diff --git a/.gitignore b/.gitignore index dd3d03124..4ae758f70 100644 --- a/.gitignore +++ b/.gitignore @@ -59,6 +59,8 @@ doc/faq.raw.xref doc/gnupg-card-architecture.eps doc/gnupg-card-architecture.pdf doc/gnupg-card-architecture.png +doc/gnupg-module-overview.pdf +doc/gnupg-module-overview.png doc/gnupg.7 doc/gpg-agent.1 doc/gpg-connect-agent.1 diff --git a/AUTHORS b/AUTHORS index b192214e0..861258f7c 100644 --- a/AUTHORS +++ b/AUTHORS @@ -30,7 +30,7 @@ List of Copyright holders Copyright (C) 1999-2003 Symas Corporation. Copyright (C) 1998-2003 Hallvard B. Furuseth. Copyright (C) 1992-1996 Regents of the University of Michigan. - + Copyright (C) 2000 Dimitrios Souflis Authors with a FSF copyright assignment @@ -194,6 +194,9 @@ Stefan Tomanek Werner Koch 2013-03-29:87620ahchj.fsf@vigenere.g10code.de: +Yann E. MORIN +2016-07-10:20160710093202.GA3688@free.fr: + Other authors ============= @@ -211,6 +214,10 @@ Alexandre Julliard. The gpg-zip documentation is based on the manpage for gpg-zip, written by Colin Tuckley and Daniel Leidert for the GNU/Debian distribution. +The test driver is based on TinySCHEME by Dimitrios Souflis and +available under a permissive license. For the terms see the file +tests/gpgscm/LICENSE.TinySCHEME. + Copyright ========= diff --git a/acinclude.m4 b/acinclude.m4 index 7c264a41b..724c08572 100644 --- a/acinclude.m4 +++ b/acinclude.m4 @@ -165,23 +165,25 @@ AC_DEFUN([GNUPG_CHECK_ENDIAN], # build_NAME and whether --enable-NAME or --disable-NAME is shown with # ./configure --help AC_DEFUN([GNUPG_BUILD_PROGRAM], - [build_$1=$2 + [m4_define([my_build], [m4_bpatsubst(build_$1, [[^a-zA-Z0-9_]], [_])]) + my_build=$2 m4_if([$2],[yes],[ AC_ARG_ENABLE([$1], AC_HELP_STRING([--disable-$1], [do not build the $1 program]), - build_$1=$enableval, build_$1=$2) + my_build=$enableval, my_build=$2) ],[ AC_ARG_ENABLE([$1], AC_HELP_STRING([--enable-$1], [build the $1 program]), - build_$1=$enableval, build_$1=$2) + my_build=$enableval, my_build=$2) ]) - case "$build_$1" in + case "$my_build" in no|yes) ;; *) AC_MSG_ERROR([only yes or no allowed for feature --enable-$1]) ;; esac + m4_undefine([my_build]) ]) diff --git a/agent/command.c b/agent/command.c index de5b1846c..e5d22689f 100644 --- a/agent/command.c +++ b/agent/command.c @@ -2663,14 +2663,13 @@ static const char hlp_updatestartuptty[] = static gpg_error_t cmd_updatestartuptty (assuan_context_t ctx, char *line) { - static const char *names[] = - { "GPG_TTY", "DISPLAY", "TERM", "XAUTHORITY", "PINENTRY_USER_DATA", NULL }; ctrl_t ctrl = assuan_get_pointer (ctx); gpg_error_t err = 0; session_env_t se; - int idx; char *lc_ctype = NULL; char *lc_messages = NULL; + int iterator; + const char *name; (void)line; @@ -2681,11 +2680,12 @@ cmd_updatestartuptty (assuan_context_t ctx, char *line) if (!se) err = gpg_error_from_syserror (); - for (idx=0; !err && names[idx]; idx++) + iterator = 0; + while (!err && (name = session_env_list_stdenvnames (&iterator, NULL))) { - const char *value = session_env_getenv (ctrl->session_env, names[idx]); + const char *value = session_env_getenv (ctrl->session_env, name); if (value) - err = session_env_setenv (se, names[idx], value); + err = session_env_setenv (se, name, value); } if (!err && ctrl->lc_ctype) diff --git a/agent/findkey.c b/agent/findkey.c index d3780b930..c5ab0e905 100644 --- a/agent/findkey.c +++ b/agent/findkey.c @@ -35,7 +35,7 @@ #include "agent.h" #include "i18n.h" #include "../common/ssh-utils.h" -#include "../common/private-keys.h" +#include "../common/name-value.h" #ifndef O_BINARY #define O_BINARY 0 @@ -57,12 +57,12 @@ write_extended_private_key (char *fname, estream_t fp, const void *buf, size_t len) { gpg_error_t err; - pkc_t pk = NULL; + nvc_t pk = NULL; gcry_sexp_t key = NULL; int remove = 0; int line; - err = pkc_parse (&pk, &line, fp); + err = nvc_parse_private_key (&pk, &line, fp); if (err) { log_error ("error parsing '%s' line %d: %s\n", @@ -74,7 +74,7 @@ write_extended_private_key (char *fname, estream_t fp, if (err) goto leave; - err = pkc_set_private_key (pk, key); + err = nvc_set_private_key (pk, key); if (err) goto leave; @@ -82,7 +82,7 @@ write_extended_private_key (char *fname, estream_t fp, if (err) goto leave; - err = pkc_write (pk, fp); + err = nvc_write (pk, fp); if (err) { log_error ("error writing '%s': %s\n", fname, gpg_strerror (err)); @@ -117,7 +117,7 @@ write_extended_private_key (char *fname, estream_t fp, gnupg_remove (fname); xfree (fname); gcry_sexp_release (key); - pkc_release (pk); + nvc_release (pk); return err; } @@ -687,10 +687,10 @@ read_key_file (const unsigned char *grip, gcry_sexp_t *result) if (first != '(') { /* Key is in extended format. */ - pkc_t pk; + nvc_t pk; int line; - rc = pkc_parse (&pk, &line, fp); + rc = nvc_parse_private_key (&pk, &line, fp); es_fclose (fp); if (rc) @@ -698,8 +698,8 @@ read_key_file (const unsigned char *grip, gcry_sexp_t *result) fname, line, gpg_strerror (rc)); else { - rc = pkc_get_private_key (pk, result); - pkc_release (pk); + rc = nvc_get_private_key (pk, result); + nvc_release (pk); if (rc) log_error ("error getting private key from '%s': %s\n", fname, gpg_strerror (rc)); diff --git a/build-aux/speedo.mk b/build-aux/speedo.mk index 67ccbb454..fbe258ca9 100644 --- a/build-aux/speedo.mk +++ b/build-aux/speedo.mk @@ -109,6 +109,10 @@ w32-release: check-tools $(SPEEDOMAKE) TARGETOS=w32 WHAT=release WITH_GUI=0 SELFCHECK=0 \ installer-from-source +w32-release-offline: check-tools + $(SPEEDOMAKE) TARGETOS=w32 WHAT=release WITH_GUI=0 SELFCHECK=0 \ + CUSTOM_SWDB=1 pkgrep=${HOME}/b pkg10rep=${HOME}/b \ + installer-from-source # Set this to "git" to build from git, diff --git a/build-aux/speedo/w32/pkg-copyright.txt b/build-aux/speedo/w32/pkg-copyright.txt index 9495bcd8a..daf288118 100644 --- a/build-aux/speedo/w32/pkg-copyright.txt +++ b/build-aux/speedo/w32/pkg-copyright.txt @@ -1,5 +1,5 @@ Here is a list with collected copyright notices. For details see the -description of each individual package. [Compiled by wk 2016-04-20] +description of each individual package. [Compiled by wk 2016-06-17] GnuPG is @@ -18,6 +18,7 @@ GnuPG is Copyright (C) 1999-2003 Symas Corporation. Copyright (C) 1998-2003 Hallvard B. Furuseth. Copyright (C) 1992-1996 Regents of the University of Michigan. + Copyright (C) 2000 Dimitrios Souflis GnuPG is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -111,6 +112,39 @@ ADNS is Copyright (C) 1991 Massachusetts Institute of Technology +TinySCHEME is part of the GnuPG package and is + + Copyright (c) 2000, Dimitrios Souflis + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are + met: + + Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + Neither the name of Dimitrios Souflis nor the names of the + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR + A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR + CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, + EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR + PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF + LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING + NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS + SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + SQLite has been put into the public-domain by its author D. Richard Hipp: diff --git a/common/Makefile.am b/common/Makefile.am index 884c966a3..6f9d96d9a 100644 --- a/common/Makefile.am +++ b/common/Makefile.am @@ -91,7 +91,8 @@ common_sources = \ call-gpg.c call-gpg.h \ exectool.c exectool.h \ server-help.c server-help.h \ - private-keys.c private-keys.h + name-value.c name-value.h \ + recsel.c recsel.h if HAVE_W32_SYSTEM common_sources += w32-reg.c w32-afunix.c w32-afunix.h @@ -157,7 +158,7 @@ module_tests = t-stringhelp t-timestuff \ t-convert t-percent t-gettime t-sysutils t-sexputil \ t-session-env t-openpgp-oid t-ssh-utils \ t-mapstrings t-zb32 t-mbox-util t-iobuf t-strlist \ - t-private-keys t-ccparray + t-name-value t-ccparray t-recsel if !HAVE_W32CE_SYSTEM module_tests += t-exechelp endif @@ -206,8 +207,9 @@ t_zb32_LDADD = $(t_common_ldadd) t_mbox_util_LDADD = $(t_common_ldadd) t_iobuf_LDADD = $(t_common_ldadd) t_strlist_LDADD = $(t_common_ldadd) -t_private_keys_LDADD = $(t_common_ldadd) +t_name_value_LDADD = $(t_common_ldadd) t_ccparray_LDADD = $(t_common_ldadd) +t_recsel_LDADD = $(t_common_ldadd) # System specific test if HAVE_W32_SYSTEM diff --git a/common/argparse.c b/common/argparse.c index 00cde23da..240fdce30 100644 --- a/common/argparse.c +++ b/common/argparse.c @@ -699,6 +699,8 @@ optfile_parse (FILE *fp, const char *filename, unsigned *lineno, } if (!set_opt_arg (arg, opts[idx].flags, p)) xfree (buffer); + else + gpgrt_annotate_leaked_object (buffer); } } break; diff --git a/common/b64dec.c b/common/b64dec.c index 3e02e4afa..c84c35ada 100644 --- a/common/b64dec.c +++ b/common/b64dec.c @@ -1,29 +1,20 @@ /* b64dec.c - Simple Base64 decoder. * Copyright (C) 2008, 2011 Free Software Foundation, Inc. + * Copyright (C) 2008, 2011, 2016 g10 Code GmbH * * This file is part of GnuPG. * * This file is free software; you can redistribute it and/or modify - * it under the terms of either - * - * - the GNU Lesser General Public License as published by the Free - * Software Foundation; either version 3 of the License, or (at - * your option) any later version. - * - * or - * - * - the GNU General Public License as published by the Free - * Software Foundation; either version 2 of the License, or (at - * your option) any later version. - * - * or both in parallel, as here. + * it under the terms of the GNU Lesser General Public License as + * published by the Free Software Foundation; either version 2.1 of + * the License, or (at your option) any later version. * * This file is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * - * You should have received a copy of the GNU General Public License + * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, see . */ @@ -61,7 +52,7 @@ static unsigned char const asctobin[128] = enum decoder_states { - s_init, s_idle, s_lfseen, s_begin, + s_init, s_idle, s_lfseen, s_beginseen, s_waitheader, s_waitblank, s_begin, s_b64_0, s_b64_1, s_b64_2, s_b64_3, s_waitendtitle, s_waitend }; @@ -71,26 +62,18 @@ enum decoder_states /* Initialize the context for the base64 decoder. If TITLE is NULL a plain base64 decoding is done. If it is the empty string the decoder will skip everything until a "-----BEGIN " line has been - seen, decoding ends at a "----END " line. - - Not yet implemented: If TITLE is either "PGP" or begins with "PGP " - the PGP armor lines are skipped as well. */ + seen, decoding ends at a "----END " line. */ gpg_error_t b64dec_start (struct b64state *state, const char *title) { memset (state, 0, sizeof *state); if (title) { - if (!strncmp (title, "PGP", 3) && (!title[3] || title[3] == ' ')) - state->lasterr = gpg_error (GPG_ERR_NOT_IMPLEMENTED); + state->title = xtrystrdup (title); + if (!state->title) + state->lasterr = gpg_error_from_syserror (); else - { - state->title = xtrystrdup (title); - if (!state->title) - state->lasterr = gpg_error_from_syserror (); - else - state->idx = s_init; - } + state->idx = s_init; } else state->idx = s_b64_0; @@ -123,6 +106,7 @@ b64dec_proc (struct b64state *state, void *buffer, size_t length, for (s=d=buffer; length && !state->stop_seen; length--, s++) { + again: switch (ds) { case s_idle: @@ -136,12 +120,42 @@ b64dec_proc (struct b64state *state, void *buffer, size_t length, ds = s_lfseen; case s_lfseen: if (*s != "-----BEGIN "[pos]) - ds = s_idle; + { + ds = s_idle; + goto again; + } else if (pos == 10) - ds = s_begin; + { + pos = 0; + ds = s_beginseen; + } else pos++; break; + case s_beginseen: + if (*s != "PGP "[pos]) + ds = s_begin; /* Not a PGP armor. */ + else if (pos == 3) + ds = s_waitheader; + else + pos++; + break; + case s_waitheader: + if (*s == '\n') + ds = s_waitblank; + break; + case s_waitblank: + if (*s == '\n') + ds = s_b64_0; /* blank line found. */ + else if (*s == ' ' || *s == '\r' || *s == '\t') + ; /* Ignore spaces. */ + else + { + /* Armor header line. Note that we don't care that our + * FSM accepts a header prefixed with spaces. */ + ds = s_waitheader; /* Wait for next header. */ + } + break; case s_begin: if (*s == '\n') ds = s_b64_0; @@ -229,10 +243,11 @@ b64dec_proc (struct b64state *state, void *buffer, size_t length, gpg_error_t b64dec_finish (struct b64state *state) { + xfree (state->title); + state->title = NULL; + if (state->lasterr) return state->lasterr; - xfree (state->title); - state->title = NULL; return state->invalid_encoding? gpg_error(GPG_ERR_BAD_DATA): 0; } diff --git a/common/b64enc.c b/common/b64enc.c index 9101d9819..af861fcbc 100644 --- a/common/b64enc.c +++ b/common/b64enc.c @@ -1,30 +1,22 @@ /* b64enc.c - Simple Base64 encoder. * Copyright (C) 2001, 2003, 2004, 2008, 2010, * 2011 Free Software Foundation, Inc. + * Copyright (C) 2001, 2003, 2004, 2008, 2010, + * 2011 g10 Code GmbH * * This file is part of GnuPG. * * This file is free software; you can redistribute it and/or modify - * it under the terms of either - * - * - the GNU Lesser General Public License as published by the Free - * Software Foundation; either version 3 of the License, or (at - * your option) any later version. - * - * or - * - * - the GNU General Public License as published by the Free - * Software Foundation; either version 2 of the License, or (at - * your option) any later version. - * - * or both in parallel, as here. + * it under the terms of the GNU Lesser General Public License as + * published by the Free Software Foundation; either version 2.1 of + * the License, or (at your option) any later version. * * This file is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * - * You should have received a copy of the GNU General Public License + * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, see . */ diff --git a/common/ccparray.c b/common/ccparray.c index 490dbf5c0..d3c28333c 100644 --- a/common/ccparray.c +++ b/common/ccparray.c @@ -114,6 +114,7 @@ ccparray_put (ccparray_t *cpa, const char *value) } for (n=0; n < cpa->size; n++) newarray[n] = cpa->array[n]; + xfree (cpa->array); cpa->array = newarray; cpa->size = newsize; diff --git a/common/exechelp-posix.c b/common/exechelp-posix.c index aefb6539c..b1b56f30c 100644 --- a/common/exechelp-posix.c +++ b/common/exechelp-posix.c @@ -523,6 +523,7 @@ gnupg_spawn_process (const char *pgmname, const char *argv[], { /* This is the child. */ gcry_control (GCRYCTL_TERM_SECMEM); + es_fclose (infp); es_fclose (outfp); es_fclose (errfp); do_exec (pgmname, argv, inpipe[0], outpipe[1], errpipe[1], diff --git a/common/exectool.c b/common/exectool.c index 897450e1e..b43e7cb01 100644 --- a/common/exectool.c +++ b/common/exectool.c @@ -224,7 +224,7 @@ static gpg_error_t copy_buffer_do_copy (struct copy_buffer *c, estream_t source, estream_t sink) { gpg_error_t err; - size_t nwritten; + size_t nwritten = 0; if (c->nread == 0) { @@ -390,7 +390,7 @@ gnupg_exec_tool_stream (const char *pgmname, const char *argv[], /* Now read as long as we have something to poll. We continue reading even after EOF or error on stdout so that we get the other error messages or remaining outut. */ - while (!fds[1].ignore && !fds[2].ignore) + while (! (fds[1].ignore && fds[2].ignore)) { count = es_poll (fds, DIM(fds), -1); if (count == -1) @@ -465,20 +465,25 @@ gnupg_exec_tool_stream (const char *pgmname, const char *argv[], pgmname, gpg_strerror (err)); goto leave; } + + if (es_feof (fds[1].stream)) + { + err = copy_buffer_flush (&cpbuf_out, output); + if (err) + { + log_error ("error reading data from '%s': %s\n", + pgmname, gpg_strerror (err)); + goto leave; + } + + fds[1].ignore = 1; /* ready. */ + } } if (fds[2].got_read) read_and_log_stderr (&fderrstate, fds + 2); } - err = copy_buffer_flush (&cpbuf_out, output); - if (err) - { - log_error ("error reading data from '%s': %s\n", - pgmname, gpg_strerror (err)); - goto leave; - } - read_and_log_stderr (&fderrstate, NULL); /* Flush. */ es_fclose (infp); infp = NULL; es_fclose (extrafp); extrafp = NULL; diff --git a/common/gettime.c b/common/gettime.c index 115f7256d..dd9c1968c 100644 --- a/common/gettime.c +++ b/common/gettime.c @@ -723,6 +723,39 @@ asctimestamp (u32 stamp) } +/* Return the timestamp STAMP in RFC-2822 format. This is always done + * in the C locale. We return the gmtime to avoid computing the + * timezone. The caller must release the returned string. + * + * Example: "Mon, 27 Jun 2016 1:42:00 +0000". + */ +char * +rfctimestamp (u32 stamp) +{ + time_t atime = stamp; + struct tm tmbuf, *tp; + + + if (IS_INVALID_TIME_T (atime)) + { + gpg_err_set_errno (EINVAL); + return NULL; + } + + tp = gnupg_gmtime (&atime, &tmbuf); + if (!tp) + return NULL; + return xtryasprintf ("%.3s, %02d %.3s %04d %02d:%02d:%02d +0000", + ("SunMonTueWedThuFriSat" + (tp->tm_wday%7)*3), + tp->tm_mday, + ("JanFebMarAprMayJunJulAugSepOctNovDec" + + (tp->tm_mon%12)*3), + tp->tm_year + 1900, + tp->tm_hour, + tp->tm_min, + tp->tm_sec); +} + static int days_per_year (int y) diff --git a/common/gettime.h b/common/gettime.h index cbc257ada..08cb3b176 100644 --- a/common/gettime.h +++ b/common/gettime.h @@ -59,6 +59,7 @@ const char *strtimevalue (u32 stamp); const char *strtimestamp (u32 stamp); /* GMT */ const char *isotimestamp (u32 stamp); /* GMT */ const char *asctimestamp (u32 stamp); /* localized */ +char *rfctimestamp (u32 stamp); /* RFC format, malloced. */ gpg_error_t add_seconds_to_isotime (gnupg_isotime_t atime, int nseconds); gpg_error_t add_days_to_isotime (gnupg_isotime_t atime, int ndays); gpg_error_t check_isotime (const gnupg_isotime_t atime); diff --git a/common/init.c b/common/init.c index c68a4e631..c406ffe58 100644 --- a/common/init.c +++ b/common/init.c @@ -106,6 +106,10 @@ register_mem_cleanup_func (void (*func)(void)) { mem_cleanup_item_t item; + for (item = mem_cleanup_list; item; item = item->next) + if (item->func == func) + return; /* Function has already been registered. */ + item = malloc (sizeof *item); if (item) { diff --git a/common/iobuf.c b/common/iobuf.c index c8ec00f7f..f3d67b474 100644 --- a/common/iobuf.c +++ b/common/iobuf.c @@ -2530,9 +2530,6 @@ iobuf_get_fname_nonnull (iobuf_t a) void iobuf_set_partial_body_length_mode (iobuf_t a, size_t len) { - block_filter_ctx_t *ctx = xcalloc (1, sizeof *ctx); - - ctx->use = a->use; if (!len) /* Disable partial body length mode. */ { @@ -2546,6 +2543,8 @@ iobuf_set_partial_body_length_mode (iobuf_t a, size_t len) else /* Enabled partial body length mode. */ { + block_filter_ctx_t *ctx = xcalloc (1, sizeof *ctx); + ctx->use = a->use; ctx->partial = 1; ctx->size = 0; ctx->first_c = len; diff --git a/common/private-keys.c b/common/name-value.c similarity index 79% rename from common/private-keys.c rename to common/name-value.c index 4cf7d227c..0b32a4442 100644 --- a/common/private-keys.c +++ b/common/name-value.c @@ -1,4 +1,4 @@ -/* private-keys.c - Parser and writer for the extended private key format. +/* name-value.c - Parser and writer for a name-value format. * Copyright (C) 2016 g10 Code GmbH * * This file is part of GnuPG. @@ -27,28 +27,34 @@ * along with this program; if not, see . */ +/* + * This module aso provides features for the extended private key + * format of gpg-agent. + */ + #include #include #include #include #include -#include "private-keys.h" #include "mischelp.h" #include "strlist.h" #include "util.h" +#include "name-value.h" -struct private_key_container +struct name_value_container { - struct private_key_entry *first; - struct private_key_entry *last; + struct name_value_entry *first; + struct name_value_entry *last; + unsigned int private_key_mode:1; }; -struct private_key_entry +struct name_value_entry { - struct private_key_entry *prev; - struct private_key_entry *next; + struct name_value_entry *prev; + struct name_value_entry *next; /* The name. Comments and blank lines have NAME set to NULL. */ char *name; @@ -70,38 +76,59 @@ my_error_from_syserror (void) } +static inline gpg_error_t +my_error (gpg_err_code_t ec) +{ + return gpg_err_make (default_errsource, ec); +} + + /* Allocation and deallocation. */ /* Allocate a private key container structure. */ -pkc_t -pkc_new (void) +nvc_t +nvc_new (void) { - return xtrycalloc (1, sizeof (struct private_key_container)); + return xtrycalloc (1, sizeof (struct name_value_container)); +} + + +/* Allocate a private key container structure for use with private keys. */ +nvc_t +nvc_new_private_key (void) +{ + nvc_t nvc = nvc_new (); + if (nvc) + nvc->private_key_mode = 1; + return nvc; } static void -pke_release (pke_t entry) +nve_release (nve_t entry, int private_key_mode) { if (entry == NULL) return; xfree (entry->name); - if (entry->value) + if (entry->value && private_key_mode) wipememory (entry->value, strlen (entry->value)); xfree (entry->value); - free_strlist_wipe (entry->raw_value); + if (private_key_mode) + free_strlist_wipe (entry->raw_value); + else + free_strlist (entry->raw_value); xfree (entry); } /* Release a private key container structure. */ void -pkc_release (pkc_t pk) +nvc_release (nvc_t pk) { - pke_t e, next; + nve_t e, next; if (pk == NULL) return; @@ -109,7 +136,7 @@ pkc_release (pkc_t pk) for (e = pk->first; e; e = next) { next = e->next; - pke_release (e); + nve_release (e, pk->private_key_mode); } xfree (pk); @@ -140,7 +167,7 @@ valid_name (const char *name) /* Makes sure that ENTRY has a RAW_VALUE. */ static gpg_error_t -assert_raw_value (pke_t entry) +assert_raw_value (nve_t entry) { gpg_error_t err = 0; size_t len, offset; @@ -256,7 +283,7 @@ continuation_length (const char *s, int *swallow_ws, const char **start) /* Makes sure that ENTRY has a VALUE. */ static gpg_error_t -assert_value (pke_t entry) +assert_value (nve_t entry) { size_t len; int swallow_ws; @@ -297,7 +324,7 @@ assert_value (pke_t entry) /* Get the name. */ char * -pke_name (pke_t pke) +nve_name (nve_t pke) { return pke->name; } @@ -305,7 +332,7 @@ pke_name (pke_t pke) /* Get the value. */ char * -pke_value (pke_t pke) +nve_value (nve_t pke) { if (assert_value (pke)) return NULL; @@ -321,23 +348,26 @@ pke_value (pke_t pke) given. If PRESERVE_ORDER is not given, entries with the same name are grouped. NAME, VALUE and RAW_VALUE is consumed. */ static gpg_error_t -_pkc_add (pkc_t pk, char *name, char *value, strlist_t raw_value, +_nvc_add (nvc_t pk, char *name, char *value, strlist_t raw_value, int preserve_order) { gpg_error_t err = 0; - pke_t e; + nve_t e; assert (value || raw_value); if (name && ! valid_name (name)) { - err = gpg_error (GPG_ERR_INV_NAME); + err = my_error (GPG_ERR_INV_NAME); goto leave; } - if (name && ascii_strcasecmp (name, "Key:") == 0 && pkc_lookup (pk, "Key:")) + if (name + && pk->private_key_mode + && !ascii_strcasecmp (name, "Key:") + && nvc_lookup (pk, "Key:")) { - err = gpg_error (GPG_ERR_INV_NAME); + err = my_error (GPG_ERR_INV_NAME); goto leave; } @@ -354,21 +384,21 @@ _pkc_add (pkc_t pk, char *name, char *value, strlist_t raw_value, if (pk->first) { - pke_t last; + nve_t last; if (preserve_order || name == NULL) last = pk->last; else { /* See if there is already an entry with NAME. */ - last = pkc_lookup (pk, name); + last = nvc_lookup (pk, name); /* If so, find the last in that block. */ if (last) { while (last->next) { - pke_t next = last->next; + nve_t next = last->next; if (next->name && ascii_strcasecmp (next->name, name) == 0) last = next; @@ -414,7 +444,7 @@ _pkc_add (pkc_t pk, char *name, char *value, strlist_t raw_value, /* Add (NAME, VALUE) to PK. If an entry with NAME already exists, it is not updated but the new entry is appended. */ gpg_error_t -pkc_add (pkc_t pk, const char *name, const char *value) +nvc_add (nvc_t pk, const char *name, const char *value) { char *k, *v; @@ -429,7 +459,7 @@ pkc_add (pkc_t pk, const char *name, const char *value) return my_error_from_syserror (); } - return _pkc_add (pk, k, v, NULL, 0); + return _nvc_add (pk, k, v, NULL, 0); } @@ -437,14 +467,14 @@ pkc_add (pkc_t pk, const char *name, const char *value) is updated with VALUE. If multiple entries with NAME exist, the first entry is updated. */ gpg_error_t -pkc_set (pkc_t pk, const char *name, const char *value) +nvc_set (nvc_t pk, const char *name, const char *value) { - pke_t e; + nve_t e; if (! valid_name (name)) return GPG_ERR_INV_NAME; - e = pkc_lookup (pk, name); + e = nvc_lookup (pk, name); if (e) { char *v; @@ -463,13 +493,13 @@ pkc_set (pkc_t pk, const char *name, const char *value) return 0; } else - return pkc_add (pk, name, value); + return nvc_add (pk, name, value); } /* Delete the given entry from PK. */ void -pkc_delete (pkc_t pk, pke_t entry) +nvc_delete (nvc_t pk, nve_t entry) { if (entry->prev) entry->prev->next = entry->next; @@ -481,7 +511,7 @@ pkc_delete (pkc_t pk, pke_t entry) else pk->last = entry->prev; - pke_release (entry); + nve_release (entry, pk->private_key_mode); } @@ -489,10 +519,10 @@ pkc_delete (pkc_t pk, pke_t entry) /* Lookup and iteration. */ /* Get the first non-comment entry. */ -pke_t -pkc_first (pkc_t pk) +nve_t +nvc_first (nvc_t pk) { - pke_t entry; + nve_t entry; for (entry = pk->first; entry; entry = entry->next) if (entry->name) return entry; @@ -501,10 +531,10 @@ pkc_first (pkc_t pk) /* Get the first entry with the given name. */ -pke_t -pkc_lookup (pkc_t pk, const char *name) +nve_t +nvc_lookup (nvc_t pk, const char *name) { - pke_t entry; + nve_t entry; for (entry = pk->first; entry; entry = entry->next) if (entry->name && ascii_strcasecmp (entry->name, name) == 0) return entry; @@ -513,8 +543,8 @@ pkc_lookup (pkc_t pk, const char *name) /* Get the next non-comment entry. */ -pke_t -pke_next (pke_t entry) +nve_t +nve_next (nve_t entry) { for (entry = entry->next; entry; entry = entry->next) if (entry->name) @@ -524,8 +554,8 @@ pke_next (pke_t entry) /* Get the next entry with the given name. */ -pke_t -pke_next_value (pke_t entry, const char *name) +nve_t +nve_next_value (nve_t entry, const char *name) { for (entry = entry->next; entry; entry = entry->next) if (entry->name && ascii_strcasecmp (entry->name, name) == 0) @@ -539,14 +569,14 @@ pke_next_value (pke_t entry, const char *name) /* Get the private key. */ gpg_error_t -pkc_get_private_key (pkc_t pk, gcry_sexp_t *retsexp) +nvc_get_private_key (nvc_t pk, gcry_sexp_t *retsexp) { gpg_error_t err; - pke_t e; + nve_t e; - e = pkc_lookup (pk, "Key:"); + e = pk->private_key_mode? nvc_lookup (pk, "Key:") : NULL; if (e == NULL) - return gpg_error (GPG_ERR_MISSING_KEY); + return my_error (GPG_ERR_MISSING_KEY); err = assert_value (e); if (err) @@ -558,12 +588,15 @@ pkc_get_private_key (pkc_t pk, gcry_sexp_t *retsexp) /* Set the private key. */ gpg_error_t -pkc_set_private_key (pkc_t pk, gcry_sexp_t sexp) +nvc_set_private_key (nvc_t pk, gcry_sexp_t sexp) { gpg_error_t err; char *raw, *clean, *p; size_t len, i; + if (!pk->private_key_mode) + return my_error (GPG_ERR_MISSING_KEY); + len = gcry_sexp_sprint (sexp, GCRYSEXP_FMT_ADVANCED, NULL, 0); raw = xtrymalloc (len); @@ -605,7 +638,7 @@ pkc_set_private_key (pkc_t pk, gcry_sexp_t sexp) } *p = 0; - err = pkc_set (pk, "Key:", clean); + err = nvc_set (pk, "Key:", clean); xfree (raw); xfree (clean); return err; @@ -615,11 +648,9 @@ pkc_set_private_key (pkc_t pk, gcry_sexp_t sexp) /* Parsing and serialization. */ -/* Parse STREAM and return a newly allocated private key container - structure in RESULT. If ERRLINEP is given, the line number the - parser was last considering is stored there. */ -gpg_error_t -pkc_parse (pkc_t *result, int *errlinep, estream_t stream) +static gpg_error_t +do_nvc_parse (nvc_t *result, int *errlinep, estream_t stream, + int for_private_key) { gpg_error_t err = 0; gpgrt_ssize_t len; @@ -628,8 +659,7 @@ pkc_parse (pkc_t *result, int *errlinep, estream_t stream) char *name = NULL; strlist_t raw_value = NULL; - - *result = pkc_new (); + *result = for_private_key? nvc_new_private_key () : nvc_new (); if (*result == NULL) return my_error_from_syserror (); @@ -659,7 +689,7 @@ pkc_parse (pkc_t *result, int *errlinep, estream_t stream) /* No continuation. Add the current entry if any. */ if (raw_value) { - err = _pkc_add (*result, name, NULL, raw_value, 1); + err = _nvc_add (*result, name, NULL, raw_value, 1); if (err) goto leave; } @@ -675,7 +705,7 @@ pkc_parse (pkc_t *result, int *errlinep, estream_t stream) colon = strchr (buf, ':'); if (colon == NULL) { - err = gpg_error (GPG_ERR_INV_VALUE); + err = my_error (GPG_ERR_INV_VALUE); goto leave; } @@ -708,13 +738,13 @@ pkc_parse (pkc_t *result, int *errlinep, estream_t stream) /* Add the final entry. */ if (raw_value) - err = _pkc_add (*result, name, NULL, raw_value, 1); + err = _nvc_add (*result, name, NULL, raw_value, 1); leave: gpgrt_free (buf); if (err) { - pkc_release (*result); + nvc_release (*result); *result = NULL; } @@ -722,12 +752,33 @@ pkc_parse (pkc_t *result, int *errlinep, estream_t stream) } +/* Parse STREAM and return a newly allocated name value container + structure in RESULT. If ERRLINEP is given, the line number the + parser was last considering is stored there. */ +gpg_error_t +nvc_parse (nvc_t *result, int *errlinep, estream_t stream) +{ + return do_nvc_parse (result, errlinep, stream, 0); +} + + +/* Parse STREAM and return a newly allocated name value container + structure in RESULT - assuming the extended private key format. If + ERRLINEP is given, the line number the parser was last considering + is stored there. */ +gpg_error_t +nvc_parse_private_key (nvc_t *result, int *errlinep, estream_t stream) +{ + return do_nvc_parse (result, errlinep, stream, 1); +} + + /* Write a representation of PK to STREAM. */ gpg_error_t -pkc_write (pkc_t pk, estream_t stream) +nvc_write (nvc_t pk, estream_t stream) { gpg_error_t err; - pke_t entry; + nve_t entry; strlist_t s; for (entry = pk->first; entry; entry = entry->next) diff --git a/common/private-keys.h b/common/name-value.h similarity index 56% rename from common/private-keys.h rename to common/name-value.h index d21e94f7c..f5f17e6de 100644 --- a/common/private-keys.h +++ b/common/name-value.h @@ -1,4 +1,4 @@ -/* private-keys.h - Parser and writer for the extended private key format. +/* name-value.h - Parser and writer for a name-value format. * Copyright (C) 2016 g10 Code GmbH * * This file is part of GnuPG. @@ -27,46 +27,50 @@ * along with this program; if not, see . */ -#ifndef GNUPG_COMMON_PRIVATE_KEYS_H -#define GNUPG_COMMON_PRIVATE_KEYS_H +#ifndef GNUPG_COMMON_NAME_VALUE_H +#define GNUPG_COMMON_NAME_VALUE_H -struct private_key_container; -typedef struct private_key_container *pkc_t; +struct name_value_container; +typedef struct name_value_container *nvc_t; -struct private_key_entry; -typedef struct private_key_entry *pke_t; +struct name_value_entry; +typedef struct name_value_entry *nve_t; /* Memory management, and dealing with entries. */ -/* Allocate a private key container structure. */ -pkc_t pkc_new (void); +/* Allocate a name value container structure. */ +nvc_t nvc_new (void); -/* Release a private key container structure. */ -void pkc_release (pkc_t pk); +/* Allocate a name value container structure for use with the extended + * private key format. */ +nvc_t nvc_new_private_key (void); + +/* Release a name value container structure. */ +void nvc_release (nvc_t pk); /* Get the name. */ -char *pke_name (pke_t pke); +char *nve_name (nve_t pke); /* Get the value. */ -char *pke_value (pke_t pke); +char *nve_value (nve_t pke); /* Lookup and iteration. */ /* Get the first non-comment entry. */ -pke_t pkc_first (pkc_t pk); +nve_t nvc_first (nvc_t pk); /* Get the first entry with the given name. */ -pke_t pkc_lookup (pkc_t pk, const char *name); +nve_t nvc_lookup (nvc_t pk, const char *name); /* Get the next non-comment entry. */ -pke_t pke_next (pke_t entry); +nve_t nve_next (nve_t entry); /* Get the next entry with the given name. */ -pke_t pke_next_value (pke_t entry, const char *name); +nve_t nve_next_value (nve_t entry, const char *name); @@ -74,25 +78,25 @@ pke_t pke_next_value (pke_t entry, const char *name); /* Add (NAME, VALUE) to PK. If an entry with NAME already exists, it is not updated but the new entry is appended. */ -gpg_error_t pkc_add (pkc_t pk, const char *name, const char *value); +gpg_error_t nvc_add (nvc_t pk, const char *name, const char *value); /* Add (NAME, VALUE) to PK. If an entry with NAME already exists, it is updated with VALUE. If multiple entries with NAME exist, the first entry is updated. */ -gpg_error_t pkc_set (pkc_t pk, const char *name, const char *value); +gpg_error_t nvc_set (nvc_t pk, const char *name, const char *value); /* Delete the given entry from PK. */ -void pkc_delete (pkc_t pk, pke_t pke); +void nvc_delete (nvc_t pk, nve_t pke); /* Private key handling. */ /* Get the private key. */ -gpg_error_t pkc_get_private_key (pkc_t pk, gcry_sexp_t *retsexp); +gpg_error_t nvc_get_private_key (nvc_t pk, gcry_sexp_t *retsexp); /* Set the private key. */ -gpg_error_t pkc_set_private_key (pkc_t pk, gcry_sexp_t sexp); +gpg_error_t nvc_set_private_key (nvc_t pk, gcry_sexp_t sexp); @@ -101,9 +105,16 @@ gpg_error_t pkc_set_private_key (pkc_t pk, gcry_sexp_t sexp); /* Parse STREAM and return a newly allocated private key container structure in RESULT. If ERRLINEP is given, the line number the parser was last considering is stored there. */ -gpg_error_t pkc_parse (pkc_t *result, int *errlinep, estream_t stream); +gpg_error_t nvc_parse (nvc_t *result, int *errlinep, estream_t stream); + +/* Parse STREAM and return a newly allocated name value container + structure in RESULT - assuming the extended private key format. If + ERRLINEP is given, the line number the parser was last considering + is stored there. */ +gpg_error_t nvc_parse_private_key (nvc_t *result, int *errlinep, + estream_t stream); /* Write a representation of PK to STREAM. */ -gpg_error_t pkc_write (pkc_t pk, estream_t stream); +gpg_error_t nvc_write (nvc_t pk, estream_t stream); -#endif /* GNUPG_COMMON_PRIVATE_KEYS_H */ +#endif /* GNUPG_COMMON_NAME_VALUE_H */ diff --git a/common/openpgpdefs.h b/common/openpgpdefs.h index f8b86e1bd..2c0ace2a5 100644 --- a/common/openpgpdefs.h +++ b/common/openpgpdefs.h @@ -115,6 +115,7 @@ typedef enum SIGSUBPKT_FEATURES = 30, /* Feature flags. */ SIGSUBPKT_SIGNATURE = 32, /* Embedded signature. */ + SIGSUBPKT_ISSUER_FPR = 33, /* EXPERIMENTAL: Issuer fingerprint. */ SIGSUBPKT_FLAG_CRITICAL = 128 } diff --git a/common/recsel.c b/common/recsel.c new file mode 100644 index 000000000..5dc685fe9 --- /dev/null +++ b/common/recsel.c @@ -0,0 +1,571 @@ +/* recsel.c - Record selection + * Copyright (C) 2014, 2016 Werner Koch + * + * This file is part of GnuPG. + * + * This file is free software; you can redistribute it and/or modify + * it under the terms of either + * + * - the GNU Lesser General Public License as published by the Free + * Software Foundation; either version 3 of the License, or (at + * your option) any later version. + * + * or + * + * - the GNU General Public License as published by the Free + * Software Foundation; either version 2 of the License, or (at + * your option) any later version. + * + * or both in parallel, as here. + * + * This file is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#include +#include +#include +#include +#include +#include + +#include "util.h" +#include "recsel.h" + +/* Select operators. */ +typedef enum + { + SELECT_SAME, + SELECT_SUB, + SELECT_NONEMPTY, + SELECT_ISTRUE, + SELECT_EQ, /* Numerically equal. */ + SELECT_LE, + SELECT_GE, + SELECT_LT, + SELECT_GT + } select_op_t; + + +/* Definition for a select expression. */ +struct recsel_expr_s +{ + recsel_expr_t next; + select_op_t op; /* Operation code. */ + unsigned int not:1; /* Negate operators. */ + unsigned int disjun:1;/* Start of a disjunction. */ + unsigned int xcase:1; /* String match is case sensitive. */ + const char *value; /* (Points into NAME.) */ + long numvalue; /* strtol of VALUE. */ + char name[1]; /* Name of the property. */ +}; + + +/* Helper */ +static inline gpg_error_t +my_error_from_syserror (void) +{ + return gpg_err_make (default_errsource, gpg_err_code_from_syserror ()); +} + +/* Helper */ +static inline gpg_error_t +my_error (gpg_err_code_t ec) +{ + return gpg_err_make (default_errsource, ec); +} + + +/* This is a case-sensitive version of our memistr. I wonder why no + * standard function memstr exists but I better do not use the name + * memstr to avoid future conflicts. + * + * FIXME: Move this to a stringhelp.c + */ +static const char * +my_memstr (const void *buffer, size_t buflen, const char *sub) +{ + const unsigned char *buf = buffer; + const unsigned char *t = (const unsigned char *)buf; + const unsigned char *s = (const unsigned char *)sub; + size_t n = buflen; + + for ( ; n ; t++, n-- ) + { + if (*t == *s) + { + for (buf = t++, buflen = n--, s++; n && *t ==*s; t++, s++, n--) + ; + if (!*s) + return (const char*)buf; + t = (const unsigned char *)buf; + s = (const unsigned char *)sub ; + n = buflen; + } + } + return NULL; +} + + +/* Return a pointer to the next logical connection operator or NULL if + * none. */ +static char * +find_next_lc (char *string) +{ + char *p1, *p2; + + p1 = strchr (string, '&'); + if (p1 && p1[1] != '&') + p1 = NULL; + p2 = strchr (string, '|'); + if (p2 && p2[1] != '|') + p2 = NULL; + if (p1 && !p2) + return p1; + if (!p1) + return p2; + return p1 < p2 ? p1 : p2; +} + + +/* Parse an expression. The expression syntax is: + * + * [] {{} PROPNAME VALUE []} + * + * A [] indicates an optional part, a {} a repetition. PROPNAME and + * VALUE may not be the empty string. White space between the + * elements is ignored. Numerical values are computed as long int; + * standard C notation applies. is the logical connection + * operator; either "&&" for a conjunction or "||" for a disjunction. + * A conjunction is assumed at the begin of an expression and + * conjunctions have higher precedence than disjunctions. If VALUE + * starts with one of the characters used in any a space after + * the is required. A VALUE is terminated by an unless the + * "--" is used in which case the VALUE spans to the end of the + * expression. may be any of + * + * =~ Substring must match + * !~ Substring must not match + * = The full string must match + * <> The full string must not match + * == The numerical value must match + * != The numerical value must not match + * <= The numerical value of the field must be LE than the value. + * < The numerical value of the field must be LT than the value. + * >= The numerical value of the field must be GT than the value. + * >= The numerical value of the field must be GE than the value. + * -n True if value is not empty (no VALUE parameter allowed). + * -z True if value is empty (no VALUE parameter allowed). + * -t Alias for "PROPNAME != 0" (no VALUE parameter allowed). + * -f Alias for "PROPNAME == 0" (no VALUE parameter allowed). + * + * Values for must be space separated and any of: + * + * -- VALUE spans to the end of the expression. + * -c The string match in this part is done case-sensitive. + * + * For example four calls to recsel_parse_expr() with these values for + * EXPR + * + * "uid =~ Alfa" + * "&& uid !~ Test" + * "|| uid =~ Alpha" + * "uid !~ Test" + * + * or the equivalent expression + * + * "uid =~ Alfa" && uid !~ Test" || uid =~ Alpha" && "uid !~ Test" + * + * are making a selector for records where the "uid" property contains + * the strings "Alfa" or "Alpha" but not the String "test". + * + * The caller must pass the address of a selector variable to this + * function and initialize the value of the function to NULL before + * the first call. recset_release needs to be called to free the + * selector. + */ +gpg_error_t +recsel_parse_expr (recsel_expr_t *selector, const char *expression) +{ + recsel_expr_t se_head = NULL; + recsel_expr_t se, se2; + char *expr_buffer; + char *expr; + char *s0, *s; + int toend = 0; + int xcase = 0; + int disjun = 0; + char *next_lc = NULL; + + while (*expression == ' ' || *expression == '\t') + expression++; + + expr_buffer = xtrystrdup (expression); + if (!expr_buffer) + return my_error_from_syserror (); + expr = expr_buffer; + + if (*expr == '|' && expr[1] == '|') + { + disjun = 1; + expr += 2; + } + else if (*expr == '&' && expr[1] == '&') + expr += 2; + + next_term: + while (*expr == ' ' || *expr == '\t') + expr++; + + while (*expr == '-') + { + switch (*++expr) + { + case '-': toend = 1; break; + case 'c': xcase = 1; break; + default: + log_error ("invalid flag '-%c' in expression\n", *expr); + recsel_release (se_head); + xfree (expr_buffer); + return my_error (GPG_ERR_INV_FLAG); + } + expr++; + while (*expr == ' ' || *expr == '\t') + expr++; + } + + next_lc = toend? NULL : find_next_lc (expr); + if (next_lc) + *next_lc = 0; /* Terminate this term. */ + + se = xtrymalloc (sizeof *se + strlen (expr)); + if (!se) + return my_error_from_syserror (); + strcpy (se->name, expr); + se->next = NULL; + se->not = 0; + se->disjun = disjun; + se->xcase = xcase; + + if (!se_head) + se_head = se; + else + { + for (se2 = se_head; se2->next; se2 = se2->next) + ; + se2->next = se; + } + + + s = strpbrk (expr, "=<>!~-"); + if (!s || s == expr ) + { + log_error ("no field name given in expression\n"); + recsel_release (se_head); + xfree (expr_buffer); + return my_error (GPG_ERR_NO_NAME); + } + s0 = s; + + if (!strncmp (s, "=~", 2)) + { + se->op = SELECT_SUB; + s += 2; + } + else if (!strncmp (s, "!~", 2)) + { + se->op = SELECT_SUB; + se->not = 1; + s += 2; + } + else if (!strncmp (s, "<>", 2)) + { + se->op = SELECT_SAME; + se->not = 1; + s += 2; + } + else if (!strncmp (s, "==", 2)) + { + se->op = SELECT_EQ; + s += 2; + } + else if (!strncmp (s, "!=", 2)) + { + se->op = SELECT_EQ; + se->not = 1; + s += 2; + } + else if (!strncmp (s, "<=", 2)) + { + se->op = SELECT_LE; + s += 2; + } + else if (!strncmp (s, ">=", 2)) + { + se->op = SELECT_GE; + s += 2; + } + else if (!strncmp (s, "<", 1)) + { + se->op = SELECT_LT; + s += 1; + } + else if (!strncmp (s, ">", 1)) + { + se->op = SELECT_GT; + s += 1; + } + else if (!strncmp (s, "=", 1)) + { + se->op = SELECT_SAME; + s += 1; + } + else if (!strncmp (s, "-z", 2)) + { + se->op = SELECT_NONEMPTY; + se->not = 1; + s += 2; + } + else if (!strncmp (s, "-n", 2)) + { + se->op = SELECT_NONEMPTY; + s += 2; + } + else if (!strncmp (s, "-f", 2)) + { + se->op = SELECT_ISTRUE; + se->not = 1; + s += 2; + } + else if (!strncmp (s, "-t", 2)) + { + se->op = SELECT_ISTRUE; + s += 2; + } + else + { + log_error ("invalid operator in expression\n"); + recsel_release (se_head); + xfree (expr_buffer); + return my_error (GPG_ERR_INV_OP); + } + + /* We require that a space is used if the value starts with any of + the operator characters. */ + if (se->op == SELECT_NONEMPTY || se->op == SELECT_ISTRUE) + ; + else if (strchr ("=<>!~", *s)) + { + log_error ("invalid operator in expression\n"); + recsel_release (se_head); + xfree (expr_buffer); + return my_error (GPG_ERR_INV_OP); + } + + while (*s == ' ' || *s == '\t') + s++; + + if (se->op == SELECT_NONEMPTY || se->op == SELECT_ISTRUE) + { + if (*s) + { + log_error ("value given for -n or -z\n"); + recsel_release (se_head); + xfree (expr_buffer); + return my_error (GPG_ERR_SYNTAX); + } + } + else + { + if (!*s) + { + log_error ("no value given in expression\n"); + recsel_release (se_head); + xfree (expr_buffer); + return my_error (GPG_ERR_MISSING_VALUE); + } + } + + se->name[s0 - expr] = 0; + trim_spaces (se->name); + if (!se->name[0]) + { + log_error ("no field name given in expression\n"); + recsel_release (se_head); + xfree (expr_buffer); + return my_error (GPG_ERR_NO_NAME); + } + + trim_spaces (se->name + (s - expr)); + se->value = se->name + (s - expr); + if (!se->value[0] && !(se->op == SELECT_NONEMPTY || se->op == SELECT_ISTRUE)) + { + log_error ("no value given in expression\n"); + recsel_release (se_head); + xfree (expr_buffer); + return my_error (GPG_ERR_MISSING_VALUE); + } + + se->numvalue = strtol (se->value, NULL, 0); + + if (next_lc) + { + disjun = next_lc[1] == '|'; + expr = next_lc + 2; + goto next_term; + } + + /* Read:y Append to passes last selector. */ + if (!*selector) + *selector = se_head; + else + { + for (se2 = *selector; se2->next; se2 = se2->next) + ; + se2->next = se_head; + } + + xfree (expr_buffer); + return 0; +} + + +void +recsel_release (recsel_expr_t a) +{ + while (a) + { + recsel_expr_t tmp = a->next; + xfree (a); + a = tmp; + } +} + + +void +recsel_dump (recsel_expr_t selector) +{ + recsel_expr_t se; + + log_debug ("--- Begin selectors ---\n"); + for (se = selector; se; se = se->next) + { + log_debug ("%s %s %s %s '%s'\n", + se==selector? " ": (se->disjun? "||":"&&"), + se->xcase? "-c":" ", + se->name, + se->op == SELECT_SAME? (se->not? "<>":"= "): + se->op == SELECT_SUB? (se->not? "!~":"=~"): + se->op == SELECT_NONEMPTY?(se->not? "-z":"-n"): + se->op == SELECT_ISTRUE? (se->not? "-f":"-t"): + se->op == SELECT_EQ? (se->not? "!=":"=="): + se->op == SELECT_LT? "< ": + se->op == SELECT_LE? "<=": + se->op == SELECT_GT? "> ": + se->op == SELECT_GE? ">=":"[oops]", + se->value); + } + log_debug ("--- End selectors ---\n"); +} + + +/* Return true if the record RECORD has been selected. The GETVAL + * function is called with COOKIE and the NAME of a property used in + * the expression. */ +int +recsel_select (recsel_expr_t selector, + const char *(*getval)(void *cookie, const char *propname), + void *cookie) +{ + recsel_expr_t se; + const char *value; + size_t selen, valuelen; + long numvalue; + int result = 1; + + se = selector; + while (se) + { + value = getval? getval (cookie, se->name) : NULL; + if (!value) + value = ""; + + if (!*value) + { + /* Field is empty. */ + result = 0; + } + else /* Field has a value. */ + { + valuelen = strlen (value); + numvalue = strtol (value, NULL, 0); + selen = strlen (se->value); + + switch (se->op) + { + case SELECT_SAME: + if (se->xcase) + result = (valuelen==selen && !memcmp (value,se->value,selen)); + else + result = (valuelen==selen && !memicmp (value,se->value,selen)); + break; + case SELECT_SUB: + if (se->xcase) + result = !!my_memstr (value, valuelen, se->value); + else + result = !!memistr (value, valuelen, se->value); + break; + case SELECT_NONEMPTY: + result = !!valuelen; + break; + case SELECT_ISTRUE: + result = !!numvalue; + break; + case SELECT_EQ: + result = (numvalue == se->numvalue); + break; + case SELECT_GT: + result = (numvalue > se->numvalue); + break; + case SELECT_GE: + result = (numvalue >= se->numvalue); + break; + case SELECT_LT: + result = (numvalue < se->numvalue); + break; + case SELECT_LE: + result = (numvalue <= se->numvalue); + break; + } + } + + if (se->not) + result = !result; + + if (result) + { + /* This expression evaluated to true. See wether there are + remaining expressions in this conjunction. */ + if (!se->next || se->next->disjun) + break; /* All expressions are true. Return True. */ + se = se->next; /* Test the next. */ + } + else + { + /* This expression evaluated to false and thus the + * conjuction evaluates to false. We skip over the + * remaining expressions of this conjunction and continue + * with the next disjunction if any. */ + do + se = se->next; + while (se && !se->disjun); + } + } + + return result; +} diff --git a/common/recsel.h b/common/recsel.h new file mode 100644 index 000000000..be67afcbe --- /dev/null +++ b/common/recsel.h @@ -0,0 +1,43 @@ +/* recsel.c - Record selection + * Copyright (C) 2016 Werner Koch + * + * This file is part of GnuPG. + * + * This file is free software; you can redistribute it and/or modify + * it under the terms of either + * + * - the GNU Lesser General Public License as published by the Free + * Software Foundation; either version 3 of the License, or (at + * your option) any later version. + * + * or + * + * - the GNU General Public License as published by the Free + * Software Foundation; either version 2 of the License, or (at + * your option) any later version. + * + * or both in parallel, as here. + * + * This file is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ +#ifndef GNUPG_COMMON_RECSEL_H +#define GNUPG_COMMON_RECSEL_H + +struct recsel_expr_s; +typedef struct recsel_expr_s *recsel_expr_t; + +gpg_error_t recsel_parse_expr (recsel_expr_t *selector, const char *expr); +void recsel_release (recsel_expr_t a); +void recsel_dump (recsel_expr_t selector); +int recsel_select (recsel_expr_t selector, + const char *(*getval)(void *cookie, const char *propname), + void *cookie); + + +#endif /*GNUPG_COMMON_RECSEL_H*/ diff --git a/common/simple-pwquery.c b/common/simple-pwquery.c index bdad14093..708b1573d 100644 --- a/common/simple-pwquery.c +++ b/common/simple-pwquery.c @@ -340,6 +340,7 @@ agent_open (int *rfd) if ( !(p = strchr ( infostr, PATHSEP_C)) || p == infostr || (p-infostr)+1 >= sizeof client_addr.sun_path ) { + spwq_free (infostr); return SPWQ_NO_AGENT; } *p++ = 0; @@ -357,12 +358,14 @@ agent_open (int *rfd) #ifdef SPWQ_USE_LOGGING log_error ("can't create socket: %s\n", strerror(errno) ); #endif + spwq_free (infostr); return SPWQ_SYS_ERROR; } memset (&client_addr, 0, sizeof client_addr); client_addr.sun_family = AF_UNIX; strcpy (client_addr.sun_path, infostr); + spwq_free (infostr); len = SUN_LEN (&client_addr); #ifdef HAVE_W32_SYSTEM @@ -373,7 +376,8 @@ agent_open (int *rfd) if (rc == -1) { #ifdef SPWQ_USE_LOGGING - log_error ( _("can't connect to '%s': %s\n"), infostr, strerror (errno)); + log_error (_("can't connect to '%s': %s\n"), + client_addr.sun_path, strerror (errno)); #endif close (fd ); return SPWQ_IO_ERROR; diff --git a/common/stringhelp.c b/common/stringhelp.c index 0e96c9e54..95912e0b2 100644 --- a/common/stringhelp.c +++ b/common/stringhelp.c @@ -538,6 +538,7 @@ do_make_filename (int xmode, const char *first_part, va_list arg_ptr) home_buffer = xtrymalloc (n); if (!home_buffer) { + xfree (home); xfree (name); return NULL; } @@ -556,6 +557,7 @@ do_make_filename (int xmode, const char *first_part, va_list arg_ptr) else strcpy (stpcpy (stpcpy (p, home), "/"), name); + xfree (home); xfree (name); name = home_buffer; /* Let's do a simple compression to catch the most common diff --git a/common/t-convert.c b/common/t-convert.c index ad33dff9b..68824e0cd 100644 --- a/common/t-convert.c +++ b/common/t-convert.c @@ -234,6 +234,7 @@ test_bin2hex (void) fail (0); else if (strcmp (p, hexstuff)) fail (0); + xfree (p); p = bin2hex (stuff, (size_t)(-1), NULL); if (p) @@ -266,6 +267,7 @@ test_bin2hexcolon (void) fail (0); else if (strcmp (p, hexstuff)) fail (0); + xfree (p); p = bin2hexcolon (stuff, (size_t)(-1), NULL); if (p) diff --git a/common/t-gettime.c b/common/t-gettime.c index 9b3139d48..8a222b7e4 100644 --- a/common/t-gettime.c +++ b/common/t-gettime.c @@ -54,6 +54,12 @@ test_isotime2epoch (void) { "20070629T160000 ", 1183132800 }, { "20070629T160000\n", 1183132800 }, { "20070629T160000.", INVALID }, +#if SIZEOF_TIME_T > 4 + { "21060207T062815", (time_t)0x0ffffffff }, + { "21060207T062816", (time_t)0x100000000 }, + { "21060207T062817", (time_t)0x100000001 }, + { "21060711T120001", (time_t)4308292801 }, +#endif /*SIZEOF_TIME_T > 4*/ { NULL, 0 } }; int idx; diff --git a/common/t-iobuf.c b/common/t-iobuf.c index 2835df4d2..0e6f508a5 100644 --- a/common/t-iobuf.c +++ b/common/t-iobuf.c @@ -190,6 +190,8 @@ main (int argc, char *argv[]) n ++; } assert (n == 10 + (strlen (content) - 10) / 2); + + iobuf_close (iobuf); } @@ -266,6 +268,8 @@ main (int argc, char *argv[]) /* The string should have been truncated (max_len == 0). */ assert (max_len == 0); free (buffer); + + iobuf_close (iobuf); } { @@ -279,10 +283,12 @@ main (int argc, char *argv[]) int c; int n; int lastc = 0; + struct content_filter_state *state; iobuf = iobuf_temp_with_content (content, strlen(content)); rc = iobuf_push_filter (iobuf, - content_filter, content_filter_new (content2)); + content_filter, + state=content_filter_new (content2)); assert (rc == 0); n = 0; @@ -309,6 +315,9 @@ main (int argc, char *argv[]) /* printf ("%d: '%c' (%d)\n", n, c, c); */ } } + + iobuf_close (iobuf); + free (state); } /* Write some data to a temporary filter. Push a new filter. The @@ -346,6 +355,8 @@ main (int argc, char *argv[]) assert (n == strlen (content) + 2 * (strlen (content2) + 1)); assert (strcmp (buffer, "0123456789aabbcc") == 0); + + iobuf_close (iobuf); } { @@ -373,6 +384,8 @@ main (int argc, char *argv[]) assert (n == 2); assert (buffer[0] == '3'); assert (buffer[1] == '7'); + + iobuf_close (iobuf); } return 0; diff --git a/common/t-mbox-util.c b/common/t-mbox-util.c index dfa4ada2a..ff48f6c5d 100644 --- a/common/t-mbox-util.c +++ b/common/t-mbox-util.c @@ -87,6 +87,8 @@ run_test (void) fail (idx); else if (strcmp (mbox, testtbl[idx].mbox)) fail (idx); + + xfree (mbox); } } diff --git a/common/t-private-keys.c b/common/t-name-value.c similarity index 69% rename from common/t-private-keys.c rename to common/t-name-value.c index 1027e70cf..3b01431d4 100644 --- a/common/t-private-keys.c +++ b/common/t-name-value.c @@ -1,4 +1,4 @@ -/* t-private-keys.c - Module test for private-keys.c +/* t-name-value.c - Module test for name-value.c * Copyright (C) 2016 g10 Code GmbH * * This file is part of GnuPG. @@ -26,82 +26,102 @@ #include #include "util.h" -#include "private-keys.h" +#include "name-value.h" static int verbose; +static int private_key_mode; + + +static nvc_t +my_nvc_new (void) +{ + if (private_key_mode) + return nvc_new_private_key (); + else + return nvc_new (); +} + void -test_getting_values (pkc_t pk) +test_getting_values (nvc_t pk) { - pke_t e; + nve_t e; - e = pkc_lookup (pk, "Comment:"); + e = nvc_lookup (pk, "Comment:"); assert (e); /* Names are case-insensitive. */ - e = pkc_lookup (pk, "comment:"); + e = nvc_lookup (pk, "comment:"); assert (e); - e = pkc_lookup (pk, "COMMENT:"); + e = nvc_lookup (pk, "COMMENT:"); assert (e); - e = pkc_lookup (pk, "SomeOtherName:"); + e = nvc_lookup (pk, "SomeOtherName:"); assert (e); } void -test_key_extraction (pkc_t pk) +test_key_extraction (nvc_t pk) { gpg_error_t err; gcry_sexp_t key; - err = pkc_get_private_key (pk, &key); - assert (err == 0); - assert (key); + if (private_key_mode) + { + err = nvc_get_private_key (pk, &key); + assert (err == 0); + assert (key); - if (verbose) - gcry_sexp_dump (key); + if (verbose) + gcry_sexp_dump (key); - gcry_sexp_release (key); + gcry_sexp_release (key); + } + else + { + err = nvc_get_private_key (pk, &key); + assert (gpg_err_code (err) == GPG_ERR_MISSING_KEY); + } } void -test_iteration (pkc_t pk) +test_iteration (nvc_t pk) { int i; - pke_t e; + nve_t e; i = 0; - for (e = pkc_first (pk); e; e = pke_next (e)) + for (e = nvc_first (pk); e; e = nve_next (e)) i++; assert (i == 4); i = 0; - for (e = pkc_lookup (pk, "Comment:"); + for (e = nvc_lookup (pk, "Comment:"); e; - e = pke_next_value (e, "Comment:")) + e = nve_next_value (e, "Comment:")) i++; assert (i == 3); } void -test_whitespace (pkc_t pk) +test_whitespace (nvc_t pk) { - pke_t e; + nve_t e; - e = pkc_lookup (pk, "One:"); + e = nvc_lookup (pk, "One:"); assert (e); - assert (strcmp (pke_value (e), "WithoutWhitespace") == 0); + assert (strcmp (nve_value (e), "WithoutWhitespace") == 0); - e = pkc_lookup (pk, "Two:"); + e = nvc_lookup (pk, "Two:"); assert (e); - assert (strcmp (pke_value (e), "With Whitespace") == 0); + assert (strcmp (nve_value (e), "With Whitespace") == 0); - e = pkc_lookup (pk, "Three:"); + e = nvc_lookup (pk, "Three:"); assert (e); - assert (strcmp (pke_value (e), + assert (strcmp (nve_value (e), "Blank lines in continuations encode newlines.\n" "Next paragraph.") == 0); } @@ -110,7 +130,7 @@ test_whitespace (pkc_t pk) struct { char *value; - void (*test_func) (pkc_t); + void (*test_func) (nvc_t); } tests[] = { { @@ -193,7 +213,7 @@ struct static char * -pkc_to_string (pkc_t pk) +nvc_to_string (nvc_t pk) { gpg_error_t err; char *buf; @@ -203,7 +223,7 @@ pkc_to_string (pkc_t pk) sink = es_fopenmem (0, "rw"); assert (sink); - err = pkc_write (pk, sink); + err = nvc_write (pk, sink); assert (err == 0); len = es_ftell (sink); @@ -226,7 +246,7 @@ void run_tests (void) { gpg_error_t err; - pkc_t pk; + nvc_t pk; int i; for (i = 0; i < DIM (tests); i++) @@ -240,17 +260,20 @@ run_tests (void) 0, dummy_realloc, dummy_free, "r"); assert (source); - err = pkc_parse (&pk, NULL, source); + if (private_key_mode) + err = nvc_parse_private_key (&pk, NULL, source); + else + err = nvc_parse (&pk, NULL, source); assert (err == 0); assert (pk); if (verbose) { - err = pkc_write (pk, es_stderr); + err = nvc_write (pk, es_stderr); assert (err == 0); } - buf = pkc_to_string (pk); + buf = nvc_to_string (pk); assert (memcmp (tests[i].value, buf, len) == 0); es_fclose (source); @@ -259,7 +282,7 @@ run_tests (void) if (tests[i].test_func) tests[i].test_func (pk); - pkc_release (pk); + nvc_release (pk); } } @@ -268,106 +291,115 @@ void run_modification_tests (void) { gpg_error_t err; - pkc_t pk; + nvc_t pk; gcry_sexp_t key; char *buf; - pk = pkc_new (); + pk = my_nvc_new (); assert (pk); - pkc_set (pk, "Foo:", "Bar"); - buf = pkc_to_string (pk); + nvc_set (pk, "Foo:", "Bar"); + buf = nvc_to_string (pk); assert (strcmp (buf, "Foo: Bar\n") == 0); xfree (buf); - pkc_set (pk, "Foo:", "Baz"); - buf = pkc_to_string (pk); + nvc_set (pk, "Foo:", "Baz"); + buf = nvc_to_string (pk); assert (strcmp (buf, "Foo: Baz\n") == 0); xfree (buf); - pkc_set (pk, "Bar:", "Bazzel"); - buf = pkc_to_string (pk); + nvc_set (pk, "Bar:", "Bazzel"); + buf = nvc_to_string (pk); assert (strcmp (buf, "Foo: Baz\nBar: Bazzel\n") == 0); xfree (buf); - pkc_add (pk, "Foo:", "Bar"); - buf = pkc_to_string (pk); + nvc_add (pk, "Foo:", "Bar"); + buf = nvc_to_string (pk); assert (strcmp (buf, "Foo: Baz\nFoo: Bar\nBar: Bazzel\n") == 0); xfree (buf); - pkc_add (pk, "DontExistYet:", "Bar"); - buf = pkc_to_string (pk); + nvc_add (pk, "DontExistYet:", "Bar"); + buf = nvc_to_string (pk); assert (strcmp (buf, "Foo: Baz\nFoo: Bar\nBar: Bazzel\nDontExistYet: Bar\n") == 0); xfree (buf); - pkc_delete (pk, pkc_lookup (pk, "DontExistYet:")); - buf = pkc_to_string (pk); + nvc_delete (pk, nvc_lookup (pk, "DontExistYet:")); + buf = nvc_to_string (pk); assert (strcmp (buf, "Foo: Baz\nFoo: Bar\nBar: Bazzel\n") == 0); xfree (buf); - pkc_delete (pk, pke_next_value (pkc_lookup (pk, "Foo:"), "Foo:")); - buf = pkc_to_string (pk); + nvc_delete (pk, nve_next_value (nvc_lookup (pk, "Foo:"), "Foo:")); + buf = nvc_to_string (pk); assert (strcmp (buf, "Foo: Baz\nBar: Bazzel\n") == 0); xfree (buf); - pkc_delete (pk, pkc_lookup (pk, "Foo:")); - buf = pkc_to_string (pk); + nvc_delete (pk, nvc_lookup (pk, "Foo:")); + buf = nvc_to_string (pk); assert (strcmp (buf, "Bar: Bazzel\n") == 0); xfree (buf); - pkc_delete (pk, pkc_first (pk)); - buf = pkc_to_string (pk); + nvc_delete (pk, nvc_first (pk)); + buf = nvc_to_string (pk); assert (strcmp (buf, "") == 0); xfree (buf); - pkc_set (pk, "Foo:", "A really long value spanning across multiple lines" + nvc_set (pk, "Foo:", "A really long value spanning across multiple lines" " that has to be wrapped at a convenient space."); - buf = pkc_to_string (pk); + buf = nvc_to_string (pk); assert (strcmp (buf, "Foo: A really long value spanning across multiple" " lines that has to be\n wrapped at a convenient space.\n") == 0); xfree (buf); - pkc_set (pk, "Foo:", "XA really long value spanning across multiple lines" + nvc_set (pk, "Foo:", "XA really long value spanning across multiple lines" " that has to be wrapped at a convenient space."); - buf = pkc_to_string (pk); + buf = nvc_to_string (pk); assert (strcmp (buf, "Foo: XA really long value spanning across multiple" " lines that has to\n be wrapped at a convenient space.\n") == 0); xfree (buf); - pkc_set (pk, "Foo:", "XXXXA really long value spanning across multiple lines" + nvc_set (pk, "Foo:", "XXXXA really long value spanning across multiple lines" " that has to be wrapped at a convenient space."); - buf = pkc_to_string (pk); + buf = nvc_to_string (pk); assert (strcmp (buf, "Foo: XXXXA really long value spanning across multiple" " lines that has\n to be wrapped at a convenient space.\n") == 0); xfree (buf); - pkc_set (pk, "Foo:", "Areallylongvaluespanningacrossmultiplelines" + nvc_set (pk, "Foo:", "Areallylongvaluespanningacrossmultiplelines" "thathastobewrappedataconvenientspacethatisnotthere."); - buf = pkc_to_string (pk); + buf = nvc_to_string (pk); assert (strcmp (buf, "Foo: Areallylongvaluespanningacrossmultiplelinesthat" "hastobewrappedataco\n nvenientspacethatisnotthere.\n") == 0); xfree (buf); - pkc_release (pk); + nvc_release (pk); - pk = pkc_new (); + pk = my_nvc_new (); assert (pk); err = gcry_sexp_build (&key, NULL, "(hello world)"); assert (err == 0); assert (key); - err = pkc_set_private_key (pk, key); + if (private_key_mode) + { + err = nvc_set_private_key (pk, key); + assert (err == 0); + + buf = nvc_to_string (pk); + assert (strcmp (buf, "Key: (hello world)\n") == 0); + xfree (buf); + } + else + { + err = nvc_set_private_key (pk, key); + assert (gpg_err_code (err) == GPG_ERR_MISSING_KEY); + } gcry_sexp_release (key); - assert (err == 0); - buf = pkc_to_string (pk); - assert (strcmp (buf, "Key: (hello world)\n") == 0); - xfree (buf); - pkc_release (pk); + nvc_release (pk); } @@ -380,7 +412,7 @@ convert (const char *fname) char *buf; size_t buflen; struct stat st; - pkc_t pk; + nvc_t pk; source = es_fopen (fname, "rb"); if (source == NULL) @@ -403,13 +435,13 @@ convert (const char *fname) exit (1); } - pk = pkc_new (); + pk = my_nvc_new (); assert (pk); - err = pkc_set_private_key (pk, key); + err = nvc_set_private_key (pk, key); assert (err == 0); - err = pkc_write (pk, es_stdout); + err = nvc_write (pk, es_stdout); assert (err == 0); return; @@ -426,8 +458,8 @@ parse (const char *fname) gpg_error_t err; estream_t source; char *buf; - pkc_t pk_a, pk_b; - pke_t e; + nvc_t pk_a, pk_b; + nve_t e; int line; source = es_fopen (fname, "rb"); @@ -437,7 +469,10 @@ parse (const char *fname) exit (1); } - err = pkc_parse (&pk_a, &line, source); + if (private_key_mode) + err = nvc_parse_private_key (&pk_a, &line, source); + else + err = nvc_parse (&pk_a, &line, source); if (err) { fprintf (stderr, "failed to parse %s line %d: %s\n", @@ -445,36 +480,36 @@ parse (const char *fname) exit (1); } - buf = pkc_to_string (pk_a); + buf = nvc_to_string (pk_a); xfree (buf); - pk_b = pkc_new (); + pk_b = my_nvc_new (); assert (pk_b); - for (e = pkc_first (pk_a); e; e = pke_next (e)) + for (e = nvc_first (pk_a); e; e = nve_next (e)) { gcry_sexp_t key = NULL; - if (strcasecmp (pke_name (e), "Key:") == 0) + if (private_key_mode && !strcasecmp (nve_name (e), "Key:")) { - err = pkc_get_private_key (pk_a, &key); + err = nvc_get_private_key (pk_a, &key); if (err) key = NULL; } if (key) { - err = pkc_set_private_key (pk_b, key); + err = nvc_set_private_key (pk_b, key); assert (err == 0); } else { - err = pkc_add (pk_b, pke_name (e), pke_value (e)); + err = nvc_add (pk_b, nve_name (e), nve_value (e)); assert (err == 0); } } - buf = pkc_to_string (pk_b); + buf = nvc_to_string (pk_b); if (verbose) fprintf (stdout, "%s", buf); xfree (buf); @@ -487,7 +522,8 @@ print_usage (void) fprintf (stderr, "usage: t-private-keys [--verbose]" " [--convert " - " || --parse ]\n"); + " || --parse-key " + " || --parse ]\n"); exit (2); } @@ -495,7 +531,7 @@ print_usage (void) int main (int argc, char **argv) { - enum { TEST, CONVERT, PARSE } command = TEST; + enum { TEST, CONVERT, PARSE, PARSEKEY } command = TEST; if (argc) { argc--; argv++; } @@ -513,6 +549,14 @@ main (int argc, char **argv) print_usage (); } + if (argc && !strcmp (argv[0], "--parse-key")) + { + command = PARSEKEY; + argc--; argv++; + if (argc != 1) + print_usage (); + } + if (argc && !strcmp (argv[0], "--parse")) { command = PARSE; @@ -524,6 +568,9 @@ main (int argc, char **argv) switch (command) { case TEST: + run_tests (); + run_modification_tests (); + private_key_mode = 1; run_tests (); run_modification_tests (); break; @@ -532,6 +579,11 @@ main (int argc, char **argv) convert (*argv); break; + case PARSEKEY: + private_key_mode = 1; + parse (*argv); + break; + case PARSE: parse (*argv); break; diff --git a/common/t-recsel.c b/common/t-recsel.c new file mode 100644 index 000000000..fe2a7b9d0 --- /dev/null +++ b/common/t-recsel.c @@ -0,0 +1,405 @@ +/* t-recsel.c - Module test for recsel.c + * Copyright (C) 2016 Werner Koch + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#include +#include +#include +#include + +#include "util.h" +#include "init.h" +#include "recsel.h" + +#define PGM "t-recsel" + +#define pass() do { ; } while(0) +#define fail(a,e) do { log_error ("line %d: test %d failed: %s\n", \ + __LINE__, (a), gpg_strerror ((e))); \ + exit (1); \ + } while(0) + +static int verbose; +static int debug; + + +#define FREEEXPR() do { recsel_release (se); se = NULL; } while (0) +#define ADDEXPR(a) do { \ + err = recsel_parse_expr (&se, (a)); \ + if (err) \ + fail (0, err); \ + } while (0) + + +static const char * +test_1_getval (void *cookie, const char *name) +{ + if (strcmp (name, "uid")) + fail (0, 0); + return cookie; +} + +static void +run_test_1 (void) +{ + static const char *expr[] = { + "uid =~ Alfa", + "&& uid !~ Test ", + "|| uid =~ Alpha", + " uid !~ Test" + }; + gpg_error_t err; + recsel_expr_t se = NULL; + int i; + + for (i=0; i < DIM (expr); i++) + { + err = recsel_parse_expr (&se, expr[i]); + if (err) + fail (i, err); + } + + if (debug) + recsel_dump (se); + + /* The example from recsel.c in several variants. */ + if (!recsel_select (se, test_1_getval, "Alfa")) + fail (0, 0); + if (!recsel_select (se, test_1_getval, "Alpha")) + fail (0, 0); + if (recsel_select (se, test_1_getval, "Alfa Test")) + fail (0, 0); + if (recsel_select (se, test_1_getval, "Alpha Test")) + fail (0, 0); + + /* Some modified versions from above. */ + if (!recsel_select (se, test_1_getval, " AlfA Tes")) + fail (0, 0); + if (!recsel_select (se, test_1_getval, " AlfA Tes ")) + fail (0, 0); + if (!recsel_select (se, test_1_getval, " Tes AlfA")) + fail (0, 0); + if (!recsel_select (se, test_1_getval, "TesAlfA")) + fail (0, 0); + + /* Simple cases. */ + if (recsel_select (se, NULL, NULL)) + fail (0, 0); + if (recsel_select (se, test_1_getval, NULL)) + fail (0, 0); + if (recsel_select (se, test_1_getval, "")) + fail (0, 0); + + FREEEXPR(); +} + + +/* Same as test1 but using a combined expression.. */ +static void +run_test_1b (void) +{ + gpg_error_t err; + recsel_expr_t se = NULL; + + err = recsel_parse_expr + (&se, "uid =~ Alfa && uid !~ Test || uid =~ Alpha && uid !~ Test" ); + if (err) + fail (0, err); + + if (debug) + recsel_dump (se); + + /* The example from recsel.c in several variants. */ + if (!recsel_select (se, test_1_getval, "Alfa")) + fail (0, 0); + if (!recsel_select (se, test_1_getval, "Alpha")) + fail (0, 0); + if (recsel_select (se, test_1_getval, "Alfa Test")) + fail (0, 0); + if (recsel_select (se, test_1_getval, "Alpha Test")) + fail (0, 0); + + /* Some modified versions from above. */ + if (!recsel_select (se, test_1_getval, " AlfA Tes")) + fail (0, 0); + if (!recsel_select (se, test_1_getval, " AlfA Tes ")) + fail (0, 0); + if (!recsel_select (se, test_1_getval, " Tes AlfA")) + fail (0, 0); + if (!recsel_select (se, test_1_getval, "TesAlfA")) + fail (0, 0); + + /* Simple cases. */ + if (recsel_select (se, NULL, NULL)) + fail (0, 0); + if (recsel_select (se, test_1_getval, NULL)) + fail (0, 0); + if (recsel_select (se, test_1_getval, "")) + fail (0, 0); + + FREEEXPR(); +} + + +static const char * +test_2_getval (void *cookie, const char *name) +{ + if (!strcmp (name, "uid")) + return "foo@example.org"; + else if (!strcmp (name, "keyid")) + return "0x12345678"; + else if (!strcmp (name, "zero")) + return "0"; + else if (!strcmp (name, "one")) + return "1"; + else if (!strcmp (name, "blanks")) + return " "; + else if (!strcmp (name, "letters")) + return "abcde"; + else + return cookie; +} + +static void +run_test_2 (void) +{ + gpg_error_t err; + recsel_expr_t se = NULL; + + ADDEXPR ("uid = foo@example.org"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("uid = Foo@example.org"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("-c uid = Foo@example.org"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + FREEEXPR(); + ADDEXPR ("uid =~ foo@example.org"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("uid =~ Foo@example.org"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("-c uid =~ Foo@example.org"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + FREEEXPR(); + ADDEXPR ("uid !~ foo@example.org"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("uid !~ Foo@example.org"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("-c uid !~ Foo@example.org"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + FREEEXPR(); + ADDEXPR ("uid =~ @"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("uid =~ @"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + FREEEXPR(); + ADDEXPR ("keyid == 0x12345678"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("keyid != 0x12345678"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("keyid >= 0x12345678"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("keyid <= 0x12345678"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("keyid > 0x12345677"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("keyid < 0x12345679"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + FREEEXPR(); + ADDEXPR ("keyid > 0x12345678"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("keyid < 0x12345678"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + + FREEEXPR(); + ADDEXPR ("uid -n"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("uid -z"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + FREEEXPR(); + ADDEXPR ("nothing -z"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("nothing -n"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + FREEEXPR(); + ADDEXPR ("blanks -n"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("blanks -z"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + FREEEXPR(); + ADDEXPR ("letters -n"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("letters -z"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + + FREEEXPR(); + ADDEXPR ("nothing -f"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("nothing -t"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + FREEEXPR(); + ADDEXPR ("zero -f"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("zero -t"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + FREEEXPR(); + ADDEXPR ("one -t"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("one -f"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + FREEEXPR(); + ADDEXPR ("blanks -f"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("blanks -t"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + FREEEXPR(); + ADDEXPR ("letter -f"); + if (!recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + FREEEXPR(); + ADDEXPR ("letters -t"); + if (recsel_select (se, test_2_getval, NULL)) + fail (0, 0); + + + FREEEXPR(); +} + + + +int +main (int argc, char **argv) +{ + int last_argc = -1; + + log_set_prefix (PGM, GPGRT_LOG_WITH_PREFIX); + init_common_subsystems (&argc, &argv); + + if (argc) + { argc--; argv++; } + while (argc && last_argc != argc ) + { + last_argc = argc; + if (!strcmp (*argv, "--")) + { + argc--; argv++; + break; + } + else if (!strcmp (*argv, "--help")) + { + fputs ("usage: " PGM " [options]\n" + "Options:\n" + " --verbose print timings etc.\n" + " --debug flyswatter\n", + stdout); + exit (0); + } + else if (!strcmp (*argv, "--verbose")) + { + verbose++; + argc--; argv++; + } + else if (!strcmp (*argv, "--debug")) + { + verbose += 2; + debug++; + argc--; argv++; + } + else if (!strncmp (*argv, "--", 2)) + { + log_error ("unknown option '%s'\n", *argv); + exit (2); + } + } + + run_test_1 (); + run_test_1b (); + run_test_2 (); + /* Fixme: We should add test for complex conditions. */ + + return 0; +} diff --git a/common/t-stringhelp.c b/common/t-stringhelp.c index 4f4555e14..ccadf0222 100644 --- a/common/t-stringhelp.c +++ b/common/t-stringhelp.c @@ -223,6 +223,7 @@ test_strconcat (void) fail (0); else if (errno != EINVAL) fail (0); + xfree (out); #if __GNUC__ < 4 /* gcc 4.0 has a sentinel attribute. */ out = strconcat (NULL); @@ -232,6 +233,8 @@ test_strconcat (void) out = strconcat (NULL, NULL); if (!out || *out) fail (1); + xfree (out); + out = strconcat ("", NULL); if (!out || *out) fail (1); @@ -283,6 +286,7 @@ test_xstrconcat (void) "1", "2", "3", "4", "5", "6", "7", NULL); if (!out) fail (0); + xfree (out); #if __GNUC__ < 4 /* gcc 4.0 has a sentinel attribute. */ out = xstrconcat (NULL); @@ -292,6 +296,8 @@ test_xstrconcat (void) out = xstrconcat (NULL, NULL); if (!out) fail (1); + xfree (out); + out = xstrconcat ("", NULL); if (!out || *out) fail (1); @@ -534,6 +540,7 @@ test_strsplit (void) fail (tidx * 1000 + i + 1); } + xfree (fields); xfree (s2); } } diff --git a/common/t-strlist.c b/common/t-strlist.c index b03390593..e49d5a724 100644 --- a/common/t-strlist.c +++ b/common/t-strlist.c @@ -67,6 +67,8 @@ test_strlist_rev (void) fail (2); if (s->next->next->next) fail (2); + + free_strlist (s); } diff --git a/common/zb32.c b/common/zb32.c index 05aa0eac8..54bd5d4fd 100644 --- a/common/zb32.c +++ b/common/zb32.c @@ -35,7 +35,7 @@ #include #include "util.h" - +#include "zb32.h" /* Zooko's base32 variant. See RFC-6189 and http://philzimmermann.com/docs/human-oriented-base-32-encoding.txt diff --git a/configure.ac b/configure.ac index 9f3aeb3d7..7f2ca332f 100644 --- a/configure.ac +++ b/configure.ac @@ -130,6 +130,7 @@ GNUPG_BUILD_PROGRAM(tools, yes) GNUPG_BUILD_PROGRAM(doc, yes) GNUPG_BUILD_PROGRAM(symcryptrun, no) GNUPG_BUILD_PROGRAM(gpgtar, yes) +GNUPG_BUILD_PROGRAM(wks-tools, no) AC_SUBST(PACKAGE) AC_SUBST(PACKAGE_GT) @@ -1670,6 +1671,7 @@ AM_CONDITIONAL(BUILD_TOOLS, test "$build_tools" = "yes") AM_CONDITIONAL(BUILD_DOC, test "$build_doc" = "yes") AM_CONDITIONAL(BUILD_SYMCRYPTRUN, test "$build_symcryptrun" = "yes") AM_CONDITIONAL(BUILD_GPGTAR, test "$build_gpgtar" = "yes") +AM_CONDITIONAL(BUILD_WKS_TOOLS, test "$build_wks_tools" = "yes") AM_CONDITIONAL(ENABLE_CARD_SUPPORT, test "$card_support" = yes) AM_CONDITIONAL(NO_TRUST_MODELS, test "$use_trust_models" = no) @@ -1903,7 +1905,9 @@ tools/gpg-zip tools/Makefile doc/Makefile tests/Makefile +tests/gpgscm/Makefile tests/openpgp/Makefile +tests/migrations/Makefile tests/pkits/Makefile g10/gpg.w32-manifest ]) @@ -1925,6 +1929,7 @@ echo " G13: $build_g13 Dirmngr: $build_dirmngr Gpgtar: $build_gpgtar + WKS tools: $build_wks_tools Protect tool: $show_gnupg_protect_tool_pgm LDAP wrapper: $show_gnupg_dirmngr_ldap_pgm diff --git a/dirmngr/http.c b/dirmngr/http.c index 941ad4f5e..a512e9ad6 100644 --- a/dirmngr/http.c +++ b/dirmngr/http.c @@ -744,7 +744,7 @@ http_session_set_log_cb (http_session_t sess, /* Start a HTTP retrieval and on success store at R_HD a context pointer for completing the request and to wait for the response. - If HTTPHOST is not NULL it is used hor the Host header instead of a + If HTTPHOST is not NULL it is used for the Host header instead of a Host header derived from the URL. */ gpg_error_t http_open (http_t *r_hd, http_req_t reqtype, const char *url, diff --git a/dirmngr/server.c b/dirmngr/server.c index 6eb6f1bef..d3e57c037 100644 --- a/dirmngr/server.c +++ b/dirmngr/server.c @@ -799,9 +799,10 @@ cmd_dns_cert (assuan_context_t ctx, char *line) static const char hlp_wkd_get[] = - "WKD_GET \n" + "WKD_GET [--submission-address] \n" "\n" - "Return the key for from a Web Key Directory.\n"; + "Return the key or the submission address for \n" + "from a Web Key Directory."; static gpg_error_t cmd_wkd_get (assuan_context_t ctx, char *line) { @@ -812,7 +813,9 @@ cmd_wkd_get (assuan_context_t ctx, char *line) char sha1buf[20]; char *uri = NULL; char *encodedhash = NULL; + int opt_submission_addr; + opt_submission_addr = has_option (line, "--submission-address"); line = skip_options (line); mbox = mailbox_from_userid (line); @@ -831,11 +834,21 @@ cmd_wkd_get (assuan_context_t ctx, char *line) goto leave; } - uri = strconcat ("https://", - domain, - "/.well-known/openpgpkey/hu/", - encodedhash, - NULL); + if (opt_submission_addr) + { + uri = strconcat ("https://", + domain, + "/.well-known/openpgpkey/submission-address", + NULL); + } + else + { + uri = strconcat ("https://", + domain, + "/.well-known/openpgpkey/hu/", + encodedhash, + NULL); + } if (!uri) { err = gpg_error_from_syserror (); @@ -848,7 +861,8 @@ cmd_wkd_get (assuan_context_t ctx, char *line) outfp = es_fopencookie (ctx, "w", data_line_cookie_functions); if (!outfp) - err = set_error (GPG_ERR_ASS_GENERAL, "error setting up a data stream"); + err = set_error (GPG_ERR_ASS_GENERAL, + "error setting up a data stream"); else { err = ks_action_fetch (ctrl, uri, outfp); diff --git a/dirmngr/t-ldap-parse-uri.c b/dirmngr/t-ldap-parse-uri.c index 100ce0de8..145b47ab9 100644 --- a/dirmngr/t-ldap-parse-uri.c +++ b/dirmngr/t-ldap-parse-uri.c @@ -222,6 +222,8 @@ check_ldap_escape_filter (int test_count, struct test_ldap_escape_filter *test) test->filter, result, test->result); fail (test_count * 1000); } + + xfree (result); } static void diff --git a/doc/HACKING b/doc/HACKING index d2168d65b..94e65d83b 100644 --- a/doc/HACKING +++ b/doc/HACKING @@ -46,6 +46,8 @@ are - scd :: The scdaemon component - ccid :: The CCID driver in scdaemon - dirmngr :: The dirmngr component + - wks :: The web key service tools + - tools :: Other code in tools - w32 :: Windows related code - po :: Translations - build :: Changes to the build system diff --git a/doc/Makefile.am b/doc/Makefile.am index bc06cd5c1..52ac3987c 100644 --- a/doc/Makefile.am +++ b/doc/Makefile.am @@ -32,7 +32,7 @@ helpfiles = help.txt help.be.txt help.ca.txt help.cs.txt \ help.pt_BR.txt help.ro.txt help.ru.txt help.sk.txt \ help.sv.txt help.tr.txt help.zh_CN.txt help.zh_TW.txt -EXTRA_DIST = samplekeys.asc mksamplekeys \ +EXTRA_DIST = samplekeys.asc mksamplekeys com-certs.pem qualified.txt \ gnupg-logo.eps gnupg-logo.pdf gnupg-logo.png gnupg-logo-tr.png \ gnupg-module-overview.png gnupg-module-overview.pdf \ gnupg-card-architecture.png gnupg-card-architecture.pdf \ @@ -46,7 +46,7 @@ BUILT_SOURCES = gnupg-module-overview.png gnupg-module-overview.pdf \ info_TEXINFOS = gnupg.texi -dist_pkgdata_DATA = qualified.txt com-certs.pem $(helpfiles) +dist_pkgdata_DATA = $(helpfiles) nobase_dist_doc_DATA = FAQ DETAILS HACKING DCO TRANSLATE OpenPGP KEYSERVER \ $(examples) diff --git a/doc/gpg-agent.texi b/doc/gpg-agent.texi index 37774dde2..cd5d7518d 100644 --- a/doc/gpg-agent.texi +++ b/doc/gpg-agent.texi @@ -815,7 +815,7 @@ it by adding this to your init script: @example unset SSH_AGENT_PID if [ "$@{gnupg_SSH_AUTH_SOCK_by:-0@}" -ne $$ ]; then - export SSH_AUTH_SOCK="$@{HOME@}/.gnupg/S.gpg-agent.ssh" + export SSH_AUTH_SOCK="$(gpgconf --list-dirs agent-ssh-socket)" fi @end example @end cartouche diff --git a/doc/gpg.texi b/doc/gpg.texi index be8045066..db110618d 100644 --- a/doc/gpg.texi +++ b/doc/gpg.texi @@ -233,7 +233,7 @@ read from STDIN. If only a one argument is given, it is expected to be a complete signature. With more than 1 argument, the first should be a detached signature -and the remaining files ake up the the signed data. To read the signed +and the remaining files make up the the signed data. To read the signed data from STDIN, use @samp{-} as the second filename. For security reasons a detached signature cannot read the signed material from STDIN without denoting it in the above way. @@ -281,9 +281,10 @@ List all keys from the public keyrings, or just the keys given on the command line. Avoid using the output of this command in scripts or other programs as -it is likely to change as GnuPG changes. See @option{--with-colons} for a -machine-parseable key listing command that is appropriate for use in -scripts and other programs. +it is likely to change as GnuPG changes. See @option{--with-colons} +for a machine-parseable key listing command that is appropriate for +use in scripts and other programs. Never use the regular output for +scripts - it is only for human consumption. @item --list-secret-keys @itemx -K @@ -291,7 +292,7 @@ scripts and other programs. List all keys from the secret keyrings, or just the ones given on the command line. A @code{#} after the letters @code{sec} means that the secret key is not usable (for example, if it was created via -@option{--export-secret-subkeys}). +@option{--export-secret-subkeys}). See also @option{--list-keys}. @item --list-sigs @opindex list-sigs @@ -569,7 +570,7 @@ Use the source, Luke :-). The output format is still subject to change. @item --enarmor -@item --dearmor +@itemx --dearmor @opindex enarmor @opindex dearmor Pack or unpack an arbitrary input into/from an OpenPGP ASCII armor. @@ -1040,6 +1041,15 @@ the interactive sub-command @code{adduid} of @option{--edit-key} the white space removed, it is expected to be UTF-8 encoded, and no checks on its form are applied. +@item --quick-revuid @var{user-id} @var{user-id-to-revoke} +@opindex quick-revuid +This command revokes a User ID on an existing key. It cannot be used +to revoke the last User ID on key (some non-revoked User ID must +remain), with revocation reason ``User ID is no longer valid''. If +you want to specify a different revocation reason, or to supply +supplementary revocation text, you should use the interactive +sub-command @code{revuid} of @option{--edit-key}. + @item --passwd @var{user_id} @opindex passwd Change the passphrase of the secret key belonging to the certificate @@ -1361,6 +1371,10 @@ Note that this adds a keyring to the current list. If the intent is to use the specified keyring alone, use @option{--keyring} along with @option{--no-default-keyring}. +If the the option @option{--no-keyring} has been used no keyrings will +be used at all. + + @item --secret-keyring @code{file} @opindex secret-keyring This is an obsolete option and ignored. All secret keys are stored in @@ -2023,6 +2037,22 @@ limited countermeasure against traffic analysis. If this option or @option{--recipient} is not specified, GnuPG asks for the user ID unless @option{--default-recipient} is given. +@item --recipient-file @var{file} +@itemx -f +@opindex recipient-file +This option is similar to @option{--recipient} except that it +encrypts to a key stored in the given file. @var{file} must be the +name of a file containing exactly one key. @command{gpg} assumes that +the key in this file is fully valid. + +@item --hidden-recipient-file @var{file} +@itemx -F +@opindex hidden-recipient-file +This option is similar to @option{--hidden-recipient} except that it +encrypts to a key stored in the given file. @var{file} must be the +name of a file containing exactly one key. @command{gpg} assumes that +the key in this file is fully valid. + @item --encrypt-to @code{name} @opindex encrypt-to Same as @option{--recipient} but this one is intended for use in the @@ -2041,11 +2071,6 @@ recipients given either by use of @option{--recipient} or by the asked user id. No trust checking is performed for these user ids and even disabled keys can be used. -@item --encrypt-to-default-key -@opindex encrypt-to-default-key -If the default secret key is taken from @option{--default-key}, then -also encrypt to that key. - @item --no-encrypt-to @opindex no-encrypt-to Disable the use of all @option{--encrypt-to} and @@ -2179,6 +2204,18 @@ opposite meaning. The options are: subkey. Defaults to no for regular @option{--import} and to yes for keyserver @option{--recv-keys}. + @item import-show + Show a listing of the key as imported right before it is stored. + This can be combined with the option @option{--dry-run} to only look + at keys. + + @item import-export + Run the entire import code but instead of storing the key to the + local keyring write it to the output. The export options + @option{export-pka} and @option{export-dane} affect the output. This + option can be used to remove all invalid parts from a key without the + need to store it. + @item merge-only During import, allow key updates to existing keys, but do not allow any new keys to be imported. Defaults to no. @@ -2198,6 +2235,47 @@ opposite meaning. The options are: Defaults to no. @end table +@item --import-filter @code{@var{name}=@var{expr}} +@itemx --export-filter @code{@var{name}=@var{expr}} +@opindex import-filter +@opindex export-filter +These options define an import/export filter which are applied to the +imported/exported keyblock right before it will be stored/written. +@var{name} defines the type of filter to use, @var{expr} the +expression to evaluate. The option can be used several times which +then appends more expression to the same @var{name}. + +@noindent +The available filter types are: + +@table @asis + + @item keep-uid + This filter will keep a user id packet and its dependent packets in + the keyblock if the expression evaluates to true. + +@end table + +For the syntax of the expression see the chapter "FILTER EXPRESSIONS". +The property names for the expressions depend on the actual filter +type and are indicated in the following table. + +The available properties are: + +@table @asis + + @item uid + A string with the user id. (keep-uid) + + @item mbox + The addr-spec part of a user id with mailbox or the empty string. + (keep-uid) + + @item primary + Boolean indicating whether the user id is the primary one. (keep-uid) + +@end table + @item --export-options @code{parameters} @opindex export-options This is a space or comma delimited string that gives options for @@ -2244,6 +2322,18 @@ opposite meaning. The options are: most recent self-signature on each user ID. This option is the same as running the @option{--edit-key} command "minimize" before export except that the local copy of the key is not modified. Defaults to no. + + @item export-pka + Instead of outputting the key material output PKA records suitable + to put into DNS zone files. An ORIGIN line is printed before each + record to allow diverting the records to the corresponding zone file. + + @item export-dane + Instead of outputting the key material output OpenPGP DANE records + suitable to put into DNS zone files. An ORIGIN line is printed before + each record to allow diverting the records to the corresponding zone + file. + @end table @item --with-colons @@ -2463,6 +2553,13 @@ Reset all packet, cipher and digest options to strict RFC-4880 behavior. Note that this is currently the same thing as @option{--openpgp}. +@item --rfc4880bis +@opindex rfc4880bis +Enable experimental features from proposed updates to RFC-4880. This +option can be used in addition to the other compliance options. +Warning: The behavior may change with any GnuPG release and created +keys or data may not be usable with future GnuPG versions. + @item --rfc2440 @opindex rfc2440 Reset all packet, cipher and digest options to strict RFC-2440 @@ -2940,6 +3037,10 @@ and do not provide alternate keyrings via @option{--keyring} or @option{--secret-keyring}, then GnuPG will still use the default public or secret keyrings. +@item --no-keyring +@opindex no-keyring +Do not add use any keyrings even if specified as options. + @item --skip-verify @opindex skip-verify Skip the signature verification step. This may be @@ -3170,7 +3271,6 @@ current home directory (@pxref{option --homedir}). @end table -@c man:.RE Note that on larger installations, it is useful to put predefined files into the directory @file{@value{SYSCONFSKELDIR}} so that newly created users start up with a working configuration. @@ -3245,7 +3345,6 @@ files; They all live in in the current home directory (@pxref{option @end table -@c man:.RE Operation is further controlled by a few environment variables: @table @asis @@ -3338,6 +3437,123 @@ user for the filename. @include specify-user-id.texi @end ifset +@mansect filter expressions +@chapheading FILTER EXPRESSIONS + +The options @option{--import-filter} and @option{--export-filter} use +expressions with this syntax (square brackets indicate an optional +part and curly braces a repetition, white space between the elements +are allowed): + +@c man:.RS +@example + [lc] @{[@{flag@}] PROPNAME op VALUE [lc]@} +@end example +@c man:.RE + +The name of a property (@var{PROPNAME}) may only consist of letters, +digits and underscores. The description for the filter type +describes which properties are defined. If an undefined property is +used it evaluates to the empty string. Unless otherwise noted, the +@var{VALUE} must always be given and may not be the empty string. No +quoting is defined for the value, thus the value may not contain the +strings @code{&&} or @code{||}, which are used as logical connection +operators. The flag @code{--} can be used to remove this restriction. + +Numerical values are computed as long int; standard C notation +applies. @var{lc} is the logical connection operator; either +@code{&&} for a conjunction or @code{||} for a disjunction. A +conjunction is assumed at the begin of an expression. Conjunctions +have higher precedence than disjunctions. If @var{VALUE} starts with +one of the characters used in any @var{op} a space after the +@var{op} is required. + +@noindent +The supported operators (@var{op}) are: + +@table @asis + + @item =~ + Substring must match. + + @item !~ + Substring must not match. + + @item = + The full string must match. + + @item <> + The full string must not match. + + @item == + The numerical value must match. + + @item != + The numerical value must not match. + + @item <= + The numerical value of the field must be LE than the value. + + @item < + The numerical value of the field must be LT than the value. + + @item >= + The numerical value of the field must be GT than the value. + + @item >= + The numerical value of the field must be GE than the value. + + @item -n + True if value is not empty (no value allowed). + + @item -z + True if value is empty (no value allowed). + + @item -t + Alias for "PROPNAME != 0" (no value allowed). + + @item -f + Alias for "PROPNAME == 0" (no value allowed). + +@end table + +@noindent +Values for @var{flag} must be space separated. The supported flags +are: + +@table @asis + @item -- + @var{VALUE} spans to the end of the expression. + @item -c + The string match in this part is done case-sensitive. +@end table + +The filter options concatenate several specifications for a filter of +the same type. For example the four options in this example: + +@c man:.RS +@example + --import-option keep-uid="uid =~ Alfa" + --import-option keep-uid="&& uid !~ Test" + --import-option keep-uid="|| uid =~ Alpha" + --import-option keep-uid="uid !~ Test" +@end example +@c man:.RE + +@noindent +which is equivalent to + +@c man:.RS +@example + --import-option \ + keep-uid="uid =~ Alfa" && uid !~ Test" || uid =~ Alpha" && "uid !~ Test" +@end example +@c man:.RE + +imports only the user ids of a key containing the strings "Alfa" +or "Alpha" but not the string "test". + + @mansect return value @chapheading RETURN VALUE diff --git a/doc/mkdefsinc.c b/doc/mkdefsinc.c index f3e2f35c7..b8fbed6e9 100644 --- a/doc/mkdefsinc.c +++ b/doc/mkdefsinc.c @@ -140,6 +140,27 @@ get_date_from_files (char **files) } +/* We need to escape file names for Texinfo. */ +static void +print_filename (const char *prefix, const char *name) +{ + const char *s; + + fputs (prefix, stdout); + for (s=name; *s; s++) + switch (*s) + { + case '@': fputs ("@atchar{}", stdout); break; + case '{': fputs ("@lbracechar{}", stdout); break; + case '}': fputs ("@rbracechar{}", stdout); break; + case ',': fputs ("@comma{}", stdout); break; + case '\\':fputs ("@backslashchar{}", stdout); break; + case '#': fputs ("@hashchar{}", stdout); break; + default: putchar (*s); break; + } + putchar('\n'); +} + int main (int argc, char **argv) @@ -288,17 +309,16 @@ main (int argc, char **argv) fputs ("\n@c Directories\n\n", stdout); - fputs ("@set BINDIR " GNUPG_BINDIR "\n" - "@set LIBEXECDIR " GNUPG_LIBEXECDIR "\n" - "@set LIBDIR " GNUPG_LIBDIR "\n" - "@set DATADIR " GNUPG_DATADIR "\n" - "@set SYSCONFDIR " GNUPG_SYSCONFDIR "\n" - "@set LOCALSTATEDIR " GNUPG_LOCALSTATEDIR "\n" - "@set LOCALCACHEDIR " GNUPG_LOCALSTATEDIR - /* */ "/cache/" PACKAGE_NAME "\n" - "@set LOCALRUNDIR " GNUPG_LOCALSTATEDIR - /* */ "/run/" PACKAGE_NAME "\n" - , stdout); + print_filename ("@set BINDIR ", GNUPG_BINDIR ); + print_filename ("@set LIBEXECDIR ", GNUPG_LIBEXECDIR ); + print_filename ("@set LIBDIR ", GNUPG_LIBDIR ); + print_filename ("@set DATADIR ", GNUPG_DATADIR ); + print_filename ("@set SYSCONFDIR ", GNUPG_SYSCONFDIR ); + print_filename ("@set LOCALSTATEDIR ", GNUPG_LOCALSTATEDIR ); + print_filename ("@set LOCALCACHEDIR ", (GNUPG_LOCALSTATEDIR + "/cache/" PACKAGE_NAME)); + print_filename ("@set LOCALRUNDIR ", (GNUPG_LOCALSTATEDIR + "/run/" PACKAGE_NAME)); p = xstrdup (GNUPG_SYSCONFDIR); pend = strrchr (p, '/'); diff --git a/doc/tools.texi b/doc/tools.texi index 8fdaa96a7..577df8ea1 100644 --- a/doc/tools.texi +++ b/doc/tools.texi @@ -280,7 +280,7 @@ Check the options for the component @var{component}. Update all configuration files with values taken from the global configuration file (usually @file{/etc/gnupg/gpgconf.conf}). -@item --list-dirs +@item --list-dirs [@var{names}] Lists the directories used by @command{gpgconf}. One directory is listed per line, and each line consists of a colon-separated list where the first field names the directory type (for example @code{sysconfdir}) @@ -288,7 +288,9 @@ and the second field contains the percent-escaped directory. Although they are not directories, the socket file names used by @command{gpg-agent} and @command{dirmngr} are printed as well. Note that the socket file names and the @code{homedir} lines are the default -names and they may be overridden by command line switches. +names and they may be overridden by command line switches. If +@var{names} are given only the directories or file names specified by +the list names are printed without any escaping. @item --list-config [@var{filename}] List the global configuration file in a colon separated format. If diff --git a/doc/yat2m.c b/doc/yat2m.c index 3de908c3b..9b76f194b 100644 --- a/doc/yat2m.c +++ b/doc/yat2m.c @@ -1,5 +1,5 @@ /* yat2m.c - Yet Another Texi 2 Man converter - * Copyright (C) 2005, 2013, 2015 g10 Code GmbH + * Copyright (C) 2005, 2013, 2015, 2016 g10 Code GmbH * Copyright (C) 2006, 2008, 2011 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify @@ -13,7 +13,7 @@ * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License - * along with this program; if not, see . + * along with this program; if not, see . */ /* @@ -104,6 +104,29 @@ #include +#if __GNUC__ +# define MY_GCC_VERSION (__GNUC__ * 10000 \ + + __GNUC_MINOR__ * 100 \ + + __GNUC_PATCHLEVEL__) +#else +# define MY_GCC_VERSION 0 +#endif + +#if MY_GCC_VERSION >= 20500 +# define ATTR_PRINTF(f, a) __attribute__ ((format(printf,f,a))) +# define ATTR_NR_PRINTF(f, a) __attribute__ ((noreturn, format(printf,f,a))) +#else +# define ATTR_PRINTF(f, a) +# define ATTR_NR_PRINTF(f, a) +#endif +#if MY_GCC_VERSION >= 30200 +# define ATTR_MALLOC __attribute__ ((__malloc__)) +#else +# define ATTR_MALLOC +#endif + + + #define PGM "yat2m" #define VERSION "1.0" @@ -214,8 +237,16 @@ static const char * const standard_sections[] = static void proc_texi_buffer (FILE *fp, const char *line, size_t len, int *table_level, int *eol_action); +static void die (const char *format, ...) ATTR_NR_PRINTF(1,2); +static void err (const char *format, ...) ATTR_PRINTF(1,2); +static void inf (const char *format, ...) ATTR_PRINTF(1,2); +static void *xmalloc (size_t n) ATTR_MALLOC; +static void *xcalloc (size_t n, size_t m) ATTR_MALLOC; + +/*-- Functions --*/ + /* Print diagnostic message and exit with failure. */ static void die (const char *format, ...) @@ -558,7 +589,7 @@ get_section_buffer (const char *name) for (i=0; i < thepage.n_sections; i++) if (!thepage.sections[i].name) break; - if (i < thepage.n_sections) + if (thepage.n_sections && i < thepage.n_sections) sect = thepage.sections + i; else { @@ -715,7 +746,7 @@ proc_texi_cmd (FILE *fp, const char *command, const char *rest, size_t len, { "subsection", 6, "\n.SS " }, { "chapheading", 0}, { "item", 2, ".TP\n.B " }, - { "itemx", 2, ".TP\n.B " }, + { "itemx", 2, ".TQ\n.B " }, { "table", 3 }, { "itemize", 3 }, { "bullet", 0, "* " }, @@ -762,6 +793,8 @@ proc_texi_cmd (FILE *fp, const char *command, const char *rest, size_t len, { if ((*table_level)-- > 1) fputs (".RE\n", fp); + else + fputs (".P\n", fp); } else if (n >= 7 && !memcmp (s, "example", 7) && (!n || s[7] == ' ' || s[7] == '\t' || s[7] == '\n')) @@ -853,7 +886,7 @@ proc_texi_cmd (FILE *fp, const char *command, const char *rest, size_t len, } else inf ("texinfo command '%s' not supported (%.*s)", command, - ((s = memchr (rest, '\n', len)), (s? (s-rest) : len)), rest); + (int)((s = memchr (rest, '\n', len)), (s? (s-rest) : len)), rest); } if (*rest == '{') @@ -965,7 +998,7 @@ proc_texi_buffer (FILE *fp, const char *line, size_t len, assert (n <= len); s += n; len -= n; s--; len++; - in_cmd = 0; + /* in_cmd = 0; -- doc only */ } } diff --git a/g10/armor.c b/g10/armor.c index fb7465595..9e58520a3 100644 --- a/g10/armor.c +++ b/g10/armor.c @@ -190,13 +190,18 @@ initialize(void) is_initialized=1; } -/**************** - * Check whether this is an armored file or not See also + +/* + * Check whether this is an armored file. See also * parse-packet.c for details on this code. + * + * Note that the buffer BUF needs to be at least 2 bytes long. If in + * doubt that the second byte to 0. + * * Returns: True if it seems to be armored */ static int -is_armored( const byte *buf ) +is_armored (const byte *buf) { int ctb, pkttype; int indeterminate_length_allowed; @@ -274,15 +279,17 @@ is_armored( const byte *buf ) int use_armor_filter( IOBUF a ) { - byte buf[1]; + byte buf[2]; int n; /* fixme: there might be a problem with iobuf_peek */ - n = iobuf_peek(a, buf, 1 ); + n = iobuf_peek (a, buf, 2); if( n == -1 ) return 0; /* EOF, doesn't matter whether armored or not */ if( !n ) return 1; /* can't check it: try armored */ + if (n != 2) + return 0; /* short buffer */ return is_armored(buf); } @@ -530,7 +537,7 @@ check_input( armor_filter_context_t *afx, IOBUF a ) /* (the line is always a C string but maybe longer) */ if( *line == '\n' || ( len && (*line == '\r' && line[1]=='\n') ) ) ; - else if( !is_armored( line ) ) { + else if (len >= 2 && !is_armored (line)) { afx->inp_checked = 1; afx->inp_bypass = 1; return 0; @@ -1409,8 +1416,9 @@ unarmor_pump (UnarmorPump x, int c) switch (x->state) { case STA_init: { - byte tmp[1]; + byte tmp[2]; tmp[0] = c; + tmp[1] = 0; if ( is_armored (tmp) ) x->state = c == '-'? STA_first_dash : STA_wait_newline; else { diff --git a/g10/build-packet.c b/g10/build-packet.c index 2745734b4..86d42efe1 100644 --- a/g10/build-packet.c +++ b/g10/build-packet.c @@ -635,6 +635,7 @@ do_plaintext( IOBUF out, int ctb, PKT_plaintext *pt ) write_header(out, ctb, calc_plaintext( pt ) ); log_assert (pt->mode == 'b' || pt->mode == 't' || pt->mode == 'u' + || pt->mode == 'm' || pt->mode == 'l' || pt->mode == '1'); iobuf_put(out, pt->mode ); iobuf_put(out, pt->namelen ); @@ -972,28 +973,49 @@ build_sig_subpkt (PKT_signature *sig, sigsubpkttype_t type, sig->unhashed = newarea; } -/**************** +/* * Put all the required stuff from SIG into subpackets of sig. + * PKSK is the signing key. * Hmmm, should we delete those subpackets which are in a wrong area? */ void -build_sig_subpkt_from_sig( PKT_signature *sig ) +build_sig_subpkt_from_sig (PKT_signature *sig, PKT_public_key *pksk) { u32 u; - byte buf[8]; + byte buf[1+MAX_FINGERPRINT_LEN]; + size_t fprlen; - u = sig->keyid[0]; - buf[0] = (u >> 24) & 0xff; - buf[1] = (u >> 16) & 0xff; - buf[2] = (u >> 8) & 0xff; - buf[3] = u & 0xff; - u = sig->keyid[1]; - buf[4] = (u >> 24) & 0xff; - buf[5] = (u >> 16) & 0xff; - buf[6] = (u >> 8) & 0xff; - buf[7] = u & 0xff; - build_sig_subpkt( sig, SIGSUBPKT_ISSUER, buf, 8 ); + /* For v4 keys we need to write the ISSUER subpacket. We do not + * want that for a future v5 format. */ + if (pksk->version < 5) + { + u = sig->keyid[0]; + buf[0] = (u >> 24) & 0xff; + buf[1] = (u >> 16) & 0xff; + buf[2] = (u >> 8) & 0xff; + buf[3] = u & 0xff; + u = sig->keyid[1]; + buf[4] = (u >> 24) & 0xff; + buf[5] = (u >> 16) & 0xff; + buf[6] = (u >> 8) & 0xff; + buf[7] = u & 0xff; + build_sig_subpkt (sig, SIGSUBPKT_ISSUER, buf, 8); + } + /* For a future v5 keys we write the ISSUER_FPR subpacket. We + * also write that for a v4 key is experimental support for + * RFC4880bis is requested. */ + if (pksk->version > 4 || opt.flags.rfc4880bis) + { + fingerprint_from_pk (pksk, buf+1, &fprlen); + if (fprlen == 20) + { + buf[0] = pksk->version; + build_sig_subpkt (sig, SIGSUBPKT_ISSUER_FPR, buf, 21); + } + } + + /* Write the timestamp. */ u = sig->timestamp; buf[0] = (u >> 24) & 0xff; buf[1] = (u >> 16) & 0xff; diff --git a/g10/card-util.c b/g10/card-util.c index be1a593e9..2cb44f996 100644 --- a/g10/card-util.c +++ b/g10/card-util.c @@ -733,28 +733,18 @@ fetch_url (ctrl_t ctrl) log_error("error retrieving URL from card: %s\n",gpg_strerror(rc)); else { - struct keyserver_spec *spec=NULL; - rc=agent_scd_getattr("KEY-FPR",&info); if(rc) log_error("error retrieving key fingerprint from card: %s\n", gpg_strerror(rc)); else if (info.pubkey_url && *info.pubkey_url) - { - spec = parse_keyserver_uri (info.pubkey_url, 1); - if(spec && info.fpr1valid) - { - /* This is not perfectly right. Currently, all card - fingerprints are 20 digits, but what about - fingerprints for a future v5 key? We should get the - length from somewhere lower in the code. In any - event, the fpr/keyid is not meaningful for straight - HTTP fetches, but using it allows the card to point - to HKP and LDAP servers as well. */ - rc = keyserver_import_fprint (ctrl, info.fpr1, 20, spec); - free_keyserver_spec(spec); - } - } + { + strlist_t sl = NULL; + + add_to_strlist (&sl, info.pubkey_url); + rc = keyserver_fetch (ctrl, sl); + free_strlist (sl); + } else if (info.fpr1valid) { rc = keyserver_import_fprint (ctrl, info.fpr1, 20, opt.keyserver); diff --git a/g10/compress.c b/g10/compress.c index bdddef134..c34beecf7 100644 --- a/g10/compress.c +++ b/g10/compress.c @@ -295,6 +295,10 @@ compress_filter( void *opaque, int control, static void release_context (compress_filter_context_t *ctx) { + xfree(ctx->inbuf); + ctx->inbuf = NULL; + xfree(ctx->outbuf); + ctx->outbuf = NULL; xfree (ctx); } diff --git a/g10/encrypt.c b/g10/encrypt.c index 57d24bef1..54a17c31e 100644 --- a/g10/encrypt.c +++ b/g10/encrypt.c @@ -335,7 +335,7 @@ encrypt_simple (const char *filename, int mode, int use_seskey) { /* Note that PT has been initialized above in !no_literal mode. */ pt->timestamp = make_timestamp(); - pt->mode = opt.textmode? 't' : 'b'; + pt->mode = opt.mimemode? 'm' : opt.textmode? 't' : 'b'; pt->len = filesize; pt->new_ctb = !pt->len; pt->buf = inp; @@ -674,7 +674,7 @@ encrypt_crypt (ctrl_t ctrl, int filefd, const char *filename, if (!opt.no_literal) { pt->timestamp = make_timestamp(); - pt->mode = opt.textmode ? 't' : 'b'; + pt->mode = opt.mimemode? 'm' : opt.textmode ? 't' : 'b'; pt->len = filesize; pt->new_ctb = !pt->len; pt->buf = inp; diff --git a/g10/export.c b/g10/export.c index b067376e1..92235fbf6 100644 --- a/g10/export.c +++ b/g10/export.c @@ -35,6 +35,10 @@ #include "i18n.h" #include "membuf.h" #include "host2net.h" +#include "zb32.h" +#include "recsel.h" +#include "mbox-util.h" +#include "init.h" #include "trustdb.h" #include "call-agent.h" @@ -56,6 +60,16 @@ struct export_stats_s }; +/* A global variable to store the selector created from + * --export-filter keep-uid=EXPR. + * + * FIXME: We should put this into the CTRL object but that requires a + * lot more changes right now. + */ +static recsel_expr_t export_keep_uid; + + + /* Local prototypes. */ static int do_export (ctrl_t ctrl, strlist_t users, int secret, unsigned int options, export_stats_t stats); @@ -63,8 +77,18 @@ static int do_export_stream (ctrl_t ctrl, iobuf_t out, strlist_t users, int secret, kbnode_t *keyblock_out, unsigned int options, export_stats_t stats, int *any); +static gpg_error_t print_pka_or_dane_records +/**/ (iobuf_t out, kbnode_t keyblock, PKT_public_key *pk, + const void *data, size_t datalen, + int print_pka, int print_dane); +static void +cleanup_export_globals (void) +{ + recsel_release (export_keep_uid); + export_keep_uid = NULL; +} /* Option parser for export options. See parse_options fro @@ -84,6 +108,10 @@ parse_export_options(char *str,unsigned int *options,int noisy) N_("remove unusable parts from key during export")}, {"export-minimal",EXPORT_MINIMAL|EXPORT_CLEAN,NULL, N_("remove as much as possible from key during export")}, + + {"export-pka", EXPORT_PKA_FORMAT, NULL, NULL }, + {"export-dane", EXPORT_DANE_FORMAT, NULL, NULL }, + /* Aliases for backward compatibility */ {"include-local-sigs",EXPORT_LOCAL_SIGS,NULL,NULL}, {"include-attributes",EXPORT_ATTRIBUTES,NULL,NULL}, @@ -100,6 +128,38 @@ parse_export_options(char *str,unsigned int *options,int noisy) } +/* Parse and set an export filter from string. STRING has the format + * "NAME=EXPR" with NAME being the name of the filter. Spaces before + * and after NAME are not allowed. If this function is called several + * times all expressions for the same NAME are concatenated. + * Supported filter names are: + * + * - keep-uid :: If the expression evaluates to true for a certain + * user ID packet, that packet and all it dependencies + * will be exported. The expression may use these + * variables: + * + * - uid :: The entire user ID. + * - mbox :: The mail box part of the user ID. + * - primary :: Evaluate to true for the primary user ID. + */ +gpg_error_t +parse_and_set_export_filter (const char *string) +{ + gpg_error_t err; + + /* Auto register the cleanup function. */ + register_mem_cleanup_func (cleanup_export_globals); + + if (!strncmp (string, "keep-uid=", 9)) + err = recsel_parse_expr (&export_keep_uid, string+9); + else + err = gpg_error (GPG_ERR_INV_NAME); + + return err; +} + + /* Create a new export stats object initialized to zero. On error returns NULL and sets ERRNO. */ export_stats_t @@ -265,7 +325,7 @@ do_export (ctrl_t ctrl, strlist_t users, int secret, unsigned int options, if (rc) return rc; - if ( opt.armor ) + if ( opt.armor && !(options & (EXPORT_PKA_FORMAT|EXPORT_DANE_FORMAT)) ) { afx = new_armor_context (); afx->what = secret? 5 : 1; @@ -1147,8 +1207,567 @@ receive_seckey_from_agent (ctrl_t ctrl, gcry_cipher_hd_t cipherhd, } +/* Write KEYBLOCK either to stdout or to the file set with the + * --output option. This is a simplified version of do_export_stream + * which supports only a few export options. */ +gpg_error_t +write_keyblock_to_output (kbnode_t keyblock, int with_armor, + unsigned int options) +{ + gpg_error_t err; + const char *fname; + iobuf_t out; + kbnode_t node; + armor_filter_context_t *afx = NULL; + iobuf_t out_help = NULL; + PKT_public_key *pk = NULL; + + fname = opt.outfile? opt.outfile : "-"; + if (is_secured_filename (fname) ) + return gpg_error (GPG_ERR_EPERM); + + out = iobuf_create (fname, 0); + if (!out) + { + err = gpg_error_from_syserror (); + log_error(_("can't create '%s': %s\n"), fname, gpg_strerror (err)); + return err; + } + if (opt.verbose) + log_info (_("writing to '%s'\n"), iobuf_get_fname_nonnull (out)); + + if ((options & (EXPORT_PKA_FORMAT|EXPORT_DANE_FORMAT))) + { + with_armor = 0; + out_help = iobuf_temp (); + } + + if (with_armor) + { + afx = new_armor_context (); + afx->what = 1; + push_armor_filter (afx, out); + } + + for (node = keyblock; node; node = node->next) + { + if (is_deleted_kbnode (node) || node->pkt->pkttype == PKT_RING_TRUST) + continue; + if (!pk && (node->pkt->pkttype == PKT_PUBLIC_KEY + || node->pkt->pkttype == PKT_SECRET_KEY)) + pk = node->pkt->pkt.public_key; + + err = build_packet (out_help? out_help : out, node->pkt); + if (err) + { + log_error ("build_packet(%d) failed: %s\n", + node->pkt->pkttype, gpg_strerror (err) ); + goto leave; + } + } + err = 0; + + if (out_help && pk) + { + const void *data; + size_t datalen; + + iobuf_flush_temp (out_help); + data = iobuf_get_temp_buffer (out_help); + datalen = iobuf_get_temp_length (out_help); + + err = print_pka_or_dane_records (out, + keyblock, pk, data, datalen, + (options & EXPORT_PKA_FORMAT), + (options & EXPORT_DANE_FORMAT)); + } + + leave: + if (err) + iobuf_cancel (out); + else + iobuf_close (out); + iobuf_cancel (out_help); + release_armor_context (afx); + return err; +} + + +/* Helper for apply_keep_uid_filter. */ +static const char * +filter_getval (void *cookie, const char *propname) +{ + kbnode_t node = cookie; + const char *result; + + if (node->pkt->pkttype == PKT_USER_ID) + { + if (!strcmp (propname, "uid")) + result = node->pkt->pkt.user_id->name; + else if (!strcmp (propname, "mbox")) + { + if (!node->pkt->pkt.user_id->mbox) + { + node->pkt->pkt.user_id->mbox + = mailbox_from_userid (node->pkt->pkt.user_id->name); + } + return node->pkt->pkt.user_id->mbox; + } + else if (!strcmp (propname, "primary")) + result = node->pkt->pkt.user_id->is_primary? "1":"0"; + else + result = NULL; + } + else + result = NULL; + + return result; +} + +/* + * Apply the keep-uid filter to the keyblock. The deleted nodes are + * marked and thus the caller should call commit_kbnode afterwards. + * KEYBLOCK must not have any blocks marked as deleted. + */ +static void +apply_keep_uid_filter (kbnode_t keyblock, recsel_expr_t selector) +{ + kbnode_t node; + + for (node = keyblock->next; node; node = node->next ) + { + if (node->pkt->pkttype == PKT_USER_ID) + { + if (!recsel_select (selector, filter_getval, node)) + { + /* log_debug ("keep-uid: deleting '%s'\n", */ + /* node->pkt->pkt.user_id->name); */ + /* The UID packet and all following packets up to the + * next UID or a subkey. */ + delete_kbnode (node); + for (; node->next + && node->next->pkt->pkttype != PKT_USER_ID + && node->next->pkt->pkttype != PKT_PUBLIC_SUBKEY + && node->next->pkt->pkttype != PKT_SECRET_SUBKEY ; + node = node->next) + delete_kbnode (node->next); + } + /* else */ + /* log_debug ("keep-uid: keeping '%s'\n", */ + /* node->pkt->pkt.user_id->name); */ + } + } +} + + +/* Print DANE or PKA records for all user IDs in KEYBLOCK to OUT. The + * data for the record is taken from (DATA,DATELEN). PK is the public + * key packet with the primary key. */ +static gpg_error_t +print_pka_or_dane_records (iobuf_t out, kbnode_t keyblock, PKT_public_key *pk, + const void *data, size_t datalen, + int print_pka, int print_dane) +{ + gpg_error_t err = 0; + kbnode_t kbctx, node; + PKT_user_id *uid; + char *mbox = NULL; + char hashbuf[32]; + char *hash = NULL; + char *domain; + const char *s; + unsigned int len; + estream_t fp = NULL; + char *hexdata = NULL; + char *hexfpr; + + hexfpr = hexfingerprint (pk, NULL, 0); + hexdata = bin2hex (data, datalen, NULL); + if (!hexdata) + { + err = gpg_error_from_syserror (); + goto leave; + } + ascii_strlwr (hexdata); + fp = es_fopenmem (0, "rw,samethread"); + if (!fp) + { + err = gpg_error_from_syserror (); + goto leave; + } + + for (kbctx = NULL; (node = walk_kbnode (keyblock, &kbctx, 0));) + { + if (node->pkt->pkttype != PKT_USER_ID) + continue; + uid = node->pkt->pkt.user_id; + + if (uid->is_expired || uid->is_revoked) + continue; + + xfree (mbox); + mbox = mailbox_from_userid (uid->name); + if (!mbox) + continue; + + domain = strchr (mbox, '@'); + *domain++ = 0; + + if (print_pka) + { + es_fprintf (fp, "$ORIGIN _pka.%s.\n; %s\n; ", domain, hexfpr); + print_utf8_buffer (fp, uid->name, uid->len); + es_putc ('\n', fp); + gcry_md_hash_buffer (GCRY_MD_SHA1, hashbuf, mbox, strlen (mbox)); + xfree (hash); + hash = zb32_encode (hashbuf, 8*20); + if (!hash) + { + err = gpg_error_from_syserror (); + goto leave; + } + len = strlen (hexfpr)/2; + es_fprintf (fp, "%s TYPE37 \\# %u 0006 0000 00 %02X %s\n\n", + hash, 6 + len, len, hexfpr); + } + + if (print_dane && hexdata) + { + es_fprintf (fp, "$ORIGIN _openpgpkey.%s.\n; %s\n; ", domain, hexfpr); + print_utf8_buffer (fp, uid->name, uid->len); + es_putc ('\n', fp); + gcry_md_hash_buffer (GCRY_MD_SHA256, hashbuf, mbox, strlen (mbox)); + xfree (hash); + hash = bin2hex (hashbuf, 28, NULL); + if (!hash) + { + err = gpg_error_from_syserror (); + goto leave; + } + ascii_strlwr (hash); + len = strlen (hexdata)/2; + es_fprintf (fp, "%s TYPE61 \\# %u (\n", hash, len); + for (s = hexdata; ;) + { + es_fprintf (fp, "\t%.64s\n", s); + if (strlen (s) < 64) + break; + s += 64; + } + es_fputs ("\t)\n\n", fp); + } + } + + /* Make sure it is a string and write it. */ + es_fputc (0, fp); + { + void *vp; + + if (es_fclose_snatch (fp, &vp, NULL)) + { + err = gpg_error_from_syserror (); + goto leave; + } + fp = NULL; + iobuf_writestr (out, vp); + es_free (vp); + } + err = 0; + + leave: + xfree (hash); + xfree (mbox); + es_fclose (fp); + xfree (hexdata); + xfree (hexfpr); + return err; +} + + +/* Helper for do_export_stream which writes one keyblock to OUT. */ +static gpg_error_t +do_export_one_keyblock (ctrl_t ctrl, kbnode_t keyblock, u32 *keyid, + iobuf_t out, int secret, unsigned int options, + export_stats_t stats, int *any, + KEYDB_SEARCH_DESC *desc, size_t ndesc, + size_t descindex, gcry_cipher_hd_t cipherhd) +{ + gpg_error_t err; + char *cache_nonce = NULL; + subkey_list_t subkey_list = NULL; /* Track already processed subkeys. */ + int skip_until_subkey = 0; + int cleartext = 0; + char *hexgrip = NULL; + char *serialno = NULL; + PKT_public_key *pk; + u32 subkidbuf[2], *subkid; + kbnode_t kbctx, node; + + for (kbctx=NULL; (node = walk_kbnode (keyblock, &kbctx, 0)); ) + { + if (skip_until_subkey) + { + if (node->pkt->pkttype == PKT_PUBLIC_SUBKEY) + skip_until_subkey = 0; + else + continue; + } + + /* We used to use comment packets, but not any longer. In + * case we still have comments on a key, strip them here + * before we call build_packet(). */ + if (node->pkt->pkttype == PKT_COMMENT) + continue; + + /* Make sure that ring_trust packets never get exported. */ + if (node->pkt->pkttype == PKT_RING_TRUST) + continue; + + /* If exact is set, then we only export what was requested + * (plus the primary key, if the user didn't specifically + * request it). */ + if (desc[descindex].exact && node->pkt->pkttype == PKT_PUBLIC_SUBKEY) + { + if (!exact_subkey_match_p (desc+descindex, node)) + { + /* Before skipping this subkey, check whether any + * other description wants an exact match on a + * subkey and include that subkey into the output + * too. Need to add this subkey to a list so that + * it won't get processed a second time. + * + * So the first step here is to check that list and + * skip in any case if the key is in that list. + * + * We need this whole mess because the import + * function of GnuPG < 2.1 is not able to merge + * secret keys and thus it is useless to output them + * as two separate keys and have import merge them. + */ + if (subkey_in_list_p (subkey_list, node)) + skip_until_subkey = 1; /* Already processed this one. */ + else + { + size_t j; + + for (j=0; j < ndesc; j++) + if (j != descindex && desc[j].exact + && exact_subkey_match_p (desc+j, node)) + break; + if (!(j < ndesc)) + skip_until_subkey = 1; /* No other one matching. */ + } + } + + if (skip_until_subkey) + continue; + + /* Mark this one as processed. */ + { + subkey_list_t tmp = new_subkey_list_item (node); + tmp->next = subkey_list; + subkey_list = tmp; + } + } + + if (node->pkt->pkttype == PKT_SIGNATURE) + { + /* Do not export packets which are marked as not + * exportable. */ + if (!(options & EXPORT_LOCAL_SIGS) + && !node->pkt->pkt.signature->flags.exportable) + continue; /* not exportable */ + + /* Do not export packets with a "sensitive" revocation key + * unless the user wants us to. Note that we do export + * these when issuing the actual revocation (see revoke.c). */ + if (!(options & EXPORT_SENSITIVE_REVKEYS) + && node->pkt->pkt.signature->revkey) + { + int i; + + for (i = 0; i < node->pkt->pkt.signature->numrevkeys; i++) + if ((node->pkt->pkt.signature->revkey[i].class & 0x40)) + break; + if (i < node->pkt->pkt.signature->numrevkeys) + continue; + } + } + + /* Don't export attribs? */ + if (!(options & EXPORT_ATTRIBUTES) + && node->pkt->pkttype == PKT_USER_ID + && node->pkt->pkt.user_id->attrib_data) + { + /* Skip until we get to something that is not an attrib or a + * signature on an attrib. */ + while (kbctx->next && kbctx->next->pkt->pkttype == PKT_SIGNATURE) + kbctx = kbctx->next; + + continue; + } + + if (secret && (node->pkt->pkttype == PKT_PUBLIC_KEY + || node->pkt->pkttype == PKT_PUBLIC_SUBKEY)) + { + pk = node->pkt->pkt.public_key; + if (node->pkt->pkttype == PKT_PUBLIC_KEY) + subkid = NULL; + else + { + keyid_from_pk (pk, subkidbuf); + subkid = subkidbuf; + } + + if (pk->seckey_info) + { + log_error ("key %s: oops: seckey_info already set" + " - skipped\n", keystr_with_sub (keyid, subkid)); + skip_until_subkey = 1; + continue; + } + + xfree (hexgrip); + err = hexkeygrip_from_pk (pk, &hexgrip); + if (err) + { + log_error ("key %s: error computing keygrip: %s" + " - skipped\n", keystr_with_sub (keyid, subkid), + gpg_strerror (err)); + skip_until_subkey = 1; + err = 0; + continue; + } + + xfree (serialno); + serialno = NULL; + if (secret == 2 && node->pkt->pkttype == PKT_PUBLIC_KEY) + { + /* We are asked not to export the secret parts of the + * primary key. Make up an error code to create the + * stub. */ + err = GPG_ERR_NOT_FOUND; + } + else + err = agent_get_keyinfo (ctrl, hexgrip, &serialno, &cleartext); + + if ((!err && serialno) + && secret == 2 && node->pkt->pkttype == PKT_PUBLIC_KEY) + { + /* It does not make sense to export a key with its + * primary key on card using a non-key stub. Thus we + * skip those keys when used with --export-secret-subkeys. */ + log_info (_("key %s: key material on-card - skipped\n"), + keystr_with_sub (keyid, subkid)); + skip_until_subkey = 1; + } + else if (gpg_err_code (err) == GPG_ERR_NOT_FOUND + || (!err && serialno)) + { + /* Create a key stub. */ + struct seckey_info *ski; + const char *s; + + pk->seckey_info = ski = xtrycalloc (1, sizeof *ski); + if (!ski) + { + err = gpg_error_from_syserror (); + goto leave; + } + + ski->is_protected = 1; + if (err) + ski->s2k.mode = 1001; /* GNU dummy (no secret key). */ + else + { + ski->s2k.mode = 1002; /* GNU-divert-to-card. */ + for (s=serialno; sizeof (ski->ivlen) && *s && s[1]; + ski->ivlen++, s += 2) + ski->iv[ski->ivlen] = xtoi_2 (s); + } + + err = build_packet (out, node->pkt); + if (!err && node->pkt->pkttype == PKT_PUBLIC_KEY) + { + stats->exported++; + print_status_exported (node->pkt->pkt.public_key); + } + } + else if (!err) + { + err = receive_seckey_from_agent (ctrl, cipherhd, + cleartext, &cache_nonce, + hexgrip, pk); + if (err) + { + if (gpg_err_code (err) == GPG_ERR_FULLY_CANCELED) + goto leave; + skip_until_subkey = 1; + err = 0; + } + else + { + err = build_packet (out, node->pkt); + if (node->pkt->pkttype == PKT_PUBLIC_KEY) + { + stats->exported++; + print_status_exported (node->pkt->pkt.public_key); + } + } + } + else + { + log_error ("key %s: error getting keyinfo from agent: %s" + " - skipped\n", keystr_with_sub (keyid, subkid), + gpg_strerror (err)); + skip_until_subkey = 1; + err = 0; + } + + xfree (pk->seckey_info); + pk->seckey_info = NULL; + { + int i; + for (i = pubkey_get_npkey (pk->pubkey_algo); + i < pubkey_get_nskey (pk->pubkey_algo); i++) + { + gcry_mpi_release (pk->pkey[i]); + pk->pkey[i] = NULL; + } + } + } + else /* Not secret or common packets. */ + { + err = build_packet (out, node->pkt); + if (!err && node->pkt->pkttype == PKT_PUBLIC_KEY) + { + stats->exported++; + print_status_exported (node->pkt->pkt.public_key); + } + } + + if (err) + { + log_error ("build_packet(%d) failed: %s\n", + node->pkt->pkttype, gpg_strerror (err)); + goto leave; + } + + if (!skip_until_subkey) + *any = 1; + } + + leave: + release_subkey_list (subkey_list); + xfree (serialno); + xfree (hexgrip); + xfree (cache_nonce); + return err; +} + + /* Export the keys identified by the list of strings in USERS to the - stream OUT. If Secret is false public keys will be exported. With + stream OUT. If SECRET is false public keys will be exported. With secret true secret keys will be exported; in this case 1 means the entire secret keyblock and 2 only the subkeys. OPTIONS are the export options to apply. If KEYBLOCK_OUT is not NULL, AND the exit @@ -1163,17 +1782,15 @@ do_export_stream (ctrl_t ctrl, iobuf_t out, strlist_t users, int secret, { gpg_error_t err = 0; PACKET pkt; - KBNODE keyblock = NULL; - KBNODE kbctx, node; + kbnode_t keyblock = NULL; + kbnode_t node; size_t ndesc, descindex; KEYDB_SEARCH_DESC *desc = NULL; - subkey_list_t subkey_list = NULL; /* Track already processed subkeys. */ KEYDB_HANDLE kdbhd; strlist_t sl; gcry_cipher_hd_t cipherhd = NULL; - char *cache_nonce = NULL; struct export_stats_s dummystats; - int cleartext = 0; + iobuf_t out_help = NULL; if (!stats) stats = &dummystats; @@ -1183,10 +1800,14 @@ do_export_stream (ctrl_t ctrl, iobuf_t out, strlist_t users, int secret, if (!kdbhd) return gpg_error_from_syserror (); - /* For the DANE format override the options. */ - if ((options & EXPORT_DANE_FORMAT)) - options = (EXPORT_DANE_FORMAT | EXPORT_MINIMAL | EXPORT_CLEAN); - + /* For the PKA and DANE format open a helper iobuf and for DANE + * enforce some options. */ + if ((options & (EXPORT_PKA_FORMAT | EXPORT_DANE_FORMAT))) + { + out_help = iobuf_temp (); + if ((options & EXPORT_DANE_FORMAT)) + options |= EXPORT_MINIMAL | EXPORT_CLEAN; + } if (!users) { @@ -1258,7 +1879,6 @@ do_export_stream (ctrl_t ctrl, iobuf_t out, strlist_t users, int secret, for (;;) { - int skip_until_subkey = 0; u32 keyid[2]; PKT_public_key *pk; @@ -1326,278 +1946,60 @@ do_export_stream (ctrl_t ctrl, iobuf_t out, strlist_t users, int secret, if ((options & EXPORT_CLEAN)) clean_key (keyblock, opt.verbose, (options&EXPORT_MINIMAL), NULL, NULL); - /* And write it. */ - xfree (cache_nonce); - cache_nonce = NULL; - for (kbctx=NULL; (node = walk_kbnode (keyblock, &kbctx, 0)); ) + if (export_keep_uid) { - if (skip_until_subkey) - { - if (node->pkt->pkttype == PKT_PUBLIC_SUBKEY) - skip_until_subkey = 0; - else - continue; - } + commit_kbnode (&keyblock); + apply_keep_uid_filter (keyblock, export_keep_uid); + commit_kbnode (&keyblock); + } - /* We used to use comment packets, but not any longer. In - case we still have comments on a key, strip them here - before we call build_packet(). */ - if (node->pkt->pkttype == PKT_COMMENT) - continue; - - /* Make sure that ring_trust packets never get exported. */ - if (node->pkt->pkttype == PKT_RING_TRUST) - continue; - - /* If exact is set, then we only export what was requested - (plus the primary key, if the user didn't specifically - request it). */ - if (desc[descindex].exact - && node->pkt->pkttype == PKT_PUBLIC_SUBKEY) - { - if (!exact_subkey_match_p (desc+descindex, node)) - { - /* Before skipping this subkey, check whether any - other description wants an exact match on a - subkey and include that subkey into the output - too. Need to add this subkey to a list so that - it won't get processed a second time. - - So the first step here is to check that list and - skip in any case if the key is in that list. - - We need this whole mess because the import - function of GnuPG < 2.1 is not able to merge - secret keys and thus it is useless to output them - as two separate keys and have import merge them. */ - if (subkey_in_list_p (subkey_list, node)) - skip_until_subkey = 1; /* Already processed this one. */ - else - { - size_t j; - - for (j=0; j < ndesc; j++) - if (j != descindex && desc[j].exact - && exact_subkey_match_p (desc+j, node)) - break; - if (!(j < ndesc)) - skip_until_subkey = 1; /* No other one matching. */ - } - } - - if(skip_until_subkey) - continue; - - /* Mark this one as processed. */ - { - subkey_list_t tmp = new_subkey_list_item (node); - tmp->next = subkey_list; - subkey_list = tmp; - } - } - - if (node->pkt->pkttype == PKT_SIGNATURE) - { - /* Do not export packets which are marked as not - exportable. */ - if (!(options&EXPORT_LOCAL_SIGS) - && !node->pkt->pkt.signature->flags.exportable) - continue; /* not exportable */ - - /* Do not export packets with a "sensitive" revocation - key unless the user wants us to. Note that we do - export these when issuing the actual revocation - (see revoke.c). */ - if (!(options&EXPORT_SENSITIVE_REVKEYS) - && node->pkt->pkt.signature->revkey) - { - int i; - - for (i=0;ipkt->pkt.signature->numrevkeys;i++) - if ( (node->pkt->pkt.signature->revkey[i].class & 0x40)) - break; - - if (i < node->pkt->pkt.signature->numrevkeys) - continue; - } - } - - /* Don't export attribs? */ - if (!(options&EXPORT_ATTRIBUTES) - && node->pkt->pkttype == PKT_USER_ID - && node->pkt->pkt.user_id->attrib_data ) - { - /* Skip until we get to something that is not an attrib - or a signature on an attrib */ - while (kbctx->next && kbctx->next->pkt->pkttype==PKT_SIGNATURE) - kbctx = kbctx->next; - - continue; - } - - if (secret && (node->pkt->pkttype == PKT_PUBLIC_KEY - || node->pkt->pkttype == PKT_PUBLIC_SUBKEY)) - { - u32 subkidbuf[2], *subkid; - char *hexgrip, *serialno; - - pk = node->pkt->pkt.public_key; - if (node->pkt->pkttype == PKT_PUBLIC_KEY) - subkid = NULL; - else - { - keyid_from_pk (pk, subkidbuf); - subkid = subkidbuf; - } - - if (pk->seckey_info) - { - log_error ("key %s: oops: seckey_info already set" - " - skipped\n", keystr_with_sub (keyid, subkid)); - skip_until_subkey = 1; - continue; - } - - err = hexkeygrip_from_pk (pk, &hexgrip); - if (err) - { - log_error ("key %s: error computing keygrip: %s" - " - skipped\n", keystr_with_sub (keyid, subkid), - gpg_strerror (err)); - skip_until_subkey = 1; - err = 0; - continue; - } - - if (secret == 2 && node->pkt->pkttype == PKT_PUBLIC_KEY) - { - /* We are asked not to export the secret parts of - the primary key. Make up an error code to create - the stub. */ - err = GPG_ERR_NOT_FOUND; - serialno = NULL; - } - else - err = agent_get_keyinfo (ctrl, hexgrip, &serialno, &cleartext); - - if ((!err && serialno) - && secret == 2 && node->pkt->pkttype == PKT_PUBLIC_KEY) - { - /* It does not make sense to export a key with its - primary key on card using a non-key stub. Thus - we skip those keys when used with - --export-secret-subkeys. */ - log_info (_("key %s: key material on-card - skipped\n"), - keystr_with_sub (keyid, subkid)); - skip_until_subkey = 1; - } - else if (gpg_err_code (err) == GPG_ERR_NOT_FOUND - || (!err && serialno)) - { - /* Create a key stub. */ - struct seckey_info *ski; - const char *s; - - pk->seckey_info = ski = xtrycalloc (1, sizeof *ski); - if (!ski) - { - err = gpg_error_from_syserror (); - xfree (hexgrip); - goto leave; - } - - ski->is_protected = 1; - if (err) - ski->s2k.mode = 1001; /* GNU dummy (no secret key). */ - else - { - ski->s2k.mode = 1002; /* GNU-divert-to-card. */ - for (s=serialno; sizeof (ski->ivlen) && *s && s[1]; - ski->ivlen++, s += 2) - ski->iv[ski->ivlen] = xtoi_2 (s); - } - - err = build_packet (out, node->pkt); - if (!err && node->pkt->pkttype == PKT_PUBLIC_KEY) - { - stats->exported++; - print_status_exported (node->pkt->pkt.public_key); - } - } - else if (!err) - { - err = receive_seckey_from_agent (ctrl, cipherhd, - cleartext, &cache_nonce, - hexgrip, pk); - if (err) - { - if (gpg_err_code (err) == GPG_ERR_FULLY_CANCELED) - goto leave; - skip_until_subkey = 1; - err = 0; - } - else - { - err = build_packet (out, node->pkt); - if (node->pkt->pkttype == PKT_PUBLIC_KEY) - { - stats->exported++; - print_status_exported (node->pkt->pkt.public_key); - } - } - } - else - { - log_error ("key %s: error getting keyinfo from agent: %s" - " - skipped\n", keystr_with_sub (keyid, subkid), - gpg_strerror (err)); - skip_until_subkey = 1; - err = 0; - } - - xfree (pk->seckey_info); - pk->seckey_info = NULL; - xfree (hexgrip); - } - else - { - err = build_packet (out, node->pkt); - if (!err && node->pkt->pkttype == PKT_PUBLIC_KEY) - { - stats->exported++; - print_status_exported (node->pkt->pkt.public_key); - } - } - - - if (err) - { - log_error ("build_packet(%d) failed: %s\n", - node->pkt->pkttype, gpg_strerror (err)); - goto leave; - } - - if (!skip_until_subkey) - *any = 1; - } + /* And write it. */ + err = do_export_one_keyblock (ctrl, keyblock, keyid, + out_help? out_help : out, + secret, options, stats, any, + desc, ndesc, descindex, cipherhd); + if (err) + break; if (keyblock_out) { *keyblock_out = keyblock; break; } + + if (out_help) + { + /* We want to write PKA or DANE records. OUT_HELP has the + * keyblock and we print a record for each uid to OUT. */ + const void *data; + size_t datalen; + + iobuf_flush_temp (out_help); + data = iobuf_get_temp_buffer (out_help); + datalen = iobuf_get_temp_length (out_help); + + err = print_pka_or_dane_records (out, + keyblock, pk, data, datalen, + (options & EXPORT_PKA_FORMAT), + (options & EXPORT_DANE_FORMAT)); + if (err) + goto leave; + + iobuf_close (out_help); + out_help = iobuf_temp (); + } + } if (gpg_err_code (err) == GPG_ERR_NOT_FOUND) err = 0; leave: + iobuf_cancel (out_help); gcry_cipher_close (cipherhd); - release_subkey_list (subkey_list); xfree(desc); keydb_release (kdbhd); if (err || !keyblock_out) release_kbnode( keyblock ); - xfree (cache_nonce); if( !*any ) log_info(_("WARNING: nothing exported\n")); return err; diff --git a/g10/free-packet.c b/g10/free-packet.c index 3883f877a..516e9a145 100644 --- a/g10/free-packet.c +++ b/g10/free-packet.c @@ -311,6 +311,7 @@ free_user_id (PKT_user_id *uid) free_attributes(uid); xfree (uid->prefs); xfree (uid->namehash); + xfree (uid->mbox); xfree (uid); } diff --git a/g10/getkey.c b/g10/getkey.c index ad0148e51..90fd175b4 100644 --- a/g10/getkey.c +++ b/g10/getkey.c @@ -1,7 +1,7 @@ /* getkey.c - Get a key from the database * Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, * 2007, 2008, 2010 Free Software Foundation, Inc. - * Copyright (C) 2015 g10 Code GmbH + * Copyright (C) 2015, 2016 g10 Code GmbH * * This file is part of GnuPG. * @@ -143,6 +143,11 @@ static void merge_selfsigs (kbnode_t keyblock); static int lookup (getkey_ctx_t ctx, kbnode_t *ret_keyblock, kbnode_t *ret_found_key, int want_secret); +static kbnode_t finish_lookup (kbnode_t keyblock, + unsigned int req_usage, int want_exact, + unsigned int *r_flags); +static void print_status_key_considered (kbnode_t keyblock, unsigned int flags); + #if 0 static void @@ -659,12 +664,9 @@ get_pubkeys (ctrl_t ctrl, static void -pk_from_block (GETKEY_CTX ctx, PKT_public_key * pk, KBNODE keyblock, - KBNODE found_key) +pk_from_block (PKT_public_key *pk, kbnode_t keyblock, kbnode_t found_key) { - KBNODE a = found_key ? found_key : keyblock; - - (void) ctx; + kbnode_t a = found_key ? found_key : keyblock; log_assert (a->pkt->pkttype == PKT_PUBLIC_KEY || a->pkt->pkttype == PKT_PUBLIC_SUBKEY); @@ -749,7 +751,7 @@ get_pubkey (PKT_public_key * pk, u32 * keyid) rc = lookup (&ctx, &kb, &found_key, 0); if (!rc) { - pk_from_block (&ctx, pk, kb, found_key); + pk_from_block (pk, kb, found_key); } getkey_end (&ctx); release_kbnode (kb); @@ -912,7 +914,7 @@ get_seckey (PKT_public_key *pk, u32 *keyid) err = lookup (&ctx, &keyblock, &found_key, 1); if (!err) { - pk_from_block (&ctx, pk, keyblock, found_key); + pk_from_block (pk, keyblock, found_key); } getkey_end (&ctx); release_kbnode (keyblock); @@ -1118,7 +1120,7 @@ key_byname (GETKEY_CTX *retctx, strlist_t namelist, rc = lookup (ctx, ret_kb, &found_key, want_secret); if (!rc && pk) { - pk_from_block (ctx, pk, *ret_kb, found_key); + pk_from_block (pk, *ret_kb, found_key); } release_kbnode (help_kb); @@ -1457,6 +1459,53 @@ get_pubkey_byname (ctrl_t ctrl, GETKEY_CTX * retctx, PKT_public_key * pk, } +/* Get a public key from a file. + * + * PK is the buffer to store the key. The caller needs to make sure + * that PK->REQ_USAGE is valid. PK->REQ_USAGE is passed through to + * the lookup function and is a mask of PUBKEY_USAGE_SIG, + * PUBKEY_USAGE_ENC and PUBKEY_USAGE_CERT. If this is non-zero, only + * keys with the specified usage will be returned. + * + * FNAME is the file name. That file should contain exactly one + * keyblock. + * + * This function returns 0 on success. Otherwise, an error code is + * returned. In particular, GPG_ERR_NO_PUBKEY is returned if the key + * is not found. + * + * The self-signed data has already been merged into the public key + * using merge_selfsigs. The caller must release the content of PK by + * calling release_public_key_parts (or, if PK was malloced, using + * free_public_key). + */ +gpg_error_t +get_pubkey_fromfile (ctrl_t ctrl, PKT_public_key *pk, const char *fname) +{ + gpg_error_t err; + kbnode_t keyblock; + kbnode_t found_key; + unsigned int infoflags; + + err = read_key_from_file (ctrl, fname, &keyblock); + if (!err) + { + /* Warning: node flag bits 0 and 1 should be preserved by + * merge_selfsigs. FIXME: Check whether this still holds. */ + merge_selfsigs (keyblock); + found_key = finish_lookup (keyblock, pk->req_usage, 0, &infoflags); + print_status_key_considered (keyblock, infoflags); + if (found_key) + pk_from_block (pk, keyblock, found_key); + else + err = gpg_error (GPG_ERR_UNUSABLE_PUBKEY); + } + + release_kbnode (keyblock); + return err; +} + + /* Lookup a key with the specified fingerprint. * * If PK is not NULL, the public key of the first result is returned @@ -1513,7 +1562,7 @@ get_pubkey_byfprint (PKT_public_key *pk, kbnode_t *r_keyblock, memcpy (ctx.items[0].u.fpr, fprint, fprint_len); rc = lookup (&ctx, &kb, &found_key, 0); if (!rc && pk) - pk_from_block (&ctx, pk, kb, found_key); + pk_from_block (pk, kb, found_key); if (!rc && r_keyblock) { *r_keyblock = kb; @@ -1903,7 +1952,7 @@ getkey_next (getkey_ctx_t ctx, PKT_public_key *pk, kbnode_t *ret_keyblock) rc = lookup (ctx, ret_keyblock, &found_key, ctx->want_secret); if (!rc && pk && ret_keyblock) - pk_from_block (ctx, pk, *ret_keyblock, found_key); + pk_from_block (pk, *ret_keyblock, found_key); return rc; } @@ -3053,31 +3102,33 @@ merge_selfsigs (KBNODE keyblock) /* See whether the key satisfies any additional requirements specified - * in CTX. If so, return 1 and set CTX->FOUND_KEY to an appropriate - * key or subkey. Otherwise, return 0 if there was no appropriate - * key. + * in CTX. If so, return the node of an appropriate key or subkey. + * Otherwise, return NULL if there was no appropriate key. * * In case the primary key is not required, select a suitable subkey. - * We need the primary key if PUBKEY_USAGE_CERT is set in - * CTX->REQ_USAGE or we are in PGP6 or PGP7 mode and PUBKEY_USAGE_SIG - * is set in CTX->REQ_USAGE. + * We need the primary key if PUBKEY_USAGE_CERT is set in REQ_USAGE or + * we are in PGP6 or PGP7 mode and PUBKEY_USAGE_SIG is set in + * REQ_USAGE. * * If any of PUBKEY_USAGE_SIG, PUBKEY_USAGE_ENC and PUBKEY_USAGE_CERT - * are set in CTX->REQ_USAGE, we filter by the key's function. - * Concretely, if PUBKEY_USAGE_SIG and PUBKEY_USAGE_CERT are set, then - * we only return a key if it is (at least) either a signing or a + * are set in REQ_USAGE, we filter by the key's function. Concretely, + * if PUBKEY_USAGE_SIG and PUBKEY_USAGE_CERT are set, then we only + * return a key if it is (at least) either a signing or a * certification key. * - * If CTX->REQ_USAGE is set, then we reject any keys that are not good + * If REQ_USAGE is set, then we reject any keys that are not good * (i.e., valid, not revoked, not expired, etc.). This allows the * getkey functions to be used for plain key listings. * * Sets the matched key's user id field (pk->user_id) to the user id - * that matched the low-level search criteria or NULL. If R_FLAGS is - * not NULL set certain flags for more detailed error reporting. Used - * flags are: + * that matched the low-level search criteria or NULL. + * + * If R_FLAGS is not NULL set certain flags for more detailed error + * reporting. Used flags are: + * * - LOOKUP_ALL_SUBKEYS_EXPIRED :: All Subkeys are expired or have * been revoked. + * - LOOKUP_NOT_SELECTED :: No suitable key found * * This function needs to handle several different cases: * @@ -3094,40 +3145,41 @@ merge_selfsigs (KBNODE keyblock) * */ static kbnode_t -finish_lookup (getkey_ctx_t ctx, kbnode_t keyblock, unsigned int *r_flags) +finish_lookup (kbnode_t keyblock, unsigned int req_usage, int want_exact, + unsigned int *r_flags) { kbnode_t k; - /* If CTX->EXACT is set, the key or subkey that actually matched the + /* If WANT_EXACT is set, the key or subkey that actually matched the low-level search criteria. */ kbnode_t foundk = NULL; /* The user id (if any) that matched the low-level search criteria. */ PKT_user_id *foundu = NULL; -#define USAGE_MASK (PUBKEY_USAGE_SIG|PUBKEY_USAGE_ENC|PUBKEY_USAGE_CERT) - unsigned int req_usage = (ctx->req_usage & USAGE_MASK); - - /* Request the primary if we're certifying another key, and also - if signing data while --pgp6 or --pgp7 is on since pgp 6 and 7 - do not understand signatures made by a signing subkey. PGP 8 - does. */ - int req_prim = ((ctx->req_usage & PUBKEY_USAGE_CERT) - || ((PGP6 || PGP7) && (ctx->req_usage & PUBKEY_USAGE_SIG))); - - u32 curtime = make_timestamp (); - u32 latest_date; kbnode_t latest_key; PKT_public_key *pk; - - log_assert (keyblock->pkt->pkttype == PKT_PUBLIC_KEY); + int req_prim; + u32 curtime = make_timestamp (); if (r_flags) *r_flags = 0; +#define USAGE_MASK (PUBKEY_USAGE_SIG|PUBKEY_USAGE_ENC|PUBKEY_USAGE_CERT) + req_usage &= USAGE_MASK; + + /* Request the primary if we're certifying another key, and also if + * signing data while --pgp6 or --pgp7 is on since pgp 6 and 7 do + * not understand signatures made by a signing subkey. PGP 8 does. */ + req_prim = ((req_usage & PUBKEY_USAGE_CERT) + || ((PGP6 || PGP7) && (req_usage & PUBKEY_USAGE_SIG))); + + + log_assert (keyblock->pkt->pkttype == PKT_PUBLIC_KEY); + /* For an exact match mark the primary or subkey that matched the low-level search criteria. */ - if (ctx->exact) + if (want_exact) { for (k = keyblock; k; k = k->next) { @@ -3262,7 +3314,7 @@ finish_lookup (getkey_ctx_t ctx, kbnode_t keyblock, unsigned int *r_flags) * primary key, or, * * - we're just considering the primary key. */ - if ((!latest_key && !ctx->exact) || foundk == keyblock || req_prim) + if ((!latest_key && !want_exact) || foundk == keyblock || req_prim) { if (DBG_LOOKUP && !foundk && !req_prim) log_debug ("\tno suitable subkeys found - trying primary\n"); @@ -3300,10 +3352,12 @@ finish_lookup (getkey_ctx_t ctx, kbnode_t keyblock, unsigned int *r_flags) { if (DBG_LOOKUP) log_debug ("\tno suitable key found - giving up\n"); + if (r_flags) + *r_flags |= LOOKUP_NOT_SELECTED; return NULL; /* Not found. */ } -found: + found: if (DBG_LOOKUP) log_debug ("\tusing key %08lX\n", (ulong) keyid_from_pk (latest_key->pkt->pkt.public_key, NULL)); @@ -3408,12 +3462,10 @@ lookup (getkey_ctx_t ctx, kbnode_t *ret_keyblock, kbnode_t *ret_found_key, goto skip; /* No secret key available. */ /* Warning: node flag bits 0 and 1 should be preserved by - * merge_selfsigs. For secret keys, premerge transferred the - * keys to the keyblock. */ + * merge_selfsigs. */ merge_selfsigs (keyblock); - found_key = finish_lookup (ctx, keyblock, &infoflags); - if (!found_key) - infoflags |= LOOKUP_NOT_SELECTED; + found_key = finish_lookup (keyblock, ctx->req_usage, ctx->exact, + &infoflags); print_status_key_considered (keyblock, infoflags); if (found_key) { diff --git a/g10/gpg.c b/g10/gpg.c index 1f2d41685..4232a840b 100644 --- a/g10/gpg.c +++ b/g10/gpg.c @@ -81,6 +81,8 @@ enum cmd_and_opt_values aSym = 'c', aDecrypt = 'd', aEncr = 'e', + oRecipientFile = 'f', + oHiddenRecipientFile = 'F', oInteractive = 'i', aListKeys = 'k', oDryRun = 'n', @@ -118,6 +120,7 @@ enum cmd_and_opt_values aQuickLSignKey, aQuickAddUid, aQuickAddKey, + aQuickRevUid, aListConfig, aListGcryptConfig, aGPGConfList, @@ -166,6 +169,7 @@ enum cmd_and_opt_values aServer, aTOFUPolicy, + oMimemode, oTextmode, oNoTextmode, oExpert, @@ -216,6 +220,7 @@ enum cmd_and_opt_values oGnuPG, oRFC2440, oRFC4880, + oRFC4880bis, oOpenPGP, oPGP6, oPGP7, @@ -246,6 +251,7 @@ enum cmd_and_opt_values oNoMDCWarn, oNoArmor, oNoDefKeyring, + oNoKeyring, oNoGreeting, oNoTTY, oNoOptions, @@ -298,7 +304,9 @@ enum cmd_and_opt_values oKeyServer, oKeyServerOptions, oImportOptions, + oImportFilter, oExportOptions, + oExportFilter, oListOptions, oVerifyOptions, oTempDir, @@ -430,6 +438,8 @@ static ARGPARSE_OPTS opts[] = { ARGPARSE_c (aQuickAddUid, "quick-adduid", N_("quickly add a new user-id")), ARGPARSE_c (aQuickAddKey, "quick-addkey", "@"), + ARGPARSE_c (aQuickRevUid, "quick-revuid", + N_("quickly revoke a user-id")), ARGPARSE_c (aFullKeygen, "full-gen-key" , N_("full featured key pair generation")), ARGPARSE_c (aGenRevoke, "gen-revoke",N_("generate a revocation certificate")), @@ -499,6 +509,8 @@ static ARGPARSE_OPTS opts[] = { ARGPARSE_s_s (oRecipient, "recipient", N_("|USER-ID|encrypt for USER-ID")), ARGPARSE_s_s (oHiddenRecipient, "hidden-recipient", "@"), + ARGPARSE_s_s (oRecipientFile, "recipient-file", "@"), + ARGPARSE_s_s (oHiddenRecipientFile, "hidden-recipient-file", "@"), ARGPARSE_s_s (oRecipient, "remote-user", "@"), /* (old option name) */ ARGPARSE_s_s (oDefRecipient, "default-recipient", "@"), ARGPARSE_s_n (oDefRecipientSelf, "default-recipient-self", "@"), @@ -521,7 +533,8 @@ static ARGPARSE_OPTS opts[] = { ARGPARSE_s_i (oBZ2CompressLevel, "bzip2-compress-level", "@"), ARGPARSE_s_n (oBZ2DecompressLowmem, "bzip2-decompress-lowmem", "@"), - ARGPARSE_s_n (oTextmodeShort, NULL, "@"), + ARGPARSE_s_n (oMimemode, "mimemode", "@"), + ARGPARSE_s_n (oTextmode, "textmode", N_("use canonical text mode")), ARGPARSE_s_n (oTextmode, "textmode", N_("use canonical text mode")), ARGPARSE_s_n (oNoTextmode, "no-textmode", "@"), @@ -568,7 +581,9 @@ static ARGPARSE_OPTS opts[] = { ARGPARSE_s_s (oKeyServer, "keyserver", "@"), ARGPARSE_s_s (oKeyServerOptions, "keyserver-options", "@"), ARGPARSE_s_s (oImportOptions, "import-options", "@"), + ARGPARSE_s_s (oImportFilter, "import-filter", "@"), ARGPARSE_s_s (oExportOptions, "export-options", "@"), + ARGPARSE_s_s (oExportFilter, "export-filter", "@"), ARGPARSE_s_s (oListOptions, "list-options", "@"), ARGPARSE_s_s (oVerifyOptions, "verify-options", "@"), @@ -599,6 +614,7 @@ static ARGPARSE_OPTS opts[] = { ARGPARSE_s_n (oGnuPG, "no-pgp8", "@"), ARGPARSE_s_n (oRFC2440, "rfc2440", "@"), ARGPARSE_s_n (oRFC4880, "rfc4880", "@"), + ARGPARSE_s_n (oRFC4880bis, "rfc4880bis", "@"), ARGPARSE_s_n (oOpenPGP, "openpgp", N_("use strict OpenPGP behavior")), ARGPARSE_s_n (oPGP6, "pgp6", "@"), ARGPARSE_s_n (oPGP7, "pgp7", "@"), @@ -672,6 +688,7 @@ static ARGPARSE_OPTS opts[] = { ARGPARSE_s_n (oNoArmor, "no-armor", "@"), ARGPARSE_s_n (oNoArmor, "no-armour", "@"), ARGPARSE_s_n (oNoDefKeyring, "no-default-keyring", "@"), + ARGPARSE_s_n (oNoKeyring, "no-keyring", "@"), ARGPARSE_s_n (oNoGreeting, "no-greeting", "@"), ARGPARSE_s_n (oNoOptions, "no-options", "@"), ARGPARSE_s_s (oHomedir, "homedir", "@"), @@ -2028,6 +2045,7 @@ parse_tofu_db_format (const char *db_format) } } + /* This function called to initialized a new control object. It is assumed that this object has been zeroed out before calling this function. */ @@ -2432,6 +2450,7 @@ main (int argc, char **argv) case aQuickKeygen: case aQuickAddUid: case aQuickAddKey: + case aQuickRevUid: case aExportOwnerTrust: case aImportOwnerTrust: case aRebuildKeydbCaches: @@ -2598,7 +2617,15 @@ main (int argc, char **argv) } break; case oNoArmor: opt.no_armor=1; opt.armor=0; break; - case oNoDefKeyring: default_keyring = 0; break; + + case oNoDefKeyring: + if (default_keyring > 0) + default_keyring = 0; + break; + case oNoKeyring: + default_keyring = -1; + break; + case oNoGreeting: nogreeting = 1; break; case oNoVerbose: opt.verbose = 0; @@ -2686,6 +2713,9 @@ main (int argc, char **argv) /* Dummy so that gpg 1.4 conf files can work. Should eventually be removed. */ break; + case oRFC4880bis: + opt.flags.rfc4880bis = 1; + /* fall thru. */ case oOpenPGP: case oRFC4880: /* This is effectively the same as RFC2440, but with @@ -2814,46 +2844,56 @@ main (int argc, char **argv) else opt.s2k_count = 0; /* Auto-calibrate when needed. */ break; - case oNoEncryptTo: opt.no_encrypt_to = 1; break; - case oEncryptTo: /* store the recipient in the second list */ - sl = add_to_strlist2( &remusr, pargs.r.ret_str, utf8_strings ); - sl->flags = ((pargs.r_opt << PK_LIST_SHIFT) | PK_LIST_ENCRYPT_TO); - if (configfp) - sl->flags |= PK_LIST_CONFIG; - break; - case oHiddenEncryptTo: /* store the recipient in the second list */ - sl = add_to_strlist2( &remusr, pargs.r.ret_str, utf8_strings ); - sl->flags = ((pargs.r_opt << PK_LIST_SHIFT) - | PK_LIST_ENCRYPT_TO|PK_LIST_HIDDEN); - if (configfp) - sl->flags |= PK_LIST_CONFIG; - break; - case oEncryptToDefaultKey: - opt.encrypt_to_default_key = configfp ? 2 : 1; - break; - case oRecipient: /* store the recipient */ + + case oRecipient: + case oHiddenRecipient: + case oRecipientFile: + case oHiddenRecipientFile: + /* Store the recipient. Note that we also store the + * option as private data in the flags. This is achieved + * by shifting the option value to the left so to keep + * enough space for the flags. */ sl = add_to_strlist2( &remusr, pargs.r.ret_str, utf8_strings ); sl->flags = (pargs.r_opt << PK_LIST_SHIFT); if (configfp) sl->flags |= PK_LIST_CONFIG; + if (pargs.r_opt == oHiddenRecipient + || pargs.r_opt == oHiddenRecipientFile) + sl->flags |= PK_LIST_HIDDEN; + if (pargs.r_opt == oRecipientFile + || pargs.r_opt == oHiddenRecipientFile) + sl->flags |= PK_LIST_FROM_FILE; any_explicit_recipient = 1; break; - case oHiddenRecipient: /* store the recipient with a flag */ + + case oEncryptTo: + case oHiddenEncryptTo: + /* Store an additional recipient. */ sl = add_to_strlist2( &remusr, pargs.r.ret_str, utf8_strings ); - sl->flags = ((pargs.r_opt << PK_LIST_SHIFT) | PK_LIST_HIDDEN); + sl->flags = ((pargs.r_opt << PK_LIST_SHIFT) | PK_LIST_ENCRYPT_TO); if (configfp) sl->flags |= PK_LIST_CONFIG; - any_explicit_recipient = 1; + if (pargs.r_opt == oHiddenEncryptTo) + sl->flags |= PK_LIST_HIDDEN; break; + case oNoEncryptTo: + opt.no_encrypt_to = 1; + break; + case oEncryptToDefaultKey: + opt.encrypt_to_default_key = configfp ? 2 : 1; + break; + case oTrySecretKey: add_to_strlist2 (&opt.secret_keys_to_try, pargs.r.ret_str, utf8_strings); break; + case oMimemode: opt.mimemode = opt.textmode = 1; break; case oTextmodeShort: opt.textmode = 2; break; case oTextmode: opt.textmode=1; break; - case oNoTextmode: opt.textmode=0; break; + case oNoTextmode: opt.textmode=opt.mimemode=0; break; + case oExpert: opt.expert = 1; break; case oNoExpert: opt.expert = 0; break; case oDefSigExpire: @@ -3022,6 +3062,11 @@ main (int argc, char **argv) log_error(_("invalid import options\n")); } break; + case oImportFilter: + rc = parse_and_set_import_filter (pargs.r.ret_str); + if (rc) + log_error (_("invalid filter option: %s\n"), gpg_strerror (rc)); + break; case oExportOptions: if(!parse_export_options(pargs.r.ret_str,&opt.export_options,1)) { @@ -3032,6 +3077,11 @@ main (int argc, char **argv) log_error(_("invalid export options\n")); } break; + case oExportFilter: + rc = parse_and_set_export_filter (pargs.r.ret_str); + if (rc) + log_error (_("invalid filter option: %s\n"), gpg_strerror (rc)); + break; case oListOptions: if(!parse_list_options(pargs.r.ret_str)) { @@ -3399,6 +3449,13 @@ main (int argc, char **argv) if( may_coredump && !opt.quiet ) log_info(_("WARNING: program may create a core file!\n")); + if (opt.flags.rfc4880bis) + log_info ("WARNING: using experimental features from RFC4880bis!\n"); + else + { + opt.mimemode = 0; /* This will use text mode instead. */ + } + if (eyes_only) { if (opt.set_filename) log_info(_("WARNING: %s overrides %s\n"), @@ -3676,14 +3733,15 @@ main (int argc, char **argv) if( opt.verbose > 1 ) set_packet_list_mode(1); - /* Add the keyrings, but not for some special commands. - We always need to add the keyrings if we are running under - SELinux, this is so that the rings are added to the list of - secured files. */ - if( ALWAYS_ADD_KEYRINGS - || (cmd != aDeArmor && cmd != aEnArmor && cmd != aGPGConfTest) ) + /* Add the keyrings, but not for some special commands. We always + * need to add the keyrings if we are running under SELinux, this + * is so that the rings are added to the list of secured files. + * We do not add any keyring if --no-keyring has been used. */ + if (default_keyring >= 0 + && (ALWAYS_ADD_KEYRINGS + || (cmd != aDeArmor && cmd != aEnArmor && cmd != aGPGConfTest))) { - if (!nrings || default_keyring) /* Add default ring. */ + if (!nrings || default_keyring > 0) /* Add default ring. */ keydb_add_resource ("pubring" EXTSEP_S GPGEXT_GPG, KEYDB_RESOURCE_FLAG_DEFAULT); for (sl = nrings; sl; sl = sl->next ) @@ -3777,6 +3835,7 @@ main (int argc, char **argv) case aQuickKeygen: case aQuickAddUid: case aQuickAddKey: + case aQuickRevUid: case aFullKeygen: case aKeygen: case aImport: @@ -4196,6 +4255,18 @@ main (int argc, char **argv) } break; + case aQuickRevUid: + { + const char *uid, *uidtorev; + + if (argc != 2) + wrong_args ("--quick-revuid USER-ID USER-ID-TO-REVOKE"); + uid = *argv++; argc--; + uidtorev = *argv++; argc--; + keyedit_quick_revuid (ctrl, uid, uidtorev); + } + break; + case aFastImport: opt.import_options |= IMPORT_FAST; case aImport: @@ -4648,7 +4719,6 @@ main (int argc, char **argv) break; case aListPackets: - opt.list_packets=2; default: if( argc > 1 ) wrong_args(_("[filename]")); @@ -4677,8 +4747,8 @@ main (int argc, char **argv) } } if( cmd == aListPackets ) { - set_packet_list_mode(1); opt.list_packets=1; + set_packet_list_mode(1); } rc = proc_packets (ctrl, NULL, a ); if( rc ) diff --git a/g10/gpgv.c b/g10/gpgv.c index 2aed10c2a..d08dc5a7a 100644 --- a/g10/gpgv.c +++ b/g10/gpgv.c @@ -167,6 +167,8 @@ main( int argc, char **argv ) opt.command_fd = -1; /* no command fd */ opt.keyserver_options.options |= KEYSERVER_AUTO_KEY_RETRIEVE; opt.trust_model = TM_ALWAYS; + opt.no_sig_cache = 1; + opt.flags.require_cross_cert = 1; opt.batch = 1; opt.weak_digests = NULL; @@ -364,6 +366,17 @@ keyserver_import_keyid (u32 *keyid, void *dummy) return -1; } +int +keyserver_import_fprint (ctrl_t ctrl, const byte *fprint,size_t fprint_len, + struct keyserver_spec *keyserver) +{ + (void)ctrl; + (void)fprint; + (void)fprint_len; + (void)keyserver; + return -1; +} + int keyserver_import_cert (const char *name) { @@ -405,6 +418,17 @@ keyserver_import_ldap (const char *name) return -1; } + +gpg_error_t +read_key_from_file (ctrl_t ctrl, const char *fname, kbnode_t *r_keyblock) +{ + (void)ctrl; + (void)fname; + (void)r_keyblock; + return -1; +} + + /* Stub: * No encryption here but mainproc links to these functions. */ diff --git a/g10/import.c b/g10/import.c index 7c0d1e2cc..375bd03f8 100644 --- a/g10/import.c +++ b/g10/import.c @@ -1,6 +1,6 @@ /* import.c - import a key into our key storage. * Copyright (C) 1998-2007, 2010-2011 Free Software Foundation, Inc. - * Copyright (C) 2014 Werner Koch + * Copyright (C) 2014, 2016 Werner Koch * * This file is part of GnuPG. * @@ -35,9 +35,13 @@ #include "i18n.h" #include "ttyio.h" #include "status.h" +#include "recsel.h" #include "keyserver-internal.h" #include "call-agent.h" #include "../common/membuf.h" +#include "../common/init.h" +#include "../common/mbox-util.h" + struct import_stats_s { @@ -60,6 +64,28 @@ struct import_stats_s }; +/* Node flag to indicate that a user ID or a subkey has a + * valid self-signature. */ +#define NODE_GOOD_SELFSIG 1 +/* Node flag to indicate that a user ID or subkey has + * an invalid self-signature. */ +#define NODE_BAD_SELFSIG 2 +/* Node flag to indicate that the node shall be deleted. */ +#define NODE_DELETION_MARK 4 +/* A node flag used to temporary mark a node. */ +#define NODE_FLAG_A 8 + + +/* A global variable to store the selector created from + * --import-filter keep-uid=EXPR. + * + * FIXME: We should put this into the CTRL object but that requires a + * lot more changes right now. + */ +static recsel_expr_t import_keep_uid; + + + static int import (ctrl_t ctrl, IOBUF inp, const char* fname, struct import_stats_s *stats, unsigned char **fpr, size_t *fpr_len, unsigned int options, @@ -68,32 +94,36 @@ static int read_block (IOBUF a, PACKET **pending_pkt, kbnode_t *ret_root, int *r_v3keys); static void revocation_present (ctrl_t ctrl, kbnode_t keyblock); static int import_one (ctrl_t ctrl, - const char *fname, kbnode_t keyblock, + kbnode_t keyblock, struct import_stats_s *stats, unsigned char **fpr, size_t *fpr_len, unsigned int options, int from_sk, int silent, import_screener_t screener, void *screener_arg); -static int import_secret_one (ctrl_t ctrl, const char *fname, kbnode_t keyblock, +static int import_secret_one (ctrl_t ctrl, kbnode_t keyblock, struct import_stats_s *stats, int batch, unsigned int options, int for_migration, import_screener_t screener, void *screener_arg); -static int import_revoke_cert( const char *fname, kbnode_t node, - struct import_stats_s *stats); -static int chk_self_sigs (const char *fname, kbnode_t keyblock, - PKT_public_key *pk, u32 *keyid, int *non_self ); -static int delete_inv_parts (const char *fname, kbnode_t keyblock, - u32 *keyid, unsigned int options ); -static int merge_blocks (const char *fname, kbnode_t keyblock_orig, +static int import_revoke_cert (kbnode_t node, struct import_stats_s *stats); +static int chk_self_sigs (kbnode_t keyblock, u32 *keyid, int *non_self); +static int delete_inv_parts (kbnode_t keyblock, + u32 *keyid, unsigned int options); +static int merge_blocks (kbnode_t keyblock_orig, kbnode_t keyblock, u32 *keyid, int *n_uids, int *n_sigs, int *n_subk ); -static int append_uid (kbnode_t keyblock, kbnode_t node, int *n_sigs, - const char *fname, u32 *keyid ); -static int append_key (kbnode_t keyblock, kbnode_t node, int *n_sigs, - const char *fname, u32 *keyid ); -static int merge_sigs (kbnode_t dst, kbnode_t src, int *n_sigs, - const char *fname, u32 *keyid ); -static int merge_keysigs (kbnode_t dst, kbnode_t src, int *n_sigs, - const char *fname, u32 *keyid ); +static int append_uid (kbnode_t keyblock, kbnode_t node, int *n_sigs); +static int append_key (kbnode_t keyblock, kbnode_t node, int *n_sigs); +static int merge_sigs (kbnode_t dst, kbnode_t src, int *n_sigs); +static int merge_keysigs (kbnode_t dst, kbnode_t src, int *n_sigs); + + + +static void +cleanup_import_globals (void) +{ + recsel_release (import_keep_uid); + import_keep_uid = NULL; +} + int parse_import_options(char *str,unsigned int *options,int noisy) @@ -112,6 +142,9 @@ parse_import_options(char *str,unsigned int *options,int noisy) {"fast-import",IMPORT_FAST,NULL, N_("do not update the trustdb after import")}, + {"import-show",IMPORT_SHOW,NULL, + N_("show key during import")}, + {"merge-only",IMPORT_MERGE_ONLY,NULL, N_("only accept updates to existing keys")}, @@ -121,6 +154,9 @@ parse_import_options(char *str,unsigned int *options,int noisy) {"import-minimal",IMPORT_MINIMAL|IMPORT_CLEAN,NULL, N_("remove as much as possible from key after import")}, + {"import-export", IMPORT_EXPORT, NULL, + N_("run import filters and export key immediately")}, + /* Aliases for backward compatibility */ {"allow-local-sigs",IMPORT_LOCAL_SIGS,NULL,NULL}, {"repair-hkp-subkey-bug",IMPORT_REPAIR_PKS_SUBKEY_BUG,NULL,NULL}, @@ -137,6 +173,39 @@ parse_import_options(char *str,unsigned int *options,int noisy) } +/* Parse and set an import filter from string. STRING has the format + * "NAME=EXPR" with NAME being the name of the filter. Spaces before + * and after NAME are not allowed. If this function is all called + * several times all expressions for the same NAME are concatenated. + * Supported filter names are: + * + * - keep-uid :: If the expression evaluates to true for a certain + * user ID packet, that packet and all it dependencies + * will be imported. The expression may use these + * variables: + * + * - uid :: The entire user ID. + * - mbox :: The mail box part of the user ID. + * - primary :: Evaluate to true for the primary user ID. + */ +gpg_error_t +parse_and_set_import_filter (const char *string) +{ + gpg_error_t err; + + /* Auto register the cleanup function. */ + register_mem_cleanup_func (cleanup_import_globals); + + if (!strncmp (string, "keep-uid=", 9)) + err = recsel_parse_expr (&import_keep_uid, string+9); + else + err = gpg_error (GPG_ERR_INV_NAME); + + return err; +} + + + import_stats_t import_new_stats_handle (void) { @@ -151,6 +220,113 @@ import_release_stats_handle (import_stats_t p) } +/* Read a key from a file. Only the first key in the file is + * considered and stored at R_KEYBLOCK. FNAME is the name of the + * file. + */ +gpg_error_t +read_key_from_file (ctrl_t ctrl, const char *fname, kbnode_t *r_keyblock) +{ + gpg_error_t err; + iobuf_t inp; + PACKET *pending_pkt = NULL; + kbnode_t keyblock = NULL; + u32 keyid[2]; + int v3keys; /* Dummy */ + int non_self; /* Dummy */ + + (void)ctrl; + + *r_keyblock = NULL; + + inp = iobuf_open (fname); + if (!inp) + err = gpg_error_from_syserror (); + else if (is_secured_file (iobuf_get_fd (inp))) + { + iobuf_close (inp); + inp = NULL; + err = gpg_error (GPG_ERR_EPERM); + } + else + err = 0; + if (err) + { + log_error (_("can't open '%s': %s\n"), + iobuf_is_pipe_filename (fname)? "[stdin]": fname, + gpg_strerror (err)); + if (gpg_err_code (err) == GPG_ERR_ENOENT) + err = gpg_error (GPG_ERR_NO_PUBKEY); + goto leave; + } + + /* Push the armor filter. */ + { + armor_filter_context_t *afx; + afx = new_armor_context (); + afx->only_keyblocks = 1; + push_armor_filter (afx, inp); + release_armor_context (afx); + } + + /* Read the first non-v3 keyblock. */ + while (!(err = read_block (inp, &pending_pkt, &keyblock, &v3keys))) + { + if (keyblock->pkt->pkttype == PKT_PUBLIC_KEY) + break; + log_info (_("skipping block of type %d\n"), keyblock->pkt->pkttype); + release_kbnode (keyblock); + keyblock = NULL; + } + if (err) + { + if (gpg_err_code (err) != GPG_ERR_INV_KEYRING) + log_error (_("error reading '%s': %s\n"), + iobuf_is_pipe_filename (fname)? "[stdin]": fname, + gpg_strerror (err)); + goto leave; + } + + keyid_from_pk (keyblock->pkt->pkt.public_key, keyid); + + if (!find_next_kbnode (keyblock, PKT_USER_ID)) + { + err = gpg_error (GPG_ERR_NO_USER_ID); + goto leave; + } + + collapse_uids (&keyblock); + + clear_kbnode_flags (keyblock); + if (chk_self_sigs (keyblock, keyid, &non_self)) + { + err = gpg_error (GPG_ERR_INV_KEYRING); + goto leave; + } + + if (!delete_inv_parts (keyblock, keyid, 0) ) + { + err = gpg_error (GPG_ERR_NO_USER_ID); + goto leave; + } + + *r_keyblock = keyblock; + keyblock = NULL; + + leave: + if (inp) + { + iobuf_close (inp); + /* Must invalidate that ugly cache to actually close the file. */ + iobuf_ioctl (NULL, IOBUF_IOCTL_INVALIDATE_CACHE, 0, (char*)fname); + } + release_kbnode (keyblock); + /* FIXME: Do we need to free PENDING_PKT ? */ + return err; +} + + + /* * Import the public keys from the given filename. Input may be armored. * This function rejects all keys which are not validly self signed on at @@ -328,16 +504,16 @@ import (ctrl_t ctrl, IOBUF inp, const char* fname,struct import_stats_s *stats, { stats->v3keys += v3keys; if (keyblock->pkt->pkttype == PKT_PUBLIC_KEY) - rc = import_one (ctrl, fname, keyblock, + rc = import_one (ctrl, keyblock, stats, fpr, fpr_len, options, 0, 0, screener, screener_arg); else if (keyblock->pkt->pkttype == PKT_SECRET_KEY) - rc = import_secret_one (ctrl, fname, keyblock, stats, + rc = import_secret_one (ctrl, keyblock, stats, opt.batch, options, 0, screener, screener_arg); else if (keyblock->pkt->pkttype == PKT_SIGNATURE && keyblock->pkt->pkt.signature->sig_class == 0x20 ) - rc = import_revoke_cert( fname, keyblock, stats ); + rc = import_revoke_cert (keyblock, stats); else { log_info (_("skipping block of type %d\n"), keyblock->pkt->pkttype); @@ -401,7 +577,7 @@ import_old_secring (ctrl_t ctrl, const char *fname) while (!(err = read_block (inp, &pending_pkt, &keyblock, &v3keys))) { if (keyblock->pkt->pkttype == PKT_SECRET_KEY) - err = import_secret_one (ctrl, fname, keyblock, stats, 1, 0, 1, + err = import_secret_one (ctrl, keyblock, stats, 1, 0, 1, NULL, NULL); release_kbnode (keyblock); if (err) @@ -707,8 +883,8 @@ fix_pks_corruption (kbnode_t keyblock) } else { - sknode->flag |= 1; /* Mark it good so we don't need to - check it again */ + /* Mark it good so we don't need to check it again */ + sknode->flag |= NODE_GOOD_SELFSIG; changed = 1; break; } @@ -921,6 +1097,74 @@ check_prefs (ctrl_t ctrl, kbnode_t keyblock) } +/* Helper for apply_keep_uid_filter. */ +static const char * +filter_getval (void *cookie, const char *propname) +{ + kbnode_t node = cookie; + const char *result; + + if (node->pkt->pkttype == PKT_USER_ID) + { + if (!strcmp (propname, "uid")) + result = node->pkt->pkt.user_id->name; + else if (!strcmp (propname, "mbox")) + { + if (!node->pkt->pkt.user_id->mbox) + { + node->pkt->pkt.user_id->mbox + = mailbox_from_userid (node->pkt->pkt.user_id->name); + } + return node->pkt->pkt.user_id->mbox; + } + else if (!strcmp (propname, "primary")) + result = node->pkt->pkt.user_id->is_primary? "1":"0"; + else + result = NULL; + } + else + result = NULL; + + return result; +} + +/* + * Apply the keep-uid filter to the keyblock. The deleted nodes are + * marked and thus the caller should call commit_kbnode afterwards. + * KEYBLOCK must not have any blocks marked as deleted. + */ +static void +apply_keep_uid_filter (kbnode_t keyblock, recsel_expr_t selector) +{ + kbnode_t node; + + for (node = keyblock->next; node; node = node->next ) + { + if (node->pkt->pkttype == PKT_USER_ID) + { + if (!recsel_select (selector, filter_getval, node)) + { + + /* log_debug ("keep-uid: deleting '%s'\n", */ + /* node->pkt->pkt.user_id->name); */ + /* The UID packet and all following packets up to the + * next UID or a subkey. */ + delete_kbnode (node); + for (; node->next + && node->next->pkt->pkttype != PKT_USER_ID + && node->next->pkt->pkttype != PKT_PUBLIC_SUBKEY + && node->next->pkt->pkttype != PKT_SECRET_SUBKEY ; + node = node->next) + delete_kbnode (node->next); + } + /* else */ + /* log_debug ("keep-uid: keeping '%s'\n", */ + /* node->pkt->pkt.user_id->name); */ + } + } +} + + /* * Try to import one keyblock. Return an error only in serious cases, * but never for an invalid keyblock. It uses log_error to increase @@ -930,13 +1174,13 @@ check_prefs (ctrl_t ctrl, kbnode_t keyblock) */ static int import_one (ctrl_t ctrl, - const char *fname, kbnode_t keyblock, struct import_stats_s *stats, + kbnode_t keyblock, struct import_stats_s *stats, unsigned char **fpr, size_t *fpr_len, unsigned int options, int from_sk, int silent, import_screener_t screener, void *screener_arg) { PKT_public_key *pk; - PKT_public_key *pk_orig; + PKT_public_key *pk_orig = NULL; kbnode_t node, uidnode; kbnode_t keyblock_orig = NULL; byte fpr2[MAX_FINGERPRINT_LEN]; @@ -949,6 +1193,7 @@ import_one (ctrl_t ctrl, int non_self = 0; size_t an; char pkstrbuf[PUBKEY_STRING_SIZE]; + int merge_keys_done = 0; /* Get the key and print some info about it. */ node = find_kbnode( keyblock, PKT_PUBLIC_KEY ); @@ -1019,26 +1264,28 @@ import_one (ctrl_t ctrl, log_info (_("key %s: PKS subkey corruption repaired\n"), keystr_from_pk(pk)); - rc = chk_self_sigs( fname, keyblock , pk, keyid, &non_self ); - if (rc ) - return rc== -1? 0:rc; + if (chk_self_sigs (keyblock, keyid, &non_self)) + return 0; /* Invalid keyblock - error already printed. */ /* If we allow such a thing, mark unsigned uids as valid */ if (opt.allow_non_selfsigned_uid) { for (node=keyblock; node; node = node->next ) - if (node->pkt->pkttype == PKT_USER_ID && !(node->flag & 1) ) + if (node->pkt->pkttype == PKT_USER_ID + && !(node->flag & NODE_GOOD_SELFSIG) + && !(node->flag & NODE_BAD_SELFSIG) ) { char *user=utf8_to_native(node->pkt->pkt.user_id->name, node->pkt->pkt.user_id->len,0); - node->flag |= 1; + /* Fake a good signature status for the user id. */ + node->flag |= NODE_GOOD_SELFSIG; log_info( _("key %s: accepted non self-signed user ID \"%s\"\n"), keystr_from_pk(pk),user); xfree(user); } } - if (!delete_inv_parts( fname, keyblock, keyid, options ) ) + if (!delete_inv_parts (keyblock, keyid, options ) ) { if (!silent) { @@ -1050,6 +1297,46 @@ import_one (ctrl_t ctrl, return 0; } + /* Get rid of deleted nodes. */ + commit_kbnode (&keyblock); + + /* Apply import filter. */ + if (import_keep_uid) + { + apply_keep_uid_filter (keyblock, import_keep_uid); + commit_kbnode (&keyblock); + } + + + /* Show the key in the form it is merged or inserted. We skip this + * if "import-export" is also active without --armor or the output + * file has explicily been given. */ + if ((options & IMPORT_SHOW) + && !((options & IMPORT_EXPORT) && !opt.armor && !opt.outfile)) + { + merge_keys_and_selfsig (keyblock); + merge_keys_done = 1; + /* Note that we do not want to show the validity because the key + * has not yet imported. */ + list_keyblock_direct (ctrl, keyblock, 0, 0, 1, 1); + es_fflush (es_stdout); + } + + /* Write the keyblock to the output and do not actually import. */ + if ((options & IMPORT_EXPORT)) + { + if (!merge_keys_done) + { + merge_keys_and_selfsig (keyblock); + merge_keys_done = 1; + } + rc = write_keyblock_to_output (keyblock, opt.armor, opt.export_options); + goto leave; + } + + if (opt.dry_run) + goto leave; + /* Do we have this key already in one of our pubrings ? */ pk_orig = xmalloc_clear( sizeof *pk_orig ); rc = get_pubkey_byfprint_fast (pk_orig, fpr2, fpr2len); @@ -1170,7 +1457,7 @@ import_one (ctrl_t ctrl, clear_kbnode_flags( keyblock_orig ); clear_kbnode_flags( keyblock ); n_uids = n_sigs = n_subk = n_uids_cleaned = 0; - rc = merge_blocks( fname, keyblock_orig, keyblock, + rc = merge_blocks (keyblock_orig, keyblock, keyid, &n_uids, &n_sigs, &n_subk ); if (rc ) { @@ -1258,7 +1545,7 @@ import_one (ctrl_t ctrl, keydb_release (hd); hd = NULL; } - leave: + leave: if (mod_key || new_key || same_key) { /* A little explanation for this: we fill in the fingerprint @@ -1429,6 +1716,7 @@ transfer_secret_keys (ctrl_t ctrl, struct import_stats_s *stats, else { const char *curvename = openpgp_oid_to_curve (curvestr, 1); + gcry_sexp_release (curve); err = gcry_sexp_build (&curve, NULL, "(curve %s)", curvename?curvename:curvestr); xfree (curvestr); @@ -1654,7 +1942,7 @@ sec_to_pub_keyblock (kbnode_t sec_keyblock) * with the trust calculation. */ static int -import_secret_one (ctrl_t ctrl, const char *fname, kbnode_t keyblock, +import_secret_one (ctrl_t ctrl, kbnode_t keyblock, struct import_stats_s *stats, int batch, unsigned int options, int for_migration, import_screener_t screener, void *screener_arg) @@ -1754,7 +2042,7 @@ import_secret_one (ctrl_t ctrl, const char *fname, kbnode_t keyblock, /* Note that this outputs an IMPORT_OK status message for the public key block, and below we will output another one for the secret keys. FIXME? */ - import_one (ctrl, fname, pub_keyblock, stats, + import_one (ctrl, pub_keyblock, stats, NULL, NULL, options, 1, for_migration, screener, screener_arg); @@ -1822,8 +2110,7 @@ import_secret_one (ctrl_t ctrl, const char *fname, kbnode_t keyblock, * Import a revocation certificate; this is a single signature packet. */ static int -import_revoke_cert (const char *fname, kbnode_t node, - struct import_stats_s *stats) +import_revoke_cert (kbnode_t node, struct import_stats_s *stats) { PKT_public_key *pk = NULL; kbnode_t onode; @@ -1832,8 +2119,6 @@ import_revoke_cert (const char *fname, kbnode_t node, u32 keyid[2]; int rc = 0; - (void)fname; - log_assert (!node->next ); log_assert (node->pkt->pkttype == PKT_SIGNATURE ); log_assert (node->pkt->pkt.signature->sig_class == 0x20 ); @@ -1949,18 +2234,21 @@ import_revoke_cert (const char *fname, kbnode_t node, } -/* - * Loop over the keyblock and check all self signatures. - * Mark all user-ids with a self-signature by setting flag bit 0. - * Mark all user-ids with an invalid self-signature by setting bit 1. - * This works also for subkeys, here the subkey is marked. Invalid or - * extra subkey sigs (binding or revocation) are marked for deletion. - * non_self is set to true if there are any sigs other than self-sigs +/* Loop over the keyblock and check all self signatures. On return + * the following bis in the node flags are set: + * + * - NODE_GOOD_SELFSIG :: User ID or subkey has a self-signature + * - NODE_BAD_SELFSIG :: Used ID or subkey has an invalid self-signature + * - NODE_DELETION_MARK :: This node shall be deleted + * + * NON_SELF is set to true if there are any sigs other than self-sigs * in this keyblock. + * + * Returns 0 on success or -1 (but not an error code) if the keyblock + * is invalid. */ static int -chk_self_sigs (const char *fname, kbnode_t keyblock, - PKT_public_key *pk, u32 *keyid, int *non_self ) +chk_self_sigs (kbnode_t keyblock, u32 *keyid, int *non_self ) { kbnode_t n, knode = NULL; PKT_signature *sig; @@ -1968,9 +2256,6 @@ chk_self_sigs (const char *fname, kbnode_t keyblock, u32 bsdate=0, rsdate=0; kbnode_t bsnode = NULL, rsnode = NULL; - (void)fname; - (void)pk; - for (n=keyblock; (n = find_next_kbnode (n, 0)); ) { if (n->pkt->pkttype == PKT_PUBLIC_SUBKEY) @@ -2009,7 +2294,7 @@ chk_self_sigs (const char *fname, kbnode_t keyblock, } /* If it hasn't been marked valid yet, keep trying. */ - if (!(unode->flag&1)) + if (!(unode->flag & NODE_GOOD_SELFSIG)) { rc = check_key_signature (keyblock, n, NULL); if ( rc ) @@ -2029,7 +2314,7 @@ chk_self_sigs (const char *fname, kbnode_t keyblock, } } else - unode->flag |= 1; /* Mark that signature checked. */ + unode->flag |= NODE_GOOD_SELFSIG; } } else if (IS_KEY_SIG (sig)) @@ -2042,7 +2327,7 @@ chk_self_sigs (const char *fname, kbnode_t keyblock, _("key %s: unsupported public key algorithm\n"): _("key %s: invalid direct key signature\n"), keystr (keyid)); - n->flag |= 4; + n->flag |= NODE_DELETION_MARK; } } else if ( IS_SUBKEY_SIG (sig) ) @@ -2056,7 +2341,7 @@ chk_self_sigs (const char *fname, kbnode_t keyblock, if (opt.verbose) log_info (_("key %s: no subkey for key binding\n"), keystr (keyid)); - n->flag |= 4; /* delete this */ + n->flag |= NODE_DELETION_MARK; } else { @@ -2069,19 +2354,19 @@ chk_self_sigs (const char *fname, kbnode_t keyblock, " algorithm\n"): _("key %s: invalid subkey binding\n"), keystr (keyid)); - n->flag |= 4; + n->flag |= NODE_DELETION_MARK; } else { /* It's valid, so is it newer? */ if (sig->timestamp >= bsdate) { - knode->flag |= 1; /* The subkey is valid. */ + knode->flag |= NODE_GOOD_SELFSIG; /* Subkey is valid. */ if (bsnode) { /* Delete the last binding sig since this one is newer */ - bsnode->flag |= 4; + bsnode->flag |= NODE_DELETION_MARK; if (opt.verbose) log_info (_("key %s: removed multiple subkey" " binding\n"),keystr(keyid)); @@ -2091,7 +2376,7 @@ chk_self_sigs (const char *fname, kbnode_t keyblock, bsdate = sig->timestamp; } else - n->flag |= 4; /* older */ + n->flag |= NODE_DELETION_MARK; /* older */ } } } @@ -2107,7 +2392,7 @@ chk_self_sigs (const char *fname, kbnode_t keyblock, if (opt.verbose) log_info (_("key %s: no subkey for key revocation\n"), keystr(keyid)); - n->flag |= 4; /* delete this */ + n->flag |= NODE_DELETION_MARK; } else { @@ -2120,7 +2405,7 @@ chk_self_sigs (const char *fname, kbnode_t keyblock, " key algorithm\n"): _("key %s: invalid subkey revocation\n"), keystr(keyid)); - n->flag |= 4; + n->flag |= NODE_DELETION_MARK; } else { @@ -2131,7 +2416,7 @@ chk_self_sigs (const char *fname, kbnode_t keyblock, { /* Delete the last revocation sig since this one is newer. */ - rsnode->flag |= 4; + rsnode->flag |= NODE_DELETION_MARK; if (opt.verbose) log_info (_("key %s: removed multiple subkey" " revocation\n"),keystr(keyid)); @@ -2141,7 +2426,7 @@ chk_self_sigs (const char *fname, kbnode_t keyblock, rsdate = sig->timestamp; } else - n->flag |= 4; /* older */ + n->flag |= NODE_DELETION_MARK; /* older */ } } } @@ -2151,28 +2436,25 @@ chk_self_sigs (const char *fname, kbnode_t keyblock, } -/**************** - * delete all parts which are invalid and those signatures whose - * public key algorithm is not available in this implemenation; - * but consider RSA as valid, because parse/build_packets knows - * about it. - * returns: true if at least one valid user-id is left over. +/* Delete all parts which are invalid and those signatures whose + * public key algorithm is not available in this implemenation; but + * consider RSA as valid, because parse/build_packets knows about it. + * + * Returns: True if at least one valid user-id is left over. */ static int -delete_inv_parts( const char *fname, kbnode_t keyblock, - u32 *keyid, unsigned int options) +delete_inv_parts (kbnode_t keyblock, u32 *keyid, unsigned int options) { kbnode_t node; int nvalid=0, uid_seen=0, subkey_seen=0; - (void)fname; - for (node=keyblock->next; node; node = node->next ) { if (node->pkt->pkttype == PKT_USER_ID) { uid_seen = 1; - if ((node->flag & 2) || !(node->flag & 1) ) + if ((node->flag & NODE_BAD_SELFSIG) + || !(node->flag & NODE_GOOD_SELFSIG)) { if (opt.verbose ) { @@ -2198,7 +2480,8 @@ delete_inv_parts( const char *fname, kbnode_t keyblock, else if ( node->pkt->pkttype == PKT_PUBLIC_SUBKEY || node->pkt->pkttype == PKT_SECRET_SUBKEY ) { - if ((node->flag & 2) || !(node->flag & 1) ) + if ((node->flag & NODE_BAD_SELFSIG) + || !(node->flag & NODE_GOOD_SELFSIG)) { if (opt.verbose ) log_info( _("key %s: skipped subkey\n"),keystr(keyid)); @@ -2286,7 +2569,7 @@ delete_inv_parts( const char *fname, kbnode_t keyblock, node->pkt->pkt.signature->sig_class); delete_kbnode(node); } - else if ((node->flag & 4) ) /* marked for deletion */ + else if ((node->flag & NODE_DELETION_MARK)) delete_kbnode( node ); } @@ -2513,10 +2796,10 @@ revocation_present (ctrl_t ctrl, kbnode_t keyblock) * the signature's public key yet; verification is done when putting it * into the trustdb, which is done automagically as soon as this pubkey * is used. - * Note: We indicate newly inserted packets with flag bit 0 + * Note: We indicate newly inserted packets with NODE_FLAG_A. */ static int -merge_blocks (const char *fname, kbnode_t keyblock_orig, kbnode_t keyblock, +merge_blocks (kbnode_t keyblock_orig, kbnode_t keyblock, u32 *keyid, int *n_uids, int *n_sigs, int *n_subk ) { kbnode_t onode, node; @@ -2549,7 +2832,7 @@ merge_blocks (const char *fname, kbnode_t keyblock_orig, kbnode_t keyblock, { kbnode_t n2 = clone_kbnode(node); insert_kbnode( keyblock_orig, n2, 0 ); - n2->flag |= 1; + n2->flag |= NODE_FLAG_A; ++*n_sigs; if(!opt.quiet) { @@ -2589,7 +2872,7 @@ merge_blocks (const char *fname, kbnode_t keyblock_orig, kbnode_t keyblock, { kbnode_t n2 = clone_kbnode(node); insert_kbnode( keyblock_orig, n2, 0 ); - n2->flag |= 1; + n2->flag |= NODE_FLAG_A; ++*n_sigs; if(!opt.quiet) log_info( _("key %s: direct key signature added\n"), @@ -2601,7 +2884,7 @@ merge_blocks (const char *fname, kbnode_t keyblock_orig, kbnode_t keyblock, /* 3rd: try to merge new certificates in */ for (onode=keyblock_orig->next; onode; onode=onode->next) { - if (!(onode->flag & 1) && onode->pkt->pkttype == PKT_USER_ID) + if (!(onode->flag & NODE_FLAG_A) && onode->pkt->pkttype == PKT_USER_ID) { /* find the user id in the imported keyblock */ for (node=keyblock->next; node; node=node->next) @@ -2611,7 +2894,7 @@ merge_blocks (const char *fname, kbnode_t keyblock_orig, kbnode_t keyblock, break; if (node ) /* found: merge */ { - rc = merge_sigs( onode, node, n_sigs, fname, keyid ); + rc = merge_sigs (onode, node, n_sigs); if (rc ) return rc; } @@ -2631,7 +2914,7 @@ merge_blocks (const char *fname, kbnode_t keyblock_orig, kbnode_t keyblock, break; if (!onode ) /* this is a new user id: append */ { - rc = append_uid( keyblock_orig, node, n_sigs, fname, keyid); + rc = append_uid (keyblock_orig, node, n_sigs); if (rc ) return rc; ++*n_uids; @@ -2653,7 +2936,7 @@ merge_blocks (const char *fname, kbnode_t keyblock_orig, kbnode_t keyblock, break; if (!onode ) /* This is a new subkey: append. */ { - rc = append_key (keyblock_orig, node, n_sigs, fname, keyid); + rc = append_key (keyblock_orig, node, n_sigs); if (rc) return rc; ++*n_subk; @@ -2669,7 +2952,7 @@ merge_blocks (const char *fname, kbnode_t keyblock_orig, kbnode_t keyblock, break; if (!onode ) /* This is a new subkey: append. */ { - rc = append_key (keyblock_orig, node, n_sigs, fname, keyid); + rc = append_key (keyblock_orig, node, n_sigs); if (rc ) return rc; ++*n_subk; @@ -2680,7 +2963,7 @@ merge_blocks (const char *fname, kbnode_t keyblock_orig, kbnode_t keyblock, /* 6th: merge subkey certificates */ for (onode=keyblock_orig->next; onode; onode=onode->next) { - if (!(onode->flag & 1) + if (!(onode->flag & NODE_FLAG_A) && (onode->pkt->pkttype == PKT_PUBLIC_SUBKEY || onode->pkt->pkttype == PKT_SECRET_SUBKEY)) { @@ -2695,7 +2978,7 @@ merge_blocks (const char *fname, kbnode_t keyblock_orig, kbnode_t keyblock, } if (node) /* Found: merge. */ { - rc = merge_keysigs( onode, node, n_sigs, fname, keyid ); + rc = merge_keysigs( onode, node, n_sigs); if (rc ) return rc; } @@ -2706,19 +2989,15 @@ merge_blocks (const char *fname, kbnode_t keyblock_orig, kbnode_t keyblock, } -/* +/* Helper function for merge_blocks. * Append the userid starting with NODE and all signatures to KEYBLOCK. */ static int -append_uid (kbnode_t keyblock, kbnode_t node, int *n_sigs, - const char *fname, u32 *keyid ) +append_uid (kbnode_t keyblock, kbnode_t node, int *n_sigs) { kbnode_t n; kbnode_t n_where = NULL; - (void)fname; - (void)keyid; - log_assert (node->pkt->pkttype == PKT_USER_ID ); /* find the position */ @@ -2744,8 +3023,8 @@ append_uid (kbnode_t keyblock, kbnode_t node, int *n_sigs, } else add_kbnode( keyblock, n ); - n->flag |= 1; - node->flag |= 1; + n->flag |= NODE_FLAG_A; + node->flag |= NODE_FLAG_A; if (n->pkt->pkttype == PKT_SIGNATURE ) ++*n_sigs; @@ -2758,20 +3037,16 @@ append_uid (kbnode_t keyblock, kbnode_t node, int *n_sigs, } -/* +/* Helper function for merge_blocks * Merge the sigs from SRC onto DST. SRC and DST are both a PKT_USER_ID. * (how should we handle comment packets here?) */ static int -merge_sigs (kbnode_t dst, kbnode_t src, int *n_sigs, - const char *fname, u32 *keyid) +merge_sigs (kbnode_t dst, kbnode_t src, int *n_sigs) { kbnode_t n, n2; int found = 0; - (void)fname; - (void)keyid; - log_assert (dst->pkt->pkttype == PKT_USER_ID); log_assert (src->pkt->pkttype == PKT_USER_ID); @@ -2797,8 +3072,8 @@ merge_sigs (kbnode_t dst, kbnode_t src, int *n_sigs, * one is released first */ n2 = clone_kbnode(n); insert_kbnode( dst, n2, PKT_SIGNATURE ); - n2->flag |= 1; - n->flag |= 1; + n2->flag |= NODE_FLAG_A; + n->flag |= NODE_FLAG_A; ++*n_sigs; } } @@ -2807,19 +3082,15 @@ merge_sigs (kbnode_t dst, kbnode_t src, int *n_sigs, } -/* +/* Helper function for merge_blocks * Merge the sigs from SRC onto DST. SRC and DST are both a PKT_xxx_SUBKEY. */ static int -merge_keysigs (kbnode_t dst, kbnode_t src, int *n_sigs, - const char *fname, u32 *keyid) +merge_keysigs (kbnode_t dst, kbnode_t src, int *n_sigs) { kbnode_t n, n2; int found = 0; - (void)fname; - (void)keyid; - log_assert (dst->pkt->pkttype == PKT_PUBLIC_SUBKEY || dst->pkt->pkttype == PKT_SECRET_SUBKEY); @@ -2858,8 +3129,8 @@ merge_keysigs (kbnode_t dst, kbnode_t src, int *n_sigs, * one is released first */ n2 = clone_kbnode(n); insert_kbnode( dst, n2, PKT_SIGNATURE ); - n2->flag |= 1; - n->flag |= 1; + n2->flag |= NODE_FLAG_A; + n->flag |= NODE_FLAG_A; ++*n_sigs; } } @@ -2868,19 +3139,15 @@ merge_keysigs (kbnode_t dst, kbnode_t src, int *n_sigs, } -/* +/* Helper function for merge_blocks. * Append the subkey starting with NODE and all signatures to KEYBLOCK. * Mark all new and copied packets by setting flag bit 0. */ static int -append_key (kbnode_t keyblock, kbnode_t node, int *n_sigs, - const char *fname, u32 *keyid) +append_key (kbnode_t keyblock, kbnode_t node, int *n_sigs) { kbnode_t n; - (void)fname; - (void)keyid; - log_assert (node->pkt->pkttype == PKT_PUBLIC_SUBKEY || node->pkt->pkttype == PKT_SECRET_SUBKEY); @@ -2890,8 +3157,8 @@ append_key (kbnode_t keyblock, kbnode_t node, int *n_sigs, * one is released first */ n = clone_kbnode(node); add_kbnode( keyblock, n ); - n->flag |= 1; - node->flag |= 1; + n->flag |= NODE_FLAG_A; + node->flag |= NODE_FLAG_A; if (n->pkt->pkttype == PKT_SIGNATURE ) ++*n_sigs; diff --git a/g10/kbnode.c b/g10/kbnode.c index a1d1f3d77..e814fa802 100644 --- a/g10/kbnode.c +++ b/g10/kbnode.c @@ -34,18 +34,18 @@ static int cleanup_registered; static KBNODE unused_nodes; -#if USE_UNUSED_NODES static void release_unused_nodes (void) { +#if USE_UNUSED_NODES while (unused_nodes) { kbnode_t next = unused_nodes->next; xfree (unused_nodes); unused_nodes = next; } -} #endif /*USE_UNUSED_NODES*/ +} static kbnode_t diff --git a/g10/keydb.c b/g10/keydb.c index 17ddd5d20..e49e25fd9 100644 --- a/g10/keydb.c +++ b/g10/keydb.c @@ -937,6 +937,7 @@ keydb_release (KEYDB_HANDLE hd) } } + keyblock_cache_clear (hd); xfree (hd); } diff --git a/g10/keydb.h b/g10/keydb.h index a30cf7ac7..4e8f3f291 100644 --- a/g10/keydb.h +++ b/g10/keydb.h @@ -70,15 +70,16 @@ enum resource_type { /* Bit flags used with build_pk_list. */ enum { - PK_LIST_ENCRYPT_TO=1, /* This is an encrypt-to recipient. */ - PK_LIST_HIDDEN=2, /* This is a hidden recipient. */ - PK_LIST_CONFIG=4 /* Specified via config file. */ + PK_LIST_ENCRYPT_TO = 1, /* This is an encrypt-to recipient. */ + PK_LIST_HIDDEN = 2, /* This is a hidden recipient. */ + PK_LIST_CONFIG = 4, /* Specified via config file. */ + PK_LIST_FROM_FILE = 8 /* Take key from file with that name. */ }; -/* To store private data in the flags they must be left shifted by - this value. */ +/* To store private data in the flags the private data must be left + shifted by this value. */ enum { - PK_LIST_SHIFT=3 + PK_LIST_SHIFT = 4 }; /**************** @@ -104,7 +105,7 @@ struct pk_list { PK_LIST next; PKT_public_key *pk; - int flags; /* flag bit 1==throw_keyid */ + int flags; /* See PK_LIST_ constants. */ }; /* Structure to hold a list of secret key certificates. */ @@ -228,7 +229,8 @@ void release_pk_list (PK_LIST pk_list); int build_pk_list (ctrl_t ctrl, strlist_t rcpts, PK_LIST *ret_pk_list); gpg_error_t find_and_check_key (ctrl_t ctrl, const char *name, unsigned int use, - int mark_hidden, pk_list_t *pk_list_addr); + int mark_hidden, int from_file, + pk_list_t *pk_list_addr); int algo_available( preftype_t preftype, int algo, const union pref_hint *hint ); @@ -322,6 +324,10 @@ int get_pubkey_byname (ctrl_t ctrl, KBNODE *ret_keyblock, KEYDB_HANDLE *ret_kdbhd, int include_unusable, int no_akl ); +/* Get a public key directly from file FNAME. */ +gpg_error_t get_pubkey_fromfile (ctrl_t ctrl, + PKT_public_key *pk, const char *fname); + /* Return the public key with the key id KEYID iff the secret key is * available and store it at PK. */ gpg_error_t get_seckey (PKT_public_key *pk, u32 *keyid); diff --git a/g10/keyedit.c b/g10/keyedit.c index d05ea5d01..9ebd643ad 100644 --- a/g10/keyedit.c +++ b/g10/keyedit.c @@ -87,6 +87,9 @@ static int real_uids_left (KBNODE keyblock); static int count_selected_keys (KBNODE keyblock); static int menu_revsig (KBNODE keyblock); static int menu_revuid (ctrl_t ctrl, kbnode_t keyblock); +static int core_revuid (ctrl_t ctrl, kbnode_t keyblock, KBNODE node, + const struct revocation_reason_info *reason, + int *modified); static int menu_revkey (KBNODE pub_keyblock); static int menu_revsubkey (KBNODE pub_keyblock); #ifndef NO_TRUST_MODELS @@ -2937,6 +2940,110 @@ keyedit_quick_adduid (ctrl_t ctrl, const char *username, const char *newuid) keydb_release (kdbhd); } +/* Unattended revokation of a keyid. USERNAME specifies the + key. UIDTOREV is the user id revoke from the key. */ +void +keyedit_quick_revuid (ctrl_t ctrl, const char *username, const char *uidtorev) +{ + gpg_error_t err; + KEYDB_HANDLE kdbhd = NULL; + KEYDB_SEARCH_DESC desc; + kbnode_t keyblock = NULL; + kbnode_t node; + int modified = 0; + size_t revlen; + +#ifdef HAVE_W32_SYSTEM + /* See keyedit_menu for why we need this. */ + check_trustdb_stale (ctrl); +#endif + + /* Search the key; we don't want the whole getkey stuff here. */ + kdbhd = keydb_new (); + if (!kdbhd) + { + /* Note that keydb_new has already used log_error. */ + goto leave; + } + + err = classify_user_id (username, &desc, 1); + if (!err) + err = keydb_search (kdbhd, &desc, 1, NULL); + if (!err) + { + err = keydb_get_keyblock (kdbhd, &keyblock); + if (err) + { + log_error (_("error reading keyblock: %s\n"), gpg_strerror (err)); + goto leave; + } + /* Now with the keyblock retrieved, search again to detect an + ambiguous specification. We need to save the found state so + that we can do an update later. */ + keydb_push_found_state (kdbhd); + err = keydb_search (kdbhd, &desc, 1, NULL); + if (!err) + err = gpg_error (GPG_ERR_AMBIGUOUS_NAME); + else if (gpg_err_code (err) == GPG_ERR_NOT_FOUND) + err = 0; + keydb_pop_found_state (kdbhd); + + if (!err) + { + /* We require the secret primary key to revoke a UID. */ + node = find_kbnode (keyblock, PKT_PUBLIC_KEY); + if (!node) + BUG (); + err = agent_probe_secret_key (ctrl, node->pkt->pkt.public_key); + } + } + if (err) + { + log_error (_("secret key \"%s\" not found: %s\n"), + username, gpg_strerror (err)); + goto leave; + } + + fix_keyblock (&keyblock); + setup_main_keyids (keyblock); + + revlen = strlen (uidtorev); + /* find the right UID */ + for (node = keyblock; node; node = node->next) + { + if (node->pkt->pkttype == PKT_USER_ID + && revlen == node->pkt->pkt.user_id->len + && !memcmp (node->pkt->pkt.user_id->name, uidtorev, revlen)) + { + struct revocation_reason_info *reason; + + reason = get_default_uid_revocation_reason (); + err = core_revuid (ctrl, keyblock, node, reason, &modified); + release_revocation_reason_info (reason); + if (err) + { + log_error (_("User ID revocation failed: %s\n"), + gpg_strerror (err)); + goto leave; + } + err = keydb_update_keyblock (kdbhd, keyblock); + if (err) + { + log_error (_("update failed: %s\n"), gpg_strerror (err)); + goto leave; + } + + if (update_trust) + revalidation_mark (); + goto leave; + } + } + + leave: + release_kbnode (keyblock); + keydb_release (kdbhd); +} + /* Find a keyblock by fingerprint because only this uniquely * identifies a key and may thus be used to select a key for @@ -6106,6 +6213,95 @@ reloop: /* (must use this, because we are modifing the list) */ } +/* return 0 if revocation of NODE (which must be a User ID) was + successful, non-zero if there was an error. *modified will be set + to 1 if a change was made. */ +static int +core_revuid (ctrl_t ctrl, kbnode_t keyblock, KBNODE node, + const struct revocation_reason_info *reason, int *modified) +{ + PKT_public_key *pk = keyblock->pkt->pkt.public_key; + gpg_error_t rc; + + if (node->pkt->pkttype != PKT_USER_ID) + { + rc = gpg_error (GPG_ERR_NO_USER_ID); + write_status_error ("keysig", rc); + log_error (_("tried to revoke a non-user ID: %s\n"), gpg_strerror (rc)); + return 1; + } + else + { + PKT_user_id *uid = node->pkt->pkt.user_id; + + if (uid->is_revoked) + { + char *user = utf8_to_native (uid->name, uid->len, 0); + log_info (_("user ID \"%s\" is already revoked\n"), user); + xfree (user); + } + else + { + PACKET *pkt; + PKT_signature *sig; + struct sign_attrib attrib; + u32 timestamp = make_timestamp (); + + if (uid->created >= timestamp) + { + /* Okay, this is a problem. The user ID selfsig was + created in the future, so we need to warn the user and + set our revocation timestamp one second after that so + everything comes out clean. */ + + log_info (_("WARNING: a user ID signature is dated %d" + " seconds in the future\n"), + uid->created - timestamp); + + timestamp = uid->created + 1; + } + + memset (&attrib, 0, sizeof attrib); + /* should not need to cast away const here; but + revocation_reason_build_cb needs to take a non-const + void* in order to meet the function signtuare for the + mksubpkt argument to make_keysig_packet */ + attrib.reason = (struct revocation_reason_info *)reason; + + rc = make_keysig_packet (&sig, pk, uid, NULL, pk, 0x30, 0, + timestamp, 0, + sign_mk_attrib, &attrib, NULL); + if (rc) + { + write_status_error ("keysig", rc); + log_error (_("signing failed: %s\n"), gpg_strerror (rc)); + return 1; + } + else + { + pkt = xmalloc_clear (sizeof *pkt); + pkt->pkttype = PKT_SIGNATURE; + pkt->pkt.signature = sig; + insert_kbnode (node, new_kbnode (pkt), 0); + +#ifndef NO_TRUST_MODELS + /* If the trustdb has an entry for this key+uid then the + trustdb needs an update. */ + if (!update_trust + && ((get_validity (ctrl, pk, uid, NULL, 0) & TRUST_MASK) + >= TRUST_UNDEFINED)) + update_trust = 1; +#endif /*!NO_TRUST_MODELS*/ + + node->pkt->pkt.user_id->is_revoked = 1; + if (modified) + *modified = 1; + } + } + return 0; + } +} + /* Revoke a user ID (i.e. revoke a user ID selfsig). Return true if keyblock changed. */ static int @@ -6132,75 +6328,20 @@ menu_revuid (ctrl_t ctrl, kbnode_t pub_keyblock) goto leave; } - reloop: /* (better this way because we are modifing the keyring) */ + reloop: /* (better this way because we are modifying the keyring) */ for (node = pub_keyblock; node; node = node->next) if (node->pkt->pkttype == PKT_USER_ID && (node->flag & NODFLG_SELUID)) { - PKT_user_id *uid = node->pkt->pkt.user_id; - - if (uid->is_revoked) - { - char *user = utf8_to_native (uid->name, uid->len, 0); - log_info (_("user ID \"%s\" is already revoked\n"), user); - xfree (user); - } - else - { - PACKET *pkt; - PKT_signature *sig; - struct sign_attrib attrib; - u32 timestamp = make_timestamp (); - - if (uid->created >= timestamp) - { - /* Okay, this is a problem. The user ID selfsig was - created in the future, so we need to warn the user and - set our revocation timestamp one second after that so - everything comes out clean. */ - - log_info (_("WARNING: a user ID signature is dated %d" - " seconds in the future\n"), - uid->created - timestamp); - - timestamp = uid->created + 1; - } - - memset (&attrib, 0, sizeof attrib); - attrib.reason = reason; - + int modified = 0; + rc = core_revuid (ctrl, pub_keyblock, node, reason, &modified); + if (rc) + goto leave; + if (modified) + { node->flag &= ~NODFLG_SELUID; - - rc = make_keysig_packet (&sig, pk, uid, NULL, pk, 0x30, 0, - timestamp, 0, - sign_mk_attrib, &attrib, NULL); - if (rc) - { - write_status_error ("keysig", rc); - log_error (_("signing failed: %s\n"), gpg_strerror (rc)); - goto leave; - } - else - { - pkt = xmalloc_clear (sizeof *pkt); - pkt->pkttype = PKT_SIGNATURE; - pkt->pkt.signature = sig; - insert_kbnode (node, new_kbnode (pkt), 0); - -#ifndef NO_TRUST_MODELS - /* If the trustdb has an entry for this key+uid then the - trustdb needs an update. */ - if (!update_trust - && (get_validity (ctrl, pk, uid, NULL, 0) & TRUST_MASK) >= - TRUST_UNDEFINED) - update_trust = 1; -#endif /*!NO_TRUST_MODELS*/ - - changed = 1; - node->pkt->pkt.user_id->is_revoked = 1; - - goto reloop; - } - } + changed = 1; + goto reloop; + } } if (changed) diff --git a/g10/keygen.c b/g10/keygen.c index 74fd37052..2b3d32886 100644 --- a/g10/keygen.c +++ b/g10/keygen.c @@ -202,7 +202,7 @@ write_uid( KBNODE root, const char *s ) size_t n = strlen(s); pkt->pkttype = PKT_USER_ID; - pkt->pkt.user_id = xmalloc_clear( sizeof *pkt->pkt.user_id + n - 1 ); + pkt->pkt.user_id = xmalloc_clear (sizeof *pkt->pkt.user_id + n); pkt->pkt.user_id->len = n; pkt->pkt.user_id->ref = 1; strcpy(pkt->pkt.user_id->name, s); @@ -413,9 +413,9 @@ keygen_set_std_prefs (const char *string,int personal) if(strlen(string)) { - char *tok,*prefstring; + char *dup, *tok, *prefstring; - prefstring=xstrdup(string); /* need a writable string! */ + dup = prefstring = xstrdup (string); /* need a writable string! */ while((tok=strsep(&prefstring," ,"))) { @@ -449,7 +449,7 @@ keygen_set_std_prefs (const char *string,int personal) } } - xfree(prefstring); + xfree (dup); } if(!rc) @@ -3481,6 +3481,7 @@ read_parameter_file (ctrl_t ctrl, const char *fname ) xfree( outctrl.pub.newfname ); } + xfree (line); release_parameter_list( para ); iobuf_close (fp); release_armor_context (outctrl.pub.afx); @@ -3610,7 +3611,13 @@ quick_generate_keypair (ctrl_t ctrl, const char *uid, const char *algostr, } } - if (*algostr || *usagestr || *expirestr) + + if (!strcmp (algostr, "test-default")) + { + para = quickgen_set_para (para, 0, PUBKEY_ALGO_EDDSA, 0, "Ed25519", 0); + para = quickgen_set_para (para, 1, PUBKEY_ALGO_ECDH, 0, "Curve25519", 0); + } + else if (*algostr || *usagestr || *expirestr) { /* Extended unattended mode. Creates only the primary key. */ int algo; @@ -4340,11 +4347,15 @@ do_generate_keypair (ctrl_t ctrl, struct para_data_s *para, gen_standard_revoke (pk, cache_nonce); + /* Get rid of the first empty packet. */ + commit_kbnode (&pub_root); + if (!opt.batch) { tty_printf (_("public and secret key created and signed.\n") ); tty_printf ("\n"); - list_keyblock_direct (ctrl, pub_root, 0, 1, 1); + merge_keys_and_selfsig (pub_root); + list_keyblock_direct (ctrl, pub_root, 0, 1, 1, 1); } diff --git a/g10/keylist.c b/g10/keylist.c index 0ac763d65..b8f97f545 100644 --- a/g10/keylist.c +++ b/g10/keylist.c @@ -59,6 +59,7 @@ struct keylist_context int inv_sigs; /* Counter used if CHECK_SIGS is set. */ int no_key; /* Counter used if CHECK_SIGS is set. */ int oth_err; /* Counter used if CHECK_SIGS is set. */ + int no_validity; /* Do not show validity. */ }; @@ -920,7 +921,7 @@ list_keyblock_pka (ctrl_t ctrl, kbnode_t keyblock) /* We do not have an export function which allows to pass a keyblock, thus we need to search the key again. */ err = export_pubkey_buffer (ctrl, hexfpr, - EXPORT_DANE_FORMAT, NULL, + (EXPORT_MINIMAL | EXPORT_CLEAN), NULL, &dummy_keyblock, &data, &datalen); release_kbnode (dummy_keyblock); if (!err) @@ -1052,7 +1053,8 @@ list_keyblock_print (ctrl_t ctrl, kbnode_t keyblock, int secret, int fpr, secret = 2; /* Key not found. */ } - check_trustdb_stale (ctrl); + if (!listctx->no_validity) + check_trustdb_stale (ctrl); /* Print the "pub" line and in KF_NONE mode the fingerprint. */ print_key_line (es_stdout, pk, secret); @@ -1090,7 +1092,8 @@ list_keyblock_print (ctrl_t ctrl, kbnode_t keyblock, int secret, int fpr, dump_attribs (uid, pk); if ((uid->is_revoked || uid->is_expired) - || (opt.list_options & LIST_SHOW_UID_VALIDITY)) + || ((opt.list_options & LIST_SHOW_UID_VALIDITY) + && !listctx->no_validity)) { const char *validity; @@ -1755,14 +1758,17 @@ list_keyblock (ctrl_t ctrl, } -/* Public function used by keygen to list a keyblock. */ +/* Public function used by keygen to list a keyblock. If NO_VALIDITY + * is set the validity of a key is never shown. */ void list_keyblock_direct (ctrl_t ctrl, - kbnode_t keyblock, int secret, int has_secret, int fpr) + kbnode_t keyblock, int secret, int has_secret, int fpr, + int no_validity) { struct keylist_context listctx; memset (&listctx, 0, sizeof (listctx)); + listctx.no_validity = !!no_validity; list_keyblock (ctrl, keyblock, secret, has_secret, fpr, &listctx); keylist_context_release (&listctx); } diff --git a/g10/keyserver.c b/g10/keyserver.c index d7105de02..2e2d6a4bb 100644 --- a/g10/keyserver.c +++ b/g10/keyserver.c @@ -240,13 +240,13 @@ parse_keyserver_uri (const char *string,int require_scheme) struct keyserver_spec *keyserver; const char *idx; int count; - char *uri,*options; + char *uri, *duped_uri, *options; log_assert (string); keyserver=xmalloc_clear(sizeof(struct keyserver_spec)); - uri=xstrdup(string); + duped_uri = uri = xstrdup (string); options=strchr(uri,' '); if(options) @@ -434,11 +434,13 @@ parse_keyserver_uri (const char *string,int require_scheme) goto fail; } + xfree (duped_uri); return keyserver; fail: free_keyserver_spec(keyserver); + xfree (duped_uri); return NULL; } diff --git a/g10/main.h b/g10/main.h index 7b716ffd6..0956f6693 100644 --- a/g10/main.h +++ b/g10/main.h @@ -289,6 +289,8 @@ void keyedit_quick_adduid (ctrl_t ctrl, const char *username, const char *newuid); void keyedit_quick_addkey (ctrl_t ctrl, const char *fpr, const char *algostr, const char *usagestr, const char *expirestr); +void keyedit_quick_revuid (ctrl_t ctrl, const char *username, + const char *uidtorev); void keyedit_quick_sign (ctrl_t ctrl, const char *fpr, strlist_t uids, strlist_t locusr, int local); void show_basic_key_info (KBNODE keyblock); @@ -347,6 +349,9 @@ typedef struct import_stats_s *import_stats_t; typedef gpg_error_t (*import_screener_t)(kbnode_t keyblock, void *arg); int parse_import_options(char *str,unsigned int *options,int noisy); +gpg_error_t parse_and_set_import_filter (const char *string); +gpg_error_t read_key_from_file (ctrl_t ctrl, const char *fname, + kbnode_t *r_keyblock); void import_keys (ctrl_t ctrl, char **fnames, int nnames, import_stats_t stats_hd, unsigned int options); int import_keys_stream (ctrl_t ctrl, iobuf_t inp, import_stats_t stats_hd, @@ -376,6 +381,7 @@ void export_release_stats (export_stats_t stats); void export_print_stats (export_stats_t stats); int parse_export_options(char *str,unsigned int *options,int noisy); +gpg_error_t parse_and_set_export_filter (const char *string); int export_pubkeys (ctrl_t ctrl, strlist_t users, unsigned int options, export_stats_t stats); @@ -390,9 +396,13 @@ gpg_error_t export_pubkey_buffer (ctrl_t ctrl, const char *keyspec, gpg_error_t receive_seckey_from_agent (ctrl_t ctrl, gcry_cipher_hd_t cipherhd, int cleartext, - char **cache_nonce_addr, const char *hexgrip, + char **cache_nonce_addr, + const char *hexgrip, PKT_public_key *pk); +gpg_error_t write_keyblock_to_output (kbnode_t keyblock, + int with_armor, unsigned int options); + gpg_error_t export_ssh_key (ctrl_t ctrl, const char *userid); /*-- dearmor.c --*/ @@ -407,6 +417,7 @@ int gen_desig_revoke (ctrl_t ctrl, const char *uname, strlist_t locusr); int revocation_reason_build_cb( PKT_signature *sig, void *opaque ); struct revocation_reason_info * ask_revocation_reason( int key_rev, int cert_rev, int hint ); +struct revocation_reason_info * get_default_uid_revocation_reason(void); void release_revocation_reason_info( struct revocation_reason_info *reason ); /*-- keylist.c --*/ @@ -415,7 +426,7 @@ void secret_key_list (ctrl_t ctrl, strlist_t list ); void print_subpackets_colon(PKT_signature *sig); void reorder_keyblock (KBNODE keyblock); void list_keyblock_direct (ctrl_t ctrl, kbnode_t keyblock, int secret, - int has_secret, int fpr); + int has_secret, int fpr, int no_validity); void print_fingerprint (estream_t fp, PKT_public_key *pk, int mode); void print_revokers (estream_t fp, PKT_public_key *pk); void show_policy_url(PKT_signature *sig,int indent,int mode); diff --git a/g10/mainproc.c b/g10/mainproc.c index 453d1b07b..4217ccdb4 100644 --- a/g10/mainproc.c +++ b/g10/mainproc.c @@ -124,8 +124,6 @@ reset_literals_seen(void) static void release_list( CTX c ) { - if (!c->list) - return; proc_tree (c, c->list); release_kbnode (c->list); while (c->pkenc_list) @@ -1328,7 +1326,7 @@ do_proc_packets (ctrl_t ctrl, CTX c, iobuf_t a) /* Stop processing when an invalid packet has been encountered * but don't do so when we are doing a --list-packets. */ if (gpg_err_code (rc) == GPG_ERR_INV_PACKET - && opt.list_packets != 2 ) + && opt.list_packets == 0) break; continue; } @@ -1805,19 +1803,26 @@ check_sig_and_print (CTX c, kbnode_t node) * favor this over the WKD method (to be tried next), because an * arbitrary keyserver is less subject to web bug like * monitoring. */ - /* if (gpg_err_code (rc) == GPG_ERR_NO_PUBKEY */ - /* && signature_hash_full_fingerprint (sig) */ - /* && (opt.keyserver_options.options&KEYSERVER_AUTO_KEY_RETRIEVE) */ - /* && keyserver_any_configured (c->ctrl)) */ - /* { */ - /* int res; */ + if (gpg_err_code (rc) == GPG_ERR_NO_PUBKEY + && opt.flags.rfc4880bis + && (opt.keyserver_options.options&KEYSERVER_AUTO_KEY_RETRIEVE) + && keyserver_any_configured (c->ctrl)) + { + int res; + const byte *p; + size_t n; - /* glo_ctrl.in_auto_key_retrieve++; */ - /* res = keyserver_import_keyid (c->ctrl, sig->keyid, opt.keyserver ); */ - /* glo_ctrl.in_auto_key_retrieve--; */ - /* if (!res) */ - /* rc = do_check_sig (c, node, NULL, &is_expkey, &is_revkey ); */ - /* } */ + p = parse_sig_subpkt (sig->hashed, SIGSUBPKT_ISSUER_FPR, &n); + if (p && n == 21 && p[0] == 4) + { + /* v4 packet with a SHA-1 fingerprint. */ + glo_ctrl.in_auto_key_retrieve++; + res = keyserver_import_fprint (c->ctrl, p+1, n-1, opt.keyserver); + glo_ctrl.in_auto_key_retrieve--; + if (!res) + rc = do_check_sig (c, node, NULL, &is_expkey, &is_revkey ); + } + } /* If the above methods didn't work, our next try is to retrieve the * key from the WKD. */ diff --git a/g10/options.h b/g10/options.h index 0a87b9011..3c4f0fe38 100644 --- a/g10/options.h +++ b/g10/options.h @@ -57,6 +57,7 @@ struct int dry_run; int autostart; int list_only; + int mimemode; int textmode; int expert; const char *def_sig_expire; @@ -80,7 +81,7 @@ struct int print_pka_records; int print_dane_records; int no_armor; - int list_packets; /* list-packets mode: 1=normal, 2=invoked by command*/ + int list_packets; /* Option --list-packets active. */ int def_cipher_algo; int force_mdc; int disable_mdc; @@ -235,6 +236,8 @@ struct unsigned int allow_weak_digest_algos:1; unsigned int large_rsa:1; unsigned int disable_signer_uid:1; + /* Flag to enbale experimental features from RFC4880bis. */ + unsigned int rfc4880bis:1; } flags; /* Linked list of ways to find a key if the key isn't on the local @@ -332,11 +335,13 @@ EXTERN_UNLESS_MAIN_MODULE int memory_stat_debug_mode; #define IMPORT_LOCAL_SIGS (1<<0) #define IMPORT_REPAIR_PKS_SUBKEY_BUG (1<<1) #define IMPORT_FAST (1<<2) +#define IMPORT_SHOW (1<<3) #define IMPORT_MERGE_ONLY (1<<4) #define IMPORT_MINIMAL (1<<5) #define IMPORT_CLEAN (1<<6) #define IMPORT_NO_SECKEY (1<<7) #define IMPORT_KEEP_OWNERTTRUST (1<<8) +#define IMPORT_EXPORT (1<<9) #define EXPORT_LOCAL_SIGS (1<<0) #define EXPORT_ATTRIBUTES (1<<1) @@ -344,7 +349,8 @@ EXTERN_UNLESS_MAIN_MODULE int memory_stat_debug_mode; #define EXPORT_RESET_SUBKEY_PASSWD (1<<3) #define EXPORT_MINIMAL (1<<4) #define EXPORT_CLEAN (1<<5) -#define EXPORT_DANE_FORMAT (1<<6) +#define EXPORT_PKA_FORMAT (1<<6) +#define EXPORT_DANE_FORMAT (1<<7) #define LIST_SHOW_PHOTOS (1<<0) #define LIST_SHOW_POLICY_URLS (1<<1) diff --git a/g10/packet.h b/g10/packet.h index 8fb6fc48f..08e2cb7f6 100644 --- a/g10/packet.h +++ b/g10/packet.h @@ -291,9 +291,10 @@ typedef struct unsigned int ks_modify:1; unsigned int compacted:1; } flags; + char *mbox; /* NULL or the result of mailbox_from_userid. */ /* The text contained in the user id packet, which is normally the name and email address of the key holder (See RFC 4880 5.11). - (Serialized.) */ + (Serialized.). For convenience an extra Nul is always appended. */ char name[1]; } PKT_user_id; @@ -764,7 +765,7 @@ gpg_error_t gpg_mpi_write_nohdr (iobuf_t out, gcry_mpi_t a); u32 calc_packet_length( PACKET *pkt ); void build_sig_subpkt( PKT_signature *sig, sigsubpkttype_t type, const byte *buffer, size_t buflen ); -void build_sig_subpkt_from_sig( PKT_signature *sig ); +void build_sig_subpkt_from_sig (PKT_signature *sig, PKT_public_key *pksk); int delete_sig_subpkt(subpktarea_t *buffer, sigsubpkttype_t type ); void build_attribute_subpkt(PKT_user_id *uid,byte type, const void *buf,u32 buflen, diff --git a/g10/parse-packet.c b/g10/parse-packet.c index e02238bfd..ec8a64121 100644 --- a/g10/parse-packet.c +++ b/g10/parse-packet.c @@ -211,7 +211,7 @@ set_packet_list_mode (int mode) enable the list mode only with a special option. */ if (!listfp) { - if (opt.list_packets == 2) + if (opt.list_packets) { listfp = es_stdout; if (opt.verbose) @@ -1335,6 +1335,19 @@ dump_sig_subpkt (int hashed, int type, int critical, (ulong) buf32_to_u32 (buffer), (ulong) buf32_to_u32 (buffer + 4)); break; + case SIGSUBPKT_ISSUER_FPR: + if (length >= 21) + { + char *tmp; + es_fprintf (listfp, "issuer fpr v%d ", buffer[0]); + tmp = bin2hex (buffer+1, length-1, NULL); + if (tmp) + { + es_fputs (tmp, listfp); + xfree (tmp); + } + } + break; case SIGSUBPKT_NOTATION: { es_fputs ("notation: ", listfp); @@ -1485,6 +1498,10 @@ parse_one_sig_subpkt (const byte * buffer, size_t n, int type) if (n < 8) break; return 0; + case SIGSUBPKT_ISSUER_FPR: /* issuer key ID */ + if (n < 21) + break; + return 0; case SIGSUBPKT_NOTATION: /* minimum length needed, and the subpacket must be well-formed where the name length and value length all fit inside the @@ -1543,6 +1560,7 @@ can_handle_critical (const byte * buffer, size_t n, int type) case SIGSUBPKT_REVOCABLE: case SIGSUBPKT_REV_KEY: case SIGSUBPKT_ISSUER: /* issuer key ID */ + case SIGSUBPKT_ISSUER_FPR: /* issuer fingerprint */ case SIGSUBPKT_PREF_SYM: case SIGSUBPKT_PREF_HASH: case SIGSUBPKT_PREF_COMPR: diff --git a/g10/pkclist.c b/g10/pkclist.c index 8efa95432..6315a6d55 100644 --- a/g10/pkclist.c +++ b/g10/pkclist.c @@ -775,14 +775,16 @@ expand_id(const char *id,strlist_t *into,unsigned int flags) } /* For simplicity, and to avoid potential loops, we only expand once - - you can't make an alias that points to an alias. */ + * you can't make an alias that points to an alias. */ static strlist_t -expand_group(strlist_t input) +expand_group (strlist_t input) { - strlist_t sl,output=NULL,rover; + strlist_t output = NULL; + strlist_t sl, rover; - for(rover=input;rover;rover=rover->next) - if(expand_id(rover->d,&output,rover->flags)==0) + for (rover = input; rover; rover = rover->next) + if (!(rover->flags & PK_LIST_FROM_FILE) + && !expand_id(rover->d,&output,rover->flags)) { /* Didn't find any groups, so use the existing string */ sl=add_to_strlist(&output,rover->d); @@ -794,17 +796,18 @@ expand_group(strlist_t input) /* Helper for build_pk_list to find and check one key. This helper is - also used directly in server mode by the RECIPIENTS command. On - success the new key is added to PK_LIST_ADDR. NAME is the user id - of the key. USE the requested usage and a set MARK_HIDDEN will mark - the key in the updated list as a hidden recipient. */ + * also used directly in server mode by the RECIPIENTS command. On + * success the new key is added to PK_LIST_ADDR. NAME is the user id + * of the key. USE the requested usage and a set MARK_HIDDEN will + * mark the key in the updated list as a hidden recipient. If + * FROM_FILE is true, NAME is is not a user ID but the name of a file + * holding a key. */ gpg_error_t find_and_check_key (ctrl_t ctrl, const char *name, unsigned int use, - int mark_hidden, pk_list_t *pk_list_addr) + int mark_hidden, int from_file, pk_list_t *pk_list_addr) { int rc; PKT_public_key *pk; - int trustlevel; if (!name || !*name) return gpg_error (GPG_ERR_INV_USER_ID); @@ -814,7 +817,10 @@ find_and_check_key (ctrl_t ctrl, const char *name, unsigned int use, return gpg_error_from_syserror (); pk->req_usage = use; - rc = get_pubkey_byname (ctrl, NULL, pk, name, NULL, NULL, 0, 0); + if (from_file) + rc = get_pubkey_fromfile (ctrl, pk, name); + else + rc = get_pubkey_byname (ctrl, NULL, pk, name, NULL, NULL, 0, 0); if (rc) { int code; @@ -844,24 +850,28 @@ find_and_check_key (ctrl_t ctrl, const char *name, unsigned int use, } /* Key found and usable. Check validity. */ - trustlevel = get_validity (ctrl, pk, pk->user_id, NULL, 1); - if ( (trustlevel & TRUST_FLAG_DISABLED) ) + if (!from_file) { - /* Key has been disabled. */ - send_status_inv_recp (13, name); - log_info (_("%s: skipped: public key is disabled\n"), name); - free_public_key (pk); - return GPG_ERR_UNUSABLE_PUBKEY; - } + int trustlevel; - if ( !do_we_trust_pre (pk, trustlevel) ) - { - /* We don't trust this key. */ - send_status_inv_recp (10, name); - free_public_key (pk); - return GPG_ERR_UNUSABLE_PUBKEY; + trustlevel = get_validity (ctrl, pk, pk->user_id, NULL, 1); + if ( (trustlevel & TRUST_FLAG_DISABLED) ) + { + /* Key has been disabled. */ + send_status_inv_recp (13, name); + log_info (_("%s: skipped: public key is disabled\n"), name); + free_public_key (pk); + return GPG_ERR_UNUSABLE_PUBKEY; + } + + if ( !do_we_trust_pre (pk, trustlevel) ) + { + /* We don't trust this key. */ + send_status_inv_recp (10, name); + free_public_key (pk); + return GPG_ERR_UNUSABLE_PUBKEY; + } } - /* Note: do_we_trust may have changed the trustlevel. */ /* Skip the actual key if the key is already present in the list. */ @@ -894,22 +904,24 @@ find_and_check_key (ctrl_t ctrl, const char *name, unsigned int use, /* This is the central function to collect the keys for recipients. - It is thus used to prepare a public key encryption. encrypt-to - keys, default keys and the keys for the actual recipients are all - collected here. When not in batch mode and no recipient has been - passed on the commandline, the function will also ask for - recipients. - - RCPTS is a string list with the recipients; NULL is an allowed - value but not very useful. Group expansion is done on these names; - they may be in any of the user Id formats we can handle. The flags - bits for each string in the string list are used for: - Bit 0 (PK_LIST_ENCRYPT_TO): This is an encrypt-to recipient. - Bit 1 (PK_LIST_HIDDEN) : This is a hidden recipient. - - On success a list of keys is stored at the address RET_PK_LIST; the - caller must free this list. On error the value at this address is - not changed. + * It is thus used to prepare a public key encryption. encrypt-to + * keys, default keys and the keys for the actual recipients are all + * collected here. When not in batch mode and no recipient has been + * passed on the commandline, the function will also ask for + * recipients. + * + * RCPTS is a string list with the recipients; NULL is an allowed + * value but not very useful. Group expansion is done on these names; + * they may be in any of the user Id formats we can handle. The flags + * bits for each string in the string list are used for: + * + * - PK_LIST_ENCRYPT_TO :: This is an encrypt-to recipient. + * - PK_LIST_HIDDEN :: This is a hidden recipient. + * - PK_LIST_FROM_FILE :: The argument is a file with a key. + * + * On success a list of keys is stored at the address RET_PK_LIST; the + * caller must free this list. On error the value at this address is + * not changed. */ int build_pk_list (ctrl_t ctrl, strlist_t rcpts, PK_LIST *ret_pk_list) @@ -1269,6 +1281,7 @@ build_pk_list (ctrl_t ctrl, strlist_t rcpts, PK_LIST *ret_pk_list) rc = find_and_check_key (ctrl, remusr->d, PUBKEY_USAGE_ENC, !!(remusr->flags&PK_LIST_HIDDEN), + !!(remusr->flags&PK_LIST_FROM_FILE), &pk_list); if (rc) goto fail; diff --git a/g10/plaintext.c b/g10/plaintext.c index e118f6b4d..c9fb67cdc 100644 --- a/g10/plaintext.c +++ b/g10/plaintext.c @@ -217,11 +217,16 @@ handle_plaintext (PKT_plaintext * pt, md_filter_context_t * mfx, static off_t count = 0; int err = 0; int c; - int convert = (pt->mode == 't' || pt->mode == 'u'); + int convert; #ifdef __riscos__ int filetype = 0xfff; #endif + if (pt->mode == 't' || pt->mode == 'u' || pt->mode == 'm') + convert = pt->mode; + else + convert = 0; + /* Let people know what the plaintext info is. This allows the receiving program to try and do something different based on the format code (say, recode UTF-8 to local). */ @@ -279,8 +284,10 @@ handle_plaintext (PKT_plaintext * pt, md_filter_context_t * mfx, if (mfx->md) gcry_md_putc (mfx->md, c); #ifndef HAVE_DOSISH_SYSTEM - if (c == '\r') /* convert to native line ending */ - continue; /* fixme: this hack might be too simple */ + /* Convert to native line ending. */ + /* fixme: this hack might be too simple */ + if (c == '\r' && convert != 'm') + continue; #endif if (fp) { @@ -354,7 +361,7 @@ handle_plaintext (PKT_plaintext * pt, md_filter_context_t * mfx, if (mfx->md) gcry_md_putc (mfx->md, c); #ifndef HAVE_DOSISH_SYSTEM - if (convert && c == '\r') + if (c == '\r' && convert != 'm') continue; /* fixme: this hack might be too simple */ #endif if (fp) diff --git a/g10/revoke.c b/g10/revoke.c index 218ca59f0..15a91acbf 100644 --- a/g10/revoke.c +++ b/g10/revoke.c @@ -862,6 +862,16 @@ ask_revocation_reason( int key_rev, int cert_rev, int hint ) return reason; } +struct revocation_reason_info * +get_default_uid_revocation_reason(void) +{ + struct revocation_reason_info *reason; + reason = xmalloc( sizeof *reason ); + reason->code = 0x20; /* uid is no longer valid */ + reason->desc = strdup(""); /* no text */ + return reason; +} + void release_revocation_reason_info( struct revocation_reason_info *reason ) { diff --git a/g10/server.c b/g10/server.c index 771a8a7a9..258f08a5d 100644 --- a/g10/server.c +++ b/g10/server.c @@ -177,6 +177,7 @@ output_notify (assuan_context_t ctx, char *line) /* RECIPIENT [--hidden] + RECIPIENT [--hidden] --file Set the recipient for the encryption. should be the internal representation of the key; the server may accept any other @@ -192,9 +193,10 @@ cmd_recipient (assuan_context_t ctx, char *line) { ctrl_t ctrl = assuan_get_pointer (ctx); gpg_error_t err; - int hidden; + int hidden, file; hidden = has_option (line,"--hidden"); + file = has_option (line,"--file"); line = skip_options (line); /* FIXME: Expand groups @@ -204,7 +206,7 @@ cmd_recipient (assuan_context_t ctx, char *line) remusr = rcpts; */ - err = find_and_check_key (ctrl, line, PUBKEY_USAGE_ENC, hidden, + err = find_and_check_key (ctrl, line, PUBKEY_USAGE_ENC, hidden, file, &ctrl->server_local->recplist); if (err) diff --git a/g10/sign.c b/g10/sign.c index a4974be85..6a7a87e03 100644 --- a/g10/sign.c +++ b/g10/sign.c @@ -156,6 +156,7 @@ mk_notation_policy_etc (PKT_signature *sig, if (DBG_LOOKUP) log_debug ("setting Signer's UID to '%s'\n", mbox); build_sig_subpkt (sig, SIGSUBPKT_SIGNERS_UID, mbox, strlen (mbox)); + xfree (mbox); } } } @@ -604,7 +605,7 @@ write_plaintext_packet (IOBUF out, IOBUF inp, const char *fname, int ptmode) * data, it is not possible to know the used length * without a double read of the file - to avoid that * we simple use partial length packets. */ - if ( ptmode == 't' ) + if ( ptmode == 't' || ptmode == 'u' || ptmode == 'm') filesize = 0; } else @@ -627,6 +628,7 @@ write_plaintext_packet (IOBUF out, IOBUF inp, const char *fname, int ptmode) log_error ("build_packet(PLAINTEXT) failed: %s\n", gpg_strerror (rc) ); pt->buf = NULL; + free_packet (&pkt); } else { byte copy_buffer[4096]; @@ -690,7 +692,7 @@ write_signature_packets (SK_LIST sk_list, IOBUF out, gcry_md_hd_t hash, if (sig->version >= 4) { - build_sig_subpkt_from_sig (sig); + build_sig_subpkt_from_sig (sig, pk); mk_notation_policy_etc (sig, NULL, pk); } @@ -1031,7 +1033,8 @@ sign_file (ctrl_t ctrl, strlist_t filenames, int detached, strlist_t locusr, } else { rc = write_plaintext_packet (out, inp, fname, - opt.textmode && !outfile ? 't':'b'); + opt.textmode && !outfile ? + (opt.mimemode? 'm':'t'):'b'); } /* catch errors from above */ @@ -1335,7 +1338,8 @@ sign_symencrypt_file (ctrl_t ctrl, const char *fname, strlist_t locusr) /* Pipe data through all filters; i.e. write the signed stuff */ /*(current filters: zip - encrypt - armor)*/ - rc = write_plaintext_packet (out, inp, fname, opt.textmode ? 't':'b'); + rc = write_plaintext_packet (out, inp, fname, + opt.textmode ? (opt.mimemode?'m':'t'):'b'); if (rc) goto leave; @@ -1456,7 +1460,7 @@ make_keysig_packet (PKT_signature **ret_sig, PKT_public_key *pk, sig->expiredate=sig->timestamp+duration; sig->sig_class = sigclass; - build_sig_subpkt_from_sig( sig ); + build_sig_subpkt_from_sig (sig, pksk); mk_notation_policy_etc (sig, pk, pksk); /* Crucial that the call to mksubpkt comes LAST before the calls @@ -1559,7 +1563,7 @@ update_keysig_packet( PKT_signature **ret_sig, automagically lower any sig expiration dates to correctly correspond to the differences in the timestamps (i.e. the duration will shrink). */ - build_sig_subpkt_from_sig( sig ); + build_sig_subpkt_from_sig (sig, pksk); if (mksubpkt) rc = (*mksubpkt)(sig, opaque); diff --git a/g10/t-keydb-get-keyblock.c b/g10/t-keydb-get-keyblock.c index c12bab182..cab1448da 100644 --- a/g10/t-keydb-get-keyblock.c +++ b/g10/t-keydb-get-keyblock.c @@ -59,4 +59,6 @@ do_test (int argc, char *argv[]) rc = keydb_get_keyblock (hd1, &kb1); TEST_P ("", ! rc); + + keydb_release (hd1); } diff --git a/g10/t-keydb.c b/g10/t-keydb.c index f0b7778b6..3606e2ea2 100644 --- a/g10/t-keydb.c +++ b/g10/t-keydb.c @@ -27,7 +27,7 @@ do_test (int argc, char *argv[]) int rc; KEYDB_HANDLE hd1, hd2; KEYDB_SEARCH_DESC desc1, desc2; - KBNODE kb1, kb2; + KBNODE kb1, kb2, p; char *uid1; char *uid2; char *fname; @@ -75,17 +75,19 @@ do_test (int argc, char *argv[]) if (rc) ABORT ("Failed to get keyblock for DBFC6AD9"); - while (kb1 && kb1->pkt->pkttype != PKT_USER_ID) - kb1 = kb1->next; - if (! kb1) + p = kb1; + while (p && p->pkt->pkttype != PKT_USER_ID) + p = p->next; + if (! p) ABORT ("DBFC6AD9 has no user id packet"); - uid1 = kb1->pkt->pkt.user_id->name; + uid1 = p->pkt->pkt.user_id->name; - while (kb2 && kb2->pkt->pkttype != PKT_USER_ID) - kb2 = kb2->next; - if (! kb2) + p = kb2; + while (p && p->pkt->pkttype != PKT_USER_ID) + p = p->next; + if (! p) ABORT ("1E42B367 has no user id packet"); - uid2 = kb2->pkt->pkt.user_id->name; + uid2 = p->pkt->pkt.user_id->name; if (verbose) { @@ -94,4 +96,9 @@ do_test (int argc, char *argv[]) } TEST_P ("cache consistency", strcmp (uid1, uid2) != 0); + + release_kbnode (kb1); + release_kbnode (kb2); + keydb_release (hd1); + keydb_release (hd2); } diff --git a/g10/t-stutter.c b/g10/t-stutter.c index 9576027a3..f3fc65330 100644 --- a/g10/t-stutter.c +++ b/g10/t-stutter.c @@ -606,5 +606,6 @@ main (int argc, char *argv[]) log_fatal ("Message is too short, nothing to test.\n"); } + xfree (filename); return failed; } diff --git a/g10/test-stubs.c b/g10/test-stubs.c index 42c91f869..6f50759d5 100644 --- a/g10/test-stubs.c +++ b/g10/test-stubs.c @@ -176,6 +176,17 @@ keyserver_import_keyid (u32 *keyid, void *dummy) return -1; } +int +keyserver_import_fprint (ctrl_t ctrl, const byte *fprint,size_t fprint_len, + struct keyserver_spec *keyserver) +{ + (void)ctrl; + (void)fprint; + (void)fprint_len; + (void)keyserver; + return -1; +} + int keyserver_import_cert (const char *name) { @@ -217,6 +228,15 @@ keyserver_import_ldap (const char *name) return -1; } +gpg_error_t +read_key_from_file (ctrl_t ctrl, const char *fname, kbnode_t *r_keyblock) +{ + (void)ctrl; + (void)fname; + (void)r_keyblock; + return -1; +} + /* Stub: * No encryption here but mainproc links to these functions. */ diff --git a/g10/textfilter.c b/g10/textfilter.c index 5929c5f46..6ca4f8806 100644 --- a/g10/textfilter.c +++ b/g10/textfilter.c @@ -240,5 +240,6 @@ copy_clearsig_text( IOBUF out, IOBUF inp, gcry_md_hd_t md, if( truncated ) log_info(_("input line longer than %d characters\n"), MAX_LINELEN ); + xfree (buffer); return 0; /* okay */ } diff --git a/g10/trustdb.c b/g10/trustdb.c index 527a23d2f..dd74d187b 100644 --- a/g10/trustdb.c +++ b/g10/trustdb.c @@ -1022,17 +1022,18 @@ tdb_get_validity_core (ctrl_t ctrl, #ifdef USE_TOFU if (opt.trust_model == TM_TOFU || opt.trust_model == TM_TOFU_PGP) { - kbnode_t user_id_node = NULL; /* Silence -Wmaybe-uninitialized. */ + kbnode_t user_id_node = NULL; + kbnode_t n = NULL; /* Silence -Wmaybe-uninitialized. */ int user_ids = 0; int user_ids_expired = 0; /* If the caller didn't supply a user id then iterate over all uids. */ if (! uid) - user_id_node = get_pubkeyblock (main_pk->keyid); + user_id_node = n = get_pubkeyblock (main_pk->keyid); while (uid - || (user_id_node = find_next_kbnode (user_id_node, PKT_USER_ID))) + || (n = find_next_kbnode (n, PKT_USER_ID))) { unsigned int tl; PKT_user_id *user_id; @@ -1040,7 +1041,7 @@ tdb_get_validity_core (ctrl_t ctrl, if (uid) user_id = uid; else - user_id = user_id_node->pkt->pkt.user_id; + user_id = n->pkt->pkt.user_id; /* If the user id is revoked or expired, then skip it. */ if (user_id->is_revoked || user_id->is_expired) @@ -1094,6 +1095,7 @@ tdb_get_validity_core (ctrl_t ctrl, now. */ break; } + release_kbnode (user_id_node); } #endif /*USE_TOFU*/ diff --git a/g13/g13tuple.c b/g13/g13tuple.c index fc6644cb7..ddcb46715 100644 --- a/g13/g13tuple.c +++ b/g13/g13tuple.c @@ -114,7 +114,7 @@ create_tupledesc (tupledesc_t *r_desc, void *data, size_t datalen) (*r_desc)->data = data; (*r_desc)->datalen = datalen; (*r_desc)->pos = 0; - (*r_desc)->refcount++; + (*r_desc)->refcount = 1; return 0; } diff --git a/kbx/keybox-blob.c b/kbx/keybox-blob.c index 556605a84..896f137b8 100644 --- a/kbx/keybox-blob.c +++ b/kbx/keybox-blob.c @@ -661,18 +661,24 @@ create_blob_finish (KEYBOXBLOB blob) /* do the fixups */ if (blob->fixup_out_of_core) - return gpg_error (GPG_ERR_ENOMEM); + { + xfree (p); + return gpg_error (GPG_ERR_ENOMEM); + } { - struct fixup_list *fl; - for (fl = blob->fixups; fl; fl = fl->next) + struct fixup_list *fl, *next; + for (fl = blob->fixups; fl; fl = next) { assert (fl->off+4 <= n); p[fl->off+0] = fl->val >> 24; p[fl->off+1] = fl->val >> 16; p[fl->off+2] = fl->val >> 8; p[fl->off+3] = fl->val; + next = fl->next; + xfree (fl); } + blob->fixups = NULL; } /* Compute and store the SHA-1 checksum. */ @@ -680,8 +686,12 @@ create_blob_finish (KEYBOXBLOB blob) pp = xtrymalloc (n); if ( !pp ) - return gpg_error_from_syserror (); + { + xfree (p); + return gpg_error_from_syserror (); + } memcpy (pp , p, n); + xfree (p); blob->blob = pp; blob->bloblen = n; @@ -1000,7 +1010,11 @@ _keybox_release_blob (KEYBOXBLOB blob) int i; if (!blob) return; - /* hmmm: release membuf here?*/ + if (blob->buf) + { + size_t len; + xfree (get_membuf (blob->buf, &len)); + } xfree (blob->keys ); xfree (blob->serialbuf); for (i=0; i < blob->nuids; i++) diff --git a/m4/Makefile.am b/m4/Makefile.am index f1b8df9bd..3232413a5 100644 --- a/m4/Makefile.am +++ b/m4/Makefile.am @@ -1,6 +1,6 @@ EXTRA_DIST = intl.m4 intldir.m4 glibc2.m4 lock.m4 visibility.m4 intmax.m4 longdouble.m4 printf-posix.m4 signed.m4 size_max.m4 wchar_t.m4 wint_t.m4 xsize.m4 codeset.m4 gettext.m4 glibc21.m4 iconv.m4 intdiv0.m4 inttypes.m4 inttypes_h.m4 inttypes-pri.m4 isc-posix.m4 lcmessage.m4 lib-ld.m4 lib-link.m4 lib-prefix.m4 progtest.m4 stdint_h.m4 uintmax_t.m4 -EXTRA_DIST += ldap.m4 libcurl.m4 libusb.m4 tar-ustar.m4 readline.m4 +EXTRA_DIST += ldap.m4 libcurl.m4 libusb.m4 tar-ustar.m4 readline.m4 pkg.m4 EXTRA_DIST += gnupg-pth.m4 diff --git a/m4/pkg.m4 b/m4/pkg.m4 new file mode 100644 index 000000000..78953b711 --- /dev/null +++ b/m4/pkg.m4 @@ -0,0 +1,214 @@ +# pkg.m4 - Macros to locate and utilise pkg-config. -*- Autoconf -*- +# serial 1 (pkg-config-0.24) +# +# Copyright © 2004 Scott James Remnant . +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + +# PKG_PROG_PKG_CONFIG([MIN-VERSION]) +# ---------------------------------- +AC_DEFUN([PKG_PROG_PKG_CONFIG], +[m4_pattern_forbid([^_?PKG_[A-Z_]+$]) +m4_pattern_allow([^PKG_CONFIG(_(PATH|LIBDIR|SYSROOT_DIR|ALLOW_SYSTEM_(CFLAGS|LIBS)))?$]) +m4_pattern_allow([^PKG_CONFIG_(DISABLE_UNINSTALLED|TOP_BUILD_DIR|DEBUG_SPEW)$]) +AC_ARG_VAR([PKG_CONFIG], [path to pkg-config utility]) +AC_ARG_VAR([PKG_CONFIG_PATH], [directories to add to pkg-config's search path]) +AC_ARG_VAR([PKG_CONFIG_LIBDIR], [path overriding pkg-config's built-in search path]) + +if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then + AC_PATH_TOOL([PKG_CONFIG], [pkg-config]) +fi +if test -n "$PKG_CONFIG"; then + _pkg_min_version=m4_default([$1], [0.9.0]) + AC_MSG_CHECKING([pkg-config is at least version $_pkg_min_version]) + if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + PKG_CONFIG="" + fi +fi[]dnl +])# PKG_PROG_PKG_CONFIG + +# PKG_CHECK_EXISTS(MODULES, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) +# +# Check to see whether a particular set of modules exists. Similar +# to PKG_CHECK_MODULES(), but does not set variables or print errors. +# +# Please remember that m4 expands AC_REQUIRE([PKG_PROG_PKG_CONFIG]) +# only at the first occurence in configure.ac, so if the first place +# it's called might be skipped (such as if it is within an "if", you +# have to call PKG_CHECK_EXISTS manually +# -------------------------------------------------------------- +AC_DEFUN([PKG_CHECK_EXISTS], +[AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl +if test -n "$PKG_CONFIG" && \ + AC_RUN_LOG([$PKG_CONFIG --exists --print-errors "$1"]); then + m4_default([$2], [:]) +m4_ifvaln([$3], [else + $3])dnl +fi]) + +# _PKG_CONFIG([VARIABLE], [COMMAND], [MODULES]) +# --------------------------------------------- +m4_define([_PKG_CONFIG], +[if test -n "$$1"; then + pkg_cv_[]$1="$$1" + elif test -n "$PKG_CONFIG"; then + PKG_CHECK_EXISTS([$3], + [pkg_cv_[]$1=`$PKG_CONFIG --[]$2 "$3" 2>/dev/null` + test "x$?" != "x0" && pkg_failed=yes ], + [pkg_failed=yes]) + else + pkg_failed=untried +fi[]dnl +])# _PKG_CONFIG + +# _PKG_SHORT_ERRORS_SUPPORTED +# ----------------------------- +AC_DEFUN([_PKG_SHORT_ERRORS_SUPPORTED], +[AC_REQUIRE([PKG_PROG_PKG_CONFIG]) +if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then + _pkg_short_errors_supported=yes +else + _pkg_short_errors_supported=no +fi[]dnl +])# _PKG_SHORT_ERRORS_SUPPORTED + + +# PKG_CHECK_MODULES(VARIABLE-PREFIX, MODULES, [ACTION-IF-FOUND], +# [ACTION-IF-NOT-FOUND]) +# +# +# Note that if there is a possibility the first call to +# PKG_CHECK_MODULES might not happen, you should be sure to include an +# explicit call to PKG_PROG_PKG_CONFIG in your configure.ac +# +# +# -------------------------------------------------------------- +AC_DEFUN([PKG_CHECK_MODULES], +[AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl +AC_ARG_VAR([$1][_CFLAGS], [C compiler flags for $1, overriding pkg-config])dnl +AC_ARG_VAR([$1][_LIBS], [linker flags for $1, overriding pkg-config])dnl + +pkg_failed=no +AC_MSG_CHECKING([for $1]) + +_PKG_CONFIG([$1][_CFLAGS], [cflags], [$2]) +_PKG_CONFIG([$1][_LIBS], [libs], [$2]) + +m4_define([_PKG_TEXT], [Alternatively, you may set the environment variables $1[]_CFLAGS +and $1[]_LIBS to avoid the need to call pkg-config. +See the pkg-config man page for more details.]) + +if test $pkg_failed = yes; then + AC_MSG_RESULT([no]) + _PKG_SHORT_ERRORS_SUPPORTED + if test $_pkg_short_errors_supported = yes; then + $1[]_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "$2" 2>&1` + else + $1[]_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "$2" 2>&1` + fi + # Put the nasty error message in config.log where it belongs + echo "$$1[]_PKG_ERRORS" >&AS_MESSAGE_LOG_FD + + m4_default([$4], [AC_MSG_ERROR( +[Package requirements ($2) were not met: + +$$1_PKG_ERRORS + +Consider adjusting the PKG_CONFIG_PATH environment variable if you +installed software in a non-standard prefix. + +_PKG_TEXT])[]dnl + ]) +elif test $pkg_failed = untried; then + AC_MSG_RESULT([no]) + m4_default([$4], [AC_MSG_FAILURE( +[The pkg-config script could not be found or is too old. Make sure it +is in your PATH or set the PKG_CONFIG environment variable to the full +path to pkg-config. + +_PKG_TEXT + +To get pkg-config, see .])[]dnl + ]) +else + $1[]_CFLAGS=$pkg_cv_[]$1[]_CFLAGS + $1[]_LIBS=$pkg_cv_[]$1[]_LIBS + AC_MSG_RESULT([yes]) + $3 +fi[]dnl +])# PKG_CHECK_MODULES + + +# PKG_INSTALLDIR(DIRECTORY) +# ------------------------- +# Substitutes the variable pkgconfigdir as the location where a module +# should install pkg-config .pc files. By default the directory is +# $libdir/pkgconfig, but the default can be changed by passing +# DIRECTORY. The user can override through the --with-pkgconfigdir +# parameter. +AC_DEFUN([PKG_INSTALLDIR], +[m4_pushdef([pkg_default], [m4_default([$1], ['${libdir}/pkgconfig'])]) +m4_pushdef([pkg_description], + [pkg-config installation directory @<:@]pkg_default[@:>@]) +AC_ARG_WITH([pkgconfigdir], + [AS_HELP_STRING([--with-pkgconfigdir], pkg_description)],, + [with_pkgconfigdir=]pkg_default) +AC_SUBST([pkgconfigdir], [$with_pkgconfigdir]) +m4_popdef([pkg_default]) +m4_popdef([pkg_description]) +]) dnl PKG_INSTALLDIR + + +# PKG_NOARCH_INSTALLDIR(DIRECTORY) +# ------------------------- +# Substitutes the variable noarch_pkgconfigdir as the location where a +# module should install arch-independent pkg-config .pc files. By +# default the directory is $datadir/pkgconfig, but the default can be +# changed by passing DIRECTORY. The user can override through the +# --with-noarch-pkgconfigdir parameter. +AC_DEFUN([PKG_NOARCH_INSTALLDIR], +[m4_pushdef([pkg_default], [m4_default([$1], ['${datadir}/pkgconfig'])]) +m4_pushdef([pkg_description], + [pkg-config arch-independent installation directory @<:@]pkg_default[@:>@]) +AC_ARG_WITH([noarch-pkgconfigdir], + [AS_HELP_STRING([--with-noarch-pkgconfigdir], pkg_description)],, + [with_noarch_pkgconfigdir=]pkg_default) +AC_SUBST([noarch_pkgconfigdir], [$with_noarch_pkgconfigdir]) +m4_popdef([pkg_default]) +m4_popdef([pkg_description]) +]) dnl PKG_NOARCH_INSTALLDIR + + +# PKG_CHECK_VAR(VARIABLE, MODULE, CONFIG-VARIABLE, +# [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) +# ------------------------------------------- +# Retrieves the value of the pkg-config variable for the given module. +AC_DEFUN([PKG_CHECK_VAR], +[AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl +AC_ARG_VAR([$1], [value of $3 for $2, overriding pkg-config])dnl + +_PKG_CONFIG([$1], [variable="][$3]["], [$2]) +AS_VAR_COPY([$1], [pkg_cv_][$1]) + +AS_VAR_IF([$1], [""], [$5], [$4])dnl +])# PKG_CHECK_VAR diff --git a/scd/ccid-driver.c b/scd/ccid-driver.c index 985404f86..7a093f683 100644 --- a/scd/ccid-driver.c +++ b/scd/ccid-driver.c @@ -975,7 +975,7 @@ parse_ccid_descriptor (ccid_driver_t handle, handle->max_ifsd = 48; } - if (handle->id_vendor == VENDOR_GEMPC && handle->id_product == GEMPC_CT30) + if (handle->id_vendor == VENDOR_GEMPC) { DEBUGOUT ("enabling product quirk: disable non-null NAD\n"); handle->nonnull_nad = 0; diff --git a/scd/scdaemon.c b/scd/scdaemon.c index 9c11cad46..7dbb9c745 100644 --- a/scd/scdaemon.c +++ b/scd/scdaemon.c @@ -156,6 +156,7 @@ static ARGPARSE_OPTS opts[] = { ARGPARSE_s_s (oDisableApplication, "disable-application", "@"), ARGPARSE_s_n (oEnablePinpadVarlen, "enable-pinpad-varlen", N_("use variable length input for pinpad")), + ARGPARSE_s_s (oHomedir, "homedir", "@"), ARGPARSE_end () }; diff --git a/tests/Makefile.am b/tests/Makefile.am index 307d82952..f349763a6 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -25,7 +25,7 @@ else openpgp = endif -SUBDIRS = ${openpgp} . pkits +SUBDIRS = gpgscm ${openpgp} . migrations pkits GPGSM = ../sm/gpgsm @@ -48,12 +48,12 @@ EXTRA_DIST = runtest inittests $(testscripts) ChangeLog-2011 \ samplekeys/cert_g10code_test1.pem \ samplekeys/cert_g10code_theo1.pem -# We used to run $(testscripts) here but these asschk scripts ares not -# completely reliable in all enviromnets and thus we better disable -# them. The tests are anyway way to minimal. We will eventually +# We used to run $(testscripts) here but these asschk scripts are not +# completely reliable in all enviroments and thus we better disable +# them. The tests are anyway way too minimal. We will eventually # write new tests based on gpg-connect-agent which has a full fledged # script language and thus makes it far easier to write tests than to -# use the low--level asschk stuff. +# use that low-level asschk stuff. TESTS = CLEANFILES = inittests.stamp x y y z out err \ diff --git a/tests/gpgscm/LICENSE.TinySCHEME b/tests/gpgscm/LICENSE.TinySCHEME new file mode 100644 index 000000000..23a7e85a5 --- /dev/null +++ b/tests/gpgscm/LICENSE.TinySCHEME @@ -0,0 +1,31 @@ + LICENSE TERMS + +Copyright (c) 2000, Dimitrios Souflis +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +Neither the name of Dimitrios Souflis nor the names of the +contributors may be used to endorse or promote products derived from +this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR +CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/tests/gpgscm/Makefile.am b/tests/gpgscm/Makefile.am new file mode 100644 index 000000000..e57a4bbe4 --- /dev/null +++ b/tests/gpgscm/Makefile.am @@ -0,0 +1,59 @@ +# TinyScheme-based test driver. +# +# Copyright (C) 2016 g10 Code GmbH +# +# This file is part of GnuPG. +# +# GnuPG is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# GnuPG is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, see . + +EXTRA_DIST = \ + LICENSE.TinySCHEME \ + Manual.txt \ + ffi.scm \ + init.scm \ + lib.scm \ + repl.scm \ + t-child.scm \ + tests.scm + +AM_CPPFLAGS = -I$(top_srcdir)/common +include $(top_srcdir)/am/cmacros.am + +AM_CFLAGS = + +CLEANFILES = + +bin_PROGRAMS = gpgscm +noinst_PROGRAMS = t-child + +common_libs = ../$(libcommon) +commonpth_libs = ../$(libcommonpth) + +gpgscm_CFLAGS = -imacros scheme-config.h \ + $(LIBGCRYPT_CFLAGS) $(LIBASSUAN_CFLAGS) $(GPG_ERROR_CFLAGS) +gpgscm_SOURCES = main.c private.h ffi.c ffi.h ffi-private.h \ + scheme-config.h opdefines.h scheme.c scheme.h scheme-private.h +gpgscm_LDADD = $(LDADD) $(common_libs) \ + $(NETLIBS) $(LIBICONV) $(LIBREADLINE) \ + $(LIBGCRYPT_LIBS) $(GPG_ERROR_LIBS) + +t_child_SOURCES = t-child.c + +# Make sure that all libs are build before we use them. This is +# important for things like make -j2. +$(PROGRAMS): $(common_libs) + +check-local: gpgscm$(EXEEXT) t-child$(EXEEXT) + EXEEXT=$(EXEEXT) GPGSCM_PATH=$(srcdir) \ + ./gpgscm$(EXEEXT) $(srcdir)/t-child.scm diff --git a/tests/gpgscm/Manual.txt b/tests/gpgscm/Manual.txt new file mode 100644 index 000000000..9fd294fc0 --- /dev/null +++ b/tests/gpgscm/Manual.txt @@ -0,0 +1,444 @@ + + + TinySCHEME Version 1.41 + + "Safe if used as prescribed" + -- Philip K. Dick, "Ubik" + +This software is open source, covered by a BSD-style license. +Please read accompanying file COPYING. +------------------------------------------------------------------------------- + + This Scheme interpreter is based on MiniSCHEME version 0.85k4 + (see miniscm.tar.gz in the Scheme Repository) + Original credits in file MiniSCHEMETribute.txt. + + D. Souflis (dsouflis@acm.org) + +------------------------------------------------------------------------------- + What is TinyScheme? + ------------------- + + TinyScheme is a lightweight Scheme interpreter that implements as large + a subset of R5RS as was possible without getting very large and + complicated. It is meant to be used as an embedded scripting interpreter + for other programs. As such, it does not offer IDEs or extensive toolkits + although it does sport a small top-level loop, included conditionally. + A lot of functionality in TinyScheme is included conditionally, to allow + developers freedom in balancing features and footprint. + + As an embedded interpreter, it allows multiple interpreter states to + coexist in the same program, without any interference between them. + Programmatically, foreign functions in C can be added and values + can be defined in the Scheme environment. Being a quite small program, + it is easy to comprehend, get to grips with, and use. + + Known bugs + ---------- + + TinyScheme is known to misbehave when memory is exhausted. + + + Things that keep missing, or that need fixing + --------------------------------------------- + + There are no hygienic macros. No rational or + complex numbers. No unwind-protect and call-with-values. + + Maybe (a subset of) SLIB will work with TinySCHEME... + + Decent debugging facilities are missing. Only tracing is supported + natively. + + + Scheme Reference + ---------------- + + If something seems to be missing, please refer to the code and + "init.scm", since some are library functions. Refer to the MiniSCHEME + readme as a last resort. + + Environments + (interaction-environment) + See R5RS. In TinySCHEME, immutable list of association lists. + + (current-environment) + The environment in effect at the time of the call. An example of its + use and its utility can be found in the sample code that implements + packages in "init.scm": + + (macro (package form) + `(apply (lambda () + ,@(cdr form) + (current-environment)))) + + The environment containing the (local) definitions inside the closure + is returned as an immutable value. + + (defined? ) (defined? ) + Checks whether the given symbol is defined in the current (or given) + environment. + + Symbols + (gensym) + Returns a new interned symbol each time. Will probably move to the + library when string->symbol is implemented. + + Directives + (gc) + Performs garbage collection immediatelly. + + (gc-verbose) (gc-verbose ) + The argument (defaulting to #t) controls whether GC produces + visible outcome. + + (quit) (quit ) + Stops the interpreter and sets the 'retcode' internal field (defaults + to 0). When standalone, 'retcode' is returned as exit code to the OS. + + (tracing ) + 1, turns on tracing. 0 turns it off. (Only when USE_TRACING is 1). + + Mathematical functions + Since rationals and complexes are absent, the respective functions + are also missing. + Supported: exp, log, sin, cos, tan, asin, acos, atan, floor, ceiling, + trunc, round and also sqrt and expt when USE_MATH=1. + Number-theoretical quotient, remainder and modulo, gcd, lcm. + Library: exact?, inexact?, odd?, even?, zero?, positive?, negative?, + exact->inexact. inexact->exact is a core function. + + Type predicates + boolean?,eof-object?,symbol?,number?,string?,integer?,real?,list?,null?, + char?,port?,input-port?,output-port?,procedure?,pair?,environment?', + vector?. Also closure?, macro?. + + Types + Types supported: + + Numbers (integers and reals) + Symbols + Pairs + Strings + Characters + Ports + Eof object + Environments + Vectors + + Literals + String literals can contain escaped quotes \" as usual, but also + \n, \r, \t, \xDD (hex representations) and \DDD (octal representations). + Note also that it is possible to include literal newlines in string + literals, e.g. + + (define s "String with newline here + and here + that can function like a HERE-string") + + Character literals contain #\space and #\newline and are supplemented + with #\return and #\tab, with obvious meanings. Hex character + representations are allowed (e.g. #\x20 is #\space). + When USE_ASCII_NAMES is defined, various control characters can be + referred to by their ASCII name. + 0 #\nul 17 #\dc1 + 1 #\soh 18 #\dc2 + 2 #\stx 19 #\dc3 + 3 #\etx 20 #\dc4 + 4 #\eot 21 #\nak + 5 #\enq 22 #\syn + 6 #\ack 23 #\etv + 7 #\bel 24 #\can + 8 #\bs 25 #\em + 9 #\ht 26 #\sub + 10 #\lf 27 #\esc + 11 #\vt 28 #\fs + 12 #\ff 29 #\gs + 13 #\cr 30 #\rs + 14 #\so 31 #\us + 15 #\si + 16 #\dle 127 #\del + + Numeric literals support #x #o #b and #d. Flonums are currently read only + in decimal notation. Full grammar will be supported soon. + + Quote, quasiquote etc. + As usual. + + Immutable values + Immutable pairs cannot be modified by set-car! and set-cdr!. + Immutable strings cannot be modified via string-set! + + I/O + As per R5RS, plus String Ports (see below). + current-input-port, current-output-port, + close-input-port, close-output-port, input-port?, output-port?, + open-input-file, open-output-file. + read, write, display, newline, write-char, read-char, peek-char. + char-ready? returns #t only for string ports, because there is no + portable way in stdio to determine if a character is available. + Also open-input-output-file, set-input-port, set-output-port (not R5RS) + Library: call-with-input-file, call-with-output-file, + with-input-from-file, with-output-from-file and + with-input-output-from-to-files, close-port and input-output-port? + (not R5RS). + String Ports: open-input-string, open-output-string, get-output-string, + open-input-output-string. Strings can be used with I/O routines. + + Vectors + make-vector, vector, vector-length, vector-ref, vector-set!, list->vector, + vector-fill!, vector->list, vector-equal? (auxiliary function, not R5RS) + + Strings + string, make-string, list->string, string-length, string-ref, string-set!, + substring, string->list, string-fill!, string-append, string-copy. + string=?, string?, string>?, string<=?, string>=?. + (No string-ci*? yet). string->number, number->string. Also atom->string, + string->atom (not R5RS). + + Symbols + symbol->string, string->symbol + + Characters + integer->char, char->integer. + char=?, char?, char<=?, char>=?. + (No char-ci*?) + + Pairs & Lists + cons, car, cdr, list, length, map, for-each, foldr, list-tail, + list-ref, last-pair, reverse, append. + Also member, memq, memv, based on generic-member, assoc, assq, assv + based on generic-assoc. + + Streams + head, tail, cons-stream + + Control features + Apart from procedure?, also macro? and closure? + map, for-each, force, delay, call-with-current-continuation (or call/cc), + eval, apply. 'Forcing' a value that is not a promise produces the value. + There is no call-with-values, values, nor dynamic-wind. Dynamic-wind in + the presence of continuations would require support from the abstract + machine itself. + + Property lists + TinyScheme inherited from MiniScheme property lists for symbols. + put, get. + + Dynamically-loaded extensions + (load-extension ) + Loads a DLL declaring foreign procedures. On Unix/Linux, one can make use + of the ld.so.conf file or the LD_RUN_PATH system variable in order to place + the library in a directory other than the current one. Please refer to the + appropriate 'man' page. + + Esoteric procedures + (oblist) + Returns the oblist, an immutable list of all the symbols. + + (macro-expand
) + Returns the expanded form of the macro call denoted by the argument + + (define-with-return ( ...) ) + Like plain 'define', but makes the continuation available as 'return' + inside the procedure. Handy for imperative programs. + + (new-segment ) + Allocates more memory segments. + + defined? + See "Environments" + + (get-closure-code ) + Gets the code as scheme data. + + (make-closure ) + Makes a new closure in the given environment. + + Obsolete procedures + (print-width ) + + Programmer's Reference + ---------------------- + + The interpreter state is initialized with "scheme_init". + Custom memory allocation routines can be installed with an alternate + initialization function: "scheme_init_custom_alloc". + Files can be loaded with "scheme_load_file". Strings containing Scheme + code can be loaded with "scheme_load_string". It is a good idea to + "scheme_load" init.scm before anything else. + + External data for keeping external state (of use to foreign functions) + can be installed with "scheme_set_external_data". + Foreign functions are installed with "assign_foreign". Additional + definitions can be added to the interpreter state, with "scheme_define" + (this is the way HTTP header data and HTML form data are passed to the + Scheme script in the Altera SQL Server). If you wish to define the + foreign function in a specific environment (to enhance modularity), + use "assign_foreign_env". + + The procedure "scheme_apply0" has been added with persistent scripts in + mind. Persistent scripts are loaded once, and every time they are needed + to produce HTTP output, appropriate data are passed through global + definitions and function "main" is called to do the job. One could + add easily "scheme_apply1" etc. + + The interpreter state should be deinitialized with "scheme_deinit". + + DLLs containing foreign functions should define a function named + init_. E.g. foo.dll should define init_foo, and bar.so + should define init_bar. This function should assign_foreign any foreign + function contained in the DLL. + + The first dynamically loaded extension available for TinyScheme is + a regular expression library. Although it's by no means an + established standard, this library is supposed to be installed in + a directory mirroring its name under the TinyScheme location. + + + Foreign Functions + ----------------- + + The user can add foreign functions in C. For example, a function + that squares its argument: + + pointer square(scheme *sc, pointer args) { + if(args!=sc->NIL) { + if(sc->isnumber(sc->pair_car(args))) { + double v=sc->rvalue(sc->pair_car(args)); + return sc->mk_real(sc,v*v); + } + } + return sc->NIL; + } + + Foreign functions are now defined as closures: + + sc->interface->scheme_define( + sc, + sc->global_env, + sc->interface->mk_symbol(sc,"square"), + sc->interface->mk_foreign_func(sc, square)); + + + Foreign functions can use the external data in the "scheme" struct + to implement any kind of external state. + + External data are set with the following function: + void scheme_set_external_data(scheme *sc, void *p); + + As of v.1.17, the canonical way for a foreign function in a DLL to + manipulate Scheme data is using the function pointers in sc->interface. + + Standalone + ---------- + + Usage: tinyscheme -? + or: tinyscheme [ ...] + followed by + -1 [ ...] + -c [ ...] + assuming that the executable is named tinyscheme. + + Use - in the place of a filename to denote stdin. + The -1 flag is meant for #! usage in shell scripts. If you specify + #! /somewhere/tinyscheme -1 + then tinyscheme will be called to process the file. For example, the + following script echoes the Scheme list of its arguments. + + #! /somewhere/tinyscheme -1 + (display *args*) + + The -c flag permits execution of arbitrary Scheme code. + + + Error Handling + -------------- + + Errors are recovered from without damage. The user can install his + own handler for system errors, by defining *error-hook*. Defining + to '() gives the default behavior, which is equivalent to "error". + USE_ERROR_HOOK must be defined. + + A simple exception handling mechanism can be found in "init.scm". + A new syntactic form is introduced: + + (catch + ... ) + + "Catch" establishes a scope spanning multiple call-frames + until another "catch" is encountered. + + Exceptions are thrown with: + + (throw "message") + + If used outside a (catch ...), reverts to (error "message"). + + Example of use: + + (define (foo x) (write x) (newline) (/ x 0)) + + (catch (begin (display "Error!\n") 0) + (write "Before foo ... ") + (foo 5) + (write "After foo")) + + The exception mechanism can be used even by system errors, by + + (define *error-hook* throw) + + which makes use of the error hook described above. + + If necessary, the user can devise his own exception mechanism with + tagged exceptions etc. + + + Reader extensions + ----------------- + + When encountering an unknown character after '#', the user-specified + procedure *sharp-hook* (if any), is called to read the expression. + This can be used to extend the reader to handle user-defined constants + or whatever. It should be a procedure without arguments, reading from + the current input port (which will be the load-port). + + + Colon Qualifiers - Packages + --------------------------- + + When USE_COLON_HOOK=1: + The lexer now recognizes the construction :: and + transforms it in the following manner (T is the transformation function): + + T(::) = (*colon-hook* 'T() ) + + where is a symbol not containing any double-colons. + + As the definition is recursive, qualifiers can be nested. + The user can define his own *colon-hook*, to handle qualified names. + By default, "init.scm" defines *colon-hook* as EVAL. Consequently, + the qualifier must denote a Scheme environment, such as one returned + by (interaction-environment). "Init.scm" defines a new syntantic form, + PACKAGE, as a simple example. It is used like this: + + (define toto + (package + (define foo 1) + (define bar +))) + + foo ==> Error, "foo" undefined + (eval 'foo) ==> Error, "foo" undefined + (eval 'foo toto) ==> 1 + toto::foo ==> 1 + ((eval 'bar toto) 2 (eval 'foo toto)) ==> 3 + (toto::bar 2 toto::foo) ==> 3 + (eval (bar 2 foo) toto) ==> 3 + + If the user installs another package infrastructure, he must define + a new 'package' procedure or macro to retain compatibility with supplied + code. + + Note: Older versions used ':' as a qualifier. Unfortunately, the use + of ':' as a pseudo-qualifier in existing code (i.e. SLIB) essentially + precludes its use as a real qualifier. diff --git a/tests/gpgscm/ffi-private.h b/tests/gpgscm/ffi-private.h new file mode 100644 index 000000000..87f491f9f --- /dev/null +++ b/tests/gpgscm/ffi-private.h @@ -0,0 +1,148 @@ +/* FFI interface for TinySCHEME. + * + * Copyright (C) 2016 g10 code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#ifndef GPGSCM_FFI_PRIVATE_H +#define GPGSCM_FFI_PRIVATE_H + +#include +#include "scheme.h" +#include "scheme-private.h" + +#define FFI_PROLOG() \ + unsigned int ffi_arg_index GPGRT_ATTR_UNUSED = 1; \ + int err GPGRT_ATTR_UNUSED = 0 \ + +int ffi_bool_value (scheme *sc, pointer p); + +#define CONVERSION_number(SC, X) (SC)->vptr->ivalue (X) +#define CONVERSION_string(SC, X) (SC)->vptr->string_value (X) +#define CONVERSION_character(SC, X) (SC)->vptr->charvalue (X) +#define CONVERSION_list(SC, X) (X) +#define CONVERSION_bool(SC, X) ffi_bool_value ((SC), (X)) +#define CONVERSION_path(SC, X) (((SC)->vptr->is_string (X) \ + ? (SC)->vptr->string_value \ + : (SC)->vptr->symname) (X)) + +#define IS_A_number(SC, X) (SC)->vptr->is_number (X) +#define IS_A_string(SC, X) (SC)->vptr->is_string (X) +#define IS_A_character(SC, X) (SC)->vptr->is_character (X) +#define IS_A_list(SC, X) (SC)->vptr->is_list ((SC), X) +#define IS_A_bool(SC, X) ((X) == (SC)->F || (X) == (SC)->T) +#define IS_A_path(SC, X) ((SC)->vptr->is_string (X) \ + || (SC)->vptr->is_symbol (X)) + +#define FFI_ARG_OR_RETURN(SC, CTYPE, TARGET, WANT, ARGS) \ + do { \ + if ((ARGS) == (SC)->NIL) \ + return (SC)->vptr->mk_string ((SC), \ + "too few arguments: want " \ + #TARGET "("#WANT"/"#CTYPE")\n"); \ + if (! IS_A_##WANT ((SC), pair_car (ARGS))) { \ + char ffi_error_message[256]; \ + snprintf (ffi_error_message, sizeof ffi_error_message, \ + "argument %d must be: " #WANT "\n", ffi_arg_index); \ + return (SC)->vptr->mk_string ((SC), ffi_error_message); \ + } \ + TARGET = CONVERSION_##WANT (SC, pair_car (ARGS)); \ + ARGS = pair_cdr (ARGS); \ + ffi_arg_index += 1; \ + } while (0) + +#define FFI_ARGS_DONE_OR_RETURN(SC, ARGS) \ + do { \ + if ((ARGS) != (SC)->NIL) \ + return (SC)->vptr->mk_string ((SC), "too many arguments"); \ + } while (0) + +#define FFI_RETURN_ERR(SC, ERR) \ + return _cons ((SC), mk_integer ((SC), (ERR)), (SC)->NIL, 1) + +#define FFI_RETURN(SC) FFI_RETURN_ERR (SC, err) + +#define FFI_RETURN_POINTER(SC, X) \ + return _cons ((SC), mk_integer ((SC), err), \ + _cons ((SC), (X), (SC)->NIL, 1), 1) +#define FFI_RETURN_INT(SC, X) \ + FFI_RETURN_POINTER ((SC), mk_integer ((SC), (X))) +#define FFI_RETURN_STRING(SC, X) \ + FFI_RETURN_POINTER ((SC), mk_string ((SC), (X))) + +char *ffi_schemify_name (const char *s, int macro); + +void ffi_scheme_eval (scheme *sc, const char *format, ...) + GPGRT_ATTR_PRINTF (2, 3); +pointer ffi_sprintf (scheme *sc, const char *format, ...) + GPGRT_ATTR_PRINTF (2, 3); + +#define ffi_define_function_name(SC, NAME, F) \ + do { \ + char *_fname = ffi_schemify_name ("_" #F, 0); \ + scheme_define ((SC), \ + (SC)->global_env, \ + mk_symbol ((SC), _fname), \ + mk_foreign_func ((SC), (do_##F))); \ + ffi_scheme_eval ((SC), \ + "(define (%s . a) (ffi-apply \"%s\" %s a))", \ + (NAME), (NAME), _fname); \ + free (_fname); \ + } while (0) + +#define ffi_define_function(SC, F) \ + do { \ + char *_name = ffi_schemify_name (#F, 0); \ + ffi_define_function_name ((SC), _name, F); \ + free (_name); \ + } while (0) + +#define ffi_define_constant(SC, C) \ + do { \ + char *_name = ffi_schemify_name (#C, 1); \ + scheme_define ((SC), \ + (SC)->global_env, \ + mk_symbol ((SC), _name), \ + mk_integer ((SC), (C))); \ + free (_name); \ + } while (0) + +#define ffi_define(SC, SYM, EXP) \ + scheme_define ((SC), (SC)->global_env, mk_symbol ((SC), (SYM)), EXP) + +#define ffi_define_variable_pointer(SC, C, P) \ + do { \ + char *_name = ffi_schemify_name (#C, 0); \ + scheme_define ((SC), \ + (SC)->global_env, \ + mk_symbol ((SC), _name), \ + (P)); \ + free (_name); \ + } while (0) + +#define ffi_define_variable_integer(SC, C) \ + ffi_define_variable_pointer ((SC), C, (SC)->vptr->mk_integer ((SC), C)) + +#define ffi_define_variable_string(SC, C) \ + ffi_define_variable_pointer ((SC), C, (SC)->vptr->mk_string ((SC), C ?: "")) + +gpg_error_t ffi_list2argv (scheme *sc, pointer list, + char ***argv, size_t *len); +gpg_error_t ffi_list2intv (scheme *sc, pointer list, + int **intv, size_t *len); + +#endif /* GPGSCM_FFI_PRIVATE_H */ diff --git a/tests/gpgscm/ffi.c b/tests/gpgscm/ffi.c new file mode 100644 index 000000000..21beb7609 --- /dev/null +++ b/tests/gpgscm/ffi.c @@ -0,0 +1,1283 @@ +/* FFI interface for TinySCHEME. + * + * Copyright (C) 2016 g10 code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#if HAVE_LIBREADLINE +#include +#include +#endif + +#include "../../common/util.h" +#include "../../common/exechelp.h" +#include "../../common/sysutils.h" + +#include "private.h" +#include "ffi.h" +#include "ffi-private.h" + + + +int +ffi_bool_value (scheme *sc, pointer p) +{ + return ! (p == sc->F); +} + + + +static pointer +do_logand (scheme *sc, pointer args) +{ + FFI_PROLOG (); + unsigned int v, acc = ~0; + while (args != sc->NIL) + { + FFI_ARG_OR_RETURN (sc, unsigned int, v, number, args); + acc &= v; + } + FFI_RETURN_INT (sc, acc); +} + +static pointer +do_logior (scheme *sc, pointer args) +{ + FFI_PROLOG (); + unsigned int v, acc = 0; + while (args != sc->NIL) + { + FFI_ARG_OR_RETURN (sc, unsigned int, v, number, args); + acc |= v; + } + FFI_RETURN_INT (sc, acc); +} + +static pointer +do_logxor (scheme *sc, pointer args) +{ + FFI_PROLOG (); + unsigned int v, acc = 0; + while (args != sc->NIL) + { + FFI_ARG_OR_RETURN (sc, unsigned int, v, number, args); + acc ^= v; + } + FFI_RETURN_INT (sc, acc); +} + +static pointer +do_lognot (scheme *sc, pointer args) +{ + FFI_PROLOG (); + unsigned int v; + FFI_ARG_OR_RETURN (sc, unsigned int, v, number, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + FFI_RETURN_INT (sc, ~v); +} + +/* User interface. */ + +static pointer +do_flush_stdio (scheme *sc, pointer args) +{ + FFI_PROLOG (); + FFI_ARGS_DONE_OR_RETURN (sc, args); + fflush (stdout); + fflush (stderr); + FFI_RETURN (sc); +} + + +int use_libreadline; + +/* Read a string, and return a pointer to it. Returns NULL on EOF. */ +char * +rl_gets (const char *prompt) +{ + static char *line = NULL; + char *p; + xfree (line); + +#if HAVE_LIBREADLINE + { + line = readline (prompt); + if (line && *line) + add_history (line); + } +#else + { + size_t max_size = 0xff; + printf ("%s", prompt); + fflush (stdout); + line = xtrymalloc (max_size); + if (line != NULL) + fgets (line, max_size, stdin); + } +#endif + + /* Strip trailing whitespace. */ + if (line && strlen (line) > 0) + for (p = &line[strlen (line) - 1]; isspace (*p); p--) + *p = 0; + + return line; +} + +static pointer +do_prompt (scheme *sc, pointer args) +{ + FFI_PROLOG (); + const char *prompt; + const char *line; + FFI_ARG_OR_RETURN (sc, const char *, prompt, string, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + line = rl_gets (prompt); + if (! line) + FFI_RETURN_POINTER (sc, sc->EOF_OBJ); + + FFI_RETURN_STRING (sc, line); +} + +static pointer +do_sleep (scheme *sc, pointer args) +{ + FFI_PROLOG (); + unsigned int seconds; + FFI_ARG_OR_RETURN (sc, unsigned int, seconds, number, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + sleep (seconds); + FFI_RETURN (sc); +} + +static pointer +do_usleep (scheme *sc, pointer args) +{ + FFI_PROLOG (); + useconds_t microseconds; + FFI_ARG_OR_RETURN (sc, useconds_t, microseconds, number, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + usleep (microseconds); + FFI_RETURN (sc); +} + +static pointer +do_chdir (scheme *sc, pointer args) +{ + FFI_PROLOG (); + char *name; + FFI_ARG_OR_RETURN (sc, char *, name, path, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + if (chdir (name)) + FFI_RETURN_ERR (sc, errno); + FFI_RETURN (sc); +} + +static pointer +do_strerror (scheme *sc, pointer args) +{ + FFI_PROLOG (); + int error; + FFI_ARG_OR_RETURN (sc, int, error, number, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + FFI_RETURN_STRING (sc, gpg_strerror (error)); +} + +static pointer +do_getenv (scheme *sc, pointer args) +{ + FFI_PROLOG (); + char *name; + char *value; + FFI_ARG_OR_RETURN (sc, char *, name, string, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + value = getenv (name); + FFI_RETURN_STRING (sc, value ? value : ""); +} + +static pointer +do_setenv (scheme *sc, pointer args) +{ + FFI_PROLOG (); + char *name; + char *value; + int overwrite; + FFI_ARG_OR_RETURN (sc, char *, name, string, args); + FFI_ARG_OR_RETURN (sc, char *, value, string, args); + FFI_ARG_OR_RETURN (sc, int, overwrite, bool, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + FFI_RETURN_ERR (sc, gnupg_setenv (name, value, overwrite)); +} + +static pointer +do_exit (scheme *sc, pointer args) +{ + FFI_PROLOG (); + int retcode; + FFI_ARG_OR_RETURN (sc, int, retcode, number, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + exit (retcode); +} + +/* XXX: use gnupgs variant b/c mode as string */ +static pointer +do_open (scheme *sc, pointer args) +{ + FFI_PROLOG (); + int fd; + char *pathname; + int flags; + mode_t mode = 0; + FFI_ARG_OR_RETURN (sc, char *, pathname, path, args); + FFI_ARG_OR_RETURN (sc, int, flags, number, args); + if (args != sc->NIL) + FFI_ARG_OR_RETURN (sc, mode_t, mode, number, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + + fd = open (pathname, flags, mode); + if (fd == -1) + FFI_RETURN_ERR (sc, gpg_error_from_syserror ()); + FFI_RETURN_INT (sc, fd); +} + +static pointer +do_fdopen (scheme *sc, pointer args) +{ + FFI_PROLOG (); + FILE *stream; + int fd; + char *mode; + int kind; + FFI_ARG_OR_RETURN (sc, int, fd, number, args); + FFI_ARG_OR_RETURN (sc, char *, mode, string, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + + stream = fdopen (fd, mode); + if (stream == NULL) + FFI_RETURN_ERR (sc, gpg_error_from_syserror ()); + + if (setvbuf (stream, NULL, _IONBF, 0) != 0) + FFI_RETURN_ERR (sc, gpg_error_from_syserror ()); + + kind = 0; + if (strchr (mode, 'r')) + kind |= port_input; + if (strchr (mode, 'w')) + kind |= port_output; + + FFI_RETURN_POINTER (sc, sc->vptr->mk_port_from_file (sc, stream, kind)); +} + +static pointer +do_close (scheme *sc, pointer args) +{ + FFI_PROLOG (); + int fd; + FFI_ARG_OR_RETURN (sc, int, fd, number, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + FFI_RETURN_ERR (sc, close (fd) == 0 ? 0 : gpg_error_from_syserror ()); +} + +static pointer +do_mkdtemp (scheme *sc, pointer args) +{ + FFI_PROLOG (); + char *template; + char buffer[128]; + char *name; + FFI_ARG_OR_RETURN (sc, char *, template, string, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + + if (strlen (template) > sizeof buffer - 1) + FFI_RETURN_ERR (sc, EINVAL); + strncpy (buffer, template, sizeof buffer); + + name = gnupg_mkdtemp (buffer); + if (name == NULL) + FFI_RETURN_ERR (sc, gpg_error_from_syserror ()); + FFI_RETURN_STRING (sc, name); +} + +static pointer +do_unlink (scheme *sc, pointer args) +{ + FFI_PROLOG (); + char *name; + FFI_ARG_OR_RETURN (sc, char *, name, string, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + if (unlink (name) == -1) + FFI_RETURN_ERR (sc, gpg_error_from_syserror ()); + FFI_RETURN (sc); +} + +static gpg_error_t +unlink_recursively (const char *name) +{ + gpg_error_t err = 0; + struct stat st; + + if (stat (name, &st) == -1) + return gpg_error_from_syserror (); + + if (S_ISDIR (st.st_mode)) + { + DIR *dir; + struct dirent *dent; + + dir = opendir (name); + if (dir == NULL) + return gpg_error_from_syserror (); + + while ((dent = readdir (dir))) + { + char *child; + + if (strcmp (dent->d_name, ".") == 0 + || strcmp (dent->d_name, "..") == 0) + continue; + + child = xtryasprintf ("%s/%s", name, dent->d_name); + if (child == NULL) + { + err = gpg_error_from_syserror (); + goto leave; + } + + err = unlink_recursively (child); + xfree (child); + if (err == gpg_error_from_errno (ENOENT)) + err = 0; + if (err) + goto leave; + } + + leave: + closedir (dir); + if (! err) + rmdir (name); + return err; + } + else + if (unlink (name) == -1) + return gpg_error_from_syserror (); + return 0; +} + +static pointer +do_unlink_recursively (scheme *sc, pointer args) +{ + FFI_PROLOG (); + char *name; + FFI_ARG_OR_RETURN (sc, char *, name, string, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + err = unlink_recursively (name); + FFI_RETURN (sc); +} + +static pointer +do_rename (scheme *sc, pointer args) +{ + FFI_PROLOG (); + char *old; + char *new; + FFI_ARG_OR_RETURN (sc, char *, old, string, args); + FFI_ARG_OR_RETURN (sc, char *, new, string, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + if (rename (old, new) == -1) + FFI_RETURN_ERR (sc, gpg_error_from_syserror ()); + FFI_RETURN (sc); +} + +static pointer +do_getcwd (scheme *sc, pointer args) +{ + FFI_PROLOG (); + pointer result; + char *cwd; + FFI_ARGS_DONE_OR_RETURN (sc, args); + cwd = gnupg_getcwd (); + if (cwd == NULL) + FFI_RETURN_ERR (sc, gpg_error_from_syserror ()); + result = sc->vptr->mk_string (sc, cwd); + xfree (cwd); + FFI_RETURN_POINTER (sc, result); +} + +static pointer +do_mkdir (scheme *sc, pointer args) +{ + FFI_PROLOG (); + char *name; + char *mode; + FFI_ARG_OR_RETURN (sc, char *, name, string, args); + FFI_ARG_OR_RETURN (sc, char *, mode, string, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + if (gnupg_mkdir (name, mode) == -1) + FFI_RETURN_ERR (sc, gpg_error_from_syserror ()); + FFI_RETURN (sc); +} + +static pointer +do_rmdir (scheme *sc, pointer args) +{ + FFI_PROLOG (); + char *name; + FFI_ARG_OR_RETURN (sc, char *, name, string, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + if (rmdir (name) == -1) + FFI_RETURN_ERR (sc, gpg_error_from_syserror ()); + FFI_RETURN (sc); +} + + + +/* estream functions. */ + +struct es_object_box +{ + estream_t stream; + int closed; +}; + +static void +es_object_finalize (scheme *sc, void *data) +{ + struct es_object_box *box = data; + (void) sc; + + if (! box->closed) + es_fclose (box->stream); + xfree (box); +} + +static void +es_object_to_string (scheme *sc, char *out, size_t size, void *data) +{ + struct es_object_box *box = data; + (void) sc; + + snprintf (out, size, "#estream %p", box->stream); +} + +static struct foreign_object_vtable es_object_vtable = + { + es_object_finalize, + es_object_to_string, + }; + +static pointer +es_wrap (scheme *sc, estream_t stream) +{ + struct es_object_box *box = xmalloc (sizeof *box); + if (box == NULL) + return sc->NIL; + + box->stream = stream; + box->closed = 0; + return sc->vptr->mk_foreign_object (sc, &es_object_vtable, box); +} + +static struct es_object_box * +es_unwrap (scheme *sc, pointer object) +{ + (void) sc; + + if (! is_foreign_object (object)) + return NULL; + + if (sc->vptr->get_foreign_object_vtable (object) != &es_object_vtable) + return NULL; + + return sc->vptr->get_foreign_object_data (object); +} + +#define CONVERSION_estream(SC, X) es_unwrap (SC, X) +#define IS_A_estream(SC, X) es_unwrap (SC, X) + +static pointer +do_es_fclose (scheme *sc, pointer args) +{ + FFI_PROLOG (); + struct es_object_box *box; + FFI_ARG_OR_RETURN (sc, struct es_object_box *, box, estream, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + err = es_fclose (box->stream); + if (! err) + box->closed = 1; + FFI_RETURN (sc); +} + +static pointer +do_es_read (scheme *sc, pointer args) +{ + FFI_PROLOG (); + struct es_object_box *box; + size_t bytes_to_read; + + pointer result; + void *buffer; + size_t bytes_read; + + FFI_ARG_OR_RETURN (sc, struct es_object_box *, box, estream, args); + FFI_ARG_OR_RETURN (sc, size_t, bytes_to_read, number, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + + buffer = xtrymalloc (bytes_to_read); + if (buffer == NULL) + FFI_RETURN_ERR (sc, ENOMEM); + + err = es_read (box->stream, buffer, bytes_to_read, &bytes_read); + if (err) + FFI_RETURN_ERR (sc, err); + + result = sc->vptr->mk_counted_string (sc, buffer, bytes_read); + xfree (buffer); + FFI_RETURN_POINTER (sc, result); +} + +static pointer +do_es_feof (scheme *sc, pointer args) +{ + FFI_PROLOG (); + struct es_object_box *box; + FFI_ARG_OR_RETURN (sc, struct es_object_box *, box, estream, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + + FFI_RETURN_POINTER (sc, es_feof (box->stream) ? sc->T : sc->F); +} + +static pointer +do_es_write (scheme *sc, pointer args) +{ + FFI_PROLOG (); + struct es_object_box *box; + const char *buffer; + size_t bytes_to_write, bytes_written; + + FFI_ARG_OR_RETURN (sc, struct es_object_box *, box, estream, args); + /* XXX how to get the length of the string buffer? scheme strings + may contain \0. */ + FFI_ARG_OR_RETURN (sc, const char *, buffer, string, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + + bytes_to_write = strlen (buffer); + while (bytes_to_write > 0) + { + err = es_write (box->stream, buffer, bytes_to_write, &bytes_written); + if (err) + break; + bytes_to_write -= bytes_written; + buffer += bytes_written; + } + + FFI_RETURN (sc); +} + + + +/* Process handling. */ + +static pointer +do_spawn_process (scheme *sc, pointer args) +{ + FFI_PROLOG (); + pointer arguments; + char **argv; + size_t len; + unsigned int flags; + + estream_t infp; + estream_t outfp; + estream_t errfp; + pid_t pid; + + FFI_ARG_OR_RETURN (sc, pointer, arguments, list, args); + FFI_ARG_OR_RETURN (sc, unsigned int, flags, number, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + + err = ffi_list2argv (sc, arguments, &argv, &len); + if (err == gpg_error (GPG_ERR_INV_VALUE)) + return ffi_sprintf (sc, "%luth element of first argument is " + "neither string nor symbol", + (unsigned long) len); + if (err) + FFI_RETURN_ERR (sc, err); + + if (verbose > 1) + { + char **p; + fprintf (stderr, "Executing:"); + for (p = argv; *p; p++) + fprintf (stderr, " '%s'", *p); + fprintf (stderr, "\n"); + } + + err = gnupg_spawn_process (argv[0], (const char **) &argv[1], + GPG_ERR_SOURCE_DEFAULT, + NULL, + flags, + &infp, &outfp, &errfp, &pid); + xfree (argv); +#define IMC(A, B) \ + _cons (sc, sc->vptr->mk_integer (sc, (unsigned long) (A)), (B), 1) +#define IMS(A, B) \ + _cons (sc, es_wrap (sc, (A)), (B), 1) + FFI_RETURN_POINTER (sc, IMS (infp, + IMS (outfp, + IMS (errfp, + IMC (pid, sc->NIL))))); +#undef IMS +#undef IMC +} + +static pointer +do_spawn_process_fd (scheme *sc, pointer args) +{ + FFI_PROLOG (); + pointer arguments; + char **argv; + size_t len; + int infd, outfd, errfd; + + pid_t pid; + + FFI_ARG_OR_RETURN (sc, pointer, arguments, list, args); + FFI_ARG_OR_RETURN (sc, int, infd, number, args); + FFI_ARG_OR_RETURN (sc, int, outfd, number, args); + FFI_ARG_OR_RETURN (sc, int, errfd, number, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + + err = ffi_list2argv (sc, arguments, &argv, &len); + if (err == gpg_error (GPG_ERR_INV_VALUE)) + return ffi_sprintf (sc, "%luth element of first argument is " + "neither string nor symbol", + (unsigned long) len); + if (err) + FFI_RETURN_ERR (sc, err); + + if (verbose > 1) + { + char **p; + fprintf (stderr, "Executing:"); + for (p = argv; *p; p++) + fprintf (stderr, " '%s'", *p); + fprintf (stderr, "\n"); + } + + err = gnupg_spawn_process_fd (argv[0], (const char **) &argv[1], + infd, outfd, errfd, &pid); + xfree (argv); + FFI_RETURN_INT (sc, pid); +} + +static pointer +do_wait_process (scheme *sc, pointer args) +{ + FFI_PROLOG (); + const char *name; + pid_t pid; + int hang; + + int retcode; + + FFI_ARG_OR_RETURN (sc, const char *, name, string, args); + FFI_ARG_OR_RETURN (sc, pid_t, pid, number, args); + FFI_ARG_OR_RETURN (sc, int, hang, bool, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + err = gnupg_wait_process (name, pid, hang, &retcode); + if (err == GPG_ERR_GENERAL) + err = 0; /* Let the return code speak for itself. */ + + FFI_RETURN_INT (sc, retcode); +} + + +static pointer +do_wait_processes (scheme *sc, pointer args) +{ + FFI_PROLOG (); + pointer list_names; + char **names; + pointer list_pids; + size_t i, count; + pid_t *pids; + int hang; + int *retcodes; + pointer retcodes_list = sc->NIL; + + FFI_ARG_OR_RETURN (sc, pointer, list_names, list, args); + FFI_ARG_OR_RETURN (sc, pointer, list_pids, list, args); + FFI_ARG_OR_RETURN (sc, int, hang, bool, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + + if (sc->vptr->list_length (sc, list_names) + != sc->vptr->list_length (sc, list_pids)) + return + sc->vptr->mk_string (sc, "length of first two arguments must match"); + + err = ffi_list2argv (sc, list_names, &names, &count); + if (err == gpg_error (GPG_ERR_INV_VALUE)) + return ffi_sprintf (sc, "%luth element of first argument is " + "neither string nor symbol", + (unsigned long) count); + if (err) + FFI_RETURN_ERR (sc, err); + + err = ffi_list2intv (sc, list_pids, (int **) &pids, &count); + if (err == gpg_error (GPG_ERR_INV_VALUE)) + return ffi_sprintf (sc, "%luth element of second argument is " + "neither string nor symbol", + (unsigned long) count); + if (err) + FFI_RETURN_ERR (sc, err); + + retcodes = xtrycalloc (sizeof *retcodes, count); + if (retcodes == NULL) + { + xfree (names); + xfree (pids); + FFI_RETURN_ERR (sc, gpg_error_from_syserror ()); + } + + err = gnupg_wait_processes ((const char **) names, pids, count, hang, + retcodes); + if (err == GPG_ERR_GENERAL) + err = 0; /* Let the return codes speak. */ + + for (i = 0; i < count; i++) + retcodes_list = + (sc->vptr->cons) (sc, + sc->vptr->mk_integer (sc, + (long) retcodes[count-1-i]), + retcodes_list); + + xfree (names); + xfree (pids); + xfree (retcodes); + FFI_RETURN_POINTER (sc, retcodes_list); +} + + +static pointer +do_pipe (scheme *sc, pointer args) +{ + FFI_PROLOG (); + int filedes[2]; + FFI_ARGS_DONE_OR_RETURN (sc, args); + err = gnupg_create_pipe (filedes); +#define IMC(A, B) \ + _cons (sc, sc->vptr->mk_integer (sc, (unsigned long) (A)), (B), 1) + FFI_RETURN_POINTER (sc, IMC (filedes[0], + IMC (filedes[1], sc->NIL))); +#undef IMC +} + +static pointer +do_inbound_pipe (scheme *sc, pointer args) +{ + FFI_PROLOG (); + int filedes[2]; + FFI_ARGS_DONE_OR_RETURN (sc, args); + err = gnupg_create_inbound_pipe (filedes, NULL, 0); +#define IMC(A, B) \ + _cons (sc, sc->vptr->mk_integer (sc, (unsigned long) (A)), (B), 1) + FFI_RETURN_POINTER (sc, IMC (filedes[0], + IMC (filedes[1], sc->NIL))); +#undef IMC +} + +static pointer +do_outbound_pipe (scheme *sc, pointer args) +{ + FFI_PROLOG (); + int filedes[2]; + FFI_ARGS_DONE_OR_RETURN (sc, args); + err = gnupg_create_outbound_pipe (filedes, NULL, 0); +#define IMC(A, B) \ + _cons (sc, sc->vptr->mk_integer (sc, (unsigned long) (A)), (B), 1) + FFI_RETURN_POINTER (sc, IMC (filedes[0], + IMC (filedes[1], sc->NIL))); +#undef IMC +} + + + +/* Test helper functions. */ +static pointer +do_file_equal (scheme *sc, pointer args) +{ + FFI_PROLOG (); + pointer result = sc->F; + char *a_name, *b_name; + int binary; + const char *mode; + FILE *a_stream = NULL, *b_stream = NULL; + struct stat a_stat, b_stat; +#define BUFFER_SIZE 1024 + char a_buf[BUFFER_SIZE], b_buf[BUFFER_SIZE]; +#undef BUFFER_SIZE + size_t chunk; + + FFI_ARG_OR_RETURN (sc, char *, a_name, string, args); + FFI_ARG_OR_RETURN (sc, char *, b_name, string, args); + FFI_ARG_OR_RETURN (sc, int, binary, bool, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + + mode = binary ? "rb" : "r"; + a_stream = fopen (a_name, mode); + if (a_stream == NULL) + goto errout; + + b_stream = fopen (b_name, mode); + if (b_stream == NULL) + goto errout; + + if (fstat (fileno (a_stream), &a_stat) < 0) + goto errout; + + if (fstat (fileno (b_stream), &b_stat) < 0) + goto errout; + + if (binary && a_stat.st_size != b_stat.st_size) + { + if (verbose) + fprintf (stderr, "Files %s and %s differ in size %lu != %lu\n", + a_name, b_name, (unsigned long) a_stat.st_size, + (unsigned long) b_stat.st_size); + + goto out; + } + + while (! feof (a_stream)) + { + chunk = sizeof a_buf; + + chunk = fread (a_buf, 1, chunk, a_stream); + if (chunk == 0 && ferror (a_stream)) + goto errout; /* some error */ + + if (fread (b_buf, 1, chunk, b_stream) < chunk) + { + if (feof (b_stream)) + goto out; /* short read */ + goto errout; /* some error */ + } + + if (chunk > 0 && memcmp (a_buf, b_buf, chunk) != 0) + goto out; + } + + fread (b_buf, 1, 1, b_stream); + if (! feof (b_stream)) + goto out; /* b is longer */ + + /* They match. */ + result = sc->T; + + out: + if (a_stream) + fclose (a_stream); + if (b_stream) + fclose (b_stream); + FFI_RETURN_POINTER (sc, result); + errout: + err = gpg_error_from_syserror (); + goto out; +} + +static pointer +do_splice (scheme *sc, pointer args) +{ + FFI_PROLOG (); + int source; + int sink; + ssize_t len = -1; + char buffer[1024]; + ssize_t bytes_read; + FFI_ARG_OR_RETURN (sc, int, source, number, args); + FFI_ARG_OR_RETURN (sc, int, sink, number, args); + if (args != sc->NIL) + FFI_ARG_OR_RETURN (sc, ssize_t, len, number, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + while (len == -1 || len > 0) + { + size_t want = sizeof buffer; + if (len > 0 && (ssize_t) want > len) + want = (size_t) len; + + bytes_read = read (source, buffer, want); + if (bytes_read == 0) + break; + if (bytes_read < 0) + FFI_RETURN_ERR (sc, gpg_error_from_syserror ()); + if (write (sink, buffer, bytes_read) != bytes_read) + FFI_RETURN_ERR (sc, gpg_error_from_syserror ()); + if (len != -1) + len -= bytes_read; + } + FFI_RETURN (sc); +} + +static pointer +do_string_index (scheme *sc, pointer args) +{ + FFI_PROLOG (); + char *haystack; + char needle; + ssize_t offset = 0; + char *position; + FFI_ARG_OR_RETURN (sc, char *, haystack, string, args); + FFI_ARG_OR_RETURN (sc, char, needle, character, args); + if (args != sc->NIL) + { + FFI_ARG_OR_RETURN (sc, ssize_t, offset, number, args); + if (offset < 0) + return ffi_sprintf (sc, "offset must be positive"); + if (offset > strlen (haystack)) + return ffi_sprintf (sc, "offset exceeds haystack"); + } + FFI_ARGS_DONE_OR_RETURN (sc, args); + + position = strchr (haystack+offset, needle); + if (position) + FFI_RETURN_INT (sc, position - haystack); + else + FFI_RETURN_POINTER (sc, sc->F); +} + +static pointer +do_string_rindex (scheme *sc, pointer args) +{ + FFI_PROLOG (); + char *haystack; + char needle; + ssize_t offset = 0; + char *position; + FFI_ARG_OR_RETURN (sc, char *, haystack, string, args); + FFI_ARG_OR_RETURN (sc, char, needle, character, args); + if (args != sc->NIL) + { + FFI_ARG_OR_RETURN (sc, ssize_t, offset, number, args); + if (offset < 0) + return ffi_sprintf (sc, "offset must be positive"); + if (offset > strlen (haystack)) + return ffi_sprintf (sc, "offset exceeds haystack"); + } + FFI_ARGS_DONE_OR_RETURN (sc, args); + + position = strrchr (haystack+offset, needle); + if (position) + FFI_RETURN_INT (sc, position - haystack); + else + FFI_RETURN_POINTER (sc, sc->F); +} + +static pointer +do_string_contains (scheme *sc, pointer args) +{ + FFI_PROLOG (); + char *haystack; + char *needle; + FFI_ARG_OR_RETURN (sc, char *, haystack, string, args); + FFI_ARG_OR_RETURN (sc, char *, needle, string, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + FFI_RETURN_POINTER (sc, strstr (haystack, needle) ? sc->T : sc->F); +} + +static pointer +do_glob (scheme *sc, pointer args) +{ + FFI_PROLOG (); + pointer result = sc->NIL; + size_t i; + char *pattern; + glob_t pglob; + FFI_ARG_OR_RETURN (sc, char *, pattern, string, args); + FFI_ARGS_DONE_OR_RETURN (sc, args); + + switch (glob (pattern, 0, NULL, &pglob)) + { + case 0: + for (i = 0; i < pglob.gl_pathc; i++) + result = + (sc->vptr->cons) (sc, + sc->vptr->mk_string (sc, pglob.gl_pathv[i]), + result); + globfree (&pglob); + break; + + case GLOB_NOMATCH: + /* Return the empty list. */ + break; + + case GLOB_NOSPACE: + return ffi_sprintf (sc, "out of memory"); + case GLOB_ABORTED: + return ffi_sprintf (sc, "read error"); + default: + assert (! "not reached"); + } + FFI_RETURN_POINTER (sc, result); +} + + +gpg_error_t +ffi_list2argv (scheme *sc, pointer list, char ***argv, size_t *len) +{ + int i; + + *len = sc->vptr->list_length (sc, list); + *argv = xtrycalloc (*len + 1, sizeof **argv); + if (*argv == NULL) + return gpg_error_from_syserror (); + + for (i = 0; sc->vptr->is_pair (list); list = sc->vptr->pair_cdr (list)) + { + if (sc->vptr->is_string (sc->vptr->pair_car (list))) + (*argv)[i++] = sc->vptr->string_value (sc->vptr->pair_car (list)); + else if (sc->vptr->is_symbol (sc->vptr->pair_car (list))) + (*argv)[i++] = sc->vptr->symname (sc->vptr->pair_car (list)); + else + { + xfree (*argv); + *argv = NULL; + *len = i; + return gpg_error (GPG_ERR_INV_VALUE); + } + } + (*argv)[i] = NULL; + return 0; +} + +gpg_error_t +ffi_list2intv (scheme *sc, pointer list, int **intv, size_t *len) +{ + int i; + + *len = sc->vptr->list_length (sc, list); + *intv = xtrycalloc (*len, sizeof **intv); + if (*intv == NULL) + return gpg_error_from_syserror (); + + for (i = 0; sc->vptr->is_pair (list); list = sc->vptr->pair_cdr (list)) + { + if (sc->vptr->is_number (sc->vptr->pair_car (list))) + (*intv)[i++] = sc->vptr->ivalue (sc->vptr->pair_car (list)); + else + { + xfree (*intv); + *intv = NULL; + *len = i; + return gpg_error (GPG_ERR_INV_VALUE); + } + } + + return 0; +} + + +char * +ffi_schemify_name (const char *s, int macro) +{ + char *n = strdup (s), *p; + if (n == NULL) + return s; + for (p = n; *p; p++) + { + *p = (char) tolower (*p); + /* We convert _ to - in identifiers. We allow, however, for + function names to start with a leading _. The functions in + this namespace are not yet finalized and might change or + vanish without warning. Use them with care. */ + if (! macro + && p != n + && *p == '_') + *p = '-'; + } + return n; +} + +pointer +ffi_sprintf (scheme *sc, const char *format, ...) +{ + pointer result; + va_list listp; + char *expression; + int size, written; + + va_start (listp, format); + size = vsnprintf (NULL, 0, format, listp); + va_end (listp); + + expression = xtrymalloc (size + 1); + if (expression == NULL) + return NULL; + + va_start (listp, format); + written = vsnprintf (expression, size + 1, format, listp); + va_end (listp); + + assert (size == written); + + result = sc->vptr->mk_string (sc, expression); + xfree (expression); + return result; +} + +void +ffi_scheme_eval (scheme *sc, const char *format, ...) +{ + va_list listp; + char *expression; + int size, written; + + va_start (listp, format); + size = vsnprintf (NULL, 0, format, listp); + va_end (listp); + + expression = xtrymalloc (size + 1); + if (expression == NULL) + return; + + va_start (listp, format); + written = vsnprintf (expression, size + 1, format, listp); + va_end (listp); + + assert (size == written); + + sc->vptr->load_string (sc, expression); + xfree (expression); +} + +gpg_error_t +ffi_init (scheme *sc, const char *argv0, int argc, const char **argv) +{ + int i; + pointer args = sc->NIL; + + /* bitwise arithmetic */ + ffi_define_function (sc, logand); + ffi_define_function (sc, logior); + ffi_define_function (sc, logxor); + ffi_define_function (sc, lognot); + + /* libc. */ + ffi_define_constant (sc, O_RDONLY); + ffi_define_constant (sc, O_WRONLY); + ffi_define_constant (sc, O_RDWR); + ffi_define_constant (sc, O_CREAT); + ffi_define_constant (sc, O_APPEND); +#ifndef O_BINARY +# define O_BINARY 0 +#endif +#ifndef O_TEXT +# define O_TEXT 0 +#endif + ffi_define_constant (sc, O_BINARY); + ffi_define_constant (sc, O_TEXT); + ffi_define_constant (sc, STDIN_FILENO); + ffi_define_constant (sc, STDOUT_FILENO); + ffi_define_constant (sc, STDERR_FILENO); + + ffi_define_function (sc, sleep); + ffi_define_function (sc, usleep); + ffi_define_function (sc, chdir); + ffi_define_function (sc, strerror); + ffi_define_function (sc, getenv); + ffi_define_function (sc, setenv); + ffi_define_function (sc, exit); + ffi_define_function (sc, open); + ffi_define_function (sc, fdopen); + ffi_define_function (sc, close); + ffi_define_function (sc, mkdtemp); + ffi_define_function (sc, unlink); + ffi_define_function (sc, unlink_recursively); + ffi_define_function (sc, rename); + ffi_define_function (sc, getcwd); + ffi_define_function (sc, mkdir); + ffi_define_function (sc, rmdir); + + /* Process management. */ + ffi_define_function (sc, spawn_process); + ffi_define_function (sc, spawn_process_fd); + ffi_define_function (sc, wait_process); + ffi_define_function (sc, wait_processes); + ffi_define_function (sc, pipe); + ffi_define_function (sc, inbound_pipe); + ffi_define_function (sc, outbound_pipe); + + /* estream functions. */ + ffi_define_function_name (sc, "es-fclose", es_fclose); + ffi_define_function_name (sc, "es-read", es_read); + ffi_define_function_name (sc, "es-feof", es_feof); + ffi_define_function_name (sc, "es-write", es_write); + + /* Test helper functions. */ + ffi_define_function (sc, file_equal); + ffi_define_function (sc, splice); + ffi_define_function (sc, string_index); + ffi_define_function (sc, string_rindex); + ffi_define_function_name (sc, "string-contains?", string_contains); + ffi_define_function (sc, glob); + + /* User interface. */ + ffi_define_function (sc, flush_stdio); + ffi_define_function (sc, prompt); + + /* Configuration. */ + ffi_define (sc, "*verbose*", sc->vptr->mk_integer (sc, verbose)); + + ffi_define (sc, "*argv0*", sc->vptr->mk_string (sc, argv0)); + for (i = argc - 1; i >= 0; i--) + { + pointer value = sc->vptr->mk_string (sc, argv[i]); + args = (sc->vptr->cons) (sc, value, args); + } + ffi_define (sc, "*args*", args); + +#if _WIN32 + ffi_define (sc, "*pathsep*", sc->vptr->mk_character (sc, ';')); +#else + ffi_define (sc, "*pathsep*", sc->vptr->mk_character (sc, ':')); +#endif + + ffi_define (sc, "*stdin*", + sc->vptr->mk_port_from_file (sc, stdin, port_input)); + ffi_define (sc, "*stdout*", + sc->vptr->mk_port_from_file (sc, stdout, port_output)); + ffi_define (sc, "*stderr*", + sc->vptr->mk_port_from_file (sc, stderr, port_output)); + + return 0; +} diff --git a/tests/gpgscm/ffi.h b/tests/gpgscm/ffi.h new file mode 100644 index 000000000..02dd99d59 --- /dev/null +++ b/tests/gpgscm/ffi.h @@ -0,0 +1,30 @@ +/* FFI interface for TinySCHEME. + * + * Copyright (C) 2016 g10 code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#ifndef GPGSCM_FFI_H +#define GPGSCM_FFI_H + +#include +#include "scheme.h" + +gpg_error_t ffi_init (scheme *sc, const char *argv0, + int argc, const char **argv); + +#endif /* GPGSCM_FFI_H */ diff --git a/tests/gpgscm/ffi.scm b/tests/gpgscm/ffi.scm new file mode 100644 index 000000000..7c2f93aba --- /dev/null +++ b/tests/gpgscm/ffi.scm @@ -0,0 +1,44 @@ +;; FFI interface for TinySCHEME. +;; +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +;; Foreign function wrapper. Expects F to return a list with the +;; first element being the `error_t' value returned by the foreign +;; function. The error is thrown, or the cdr of the result is +;; returned. +(define (ffi-apply name f args) + (let ((result (apply f args))) + (cond + ((string? result) + (ffi-fail name args result)) + ((not (= (car result) 0)) + (ffi-fail name args (strerror (car result)))) + ((and (= (car result) 0) (pair? (cdr result))) (cadr result)) + ((= (car result) 0) '()) + (else + (throw (list "Result violates FFI calling convention: " result)))))) + +(define (ffi-fail name args message) + (let ((args' (open-output-string))) + (write (cons (string->symbol name) args) args') + (throw (string-append + (get-output-string args') ": " message)))) + +;; Pseudo-definitions for foreign functions. Evaluates to no code, +;; but serves as documentation. +(macro (ffi-define form)) diff --git a/tests/gpgscm/init.scm b/tests/gpgscm/init.scm new file mode 100644 index 000000000..0889366af --- /dev/null +++ b/tests/gpgscm/init.scm @@ -0,0 +1,723 @@ +; Initialization file for TinySCHEME 1.41 + +; Per R5RS, up to four deep compositions should be defined +(define (caar x) (car (car x))) +(define (cadr x) (car (cdr x))) +(define (cdar x) (cdr (car x))) +(define (cddr x) (cdr (cdr x))) +(define (caaar x) (car (car (car x)))) +(define (caadr x) (car (car (cdr x)))) +(define (cadar x) (car (cdr (car x)))) +(define (caddr x) (car (cdr (cdr x)))) +(define (cdaar x) (cdr (car (car x)))) +(define (cdadr x) (cdr (car (cdr x)))) +(define (cddar x) (cdr (cdr (car x)))) +(define (cdddr x) (cdr (cdr (cdr x)))) +(define (caaaar x) (car (car (car (car x))))) +(define (caaadr x) (car (car (car (cdr x))))) +(define (caadar x) (car (car (cdr (car x))))) +(define (caaddr x) (car (car (cdr (cdr x))))) +(define (cadaar x) (car (cdr (car (car x))))) +(define (cadadr x) (car (cdr (car (cdr x))))) +(define (caddar x) (car (cdr (cdr (car x))))) +(define (cadddr x) (car (cdr (cdr (cdr x))))) +(define (cdaaar x) (cdr (car (car (car x))))) +(define (cdaadr x) (cdr (car (car (cdr x))))) +(define (cdadar x) (cdr (car (cdr (car x))))) +(define (cdaddr x) (cdr (car (cdr (cdr x))))) +(define (cddaar x) (cdr (cdr (car (car x))))) +(define (cddadr x) (cdr (cdr (car (cdr x))))) +(define (cdddar x) (cdr (cdr (cdr (car x))))) +(define (cddddr x) (cdr (cdr (cdr (cdr x))))) + +;;;; Utility to ease macro creation +(define (macro-expand form) + ((eval (get-closure-code (eval (car form)))) form)) + +(define (macro-expand-all form) + (if (macro? form) + (macro-expand-all (macro-expand form)) + form)) + +(define *compile-hook* macro-expand-all) + + +(macro (unless form) + `(if (not ,(cadr form)) (begin ,@(cddr form)))) + +(macro (when form) + `(if ,(cadr form) (begin ,@(cddr form)))) + +; DEFINE-MACRO Contributed by Andy Gaynor +(macro (define-macro dform) + (if (symbol? (cadr dform)) + `(macro ,@(cdr dform)) + (let ((form (gensym))) + `(macro (,(caadr dform) ,form) + (apply (lambda ,(cdadr dform) ,@(cddr dform)) (cdr ,form)))))) + +; Utilities for math. Notice that inexact->exact is primitive, +; but exact->inexact is not. +(define exact? integer?) +(define (inexact? x) (and (real? x) (not (integer? x)))) +(define (even? n) (= (remainder n 2) 0)) +(define (odd? n) (not (= (remainder n 2) 0))) +(define (zero? n) (= n 0)) +(define (positive? n) (> n 0)) +(define (negative? n) (< n 0)) +(define complex? number?) +(define rational? real?) +(define (abs n) (if (>= n 0) n (- n))) +(define (exact->inexact n) (* n 1.0)) +(define (<> n1 n2) (not (= n1 n2))) + +; min and max must return inexact if any arg is inexact; use (+ n 0.0) +(define (max . lst) + (foldr (lambda (a b) + (if (> a b) + (if (exact? b) a (+ a 0.0)) + (if (exact? a) b (+ b 0.0)))) + (car lst) (cdr lst))) +(define (min . lst) + (foldr (lambda (a b) + (if (< a b) + (if (exact? b) a (+ a 0.0)) + (if (exact? a) b (+ b 0.0)))) + (car lst) (cdr lst))) + +(define (succ x) (+ x 1)) +(define (pred x) (- x 1)) +(define gcd + (lambda a + (if (null? a) + 0 + (let ((aa (abs (car a))) + (bb (abs (cadr a)))) + (if (= bb 0) + aa + (gcd bb (remainder aa bb))))))) +(define lcm + (lambda a + (if (null? a) + 1 + (let ((aa (abs (car a))) + (bb (abs (cadr a)))) + (if (or (= aa 0) (= bb 0)) + 0 + (abs (* (quotient aa (gcd aa bb)) bb))))))) + + +(define (string . charlist) + (list->string charlist)) + +(define (list->string charlist) + (let* ((len (length charlist)) + (newstr (make-string len)) + (fill-string! + (lambda (str i len charlist) + (if (= i len) + str + (begin (string-set! str i (car charlist)) + (fill-string! str (+ i 1) len (cdr charlist))))))) + (fill-string! newstr 0 len charlist))) + +(define (string-fill! s e) + (let ((n (string-length s))) + (let loop ((i 0)) + (if (= i n) + s + (begin (string-set! s i e) (loop (succ i))))))) + +(define (string->list s) + (let loop ((n (pred (string-length s))) (l '())) + (if (= n -1) + l + (loop (pred n) (cons (string-ref s n) l))))) + +(define (string-copy str) + (string-append str)) + +(define (string->anyatom str pred) + (let* ((a (string->atom str))) + (if (pred a) a + (error "string->xxx: not a xxx" a)))) + +(define (string->number str . base) + (let ((n (string->atom str (if (null? base) 10 (car base))))) + (if (number? n) n #f))) + +(define (anyatom->string n pred) + (if (pred n) + (atom->string n) + (error "xxx->string: not a xxx" n))) + +(define (number->string n . base) + (atom->string n (if (null? base) 10 (car base)))) + + +(define (char-cmp? cmp a b) + (cmp (char->integer a) (char->integer b))) +(define (char-ci-cmp? cmp a b) + (cmp (char->integer (char-downcase a)) (char->integer (char-downcase b)))) + +(define (char=? a b) (char-cmp? = a b)) +(define (char? a b) (char-cmp? > a b)) +(define (char<=? a b) (char-cmp? <= a b)) +(define (char>=? a b) (char-cmp? >= a b)) + +(define (char-ci=? a b) (char-ci-cmp? = a b)) +(define (char-ci? a b) (char-ci-cmp? > a b)) +(define (char-ci<=? a b) (char-ci-cmp? <= a b)) +(define (char-ci>=? a b) (char-ci-cmp? >= a b)) + +; Note the trick of returning (cmp x y) +(define (string-cmp? chcmp cmp a b) + (let ((na (string-length a)) (nb (string-length b))) + (let loop ((i 0)) + (cond + ((= i na) + (if (= i nb) (cmp 0 0) (cmp 0 1))) + ((= i nb) + (cmp 1 0)) + ((chcmp = (string-ref a i) (string-ref b i)) + (loop (succ i))) + (else + (chcmp cmp (string-ref a i) (string-ref b i))))))) + + +(define (string=? a b) (string-cmp? char-cmp? = a b)) +(define (string? a b) (string-cmp? char-cmp? > a b)) +(define (string<=? a b) (string-cmp? char-cmp? <= a b)) +(define (string>=? a b) (string-cmp? char-cmp? >= a b)) + +(define (string-ci=? a b) (string-cmp? char-ci-cmp? = a b)) +(define (string-ci? a b) (string-cmp? char-ci-cmp? > a b)) +(define (string-ci<=? a b) (string-cmp? char-ci-cmp? <= a b)) +(define (string-ci>=? a b) (string-cmp? char-ci-cmp? >= a b)) + +(define (list . x) x) + +(define (foldr f x lst) + (if (null? lst) + x + (foldr f (f x (car lst)) (cdr lst)))) + +(define (unzip1-with-cdr . lists) + (unzip1-with-cdr-iterative lists '() '())) + +(define (unzip1-with-cdr-iterative lists cars cdrs) + (if (null? lists) + (cons cars cdrs) + (let ((car1 (caar lists)) + (cdr1 (cdar lists))) + (unzip1-with-cdr-iterative + (cdr lists) + (append cars (list car1)) + (append cdrs (list cdr1)))))) + +(define (map proc . lists) + (if (null? lists) + (apply proc) + (if (null? (car lists)) + '() + (let* ((unz (apply unzip1-with-cdr lists)) + (cars (car unz)) + (cdrs (cdr unz))) + (cons (apply proc cars) (apply map (cons proc cdrs))))))) + +(define (for-each proc . lists) + (if (null? lists) + (apply proc) + (if (null? (car lists)) + #t + (let* ((unz (apply unzip1-with-cdr lists)) + (cars (car unz)) + (cdrs (cdr unz))) + (apply proc cars) (apply map (cons proc cdrs)))))) + +(define (list-tail x k) + (if (zero? k) + x + (list-tail (cdr x) (- k 1)))) + +(define (list-ref x k) + (car (list-tail x k))) + +(define (last-pair x) + (if (pair? (cdr x)) + (last-pair (cdr x)) + x)) + +(define (head stream) (car stream)) + +(define (tail stream) (force (cdr stream))) + +(define (vector-equal? x y) + (and (vector? x) (vector? y) (= (vector-length x) (vector-length y)) + (let ((n (vector-length x))) + (let loop ((i 0)) + (if (= i n) + #t + (and (equal? (vector-ref x i) (vector-ref y i)) + (loop (succ i)))))))) + +(define (list->vector x) + (apply vector x)) + +(define (vector-fill! v e) + (let ((n (vector-length v))) + (let loop ((i 0)) + (if (= i n) + v + (begin (vector-set! v i e) (loop (succ i))))))) + +(define (vector->list v) + (let loop ((n (pred (vector-length v))) (l '())) + (if (= n -1) + l + (loop (pred n) (cons (vector-ref v n) l))))) + +;; The following quasiquote macro is due to Eric S. Tiedemann. +;; Copyright 1988 by Eric S. Tiedemann; all rights reserved. +;; +;; Subsequently modified to handle vectors: D. Souflis + +(macro + quasiquote + (lambda (l) + (define (mcons f l r) + (if (and (pair? r) + (eq? (car r) 'quote) + (eq? (car (cdr r)) (cdr f)) + (pair? l) + (eq? (car l) 'quote) + (eq? (car (cdr l)) (car f))) + (if (or (procedure? f) (number? f) (string? f)) + f + (list 'quote f)) + (if (eqv? l vector) + (apply l (eval r)) + (list 'cons l r) + ))) + (define (mappend f l r) + (if (or (null? (cdr f)) + (and (pair? r) + (eq? (car r) 'quote) + (eq? (car (cdr r)) '()))) + l + (list 'append l r))) + (define (foo level form) + (cond ((not (pair? form)) + (if (or (procedure? form) (number? form) (string? form)) + form + (list 'quote form)) + ) + ((eq? 'quasiquote (car form)) + (mcons form ''quasiquote (foo (+ level 1) (cdr form)))) + (#t (if (zero? level) + (cond ((eq? (car form) 'unquote) (car (cdr form))) + ((eq? (car form) 'unquote-splicing) + (error "Unquote-splicing wasn't in a list:" + form)) + ((and (pair? (car form)) + (eq? (car (car form)) 'unquote-splicing)) + (mappend form (car (cdr (car form))) + (foo level (cdr form)))) + (#t (mcons form (foo level (car form)) + (foo level (cdr form))))) + (cond ((eq? (car form) 'unquote) + (mcons form ''unquote (foo (- level 1) + (cdr form)))) + ((eq? (car form) 'unquote-splicing) + (mcons form ''unquote-splicing + (foo (- level 1) (cdr form)))) + (#t (mcons form (foo level (car form)) + (foo level (cdr form))))))))) + (foo 0 (car (cdr l))))) + +;;;;;Helper for the dynamic-wind definition. By Tom Breton (Tehom) +(define (shared-tail x y) + (let ((len-x (length x)) + (len-y (length y))) + (define (shared-tail-helper x y) + (if + (eq? x y) + x + (shared-tail-helper (cdr x) (cdr y)))) + + (cond + ((> len-x len-y) + (shared-tail-helper + (list-tail x (- len-x len-y)) + y)) + ((< len-x len-y) + (shared-tail-helper + x + (list-tail y (- len-y len-x)))) + (#t (shared-tail-helper x y))))) + +;;;;;Dynamic-wind by Tom Breton (Tehom) + +;;Guarded because we must only eval this once, because doing so +;;redefines call/cc in terms of old call/cc +(unless (defined? 'dynamic-wind) + (let + ;;These functions are defined in the context of a private list of + ;;pairs of before/after procs. + ( (*active-windings* '()) + ;;We'll define some functions into the larger environment, so + ;;we need to know it. + (outer-env (current-environment))) + + ;;Poor-man's structure operations + (define before-func car) + (define after-func cdr) + (define make-winding cons) + + ;;Manage active windings + (define (activate-winding! new) + ((before-func new)) + (set! *active-windings* (cons new *active-windings*))) + (define (deactivate-top-winding!) + (let ((old-top (car *active-windings*))) + ;;Remove it from the list first so it's not active during its + ;;own exit. + (set! *active-windings* (cdr *active-windings*)) + ((after-func old-top)))) + + (define (set-active-windings! new-ws) + (unless (eq? new-ws *active-windings*) + (let ((shared (shared-tail new-ws *active-windings*))) + + ;;Define the looping functions. + ;;Exit the old list. Do deeper ones last. Don't do + ;;any shared ones. + (define (pop-many) + (unless (eq? *active-windings* shared) + (deactivate-top-winding!) + (pop-many))) + ;;Enter the new list. Do deeper ones first so that the + ;;deeper windings will already be active. Don't do any + ;;shared ones. + (define (push-many new-ws) + (unless (eq? new-ws shared) + (push-many (cdr new-ws)) + (activate-winding! (car new-ws)))) + + ;;Do it. + (pop-many) + (push-many new-ws)))) + + ;;The definitions themselves. + (eval + `(define call-with-current-continuation + ;;It internally uses the built-in call/cc, so capture it. + ,(let ((old-c/cc call-with-current-continuation)) + (lambda (func) + ;;Use old call/cc to get the continuation. + (old-c/cc + (lambda (continuation) + ;;Call func with not the continuation itself + ;;but a procedure that adjusts the active + ;;windings to what they were when we made + ;;this, and only then calls the + ;;continuation. + (func + (let ((current-ws *active-windings*)) + (lambda (x) + (set-active-windings! current-ws) + (continuation x))))))))) + outer-env) + ;;We can't just say "define (dynamic-wind before thunk after)" + ;;because the lambda it's defined to lives in this environment, + ;;not in the global environment. + (eval + `(define dynamic-wind + ,(lambda (before thunk after) + ;;Make a new winding + (activate-winding! (make-winding before after)) + (let ((result (thunk))) + ;;Get rid of the new winding. + (deactivate-top-winding!) + ;;The return value is that of thunk. + result))) + outer-env))) + +(define call/cc call-with-current-continuation) + + +;;;;; atom? and equal? written by a.k + +;;;; atom? +(define (atom? x) + (not (pair? x))) + +;;;; equal? +(define (equal? x y) + (cond + ((pair? x) + (and (pair? y) + (equal? (car x) (car y)) + (equal? (cdr x) (cdr y)))) + ((vector? x) + (and (vector? y) (vector-equal? x y))) + ((string? x) + (and (string? y) (string=? x y))) + (else (eqv? x y)))) + +;;;; (do ((var init inc) ...) (endtest result ...) body ...) +;; +(macro do + (lambda (do-macro) + (apply (lambda (do vars endtest . body) + (let ((do-loop (gensym))) + `(letrec ((,do-loop + (lambda ,(map (lambda (x) + (if (pair? x) (car x) x)) + `,vars) + (if ,(car endtest) + (begin ,@(cdr endtest)) + (begin + ,@body + (,do-loop + ,@(map (lambda (x) + (cond + ((not (pair? x)) x) + ((< (length x) 3) (car x)) + (else (car (cdr (cdr x)))))) + `,vars))))))) + (,do-loop + ,@(map (lambda (x) + (if (and (pair? x) (cdr x)) + (car (cdr x)) + '())) + `,vars))))) + do-macro))) + +;;;; generic-member +(define (generic-member cmp obj lst) + (cond + ((null? lst) #f) + ((cmp obj (car lst)) lst) + (else (generic-member cmp obj (cdr lst))))) + +(define (memq obj lst) + (generic-member eq? obj lst)) +(define (memv obj lst) + (generic-member eqv? obj lst)) +(define (member obj lst) + (generic-member equal? obj lst)) + +;;;; generic-assoc +(define (generic-assoc cmp obj alst) + (cond + ((null? alst) #f) + ((cmp obj (caar alst)) (car alst)) + (else (generic-assoc cmp obj (cdr alst))))) + +(define (assq obj alst) + (generic-assoc eq? obj alst)) +(define (assv obj alst) + (generic-assoc eqv? obj alst)) +(define (assoc obj alst) + (generic-assoc equal? obj alst)) + +(define (acons x y z) (cons (cons x y) z)) + +;;;; Handy for imperative programs +;;;; Used as: (define-with-return (foo x y) .... (return z) ...) +(macro (define-with-return form) + `(define ,(cadr form) + (call/cc (lambda (return) ,@(cddr form))))) + +;;;; Simple exception handling +; +; Exceptions are caught as follows: +; +; (catch (do-something to-recover and-return meaningful-value) +; (if-something goes-wrong) +; (with-these calls)) +; +; "Catch" establishes a scope spanning multiple call-frames until +; another "catch" is encountered. Within the recovery expression +; the thrown exception is bound to *error*. +; +; Exceptions are thrown with: +; +; (throw "message") +; +; If used outside a (catch ...), reverts to (error "message) + +(define *handlers* (list)) + +(define (push-handler proc) + (set! *handlers* (cons proc *handlers*))) + +(define (pop-handler) + (let ((h (car *handlers*))) + (set! *handlers* (cdr *handlers*)) + h)) + +(define (more-handlers?) + (pair? *handlers*)) + +(define (throw . x) + (if (more-handlers?) + (apply (pop-handler) x) + (apply error x))) + +(macro (catch form) + (let ((label (gensym))) + `(call/cc (lambda (exit) + (push-handler (lambda (*error*) (exit ,(cadr form)))) + (let ((,label (begin ,@(cddr form)))) + (pop-handler) + ,label))))) + +(define (*error-hook* . args) + (throw args)) + + +;;;;; Definition of MAKE-ENVIRONMENT, to be used with two-argument EVAL + +(macro (make-environment form) + `(apply (lambda () + ,@(cdr form) + (current-environment)))) + +(define-macro (eval-polymorphic x . envl) + (display envl) + (let* ((env (if (null? envl) (current-environment) (eval (car envl)))) + (xval (eval x env))) + (if (closure? xval) + (make-closure (get-closure-code xval) env) + xval))) + +; Redefine this if you install another package infrastructure +; Also redefine 'package' +(define *colon-hook* eval) + +(macro (package form) + `(apply (lambda () + ,@(cdr form) + (current-environment)))) + +;;;;; I/O + +(define (input-output-port? p) + (and (input-port? p) (output-port? p))) + +(define (close-port p) + (cond + ((input-output-port? p) (close-input-port p) (close-output-port p)) + ((input-port? p) (close-input-port p)) + ((output-port? p) (close-output-port p)) + (else (throw "Not a port" p)))) + +(define (call-with-input-file s p) + (let ((inport (open-input-file s))) + (if (eq? inport #f) + #f + (let ((res (p inport))) + (close-input-port inport) + res)))) + +(define (call-with-output-file s p) + (let ((outport (open-output-file s))) + (if (eq? outport #f) + #f + (let ((res (p outport))) + (close-output-port outport) + res)))) + +(define (with-input-from-file s p) + (let ((inport (open-input-file s))) + (if (eq? inport #f) + #f + (let ((prev-inport (current-input-port))) + (set-input-port inport) + (let ((res (p))) + (close-input-port inport) + (set-input-port prev-inport) + res))))) + +(define (with-output-to-file s p) + (let ((outport (open-output-file s))) + (if (eq? outport #f) + #f + (let ((prev-outport (current-output-port))) + (set-output-port outport) + (let ((res (p))) + (close-output-port outport) + (set-output-port prev-outport) + res))))) + +(define (with-input-output-from-to-files si so p) + (let ((inport (open-input-file si)) + (outport (open-input-file so))) + (if (not (and inport outport)) + (begin + (close-input-port inport) + (close-output-port outport) + #f) + (let ((prev-inport (current-input-port)) + (prev-outport (current-output-port))) + (set-input-port inport) + (set-output-port outport) + (let ((res (p))) + (close-input-port inport) + (close-output-port outport) + (set-input-port prev-inport) + (set-output-port prev-outport) + res))))) + +; Random number generator (maximum cycle) +(define *seed* 1) +(define (random-next) + (let* ((a 16807) (m 2147483647) (q (quotient m a)) (r (modulo m a))) + (set! *seed* + (- (* a (- *seed* + (* (quotient *seed* q) q))) + (* (quotient *seed* q) r))) + (if (< *seed* 0) (set! *seed* (+ *seed* m))) + *seed*)) +;; SRFI-0 +;; COND-EXPAND +;; Implemented as a macro +(define *features* '(srfi-0 tinyscheme)) + +(define-macro (cond-expand . cond-action-list) + (cond-expand-runtime cond-action-list)) + +(define (cond-expand-runtime cond-action-list) + (if (null? cond-action-list) + #t + (if (cond-eval (caar cond-action-list)) + `(begin ,@(cdar cond-action-list)) + (cond-expand-runtime (cdr cond-action-list))))) + +(define (cond-eval-and cond-list) + (foldr (lambda (x y) (and (cond-eval x) (cond-eval y))) #t cond-list)) + +(define (cond-eval-or cond-list) + (foldr (lambda (x y) (or (cond-eval x) (cond-eval y))) #f cond-list)) + +(define (cond-eval condition) + (cond + ((symbol? condition) + (if (member condition *features*) #t #f)) + ((eq? condition #t) #t) + ((eq? condition #f) #f) + (else (case (car condition) + ((and) (cond-eval-and (cdr condition))) + ((or) (cond-eval-or (cdr condition))) + ((not) (if (not (null? (cddr condition))) + (error "cond-expand : 'not' takes 1 argument") + (not (cond-eval (cadr condition))))) + (else (error "cond-expand : unknown operator" (car condition))))))) + +(gc-verbose #f) diff --git a/tests/gpgscm/lib.scm b/tests/gpgscm/lib.scm new file mode 100644 index 000000000..e23977a5e --- /dev/null +++ b/tests/gpgscm/lib.scm @@ -0,0 +1,159 @@ +;; Additional library functions for TinySCHEME. +;; +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(macro (assert form) + `(if (not ,(cadr form)) + (begin + (display (list "Assertion failed:" (quote ,(cadr form)))) + (newline) + (exit 1)))) +(assert #t) + +(define (filter pred lst) + (cond ((null? lst) '()) + ((pred (car lst)) + (cons (car lst) (filter pred (cdr lst)))) + (else (filter pred (cdr lst))))) + +(define (any p l) + (cond ((null? l) #f) + ((p (car l)) #t) + (else (any p (cdr l))))) + +(define (all p l) + (cond ((null? l) #t) + ((not (p (car l))) #f) + (else (all p (cdr l))))) + +;; Is PREFIX a prefix of S? +(define (string-prefix? s prefix) + (and (>= (string-length s) (string-length prefix)) + (string=? prefix (substring s 0 (string-length prefix))))) +(assert (string-prefix? "Scheme" "Sch")) + +;; Is SUFFIX a suffix of S? +(define (string-suffix? s suffix) + (and (>= (string-length s) (string-length suffix)) + (string=? suffix (substring s (- (string-length s) + (string-length suffix)) + (string-length s))))) +(assert (string-suffix? "Scheme" "eme")) + +;; Locate the first occurrence of needle in haystack starting at offset. +(ffi-define (string-index haystack needle [offset])) +(assert (= 2 (string-index "Hallo" #\l))) +(assert (= 3 (string-index "Hallo" #\l 3))) +(assert (equal? #f (string-index "Hallo" #\.))) + +;; Locate the last occurrence of needle in haystack starting at offset. +(ffi-define (string-rindex haystack needle [offset])) +(assert (= 3 (string-rindex "Hallo" #\l))) +(assert (equal? #f (string-rindex "Hallo" #\a 2))) +(assert (equal? #f (string-rindex "Hallo" #\.))) + +;; Split haystack at delimiter at most n times. +(define (string-splitn haystack delimiter n) + (let ((length (string-length haystack))) + (define (split acc delimiter offset n) + (if (>= offset length) + (reverse acc) + (let ((i (string-index haystack delimiter offset))) + (if (or (eq? i #f) (= 0 n)) + (reverse (cons (substring haystack offset length) acc)) + (split (cons (substring haystack offset i) acc) + delimiter (+ i 1) (- n 1)))))) + (split '() delimiter 0 n))) +(assert (= 2 (length (string-splitn "foo:bar:baz" #\: 1)))) +(assert (string=? "foo" (car (string-splitn "foo:bar:baz" #\: 1)))) +(assert (string=? "bar:baz" (cadr (string-splitn "foo:bar:baz" #\: 1)))) + +;; Split haystack at delimiter. +(define (string-split haystack delimiter) + (string-splitn haystack delimiter -1)) +(assert (= 3 (length (string-split "foo:bar:baz" #\:)))) +(assert (string=? "foo" (car (string-split "foo:bar:baz" #\:)))) +(assert (string=? "bar" (cadr (string-split "foo:bar:baz" #\:)))) +(assert (string=? "baz" (caddr (string-split "foo:bar:baz" #\:)))) + +;; Trim the prefix of S containing only characters that make PREDICATE +;; true. +(define (string-ltrim predicate s) + (let loop ((s' (string->list s))) + (if (predicate (car s')) + (loop (cdr s')) + (list->string s')))) +(assert (string=? "foo" (string-ltrim char-whitespace? " foo"))) + +;; Trim the suffix of S containing only characters that make PREDICATE +;; true. +(define (string-rtrim predicate s) + (let loop ((s' (reverse (string->list s)))) + (if (predicate (car s')) + (loop (cdr s')) + (list->string (reverse s'))))) +(assert (string=? "foo" (string-rtrim char-whitespace? "foo "))) + +;; Trim both the prefix and suffix of S containing only characters +;; that make PREDICATE true. +(define (string-trim predicate s) + (string-ltrim predicate (string-rtrim predicate s))) +(assert (string=? "foo" (string-trim char-whitespace? " foo "))) + +;; Check if needle is contained in haystack. +(ffi-define (string-contains? haystack needle)) +(assert (string-contains? "Hallo" "llo")) +(assert (not (string-contains? "Hallo" "olla"))) + +;; Read a word from port P. +(define (read-word . p) + (list->string + (let f () + (let ((c (apply peek-char p))) + (cond + ((eof-object? c) '()) + ((char-alphabetic? c) + (apply read-char p) + (cons c (f))) + (else + (apply read-char p) + '())))))) + +;; Read a line from port P. +(define (read-line . p) + (list->string + (let f () + (let ((c (apply peek-char p))) + (cond + ((eof-object? c) '()) + ((char=? c #\newline) + (apply read-char p) + '()) + (else + (apply read-char p) + (cons c (f)))))))) + +;; Read everything from port P. +(define (read-all . p) + (let loop ((acc (open-output-string))) + (let ((c (apply peek-char p))) + (cond + ((eof-object? c) (get-output-string acc)) + (else + (write-char (apply read-char p) acc) + (loop acc)))))) diff --git a/tests/gpgscm/main.c b/tests/gpgscm/main.c new file mode 100644 index 000000000..5b3792eac --- /dev/null +++ b/tests/gpgscm/main.c @@ -0,0 +1,288 @@ +/* TinyScheme-based test driver. + * + * Copyright (C) 2016 g10 code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "private.h" +#include "scheme.h" +#include "ffi.h" +#include "i18n.h" +#include "../../common/argparse.h" +#include "../../common/init.h" +#include "../../common/logging.h" +#include "../../common/strlist.h" +#include "../../common/sysutils.h" +#include "../../common/util.h" + +/* The TinyScheme banner. Unfortunately, it isn't in the header + file. */ +#define ts_banner "TinyScheme 1.41" + +int verbose; + + + +/* Constants to identify the commands and options. */ +enum cmd_and_opt_values + { + aNull = 0, + oVerbose = 'v', + }; + +/* The list of commands and options. */ +static ARGPARSE_OPTS opts[] = + { + ARGPARSE_s_n (oVerbose, "verbose", N_("verbose")), + ARGPARSE_end (), + }; + +char *scmpath = ""; +size_t scmpath_len = 0; + +/* Command line parsing. */ +static void +parse_arguments (ARGPARSE_ARGS *pargs, ARGPARSE_OPTS *popts) +{ + int no_more_options = 0; + + while (!no_more_options && optfile_parse (NULL, NULL, NULL, pargs, popts)) + { + switch (pargs->r_opt) + { + case oVerbose: + verbose++; + break; + + default: + pargs->err = 2; + break; + } + } +} + +/* Print usage information and and provide strings for help. */ +static const char * +my_strusage( int level ) +{ + const char *p; + + switch (level) + { + case 11: p = "gpgscm (@GNUPG@)"; + break; + case 13: p = VERSION; break; + case 17: p = PRINTABLE_OS_NAME; break; + case 19: p = _("Please report bugs to <@EMAIL@>.\n"); break; + + case 1: + case 40: + p = _("Usage: gpgscm [options] [file] (-h for help)"); + break; + case 41: + p = _("Syntax: gpgscm [options] [file]\n" + "Execute the given Scheme program, or spawn interactive shell.\n"); + break; + + default: p = NULL; break; + } + return p; +} + + +/* Load the Scheme program from FILE_NAME. If FILE_NAME is not an + absolute path, and LOOKUP_IN_PATH is given, then it is qualified + with the values in scmpath until the file is found. */ +static gpg_error_t +load (scheme *sc, char *file_name, + int lookup_in_cwd, int lookup_in_path) +{ + gpg_error_t err = 0; + size_t n; + const char *directory; + char *qualified_name = file_name; + int use_path; + FILE *h = NULL; + + use_path = + lookup_in_path && ! (file_name[0] == '/' || scmpath_len == 0); + + if (file_name[0] == '/' || lookup_in_cwd || scmpath_len == 0) + { + h = fopen (file_name, "r"); + if (! h) + err = gpg_error_from_syserror (); + } + + if (h == NULL && use_path) + for (directory = scmpath, n = scmpath_len; n; + directory += strlen (directory) + 1, n--) + { + if (asprintf (&qualified_name, "%s/%s", directory, file_name) < 0) + return gpg_error_from_syserror (); + + h = fopen (qualified_name, "r"); + if (h) + break; + + if (n > 1) + { + free (qualified_name); + continue; /* Try again! */ + } + + err = gpg_error_from_syserror (); + } + + if (h == NULL) + { + /* Failed and no more elements in scmpath to try. */ + fprintf (stderr, "Could not read %s: %s.\n", + qualified_name, gpg_strerror (err)); + if (lookup_in_path) + fprintf (stderr, + "Consider using GPGSCM_PATH to specify the location " + "of the Scheme library.\n"); + return err; + } + if (verbose > 1) + fprintf (stderr, "Loading %s...\n", qualified_name); + scheme_load_named_file (sc, h, qualified_name); + fclose (h); + + if (file_name != qualified_name) + free (qualified_name); + return 0; +} + + + +int +main (int argc, char **argv) +{ + gpg_error_t err; + char *argv0; + ARGPARSE_ARGS pargs; + scheme *sc; + char *p; +#if _WIN32 + char pathsep = ';'; +#else + char pathsep = ':'; +#endif + char *script = NULL; + + /* Save argv[0] so that we can re-exec. */ + argv0 = argv[0]; + + /* Parse path. */ + if (getenv ("GPGSCM_PATH")) + scmpath = getenv ("GPGSCM_PATH"); + + p = scmpath = strdup (scmpath); + if (p == NULL) + return 2; + + if (*p) + scmpath_len++; + for (; *p; p++) + if (*p == pathsep) + *p = 0, scmpath_len++; + + set_strusage (my_strusage); + log_set_prefix ("gpgscm", 1); + + /* Make sure that our subsystems are ready. */ + i18n_init (); + init_common_subsystems (&argc, &argv); + + if (!gcry_check_version (GCRYPT_VERSION)) + { + fputs ("libgcrypt version mismatch\n", stderr); + exit (2); + } + + /* Parse the command line. */ + pargs.argc = &argc; + pargs.argv = &argv; + pargs.flags = 0; + parse_arguments (&pargs, opts); + + if (log_get_errorcount (0)) + exit (2); + + sc = scheme_init_new_custom_alloc (gcry_malloc, gcry_free); + if (! sc) { + fprintf (stderr, "Could not initialize TinyScheme!\n"); + return 2; + } + scheme_set_input_port_file (sc, stdin); + scheme_set_output_port_file (sc, stderr); + + if (argc) + { + script = argv[0]; + argc--, argv++; + } + + err = load (sc, "init.scm", 0, 1); + if (! err) + err = load (sc, "ffi.scm", 0, 1); + if (! err) + err = ffi_init (sc, argv0, argc, (const char **) argv); + if (! err) + err = load (sc, "lib.scm", 0, 1); + if (! err) + err = load (sc, "repl.scm", 0, 1); + if (! err) + err = load (sc, "tests.scm", 0, 1); + if (err) + { + fprintf (stderr, "Error initializing gpgscm: %s.\n", + gpg_strerror (err)); + exit (2); + } + + if (script == NULL) + { + /* Interactive shell. */ + fprintf (stderr, "gpgscm/"ts_banner".\n"); + scheme_load_string (sc, "(interactive-repl)"); + } + else + { + err = load (sc, script, 1, 1); + if (err) + log_fatal ("%s: %s", script, gpg_strerror (err)); + } + + scheme_deinit (sc); + xfree (sc); + return EXIT_SUCCESS; +} diff --git a/tests/gpgscm/opdefines.h b/tests/gpgscm/opdefines.h new file mode 100644 index 000000000..ceb4d0e39 --- /dev/null +++ b/tests/gpgscm/opdefines.h @@ -0,0 +1,195 @@ + _OP_DEF(opexe_0, "load", 1, 1, TST_STRING, OP_LOAD ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_T0LVL ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_T1LVL ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_READ_INTERNAL ) + _OP_DEF(opexe_0, "gensym", 0, 0, 0, OP_GENSYM ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_VALUEPRINT ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_EVAL ) +#if USE_TRACING + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_REAL_EVAL ) +#endif + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_E0ARGS ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_E1ARGS ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_APPLY ) +#if USE_TRACING + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_REAL_APPLY ) + _OP_DEF(opexe_0, "tracing", 1, 1, TST_NATURAL, OP_TRACING ) +#endif + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_DOMACRO ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_LAMBDA ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_LAMBDA1 ) + _OP_DEF(opexe_0, "make-closure", 1, 2, TST_PAIR TST_ENVIRONMENT, OP_MKCLOSURE ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_QUOTE ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_DEF0 ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_DEF1 ) + _OP_DEF(opexe_0, "defined?", 1, 2, TST_SYMBOL TST_ENVIRONMENT, OP_DEFP ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_BEGIN ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_IF0 ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_IF1 ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_SET0 ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_SET1 ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_LET0 ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_LET1 ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_LET2 ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_LET0AST ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_LET1AST ) + _OP_DEF(opexe_0, 0, 0, 0, 0, OP_LET2AST ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_LET0REC ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_LET1REC ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_LET2REC ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_COND0 ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_COND1 ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_DELAY ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_AND0 ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_AND1 ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_OR0 ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_OR1 ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_C0STREAM ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_C1STREAM ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_MACRO0 ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_MACRO1 ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_CASE0 ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_CASE1 ) + _OP_DEF(opexe_1, 0, 0, 0, 0, OP_CASE2 ) + _OP_DEF(opexe_1, "eval", 1, 2, TST_ANY TST_ENVIRONMENT, OP_PEVAL ) + _OP_DEF(opexe_1, "apply", 1, INF_ARG, TST_NONE, OP_PAPPLY ) + _OP_DEF(opexe_1, "call-with-current-continuation", 1, 1, TST_NONE, OP_CONTINUATION ) +#if USE_MATH + _OP_DEF(opexe_2, "inexact->exact", 1, 1, TST_NUMBER, OP_INEX2EX ) + _OP_DEF(opexe_2, "exp", 1, 1, TST_NUMBER, OP_EXP ) + _OP_DEF(opexe_2, "log", 1, 1, TST_NUMBER, OP_LOG ) + _OP_DEF(opexe_2, "sin", 1, 1, TST_NUMBER, OP_SIN ) + _OP_DEF(opexe_2, "cos", 1, 1, TST_NUMBER, OP_COS ) + _OP_DEF(opexe_2, "tan", 1, 1, TST_NUMBER, OP_TAN ) + _OP_DEF(opexe_2, "asin", 1, 1, TST_NUMBER, OP_ASIN ) + _OP_DEF(opexe_2, "acos", 1, 1, TST_NUMBER, OP_ACOS ) + _OP_DEF(opexe_2, "atan", 1, 2, TST_NUMBER, OP_ATAN ) + _OP_DEF(opexe_2, "sqrt", 1, 1, TST_NUMBER, OP_SQRT ) + _OP_DEF(opexe_2, "expt", 2, 2, TST_NUMBER, OP_EXPT ) + _OP_DEF(opexe_2, "floor", 1, 1, TST_NUMBER, OP_FLOOR ) + _OP_DEF(opexe_2, "ceiling", 1, 1, TST_NUMBER, OP_CEILING ) + _OP_DEF(opexe_2, "truncate", 1, 1, TST_NUMBER, OP_TRUNCATE ) + _OP_DEF(opexe_2, "round", 1, 1, TST_NUMBER, OP_ROUND ) +#endif + _OP_DEF(opexe_2, "+", 0, INF_ARG, TST_NUMBER, OP_ADD ) + _OP_DEF(opexe_2, "-", 1, INF_ARG, TST_NUMBER, OP_SUB ) + _OP_DEF(opexe_2, "*", 0, INF_ARG, TST_NUMBER, OP_MUL ) + _OP_DEF(opexe_2, "/", 1, INF_ARG, TST_NUMBER, OP_DIV ) + _OP_DEF(opexe_2, "quotient", 1, INF_ARG, TST_INTEGER, OP_INTDIV ) + _OP_DEF(opexe_2, "remainder", 2, 2, TST_INTEGER, OP_REM ) + _OP_DEF(opexe_2, "modulo", 2, 2, TST_INTEGER, OP_MOD ) + _OP_DEF(opexe_2, "car", 1, 1, TST_PAIR, OP_CAR ) + _OP_DEF(opexe_2, "cdr", 1, 1, TST_PAIR, OP_CDR ) + _OP_DEF(opexe_2, "cons", 2, 2, TST_NONE, OP_CONS ) + _OP_DEF(opexe_2, "set-car!", 2, 2, TST_PAIR TST_ANY, OP_SETCAR ) + _OP_DEF(opexe_2, "set-cdr!", 2, 2, TST_PAIR TST_ANY, OP_SETCDR ) + _OP_DEF(opexe_2, "char->integer", 1, 1, TST_CHAR, OP_CHAR2INT ) + _OP_DEF(opexe_2, "integer->char", 1, 1, TST_NATURAL, OP_INT2CHAR ) + _OP_DEF(opexe_2, "char-upcase", 1, 1, TST_CHAR, OP_CHARUPCASE ) + _OP_DEF(opexe_2, "char-downcase", 1, 1, TST_CHAR, OP_CHARDNCASE ) + _OP_DEF(opexe_2, "symbol->string", 1, 1, TST_SYMBOL, OP_SYM2STR ) + _OP_DEF(opexe_2, "atom->string", 1, 2, TST_ANY TST_NATURAL, OP_ATOM2STR ) + _OP_DEF(opexe_2, "string->symbol", 1, 1, TST_STRING, OP_STR2SYM ) + _OP_DEF(opexe_2, "string->atom", 1, 2, TST_STRING TST_NATURAL, OP_STR2ATOM ) + _OP_DEF(opexe_2, "make-string", 1, 2, TST_NATURAL TST_CHAR, OP_MKSTRING ) + _OP_DEF(opexe_2, "string-length", 1, 1, TST_STRING, OP_STRLEN ) + _OP_DEF(opexe_2, "string-ref", 2, 2, TST_STRING TST_NATURAL, OP_STRREF ) + _OP_DEF(opexe_2, "string-set!", 3, 3, TST_STRING TST_NATURAL TST_CHAR, OP_STRSET ) + _OP_DEF(opexe_2, "string-append", 0, INF_ARG, TST_STRING, OP_STRAPPEND ) + _OP_DEF(opexe_2, "substring", 2, 3, TST_STRING TST_NATURAL, OP_SUBSTR ) + _OP_DEF(opexe_2, "vector", 0, INF_ARG, TST_NONE, OP_VECTOR ) + _OP_DEF(opexe_2, "make-vector", 1, 2, TST_NATURAL TST_ANY, OP_MKVECTOR ) + _OP_DEF(opexe_2, "vector-length", 1, 1, TST_VECTOR, OP_VECLEN ) + _OP_DEF(opexe_2, "vector-ref", 2, 2, TST_VECTOR TST_NATURAL, OP_VECREF ) + _OP_DEF(opexe_2, "vector-set!", 3, 3, TST_VECTOR TST_NATURAL TST_ANY, OP_VECSET ) + _OP_DEF(opexe_3, "not", 1, 1, TST_NONE, OP_NOT ) + _OP_DEF(opexe_3, "boolean?", 1, 1, TST_NONE, OP_BOOLP ) + _OP_DEF(opexe_3, "eof-object?", 1, 1, TST_NONE, OP_EOFOBJP ) + _OP_DEF(opexe_3, "null?", 1, 1, TST_NONE, OP_NULLP ) + _OP_DEF(opexe_3, "=", 2, INF_ARG, TST_NUMBER, OP_NUMEQ ) + _OP_DEF(opexe_3, "<", 2, INF_ARG, TST_NUMBER, OP_LESS ) + _OP_DEF(opexe_3, ">", 2, INF_ARG, TST_NUMBER, OP_GRE ) + _OP_DEF(opexe_3, "<=", 2, INF_ARG, TST_NUMBER, OP_LEQ ) + _OP_DEF(opexe_3, ">=", 2, INF_ARG, TST_NUMBER, OP_GEQ ) + _OP_DEF(opexe_3, "symbol?", 1, 1, TST_ANY, OP_SYMBOLP ) + _OP_DEF(opexe_3, "number?", 1, 1, TST_ANY, OP_NUMBERP ) + _OP_DEF(opexe_3, "string?", 1, 1, TST_ANY, OP_STRINGP ) + _OP_DEF(opexe_3, "integer?", 1, 1, TST_ANY, OP_INTEGERP ) + _OP_DEF(opexe_3, "real?", 1, 1, TST_ANY, OP_REALP ) + _OP_DEF(opexe_3, "char?", 1, 1, TST_ANY, OP_CHARP ) +#if USE_CHAR_CLASSIFIERS + _OP_DEF(opexe_3, "char-alphabetic?", 1, 1, TST_CHAR, OP_CHARAP ) + _OP_DEF(opexe_3, "char-numeric?", 1, 1, TST_CHAR, OP_CHARNP ) + _OP_DEF(opexe_3, "char-whitespace?", 1, 1, TST_CHAR, OP_CHARWP ) + _OP_DEF(opexe_3, "char-upper-case?", 1, 1, TST_CHAR, OP_CHARUP ) + _OP_DEF(opexe_3, "char-lower-case?", 1, 1, TST_CHAR, OP_CHARLP ) +#endif + _OP_DEF(opexe_3, "port?", 1, 1, TST_ANY, OP_PORTP ) + _OP_DEF(opexe_3, "input-port?", 1, 1, TST_ANY, OP_INPORTP ) + _OP_DEF(opexe_3, "output-port?", 1, 1, TST_ANY, OP_OUTPORTP ) + _OP_DEF(opexe_3, "procedure?", 1, 1, TST_ANY, OP_PROCP ) + _OP_DEF(opexe_3, "pair?", 1, 1, TST_ANY, OP_PAIRP ) + _OP_DEF(opexe_3, "list?", 1, 1, TST_ANY, OP_LISTP ) + _OP_DEF(opexe_3, "environment?", 1, 1, TST_ANY, OP_ENVP ) + _OP_DEF(opexe_3, "vector?", 1, 1, TST_ANY, OP_VECTORP ) + _OP_DEF(opexe_3, "eq?", 2, 2, TST_ANY, OP_EQ ) + _OP_DEF(opexe_3, "eqv?", 2, 2, TST_ANY, OP_EQV ) + _OP_DEF(opexe_4, "force", 1, 1, TST_ANY, OP_FORCE ) + _OP_DEF(opexe_4, 0, 0, 0, 0, OP_SAVE_FORCED ) + _OP_DEF(opexe_4, "write", 1, 2, TST_ANY TST_OUTPORT, OP_WRITE ) + _OP_DEF(opexe_4, "write-char", 1, 2, TST_CHAR TST_OUTPORT, OP_WRITE_CHAR ) + _OP_DEF(opexe_4, "display", 1, 2, TST_ANY TST_OUTPORT, OP_DISPLAY ) + _OP_DEF(opexe_4, "newline", 0, 1, TST_OUTPORT, OP_NEWLINE ) + _OP_DEF(opexe_4, "error", 1, INF_ARG, TST_NONE, OP_ERR0 ) + _OP_DEF(opexe_4, 0, 0, 0, 0, OP_ERR1 ) + _OP_DEF(opexe_4, "reverse", 1, 1, TST_LIST, OP_REVERSE ) + _OP_DEF(opexe_4, "list*", 1, INF_ARG, TST_NONE, OP_LIST_STAR ) + _OP_DEF(opexe_4, "append", 0, INF_ARG, TST_NONE, OP_APPEND ) +#if USE_PLIST + _OP_DEF(opexe_4, "put", 3, 3, TST_NONE, OP_PUT ) + _OP_DEF(opexe_4, "get", 2, 2, TST_NONE, OP_GET ) +#endif + _OP_DEF(opexe_4, "quit", 0, 1, TST_NUMBER, OP_QUIT ) + _OP_DEF(opexe_4, "gc", 0, 0, 0, OP_GC ) + _OP_DEF(opexe_4, "gc-verbose", 0, 1, TST_NONE, OP_GCVERB ) + _OP_DEF(opexe_4, "new-segment", 0, 1, TST_NUMBER, OP_NEWSEGMENT ) + _OP_DEF(opexe_4, "oblist", 0, 0, 0, OP_OBLIST ) + _OP_DEF(opexe_4, "current-input-port", 0, 0, 0, OP_CURR_INPORT ) + _OP_DEF(opexe_4, "current-output-port", 0, 0, 0, OP_CURR_OUTPORT ) + _OP_DEF(opexe_4, "open-input-file", 1, 1, TST_STRING, OP_OPEN_INFILE ) + _OP_DEF(opexe_4, "open-output-file", 1, 1, TST_STRING, OP_OPEN_OUTFILE ) + _OP_DEF(opexe_4, "open-input-output-file", 1, 1, TST_STRING, OP_OPEN_INOUTFILE ) +#if USE_STRING_PORTS + _OP_DEF(opexe_4, "open-input-string", 1, 1, TST_STRING, OP_OPEN_INSTRING ) + _OP_DEF(opexe_4, "open-input-output-string", 1, 1, TST_STRING, OP_OPEN_INOUTSTRING ) + _OP_DEF(opexe_4, "open-output-string", 0, 1, TST_STRING, OP_OPEN_OUTSTRING ) + _OP_DEF(opexe_4, "get-output-string", 1, 1, TST_OUTPORT, OP_GET_OUTSTRING ) +#endif + _OP_DEF(opexe_4, "close-input-port", 1, 1, TST_INPORT, OP_CLOSE_INPORT ) + _OP_DEF(opexe_4, "close-output-port", 1, 1, TST_OUTPORT, OP_CLOSE_OUTPORT ) + _OP_DEF(opexe_4, "interaction-environment", 0, 0, 0, OP_INT_ENV ) + _OP_DEF(opexe_4, "current-environment", 0, 0, 0, OP_CURR_ENV ) + _OP_DEF(opexe_5, "read", 0, 1, TST_INPORT, OP_READ ) + _OP_DEF(opexe_5, "read-char", 0, 1, TST_INPORT, OP_READ_CHAR ) + _OP_DEF(opexe_5, "peek-char", 0, 1, TST_INPORT, OP_PEEK_CHAR ) + _OP_DEF(opexe_5, "char-ready?", 0, 1, TST_INPORT, OP_CHAR_READY ) + _OP_DEF(opexe_5, "set-input-port", 1, 1, TST_INPORT, OP_SET_INPORT ) + _OP_DEF(opexe_5, "set-output-port", 1, 1, TST_OUTPORT, OP_SET_OUTPORT ) + _OP_DEF(opexe_5, 0, 0, 0, 0, OP_RDSEXPR ) + _OP_DEF(opexe_5, 0, 0, 0, 0, OP_RDLIST ) + _OP_DEF(opexe_5, 0, 0, 0, 0, OP_RDDOT ) + _OP_DEF(opexe_5, 0, 0, 0, 0, OP_RDQUOTE ) + _OP_DEF(opexe_5, 0, 0, 0, 0, OP_RDQQUOTE ) + _OP_DEF(opexe_5, 0, 0, 0, 0, OP_RDQQUOTEVEC ) + _OP_DEF(opexe_5, 0, 0, 0, 0, OP_RDUNQUOTE ) + _OP_DEF(opexe_5, 0, 0, 0, 0, OP_RDUQTSP ) + _OP_DEF(opexe_5, 0, 0, 0, 0, OP_RDVEC ) + _OP_DEF(opexe_5, 0, 0, 0, 0, OP_P0LIST ) + _OP_DEF(opexe_5, 0, 0, 0, 0, OP_P1LIST ) + _OP_DEF(opexe_5, 0, 0, 0, 0, OP_PVECFROM ) + _OP_DEF(opexe_6, "length", 1, 1, TST_LIST, OP_LIST_LENGTH ) + _OP_DEF(opexe_6, "assq", 2, 2, TST_NONE, OP_ASSQ ) + _OP_DEF(opexe_6, "get-closure-code", 1, 1, TST_NONE, OP_GET_CLOSURE ) + _OP_DEF(opexe_6, "closure?", 1, 1, TST_NONE, OP_CLOSUREP ) + _OP_DEF(opexe_6, "macro?", 1, 1, TST_NONE, OP_MACROP ) +#undef _OP_DEF diff --git a/tests/gpgscm/private.h b/tests/gpgscm/private.h new file mode 100644 index 000000000..efa0cb026 --- /dev/null +++ b/tests/gpgscm/private.h @@ -0,0 +1,26 @@ +/* TinyScheme-based test driver. + * + * Copyright (C) 2016 g10 code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#ifndef __GPGSCM_PRIVATE_H__ +#define __GPGSCM_PRIVATE_H__ + +extern int verbose; + +#endif /* __GPGSCM_PRIVATE_H__ */ diff --git a/tests/gpgscm/repl.scm b/tests/gpgscm/repl.scm new file mode 100644 index 000000000..896554faf --- /dev/null +++ b/tests/gpgscm/repl.scm @@ -0,0 +1,50 @@ +;; A read-evaluate-print-loop for gpgscm. +;; +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +;; Interactive repl using 'prompt' function. P must be a function +;; that given the current entered prefix returns the prompt to +;; display. +(define (repl p) + (let ((repl-environment (make-environment))) + (call/cc + (lambda (exit) + (let loop ((prefix "")) + (let ((line (prompt (p prefix)))) + (if (and (not (eof-object? line)) (= 0 (string-length line))) + (exit (loop prefix))) + (if (not (eof-object? line)) + (let* ((next (string-append prefix line)) + (c (catch (begin (echo "Parse error:" *error*) + (loop prefix)) + (read (open-input-string next))))) + (if (not (eof-object? c)) + (begin + (catch (echo "Error:" *error*) + (echo " ===>" (eval c repl-environment))) + (exit (loop "")))) + (exit (loop next)))))))))) + +(define (prompt-append-prefix prompt prefix) + (string-append prompt (if (> (string-length prefix) 0) + (string-append prefix "...") + "> "))) + +;; Default repl run by main.c. +(define (interactive-repl) + (repl (lambda (p) (prompt-append-prefix "gpgscm " p)))) diff --git a/tests/gpgscm/scheme-config.h b/tests/gpgscm/scheme-config.h new file mode 100644 index 000000000..fe3d746dd --- /dev/null +++ b/tests/gpgscm/scheme-config.h @@ -0,0 +1,36 @@ +/* TinyScheme configuration. + * + * Copyright (C) 2016 g10 code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#define STANDALONE 0 +#define USE_MATH 0 +#define USE_CHAR_CLASSIFIERS 1 +#define USE_ASCII_NAMES 1 +#define USE_STRING_PORTS 1 +#define USE_ERROR_HOOK 1 +#define USE_TRACING 1 +#define USE_COLON_HOOK 1 +#define USE_DL 0 +#define USE_PLIST 0 +#define USE_INTERFACE 1 +#define SHOW_ERROR_LINE 1 + +#if __MINGW32__ +# define USE_STRLWR 0 +#endif /* __MINGW32__ */ diff --git a/tests/gpgscm/scheme-private.h b/tests/gpgscm/scheme-private.h new file mode 100644 index 000000000..9eafe766d --- /dev/null +++ b/tests/gpgscm/scheme-private.h @@ -0,0 +1,228 @@ +/* scheme-private.h */ + +#ifndef _SCHEME_PRIVATE_H +#define _SCHEME_PRIVATE_H + +#include "scheme.h" +/*------------------ Ugly internals -----------------------------------*/ +/*------------------ Of interest only to FFI users --------------------*/ + +#ifdef __cplusplus +extern "C" { +#endif + +enum scheme_port_kind { + port_free=0, + port_file=1, + port_string=2, + port_srfi6=4, + port_input=16, + port_output=32, + port_saw_EOF=64 +}; + +typedef struct port { + unsigned char kind; + union { + struct { + FILE *file; + int closeit; +#if SHOW_ERROR_LINE + int curr_line; + char *filename; +#endif + } stdio; + struct { + char *start; + char *past_the_end; + char *curr; + } string; + } rep; +} port; + +/* cell structure */ +struct cell { + unsigned int _flag; + union { + struct { + char *_svalue; + int _length; + } _string; + num _number; + port *_port; + foreign_func _ff; + struct { + struct cell *_car; + struct cell *_cdr; + } _cons; + struct { + char *_data; + const foreign_object_vtable *_vtable; + } _foreign_object; + } _object; +}; + +struct scheme { +/* arrays for segments */ +func_alloc malloc; +func_dealloc free; + +/* return code */ +int retcode; +int tracing; + + +#ifndef CELL_SEGSIZE +#define CELL_SEGSIZE 5000 /* # of cells in one segment */ +#endif +#ifndef CELL_NSEGMENT +#define CELL_NSEGMENT 10 /* # of segments for cells */ +#endif +char *alloc_seg[CELL_NSEGMENT]; +pointer cell_seg[CELL_NSEGMENT]; +int last_cell_seg; + +/* We use 4 registers. */ +pointer args; /* register for arguments of function */ +pointer envir; /* stack register for current environment */ +pointer code; /* register for current code */ +pointer dump; /* stack register for next evaluation */ + +int interactive_repl; /* are we in an interactive REPL? */ + +struct cell _sink; +pointer sink; /* when mem. alloc. fails */ +struct cell _NIL; +pointer NIL; /* special cell representing empty cell */ +struct cell _HASHT; +pointer T; /* special cell representing #t */ +struct cell _HASHF; +pointer F; /* special cell representing #f */ +struct cell _EOF_OBJ; +pointer EOF_OBJ; /* special cell representing end-of-file object */ +pointer oblist; /* pointer to symbol table */ +pointer global_env; /* pointer to global environment */ +pointer c_nest; /* stack for nested calls from C */ + +/* global pointers to special symbols */ +pointer LAMBDA; /* pointer to syntax lambda */ +pointer QUOTE; /* pointer to syntax quote */ + +pointer QQUOTE; /* pointer to symbol quasiquote */ +pointer UNQUOTE; /* pointer to symbol unquote */ +pointer UNQUOTESP; /* pointer to symbol unquote-splicing */ +pointer FEED_TO; /* => */ +pointer COLON_HOOK; /* *colon-hook* */ +pointer ERROR_HOOK; /* *error-hook* */ +pointer SHARP_HOOK; /* *sharp-hook* */ +pointer COMPILE_HOOK; /* *compile-hook* */ + +pointer free_cell; /* pointer to top of free cells */ +long fcells; /* # of free cells */ + +pointer inport; +pointer outport; +pointer save_inport; +pointer loadport; + +#ifndef MAXFIL +#define MAXFIL 64 +#endif +port load_stack[MAXFIL]; /* Stack of open files for port -1 (LOADing) */ +int nesting_stack[MAXFIL]; +int file_i; +int nesting; + +char gc_verbose; /* if gc_verbose is not zero, print gc status */ +char no_memory; /* Whether mem. alloc. has failed */ + +#ifndef LINESIZE +#define LINESIZE 1024 +#endif +char linebuff[LINESIZE]; +#ifndef STRBUFFSIZE +#define STRBUFFSIZE 256 +#endif +char *strbuff; +size_t strbuff_size; +FILE *tmpfp; +int tok; +int print_flag; +pointer value; +int op; + +void *ext_data; /* For the benefit of foreign functions */ +long gensym_cnt; + +struct scheme_interface *vptr; +void *dump_base; /* pointer to base of allocated dump stack */ +int dump_size; /* number of frames allocated for dump stack */ +}; + +/* operator code */ +enum scheme_opcodes { +#define _OP_DEF(A,B,C,D,E,OP) OP, +#include "opdefines.h" + OP_MAXDEFINED +}; + + +#define cons(sc,a,b) _cons(sc,a,b,0) +#define immutable_cons(sc,a,b) _cons(sc,a,b,1) + +int is_string(pointer p); +char *string_value(pointer p); +int is_number(pointer p); +num nvalue(pointer p); +long ivalue(pointer p); +double rvalue(pointer p); +int is_integer(pointer p); +int is_real(pointer p); +int is_character(pointer p); +long charvalue(pointer p); +int is_vector(pointer p); + +int is_port(pointer p); + +int is_pair(pointer p); +pointer pair_car(pointer p); +pointer pair_cdr(pointer p); +pointer set_car(pointer p, pointer q); +pointer set_cdr(pointer p, pointer q); + +int is_symbol(pointer p); +char *symname(pointer p); +int hasprop(pointer p); + +int is_syntax(pointer p); +int is_proc(pointer p); +int is_foreign(pointer p); +char *syntaxname(pointer p); +int is_closure(pointer p); +#ifdef USE_MACRO +int is_macro(pointer p); +#endif +pointer closure_code(pointer p); +pointer closure_env(pointer p); + +int is_continuation(pointer p); +int is_promise(pointer p); +int is_environment(pointer p); +int is_immutable(pointer p); +void setimmutable(pointer p); + +int is_foreign_object(pointer p); +const foreign_object_vtable *get_foreign_object_vtable(pointer p); +void *get_foreign_object_data(pointer p); + +#ifdef __cplusplus +} +#endif + +#endif + +/* +Local variables: +c-file-style: "k&r" +End: +*/ diff --git a/tests/gpgscm/scheme.c b/tests/gpgscm/scheme.c new file mode 100644 index 000000000..0a7620521 --- /dev/null +++ b/tests/gpgscm/scheme.c @@ -0,0 +1,5169 @@ +/* T I N Y S C H E M E 1 . 4 1 + * Dimitrios Souflis (dsouflis@acm.org) + * Based on MiniScheme (original credits follow) + * (MINISCM) coded by Atsushi Moriwaki (11/5/1989) + * (MINISCM) E-MAIL : moriwaki@kurims.kurims.kyoto-u.ac.jp + * (MINISCM) This version has been modified by R.C. Secrist. + * (MINISCM) + * (MINISCM) Mini-Scheme is now maintained by Akira KIDA. + * (MINISCM) + * (MINISCM) This is a revised and modified version by Akira KIDA. + * (MINISCM) current version is 0.85k4 (15 May 1994) + * + */ + +#define _SCHEME_SOURCE +#include "scheme-private.h" +#ifndef WIN32 +# include +#endif +#ifdef WIN32 +#define snprintf _snprintf +#endif +#if USE_DL +# include "dynload.h" +#endif +#if USE_MATH +# include +#endif + +#include +#include +#include +#include + +#if USE_STRCASECMP +#include +# ifndef __APPLE__ +# define stricmp strcasecmp +# endif +#endif + +/* Used for documentation purposes, to signal functions in 'interface' */ +#define INTERFACE + +#define TOK_EOF (-1) +#define TOK_LPAREN 0 +#define TOK_RPAREN 1 +#define TOK_DOT 2 +#define TOK_ATOM 3 +#define TOK_QUOTE 4 +#define TOK_COMMENT 5 +#define TOK_DQUOTE 6 +#define TOK_BQUOTE 7 +#define TOK_COMMA 8 +#define TOK_ATMARK 9 +#define TOK_SHARP 10 +#define TOK_SHARP_CONST 11 +#define TOK_VEC 12 + +#define BACKQUOTE '`' +#define DELIMITERS "()\";\f\t\v\n\r " + +/* + * Basic memory allocation units + */ + +#define banner "TinyScheme 1.41" + +#include +#include +#include + +#ifdef __APPLE__ +static int stricmp(const char *s1, const char *s2) +{ + unsigned char c1, c2; + do { + c1 = tolower(*s1); + c2 = tolower(*s2); + if (c1 < c2) + return -1; + else if (c1 > c2) + return 1; + s1++, s2++; + } while (c1 != 0); + return 0; +} +#endif /* __APPLE__ */ + +#if USE_STRLWR +static const char *strlwr(char *s) { + const char *p=s; + while(*s) { + *s=tolower(*s); + s++; + } + return p; +} +#endif + +#ifndef prompt +# define prompt "ts> " +#endif + +#ifndef InitFile +# define InitFile "init.scm" +#endif + +#ifndef FIRST_CELLSEGS +# define FIRST_CELLSEGS 3 +#endif + +enum scheme_types { + T_STRING=1, + T_NUMBER=2, + T_SYMBOL=3, + T_PROC=4, + T_PAIR=5, + T_CLOSURE=6, + T_CONTINUATION=7, + T_FOREIGN=8, + T_CHARACTER=9, + T_PORT=10, + T_VECTOR=11, + T_MACRO=12, + T_PROMISE=13, + T_ENVIRONMENT=14, + T_FOREIGN_OBJECT=15, + T_BOOLEAN=16, + T_NIL=17, + T_EOF_OBJ=18, + T_SINK=19, + T_LAST_SYSTEM_TYPE=19 +}; + +static const char * +type_to_string (enum scheme_types typ) +{ + switch (typ) + { + case T_STRING: return "string"; + case T_NUMBER: return "number"; + case T_SYMBOL: return "symbol"; + case T_PROC: return "proc"; + case T_PAIR: return "pair"; + case T_CLOSURE: return "closure"; + case T_CONTINUATION: return "configuration"; + case T_FOREIGN: return "foreign"; + case T_CHARACTER: return "character"; + case T_PORT: return "port"; + case T_VECTOR: return "vector"; + case T_MACRO: return "macro"; + case T_PROMISE: return "promise"; + case T_ENVIRONMENT: return "environment"; + case T_FOREIGN_OBJECT: return "foreign object"; + case T_BOOLEAN: return "boolean"; + case T_NIL: return "nil"; + case T_EOF_OBJ: return "eof object"; + case T_SINK: return "sink"; + } + assert (! "not reached"); +} + +/* ADJ is enough slack to align cells in a TYPE_BITS-bit boundary */ +#define ADJ 32 +#define TYPE_BITS 5 +#define T_MASKTYPE 31 /* 0000000000011111 */ +#define T_SYNTAX 4096 /* 0001000000000000 */ +#define T_IMMUTABLE 8192 /* 0010000000000000 */ +#define T_ATOM 16384 /* 0100000000000000 */ /* only for gc */ +#define CLRATOM 49151 /* 1011111111111111 */ /* only for gc */ +#define MARK 32768 /* 1000000000000000 */ +#define UNMARK 32767 /* 0111111111111111 */ + + +static num num_add(num a, num b); +static num num_mul(num a, num b); +static num num_div(num a, num b); +static num num_intdiv(num a, num b); +static num num_sub(num a, num b); +static num num_rem(num a, num b); +static num num_mod(num a, num b); +static int num_eq(num a, num b); +static int num_gt(num a, num b); +static int num_ge(num a, num b); +static int num_lt(num a, num b); +static int num_le(num a, num b); + +#if USE_MATH +static double round_per_R5RS(double x); +#endif +static int is_zero_double(double x); +static INLINE int num_is_integer(pointer p) { + return ((p)->_object._number.is_fixnum); +} + +static num num_zero; +static num num_one; + +/* macros for cell operations */ +#define typeflag(p) ((p)->_flag) +#define type(p) (typeflag(p)&T_MASKTYPE) + +INTERFACE INLINE int is_string(pointer p) { return (type(p)==T_STRING); } +#define strvalue(p) ((p)->_object._string._svalue) +#define strlength(p) ((p)->_object._string._length) + +INTERFACE static int is_list(scheme *sc, pointer p); +INTERFACE INLINE int is_vector(pointer p) { return (type(p)==T_VECTOR); } +INTERFACE static void fill_vector(pointer vec, pointer obj); +INTERFACE static pointer vector_elem(pointer vec, int ielem); +INTERFACE static pointer set_vector_elem(pointer vec, int ielem, pointer a); +INTERFACE INLINE int is_number(pointer p) { return (type(p)==T_NUMBER); } +INTERFACE INLINE int is_integer(pointer p) { + if (!is_number(p)) + return 0; + if (num_is_integer(p) || (double)ivalue(p) == rvalue(p)) + return 1; + return 0; +} + +INTERFACE INLINE int is_real(pointer p) { + return is_number(p) && (!(p)->_object._number.is_fixnum); +} + +INTERFACE INLINE int is_character(pointer p) { return (type(p)==T_CHARACTER); } +INTERFACE INLINE char *string_value(pointer p) { return strvalue(p); } +INLINE num nvalue(pointer p) { return ((p)->_object._number); } +INTERFACE long ivalue(pointer p) { return (num_is_integer(p)?(p)->_object._number.value.ivalue:(long)(p)->_object._number.value.rvalue); } +INTERFACE double rvalue(pointer p) { return (!num_is_integer(p)?(p)->_object._number.value.rvalue:(double)(p)->_object._number.value.ivalue); } +#define ivalue_unchecked(p) ((p)->_object._number.value.ivalue) +#define rvalue_unchecked(p) ((p)->_object._number.value.rvalue) +#define set_num_integer(p) (p)->_object._number.is_fixnum=1; +#define set_num_real(p) (p)->_object._number.is_fixnum=0; +INTERFACE long charvalue(pointer p) { return ivalue_unchecked(p); } + +INTERFACE INLINE int is_port(pointer p) { return (type(p)==T_PORT); } +INTERFACE INLINE int is_inport(pointer p) { return is_port(p) && p->_object._port->kind & port_input; } +INTERFACE INLINE int is_outport(pointer p) { return is_port(p) && p->_object._port->kind & port_output; } + +INTERFACE INLINE int is_pair(pointer p) { return (type(p)==T_PAIR); } +#define car(p) ((p)->_object._cons._car) +#define cdr(p) ((p)->_object._cons._cdr) +INTERFACE pointer pair_car(pointer p) { return car(p); } +INTERFACE pointer pair_cdr(pointer p) { return cdr(p); } +INTERFACE pointer set_car(pointer p, pointer q) { return car(p)=q; } +INTERFACE pointer set_cdr(pointer p, pointer q) { return cdr(p)=q; } + +INTERFACE INLINE int is_symbol(pointer p) { return (type(p)==T_SYMBOL); } +INTERFACE INLINE char *symname(pointer p) { return strvalue(car(p)); } +#if USE_PLIST +SCHEME_EXPORT INLINE int hasprop(pointer p) { return (typeflag(p)&T_SYMBOL); } +#define symprop(p) cdr(p) +#endif + +INTERFACE INLINE int is_syntax(pointer p) { return (typeflag(p)&T_SYNTAX); } +INTERFACE INLINE int is_proc(pointer p) { return (type(p)==T_PROC); } +INTERFACE INLINE int is_foreign(pointer p) { return (type(p)==T_FOREIGN); } +INTERFACE INLINE char *syntaxname(pointer p) { return strvalue(car(p)); } +#define procnum(p) ivalue(p) +static const char *procname(pointer x); + +INTERFACE INLINE int is_closure(pointer p) { return (type(p)==T_CLOSURE); } +INTERFACE INLINE int is_macro(pointer p) { return (type(p)==T_MACRO); } +INTERFACE INLINE pointer closure_code(pointer p) { return car(p); } +INTERFACE INLINE pointer closure_env(pointer p) { return cdr(p); } + +INTERFACE INLINE int is_continuation(pointer p) { return (type(p)==T_CONTINUATION); } +#define cont_dump(p) cdr(p) + +INTERFACE INLINE int is_foreign_object(pointer p) { return (type(p)==T_FOREIGN_OBJECT); } +INTERFACE const foreign_object_vtable *get_foreign_object_vtable(pointer p) { + return p->_object._foreign_object._vtable; +} +INTERFACE void *get_foreign_object_data(pointer p) { + return p->_object._foreign_object._data; +} + +/* To do: promise should be forced ONCE only */ +INTERFACE INLINE int is_promise(pointer p) { return (type(p)==T_PROMISE); } + +INTERFACE INLINE int is_environment(pointer p) { return (type(p)==T_ENVIRONMENT); } +#define setenvironment(p) typeflag(p) = T_ENVIRONMENT + +#define is_atom(p) (typeflag(p)&T_ATOM) +#define setatom(p) typeflag(p) |= T_ATOM +#define clratom(p) typeflag(p) &= CLRATOM + +#define is_mark(p) (typeflag(p)&MARK) +#define setmark(p) typeflag(p) |= MARK +#define clrmark(p) typeflag(p) &= UNMARK + +INTERFACE INLINE int is_immutable(pointer p) { return (typeflag(p)&T_IMMUTABLE); } +/*#define setimmutable(p) typeflag(p) |= T_IMMUTABLE*/ +INTERFACE INLINE void setimmutable(pointer p) { typeflag(p) |= T_IMMUTABLE; } + +#define caar(p) car(car(p)) +#define cadr(p) car(cdr(p)) +#define cdar(p) cdr(car(p)) +#define cddr(p) cdr(cdr(p)) +#define cadar(p) car(cdr(car(p))) +#define caddr(p) car(cdr(cdr(p))) +#define cdaar(p) cdr(car(car(p))) +#define cadaar(p) car(cdr(car(car(p)))) +#define cadddr(p) car(cdr(cdr(cdr(p)))) +#define cddddr(p) cdr(cdr(cdr(cdr(p)))) + +#if USE_CHAR_CLASSIFIERS +static INLINE int Cisalpha(int c) { return isascii(c) && isalpha(c); } +static INLINE int Cisdigit(int c) { return isascii(c) && isdigit(c); } +static INLINE int Cisspace(int c) { return isascii(c) && isspace(c); } +static INLINE int Cisupper(int c) { return isascii(c) && isupper(c); } +static INLINE int Cislower(int c) { return isascii(c) && islower(c); } +#endif + +#if USE_ASCII_NAMES +static const char *charnames[32]={ + "nul", + "soh", + "stx", + "etx", + "eot", + "enq", + "ack", + "bel", + "bs", + "ht", + "lf", + "vt", + "ff", + "cr", + "so", + "si", + "dle", + "dc1", + "dc2", + "dc3", + "dc4", + "nak", + "syn", + "etb", + "can", + "em", + "sub", + "esc", + "fs", + "gs", + "rs", + "us" +}; + +static int is_ascii_name(const char *name, int *pc) { + int i; + for(i=0; i<32; i++) { + if(stricmp(name,charnames[i])==0) { + *pc=i; + return 1; + } + } + if(stricmp(name,"del")==0) { + *pc=127; + return 1; + } + return 0; +} + +#endif + +static int file_push(scheme *sc, const char *fname); +static void file_pop(scheme *sc); +static int file_interactive(scheme *sc); +static INLINE int is_one_of(char *s, int c); +static int alloc_cellseg(scheme *sc, int n); +static long binary_decode(const char *s); +static INLINE pointer get_cell(scheme *sc, pointer a, pointer b); +static pointer _get_cell(scheme *sc, pointer a, pointer b); +static pointer reserve_cells(scheme *sc, int n); +static pointer get_consecutive_cells(scheme *sc, int n); +static pointer find_consecutive_cells(scheme *sc, int n); +static void finalize_cell(scheme *sc, pointer a); +static int count_consecutive_cells(pointer x, int needed); +static pointer find_slot_in_env(scheme *sc, pointer env, pointer sym, int all); +static pointer mk_number(scheme *sc, num n); +static char *store_string(scheme *sc, int len, const char *str, char fill); +static pointer mk_vector(scheme *sc, int len); +static pointer mk_atom(scheme *sc, char *q); +static pointer mk_sharp_const(scheme *sc, char *name); +static pointer mk_port(scheme *sc, port *p); +static pointer port_from_filename(scheme *sc, const char *fn, int prop); +static pointer port_from_file(scheme *sc, FILE *, int prop); +static pointer port_from_string(scheme *sc, char *start, char *past_the_end, int prop); +static port *port_rep_from_filename(scheme *sc, const char *fn, int prop); +static port *port_rep_from_file(scheme *sc, FILE *, int prop); +static port *port_rep_from_string(scheme *sc, char *start, char *past_the_end, int prop); +static void port_close(scheme *sc, pointer p, int flag); +static void mark(pointer a); +static void gc(scheme *sc, pointer a, pointer b); +static int basic_inchar(port *pt); +static int inchar(scheme *sc); +static void backchar(scheme *sc, int c); +static char *readstr_upto(scheme *sc, char *delim); +static pointer readstrexp(scheme *sc); +static INLINE int skipspace(scheme *sc); +static int token(scheme *sc); +static void printslashstring(scheme *sc, char *s, int len); +static void atom2str(scheme *sc, pointer l, int f, char **pp, int *plen); +static void printatom(scheme *sc, pointer l, int f); +static pointer mk_proc(scheme *sc, enum scheme_opcodes op); +static pointer mk_closure(scheme *sc, pointer c, pointer e); +static pointer mk_continuation(scheme *sc, pointer d); +static pointer reverse(scheme *sc, pointer a); +static pointer reverse_in_place(scheme *sc, pointer term, pointer list); +static pointer revappend(scheme *sc, pointer a, pointer b); +static void dump_stack_mark(scheme *); +static pointer opexe_0(scheme *sc, enum scheme_opcodes op); +static pointer opexe_1(scheme *sc, enum scheme_opcodes op); +static pointer opexe_2(scheme *sc, enum scheme_opcodes op); +static pointer opexe_3(scheme *sc, enum scheme_opcodes op); +static pointer opexe_4(scheme *sc, enum scheme_opcodes op); +static pointer opexe_5(scheme *sc, enum scheme_opcodes op); +static pointer opexe_6(scheme *sc, enum scheme_opcodes op); +static void Eval_Cycle(scheme *sc, enum scheme_opcodes op); +static void assign_syntax(scheme *sc, char *name); +static int syntaxnum(pointer p); +static void assign_proc(scheme *sc, enum scheme_opcodes, char *name); + +#define num_ivalue(n) (n.is_fixnum?(n).value.ivalue:(long)(n).value.rvalue) +#define num_rvalue(n) (!n.is_fixnum?(n).value.rvalue:(double)(n).value.ivalue) + +static num num_add(num a, num b) { + num ret; + ret.is_fixnum=a.is_fixnum && b.is_fixnum; + if(ret.is_fixnum) { + ret.value.ivalue= a.value.ivalue+b.value.ivalue; + } else { + ret.value.rvalue=num_rvalue(a)+num_rvalue(b); + } + return ret; +} + +static num num_mul(num a, num b) { + num ret; + ret.is_fixnum=a.is_fixnum && b.is_fixnum; + if(ret.is_fixnum) { + ret.value.ivalue= a.value.ivalue*b.value.ivalue; + } else { + ret.value.rvalue=num_rvalue(a)*num_rvalue(b); + } + return ret; +} + +static num num_div(num a, num b) { + num ret; + ret.is_fixnum=a.is_fixnum && b.is_fixnum && a.value.ivalue%b.value.ivalue==0; + if(ret.is_fixnum) { + ret.value.ivalue= a.value.ivalue/b.value.ivalue; + } else { + ret.value.rvalue=num_rvalue(a)/num_rvalue(b); + } + return ret; +} + +static num num_intdiv(num a, num b) { + num ret; + ret.is_fixnum=a.is_fixnum && b.is_fixnum; + if(ret.is_fixnum) { + ret.value.ivalue= a.value.ivalue/b.value.ivalue; + } else { + ret.value.rvalue=num_rvalue(a)/num_rvalue(b); + } + return ret; +} + +static num num_sub(num a, num b) { + num ret; + ret.is_fixnum=a.is_fixnum && b.is_fixnum; + if(ret.is_fixnum) { + ret.value.ivalue= a.value.ivalue-b.value.ivalue; + } else { + ret.value.rvalue=num_rvalue(a)-num_rvalue(b); + } + return ret; +} + +static num num_rem(num a, num b) { + num ret; + long e1, e2, res; + ret.is_fixnum=a.is_fixnum && b.is_fixnum; + e1=num_ivalue(a); + e2=num_ivalue(b); + res=e1%e2; + /* remainder should have same sign as second operand */ + if (res > 0) { + if (e1 < 0) { + res -= labs(e2); + } + } else if (res < 0) { + if (e1 > 0) { + res += labs(e2); + } + } + ret.value.ivalue=res; + return ret; +} + +static num num_mod(num a, num b) { + num ret; + long e1, e2, res; + ret.is_fixnum=a.is_fixnum && b.is_fixnum; + e1=num_ivalue(a); + e2=num_ivalue(b); + res=e1%e2; + /* modulo should have same sign as second operand */ + if (res * e2 < 0) { + res += e2; + } + ret.value.ivalue=res; + return ret; +} + +static int num_eq(num a, num b) { + int ret; + int is_fixnum=a.is_fixnum && b.is_fixnum; + if(is_fixnum) { + ret= a.value.ivalue==b.value.ivalue; + } else { + ret=num_rvalue(a)==num_rvalue(b); + } + return ret; +} + + +static int num_gt(num a, num b) { + int ret; + int is_fixnum=a.is_fixnum && b.is_fixnum; + if(is_fixnum) { + ret= a.value.ivalue>b.value.ivalue; + } else { + ret=num_rvalue(a)>num_rvalue(b); + } + return ret; +} + +static int num_ge(num a, num b) { + return !num_lt(a,b); +} + +static int num_lt(num a, num b) { + int ret; + int is_fixnum=a.is_fixnum && b.is_fixnum; + if(is_fixnum) { + ret= a.value.ivaluedce) { + return ce; + } else if(dfl-DBL_MIN; +} + +static long binary_decode(const char *s) { + long x=0; + + while(*s!=0 && (*s=='1' || *s=='0')) { + x<<=1; + x+=*s-'0'; + s++; + } + + return x; +} + +/* allocate new cell segment */ +static int alloc_cellseg(scheme *sc, int n) { + pointer newp; + pointer last; + pointer p; + char *cp; + long i; + int k; + int adj=ADJ; + + if(adjlast_cell_seg >= CELL_NSEGMENT - 1) + return k; + cp = (char*) sc->malloc(CELL_SEGSIZE * sizeof(struct cell)+adj); + if (cp == 0) + return k; + i = ++sc->last_cell_seg ; + sc->alloc_seg[i] = cp; + /* adjust in TYPE_BITS-bit boundary */ + if(((unsigned long)cp)%adj!=0) { + cp=(char*)(adj*((unsigned long)cp/adj+1)); + } + /* insert new segment in address order */ + newp=(pointer)cp; + sc->cell_seg[i] = newp; + while (i > 0 && sc->cell_seg[i - 1] > sc->cell_seg[i]) { + p = sc->cell_seg[i]; + sc->cell_seg[i] = sc->cell_seg[i - 1]; + sc->cell_seg[--i] = p; + } + sc->fcells += CELL_SEGSIZE; + last = newp + CELL_SEGSIZE - 1; + for (p = newp; p <= last; p++) { + typeflag(p) = 0; + cdr(p) = p + 1; + car(p) = sc->NIL; + } + /* insert new cells in address order on free list */ + if (sc->free_cell == sc->NIL || p < sc->free_cell) { + cdr(last) = sc->free_cell; + sc->free_cell = newp; + } else { + p = sc->free_cell; + while (cdr(p) != sc->NIL && newp > cdr(p)) + p = cdr(p); + cdr(last) = cdr(p); + cdr(p) = newp; + } + } + return n; +} + +static INLINE pointer get_cell_x(scheme *sc, pointer a, pointer b) { + if (sc->free_cell != sc->NIL) { + pointer x = sc->free_cell; + sc->free_cell = cdr(x); + --sc->fcells; + return (x); + } + return _get_cell (sc, a, b); +} + + +/* get new cell. parameter a, b is marked by gc. */ +static pointer _get_cell(scheme *sc, pointer a, pointer b) { + pointer x; + + if(sc->no_memory) { + return sc->sink; + } + + if (sc->free_cell == sc->NIL) { + const int min_to_be_recovered = sc->last_cell_seg*8; + gc(sc,a, b); + if (sc->fcells < min_to_be_recovered + || sc->free_cell == sc->NIL) { + /* if only a few recovered, get more to avoid fruitless gc's */ + if (!alloc_cellseg(sc,1) && sc->free_cell == sc->NIL) { + sc->no_memory=1; + return sc->sink; + } + } + } + x = sc->free_cell; + sc->free_cell = cdr(x); + --sc->fcells; + return (x); +} + +/* make sure that there is a given number of cells free */ +static pointer reserve_cells(scheme *sc, int n) { + if(sc->no_memory) { + return sc->NIL; + } + + /* Are there enough cells available? */ + if (sc->fcells < n) { + /* If not, try gc'ing some */ + gc(sc, sc->NIL, sc->NIL); + if (sc->fcells < n) { + /* If there still aren't, try getting more heap */ + if (!alloc_cellseg(sc,1)) { + sc->no_memory=1; + return sc->NIL; + } + } + if (sc->fcells < n) { + /* If all fail, report failure */ + sc->no_memory=1; + return sc->NIL; + } + } + return (sc->T); +} + +static pointer get_consecutive_cells(scheme *sc, int n) { + pointer x; + + if(sc->no_memory) { return sc->sink; } + + /* Are there any cells available? */ + x=find_consecutive_cells(sc,n); + if (x != sc->NIL) { return x; } + + /* If not, try gc'ing some */ + gc(sc, sc->NIL, sc->NIL); + x=find_consecutive_cells(sc,n); + if (x != sc->NIL) { return x; } + + /* If there still aren't, try getting more heap */ + if (!alloc_cellseg(sc,1)) + { + sc->no_memory=1; + return sc->sink; + } + + x=find_consecutive_cells(sc,n); + if (x != sc->NIL) { return x; } + + /* If all fail, report failure */ + sc->no_memory=1; + return sc->sink; +} + +static int count_consecutive_cells(pointer x, int needed) { + int n=1; + while(cdr(x)==x+1) { + x=cdr(x); + n++; + if(n>needed) return n; + } + return n; +} + +static pointer find_consecutive_cells(scheme *sc, int n) { + pointer *pp; + int cnt; + + pp=&sc->free_cell; + while(*pp!=sc->NIL) { + cnt=count_consecutive_cells(*pp,n); + if(cnt>=n) { + pointer x=*pp; + *pp=cdr(*pp+n-1); + sc->fcells -= n; + return x; + } + pp=&cdr(*pp+cnt-1); + } + return sc->NIL; +} + +/* To retain recent allocs before interpreter knows about them - + Tehom */ + +static void push_recent_alloc(scheme *sc, pointer recent, pointer extra) +{ + pointer holder = get_cell_x(sc, recent, extra); + typeflag(holder) = T_PAIR | T_IMMUTABLE; + car(holder) = recent; + cdr(holder) = car(sc->sink); + car(sc->sink) = holder; +} + + +static pointer get_cell(scheme *sc, pointer a, pointer b) +{ + pointer cell = get_cell_x(sc, a, b); + /* For right now, include "a" and "b" in "cell" so that gc doesn't + think they are garbage. */ + /* Tentatively record it as a pair so gc understands it. */ + typeflag(cell) = T_PAIR; + car(cell) = a; + cdr(cell) = b; + push_recent_alloc(sc, cell, sc->NIL); + return cell; +} + +static pointer get_vector_object(scheme *sc, int len, pointer init) +{ + pointer cells = get_consecutive_cells(sc,len/2+len%2+1); + if(sc->no_memory) { return sc->sink; } + /* Record it as a vector so that gc understands it. */ + typeflag(cells) = (T_VECTOR | T_ATOM); + ivalue_unchecked(cells)=len; + set_num_integer(cells); + fill_vector(cells,init); + push_recent_alloc(sc, cells, sc->NIL); + return cells; +} + +static INLINE void ok_to_freely_gc(scheme *sc) +{ + car(sc->sink) = sc->NIL; +} + + +#if defined TSGRIND +static void check_cell_alloced(pointer p, int expect_alloced) +{ + /* Can't use putstr(sc,str) because callers have no access to + sc. */ + if(typeflag(p) & !expect_alloced) + { + fprintf(stderr,"Cell is already allocated!\n"); + } + if(!(typeflag(p)) & expect_alloced) + { + fprintf(stderr,"Cell is not allocated!\n"); + } + +} +static void check_range_alloced(pointer p, int n, int expect_alloced) +{ + int i; + for(i = 0;iNIL); + typeflag(x) = T_SYMBOL; + setimmutable(car(x)); + + location = hash_fn(name, ivalue_unchecked(sc->oblist)); + set_vector_elem(sc->oblist, location, + immutable_cons(sc, x, vector_elem(sc->oblist, location))); + return x; +} + +static INLINE pointer oblist_find_by_name(scheme *sc, const char *name) +{ + int location; + pointer x; + char *s; + + location = hash_fn(name, ivalue_unchecked(sc->oblist)); + for (x = vector_elem(sc->oblist, location); x != sc->NIL; x = cdr(x)) { + s = symname(car(x)); + /* case-insensitive, per R5RS section 2. */ + if(stricmp(name, s) == 0) { + return car(x); + } + } + return sc->NIL; +} + +static pointer oblist_all_symbols(scheme *sc) +{ + int i; + pointer x; + pointer ob_list = sc->NIL; + + for (i = 0; i < ivalue_unchecked(sc->oblist); i++) { + for (x = vector_elem(sc->oblist, i); x != sc->NIL; x = cdr(x)) { + ob_list = cons(sc, x, ob_list); + } + } + return ob_list; +} + +#else + +static pointer oblist_initial_value(scheme *sc) +{ + return sc->NIL; +} + +static INLINE pointer oblist_find_by_name(scheme *sc, const char *name) +{ + pointer x; + char *s; + + for (x = sc->oblist; x != sc->NIL; x = cdr(x)) { + s = symname(car(x)); + /* case-insensitive, per R5RS section 2. */ + if(stricmp(name, s) == 0) { + return car(x); + } + } + return sc->NIL; +} + +/* returns the new symbol */ +static pointer oblist_add_by_name(scheme *sc, const char *name) +{ + pointer x; + + x = immutable_cons(sc, mk_string(sc, name), sc->NIL); + typeflag(x) = T_SYMBOL; + setimmutable(car(x)); + sc->oblist = immutable_cons(sc, x, sc->oblist); + return x; +} +static pointer oblist_all_symbols(scheme *sc) +{ + return sc->oblist; +} + +#endif + +static pointer mk_port(scheme *sc, port *p) { + pointer x = get_cell(sc, sc->NIL, sc->NIL); + + typeflag(x) = T_PORT|T_ATOM; + x->_object._port=p; + return (x); +} + +pointer mk_foreign_func(scheme *sc, foreign_func f) { + pointer x = get_cell(sc, sc->NIL, sc->NIL); + + typeflag(x) = (T_FOREIGN | T_ATOM); + x->_object._ff=f; + return (x); +} + +pointer mk_foreign_object(scheme *sc, const foreign_object_vtable *vtable, void *data) { + pointer x = get_cell(sc, sc->NIL, sc->NIL); + + typeflag(x) = (T_FOREIGN_OBJECT | T_ATOM); + x->_object._foreign_object._vtable=vtable; + x->_object._foreign_object._data = data; + return (x); +} + +INTERFACE pointer mk_character(scheme *sc, int c) { + pointer x = get_cell(sc,sc->NIL, sc->NIL); + + typeflag(x) = (T_CHARACTER | T_ATOM); + ivalue_unchecked(x)= c; + set_num_integer(x); + return (x); +} + +/* get number atom (integer) */ +INTERFACE pointer mk_integer(scheme *sc, long n) { + pointer x = get_cell(sc,sc->NIL, sc->NIL); + + typeflag(x) = (T_NUMBER | T_ATOM); + ivalue_unchecked(x)= n; + set_num_integer(x); + return (x); +} + +INTERFACE pointer mk_real(scheme *sc, double n) { + pointer x = get_cell(sc,sc->NIL, sc->NIL); + + typeflag(x) = (T_NUMBER | T_ATOM); + rvalue_unchecked(x)= n; + set_num_real(x); + return (x); +} + +static pointer mk_number(scheme *sc, num n) { + if(n.is_fixnum) { + return mk_integer(sc,n.value.ivalue); + } else { + return mk_real(sc,n.value.rvalue); + } +} + +/* allocate name to string area */ +static char *store_string(scheme *sc, int len_str, const char *str, char fill) { + char *q; + + q=(char*)sc->malloc(len_str+1); + if(q==0) { + sc->no_memory=1; + return sc->strbuff; + } + if(str!=0) { + memcpy (q, str, len_str); + q[len_str]=0; + } else { + memset(q, fill, len_str); + q[len_str]=0; + } + return (q); +} + +/* get new string */ +INTERFACE pointer mk_string(scheme *sc, const char *str) { + return mk_counted_string(sc,str,strlen(str)); +} + +INTERFACE pointer mk_counted_string(scheme *sc, const char *str, int len) { + pointer x = get_cell(sc, sc->NIL, sc->NIL); + typeflag(x) = (T_STRING | T_ATOM); + strvalue(x) = store_string(sc,len,str,0); + strlength(x) = len; + return (x); +} + +INTERFACE pointer mk_empty_string(scheme *sc, int len, char fill) { + pointer x = get_cell(sc, sc->NIL, sc->NIL); + typeflag(x) = (T_STRING | T_ATOM); + strvalue(x) = store_string(sc,len,0,fill); + strlength(x) = len; + return (x); +} + +INTERFACE static pointer mk_vector(scheme *sc, int len) +{ return get_vector_object(sc,len,sc->NIL); } + +INTERFACE static void fill_vector(pointer vec, pointer obj) { + int i; + int n = ivalue(vec)/2+ivalue(vec)%2; + for(i=0; i < n; i++) { + typeflag(vec+1+i) = T_PAIR; + setimmutable(vec+1+i); + car(vec+1+i)=obj; + cdr(vec+1+i)=obj; + } +} + +INTERFACE static pointer vector_elem(pointer vec, int ielem) { + int n=ielem/2; + if(ielem%2==0) { + return car(vec+1+n); + } else { + return cdr(vec+1+n); + } +} + +INTERFACE static pointer set_vector_elem(pointer vec, int ielem, pointer a) { + int n=ielem/2; + if(ielem%2==0) { + return car(vec+1+n)=a; + } else { + return cdr(vec+1+n)=a; + } +} + +/* get new symbol */ +INTERFACE pointer mk_symbol(scheme *sc, const char *name) { + pointer x; + + /* first check oblist */ + x = oblist_find_by_name(sc, name); + if (x != sc->NIL) { + return (x); + } else { + x = oblist_add_by_name(sc, name); + return (x); + } +} + +INTERFACE pointer gensym(scheme *sc) { + pointer x; + char name[40]; + + for(; sc->gensym_cntgensym_cnt++) { + snprintf(name,40,"gensym-%ld",sc->gensym_cnt); + + /* first check oblist */ + x = oblist_find_by_name(sc, name); + + if (x != sc->NIL) { + continue; + } else { + x = oblist_add_by_name(sc, name); + return (x); + } + } + + return sc->NIL; +} + +/* double the size of the string buffer */ +static int expand_strbuff(scheme *sc) { + size_t new_size = sc->strbuff_size * 2; + char *new_buffer = sc->malloc(new_size); + if (new_buffer == 0) { + sc->no_memory = 1; + return 1; + } + memcpy(new_buffer, sc->strbuff, sc->strbuff_size); + sc->free(sc->strbuff); + sc->strbuff = new_buffer; + sc->strbuff_size = new_size; + return 0; +} + +/* make symbol or number atom from string */ +static pointer mk_atom(scheme *sc, char *q) { + char c, *p; + int has_dec_point=0; + int has_fp_exp = 0; + +#if USE_COLON_HOOK + if((p=strstr(q,"::"))!=0) { + *p=0; + return cons(sc, sc->COLON_HOOK, + cons(sc, + cons(sc, + sc->QUOTE, + cons(sc, mk_atom(sc,p+2), sc->NIL)), + cons(sc, mk_symbol(sc,strlwr(q)), sc->NIL))); + } +#endif + + p = q; + c = *p++; + if ((c == '+') || (c == '-')) { + c = *p++; + if (c == '.') { + has_dec_point=1; + c = *p++; + } + if (!isdigit(c)) { + return (mk_symbol(sc, strlwr(q))); + } + } else if (c == '.') { + has_dec_point=1; + c = *p++; + if (!isdigit(c)) { + return (mk_symbol(sc, strlwr(q))); + } + } else if (!isdigit(c)) { + return (mk_symbol(sc, strlwr(q))); + } + + for ( ; (c = *p) != 0; ++p) { + if (!isdigit(c)) { + if(c=='.') { + if(!has_dec_point) { + has_dec_point=1; + continue; + } + } + else if ((c == 'e') || (c == 'E')) { + if(!has_fp_exp) { + has_dec_point = 1; /* decimal point illegal + from now on */ + p++; + if ((*p == '-') || (*p == '+') || isdigit(*p)) { + continue; + } + } + } + return (mk_symbol(sc, strlwr(q))); + } + } + if(has_dec_point) { + return mk_real(sc,atof(q)); + } + return (mk_integer(sc, atol(q))); +} + +/* make constant */ +static pointer mk_sharp_const(scheme *sc, char *name) { + long x; + char tmp[STRBUFFSIZE]; + + if (!strcmp(name, "t")) + return (sc->T); + else if (!strcmp(name, "f")) + return (sc->F); + else if (*name == 'o') {/* #o (octal) */ + snprintf(tmp, STRBUFFSIZE, "0%s", name+1); + sscanf(tmp, "%lo", (long unsigned *)&x); + return (mk_integer(sc, x)); + } else if (*name == 'd') { /* #d (decimal) */ + sscanf(name+1, "%ld", (long int *)&x); + return (mk_integer(sc, x)); + } else if (*name == 'x') { /* #x (hex) */ + snprintf(tmp, STRBUFFSIZE, "0x%s", name+1); + sscanf(tmp, "%lx", (long unsigned *)&x); + return (mk_integer(sc, x)); + } else if (*name == 'b') { /* #b (binary) */ + x = binary_decode(name+1); + return (mk_integer(sc, x)); + } else if (*name == '\\') { /* #\w (character) */ + int c=0; + if(stricmp(name+1,"space")==0) { + c=' '; + } else if(stricmp(name+1,"newline")==0) { + c='\n'; + } else if(stricmp(name+1,"return")==0) { + c='\r'; + } else if(stricmp(name+1,"tab")==0) { + c='\t'; + } else if(name[1]=='x' && name[2]!=0) { + int c1=0; + if(sscanf(name+2,"%x",(unsigned int *)&c1)==1 && c1 < UCHAR_MAX) { + c=c1; + } else { + return sc->NIL; + } +#if USE_ASCII_NAMES + } else if(is_ascii_name(name+1,&c)) { + /* nothing */ +#endif + } else if(name[2]==0) { + c=name[1]; + } else { + return sc->NIL; + } + return mk_character(sc,c); + } else + return (sc->NIL); +} + +/* ========== garbage collector ========== */ + +/*-- + * We use algorithm E (Knuth, The Art of Computer Programming Vol.1, + * sec. 2.3.5), the Schorr-Deutsch-Waite link-inversion algorithm, + * for marking. + */ +static void mark(pointer a) { + pointer t, q, p; + + t = (pointer) 0; + p = a; +E2: setmark(p); + if(is_vector(p)) { + int i; + int n = ivalue_unchecked(p)/2+ivalue_unchecked(p)%2; + for(i=0; i < n; i++) { + /* Vector cells will be treated like ordinary cells */ + mark(p+1+i); + } + } + if (is_atom(p)) + goto E6; + /* E4: down car */ + q = car(p); + if (q && !is_mark(q)) { + setatom(p); /* a note that we have moved car */ + car(p) = t; + t = p; + p = q; + goto E2; + } +E5: q = cdr(p); /* down cdr */ + if (q && !is_mark(q)) { + cdr(p) = t; + t = p; + p = q; + goto E2; + } +E6: /* up. Undo the link switching from steps E4 and E5. */ + if (!t) + return; + q = t; + if (is_atom(q)) { + clratom(q); + t = car(q); + car(q) = p; + p = q; + goto E5; + } else { + t = cdr(q); + cdr(q) = p; + p = q; + goto E6; + } +} + +/* garbage collection. parameter a, b is marked. */ +static void gc(scheme *sc, pointer a, pointer b) { + pointer p; + int i; + + if(sc->gc_verbose) { + putstr(sc, "gc..."); + } + + /* mark system globals */ + mark(sc->oblist); + mark(sc->global_env); + + /* mark current registers */ + mark(sc->args); + mark(sc->envir); + mark(sc->code); + dump_stack_mark(sc); + mark(sc->value); + mark(sc->inport); + mark(sc->save_inport); + mark(sc->outport); + mark(sc->loadport); + + /* Mark recent objects the interpreter doesn't know about yet. */ + mark(car(sc->sink)); + /* Mark any older stuff above nested C calls */ + mark(sc->c_nest); + + /* mark variables a, b */ + mark(a); + mark(b); + + /* garbage collect */ + clrmark(sc->NIL); + sc->fcells = 0; + sc->free_cell = sc->NIL; + /* free-list is kept sorted by address so as to maintain consecutive + ranges, if possible, for use with vectors. Here we scan the cells + (which are also kept sorted by address) downwards to build the + free-list in sorted order. + */ + for (i = sc->last_cell_seg; i >= 0; i--) { + p = sc->cell_seg[i] + CELL_SEGSIZE; + while (--p >= sc->cell_seg[i]) { + if (is_mark(p)) { + clrmark(p); + } else { + /* reclaim cell */ + if (typeflag(p) != 0) { + finalize_cell(sc, p); + typeflag(p) = 0; + car(p) = sc->NIL; + } + ++sc->fcells; + cdr(p) = sc->free_cell; + sc->free_cell = p; + } + } + } + + if (sc->gc_verbose) { + char msg[80]; + snprintf(msg,80,"done: %ld cells were recovered.\n", sc->fcells); + putstr(sc,msg); + } +} + +static void finalize_cell(scheme *sc, pointer a) { + if(is_string(a)) { + sc->free(strvalue(a)); + } else if(is_port(a)) { + if(a->_object._port->kind&port_file + && a->_object._port->rep.stdio.closeit) { + port_close(sc,a,port_input|port_output); + } else if (a->_object._port->kind & port_srfi6) { + sc->free(a->_object._port->rep.string.start); + } + sc->free(a->_object._port); + } else if(is_foreign_object(a)) { + a->_object._foreign_object._vtable->finalize(sc, a->_object._foreign_object._data); + } +} + +/* ========== Routines for Reading ========== */ + +static int file_push(scheme *sc, const char *fname) { + FILE *fin = NULL; + + if (sc->file_i == MAXFIL-1) + return 0; + fin=fopen(fname,"r"); + if(fin!=0) { + sc->file_i++; + sc->load_stack[sc->file_i].kind=port_file|port_input; + sc->load_stack[sc->file_i].rep.stdio.file=fin; + sc->load_stack[sc->file_i].rep.stdio.closeit=1; + sc->nesting_stack[sc->file_i]=0; + sc->loadport->_object._port=sc->load_stack+sc->file_i; + +#if SHOW_ERROR_LINE + sc->load_stack[sc->file_i].rep.stdio.curr_line = 0; + if(fname) + sc->load_stack[sc->file_i].rep.stdio.filename = store_string(sc, strlen(fname), fname, 0); +#endif + } + return fin!=0; +} + +static void file_pop(scheme *sc) { + if(sc->file_i != 0) { + sc->nesting=sc->nesting_stack[sc->file_i]; + port_close(sc,sc->loadport,port_input); + sc->file_i--; + sc->loadport->_object._port=sc->load_stack+sc->file_i; + } +} + +static int file_interactive(scheme *sc) { + return sc->file_i==0 && sc->load_stack[0].rep.stdio.file==stdin + && sc->inport->_object._port->kind&port_file; +} + +static port *port_rep_from_filename(scheme *sc, const char *fn, int prop) { + FILE *f; + char *rw; + port *pt; + if(prop==(port_input|port_output)) { + rw="a+"; + } else if(prop==port_output) { + rw="w"; + } else { + rw="r"; + } + f=fopen(fn,rw); + if(f==0) { + return 0; + } + pt=port_rep_from_file(sc,f,prop); + pt->rep.stdio.closeit=1; + +#if SHOW_ERROR_LINE + if(fn) + pt->rep.stdio.filename = store_string(sc, strlen(fn), fn, 0); + + pt->rep.stdio.curr_line = 0; +#endif + return pt; +} + +static pointer port_from_filename(scheme *sc, const char *fn, int prop) { + port *pt; + pt=port_rep_from_filename(sc,fn,prop); + if(pt==0) { + return sc->NIL; + } + return mk_port(sc,pt); +} + +static port *port_rep_from_file(scheme *sc, FILE *f, int prop) +{ + port *pt; + + pt = (port *)sc->malloc(sizeof *pt); + if (pt == NULL) { + return NULL; + } + pt->kind = port_file | prop; + pt->rep.stdio.file = f; + pt->rep.stdio.closeit = 0; + return pt; +} + +static pointer port_from_file(scheme *sc, FILE *f, int prop) { + port *pt; + pt=port_rep_from_file(sc,f,prop); + if(pt==0) { + return sc->NIL; + } + return mk_port(sc,pt); +} + +static port *port_rep_from_string(scheme *sc, char *start, char *past_the_end, int prop) { + port *pt; + pt=(port*)sc->malloc(sizeof(port)); + if(pt==0) { + return 0; + } + pt->kind=port_string|prop; + pt->rep.string.start=start; + pt->rep.string.curr=start; + pt->rep.string.past_the_end=past_the_end; + return pt; +} + +static pointer port_from_string(scheme *sc, char *start, char *past_the_end, int prop) { + port *pt; + pt=port_rep_from_string(sc,start,past_the_end,prop); + if(pt==0) { + return sc->NIL; + } + return mk_port(sc,pt); +} + +#define BLOCK_SIZE 256 + +static port *port_rep_from_scratch(scheme *sc) { + port *pt; + char *start; + pt=(port*)sc->malloc(sizeof(port)); + if(pt==0) { + return 0; + } + start=sc->malloc(BLOCK_SIZE); + if(start==0) { + return 0; + } + memset(start,' ',BLOCK_SIZE-1); + start[BLOCK_SIZE-1]='\0'; + pt->kind=port_string|port_output|port_srfi6; + pt->rep.string.start=start; + pt->rep.string.curr=start; + pt->rep.string.past_the_end=start+BLOCK_SIZE-1; + return pt; +} + +static pointer port_from_scratch(scheme *sc) { + port *pt; + pt=port_rep_from_scratch(sc); + if(pt==0) { + return sc->NIL; + } + return mk_port(sc,pt); +} + +static void port_close(scheme *sc, pointer p, int flag) { + port *pt=p->_object._port; + pt->kind&=~flag; + if((pt->kind & (port_input|port_output))==0) { + if(pt->kind&port_file) { + +#if SHOW_ERROR_LINE + /* Cleanup is here so (close-*-port) functions could work too */ + pt->rep.stdio.curr_line = 0; + + if(pt->rep.stdio.filename) + sc->free(pt->rep.stdio.filename); +#endif + + fclose(pt->rep.stdio.file); + } + pt->kind=port_free; + } +} + +/* get new character from input file */ +static int inchar(scheme *sc) { + int c; + port *pt; + + pt = sc->inport->_object._port; + if(pt->kind & port_saw_EOF) + { return EOF; } + c = basic_inchar(pt); + if(c == EOF && sc->inport == sc->loadport) { + /* Instead, set port_saw_EOF */ + pt->kind |= port_saw_EOF; + + /* file_pop(sc); */ + return EOF; + /* NOTREACHED */ + } + return c; +} + +static int basic_inchar(port *pt) { + if(pt->kind & port_file) { + return fgetc(pt->rep.stdio.file); + } else { + if(*pt->rep.string.curr == 0 || + pt->rep.string.curr == pt->rep.string.past_the_end) { + return EOF; + } else { + return *pt->rep.string.curr++; + } + } +} + +/* back character to input buffer */ +static void backchar(scheme *sc, int c) { + port *pt; + if(c==EOF) return; + pt=sc->inport->_object._port; + if(pt->kind&port_file) { + ungetc(c,pt->rep.stdio.file); + } else { + if(pt->rep.string.curr!=pt->rep.string.start) { + --pt->rep.string.curr; + } + } +} + +static int realloc_port_string(scheme *sc, port *p) +{ + char *start=p->rep.string.start; + size_t old_size = p->rep.string.past_the_end - start; + size_t new_size=p->rep.string.past_the_end-start+1+BLOCK_SIZE; + char *str=sc->malloc(new_size); + if(str) { + memset(str,' ',new_size-1); + str[new_size-1]='\0'; + memcpy(str, start, old_size); + p->rep.string.start=str; + p->rep.string.past_the_end=str+new_size-1; + p->rep.string.curr-=start-str; + sc->free(start); + return 1; + } else { + return 0; + } +} + +INTERFACE void putstr(scheme *sc, const char *s) { + port *pt=sc->outport->_object._port; + if(pt->kind&port_file) { + fputs(s,pt->rep.stdio.file); + } else { + for(;*s;s++) { + if(pt->rep.string.curr!=pt->rep.string.past_the_end) { + *pt->rep.string.curr++=*s; + } else if(pt->kind&port_srfi6&&realloc_port_string(sc,pt)) { + *pt->rep.string.curr++=*s; + } + } + } +} + +static void putchars(scheme *sc, const char *s, int len) { + port *pt=sc->outport->_object._port; + if(pt->kind&port_file) { + fwrite(s,1,len,pt->rep.stdio.file); + } else { + for(;len;len--) { + if(pt->rep.string.curr!=pt->rep.string.past_the_end) { + *pt->rep.string.curr++=*s++; + } else if(pt->kind&port_srfi6&&realloc_port_string(sc,pt)) { + *pt->rep.string.curr++=*s++; + } + } + } +} + +INTERFACE void putcharacter(scheme *sc, int c) { + port *pt=sc->outport->_object._port; + if(pt->kind&port_file) { + fputc(c,pt->rep.stdio.file); + } else { + if(pt->rep.string.curr!=pt->rep.string.past_the_end) { + *pt->rep.string.curr++=c; + } else if(pt->kind&port_srfi6&&realloc_port_string(sc,pt)) { + *pt->rep.string.curr++=c; + } + } +} + +/* read characters up to delimiter, but cater to character constants */ +static char *readstr_upto(scheme *sc, char *delim) { + char *p = sc->strbuff; + + while ((p - sc->strbuff < sc->strbuff_size) && + !is_one_of(delim, (*p++ = inchar(sc)))); + + if(p == sc->strbuff+2 && p[-2] == '\\') { + *p=0; + } else { + backchar(sc,p[-1]); + *--p = '\0'; + } + return sc->strbuff; +} + +/* read string expression "xxx...xxx" */ +static pointer readstrexp(scheme *sc) { + char *p = sc->strbuff; + int c; + int c1=0; + enum { st_ok, st_bsl, st_x1, st_x2, st_oct1, st_oct2 } state=st_ok; + + for (;;) { + c=inchar(sc); + if(c == EOF) { + return sc->F; + } + if(p-sc->strbuff > (sc->strbuff_size)-1) { + ptrdiff_t offset = p - sc->strbuff; + if (expand_strbuff(sc) != 0) { + return sc->F; + } + p = sc->strbuff + offset; + } + switch(state) { + case st_ok: + switch(c) { + case '\\': + state=st_bsl; + break; + case '"': + *p=0; + return mk_counted_string(sc,sc->strbuff,p-sc->strbuff); + default: + *p++=c; + break; + } + break; + case st_bsl: + switch(c) { + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + state=st_oct1; + c1=c-'0'; + break; + case 'x': + case 'X': + state=st_x1; + c1=0; + break; + case 'n': + *p++='\n'; + state=st_ok; + break; + case 't': + *p++='\t'; + state=st_ok; + break; + case 'r': + *p++='\r'; + state=st_ok; + break; + case '"': + *p++='"'; + state=st_ok; + break; + default: + *p++=c; + state=st_ok; + break; + } + break; + case st_x1: + case st_x2: + c=toupper(c); + if(c>='0' && c<='F') { + if(c<='9') { + c1=(c1<<4)+c-'0'; + } else { + c1=(c1<<4)+c-'A'+10; + } + if(state==st_x1) { + state=st_x2; + } else { + *p++=c1; + state=st_ok; + } + } else { + return sc->F; + } + break; + case st_oct1: + case st_oct2: + if (c < '0' || c > '7') + { + *p++=c1; + backchar(sc, c); + state=st_ok; + } + else + { + if (state==st_oct2 && c1 >= 32) + return sc->F; + + c1=(c1<<3)+(c-'0'); + + if (state == st_oct1) + state=st_oct2; + else + { + *p++=c1; + state=st_ok; + } + } + break; + + } + } +} + +/* check c is in chars */ +static INLINE int is_one_of(char *s, int c) { + if(c==EOF) return 1; + while (*s) + if (*s++ == c) + return (1); + return (0); +} + +/* skip white characters */ +static INLINE int skipspace(scheme *sc) { + int c = 0, curr_line = 0; + + do { + c=inchar(sc); +#if SHOW_ERROR_LINE + if(c=='\n') + curr_line++; +#endif + } while (isspace(c)); + +/* record it */ +#if SHOW_ERROR_LINE + if (sc->load_stack[sc->file_i].kind & port_file) + sc->load_stack[sc->file_i].rep.stdio.curr_line += curr_line; +#endif + + if(c!=EOF) { + backchar(sc,c); + return 1; + } + else + { return EOF; } +} + +/* get token */ +static int token(scheme *sc) { + int c; + c = skipspace(sc); + if(c == EOF) { return (TOK_EOF); } + switch (c=inchar(sc)) { + case EOF: + return (TOK_EOF); + case '(': + return (TOK_LPAREN); + case ')': + return (TOK_RPAREN); + case '.': + c=inchar(sc); + if(is_one_of(" \n\t",c)) { + return (TOK_DOT); + } else { + backchar(sc,c); + backchar(sc,'.'); + return TOK_ATOM; + } + case '\'': + return (TOK_QUOTE); + case ';': + while ((c=inchar(sc)) != '\n' && c!=EOF) + ; + +#if SHOW_ERROR_LINE + if(c == '\n' && sc->load_stack[sc->file_i].kind & port_file) + sc->load_stack[sc->file_i].rep.stdio.curr_line++; +#endif + + if(c == EOF) + { return (TOK_EOF); } + else + { return (token(sc));} + case '"': + return (TOK_DQUOTE); + case BACKQUOTE: + return (TOK_BQUOTE); + case ',': + if ((c=inchar(sc)) == '@') { + return (TOK_ATMARK); + } else { + backchar(sc,c); + return (TOK_COMMA); + } + case '#': + c=inchar(sc); + if (c == '(') { + return (TOK_VEC); + } else if(c == '!') { + while ((c=inchar(sc)) != '\n' && c!=EOF) + ; + +#if SHOW_ERROR_LINE + if(c == '\n' && sc->load_stack[sc->file_i].kind & port_file) + sc->load_stack[sc->file_i].rep.stdio.curr_line++; +#endif + + if(c == EOF) + { return (TOK_EOF); } + else + { return (token(sc));} + } else { + backchar(sc,c); + if(is_one_of(" tfodxb\\",c)) { + return TOK_SHARP_CONST; + } else { + return (TOK_SHARP); + } + } + default: + backchar(sc,c); + return (TOK_ATOM); + } +} + +/* ========== Routines for Printing ========== */ +#define ok_abbrev(x) (is_pair(x) && cdr(x) == sc->NIL) + +static void printslashstring(scheme *sc, char *p, int len) { + int i; + unsigned char *s=(unsigned char*)p; + putcharacter(sc,'"'); + for ( i=0; iNIL) { + p = "()"; + } else if (l == sc->T) { + p = "#t"; + } else if (l == sc->F) { + p = "#f"; + } else if (l == sc->EOF_OBJ) { + p = "#"; + } else if (is_port(l)) { + p = "#"; + } else if (is_number(l)) { + p = sc->strbuff; + if (f <= 1 || f == 10) /* f is the base for numbers if > 1 */ { + if(num_is_integer(l)) { + snprintf(p, STRBUFFSIZE, "%ld", ivalue_unchecked(l)); + } else { + snprintf(p, STRBUFFSIZE, "%.10g", rvalue_unchecked(l)); + /* r5rs says there must be a '.' (unless 'e'?) */ + f = strcspn(p, ".e"); + if (p[f] == 0) { + p[f] = '.'; /* not found, so add '.0' at the end */ + p[f+1] = '0'; + p[f+2] = 0; + } + } + } else { + long v = ivalue(l); + if (f == 16) { + if (v >= 0) + snprintf(p, STRBUFFSIZE, "%lx", v); + else + snprintf(p, STRBUFFSIZE, "-%lx", -v); + } else if (f == 8) { + if (v >= 0) + snprintf(p, STRBUFFSIZE, "%lo", v); + else + snprintf(p, STRBUFFSIZE, "-%lo", -v); + } else if (f == 2) { + unsigned long b = (v < 0) ? -v : v; + p = &p[STRBUFFSIZE-1]; + *p = 0; + do { *--p = (b&1) ? '1' : '0'; b >>= 1; } while (b != 0); + if (v < 0) *--p = '-'; + } + } + } else if (is_string(l)) { + if (!f) { + p = strvalue(l); + } else { /* Hack, uses the fact that printing is needed */ + *pp=sc->strbuff; + *plen=0; + printslashstring(sc, strvalue(l), strlength(l)); + return; + } + } else if (is_character(l)) { + int c=charvalue(l); + p = sc->strbuff; + if (!f) { + p[0]=c; + p[1]=0; + } else { + switch(c) { + case ' ': + p = "#\\space"; + break; + case '\n': + p = "#\\newline"; + break; + case '\r': + p = "#\\return"; + break; + case '\t': + p = "#\\tab"; + break; + default: +#if USE_ASCII_NAMES + if(c==127) { + p = "#\\del"; + break; + } else if(c<32) { + snprintf(p,STRBUFFSIZE, "#\\%s",charnames[c]); + break; + } +#else + if(c<32) { + snprintf(p,STRBUFFSIZE,"#\\x%x",c); + break; + } +#endif + snprintf(p,STRBUFFSIZE,"#\\%c",c); + break; + } + } + } else if (is_symbol(l)) { + p = symname(l); + } else if (is_proc(l)) { + p = sc->strbuff; + snprintf(p,STRBUFFSIZE,"#<%s PROCEDURE %ld>", procname(l),procnum(l)); + } else if (is_macro(l)) { + p = "#"; + } else if (is_closure(l)) { + p = "#"; + } else if (is_promise(l)) { + p = "#"; + } else if (is_foreign(l)) { + p = sc->strbuff; + snprintf(p,STRBUFFSIZE,"#", procnum(l)); + } else if (is_continuation(l)) { + p = "#"; + } else if (is_foreign_object(l)) { + p = sc->strbuff; + l->_object._foreign_object._vtable->to_string(sc, p, STRBUFFSIZE, l->_object._foreign_object._data); + } else { + p = "#"; + } + *pp=p; + *plen=strlen(p); +} +/* ========== Routines for Evaluation Cycle ========== */ + +/* make closure. c is code. e is environment */ +static pointer mk_closure(scheme *sc, pointer c, pointer e) { + pointer x = get_cell(sc, c, e); + + typeflag(x) = T_CLOSURE; + car(x) = c; + cdr(x) = e; + return (x); +} + +/* make continuation. */ +static pointer mk_continuation(scheme *sc, pointer d) { + pointer x = get_cell(sc, sc->NIL, d); + + typeflag(x) = T_CONTINUATION; + cont_dump(x) = d; + return (x); +} + +static pointer list_star(scheme *sc, pointer d) { + pointer p, q; + if(cdr(d)==sc->NIL) { + return car(d); + } + p=cons(sc,car(d),cdr(d)); + q=p; + while(cdr(cdr(p))!=sc->NIL) { + d=cons(sc,car(p),cdr(p)); + if(cdr(cdr(p))!=sc->NIL) { + p=cdr(d); + } + } + cdr(p)=car(cdr(p)); + return q; +} + +/* reverse list -- produce new list */ +static pointer reverse(scheme *sc, pointer a) { +/* a must be checked by gc */ + pointer p = sc->NIL; + + for ( ; is_pair(a); a = cdr(a)) { + p = cons(sc, car(a), p); + } + return (p); +} + +/* reverse list --- in-place */ +static pointer reverse_in_place(scheme *sc, pointer term, pointer list) { + pointer p = list, result = term, q; + + while (p != sc->NIL) { + q = cdr(p); + cdr(p) = result; + result = p; + p = q; + } + return (result); +} + +/* append list -- produce new list (in reverse order) */ +static pointer revappend(scheme *sc, pointer a, pointer b) { + pointer result = a; + pointer p = b; + + while (is_pair(p)) { + result = cons(sc, car(p), result); + p = cdr(p); + } + + if (p == sc->NIL) { + return result; + } + + return sc->F; /* signal an error */ +} + +/* equivalence of atoms */ +int eqv(pointer a, pointer b) { + if (is_string(a)) { + if (is_string(b)) + return (strvalue(a) == strvalue(b)); + else + return (0); + } else if (is_number(a)) { + if (is_number(b)) { + if (num_is_integer(a) == num_is_integer(b)) + return num_eq(nvalue(a),nvalue(b)); + } + return (0); + } else if (is_character(a)) { + if (is_character(b)) + return charvalue(a)==charvalue(b); + else + return (0); + } else if (is_port(a)) { + if (is_port(b)) + return a==b; + else + return (0); + } else if (is_proc(a)) { + if (is_proc(b)) + return procnum(a)==procnum(b); + else + return (0); + } else { + return (a == b); + } +} + +/* true or false value macro */ +/* () is #t in R5RS */ +#define is_true(p) ((p) != sc->F) +#define is_false(p) ((p) == sc->F) + +/* ========== Environment implementation ========== */ + +#if !defined(USE_ALIST_ENV) || !defined(USE_OBJECT_LIST) + +static int hash_fn(const char *key, int table_size) +{ + unsigned int hashed = 0; + const char *c; + int bits_per_int = sizeof(unsigned int)*8; + + for (c = key; *c; c++) { + /* letters have about 5 bits in them */ + hashed = (hashed<<5) | (hashed>>(bits_per_int-5)); + hashed ^= *c; + } + return hashed % table_size; +} +#endif + +#ifndef USE_ALIST_ENV + +/* + * In this implementation, each frame of the environment may be + * a hash table: a vector of alists hashed by variable name. + * In practice, we use a vector only for the initial frame; + * subsequent frames are too small and transient for the lookup + * speed to out-weigh the cost of making a new vector. + */ + +static void new_frame_in_env(scheme *sc, pointer old_env) +{ + pointer new_frame; + + /* The interaction-environment has about 300 variables in it. */ + if (old_env == sc->NIL) { + new_frame = mk_vector(sc, 461); + } else { + new_frame = sc->NIL; + } + + sc->envir = immutable_cons(sc, new_frame, old_env); + setenvironment(sc->envir); +} + +static INLINE void new_slot_spec_in_env(scheme *sc, pointer env, + pointer variable, pointer value) +{ + pointer slot = immutable_cons(sc, variable, value); + + if (is_vector(car(env))) { + int location = hash_fn(symname(variable), ivalue_unchecked(car(env))); + + set_vector_elem(car(env), location, + immutable_cons(sc, slot, vector_elem(car(env), location))); + } else { + car(env) = immutable_cons(sc, slot, car(env)); + } +} + +static pointer find_slot_in_env(scheme *sc, pointer env, pointer hdl, int all) +{ + pointer x,y; + int location; + + for (x = env; x != sc->NIL; x = cdr(x)) { + if (is_vector(car(x))) { + location = hash_fn(symname(hdl), ivalue_unchecked(car(x))); + y = vector_elem(car(x), location); + } else { + y = car(x); + } + for ( ; y != sc->NIL; y = cdr(y)) { + if (caar(y) == hdl) { + break; + } + } + if (y != sc->NIL) { + break; + } + if(!all) { + return sc->NIL; + } + } + if (x != sc->NIL) { + return car(y); + } + return sc->NIL; +} + +#else /* USE_ALIST_ENV */ + +static INLINE void new_frame_in_env(scheme *sc, pointer old_env) +{ + sc->envir = immutable_cons(sc, sc->NIL, old_env); + setenvironment(sc->envir); +} + +static INLINE void new_slot_spec_in_env(scheme *sc, pointer env, + pointer variable, pointer value) +{ + car(env) = immutable_cons(sc, immutable_cons(sc, variable, value), car(env)); +} + +static pointer find_slot_in_env(scheme *sc, pointer env, pointer hdl, int all) +{ + pointer x,y; + for (x = env; x != sc->NIL; x = cdr(x)) { + for (y = car(x); y != sc->NIL; y = cdr(y)) { + if (caar(y) == hdl) { + break; + } + } + if (y != sc->NIL) { + break; + } + if(!all) { + return sc->NIL; + } + } + if (x != sc->NIL) { + return car(y); + } + return sc->NIL; +} + +#endif /* USE_ALIST_ENV else */ + +static INLINE void new_slot_in_env(scheme *sc, pointer variable, pointer value) +{ + new_slot_spec_in_env(sc, sc->envir, variable, value); +} + +static INLINE void set_slot_in_env(scheme *sc, pointer slot, pointer value) +{ + (void)sc; + cdr(slot) = value; +} + +static INLINE pointer slot_value_in_env(pointer slot) +{ + return cdr(slot); +} + +/* ========== Evaluation Cycle ========== */ + + +static pointer _Error_1(scheme *sc, const char *s, pointer a) { + const char *str = s; +#if USE_ERROR_HOOK + pointer x; + pointer hdl=sc->ERROR_HOOK; +#endif + +#if SHOW_ERROR_LINE + char sbuf[STRBUFFSIZE]; + + /* make sure error is not in REPL */ + if (sc->load_stack[sc->file_i].kind & port_file && + sc->load_stack[sc->file_i].rep.stdio.file != stdin) { + int ln = sc->load_stack[sc->file_i].rep.stdio.curr_line; + const char *fname = sc->load_stack[sc->file_i].rep.stdio.filename; + + /* should never happen */ + if(!fname) fname = ""; + + /* we started from 0 */ + ln++; + snprintf(sbuf, STRBUFFSIZE, "(%s : %i) %s", fname, ln, s); + + str = (const char*)sbuf; + } +#endif + +#if USE_ERROR_HOOK + x=find_slot_in_env(sc,sc->envir,hdl,1); + if (x != sc->NIL) { + if(a!=0) { + sc->code = cons(sc, cons(sc, sc->QUOTE, cons(sc,(a), sc->NIL)), sc->NIL); + } else { + sc->code = sc->NIL; + } + sc->code = cons(sc, mk_string(sc, str), sc->code); + setimmutable(car(sc->code)); + sc->code = cons(sc, slot_value_in_env(x), sc->code); + sc->op = (int)OP_EVAL; + return sc->T; + } +#endif + + if(a!=0) { + sc->args = cons(sc, (a), sc->NIL); + } else { + sc->args = sc->NIL; + } + sc->args = cons(sc, mk_string(sc, str), sc->args); + setimmutable(car(sc->args)); + sc->op = (int)OP_ERR0; + return sc->T; +} +#define Error_1(sc,s, a) return _Error_1(sc,s,a) +#define Error_0(sc,s) return _Error_1(sc,s,0) + +/* Too small to turn into function */ +# define BEGIN do { +# define END } while (0) +#define s_goto(sc,a) BEGIN \ + sc->op = (int)(a); \ + return sc->T; END + +#define s_return(sc,a) return _s_return(sc,a) + +#ifndef USE_SCHEME_STACK + +/* this structure holds all the interpreter's registers */ +struct dump_stack_frame { + enum scheme_opcodes op; + pointer args; + pointer envir; + pointer code; +}; + +#define STACK_GROWTH 3 + +static void s_save(scheme *sc, enum scheme_opcodes op, pointer args, pointer code) +{ + int nframes = (int)sc->dump; + struct dump_stack_frame *next_frame; + + /* enough room for the next frame? */ + if (nframes >= sc->dump_size) { + sc->dump_size += STACK_GROWTH; + /* alas there is no sc->realloc */ + sc->dump_base = realloc(sc->dump_base, + sizeof(struct dump_stack_frame) * sc->dump_size); + } + next_frame = (struct dump_stack_frame *)sc->dump_base + nframes; + next_frame->op = op; + next_frame->args = args; + next_frame->envir = sc->envir; + next_frame->code = code; + sc->dump = (pointer)(nframes+1); +} + +static pointer _s_return(scheme *sc, pointer a) +{ + int nframes = (int)sc->dump; + struct dump_stack_frame *frame; + + sc->value = (a); + if (nframes <= 0) { + return sc->NIL; + } + nframes--; + frame = (struct dump_stack_frame *)sc->dump_base + nframes; + sc->op = frame->op; + sc->args = frame->args; + sc->envir = frame->envir; + sc->code = frame->code; + sc->dump = (pointer)nframes; + return sc->T; +} + +static INLINE void dump_stack_reset(scheme *sc) +{ + /* in this implementation, sc->dump is the number of frames on the stack */ + sc->dump = (pointer)0; +} + +static INLINE void dump_stack_initialize(scheme *sc) +{ + sc->dump_size = 0; + sc->dump_base = NULL; + dump_stack_reset(sc); +} + +static void dump_stack_free(scheme *sc) +{ + free(sc->dump_base); + sc->dump_base = NULL; + sc->dump = (pointer)0; + sc->dump_size = 0; +} + +static INLINE void dump_stack_mark(scheme *sc) +{ + int nframes = (int)sc->dump; + int i; + for(i=0; idump_base + i; + mark(frame->args); + mark(frame->envir); + mark(frame->code); + } +} + +#else + +static INLINE void dump_stack_reset(scheme *sc) +{ + sc->dump = sc->NIL; +} + +static INLINE void dump_stack_initialize(scheme *sc) +{ + dump_stack_reset(sc); +} + +static void dump_stack_free(scheme *sc) +{ + sc->dump = sc->NIL; +} + +static pointer _s_return(scheme *sc, pointer a) { + sc->value = (a); + if(sc->dump==sc->NIL) return sc->NIL; + sc->op = ivalue(car(sc->dump)); + sc->args = cadr(sc->dump); + sc->envir = caddr(sc->dump); + sc->code = cadddr(sc->dump); + sc->dump = cddddr(sc->dump); + return sc->T; +} + +static void s_save(scheme *sc, enum scheme_opcodes op, pointer args, pointer code) { + sc->dump = cons(sc, sc->envir, cons(sc, (code), sc->dump)); + sc->dump = cons(sc, (args), sc->dump); + sc->dump = cons(sc, mk_integer(sc, (long)(op)), sc->dump); +} + +static INLINE void dump_stack_mark(scheme *sc) +{ + mark(sc->dump); +} +#endif + +#define s_retbool(tf) s_return(sc,(tf) ? sc->T : sc->F) + +static pointer opexe_0(scheme *sc, enum scheme_opcodes op) { + pointer x, y; + + switch (op) { + case OP_LOAD: /* load */ + if(file_interactive(sc)) { + fprintf(sc->outport->_object._port->rep.stdio.file, + "Loading %s\n", strvalue(car(sc->args))); + } + if (!file_push(sc,strvalue(car(sc->args)))) { + Error_1(sc,"unable to open", car(sc->args)); + } + else + { + sc->args = mk_integer(sc,sc->file_i); + s_goto(sc,OP_T0LVL); + } + + case OP_T0LVL: /* top level */ + /* If we reached the end of file, this loop is done. */ + if(sc->loadport->_object._port->kind & port_saw_EOF) + { + if(sc->file_i == 0) + { + sc->args=sc->NIL; + s_goto(sc,OP_QUIT); + } + else + { + file_pop(sc); + s_return(sc,sc->value); + } + /* NOTREACHED */ + } + + /* If interactive, be nice to user. */ + if(file_interactive(sc)) + { + sc->envir = sc->global_env; + dump_stack_reset(sc); + putstr(sc,"\n"); + putstr(sc,prompt); + } + + /* Set up another iteration of REPL */ + sc->nesting=0; + sc->save_inport=sc->inport; + sc->inport = sc->loadport; + s_save(sc,OP_T0LVL, sc->NIL, sc->NIL); + s_save(sc,OP_VALUEPRINT, sc->NIL, sc->NIL); + s_save(sc,OP_T1LVL, sc->NIL, sc->NIL); + s_goto(sc,OP_READ_INTERNAL); + + case OP_T1LVL: /* top level */ + sc->code = sc->value; + sc->inport=sc->save_inport; + s_goto(sc,OP_EVAL); + + case OP_READ_INTERNAL: /* internal read */ + sc->tok = token(sc); + if(sc->tok==TOK_EOF) + { s_return(sc,sc->EOF_OBJ); } + s_goto(sc,OP_RDSEXPR); + + case OP_GENSYM: + s_return(sc, gensym(sc)); + + case OP_VALUEPRINT: /* print evaluation result */ + /* OP_VALUEPRINT is always pushed, because when changing from + non-interactive to interactive mode, it needs to be + already on the stack */ + if(sc->tracing) { + putstr(sc,"\nGives: "); + } + if(file_interactive(sc)) { + sc->print_flag = 1; + sc->args = sc->value; + s_goto(sc,OP_P0LIST); + } else { + s_return(sc,sc->value); + } + + case OP_EVAL: /* main part of evaluation */ +#if USE_TRACING + if(sc->tracing) { + /*s_save(sc,OP_VALUEPRINT,sc->NIL,sc->NIL);*/ + s_save(sc,OP_REAL_EVAL,sc->args,sc->code); + sc->args=sc->code; + putstr(sc,"\nEval: "); + s_goto(sc,OP_P0LIST); + } + /* fall through */ + case OP_REAL_EVAL: +#endif + if (is_symbol(sc->code)) { /* symbol */ + x=find_slot_in_env(sc,sc->envir,sc->code,1); + if (x != sc->NIL) { + s_return(sc,slot_value_in_env(x)); + } else { + Error_1(sc,"eval: unbound variable:", sc->code); + } + } else if (is_pair(sc->code)) { + if (is_syntax(x = car(sc->code))) { /* SYNTAX */ + sc->code = cdr(sc->code); + s_goto(sc,syntaxnum(x)); + } else {/* first, eval top element and eval arguments */ + s_save(sc,OP_E0ARGS, sc->NIL, sc->code); + /* If no macros => s_save(sc,OP_E1ARGS, sc->NIL, cdr(sc->code));*/ + sc->code = car(sc->code); + s_goto(sc,OP_EVAL); + } + } else { + s_return(sc,sc->code); + } + + case OP_E0ARGS: /* eval arguments */ + if (is_macro(sc->value)) { /* macro expansion */ + s_save(sc,OP_DOMACRO, sc->NIL, sc->NIL); + sc->args = cons(sc,sc->code, sc->NIL); + sc->code = sc->value; + s_goto(sc,OP_APPLY); + } else { + sc->code = cdr(sc->code); + s_goto(sc,OP_E1ARGS); + } + + case OP_E1ARGS: /* eval arguments */ + sc->args = cons(sc, sc->value, sc->args); + if (is_pair(sc->code)) { /* continue */ + s_save(sc,OP_E1ARGS, sc->args, cdr(sc->code)); + sc->code = car(sc->code); + sc->args = sc->NIL; + s_goto(sc,OP_EVAL); + } else { /* end */ + sc->args = reverse_in_place(sc, sc->NIL, sc->args); + sc->code = car(sc->args); + sc->args = cdr(sc->args); + s_goto(sc,OP_APPLY); + } + +#if USE_TRACING + case OP_TRACING: { + int tr=sc->tracing; + sc->tracing=ivalue(car(sc->args)); + s_return(sc,mk_integer(sc,tr)); + } +#endif + + case OP_APPLY: /* apply 'code' to 'args' */ +#if USE_TRACING + if(sc->tracing) { + s_save(sc,OP_REAL_APPLY,sc->args,sc->code); + sc->print_flag = 1; + /* sc->args=cons(sc,sc->code,sc->args);*/ + putstr(sc,"\nApply to: "); + s_goto(sc,OP_P0LIST); + } + /* fall through */ + case OP_REAL_APPLY: +#endif + if (is_proc(sc->code)) { + s_goto(sc,procnum(sc->code)); /* PROCEDURE */ + } else if (is_foreign(sc->code)) + { + /* Keep nested calls from GC'ing the arglist */ + push_recent_alloc(sc,sc->args,sc->NIL); + x=sc->code->_object._ff(sc,sc->args); + s_return(sc,x); + } else if (is_closure(sc->code) || is_macro(sc->code) + || is_promise(sc->code)) { /* CLOSURE */ + /* Should not accept promise */ + /* make environment */ + new_frame_in_env(sc, closure_env(sc->code)); + for (x = car(closure_code(sc->code)), y = sc->args; + is_pair(x); x = cdr(x), y = cdr(y)) { + if (y == sc->NIL) { + Error_0(sc,"not enough arguments"); + } else { + new_slot_in_env(sc, car(x), car(y)); + } + } + if (x == sc->NIL) { + /*-- + * if (y != sc->NIL) { + * Error_0(sc,"too many arguments"); + * } + */ + } else if (is_symbol(x)) + new_slot_in_env(sc, x, y); + else { + Error_1(sc,"syntax error in closure: not a symbol:", x); + } + sc->code = cdr(closure_code(sc->code)); + sc->args = sc->NIL; + s_goto(sc,OP_BEGIN); + } else if (is_continuation(sc->code)) { /* CONTINUATION */ + sc->dump = cont_dump(sc->code); + s_return(sc,sc->args != sc->NIL ? car(sc->args) : sc->NIL); + } else { + Error_1(sc,"illegal function",sc->code); + } + + case OP_DOMACRO: /* do macro */ + sc->code = sc->value; + s_goto(sc,OP_EVAL); + +#if 1 + case OP_LAMBDA: /* lambda */ + /* If the hook is defined, apply it to sc->code, otherwise + set sc->value fall thru */ + { + pointer f=find_slot_in_env(sc,sc->envir,sc->COMPILE_HOOK,1); + if(f==sc->NIL) { + sc->value = sc->code; + /* Fallthru */ + } else { + s_save(sc,OP_LAMBDA1,sc->args,sc->code); + sc->args=cons(sc,sc->code,sc->NIL); + sc->code=slot_value_in_env(f); + s_goto(sc,OP_APPLY); + } + } + + case OP_LAMBDA1: + s_return(sc,mk_closure(sc, sc->value, sc->envir)); + +#else + case OP_LAMBDA: /* lambda */ + s_return(sc,mk_closure(sc, sc->code, sc->envir)); + +#endif + + case OP_MKCLOSURE: /* make-closure */ + x=car(sc->args); + if(car(x)==sc->LAMBDA) { + x=cdr(x); + } + if(cdr(sc->args)==sc->NIL) { + y=sc->envir; + } else { + y=cadr(sc->args); + } + s_return(sc,mk_closure(sc, x, y)); + + case OP_QUOTE: /* quote */ + s_return(sc,car(sc->code)); + + case OP_DEF0: /* define */ + if(is_immutable(car(sc->code))) + Error_1(sc,"define: unable to alter immutable", car(sc->code)); + + if (is_pair(car(sc->code))) { + x = caar(sc->code); + sc->code = cons(sc, sc->LAMBDA, cons(sc, cdar(sc->code), cdr(sc->code))); + } else { + x = car(sc->code); + sc->code = cadr(sc->code); + } + if (!is_symbol(x)) { + Error_0(sc,"variable is not a symbol"); + } + s_save(sc,OP_DEF1, sc->NIL, x); + s_goto(sc,OP_EVAL); + + case OP_DEF1: /* define */ + x=find_slot_in_env(sc,sc->envir,sc->code,0); + if (x != sc->NIL) { + set_slot_in_env(sc, x, sc->value); + } else { + new_slot_in_env(sc, sc->code, sc->value); + } + s_return(sc,sc->code); + + + case OP_DEFP: /* defined? */ + x=sc->envir; + if(cdr(sc->args)!=sc->NIL) { + x=cadr(sc->args); + } + s_retbool(find_slot_in_env(sc,x,car(sc->args),1)!=sc->NIL); + + case OP_SET0: /* set! */ + if(is_immutable(car(sc->code))) + Error_1(sc,"set!: unable to alter immutable variable",car(sc->code)); + s_save(sc,OP_SET1, sc->NIL, car(sc->code)); + sc->code = cadr(sc->code); + s_goto(sc,OP_EVAL); + + case OP_SET1: /* set! */ + y=find_slot_in_env(sc,sc->envir,sc->code,1); + if (y != sc->NIL) { + set_slot_in_env(sc, y, sc->value); + s_return(sc,sc->value); + } else { + Error_1(sc,"set!: unbound variable:", sc->code); + } + + + case OP_BEGIN: /* begin */ + if (!is_pair(sc->code)) { + s_return(sc,sc->code); + } + if (cdr(sc->code) != sc->NIL) { + s_save(sc,OP_BEGIN, sc->NIL, cdr(sc->code)); + } + sc->code = car(sc->code); + s_goto(sc,OP_EVAL); + + case OP_IF0: /* if */ + s_save(sc,OP_IF1, sc->NIL, cdr(sc->code)); + sc->code = car(sc->code); + s_goto(sc,OP_EVAL); + + case OP_IF1: /* if */ + if (is_true(sc->value)) + sc->code = car(sc->code); + else + sc->code = cadr(sc->code); /* (if #f 1) ==> () because + * car(sc->NIL) = sc->NIL */ + s_goto(sc,OP_EVAL); + + case OP_LET0: /* let */ + sc->args = sc->NIL; + sc->value = sc->code; + sc->code = is_symbol(car(sc->code)) ? cadr(sc->code) : car(sc->code); + s_goto(sc,OP_LET1); + + case OP_LET1: /* let (calculate parameters) */ + sc->args = cons(sc, sc->value, sc->args); + if (is_pair(sc->code)) { /* continue */ + if (!is_pair(car(sc->code)) || !is_pair(cdar(sc->code))) { + Error_1(sc, "Bad syntax of binding spec in let :", + car(sc->code)); + } + s_save(sc,OP_LET1, sc->args, cdr(sc->code)); + sc->code = cadar(sc->code); + sc->args = sc->NIL; + s_goto(sc,OP_EVAL); + } else { /* end */ + sc->args = reverse_in_place(sc, sc->NIL, sc->args); + sc->code = car(sc->args); + sc->args = cdr(sc->args); + s_goto(sc,OP_LET2); + } + + case OP_LET2: /* let */ + new_frame_in_env(sc, sc->envir); + for (x = is_symbol(car(sc->code)) ? cadr(sc->code) : car(sc->code), y = sc->args; + y != sc->NIL; x = cdr(x), y = cdr(y)) { + new_slot_in_env(sc, caar(x), car(y)); + } + if (is_symbol(car(sc->code))) { /* named let */ + for (x = cadr(sc->code), sc->args = sc->NIL; x != sc->NIL; x = cdr(x)) { + if (!is_pair(x)) + Error_1(sc, "Bad syntax of binding in let :", x); + if (!is_list(sc, car(x))) + Error_1(sc, "Bad syntax of binding in let :", car(x)); + sc->args = cons(sc, caar(x), sc->args); + } + x = mk_closure(sc, cons(sc, reverse_in_place(sc, sc->NIL, sc->args), cddr(sc->code)), sc->envir); + new_slot_in_env(sc, car(sc->code), x); + sc->code = cddr(sc->code); + sc->args = sc->NIL; + } else { + sc->code = cdr(sc->code); + sc->args = sc->NIL; + } + s_goto(sc,OP_BEGIN); + + case OP_LET0AST: /* let* */ + if (car(sc->code) == sc->NIL) { + new_frame_in_env(sc, sc->envir); + sc->code = cdr(sc->code); + s_goto(sc,OP_BEGIN); + } + if(!is_pair(car(sc->code)) || !is_pair(caar(sc->code)) || !is_pair(cdaar(sc->code))) { + Error_1(sc,"Bad syntax of binding spec in let* :",car(sc->code)); + } + s_save(sc,OP_LET1AST, cdr(sc->code), car(sc->code)); + sc->code = cadaar(sc->code); + s_goto(sc,OP_EVAL); + + case OP_LET1AST: /* let* (make new frame) */ + new_frame_in_env(sc, sc->envir); + s_goto(sc,OP_LET2AST); + + case OP_LET2AST: /* let* (calculate parameters) */ + new_slot_in_env(sc, caar(sc->code), sc->value); + sc->code = cdr(sc->code); + if (is_pair(sc->code)) { /* continue */ + s_save(sc,OP_LET2AST, sc->args, sc->code); + sc->code = cadar(sc->code); + sc->args = sc->NIL; + s_goto(sc,OP_EVAL); + } else { /* end */ + sc->code = sc->args; + sc->args = sc->NIL; + s_goto(sc,OP_BEGIN); + } + default: + snprintf(sc->strbuff,STRBUFFSIZE,"%d: illegal operator", sc->op); + Error_0(sc,sc->strbuff); + } + return sc->T; +} + +static pointer opexe_1(scheme *sc, enum scheme_opcodes op) { + pointer x, y; + + switch (op) { + case OP_LET0REC: /* letrec */ + new_frame_in_env(sc, sc->envir); + sc->args = sc->NIL; + sc->value = sc->code; + sc->code = car(sc->code); + s_goto(sc,OP_LET1REC); + + case OP_LET1REC: /* letrec (calculate parameters) */ + sc->args = cons(sc, sc->value, sc->args); + if (is_pair(sc->code)) { /* continue */ + if (!is_pair(car(sc->code)) || !is_pair(cdar(sc->code))) { + Error_1(sc, "Bad syntax of binding spec in letrec :", + car(sc->code)); + } + s_save(sc,OP_LET1REC, sc->args, cdr(sc->code)); + sc->code = cadar(sc->code); + sc->args = sc->NIL; + s_goto(sc,OP_EVAL); + } else { /* end */ + sc->args = reverse_in_place(sc, sc->NIL, sc->args); + sc->code = car(sc->args); + sc->args = cdr(sc->args); + s_goto(sc,OP_LET2REC); + } + + case OP_LET2REC: /* letrec */ + for (x = car(sc->code), y = sc->args; y != sc->NIL; x = cdr(x), y = cdr(y)) { + new_slot_in_env(sc, caar(x), car(y)); + } + sc->code = cdr(sc->code); + sc->args = sc->NIL; + s_goto(sc,OP_BEGIN); + + case OP_COND0: /* cond */ + if (!is_pair(sc->code)) { + Error_0(sc,"syntax error in cond"); + } + s_save(sc,OP_COND1, sc->NIL, sc->code); + sc->code = caar(sc->code); + s_goto(sc,OP_EVAL); + + case OP_COND1: /* cond */ + if (is_true(sc->value)) { + if ((sc->code = cdar(sc->code)) == sc->NIL) { + s_return(sc,sc->value); + } + if(!sc->code || car(sc->code)==sc->FEED_TO) { + if(!is_pair(cdr(sc->code))) { + Error_0(sc,"syntax error in cond"); + } + x=cons(sc, sc->QUOTE, cons(sc, sc->value, sc->NIL)); + sc->code=cons(sc,cadr(sc->code),cons(sc,x,sc->NIL)); + s_goto(sc,OP_EVAL); + } + s_goto(sc,OP_BEGIN); + } else { + if ((sc->code = cdr(sc->code)) == sc->NIL) { + s_return(sc,sc->NIL); + } else { + s_save(sc,OP_COND1, sc->NIL, sc->code); + sc->code = caar(sc->code); + s_goto(sc,OP_EVAL); + } + } + + case OP_DELAY: /* delay */ + x = mk_closure(sc, cons(sc, sc->NIL, sc->code), sc->envir); + typeflag(x)=T_PROMISE; + s_return(sc,x); + + case OP_AND0: /* and */ + if (sc->code == sc->NIL) { + s_return(sc,sc->T); + } + s_save(sc,OP_AND1, sc->NIL, cdr(sc->code)); + sc->code = car(sc->code); + s_goto(sc,OP_EVAL); + + case OP_AND1: /* and */ + if (is_false(sc->value)) { + s_return(sc,sc->value); + } else if (sc->code == sc->NIL) { + s_return(sc,sc->value); + } else { + s_save(sc,OP_AND1, sc->NIL, cdr(sc->code)); + sc->code = car(sc->code); + s_goto(sc,OP_EVAL); + } + + case OP_OR0: /* or */ + if (sc->code == sc->NIL) { + s_return(sc,sc->F); + } + s_save(sc,OP_OR1, sc->NIL, cdr(sc->code)); + sc->code = car(sc->code); + s_goto(sc,OP_EVAL); + + case OP_OR1: /* or */ + if (is_true(sc->value)) { + s_return(sc,sc->value); + } else if (sc->code == sc->NIL) { + s_return(sc,sc->value); + } else { + s_save(sc,OP_OR1, sc->NIL, cdr(sc->code)); + sc->code = car(sc->code); + s_goto(sc,OP_EVAL); + } + + case OP_C0STREAM: /* cons-stream */ + s_save(sc,OP_C1STREAM, sc->NIL, cdr(sc->code)); + sc->code = car(sc->code); + s_goto(sc,OP_EVAL); + + case OP_C1STREAM: /* cons-stream */ + sc->args = sc->value; /* save sc->value to register sc->args for gc */ + x = mk_closure(sc, cons(sc, sc->NIL, sc->code), sc->envir); + typeflag(x)=T_PROMISE; + s_return(sc,cons(sc, sc->args, x)); + + case OP_MACRO0: /* macro */ + if (is_pair(car(sc->code))) { + x = caar(sc->code); + sc->code = cons(sc, sc->LAMBDA, cons(sc, cdar(sc->code), cdr(sc->code))); + } else { + x = car(sc->code); + sc->code = cadr(sc->code); + } + if (!is_symbol(x)) { + Error_0(sc,"variable is not a symbol"); + } + s_save(sc,OP_MACRO1, sc->NIL, x); + s_goto(sc,OP_EVAL); + + case OP_MACRO1: /* macro */ + typeflag(sc->value) = T_MACRO; + x = find_slot_in_env(sc, sc->envir, sc->code, 0); + if (x != sc->NIL) { + set_slot_in_env(sc, x, sc->value); + } else { + new_slot_in_env(sc, sc->code, sc->value); + } + s_return(sc,sc->code); + + case OP_CASE0: /* case */ + s_save(sc,OP_CASE1, sc->NIL, cdr(sc->code)); + sc->code = car(sc->code); + s_goto(sc,OP_EVAL); + + case OP_CASE1: /* case */ + for (x = sc->code; x != sc->NIL; x = cdr(x)) { + if (!is_pair(y = caar(x))) { + break; + } + for ( ; y != sc->NIL; y = cdr(y)) { + if (eqv(car(y), sc->value)) { + break; + } + } + if (y != sc->NIL) { + break; + } + } + if (x != sc->NIL) { + if (is_pair(caar(x))) { + sc->code = cdar(x); + s_goto(sc,OP_BEGIN); + } else {/* else */ + s_save(sc,OP_CASE2, sc->NIL, cdar(x)); + sc->code = caar(x); + s_goto(sc,OP_EVAL); + } + } else { + s_return(sc,sc->NIL); + } + + case OP_CASE2: /* case */ + if (is_true(sc->value)) { + s_goto(sc,OP_BEGIN); + } else { + s_return(sc,sc->NIL); + } + + case OP_PAPPLY: /* apply */ + sc->code = car(sc->args); + sc->args = list_star(sc,cdr(sc->args)); + /*sc->args = cadr(sc->args);*/ + s_goto(sc,OP_APPLY); + + case OP_PEVAL: /* eval */ + if(cdr(sc->args)!=sc->NIL) { + sc->envir=cadr(sc->args); + } + sc->code = car(sc->args); + s_goto(sc,OP_EVAL); + + case OP_CONTINUATION: /* call-with-current-continuation */ + sc->code = car(sc->args); + sc->args = cons(sc, mk_continuation(sc, sc->dump), sc->NIL); + s_goto(sc,OP_APPLY); + + default: + snprintf(sc->strbuff,STRBUFFSIZE,"%d: illegal operator", sc->op); + Error_0(sc,sc->strbuff); + } + return sc->T; +} + +static pointer opexe_2(scheme *sc, enum scheme_opcodes op) { + pointer x; + num v; +#if USE_MATH + double dd; +#endif + + switch (op) { +#if USE_MATH + case OP_INEX2EX: /* inexact->exact */ + x=car(sc->args); + if(num_is_integer(x)) { + s_return(sc,x); + } else if(modf(rvalue_unchecked(x),&dd)==0.0) { + s_return(sc,mk_integer(sc,ivalue(x))); + } else { + Error_1(sc,"inexact->exact: not integral:",x); + } + + case OP_EXP: + x=car(sc->args); + s_return(sc, mk_real(sc, exp(rvalue(x)))); + + case OP_LOG: + x=car(sc->args); + s_return(sc, mk_real(sc, log(rvalue(x)))); + + case OP_SIN: + x=car(sc->args); + s_return(sc, mk_real(sc, sin(rvalue(x)))); + + case OP_COS: + x=car(sc->args); + s_return(sc, mk_real(sc, cos(rvalue(x)))); + + case OP_TAN: + x=car(sc->args); + s_return(sc, mk_real(sc, tan(rvalue(x)))); + + case OP_ASIN: + x=car(sc->args); + s_return(sc, mk_real(sc, asin(rvalue(x)))); + + case OP_ACOS: + x=car(sc->args); + s_return(sc, mk_real(sc, acos(rvalue(x)))); + + case OP_ATAN: + x=car(sc->args); + if(cdr(sc->args)==sc->NIL) { + s_return(sc, mk_real(sc, atan(rvalue(x)))); + } else { + pointer y=cadr(sc->args); + s_return(sc, mk_real(sc, atan2(rvalue(x),rvalue(y)))); + } + + case OP_SQRT: + x=car(sc->args); + s_return(sc, mk_real(sc, sqrt(rvalue(x)))); + + case OP_EXPT: { + double result; + int real_result=1; + pointer y=cadr(sc->args); + x=car(sc->args); + if (num_is_integer(x) && num_is_integer(y)) + real_result=0; + /* This 'if' is an R5RS compatibility fix. */ + /* NOTE: Remove this 'if' fix for R6RS. */ + if (rvalue(x) == 0 && rvalue(y) < 0) { + result = 0.0; + } else { + result = pow(rvalue(x),rvalue(y)); + } + /* Before returning integer result make sure we can. */ + /* If the test fails, result is too big for integer. */ + if (!real_result) + { + long result_as_long = (long)result; + if (result != (double)result_as_long) + real_result = 1; + } + if (real_result) { + s_return(sc, mk_real(sc, result)); + } else { + s_return(sc, mk_integer(sc, result)); + } + } + + case OP_FLOOR: + x=car(sc->args); + s_return(sc, mk_real(sc, floor(rvalue(x)))); + + case OP_CEILING: + x=car(sc->args); + s_return(sc, mk_real(sc, ceil(rvalue(x)))); + + case OP_TRUNCATE : { + double rvalue_of_x ; + x=car(sc->args); + rvalue_of_x = rvalue(x) ; + if (rvalue_of_x > 0) { + s_return(sc, mk_real(sc, floor(rvalue_of_x))); + } else { + s_return(sc, mk_real(sc, ceil(rvalue_of_x))); + } + } + + case OP_ROUND: + x=car(sc->args); + if (num_is_integer(x)) + s_return(sc, x); + s_return(sc, mk_real(sc, round_per_R5RS(rvalue(x)))); +#endif + + case OP_ADD: /* + */ + v=num_zero; + for (x = sc->args; x != sc->NIL; x = cdr(x)) { + v=num_add(v,nvalue(car(x))); + } + s_return(sc,mk_number(sc, v)); + + case OP_MUL: /* * */ + v=num_one; + for (x = sc->args; x != sc->NIL; x = cdr(x)) { + v=num_mul(v,nvalue(car(x))); + } + s_return(sc,mk_number(sc, v)); + + case OP_SUB: /* - */ + if(cdr(sc->args)==sc->NIL) { + x=sc->args; + v=num_zero; + } else { + x = cdr(sc->args); + v = nvalue(car(sc->args)); + } + for (; x != sc->NIL; x = cdr(x)) { + v=num_sub(v,nvalue(car(x))); + } + s_return(sc,mk_number(sc, v)); + + case OP_DIV: /* / */ + if(cdr(sc->args)==sc->NIL) { + x=sc->args; + v=num_one; + } else { + x = cdr(sc->args); + v = nvalue(car(sc->args)); + } + for (; x != sc->NIL; x = cdr(x)) { + if (!is_zero_double(rvalue(car(x)))) + v=num_div(v,nvalue(car(x))); + else { + Error_0(sc,"/: division by zero"); + } + } + s_return(sc,mk_number(sc, v)); + + case OP_INTDIV: /* quotient */ + if(cdr(sc->args)==sc->NIL) { + x=sc->args; + v=num_one; + } else { + x = cdr(sc->args); + v = nvalue(car(sc->args)); + } + for (; x != sc->NIL; x = cdr(x)) { + if (ivalue(car(x)) != 0) + v=num_intdiv(v,nvalue(car(x))); + else { + Error_0(sc,"quotient: division by zero"); + } + } + s_return(sc,mk_number(sc, v)); + + case OP_REM: /* remainder */ + v = nvalue(car(sc->args)); + if (ivalue(cadr(sc->args)) != 0) + v=num_rem(v,nvalue(cadr(sc->args))); + else { + Error_0(sc,"remainder: division by zero"); + } + s_return(sc,mk_number(sc, v)); + + case OP_MOD: /* modulo */ + v = nvalue(car(sc->args)); + if (ivalue(cadr(sc->args)) != 0) + v=num_mod(v,nvalue(cadr(sc->args))); + else { + Error_0(sc,"modulo: division by zero"); + } + s_return(sc,mk_number(sc, v)); + + case OP_CAR: /* car */ + s_return(sc,caar(sc->args)); + + case OP_CDR: /* cdr */ + s_return(sc,cdar(sc->args)); + + case OP_CONS: /* cons */ + cdr(sc->args) = cadr(sc->args); + s_return(sc,sc->args); + + case OP_SETCAR: /* set-car! */ + if(!is_immutable(car(sc->args))) { + caar(sc->args) = cadr(sc->args); + s_return(sc,car(sc->args)); + } else { + Error_0(sc,"set-car!: unable to alter immutable pair"); + } + + case OP_SETCDR: /* set-cdr! */ + if(!is_immutable(car(sc->args))) { + cdar(sc->args) = cadr(sc->args); + s_return(sc,car(sc->args)); + } else { + Error_0(sc,"set-cdr!: unable to alter immutable pair"); + } + + case OP_CHAR2INT: { /* char->integer */ + char c; + c=(char)ivalue(car(sc->args)); + s_return(sc,mk_integer(sc,(unsigned char)c)); + } + + case OP_INT2CHAR: { /* integer->char */ + unsigned char c; + c=(unsigned char)ivalue(car(sc->args)); + s_return(sc,mk_character(sc,(char)c)); + } + + case OP_CHARUPCASE: { + unsigned char c; + c=(unsigned char)ivalue(car(sc->args)); + c=toupper(c); + s_return(sc,mk_character(sc,(char)c)); + } + + case OP_CHARDNCASE: { + unsigned char c; + c=(unsigned char)ivalue(car(sc->args)); + c=tolower(c); + s_return(sc,mk_character(sc,(char)c)); + } + + case OP_STR2SYM: /* string->symbol */ + s_return(sc,mk_symbol(sc,strvalue(car(sc->args)))); + + case OP_STR2ATOM: /* string->atom */ { + char *s=strvalue(car(sc->args)); + long pf = 0; + if(cdr(sc->args)!=sc->NIL) { + /* we know cadr(sc->args) is a natural number */ + /* see if it is 2, 8, 10, or 16, or error */ + pf = ivalue_unchecked(cadr(sc->args)); + if(pf == 16 || pf == 10 || pf == 8 || pf == 2) { + /* base is OK */ + } + else { + pf = -1; + } + } + if (pf < 0) { + Error_1(sc, "string->atom: bad base:", cadr(sc->args)); + } else if(*s=='#') /* no use of base! */ { + s_return(sc, mk_sharp_const(sc, s+1)); + } else { + if (pf == 0 || pf == 10) { + s_return(sc, mk_atom(sc, s)); + } + else { + char *ep; + long iv = strtol(s,&ep,(int )pf); + if (*ep == 0) { + s_return(sc, mk_integer(sc, iv)); + } + else { + s_return(sc, sc->F); + } + } + } + } + + case OP_SYM2STR: /* symbol->string */ + x=mk_string(sc,symname(car(sc->args))); + setimmutable(x); + s_return(sc,x); + + case OP_ATOM2STR: /* atom->string */ { + long pf = 0; + x=car(sc->args); + if(cdr(sc->args)!=sc->NIL) { + /* we know cadr(sc->args) is a natural number */ + /* see if it is 2, 8, 10, or 16, or error */ + pf = ivalue_unchecked(cadr(sc->args)); + if(is_number(x) && (pf == 16 || pf == 10 || pf == 8 || pf == 2)) { + /* base is OK */ + } + else { + pf = -1; + } + } + if (pf < 0) { + Error_1(sc, "atom->string: bad base:", cadr(sc->args)); + } else if(is_number(x) || is_character(x) || is_string(x) || is_symbol(x)) { + char *p; + int len; + atom2str(sc,x,(int )pf,&p,&len); + s_return(sc,mk_counted_string(sc,p,len)); + } else { + Error_1(sc, "atom->string: not an atom:", x); + } + } + + case OP_MKSTRING: { /* make-string */ + int fill=' '; + int len; + + len=ivalue(car(sc->args)); + + if(cdr(sc->args)!=sc->NIL) { + fill=charvalue(cadr(sc->args)); + } + s_return(sc,mk_empty_string(sc,len,(char)fill)); + } + + case OP_STRLEN: /* string-length */ + s_return(sc,mk_integer(sc,strlength(car(sc->args)))); + + case OP_STRREF: { /* string-ref */ + char *str; + int index; + + str=strvalue(car(sc->args)); + + index=ivalue(cadr(sc->args)); + + if(index>=strlength(car(sc->args))) { + Error_1(sc,"string-ref: out of bounds:",cadr(sc->args)); + } + + s_return(sc,mk_character(sc,((unsigned char*)str)[index])); + } + + case OP_STRSET: { /* string-set! */ + char *str; + int index; + int c; + + if(is_immutable(car(sc->args))) { + Error_1(sc,"string-set!: unable to alter immutable string:",car(sc->args)); + } + str=strvalue(car(sc->args)); + + index=ivalue(cadr(sc->args)); + if(index>=strlength(car(sc->args))) { + Error_1(sc,"string-set!: out of bounds:",cadr(sc->args)); + } + + c=charvalue(caddr(sc->args)); + + str[index]=(char)c; + s_return(sc,car(sc->args)); + } + + case OP_STRAPPEND: { /* string-append */ + /* in 1.29 string-append was in Scheme in init.scm but was too slow */ + int len = 0; + pointer newstr; + char *pos; + + /* compute needed length for new string */ + for (x = sc->args; x != sc->NIL; x = cdr(x)) { + len += strlength(car(x)); + } + newstr = mk_empty_string(sc, len, ' '); + /* store the contents of the argument strings into the new string */ + for (pos = strvalue(newstr), x = sc->args; x != sc->NIL; + pos += strlength(car(x)), x = cdr(x)) { + memcpy(pos, strvalue(car(x)), strlength(car(x))); + } + s_return(sc, newstr); + } + + case OP_SUBSTR: { /* substring */ + char *str; + int index0; + int index1; + int len; + + str=strvalue(car(sc->args)); + + index0=ivalue(cadr(sc->args)); + + if(index0>strlength(car(sc->args))) { + Error_1(sc,"substring: start out of bounds:",cadr(sc->args)); + } + + if(cddr(sc->args)!=sc->NIL) { + index1=ivalue(caddr(sc->args)); + if(index1>strlength(car(sc->args)) || index1args)); + } + } else { + index1=strlength(car(sc->args)); + } + + len=index1-index0; + x=mk_empty_string(sc,len,' '); + memcpy(strvalue(x),str+index0,len); + strvalue(x)[len]=0; + + s_return(sc,x); + } + + case OP_VECTOR: { /* vector */ + int i; + pointer vec; + int len=list_length(sc,sc->args); + if(len<0) { + Error_1(sc,"vector: not a proper list:",sc->args); + } + vec=mk_vector(sc,len); + if(sc->no_memory) { s_return(sc, sc->sink); } + for (x = sc->args, i = 0; is_pair(x); x = cdr(x), i++) { + set_vector_elem(vec,i,car(x)); + } + s_return(sc,vec); + } + + case OP_MKVECTOR: { /* make-vector */ + pointer fill=sc->NIL; + int len; + pointer vec; + + len=ivalue(car(sc->args)); + + if(cdr(sc->args)!=sc->NIL) { + fill=cadr(sc->args); + } + vec=mk_vector(sc,len); + if(sc->no_memory) { s_return(sc, sc->sink); } + if(fill!=sc->NIL) { + fill_vector(vec,fill); + } + s_return(sc,vec); + } + + case OP_VECLEN: /* vector-length */ + s_return(sc,mk_integer(sc,ivalue(car(sc->args)))); + + case OP_VECREF: { /* vector-ref */ + int index; + + index=ivalue(cadr(sc->args)); + + if(index>=ivalue(car(sc->args))) { + Error_1(sc,"vector-ref: out of bounds:",cadr(sc->args)); + } + + s_return(sc,vector_elem(car(sc->args),index)); + } + + case OP_VECSET: { /* vector-set! */ + int index; + + if(is_immutable(car(sc->args))) { + Error_1(sc,"vector-set!: unable to alter immutable vector:",car(sc->args)); + } + + index=ivalue(cadr(sc->args)); + if(index>=ivalue(car(sc->args))) { + Error_1(sc,"vector-set!: out of bounds:",cadr(sc->args)); + } + + set_vector_elem(car(sc->args),index,caddr(sc->args)); + s_return(sc,car(sc->args)); + } + + default: + snprintf(sc->strbuff,STRBUFFSIZE,"%d: illegal operator", sc->op); + Error_0(sc,sc->strbuff); + } + return sc->T; +} + +static int is_list(scheme *sc, pointer a) +{ return list_length(sc,a) >= 0; } + +/* Result is: + proper list: length + circular list: -1 + not even a pair: -2 + dotted list: -2 minus length before dot +*/ +int list_length(scheme *sc, pointer a) { + int i=0; + pointer slow, fast; + + slow = fast = a; + while (1) + { + if (fast == sc->NIL) + return i; + if (!is_pair(fast)) + return -2 - i; + fast = cdr(fast); + ++i; + if (fast == sc->NIL) + return i; + if (!is_pair(fast)) + return -2 - i; + ++i; + fast = cdr(fast); + + /* Safe because we would have already returned if `fast' + encountered a non-pair. */ + slow = cdr(slow); + if (fast == slow) + { + /* the fast pointer has looped back around and caught up + with the slow pointer, hence the structure is circular, + not of finite length, and therefore not a list */ + return -1; + } + } +} + +static pointer opexe_3(scheme *sc, enum scheme_opcodes op) { + pointer x; + num v; + int (*comp_func)(num,num)=0; + + switch (op) { + case OP_NOT: /* not */ + s_retbool(is_false(car(sc->args))); + case OP_BOOLP: /* boolean? */ + s_retbool(car(sc->args) == sc->F || car(sc->args) == sc->T); + case OP_EOFOBJP: /* boolean? */ + s_retbool(car(sc->args) == sc->EOF_OBJ); + case OP_NULLP: /* null? */ + s_retbool(car(sc->args) == sc->NIL); + case OP_NUMEQ: /* = */ + case OP_LESS: /* < */ + case OP_GRE: /* > */ + case OP_LEQ: /* <= */ + case OP_GEQ: /* >= */ + switch(op) { + case OP_NUMEQ: comp_func=num_eq; break; + case OP_LESS: comp_func=num_lt; break; + case OP_GRE: comp_func=num_gt; break; + case OP_LEQ: comp_func=num_le; break; + case OP_GEQ: comp_func=num_ge; break; + default: assert (! "reached"); + } + x=sc->args; + v=nvalue(car(x)); + x=cdr(x); + + for (; x != sc->NIL; x = cdr(x)) { + if(!comp_func(v,nvalue(car(x)))) { + s_retbool(0); + } + v=nvalue(car(x)); + } + s_retbool(1); + case OP_SYMBOLP: /* symbol? */ + s_retbool(is_symbol(car(sc->args))); + case OP_NUMBERP: /* number? */ + s_retbool(is_number(car(sc->args))); + case OP_STRINGP: /* string? */ + s_retbool(is_string(car(sc->args))); + case OP_INTEGERP: /* integer? */ + s_retbool(is_integer(car(sc->args))); + case OP_REALP: /* real? */ + s_retbool(is_number(car(sc->args))); /* All numbers are real */ + case OP_CHARP: /* char? */ + s_retbool(is_character(car(sc->args))); +#if USE_CHAR_CLASSIFIERS + case OP_CHARAP: /* char-alphabetic? */ + s_retbool(Cisalpha(ivalue(car(sc->args)))); + case OP_CHARNP: /* char-numeric? */ + s_retbool(Cisdigit(ivalue(car(sc->args)))); + case OP_CHARWP: /* char-whitespace? */ + s_retbool(Cisspace(ivalue(car(sc->args)))); + case OP_CHARUP: /* char-upper-case? */ + s_retbool(Cisupper(ivalue(car(sc->args)))); + case OP_CHARLP: /* char-lower-case? */ + s_retbool(Cislower(ivalue(car(sc->args)))); +#endif + case OP_PORTP: /* port? */ + s_retbool(is_port(car(sc->args))); + case OP_INPORTP: /* input-port? */ + s_retbool(is_inport(car(sc->args))); + case OP_OUTPORTP: /* output-port? */ + s_retbool(is_outport(car(sc->args))); + case OP_PROCP: /* procedure? */ + /*-- + * continuation should be procedure by the example + * (call-with-current-continuation procedure?) ==> #t + * in R^3 report sec. 6.9 + */ + s_retbool(is_proc(car(sc->args)) || is_closure(car(sc->args)) + || is_continuation(car(sc->args)) || is_foreign(car(sc->args))); + case OP_PAIRP: /* pair? */ + s_retbool(is_pair(car(sc->args))); + case OP_LISTP: /* list? */ + s_retbool(list_length(sc,car(sc->args)) >= 0); + + case OP_ENVP: /* environment? */ + s_retbool(is_environment(car(sc->args))); + case OP_VECTORP: /* vector? */ + s_retbool(is_vector(car(sc->args))); + case OP_EQ: /* eq? */ + s_retbool(car(sc->args) == cadr(sc->args)); + case OP_EQV: /* eqv? */ + s_retbool(eqv(car(sc->args), cadr(sc->args))); + default: + snprintf(sc->strbuff,STRBUFFSIZE,"%d: illegal operator", sc->op); + Error_0(sc,sc->strbuff); + } + return sc->T; +} + +static pointer opexe_4(scheme *sc, enum scheme_opcodes op) { + pointer x, y; + + switch (op) { + case OP_FORCE: /* force */ + sc->code = car(sc->args); + if (is_promise(sc->code)) { + /* Should change type to closure here */ + s_save(sc, OP_SAVE_FORCED, sc->NIL, sc->code); + sc->args = sc->NIL; + s_goto(sc,OP_APPLY); + } else { + s_return(sc,sc->code); + } + + case OP_SAVE_FORCED: /* Save forced value replacing promise */ + memcpy(sc->code,sc->value,sizeof(struct cell)); + s_return(sc,sc->value); + + case OP_WRITE: /* write */ + case OP_DISPLAY: /* display */ + case OP_WRITE_CHAR: /* write-char */ + if(is_pair(cdr(sc->args))) { + if(cadr(sc->args)!=sc->outport) { + x=cons(sc,sc->outport,sc->NIL); + s_save(sc,OP_SET_OUTPORT, x, sc->NIL); + sc->outport=cadr(sc->args); + } + } + sc->args = car(sc->args); + if(op==OP_WRITE) { + sc->print_flag = 1; + } else { + sc->print_flag = 0; + } + s_goto(sc,OP_P0LIST); + + case OP_NEWLINE: /* newline */ + if(is_pair(sc->args)) { + if(car(sc->args)!=sc->outport) { + x=cons(sc,sc->outport,sc->NIL); + s_save(sc,OP_SET_OUTPORT, x, sc->NIL); + sc->outport=car(sc->args); + } + } + putstr(sc, "\n"); + s_return(sc,sc->T); + + case OP_ERR0: /* error */ + sc->retcode=-1; + if (!is_string(car(sc->args))) { + sc->args=cons(sc,mk_string(sc," -- "),sc->args); + setimmutable(car(sc->args)); + } + putstr(sc, "Error: "); + putstr(sc, strvalue(car(sc->args))); + sc->args = cdr(sc->args); + s_goto(sc,OP_ERR1); + + case OP_ERR1: /* error */ + putstr(sc, " "); + if (sc->args != sc->NIL) { + s_save(sc,OP_ERR1, cdr(sc->args), sc->NIL); + sc->args = car(sc->args); + sc->print_flag = 1; + s_goto(sc,OP_P0LIST); + } else { + putstr(sc, "\n"); + if(sc->interactive_repl) { + s_goto(sc,OP_T0LVL); + } else { + return sc->NIL; + } + } + + case OP_REVERSE: /* reverse */ + s_return(sc,reverse(sc, car(sc->args))); + + case OP_LIST_STAR: /* list* */ + s_return(sc,list_star(sc,sc->args)); + + case OP_APPEND: /* append */ + x = sc->NIL; + y = sc->args; + if (y == x) { + s_return(sc, x); + } + + /* cdr() in the while condition is not a typo. If car() */ + /* is used (append '() 'a) will return the wrong result.*/ + while (cdr(y) != sc->NIL) { + x = revappend(sc, x, car(y)); + y = cdr(y); + if (x == sc->F) { + Error_0(sc, "non-list argument to append"); + } + } + + s_return(sc, reverse_in_place(sc, car(y), x)); + +#if USE_PLIST + case OP_PUT: /* put */ + if (!hasprop(car(sc->args)) || !hasprop(cadr(sc->args))) { + Error_0(sc,"illegal use of put"); + } + for (x = symprop(car(sc->args)), y = cadr(sc->args); x != sc->NIL; x = cdr(x)) { + if (caar(x) == y) { + break; + } + } + if (x != sc->NIL) + cdar(x) = caddr(sc->args); + else + symprop(car(sc->args)) = cons(sc, cons(sc, y, caddr(sc->args)), + symprop(car(sc->args))); + s_return(sc,sc->T); + + case OP_GET: /* get */ + if (!hasprop(car(sc->args)) || !hasprop(cadr(sc->args))) { + Error_0(sc,"illegal use of get"); + } + for (x = symprop(car(sc->args)), y = cadr(sc->args); x != sc->NIL; x = cdr(x)) { + if (caar(x) == y) { + break; + } + } + if (x != sc->NIL) { + s_return(sc,cdar(x)); + } else { + s_return(sc,sc->NIL); + } +#endif /* USE_PLIST */ + case OP_QUIT: /* quit */ + if(is_pair(sc->args)) { + sc->retcode=ivalue(car(sc->args)); + } + return (sc->NIL); + + case OP_GC: /* gc */ + gc(sc, sc->NIL, sc->NIL); + s_return(sc,sc->T); + + case OP_GCVERB: /* gc-verbose */ + { int was = sc->gc_verbose; + + sc->gc_verbose = (car(sc->args) != sc->F); + s_retbool(was); + } + + case OP_NEWSEGMENT: /* new-segment */ + if (!is_pair(sc->args) || !is_number(car(sc->args))) { + Error_0(sc,"new-segment: argument must be a number"); + } + alloc_cellseg(sc, (int) ivalue(car(sc->args))); + s_return(sc,sc->T); + + case OP_OBLIST: /* oblist */ + s_return(sc, oblist_all_symbols(sc)); + + case OP_CURR_INPORT: /* current-input-port */ + s_return(sc,sc->inport); + + case OP_CURR_OUTPORT: /* current-output-port */ + s_return(sc,sc->outport); + + case OP_OPEN_INFILE: /* open-input-file */ + case OP_OPEN_OUTFILE: /* open-output-file */ + case OP_OPEN_INOUTFILE: /* open-input-output-file */ { + int prop=0; + pointer p; + switch(op) { + case OP_OPEN_INFILE: prop=port_input; break; + case OP_OPEN_OUTFILE: prop=port_output; break; + case OP_OPEN_INOUTFILE: prop=port_input|port_output; break; + default: assert (! "reached"); + } + p=port_from_filename(sc,strvalue(car(sc->args)),prop); + if(p==sc->NIL) { + s_return(sc,sc->F); + } + s_return(sc,p); + break; + default: assert (! "reached"); + } + +#if USE_STRING_PORTS + case OP_OPEN_INSTRING: /* open-input-string */ + case OP_OPEN_INOUTSTRING: /* open-input-output-string */ { + int prop=0; + pointer p; + switch(op) { + case OP_OPEN_INSTRING: prop=port_input; break; + case OP_OPEN_INOUTSTRING: prop=port_input|port_output; break; + default: assert (! "reached"); + } + p=port_from_string(sc, strvalue(car(sc->args)), + strvalue(car(sc->args))+strlength(car(sc->args)), prop); + if(p==sc->NIL) { + s_return(sc,sc->F); + } + s_return(sc,p); + } + case OP_OPEN_OUTSTRING: /* open-output-string */ { + pointer p; + if(car(sc->args)==sc->NIL) { + p=port_from_scratch(sc); + if(p==sc->NIL) { + s_return(sc,sc->F); + } + } else { + p=port_from_string(sc, strvalue(car(sc->args)), + strvalue(car(sc->args))+strlength(car(sc->args)), + port_output); + if(p==sc->NIL) { + s_return(sc,sc->F); + } + } + s_return(sc,p); + } + case OP_GET_OUTSTRING: /* get-output-string */ { + port *p; + + if ((p=car(sc->args)->_object._port)->kind&port_string) { + off_t size; + char *str; + + size=p->rep.string.curr-p->rep.string.start+1; + str=sc->malloc(size); + if(str != NULL) { + pointer s; + + memcpy(str,p->rep.string.start,size-1); + str[size-1]='\0'; + s=mk_string(sc,str); + sc->free(str); + s_return(sc,s); + } + } + s_return(sc,sc->F); + } +#endif + + case OP_CLOSE_INPORT: /* close-input-port */ + port_close(sc,car(sc->args),port_input); + s_return(sc,sc->T); + + case OP_CLOSE_OUTPORT: /* close-output-port */ + port_close(sc,car(sc->args),port_output); + s_return(sc,sc->T); + + case OP_INT_ENV: /* interaction-environment */ + s_return(sc,sc->global_env); + + case OP_CURR_ENV: /* current-environment */ + s_return(sc,sc->envir); + + } + return sc->T; +} + +static pointer opexe_5(scheme *sc, enum scheme_opcodes op) { + pointer x; + + if(sc->nesting!=0) { + int n=sc->nesting; + sc->nesting=0; + sc->retcode=-1; + Error_1(sc,"unmatched parentheses:",mk_integer(sc,n)); + } + + switch (op) { + /* ========== reading part ========== */ + case OP_READ: + if(!is_pair(sc->args)) { + s_goto(sc,OP_READ_INTERNAL); + } + if(!is_inport(car(sc->args))) { + Error_1(sc,"read: not an input port:",car(sc->args)); + } + if(car(sc->args)==sc->inport) { + s_goto(sc,OP_READ_INTERNAL); + } + x=sc->inport; + sc->inport=car(sc->args); + x=cons(sc,x,sc->NIL); + s_save(sc,OP_SET_INPORT, x, sc->NIL); + s_goto(sc,OP_READ_INTERNAL); + + case OP_READ_CHAR: /* read-char */ + case OP_PEEK_CHAR: /* peek-char */ { + int c; + if(is_pair(sc->args)) { + if(car(sc->args)!=sc->inport) { + x=sc->inport; + x=cons(sc,x,sc->NIL); + s_save(sc,OP_SET_INPORT, x, sc->NIL); + sc->inport=car(sc->args); + } + } + c=inchar(sc); + if(c==EOF) { + s_return(sc,sc->EOF_OBJ); + } + if(sc->op==OP_PEEK_CHAR) { + backchar(sc,c); + } + s_return(sc,mk_character(sc,c)); + } + + case OP_CHAR_READY: /* char-ready? */ { + pointer p=sc->inport; + int res; + if(is_pair(sc->args)) { + p=car(sc->args); + } + res=p->_object._port->kind&port_string; + s_retbool(res); + } + + case OP_SET_INPORT: /* set-input-port */ + sc->inport=car(sc->args); + s_return(sc,sc->value); + + case OP_SET_OUTPORT: /* set-output-port */ + sc->outport=car(sc->args); + s_return(sc,sc->value); + + case OP_RDSEXPR: + switch (sc->tok) { + case TOK_EOF: + s_return(sc,sc->EOF_OBJ); + /* NOTREACHED */ +/* + * Commented out because we now skip comments in the scanner + * + case TOK_COMMENT: { + int c; + while ((c=inchar(sc)) != '\n' && c!=EOF) + ; + sc->tok = token(sc); + s_goto(sc,OP_RDSEXPR); + } +*/ + case TOK_VEC: + s_save(sc,OP_RDVEC,sc->NIL,sc->NIL); + /* fall through */ + case TOK_LPAREN: + sc->tok = token(sc); + if (sc->tok == TOK_RPAREN) { + s_return(sc,sc->NIL); + } else if (sc->tok == TOK_DOT) { + Error_0(sc,"syntax error: illegal dot expression"); + } else { + sc->nesting_stack[sc->file_i]++; + s_save(sc,OP_RDLIST, sc->NIL, sc->NIL); + s_goto(sc,OP_RDSEXPR); + } + case TOK_QUOTE: + s_save(sc,OP_RDQUOTE, sc->NIL, sc->NIL); + sc->tok = token(sc); + s_goto(sc,OP_RDSEXPR); + case TOK_BQUOTE: + sc->tok = token(sc); + if(sc->tok==TOK_VEC) { + s_save(sc,OP_RDQQUOTEVEC, sc->NIL, sc->NIL); + sc->tok=TOK_LPAREN; + s_goto(sc,OP_RDSEXPR); + } else { + s_save(sc,OP_RDQQUOTE, sc->NIL, sc->NIL); + } + s_goto(sc,OP_RDSEXPR); + case TOK_COMMA: + s_save(sc,OP_RDUNQUOTE, sc->NIL, sc->NIL); + sc->tok = token(sc); + s_goto(sc,OP_RDSEXPR); + case TOK_ATMARK: + s_save(sc,OP_RDUQTSP, sc->NIL, sc->NIL); + sc->tok = token(sc); + s_goto(sc,OP_RDSEXPR); + case TOK_ATOM: + s_return(sc,mk_atom(sc, readstr_upto(sc, DELIMITERS))); + case TOK_DQUOTE: + x=readstrexp(sc); + if(x==sc->F) { + Error_0(sc,"Error reading string"); + } + setimmutable(x); + s_return(sc,x); + case TOK_SHARP: { + pointer f=find_slot_in_env(sc,sc->envir,sc->SHARP_HOOK,1); + if(f==sc->NIL) { + Error_0(sc,"undefined sharp expression"); + } else { + sc->code=cons(sc,slot_value_in_env(f),sc->NIL); + s_goto(sc,OP_EVAL); + } + } + case TOK_SHARP_CONST: + if ((x = mk_sharp_const(sc, readstr_upto(sc, DELIMITERS))) == sc->NIL) { + Error_0(sc,"undefined sharp expression"); + } else { + s_return(sc,x); + } + default: + Error_0(sc,"syntax error: illegal token"); + } + break; + + case OP_RDLIST: { + sc->args = cons(sc, sc->value, sc->args); + sc->tok = token(sc); +/* We now skip comments in the scanner + while (sc->tok == TOK_COMMENT) { + int c; + while ((c=inchar(sc)) != '\n' && c!=EOF) + ; + sc->tok = token(sc); + } +*/ + if (sc->tok == TOK_EOF) + { s_return(sc,sc->EOF_OBJ); } + else if (sc->tok == TOK_RPAREN) { + int c = inchar(sc); + if (c != '\n') + backchar(sc,c); +#if SHOW_ERROR_LINE + else if (sc->load_stack[sc->file_i].kind & port_file) + sc->load_stack[sc->file_i].rep.stdio.curr_line++; +#endif + sc->nesting_stack[sc->file_i]--; + s_return(sc,reverse_in_place(sc, sc->NIL, sc->args)); + } else if (sc->tok == TOK_DOT) { + s_save(sc,OP_RDDOT, sc->args, sc->NIL); + sc->tok = token(sc); + s_goto(sc,OP_RDSEXPR); + } else { + s_save(sc,OP_RDLIST, sc->args, sc->NIL);; + s_goto(sc,OP_RDSEXPR); + } + } + + case OP_RDDOT: + if (token(sc) != TOK_RPAREN) { + Error_0(sc,"syntax error: illegal dot expression"); + } else { + sc->nesting_stack[sc->file_i]--; + s_return(sc,reverse_in_place(sc, sc->value, sc->args)); + } + + case OP_RDQUOTE: + s_return(sc,cons(sc, sc->QUOTE, cons(sc, sc->value, sc->NIL))); + + case OP_RDQQUOTE: + s_return(sc,cons(sc, sc->QQUOTE, cons(sc, sc->value, sc->NIL))); + + case OP_RDQQUOTEVEC: + s_return(sc,cons(sc, mk_symbol(sc,"apply"), + cons(sc, mk_symbol(sc,"vector"), + cons(sc,cons(sc, sc->QQUOTE, + cons(sc,sc->value,sc->NIL)), + sc->NIL)))); + + case OP_RDUNQUOTE: + s_return(sc,cons(sc, sc->UNQUOTE, cons(sc, sc->value, sc->NIL))); + + case OP_RDUQTSP: + s_return(sc,cons(sc, sc->UNQUOTESP, cons(sc, sc->value, sc->NIL))); + + case OP_RDVEC: + /*sc->code=cons(sc,mk_proc(sc,OP_VECTOR),sc->value); + s_goto(sc,OP_EVAL); Cannot be quoted*/ + /*x=cons(sc,mk_proc(sc,OP_VECTOR),sc->value); + s_return(sc,x); Cannot be part of pairs*/ + /*sc->code=mk_proc(sc,OP_VECTOR); + sc->args=sc->value; + s_goto(sc,OP_APPLY);*/ + sc->args=sc->value; + s_goto(sc,OP_VECTOR); + + /* ========== printing part ========== */ + case OP_P0LIST: + if(is_vector(sc->args)) { + putstr(sc,"#("); + sc->args=cons(sc,sc->args,mk_integer(sc,0)); + s_goto(sc,OP_PVECFROM); + } else if(is_environment(sc->args)) { + putstr(sc,"#"); + s_return(sc,sc->T); + } else if (!is_pair(sc->args)) { + printatom(sc, sc->args, sc->print_flag); + s_return(sc,sc->T); + } else if (car(sc->args) == sc->QUOTE && ok_abbrev(cdr(sc->args))) { + putstr(sc, "'"); + sc->args = cadr(sc->args); + s_goto(sc,OP_P0LIST); + } else if (car(sc->args) == sc->QQUOTE && ok_abbrev(cdr(sc->args))) { + putstr(sc, "`"); + sc->args = cadr(sc->args); + s_goto(sc,OP_P0LIST); + } else if (car(sc->args) == sc->UNQUOTE && ok_abbrev(cdr(sc->args))) { + putstr(sc, ","); + sc->args = cadr(sc->args); + s_goto(sc,OP_P0LIST); + } else if (car(sc->args) == sc->UNQUOTESP && ok_abbrev(cdr(sc->args))) { + putstr(sc, ",@"); + sc->args = cadr(sc->args); + s_goto(sc,OP_P0LIST); + } else { + putstr(sc, "("); + s_save(sc,OP_P1LIST, cdr(sc->args), sc->NIL); + sc->args = car(sc->args); + s_goto(sc,OP_P0LIST); + } + + case OP_P1LIST: + if (is_pair(sc->args)) { + s_save(sc,OP_P1LIST, cdr(sc->args), sc->NIL); + putstr(sc, " "); + sc->args = car(sc->args); + s_goto(sc,OP_P0LIST); + } else if(is_vector(sc->args)) { + s_save(sc,OP_P1LIST,sc->NIL,sc->NIL); + putstr(sc, " . "); + s_goto(sc,OP_P0LIST); + } else { + if (sc->args != sc->NIL) { + putstr(sc, " . "); + printatom(sc, sc->args, sc->print_flag); + } + putstr(sc, ")"); + s_return(sc,sc->T); + } + case OP_PVECFROM: { + int i=ivalue_unchecked(cdr(sc->args)); + pointer vec=car(sc->args); + int len=ivalue_unchecked(vec); + if(i==len) { + putstr(sc,")"); + s_return(sc,sc->T); + } else { + pointer elem=vector_elem(vec,i); + ivalue_unchecked(cdr(sc->args))=i+1; + s_save(sc,OP_PVECFROM, sc->args, sc->NIL); + sc->args=elem; + if (i > 0) + putstr(sc," "); + s_goto(sc,OP_P0LIST); + } + } + + default: + snprintf(sc->strbuff,STRBUFFSIZE,"%d: illegal operator", sc->op); + Error_0(sc,sc->strbuff); + + } + return sc->T; +} + +static pointer opexe_6(scheme *sc, enum scheme_opcodes op) { + pointer x, y; + long v; + + switch (op) { + case OP_LIST_LENGTH: /* length */ /* a.k */ + v=list_length(sc,car(sc->args)); + if(v<0) { + Error_1(sc,"length: not a list:",car(sc->args)); + } + s_return(sc,mk_integer(sc, v)); + + case OP_ASSQ: /* assq */ /* a.k */ + x = car(sc->args); + for (y = cadr(sc->args); is_pair(y); y = cdr(y)) { + if (!is_pair(car(y))) { + Error_0(sc,"unable to handle non pair element"); + } + if (x == caar(y)) + break; + } + if (is_pair(y)) { + s_return(sc,car(y)); + } else { + s_return(sc,sc->F); + } + + + case OP_GET_CLOSURE: /* get-closure-code */ /* a.k */ + sc->args = car(sc->args); + if (sc->args == sc->NIL) { + s_return(sc,sc->F); + } else if (is_closure(sc->args)) { + s_return(sc,cons(sc, sc->LAMBDA, closure_code(sc->value))); + } else if (is_macro(sc->args)) { + s_return(sc,cons(sc, sc->LAMBDA, closure_code(sc->value))); + } else { + s_return(sc,sc->F); + } + case OP_CLOSUREP: /* closure? */ + /* + * Note, macro object is also a closure. + * Therefore, (closure? <#MACRO>) ==> #t + */ + s_retbool(is_closure(car(sc->args))); + case OP_MACROP: /* macro? */ + s_retbool(is_macro(car(sc->args))); + default: + snprintf(sc->strbuff,STRBUFFSIZE,"%d: illegal operator", sc->op); + Error_0(sc,sc->strbuff); + } + return sc->T; /* NOTREACHED */ +} + +typedef pointer (*dispatch_func)(scheme *, enum scheme_opcodes); + +typedef int (*test_predicate)(pointer); + +static int is_any(pointer p) { + (void)p; + return 1; +} + +static int is_nonneg(pointer p) { + return ivalue(p)>=0 && is_integer(p); +} + +/* Correspond carefully with following defines! */ +static struct { + test_predicate fct; + const char *kind; +} tests[]={ + {0,0}, /* unused */ + {is_any, 0}, + {is_string, "string"}, + {is_symbol, "symbol"}, + {is_port, "port"}, + {is_inport,"input port"}, + {is_outport,"output port"}, + {is_environment, "environment"}, + {is_pair, "pair"}, + {0, "pair or '()"}, + {is_character, "character"}, + {is_vector, "vector"}, + {is_number, "number"}, + {is_integer, "integer"}, + {is_nonneg, "non-negative integer"} +}; + +#define TST_NONE 0 +#define TST_ANY "\001" +#define TST_STRING "\002" +#define TST_SYMBOL "\003" +#define TST_PORT "\004" +#define TST_INPORT "\005" +#define TST_OUTPORT "\006" +#define TST_ENVIRONMENT "\007" +#define TST_PAIR "\010" +#define TST_LIST "\011" +#define TST_CHAR "\012" +#define TST_VECTOR "\013" +#define TST_NUMBER "\014" +#define TST_INTEGER "\015" +#define TST_NATURAL "\016" + +typedef struct { + dispatch_func func; + char *name; + int min_arity; + int max_arity; + char *arg_tests_encoding; +} op_code_info; + +#define INF_ARG 0xffff + +static op_code_info dispatch_table[]= { +#define _OP_DEF(A,B,C,D,E,OP) {A,B,C,D,E}, +#include "opdefines.h" + { 0 } +}; + +static const char *procname(pointer x) { + int n=procnum(x); + const char *name=dispatch_table[n].name; + if(name==0) { + name="ILLEGAL!"; + } + return name; +} + +/* kernel of this interpreter */ +static void Eval_Cycle(scheme *sc, enum scheme_opcodes op) { + sc->op = op; + for (;;) { + op_code_info *pcd=dispatch_table+sc->op; + if (pcd->name!=0) { /* if built-in function, check arguments */ + char msg[STRBUFFSIZE]; + int ok=1; + int n=list_length(sc,sc->args); + + /* Check number of arguments */ + if(nmin_arity) { + ok=0; + snprintf(msg, STRBUFFSIZE, "%s: needs%s %d argument(s)", + pcd->name, + pcd->min_arity==pcd->max_arity?"":" at least", + pcd->min_arity); + } + if(ok && n>pcd->max_arity) { + ok=0; + snprintf(msg, STRBUFFSIZE, "%s: needs%s %d argument(s)", + pcd->name, + pcd->min_arity==pcd->max_arity?"":" at most", + pcd->max_arity); + } + if(ok) { + if(pcd->arg_tests_encoding!=0) { + int i=0; + int j; + const char *t=pcd->arg_tests_encoding; + pointer arglist=sc->args; + do { + pointer arg=car(arglist); + j=(int)t[0]; + if(j==TST_LIST[0]) { + if(arg!=sc->NIL && !is_pair(arg)) break; + } else { + if(!tests[j].fct(arg)) break; + } + + if(t[1]!=0) {/* last test is replicated as necessary */ + t++; + } + arglist=cdr(arglist); + i++; + } while(iname, + i+1, + tests[j].kind, + type_to_string(type(car(arglist)))); + } + } + } + if(!ok) { + if(_Error_1(sc,msg,0)==sc->NIL) { + return; + } + pcd=dispatch_table+sc->op; + } + } + ok_to_freely_gc(sc); + if (pcd->func(sc, (enum scheme_opcodes)sc->op) == sc->NIL) { + return; + } + if(sc->no_memory) { + fprintf(stderr,"No memory!\n"); + exit(1); + } + } +} + +/* ========== Initialization of internal keywords ========== */ + +static void assign_syntax(scheme *sc, char *name) { + pointer x; + + x = oblist_add_by_name(sc, name); + typeflag(x) |= T_SYNTAX; +} + +static void assign_proc(scheme *sc, enum scheme_opcodes op, char *name) { + pointer x, y; + + x = mk_symbol(sc, name); + y = mk_proc(sc,op); + new_slot_in_env(sc, x, y); +} + +static pointer mk_proc(scheme *sc, enum scheme_opcodes op) { + pointer y; + + y = get_cell(sc, sc->NIL, sc->NIL); + typeflag(y) = (T_PROC | T_ATOM); + ivalue_unchecked(y) = (long) op; + set_num_integer(y); + return y; +} + +/* Hard-coded for the given keywords. Remember to rewrite if more are added! */ +static int syntaxnum(pointer p) { + const char *s=strvalue(car(p)); + switch(strlength(car(p))) { + case 2: + if(s[0]=='i') return OP_IF0; /* if */ + else return OP_OR0; /* or */ + case 3: + if(s[0]=='a') return OP_AND0; /* and */ + else return OP_LET0; /* let */ + case 4: + switch(s[3]) { + case 'e': return OP_CASE0; /* case */ + case 'd': return OP_COND0; /* cond */ + case '*': return OP_LET0AST; /* let* */ + default: return OP_SET0; /* set! */ + } + case 5: + switch(s[2]) { + case 'g': return OP_BEGIN; /* begin */ + case 'l': return OP_DELAY; /* delay */ + case 'c': return OP_MACRO0; /* macro */ + default: return OP_QUOTE; /* quote */ + } + case 6: + switch(s[2]) { + case 'm': return OP_LAMBDA; /* lambda */ + case 'f': return OP_DEF0; /* define */ + default: return OP_LET0REC; /* letrec */ + } + default: + return OP_C0STREAM; /* cons-stream */ + } +} + +/* initialization of TinyScheme */ +#if USE_INTERFACE +INTERFACE static pointer s_cons(scheme *sc, pointer a, pointer b) { + return cons(sc,a,b); +} +INTERFACE static pointer s_immutable_cons(scheme *sc, pointer a, pointer b) { + return immutable_cons(sc,a,b); +} + +static struct scheme_interface vtbl ={ + scheme_define, + s_cons, + s_immutable_cons, + reserve_cells, + mk_integer, + mk_real, + mk_symbol, + gensym, + mk_string, + mk_counted_string, + mk_character, + mk_vector, + mk_foreign_func, + mk_foreign_object, + get_foreign_object_vtable, + get_foreign_object_data, + putstr, + putcharacter, + + is_string, + string_value, + is_number, + nvalue, + ivalue, + rvalue, + is_integer, + is_real, + is_character, + charvalue, + is_list, + is_vector, + list_length, + ivalue, + fill_vector, + vector_elem, + set_vector_elem, + is_port, + is_pair, + pair_car, + pair_cdr, + set_car, + set_cdr, + + is_symbol, + symname, + + is_syntax, + is_proc, + is_foreign, + syntaxname, + is_closure, + is_macro, + closure_code, + closure_env, + + is_continuation, + is_promise, + is_environment, + is_immutable, + setimmutable, + + scheme_load_file, + scheme_load_string, + port_from_file +}; +#endif + +scheme *scheme_init_new() { + scheme *sc=(scheme*)malloc(sizeof(scheme)); + if(!scheme_init(sc)) { + free(sc); + return 0; + } else { + return sc; + } +} + +scheme *scheme_init_new_custom_alloc(func_alloc malloc, func_dealloc free) { + scheme *sc=(scheme*)malloc(sizeof(scheme)); + if(!scheme_init_custom_alloc(sc,malloc,free)) { + free(sc); + return 0; + } else { + return sc; + } +} + + +int scheme_init(scheme *sc) { + return scheme_init_custom_alloc(sc,malloc,free); +} + +int scheme_init_custom_alloc(scheme *sc, func_alloc malloc, func_dealloc free) { + int i, n=sizeof(dispatch_table)/sizeof(dispatch_table[0]); + pointer x; + + num_zero.is_fixnum=1; + num_zero.value.ivalue=0; + num_one.is_fixnum=1; + num_one.value.ivalue=1; + +#if USE_INTERFACE + sc->vptr=&vtbl; +#endif + sc->gensym_cnt=0; + sc->malloc=malloc; + sc->free=free; + sc->last_cell_seg = -1; + sc->sink = &sc->_sink; + sc->NIL = &sc->_NIL; + sc->T = &sc->_HASHT; + sc->F = &sc->_HASHF; + sc->EOF_OBJ=&sc->_EOF_OBJ; + sc->free_cell = &sc->_NIL; + sc->fcells = 0; + sc->no_memory=0; + sc->inport=sc->NIL; + sc->outport=sc->NIL; + sc->save_inport=sc->NIL; + sc->loadport=sc->NIL; + sc->nesting=0; + sc->interactive_repl=0; + sc->strbuff = sc->malloc(STRBUFFSIZE); + if (sc->strbuff == 0) { + sc->no_memory=1; + return 0; + } + sc->strbuff_size = STRBUFFSIZE; + + if (alloc_cellseg(sc,FIRST_CELLSEGS) != FIRST_CELLSEGS) { + sc->no_memory=1; + return 0; + } + sc->gc_verbose = 0; + dump_stack_initialize(sc); + sc->code = sc->NIL; + sc->tracing=0; + + /* init sc->NIL */ + typeflag(sc->NIL) = (T_NIL | T_ATOM | MARK); + car(sc->NIL) = cdr(sc->NIL) = sc->NIL; + /* init T */ + typeflag(sc->T) = (T_BOOLEAN | T_ATOM | MARK); + car(sc->T) = cdr(sc->T) = sc->T; + /* init F */ + typeflag(sc->F) = (T_BOOLEAN | T_ATOM | MARK); + car(sc->F) = cdr(sc->F) = sc->F; + /* init EOF_OBJ */ + typeflag(sc->EOF_OBJ) = (T_EOF_OBJ | T_ATOM | MARK); + car(sc->EOF_OBJ) = cdr(sc->EOF_OBJ) = sc->EOF_OBJ; + /* init sink */ + typeflag(sc->sink) = (T_SINK | T_PAIR | MARK); + car(sc->sink) = sc->NIL; + /* init c_nest */ + sc->c_nest = sc->NIL; + + sc->oblist = oblist_initial_value(sc); + /* init global_env */ + new_frame_in_env(sc, sc->NIL); + sc->global_env = sc->envir; + /* init else */ + x = mk_symbol(sc,"else"); + new_slot_in_env(sc, x, sc->T); + + assign_syntax(sc, "lambda"); + assign_syntax(sc, "quote"); + assign_syntax(sc, "define"); + assign_syntax(sc, "if"); + assign_syntax(sc, "begin"); + assign_syntax(sc, "set!"); + assign_syntax(sc, "let"); + assign_syntax(sc, "let*"); + assign_syntax(sc, "letrec"); + assign_syntax(sc, "cond"); + assign_syntax(sc, "delay"); + assign_syntax(sc, "and"); + assign_syntax(sc, "or"); + assign_syntax(sc, "cons-stream"); + assign_syntax(sc, "macro"); + assign_syntax(sc, "case"); + + for(i=0; iLAMBDA = mk_symbol(sc, "lambda"); + sc->QUOTE = mk_symbol(sc, "quote"); + sc->QQUOTE = mk_symbol(sc, "quasiquote"); + sc->UNQUOTE = mk_symbol(sc, "unquote"); + sc->UNQUOTESP = mk_symbol(sc, "unquote-splicing"); + sc->FEED_TO = mk_symbol(sc, "=>"); + sc->COLON_HOOK = mk_symbol(sc,"*colon-hook*"); + sc->ERROR_HOOK = mk_symbol(sc, "*error-hook*"); + sc->SHARP_HOOK = mk_symbol(sc, "*sharp-hook*"); + sc->COMPILE_HOOK = mk_symbol(sc, "*compile-hook*"); + + return !sc->no_memory; +} + +void scheme_set_input_port_file(scheme *sc, FILE *fin) { + sc->inport=port_from_file(sc,fin,port_input); +} + +void scheme_set_input_port_string(scheme *sc, char *start, char *past_the_end) { + sc->inport=port_from_string(sc,start,past_the_end,port_input); +} + +void scheme_set_output_port_file(scheme *sc, FILE *fout) { + sc->outport=port_from_file(sc,fout,port_output); +} + +void scheme_set_output_port_string(scheme *sc, char *start, char *past_the_end) { + sc->outport=port_from_string(sc,start,past_the_end,port_output); +} + +void scheme_set_external_data(scheme *sc, void *p) { + sc->ext_data=p; +} + +void scheme_deinit(scheme *sc) { + int i; + +#if SHOW_ERROR_LINE + char *fname; +#endif + + sc->oblist=sc->NIL; + sc->global_env=sc->NIL; + dump_stack_free(sc); + sc->envir=sc->NIL; + sc->code=sc->NIL; + sc->args=sc->NIL; + sc->value=sc->NIL; + if(is_port(sc->inport)) { + typeflag(sc->inport) = T_ATOM; + } + sc->inport=sc->NIL; + sc->outport=sc->NIL; + if(is_port(sc->save_inport)) { + typeflag(sc->save_inport) = T_ATOM; + } + sc->save_inport=sc->NIL; + if(is_port(sc->loadport)) { + typeflag(sc->loadport) = T_ATOM; + } + sc->loadport=sc->NIL; + sc->gc_verbose=0; + gc(sc,sc->NIL,sc->NIL); + + for(i=0; i<=sc->last_cell_seg; i++) { + sc->free(sc->alloc_seg[i]); + } + sc->free(sc->strbuff); + +#if SHOW_ERROR_LINE + for(i=0; i<=sc->file_i; i++) { + if (sc->load_stack[i].kind & port_file) { + fname = sc->load_stack[i].rep.stdio.filename; + if(fname) + sc->free(fname); + } + } +#endif +} + +void scheme_load_file(scheme *sc, FILE *fin) +{ scheme_load_named_file(sc,fin,0); } + +void scheme_load_named_file(scheme *sc, FILE *fin, const char *filename) { + dump_stack_reset(sc); + sc->envir = sc->global_env; + sc->file_i=0; + sc->load_stack[0].kind=port_input|port_file; + sc->load_stack[0].rep.stdio.file=fin; + sc->loadport=mk_port(sc,sc->load_stack); + sc->retcode=0; + if(fin==stdin) { + sc->interactive_repl=1; + } + +#if SHOW_ERROR_LINE + sc->load_stack[0].rep.stdio.curr_line = 0; + if(fin!=stdin && filename) + sc->load_stack[0].rep.stdio.filename = store_string(sc, strlen(filename), filename, 0); + else + sc->load_stack[0].rep.stdio.filename = NULL; +#endif + + sc->inport=sc->loadport; + sc->args = mk_integer(sc,sc->file_i); + Eval_Cycle(sc, OP_T0LVL); + typeflag(sc->loadport)=T_ATOM; + if(sc->retcode==0) { + sc->retcode=sc->nesting!=0; + } + +#if SHOW_ERROR_LINE + sc->free(sc->load_stack[0].rep.stdio.filename); + sc->load_stack[0].rep.stdio.filename = NULL; +#endif +} + +void scheme_load_string(scheme *sc, const char *cmd) { + dump_stack_reset(sc); + sc->envir = sc->global_env; + sc->file_i=0; + sc->load_stack[0].kind=port_input|port_string; + sc->load_stack[0].rep.string.start=(char*)cmd; /* This func respects const */ + sc->load_stack[0].rep.string.past_the_end=(char*)cmd+strlen(cmd); + sc->load_stack[0].rep.string.curr=(char*)cmd; + sc->loadport=mk_port(sc,sc->load_stack); + sc->retcode=0; + sc->interactive_repl=0; + sc->inport=sc->loadport; + sc->args = mk_integer(sc,sc->file_i); + Eval_Cycle(sc, OP_T0LVL); + typeflag(sc->loadport)=T_ATOM; + if(sc->retcode==0) { + sc->retcode=sc->nesting!=0; + } +} + +void scheme_define(scheme *sc, pointer envir, pointer symbol, pointer value) { + pointer x; + + x=find_slot_in_env(sc,envir,symbol,0); + if (x != sc->NIL) { + set_slot_in_env(sc, x, value); + } else { + new_slot_spec_in_env(sc, envir, symbol, value); + } +} + +#if !STANDALONE +void scheme_register_foreign_func(scheme * sc, scheme_registerable * sr) +{ + scheme_define(sc, + sc->global_env, + mk_symbol(sc,sr->name), + mk_foreign_func(sc, sr->f)); +} + +void scheme_register_foreign_func_list(scheme * sc, + scheme_registerable * list, + int count) +{ + int i; + for(i = 0; i < count; i++) + { + scheme_register_foreign_func(sc, list + i); + } +} + +pointer scheme_apply0(scheme *sc, const char *procname) +{ return scheme_eval(sc, cons(sc,mk_symbol(sc,procname),sc->NIL)); } + +void save_from_C_call(scheme *sc) +{ + pointer saved_data = + cons(sc, + car(sc->sink), + cons(sc, + sc->envir, + sc->dump)); + /* Push */ + sc->c_nest = cons(sc, saved_data, sc->c_nest); + /* Truncate the dump stack so TS will return here when done, not + directly resume pre-C-call operations. */ + dump_stack_reset(sc); +} +void restore_from_C_call(scheme *sc) +{ + car(sc->sink) = caar(sc->c_nest); + sc->envir = cadar(sc->c_nest); + sc->dump = cdr(cdar(sc->c_nest)); + /* Pop */ + sc->c_nest = cdr(sc->c_nest); +} + +/* "func" and "args" are assumed to be already eval'ed. */ +pointer scheme_call(scheme *sc, pointer func, pointer args) +{ + int old_repl = sc->interactive_repl; + sc->interactive_repl = 0; + save_from_C_call(sc); + sc->envir = sc->global_env; + sc->args = args; + sc->code = func; + sc->retcode = 0; + Eval_Cycle(sc, OP_APPLY); + sc->interactive_repl = old_repl; + restore_from_C_call(sc); + return sc->value; +} + +pointer scheme_eval(scheme *sc, pointer obj) +{ + int old_repl = sc->interactive_repl; + sc->interactive_repl = 0; + save_from_C_call(sc); + sc->args = sc->NIL; + sc->code = obj; + sc->retcode = 0; + Eval_Cycle(sc, OP_EVAL); + sc->interactive_repl = old_repl; + restore_from_C_call(sc); + return sc->value; +} + + +#endif + +/* ========== Main ========== */ + +#if STANDALONE + +#if defined(__APPLE__) && !defined (OSX) +int main() +{ + extern MacTS_main(int argc, char **argv); + char** argv; + int argc = ccommand(&argv); + MacTS_main(argc,argv); + return 0; +} +int MacTS_main(int argc, char **argv) { +#else +int main(int argc, char **argv) { +#endif + scheme sc; + FILE *fin; + char *file_name=InitFile; + int retcode; + int isfile=1; + + if(argc==1) { + printf(banner); + } + if(argc==2 && strcmp(argv[1],"-?")==0) { + printf("Usage: tinyscheme -?\n"); + printf("or: tinyscheme [ ...]\n"); + printf("followed by\n"); + printf(" -1 [ ...]\n"); + printf(" -c [ ...]\n"); + printf("assuming that the executable is named tinyscheme.\n"); + printf("Use - as filename for stdin.\n"); + return 1; + } + if(!scheme_init(&sc)) { + fprintf(stderr,"Could not initialize!\n"); + return 2; + } + scheme_set_input_port_file(&sc, stdin); + scheme_set_output_port_file(&sc, stdout); +#if USE_DL + scheme_define(&sc,sc.global_env,mk_symbol(&sc,"load-extension"),mk_foreign_func(&sc, scm_load_ext)); +#endif + argv++; + if(access(file_name,0)!=0) { + char *p=getenv("TINYSCHEMEINIT"); + if(p!=0) { + file_name=p; + } + } + do { + if(strcmp(file_name,"-")==0) { + fin=stdin; + } else if(strcmp(file_name,"-1")==0 || strcmp(file_name,"-c")==0) { + pointer args=sc.NIL; + isfile=file_name[1]=='1'; + file_name=*argv++; + if(strcmp(file_name,"-")==0) { + fin=stdin; + } else if(isfile) { + fin=fopen(file_name,"r"); + } + for(;*argv;argv++) { + pointer value=mk_string(&sc,*argv); + args=cons(&sc,value,args); + } + args=reverse_in_place(&sc,sc.NIL,args); + scheme_define(&sc,sc.global_env,mk_symbol(&sc,"*args*"),args); + + } else { + fin=fopen(file_name,"r"); + } + if(isfile && fin==0) { + fprintf(stderr,"Could not open file %s\n",file_name); + } else { + if(isfile) { + scheme_load_named_file(&sc,fin,file_name); + } else { + scheme_load_string(&sc,file_name); + } + if(!isfile || fin!=stdin) { + if(sc.retcode!=0) { + fprintf(stderr,"Errors encountered reading %s\n",file_name); + } + if(isfile) { + fclose(fin); + } + } + } + file_name=*argv++; + } while(file_name!=0); + if(argc==1) { + scheme_load_named_file(&sc,stdin,0); + } + retcode=sc.retcode; + scheme_deinit(&sc); + + return retcode; +} + +#endif + +/* +Local variables: +c-file-style: "k&r" +End: +*/ diff --git a/tests/gpgscm/scheme.h b/tests/gpgscm/scheme.h new file mode 100644 index 000000000..f4231c474 --- /dev/null +++ b/tests/gpgscm/scheme.h @@ -0,0 +1,266 @@ +/* SCHEME.H */ + +#ifndef _SCHEME_H +#define _SCHEME_H + +#include + +#ifdef __cplusplus +extern "C" { +#endif + +/* + * Default values for #define'd symbols + */ +#ifndef STANDALONE /* If used as standalone interpreter */ +# define STANDALONE 1 +#endif + +#ifndef _MSC_VER +# define USE_STRCASECMP 1 +# ifndef USE_STRLWR +# define USE_STRLWR 1 +# endif +# define SCHEME_EXPORT +#else +# define USE_STRCASECMP 0 +# define USE_STRLWR 0 +# ifdef _SCHEME_SOURCE +# define SCHEME_EXPORT __declspec(dllexport) +# else +# define SCHEME_EXPORT __declspec(dllimport) +# endif +#endif + +#if USE_NO_FEATURES +# define USE_MATH 0 +# define USE_CHAR_CLASSIFIERS 0 +# define USE_ASCII_NAMES 0 +# define USE_STRING_PORTS 0 +# define USE_ERROR_HOOK 0 +# define USE_TRACING 0 +# define USE_COLON_HOOK 0 +# define USE_DL 0 +# define USE_PLIST 0 +#endif + +/* + * Leave it defined if you want continuations, and also for the Sharp Zaurus. + * Undefine it if you only care about faster speed and not strict Scheme compatibility. + */ +#define USE_SCHEME_STACK + +#if USE_DL +# define USE_INTERFACE 1 +#endif + + +#ifndef USE_MATH /* If math support is needed */ +# define USE_MATH 1 +#endif + +#ifndef USE_CHAR_CLASSIFIERS /* If char classifiers are needed */ +# define USE_CHAR_CLASSIFIERS 1 +#endif + +#ifndef USE_ASCII_NAMES /* If extended escaped characters are needed */ +# define USE_ASCII_NAMES 1 +#endif + +#ifndef USE_STRING_PORTS /* Enable string ports */ +# define USE_STRING_PORTS 1 +#endif + +#ifndef USE_TRACING +# define USE_TRACING 1 +#endif + +#ifndef USE_PLIST +# define USE_PLIST 0 +#endif + +/* To force system errors through user-defined error handling (see *error-hook*) */ +#ifndef USE_ERROR_HOOK +# define USE_ERROR_HOOK 1 +#endif + +#ifndef USE_COLON_HOOK /* Enable qualified qualifier */ +# define USE_COLON_HOOK 1 +#endif + +#ifndef USE_STRCASECMP /* stricmp for Unix */ +# define USE_STRCASECMP 0 +#endif + +#ifndef USE_STRLWR +# define USE_STRLWR 1 +#endif + +#ifndef STDIO_ADDS_CR /* Define if DOS/Windows */ +# define STDIO_ADDS_CR 0 +#endif + +#ifndef INLINE +# define INLINE +#endif + +#ifndef USE_INTERFACE +# define USE_INTERFACE 0 +#endif + +#ifndef SHOW_ERROR_LINE /* Show error line in file */ +# define SHOW_ERROR_LINE 1 +#endif + +typedef struct scheme scheme; +typedef struct cell *pointer; + +typedef void * (*func_alloc)(size_t); +typedef void (*func_dealloc)(void *); + +/* table of functions required for foreign objects */ +typedef struct foreign_object_vtable { + void (*finalize)(scheme *sc, void *data); + void (*to_string)(scheme *sc, char *out, size_t size, void *data); +} foreign_object_vtable; + +/* num, for generic arithmetic */ +typedef struct num { + char is_fixnum; + union { + long ivalue; + double rvalue; + } value; +} num; + +SCHEME_EXPORT scheme *scheme_init_new(void); +SCHEME_EXPORT scheme *scheme_init_new_custom_alloc(func_alloc malloc, func_dealloc free); +SCHEME_EXPORT int scheme_init(scheme *sc); +SCHEME_EXPORT int scheme_init_custom_alloc(scheme *sc, func_alloc, func_dealloc); +SCHEME_EXPORT void scheme_deinit(scheme *sc); +void scheme_set_input_port_file(scheme *sc, FILE *fin); +void scheme_set_input_port_string(scheme *sc, char *start, char *past_the_end); +SCHEME_EXPORT void scheme_set_output_port_file(scheme *sc, FILE *fin); +void scheme_set_output_port_string(scheme *sc, char *start, char *past_the_end); +SCHEME_EXPORT void scheme_load_file(scheme *sc, FILE *fin); +SCHEME_EXPORT void scheme_load_named_file(scheme *sc, FILE *fin, const char *filename); +SCHEME_EXPORT void scheme_load_string(scheme *sc, const char *cmd); +SCHEME_EXPORT pointer scheme_apply0(scheme *sc, const char *procname); +SCHEME_EXPORT pointer scheme_call(scheme *sc, pointer func, pointer args); +SCHEME_EXPORT pointer scheme_eval(scheme *sc, pointer obj); +void scheme_set_external_data(scheme *sc, void *p); +SCHEME_EXPORT void scheme_define(scheme *sc, pointer env, pointer symbol, pointer value); + +typedef pointer (*foreign_func)(scheme *, pointer); + +pointer _cons(scheme *sc, pointer a, pointer b, int immutable); +pointer mk_integer(scheme *sc, long num); +pointer mk_real(scheme *sc, double num); +pointer mk_symbol(scheme *sc, const char *name); +pointer gensym(scheme *sc); +pointer mk_string(scheme *sc, const char *str); +pointer mk_counted_string(scheme *sc, const char *str, int len); +pointer mk_empty_string(scheme *sc, int len, char fill); +pointer mk_character(scheme *sc, int c); +pointer mk_foreign_func(scheme *sc, foreign_func f); +pointer mk_foreign_object(scheme *sc, const foreign_object_vtable *vtable, void *data); +void putstr(scheme *sc, const char *s); +int list_length(scheme *sc, pointer a); +int eqv(pointer a, pointer b); + + +#if USE_INTERFACE +struct scheme_interface { + void (*scheme_define)(scheme *sc, pointer env, pointer symbol, pointer value); + pointer (*cons)(scheme *sc, pointer a, pointer b); + pointer (*immutable_cons)(scheme *sc, pointer a, pointer b); + pointer (*reserve_cells)(scheme *sc, int n); + pointer (*mk_integer)(scheme *sc, long num); + pointer (*mk_real)(scheme *sc, double num); + pointer (*mk_symbol)(scheme *sc, const char *name); + pointer (*gensym)(scheme *sc); + pointer (*mk_string)(scheme *sc, const char *str); + pointer (*mk_counted_string)(scheme *sc, const char *str, int len); + pointer (*mk_character)(scheme *sc, int c); + pointer (*mk_vector)(scheme *sc, int len); + pointer (*mk_foreign_func)(scheme *sc, foreign_func f); + pointer (*mk_foreign_object)(scheme *sc, const foreign_object_vtable *vtable, void *data); + const foreign_object_vtable *(*get_foreign_object_vtable)(pointer p); + void *(*get_foreign_object_data)(pointer p); + void (*putstr)(scheme *sc, const char *s); + void (*putcharacter)(scheme *sc, int c); + + int (*is_string)(pointer p); + char *(*string_value)(pointer p); + int (*is_number)(pointer p); + num (*nvalue)(pointer p); + long (*ivalue)(pointer p); + double (*rvalue)(pointer p); + int (*is_integer)(pointer p); + int (*is_real)(pointer p); + int (*is_character)(pointer p); + long (*charvalue)(pointer p); + int (*is_list)(scheme *sc, pointer p); + int (*is_vector)(pointer p); + int (*list_length)(scheme *sc, pointer vec); + long (*vector_length)(pointer vec); + void (*fill_vector)(pointer vec, pointer elem); + pointer (*vector_elem)(pointer vec, int ielem); + pointer (*set_vector_elem)(pointer vec, int ielem, pointer newel); + int (*is_port)(pointer p); + + int (*is_pair)(pointer p); + pointer (*pair_car)(pointer p); + pointer (*pair_cdr)(pointer p); + pointer (*set_car)(pointer p, pointer q); + pointer (*set_cdr)(pointer p, pointer q); + + int (*is_symbol)(pointer p); + char *(*symname)(pointer p); + + int (*is_syntax)(pointer p); + int (*is_proc)(pointer p); + int (*is_foreign)(pointer p); + char *(*syntaxname)(pointer p); + int (*is_closure)(pointer p); + int (*is_macro)(pointer p); + pointer (*closure_code)(pointer p); + pointer (*closure_env)(pointer p); + + int (*is_continuation)(pointer p); + int (*is_promise)(pointer p); + int (*is_environment)(pointer p); + int (*is_immutable)(pointer p); + void (*setimmutable)(pointer p); + void (*load_file)(scheme *sc, FILE *fin); + void (*load_string)(scheme *sc, const char *input); + pointer (*mk_port_from_file)(scheme *sc, FILE *f, int kind); +}; +#endif + +#if !STANDALONE +typedef struct scheme_registerable +{ + foreign_func f; + const char * name; +} +scheme_registerable; + +void scheme_register_foreign_func_list(scheme * sc, + scheme_registerable * list, + int n); + +#endif /* !STANDALONE */ + +#ifdef __cplusplus +} +#endif + +#endif + + +/* +Local variables: +c-file-style: "k&r" +End: +*/ diff --git a/tests/gpgscm/t-child.c b/tests/gpgscm/t-child.c new file mode 100644 index 000000000..fe2e7b407 --- /dev/null +++ b/tests/gpgscm/t-child.c @@ -0,0 +1,66 @@ +/* Sanity check for the process and IPC primitives. + * + * Copyright (C) 2016 g10 code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#include +#include +#include + +#ifdef _WIN32 +# include +# include +#endif + +int +main (int argc, char **argv) +{ +#if _WIN32 + if (! setmode (stdin, O_BINARY)) + return 23; + if (! setmode (stdout, O_BINARY)) + return 23; +#endif + + if (argc == 1) + return 2; + else if (strcmp (argv[1], "return0") == 0) + return 0; + else if (strcmp (argv[1], "return1") == 0) + return 1; + else if (strcmp (argv[1], "return77") == 0) + return 77; + else if (strcmp (argv[1], "hello_stdout") == 0) + fprintf (stdout, "hello"); + else if (strcmp (argv[1], "hello_stderr") == 0) + fprintf (stderr, "hello"); + else if (strcmp (argv[1], "cat") == 0) + while (! feof (stdin)) + { + char buffer[4096]; + size_t bytes_read; + bytes_read = fread (buffer, 1, sizeof buffer, stdin); + fwrite (buffer, 1, bytes_read, stdout); + } + else + { + fprintf (stderr, "unknown command %s\n", argv[1]); + return 2; + } + return 0; +} diff --git a/tests/gpgscm/t-child.scm b/tests/gpgscm/t-child.scm new file mode 100644 index 000000000..27928f6d8 --- /dev/null +++ b/tests/gpgscm/t-child.scm @@ -0,0 +1,93 @@ +;; Tests for the low-level process and IPC primitives. +;; +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(echo "Testing process and IPC primitives...") + +(define (qualify executable) + (string-append executable (getenv "EXEEXT"))) + +(assert (= 0 (call `(,(qualify "t-child") "return0")))) +(assert (= 1 (call `(,(qualify "t-child") "return1")))) +(assert (= 77 (call `(,(qualify "t-child") "return77")))) + +(let ((r (call-with-io `(,(qualify "t-child") "return0") ""))) + (assert (= 0 (:retcode r))) + (assert (string=? "" (:stdout r))) + (assert (string=? "" (:stderr r)))) + +(let ((r (call-with-io `(,(qualify "t-child") "return1") ""))) + (assert (= 1 (:retcode r))) + (assert (string=? "" (:stdout r))) + (assert (string=? "" (:stderr r)))) + +(let ((r (call-with-io `(,(qualify "t-child") "return77") ""))) + (assert (= 77 (:retcode r))) + (assert (string=? "" (:stdout r))) + (assert (string=? "" (:stderr r)))) + +(let ((r (call-with-io `(,(qualify "t-child") "hello_stdout") ""))) + (assert (= 0 (:retcode r))) + (assert (string=? "hello" (:stdout r))) + (assert (string=? "" (:stderr r)))) + +(let ((r (call-with-io `(,(qualify "t-child") "hello_stderr") ""))) + (assert (= 0 (:retcode r))) + (assert (string=? "" (:stdout r))) + (assert (string=? "hello" (:stderr r)))) + +(let ((r (call-with-io `(,(qualify "t-child") "cat") "hellohello"))) + (assert (= 0 (:retcode r))) + (assert (string=? "hellohello" (:stdout r))) + (assert (string=? "" (:stderr r)))) + +(define (spawn what) + (spawn-process-fd what CLOSED_FD STDOUT_FILENO STDERR_FILENO)) + +(let ((pid0 (spawn `(,(qualify "t-child") "return0"))) + (pid1 (spawn `(,(qualify "t-child") "return0")))) + (assert (equal? '(0 0) + (wait-processes '("child0" "child1") (list pid0 pid1) #t)))) + +(let ((pid0 (spawn `(,(qualify "t-child") "return1"))) + (pid1 (spawn `(,(qualify "t-child") "return0")))) + (assert (equal? '(1 0) + (wait-processes '("child0" "child1") (list pid0 pid1) #t)))) + +(let ((pid0 (spawn `(,(qualify "t-child") "return0"))) + (pid1 (spawn `(,(qualify "t-child") "return77"))) + (pid2 (spawn `(,(qualify "t-child") "return1")))) + (assert (equal? '(0 77 1) + (wait-processes '("child0" "child1" "child2") + (list pid0 pid1 pid2) #t)))) + +(let* ((p (pipe)) + (pid0 (spawn-process-fd + `(,(qualify "t-child") "hello_stdout") + CLOSED_FD (:write-end p) STDERR_FILENO)) + (_ (close (:write-end p))) + (pid1 (spawn-process-fd + `(,(qualify "t-child") "cat") + (:read-end p) STDOUT_FILENO STDERR_FILENO))) + (close (:read-end p)) + (assert + (equal? '(0 0) + (wait-processes '("child0" "child1") (list pid0 pid1) #t)))) +(echo " world.") + +(echo "All good.") diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm new file mode 100644 index 000000000..c32e2fa5e --- /dev/null +++ b/tests/gpgscm/tests.scm @@ -0,0 +1,443 @@ +;; Common definitions for writing tests. +;; +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +;; Trace displays and returns the given value. A debugging aid. +(define (trace x) + (display x) + (newline) + x) + +;; Stringification. +(define (stringify expression) + (let ((p (open-output-string))) + (write expression p) + (get-output-string p))) + +;; Reporting. +(define (echo . msg) + (for-each (lambda (x) (display x) (display " ")) msg) + (newline)) + +(define (info . msg) + (apply echo msg) + (flush-stdio)) + +(define (error . msg) + (apply info msg) + (exit 1)) + +(define (skip . msg) + (apply info msg) + (exit 77)) + +(define (make-counter) + (let ((c 0)) + (lambda () + (let ((r c)) + (set! c (+ 1 c)) + r)))) + +(define *progress-nesting* 0) + +(define (call-with-progress msg what) + (set! *progress-nesting* (+ 1 *progress-nesting*)) + (if (= 1 *progress-nesting*) + (begin + (info msg) + (display " > ") + (flush-stdio) + (what (lambda (item) + (display item) + (display " ") + (flush-stdio))) + (info "< ")) + (begin + (what (lambda (item) (display ".") (flush-stdio))) + (display " ") + (flush-stdio))) + (set! *progress-nesting* (- *progress-nesting* 1))) + +(define (for-each-p msg proc lst) + (for-each-p' msg proc (lambda (x) x) lst)) + +(define (for-each-p' msg proc fmt lst) + (call-with-progress + msg + (lambda (progress) + (for-each (lambda (a) + (progress (fmt a)) + (proc a)) + lst)))) + +;; Process management. +(define CLOSED_FD -1) +(define (call-with-fds what infd outfd errfd) + (wait-process (stringify what) (spawn-process-fd what infd outfd errfd) #t)) +(define (call what) + (call-with-fds what + CLOSED_FD + (if (< *verbose* 0) STDOUT_FILENO CLOSED_FD) + (if (< *verbose* 0) STDERR_FILENO CLOSED_FD))) + +;; Accessor functions for the results of 'spawn-process'. +(define :stdin car) +(define :stdout cadr) +(define :stderr caddr) +(define :pid cadddr) + +(define (call-with-io what in) + (let ((h (spawn-process what 0))) + (es-write (:stdin h) in) + (es-fclose (:stdin h)) + (let* ((out (es-read-all (:stdout h))) + (err (es-read-all (:stderr h))) + (result (wait-process (car what) (:pid h) #t))) + (es-fclose (:stdout h)) + (es-fclose (:stderr h)) + (list result out err)))) + +;; Accessor function for the results of 'call-with-io'. ':stdout' and +;; ':stderr' can also be used. +(define :retcode car) + +(define (call-check what) + (let ((result (call-with-io what ""))) + (if (= 0 (:retcode result)) + (:stdout result) + (throw (list what "failed:" (:stderr result)))))) + +(define (call-popen command input-string) + (let ((result (call-with-io command input-string))) + (if (= 0 (:retcode result)) + (:stdout result) + (throw (:stderr result))))) + +;; +;; estream helpers. +;; + +(define (es-read-all stream) + (let loop + ((acc "")) + (if (es-feof stream) + acc + (loop (string-append acc (es-read stream 4096)))))) + +;; +;; File management. +;; +(define (file-exists? name) + (call-with-input-file name (lambda (port) #t))) + +(define (file=? a b) + (file-equal a b #t)) + +(define (text-file=? a b) + (file-equal a b #f)) + +(define (file-copy from to) + (catch '() (unlink to)) + (letfd ((source (open from (logior O_RDONLY O_BINARY))) + (sink (open to (logior O_WRONLY O_CREAT O_BINARY) #o600))) + (splice source sink))) + +(define (text-file-copy from to) + (catch '() (unlink to)) + (letfd ((source (open from O_RDONLY)) + (sink (open to (logior O_WRONLY O_CREAT) #o600))) + (splice source sink))) + +(define (path-join . components) + (let loop ((acc #f) (rest (filter (lambda (s) + (not (string=? "" s))) components))) + (if (null? rest) + acc + (loop (if (string? acc) + (string-append acc "/" (car rest)) + (car rest)) + (cdr rest))))) +(assert (string=? (path-join "foo" "bar" "baz") "foo/bar/baz")) +(assert (string=? (path-join "" "bar" "baz") "bar/baz")) + +(define (canonical-path path) + (if (char=? #\/ (string-ref path 0)) + path + (string-append (getcwd) "/" path))) + +(define (in-srcdir what) + (canonical-path (string-append (getenv "srcdir") "/" what))) + +(define (with-path name) + (let loop ((path (string-split (getenv "GPGSCM_PATH") #\:))) + (if (null? path) + name + (let* ((qualified-name (string-append (car path) "/" name)) + (file-exists (call-with-input-file qualified-name + (lambda (x) #t)))) + (if file-exists + qualified-name + (loop (cdr path))))))) + +(define (basename path) + (let ((i (string-index path #\/))) + (if (equal? i #f) + path + (basename (substring path (+ 1 i) (string-length path)))))) + +(define (basename-suffix path suffix) + (basename + (if (string-suffix? path suffix) + (substring path 0 (- (string-length path) (string-length suffix))) + path))) + +;; Helper for (pipe). +(define :read-end car) +(define :write-end cadr) + +;; let-like macro that manages file descriptors. +;; +;; (letfd ) +;; +;; Bind all variables given in and initialize each of them +;; to the given initial value, and close them after evaluting . +(macro (letfd form) + (let ((result-sym (gensym))) + `((lambda (,(caaadr form)) + (let ((,result-sym + ,(if (= 1 (length (cadr form))) + `(begin ,@(cddr form)) + `(letfd ,(cdadr form) ,@(cddr form))))) + (close ,(caaadr form)) + ,result-sym)) ,@(cdaadr form)))) + +(macro (with-working-directory form) + (let ((result-sym (gensym)) (cwd-sym (gensym))) + `(let* ((,cwd-sym (getcwd)) + (_ (if ,(cadr form) (chdir ,(cadr form)))) + (,result-sym (begin ,@(cddr form)))) + (chdir ,cwd-sym) + ,result-sym))) + +(macro (with-temporary-working-directory form) + (let ((result-sym (gensym)) (cwd-sym (gensym)) (tmp-sym (gensym))) + `(let* ((,cwd-sym (getcwd)) + (,tmp-sym (mkdtemp (path-join (getenv "TMP") "gpgscm-XXXXXX"))) + (_ (chdir ,tmp-sym)) + (,result-sym (begin ,@(cdr form)))) + (chdir ,cwd-sym) + (unlink-recursively ,tmp-sym) + ,result-sym))) + +(define (make-temporary-file . args) + (canonical-path (path-join + (mkdtemp (path-join (getenv "TMP") "gpgscm-XXXXXX")) + (if (null? args) "a" (car args))))) + +(define (remove-temporary-file filename) + (catch '() + (unlink filename)) + (let ((dirname (substring filename 0 (string-rindex filename #\/)))) + (catch (echo "removing temporary directory" dirname "failed") + (rmdir dirname)))) + +;; let-like macro that manages temporary files. +;; +;; (lettmp ) +;; +;; Bind all variables given in , initialize each of them to +;; a string representing an unique path in the filesystem, and delete +;; them after evaluting . +(macro (lettmp form) + (let ((result-sym (gensym))) + `((lambda (,(caadr form)) + (let ((,result-sym + ,(if (= 1 (length (cadr form))) + `(begin ,@(cddr form)) + `(lettmp ,(cdadr form) ,@(cddr form))))) + (remove-temporary-file ,(caadr form)) + ,result-sym)) (make-temporary-file ,(symbol->string (caadr form)))))) + +(define (check-execution source transformer) + (lettmp (sink) + (transformer source sink))) + +(define (check-identity source transformer) + (lettmp (sink) + (transformer source sink) + (if (not (file=? source sink)) + (error "mismatch")))) + +;; +;; Monadic pipe support. +;; + +(define pipeM + (package + (define (new procs source sink producer) + (package + (define (dump) + (write (list procs source sink producer)) + (newline)) + (define (add-proc command pid) + (new (cons (list command pid) procs) source sink producer)) + (define (commands) + (map car procs)) + (define (pids) + (map cadr procs)) + (define (set-source source') + (new procs source' sink producer)) + (define (set-sink sink') + (new procs source sink' producer)) + (define (set-producer producer') + (if producer + (throw "producer already set")) + (new procs source sink producer')))))) + + +(define (pipe:do . commands) + (let loop ((M (pipeM::new '() CLOSED_FD CLOSED_FD #f)) (cmds commands)) + (if (null? cmds) + (begin + (if M::producer (M::producer)) + (if (not (null? M::procs)) + (let* ((retcodes (wait-processes (map stringify (M::commands)) + (M::pids) #t)) + (results (map (lambda (p r) (append p (list r))) + M::procs retcodes)) + (failed (filter (lambda (x) (not (= 0 (caddr x)))) + results))) + (if (not (null? failed)) + (throw failed))))) ; xxx nicer reporting + (if (and (= 2 (length cmds)) (number? (cadr cmds))) + ;; hack: if it's an fd, use it as sink + (let ((M' ((car cmds) (M::set-sink (cadr cmds))))) + (if (> M::source 2) (close M::source)) + (if (> (cadr cmds) 2) (close (cadr cmds))) + (loop M' '())) + (let ((M' ((car cmds) M))) + (if (> M::source 2) (close M::source)) + (loop M' (cdr cmds))))))) + +(define (pipe:open pathname flags) + (lambda (M) + (M::set-source (open pathname flags)))) + +(define (pipe:defer producer) + (lambda (M) + (let* ((p (outbound-pipe)) + (M' (M::set-source (:read-end p)))) + (M'::set-producer (lambda () + (producer (:write-end p)) + (close (:write-end p))))))) +(define (pipe:echo data) + (pipe:defer (lambda (sink) (display data (fdopen sink "wb"))))) + +(define (pipe:spawn command) + (lambda (M) + (define (do-spawn M new-source) + (let ((pid (spawn-process-fd command M::source M::sink + (if (> *verbose* 0) + STDERR_FILENO CLOSED_FD))) + (M' (M::set-source new-source))) + (M'::add-proc command pid))) + (if (= CLOSED_FD M::sink) + (let* ((p (pipe)) + (M' (do-spawn (M::set-sink (:write-end p)) (:read-end p)))) + (close (:write-end p)) + (M'::set-sink CLOSED_FD)) + (do-spawn M CLOSED_FD)))) + +(define (pipe:splice sink) + (lambda (M) + (splice M::source sink) + (M::set-source CLOSED_FD))) + +(define (pipe:write-to pathname flags mode) + (open pathname flags mode)) + +;; +;; Monadic transformer support. +;; + +(define (tr:do . commands) + (let loop ((tmpfiles '()) (source #f) (cmds commands)) + (if (null? cmds) + (for-each remove-temporary-file tmpfiles) + (let* ((v ((car cmds) tmpfiles source)) + (tmpfiles' (car v)) + (sink (cadr v)) + (error (caddr v))) + (if error + (begin + (for-each remove-temporary-file tmpfiles') + (throw error))) + (loop tmpfiles' sink (cdr cmds)))))) + +(define (tr:open pathname) + (lambda (tmpfiles source) + (list tmpfiles pathname #f))) + +(define (tr:spawn input command) + (lambda (tmpfiles source) + (if (and (member '**in** command) (not source)) + (error (string-append (stringify cmd) " needs an input"))) + (let* ((t (make-temporary-file)) + (cmd (map (lambda (x) + (cond + ((equal? '**in** x) source) + ((equal? '**out** x) t) + (else x))) command))) + (catch (list (cons t tmpfiles) t *error*) + (call-popen cmd input) + (if (and (member '**out** command) (not (file-exists? t))) + (error (string-append (stringify cmd) + " did not produce '" t "'."))) + (list (cons t tmpfiles) t #f))))) + +(define (tr:write-to pathname) + (lambda (tmpfiles source) + (rename source pathname) + (list tmpfiles pathname #f))) + +(define (tr:pipe-do . commands) + (lambda (tmpfiles source) + (let ((t (make-temporary-file))) + (apply pipe:do + `(,@(if source `(,(pipe:open source (logior O_RDONLY O_BINARY))) '()) + ,@commands + ,(pipe:write-to t (logior O_WRONLY O_BINARY O_CREAT) #o600))) + (list (cons t tmpfiles) t #f)))) + +(define (tr:assert-identity reference) + (lambda (tmpfiles source) + (if (not (file=? source reference)) + (error "mismatch")) + (list tmpfiles source #f))) + +(define (tr:assert-weak-identity reference) + (lambda (tmpfiles source) + (if (not (text-file=? source reference)) + (error "mismatch")) + (list tmpfiles source #f))) + +(define (tr:call-with-content function . args) + (lambda (tmpfiles source) + (catch (list tmpfiles source *error*) + (apply function `(,(call-with-input-file source read-all) ,@args))) + (list tmpfiles source #f))) diff --git a/tests/migrations/Makefile.am b/tests/migrations/Makefile.am index 0f581c270..9c82d66ee 100644 --- a/tests/migrations/Makefile.am +++ b/tests/migrations/Makefile.am @@ -26,21 +26,20 @@ include $(top_srcdir)/am/cmacros.am AM_CFLAGS = -TESTS_ENVIRONMENT = GPG_AGENT_INFO= LC_ALL=C +TMP ?= /tmp -TESTS = from-classic.test \ - extended-private-key-format.test +TESTS_ENVIRONMENT = GPG_AGENT_INFO= LC_ALL=C \ + PATH=../gpgscm:$(PATH) \ + TMP=$(TMP) \ + GPGSCM_PATH=$(top_srcdir)/tests/gpgscm:$(top_srcdir)/tests/migrations -TEST_FILES = from-classic.gpghome/pubring.gpg.asc \ - from-classic.gpghome/secring.gpg.asc \ - from-classic.gpghome/trustdb.gpg.asc \ - extended-private-key-format.gpghome/trustdb.gpg.asc \ - extended-private-key-format.gpghome/pubring.kbx.asc \ - extended-private-key-format.gpghome/private-keys-v1.d/13FDB8809B17C5547779F9D205C45F47CE0217CE.key.asc \ - extended-private-key-format.gpghome/private-keys-v1.d/343D8AF79796EE107D645A2787A9D9252F924E6F.key.asc \ - extended-private-key-format.gpghome/private-keys-v1.d/8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34.key.asc +TESTS = from-classic.scm \ + extended-pkf.scm -EXTRA_DIST = $(TESTS) $(TEST_FILES) +TEST_FILES = from-classic.tar.asc \ + extended-pkf.tar.asc + +EXTRA_DIST = common.scm $(TESTS) $(TEST_FILES) CLEANFILES = prepared.stamp x y yy z out err $(data_files) \ plain-1 plain-2 plain-3 trustdb.gpg *.lock .\#lk* \ diff --git a/tests/migrations/common.scm b/tests/migrations/common.scm new file mode 100644 index 000000000..79f69e5d1 --- /dev/null +++ b/tests/migrations/common.scm @@ -0,0 +1,39 @@ +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(if (string=? "" (getenv "srcdir")) + (error "not called from make")) + +(setenv "GNUPGHOME" "" #t) + +(define (qualify executable) + (string-append executable (getenv "EXEEXT"))) + +;; We may not use a relative name for gpg-agent. +(define GPG-AGENT (qualify (string-append (getcwd) "/../../agent/gpg-agent"))) +(define GPG `(,(qualify (string-append (getcwd) "/../../g10/gpg")) + --no-permission-warning --no-greeting + --no-secmem-warning --batch + ,(string-append "--agent-program=" GPG-AGENT + "|--debug-quick-random"))) +(define GPGTAR (qualify (string-append (getcwd) "/../../tools/gpgtar"))) + +(define (untar-armored source-name) + (pipe:do + (pipe:open source-name (logior O_RDONLY O_BINARY)) + (pipe:spawn `(,@GPG --dearmor)) + (pipe:spawn `(,GPGTAR --extract --directory=. -)))) diff --git a/tests/migrations/extended-pkf.scm b/tests/migrations/extended-pkf.scm new file mode 100755 index 000000000..3e76532ba --- /dev/null +++ b/tests/migrations/extended-pkf.scm @@ -0,0 +1,43 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "common.scm")) + +(define src-tarball (in-srcdir "extended-pkf.tar.asc")) + +(define (setup) + (untar-armored src-tarball) + (setenv "GNUPGHOME" (getcwd) #t)) + +(define (trigger-migration) + (call-check `(,@GPG --list-secret-keys))) + +(define (assert-keys-usable) + (for-each + (lambda (keyid) + (catch (error "Key not found:" keyid) + (call-check `(,@GPG --list-secret-keys ,keyid)))) + '("C40FDECF" "ECABF51D"))) + +(info "Testing the extended private key format ...") +(with-temporary-working-directory + (setup) + (assert-keys-usable)) + +;; XXX try changing a key, and check that the format is not changed. diff --git a/tests/migrations/extended-pkf.tar.asc b/tests/migrations/extended-pkf.tar.asc new file mode 100644 index 000000000..adbe174fe --- /dev/null +++ b/tests/migrations/extended-pkf.tar.asc @@ -0,0 +1,220 @@ +-----BEGIN PGP ARMORED FILE----- +Version: GnuPG v2 +Comment: Use "gpg --dearmor" for unpacking + +cHJpdmF0ZS1rZXlzLXYxLmQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAADAwMDA3NTUAMDAwMTc1MAAwMDAxNzUwADAwMDAwMDAwMDAwADEyNzM2NzI1 +MzA2ADAxNDU0NwAgNQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAB1c3RhcgAwMHRleXRob29uAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAdGV5dGhvb24AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABwcml2YXRlLWtleXMtdjEu +ZC84QjVBQkYzRUY5RUI4RDk2QjkxQTBCOEMyQzQ0MDFDOTFDODM0QzM0LmtleQAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMDAwMDY0NAAwMDAx +NzUwADAwMDE3NTAAMDAwMDAwMDEyMDQAMTI3MzY3MjUyNTYAMDIyMTAyACAwAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AHVzdGFyADAwdGV5dGhvb24AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB0ZXl0aG9v +bgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAEtleTogKHByaXZhdGUta2V5IChlbGcgKHAgIzAwQ0NE +OEIxRjlEQUM3NEQ4MDhDQzUyRjBEODk0NjREQTU1NEM2OUQ2N0YzCiAzMjNDNDJB +OTVDOTk2MkRGNDIxMjZFQzBFMDk3MUY0OUI4MTE1MjlBNkEyQUU5RjBBREVCODM5 +QTYzNDYxNUNENTZGQTU0CiBGNUEwQjdFRjI1QTBFMkZFODQzRkEyRTZFMDIxQ0FC +NDExOUU2MDM5NEM5RDZBM0Y3QUQ0RjU3Nzk2RDM2NjY5QTUxMjY2CiBDMjdBOEQx +QzVBNkI0MTQxRDVDODMxRTg0NTQxRjNDODExRTg5MDc4OTgwMzM4Mjk1RjgyQjdG +N0ZENDMzM0VGRDkzMzEyCiBGMkFCIykoZyAjMDYjKSh5ICMzNzczQTZEOUVDODg5 +RDc2RTMyNEQ2RTVFQzIxQkQ0NTY5OTgzMUFFNEZEMEFFMDM3ODIwCiA1QkFFNUI4 +Q0U4NUZBREFCRDdFNkI3QzczMDI1Q0IzRDczMEQ1QzU4MjkwMzRENzZCRTA4NTVD +MkU5RkY3QTQ5MjNFRkZBCiBGMTZBOTY2Njk0NERCQzYyOTQ4MzhGQzNGMDlGRjk2 +NEE4RDAyM0NCOEVCQTMzMkZCMDUxRUEwMjgyMEVFNjEyMEZGQkU2CiAyQjM2QTIw +MkIzQzc1MkY5REE3NkIyRUMxMUE2N0QyRTM1RTY2RUMxMDYzNTg3QjIyNTAwRThB +NDZEMTU3Qjc1IykoeCAjCiA2OTE1QzZDRUQyNTgxNDNGODkzN0IxMzM1RjQ4ODdG +MDA0MkI3QzYzMDA1Mzk4RjkzOTZCQjg1MzIzOENCNiMpKSkKNjE1Q0Q1NkZBNTQK +IEY1QTBCN0VGMjVBMEUyRkU4NDNGQTJFNkUwMjFDQUI0MTE5RTYwMzk0QzlENkEz +RjdBRDRGNTc3OTZEMzY2NjlBNTEyNjYKIEMyN0E4RDFDNUE2QjQxNDFENUM4MzFF +ODQ1NDFGM0M4MTFFODkwNzg5ODAzMzgyOTVGODJCN0Y3RkQ0MzMzRUZEOTMzMTIK +IEYyQUIjKShnICMwNiMpKHkgIzM3NzNBNkQ5RUM4ODlENzZFMzI0RDZFNUVDMjFC +RDQ1Njk5ODMxQUU0RkQwQUUwMzc4MjAKIDVCQUU1QjhDRTg1RkFEQUJEN0U2QjdD +NzMwMjVDQjNENzMwRDVDNTgyOTAzNEQ3NkJFMDg1NUMyRTlGRjdBNDkyM0VGRkEK +IEYxNkE5NjY2OTQ0REJDNjI5NDgzOEZDM0YwOUZGOTY0QThEMDIzQ0I4RUJBMzMy +RkIwNTFFQTAyODIwRUU2MTIwRkZCRTYKIDJCMzZBMjBwcml2YXRlLWtleXMtdjEu +ZC8zNDNEOEFGNzk3OTZFRTEwN0Q2NDVBMjc4N0E5RDkyNTJGOTI0RTZGLmtleQAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMDAwMDY0NAAwMDAx +NzUwADAwMDE3NTAAMDAwMDAwMDA3NTQAMTI3MzY3MjUyNTYAMDIyMDQwACAwAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AHVzdGFyADAwdGV5dGhvb24AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB0ZXl0aG9v +bgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAACgxMTpwcml2YXRlLWtleSgzOmRzYSgxOnAxMjk6AKxx +qlg9Kz9DZ/3N52BC0w+JtYKke39vpdWVDHR3MHmMJ/31Y2iSpm0fvRs3h1j9/fBV +mLOZglNQyH62SxdJyZwCelkZzfUy/qLm9Qaqi7wpg0p4EbmWdoFF/A1Zg/MU7D5w +5xu+EA1J77Z6QyALN9rIOXZ7rLLa64lw/MV4LdIPKSgxOnEyMToAuOPYbSW26ea5 +CR7wQ7OGMRCJJOcpKDE6ZzEyODpfiE8aUjDk+UeuwbuF1qGFO51XmFEaW+iyfCyt +gle8oBAsBXURXbpIhhQfmkz/Jxesbbl2pWgbnq5CqeEF1SqjiJKezFjdkwDjoPXh +ERz0//8Ia8n+PZnjWDDy7ygHutLnR2O+hpZvmbKPtuFpxMF19qHdTx1VdwiLVkW+ +2JoYBikoMTp5MTI4OgIF7eNIdpaYiB0427un4ggc26+Y9nkF93DaMnZEaYSeum6g +/g7D1vwINFgQkMYEWi4DK3W+uH0E/n8o20wS2wvMrbeYaQm5v6ucd001wwFDY6Ad +wpwP7UCLQcu6qqvwNHdxWYK6+gIsSufLmeMGrsvC0WQqYeu1GfGpHIMCZJlZKSgx +OngyMDp/2Na42QEhjCvSBm9cv2Qyk9M5EykpKQAAAAAAAAAAAAAAAAAAAAAAAAAA +cHJpdmF0ZS1rZXlzLXYxLmQvMTNGREI4ODA5QjE3QzU1NDc3NzlGOUQyMDVDNDVG +NDdDRTAyMTdDRS5rZXkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAADAwMDA2NDQAMDAwMTc1MAAwMDAxNzUwADAwMDAwMDAxNzQyADEyNzM2NzI1 +MjU2ADAyMjAzMgAgMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAB1c3RhcgAwMHRleXRob29uAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAdGV5dGhvb24AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABLZXk6IChwcml2YXRlLWtl +eSAocnNhIChuICMwMEE4NTI1Njc2RUNFNEQ3NUZFNkQwMDczRjJCRjk5QTZGNDkz +M0NFQkRENAogNTI4QUY1NkU0QzYxRTJGNzMxMjQ3MzkzNjQ1RERBRjU4RUFERDU2 +NTI5QzI1Mzk3NzgyMzY0NjNERjJENDU4NTIwRTgwRQogMzRDMDU4MjQyQjNGRjg4 +REQzOUE4ODNCNDc1QjY2Q0VBQUJCQzk5ODlGRjAxRkZFNzM3NjYwRTlCNjFCQjlE +QzkxMjA1RAogNDI4RkZGRThGNjc1RkFFRjYxMzY1OEM3MkRBNkQ3NTBDMEVCQzQw +QUY2MjNEMjA2NjkyQzgyNTE0QzQwNEQ4ODI1QUI3MAogMTAwMSMpKGUgIzAxMDEj +KShkICMwMEJDQTAwMTQ0ODVGQjc2RDUwRTlCNkNCQTU3MjFBQzExMjEzOTBGODYw +OEQ0MDg0QgogRDA0NUE4NzZERjM4MTBGMTE0QkMyRDY4RUI1NTJFNjFCMDFFREJD +MjQ4MUYwOEM4MjgzMkUwMEUyNzlENjdBODUzMDU1RAogQ0FFNUMyMzU2ODUxQ0JF +MzZENjEwQzREMkFCNDNGQTY1NTk4NUM0NDY5RDFEOTExRTFBRkQ4MTdFQUE1RkVF +MEZGMjY1NwogNEMzNTlFMTc1Mjg3MDUyMTk0NTNCNTFBRUMxMERCRjc1NjJCMDYx +RDVDNjZDMzVCQjNGOUYwQjIyMkI5RDE5NkI5IykocAogICMwMEMzM0M1ODA2Mzk5 +NkJENTk3NTJBQUJERkRBQ0RBQTdCNEI2NkFBMTc1NEVFMEQ4OUI3Nzk0RjBERThG +RjcyNEM1NAogOUZGMTEyQTMzMjkyQkI5RDdCQ0VFNzk0RjA4MDI0QzNFNTVGRDgy +MzNGNTA3OUVENDk5MUM0REYyNjE4RDkjKShxICMwMAogRENCNTk0NUYwMEYxQUY0 +MzhCRDRDMzExQjhCQUNBM0Q5REIwQUQxNjUxOTg2NTM0MjAzMEYxREYzMDU3RTU1 +MzJDNDdGNQogOEQzMzAzQ0JBM0M4QTI5ODE0RjYxN0I3QjNERUU5OEZBQUFBRUU4 +MTFCNDk4RkFBRjIxNzdCNzc2OSMpKHUgIzI5RkIyRAogRjY5QjIzNUE0OUE5MDZC +MTBFRjdEOEY4MUFBRUE4QUQ4MUU3Q0RERTFGNEE3OUNFMjQ0QkY4RkNFNkRENUVC +MTgxMUIwQgogRDVFNTE2NUI5NTcwODUwMzY5MDFERDI4NUE2MjhDMjk3QTc4MkRB +ODE1NzNBNDNEMUMwOSMpKSkKMUFGRDgxN0VBQTVGRUUwRkYyNjU3CiA0QzM1OUUx +cHVicmluZy5rYngAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAADAwMDA2NDQAMDAwMTc1MAAwMDAxNzUwADAwMDAwMDAzMDI3ADEyNzM2NzI1 +MjU2ADAxMzYxNwAgMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAB1c3RhcgAwMHRleXRob29uAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAdGV5dGhvb24AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAQEAAktCWGYAAAAA +Vxi2I1cYtiMAAAAAAAAAAAAABBcCAQAAAAAAfgAAA4UAAgAcwd67NOqLcQCer6R0 +lz1Q4cQP3s8AAAAgAAAAAM09D1cBy/yssqSQcwWjeIeyeQeqAAAAPAAAAAAAAAAB +AAwAAAIlAAAAIgAAAAAAAgAE//////////8AAAAAAAAAAAAAAABXGLYjAAAAAJkB +ogQ/8lJrEQQArHGqWD0rP0Nn/c3nYELTD4m1gqR7f2+l1ZUMdHcweYwn/fVjaJKm +bR+9GzeHWP398FWYs5mCU1DIfrZLF0nJnAJ6WRnN9TL+oub1BqqLvCmDSngRuZZ2 +gUX8DVmD8xTsPnDnG74QDUnvtnpDIAs32sg5dnusstrriXD8xXgt0g8AoLjj2G0l +tunmuQke8EOzhjEQiSTnA/9fiE8aUjDk+UeuwbuF1qGFO51XmFEaW+iyfCytgle8 +oBAsBXURXbpIhhQfmkz/Jxesbbl2pWgbnq5CqeEF1SqjiJKezFjdkwDjoPXhERz0 +//8Ia8n+PZnjWDDy7ygHutLnR2O+hpZvmbKPtuFpxMF19qHdTx1VdwiLVkW+2JoY +BgP6AgXt40h2lpiIHTjbu6fiCBzbr5j2eQX3cNoydkRphJ66bqD+DsPW/Ag0WBCQ +xgRaLgMrdb64fQT+fyjbTBLbC8ytt5hpCbm/q5x3TTXDAUNjoB3CnA/tQItBy7qq +q/A0d3FZgrr6AixK58uZ4wauy8LRZCph67UZ8akcgwJkmVm0IlRlc3QgdHdvIChu +byBwcCkgPHR3b0BleGFtcGxlLmNvbT6IXwQTEQIAHwUCP/JSawIbAwcLCQgHAwIB +AxUCAwMWAgECHgECF4AACgkQlz1Q4cQP3s+AQwCfQXxEYOueZe/uuozb6mJzagPP +WSkAnRJY8fF2MkdbOgYyseqhwDL/fAWLuQENBD/yUm8QBADM2LH52sdNgIzFLw2J +Rk2lVMadZ/MyPEKpXJli30ISbsDglx9JuBFSmmoq6fCt64OaY0YVzVb6VPWgt+8l +oOL+hD+i5uAhyrQRnmA5TJ1qP3rU9XeW02ZppRJmwnqNHFprQUHVyDHoRUHzyBHo +kHiYAzgpX4K39/1DM+/ZMxLyqwADBgP+N3Om2eyInXbjJNbl7CG9RWmYMa5P0K4D +eCBbrluM6F+tq9fmt8cwJcs9cw1cWCkDTXa+CFXC6f96SSPv+vFqlmaUTbxilIOP +w/Cf+WSo0CPLjrozL7BR6gKCDuYSD/vmKzaiArPHUvnadrLsEaZ9LjXmbsEGNYey +JQDopG0Ve3WISQQYEQIACQUCP/JSbwIbDAAKCRCXPVDhxA/ezyy+AKCZZylXC+0M +3ecBVPV0wVO8LPSF/ACgjhWzMkF6wb/wbItb57YT4uJBdWpyKrYYYncCnYq+gLAI +v8OEIB9wawAAAeACAQAAAAAAXgAAAW4AAQAczyNJCw94uFC7vHNp0SC2Juyr9R0A +AAAgAAAAAAAAAAEADAAAAO8AAAAmAAAAAAABAAT/////AAAAAAAAAAAAAAAAVxi2 +SQAAAACZAIwEP/JTvQEEAKhSVnbs5Ndf5tAHPyv5mm9JM8691FKK9W5MYeL3MSRz +k2Rd2vWOrdVlKcJTl3gjZGPfLUWFIOgONMBYJCs/+I3Tmog7R1tmzqq7yZif8B/+ +c3Zg6bYbudyRIF1Cj//o9nX672E2WMctptdQwOvECvYj0gZpLIJRTEBNiCWrcBAB +AAkBAbQmVGVzdCB0aHJlZSAobm8gcHApIDx0aHJlZUBleGFtcGxlLmNvbT6ItQQT +AQIAHwUCP/JTvQIbAwcLCQgHAwIBAxUCAwMWAgECHgECF4AACgkQ0SC2Juyr9R1q +QwP/bCDX1WGk1u0zkKJWJ/VXnuH3jk6ZevkuHZICwjlqAxv1de5P3Jeya/4kPmEQ +TotEv3xcDAZ+9pBL3TrZolAKhxkBZ08l4QSy76kyf8hB0eoZ2Svs7LrGPBJr6CHX +0kyDiapHgAhBKQq9GhNKpIAZuL6DK2dOaQDtoRSW2iB1h4ksYHkxg+dI/AANhV82 +0vGwpkRIsPBsi1vnthPi4kF1anIqthhidwKdir6AsAi/w4QgH3BrAAAB4AIBAAAA +AABeAAABbgABABzPI0kLD3i4ULu8c2nRILYm7Kv1HQAAACAAAAAAAAAAAQAMAAAA +7wAAACYAAAAAAAEABP////8AAAAAAAAAAAAAAABXGLZJAAAAAJkAjAQ/8lO9AQQA +qFJWduzk11/m0Ac/K/mab0kzzr3UUor1bkxh4vcxJHOTZF3a9Y6t1WUpwlOXeCNk +Y98tRYUg6A40wFgkKz/4jdOaiDtHW2bOqrvJmJ/wH/5zdmDpthu53JEgXUKP/+j2 +dfrvYTZYxy2m11DA68QK9iPSBmksglFMQE2IJatwEAEACQEBtCZUZXN0IHRocmVl +IChubyBwcCkgPHRocmVlQGV4YW1wbGUuY29tPoi1BBMBAgAfBQI/8lO9AhsDBwsJ +CAcDAgEDFQIDAxYCAQIeAQIXgAAKCRDRILYm7Kv1HWpDA/9sINfVYaTW7TOQolYn +9Vee4feOTpl6+S4dkgLCOWoDG/V17k/cl7Jr/iQ+YRBOi0S/fFwMBn72kEvdOtmi +UAqHGQFnTyXhBLLvqTJ/yEHR6hnZK+zsusY8EmvoIdfSTIOJqkeACEEpCr0aE0qk +gBm4voMrZ05pAO2hFJbaIHRydXN0ZGIuZ3BnAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAwMDAwNjQ0ADAwMDE3NTAAMDAwMTc1MAAwMDAw +MDAwMjI2MAAxMjczNjcyNTI1NgAwMTM2MjcAIDAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAdXN0YXIAMDB0ZXl0aG9v +bgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHRleXRob29uAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AWdwZwMDAQUBAgAAVxi2IwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAA== +=Joz2 +-----END PGP ARMORED FILE----- diff --git a/tests/migrations/extended-private-key-format.gpghome/private-keys-v1.d/13FDB8809B17C5547779F9D205C45F47CE0217CE.key.asc b/tests/migrations/extended-private-key-format.gpghome/private-keys-v1.d/13FDB8809B17C5547779F9D205C45F47CE0217CE.key.asc deleted file mode 100644 index d9192b19a..000000000 --- a/tests/migrations/extended-private-key-format.gpghome/private-keys-v1.d/13FDB8809B17C5547779F9D205C45F47CE0217CE.key.asc +++ /dev/null @@ -1,27 +0,0 @@ ------BEGIN PGP ARMORED FILE----- -Version: GnuPG v2 -Comment: Use "gpg --dearmor" for unpacking - -S2V5OiAocHJpdmF0ZS1rZXkgKHJzYSAobiAjMDBBODUyNTY3NkVDRTRENzVGRTZE -MDA3M0YyQkY5OUE2RjQ5MzNDRUJERDQKIDUyOEFGNTZFNEM2MUUyRjczMTI0NzM5 -MzY0NUREQUY1OEVBREQ1NjUyOUMyNTM5Nzc4MjM2NDYzREYyRDQ1ODUyMEU4MEUK -IDM0QzA1ODI0MkIzRkY4OEREMzlBODgzQjQ3NUI2NkNFQUFCQkM5OTg5RkYwMUZG -RTczNzY2MEU5QjYxQkI5REM5MTIwNUQKIDQyOEZGRkU4RjY3NUZBRUY2MTM2NThD -NzJEQTZENzUwQzBFQkM0MEFGNjIzRDIwNjY5MkM4MjUxNEM0MDREODgyNUFCNzAK -IDEwMDEjKShlICMwMTAxIykoZCAjMDBCQ0EwMDE0NDg1RkI3NkQ1MEU5QjZDQkE1 -NzIxQUMxMTIxMzkwRjg2MDhENDA4NEIKIEQwNDVBODc2REYzODEwRjExNEJDMkQ2 -OEVCNTUyRTYxQjAxRURCQzI0ODFGMDhDODI4MzJFMDBFMjc5RDY3QTg1MzA1NUQK -IENBRTVDMjM1Njg1MUNCRTM2RDYxMEM0RDJBQjQzRkE2NTU5ODVDNDQ2OUQxRDkx -MUUxQUZEODE3RUFBNUZFRTBGRjI2NTcKIDRDMzU5RTE3NTI4NzA1MjE5NDUzQjUx -QUVDMTBEQkY3NTYyQjA2MUQ1QzY2QzM1QkIzRjlGMEIyMjJCOUQxOTZCOSMpKHAK -ICAjMDBDMzNDNTgwNjM5OTZCRDU5NzUyQUFCREZEQUNEQUE3QjRCNjZBQTE3NTRF -RTBEODlCNzc5NEYwREU4RkY3MjRDNTQKIDlGRjExMkEzMzI5MkJCOUQ3QkNFRTc5 -NEYwODAyNEMzRTU1RkQ4MjMzRjUwNzlFRDQ5OTFDNERGMjYxOEQ5IykocSAjMDAK -IERDQjU5NDVGMDBGMUFGNDM4QkQ0QzMxMUI4QkFDQTNEOURCMEFEMTY1MTk4NjUz -NDIwMzBGMURGMzA1N0U1NTMyQzQ3RjUKIDhEMzMwM0NCQTNDOEEyOTgxNEY2MTdC -N0IzREVFOThGQUFBQUVFODExQjQ5OEZBQUYyMTc3Qjc3NjkjKSh1ICMyOUZCMkQK -IEY2OUIyMzVBNDlBOTA2QjEwRUY3RDhGODFBQUVBOEFEODFFN0NEREUxRjRBNzlD -RTI0NEJGOEZDRTZERDVFQjE4MTFCMEIKIEQ1RTUxNjVCOTU3MDg1MDM2OTAxREQy -ODVBNjI4QzI5N0E3ODJEQTgxNTczQTQzRDFDMDkjKSkpCg== -=laTh ------END PGP ARMORED FILE----- diff --git a/tests/migrations/extended-private-key-format.gpghome/private-keys-v1.d/343D8AF79796EE107D645A2787A9D9252F924E6F.key.asc b/tests/migrations/extended-private-key-format.gpghome/private-keys-v1.d/343D8AF79796EE107D645A2787A9D9252F924E6F.key.asc deleted file mode 100644 index 1eede1c61..000000000 --- a/tests/migrations/extended-private-key-format.gpghome/private-keys-v1.d/343D8AF79796EE107D645A2787A9D9252F924E6F.key.asc +++ /dev/null @@ -1,17 +0,0 @@ ------BEGIN PGP ARMORED FILE----- -Version: GnuPG v2 -Comment: Use "gpg --dearmor" for unpacking - -KDExOnByaXZhdGUta2V5KDM6ZHNhKDE6cDEyOToArHGqWD0rP0Nn/c3nYELTD4m1 -gqR7f2+l1ZUMdHcweYwn/fVjaJKmbR+9GzeHWP398FWYs5mCU1DIfrZLF0nJnAJ6 -WRnN9TL+oub1BqqLvCmDSngRuZZ2gUX8DVmD8xTsPnDnG74QDUnvtnpDIAs32sg5 -dnusstrriXD8xXgt0g8pKDE6cTIxOgC449htJbbp5rkJHvBDs4YxEIkk5ykoMTpn -MTI4Ol+ITxpSMOT5R67Bu4XWoYU7nVeYURpb6LJ8LK2CV7ygECwFdRFdukiGFB+a -TP8nF6xtuXalaBuerkKp4QXVKqOIkp7MWN2TAOOg9eERHPT//whryf49meNYMPLv -KAe60udHY76Glm+Zso+24WnEwXX2od1PHVV3CItWRb7YmhgGKSgxOnkxMjg6AgXt -40h2lpiIHTjbu6fiCBzbr5j2eQX3cNoydkRphJ66bqD+DsPW/Ag0WBCQxgRaLgMr -db64fQT+fyjbTBLbC8ytt5hpCbm/q5x3TTXDAUNjoB3CnA/tQItBy7qqq/A0d3FZ -grr6AixK58uZ4wauy8LRZCph67UZ8akcgwJkmVkpKDE6eDIwOn/Y1rjZASGMK9IG -b1y/ZDKT0zkTKSkp -=muRa ------END PGP ARMORED FILE----- diff --git a/tests/migrations/extended-private-key-format.gpghome/private-keys-v1.d/8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34.key.asc b/tests/migrations/extended-private-key-format.gpghome/private-keys-v1.d/8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34.key.asc deleted file mode 100644 index 70836735d..000000000 --- a/tests/migrations/extended-private-key-format.gpghome/private-keys-v1.d/8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34.key.asc +++ /dev/null @@ -1,20 +0,0 @@ ------BEGIN PGP ARMORED FILE----- -Version: GnuPG v2 -Comment: Use "gpg --dearmor" for unpacking - -S2V5OiAocHJpdmF0ZS1rZXkgKGVsZyAocCAjMDBDQ0Q4QjFGOURBQzc0RDgwOEND -NTJGMEQ4OTQ2NERBNTU0QzY5RDY3RjMKIDMyM0M0MkE5NUM5OTYyREY0MjEyNkVD -MEUwOTcxRjQ5QjgxMTUyOUE2QTJBRTlGMEFERUI4MzlBNjM0NjE1Q0Q1NkZBNTQK -IEY1QTBCN0VGMjVBMEUyRkU4NDNGQTJFNkUwMjFDQUI0MTE5RTYwMzk0QzlENkEz -RjdBRDRGNTc3OTZEMzY2NjlBNTEyNjYKIEMyN0E4RDFDNUE2QjQxNDFENUM4MzFF -ODQ1NDFGM0M4MTFFODkwNzg5ODAzMzgyOTVGODJCN0Y3RkQ0MzMzRUZEOTMzMTIK -IEYyQUIjKShnICMwNiMpKHkgIzM3NzNBNkQ5RUM4ODlENzZFMzI0RDZFNUVDMjFC -RDQ1Njk5ODMxQUU0RkQwQUUwMzc4MjAKIDVCQUU1QjhDRTg1RkFEQUJEN0U2QjdD -NzMwMjVDQjNENzMwRDVDNTgyOTAzNEQ3NkJFMDg1NUMyRTlGRjdBNDkyM0VGRkEK -IEYxNkE5NjY2OTQ0REJDNjI5NDgzOEZDM0YwOUZGOTY0QThEMDIzQ0I4RUJBMzMy -RkIwNTFFQTAyODIwRUU2MTIwRkZCRTYKIDJCMzZBMjAyQjNDNzUyRjlEQTc2QjJF -QzExQTY3RDJFMzVFNjZFQzEwNjM1ODdCMjI1MDBFOEE0NkQxNTdCNzUjKSh4ICMK -IDY5MTVDNkNFRDI1ODE0M0Y4OTM3QjEzMzVGNDg4N0YwMDQyQjdDNjMwMDUzOThG -OTM5NkJCODUzMjM4Q0I2IykpKQo= -=6fkh ------END PGP ARMORED FILE----- diff --git a/tests/migrations/extended-private-key-format.gpghome/pubring.kbx.asc b/tests/migrations/extended-private-key-format.gpghome/pubring.kbx.asc deleted file mode 100644 index 50123712c..000000000 --- a/tests/migrations/extended-private-key-format.gpghome/pubring.kbx.asc +++ /dev/null @@ -1,39 +0,0 @@ ------BEGIN PGP ARMORED FILE----- -Version: GnuPG v2 -Comment: Use "gpg --dearmor" for unpacking - -AAAAIAEBAAJLQlhmAAAAAFcYtiNXGLYjAAAAAAAAAAAAAAQXAgEAAAAAAH4AAAOF -AAIAHMHeuzTqi3EAnq+kdJc9UOHED97PAAAAIAAAAADNPQ9XAcv8rLKkkHMFo3iH -snkHqgAAADwAAAAAAAAAAQAMAAACJQAAACIAAAAAAAIABP//////////AAAAAAAA -AAAAAAAAVxi2IwAAAACZAaIEP/JSaxEEAKxxqlg9Kz9DZ/3N52BC0w+JtYKke39v -pdWVDHR3MHmMJ/31Y2iSpm0fvRs3h1j9/fBVmLOZglNQyH62SxdJyZwCelkZzfUy -/qLm9Qaqi7wpg0p4EbmWdoFF/A1Zg/MU7D5w5xu+EA1J77Z6QyALN9rIOXZ7rLLa -64lw/MV4LdIPAKC449htJbbp5rkJHvBDs4YxEIkk5wP/X4hPGlIw5PlHrsG7hdah -hTudV5hRGlvosnwsrYJXvKAQLAV1EV26SIYUH5pM/ycXrG25dqVoG56uQqnhBdUq -o4iSnsxY3ZMA46D14REc9P//CGvJ/j2Z41gw8u8oB7rS50djvoaWb5myj7bhacTB -dfah3U8dVXcIi1ZFvtiaGAYD+gIF7eNIdpaYiB0427un4ggc26+Y9nkF93DaMnZE -aYSeum6g/g7D1vwINFgQkMYEWi4DK3W+uH0E/n8o20wS2wvMrbeYaQm5v6ucd001 -wwFDY6AdwpwP7UCLQcu6qqvwNHdxWYK6+gIsSufLmeMGrsvC0WQqYeu1GfGpHIMC -ZJlZtCJUZXN0IHR3byAobm8gcHApIDx0d29AZXhhbXBsZS5jb20+iF8EExECAB8F -Aj/yUmsCGwMHCwkIBwMCAQMVAgMDFgIBAh4BAheAAAoJEJc9UOHED97PgEMAn0F8 -RGDrnmXv7rqM2+pic2oDz1kpAJ0SWPHxdjJHWzoGMrHqocAy/3wFi7kBDQQ/8lJv -EAQAzNix+drHTYCMxS8NiUZNpVTGnWfzMjxCqVyZYt9CEm7A4JcfSbgRUppqKunw -reuDmmNGFc1W+lT1oLfvJaDi/oQ/oubgIcq0EZ5gOUydaj961PV3ltNmaaUSZsJ6 -jRxaa0FB1cgx6EVB88gR6JB4mAM4KV+Ct/f9QzPv2TMS8qsAAwYD/jdzptnsiJ12 -4yTW5ewhvUVpmDGuT9CuA3ggW65bjOhfravX5rfHMCXLPXMNXFgpA012vghVwun/ -ekkj7/rxapZmlE28YpSDj8Pwn/lkqNAjy466My+wUeoCgg7mEg/75is2ogKzx1L5 -2nay7BGmfS415m7BBjWHsiUA6KRtFXt1iEkEGBECAAkFAj/yUm8CGwwACgkQlz1Q -4cQP3s8svgCgmWcpVwvtDN3nAVT1dMFTvCz0hfwAoI4VszJBesG/8GyLW+e2E+Li -QXVqciq2GGJ3Ap2KvoCwCL/DhCAfcGsAAAHgAgEAAAAAAF4AAAFuAAEAHM8jSQsP -eLhQu7xzadEgtibsq/UdAAAAIAAAAAAAAAABAAwAAADvAAAAJgAAAAAAAQAE//// -/wAAAAAAAAAAAAAAAFcYtkkAAAAAmQCMBD/yU70BBACoUlZ27OTXX+bQBz8r+Zpv -STPOvdRSivVuTGHi9zEkc5NkXdr1jq3VZSnCU5d4I2Rj3y1FhSDoDjTAWCQrP/iN -05qIO0dbZs6qu8mYn/Af/nN2YOm2G7nckSBdQo//6PZ1+u9hNljHLabXUMDrxAr2 -I9IGaSyCUUxATYglq3AQAQAJAQG0JlRlc3QgdGhyZWUgKG5vIHBwKSA8dGhyZWVA -ZXhhbXBsZS5jb20+iLUEEwECAB8FAj/yU70CGwMHCwkIBwMCAQMVAgMDFgIBAh4B -AheAAAoJENEgtibsq/UdakMD/2wg19VhpNbtM5CiVif1V57h945OmXr5Lh2SAsI5 -agMb9XXuT9yXsmv+JD5hEE6LRL98XAwGfvaQS9062aJQCocZAWdPJeEEsu+pMn/I -QdHqGdkr7Oy6xjwSa+gh19JMg4mqR4AIQSkKvRoTSqSAGbi+gytnTmkA7aEUltog -dYeJLGB5MYPnSPwADYVfNtLxsKZESLA= -=tULv ------END PGP ARMORED FILE----- diff --git a/tests/migrations/extended-private-key-format.gpghome/trustdb.gpg.asc b/tests/migrations/extended-private-key-format.gpghome/trustdb.gpg.asc deleted file mode 100644 index f4d354dcb..000000000 --- a/tests/migrations/extended-private-key-format.gpghome/trustdb.gpg.asc +++ /dev/null @@ -1,31 +0,0 @@ ------BEGIN PGP ARMORED FILE----- -Version: GnuPG v2 -Comment: Use "gpg --dearmor" for unpacking - -AWdwZwMDAQUBAgAAVxi2IwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQoAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -=eBUi ------END PGP ARMORED FILE----- diff --git a/tests/migrations/extended-private-key-format.test b/tests/migrations/extended-private-key-format.test deleted file mode 100755 index 9c373e877..000000000 --- a/tests/migrations/extended-private-key-format.test +++ /dev/null @@ -1,57 +0,0 @@ -#!/bin/sh -# Copyright 2016 g10 Code GmbH -# -# This file is free software; as a special exception the author gives -# unlimited permission to copy and/or distribute it, with or without -# modifications, as long as this notice is preserved. This file is -# distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY, to the extent permitted by law; without even the implied -# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -if [ -z "$srcdir" ]; then - echo "not called from make" >&2 - exit 1 -fi - -unset GNUPGHOME -set -e - -# (We may not use a relative name for gpg-agent.) -GPG_AGENT="$(cd ../../agent && /bin/pwd)/gpg-agent" -GPG="../../g10/gpg --no-permission-warning --no-greeting --no-secmem-warning ---batch --agent-program=${GPG_AGENT}|--debug-quick-random" - -TEST="extended-private-key-format" - -setup_home() -{ - XGNUPGHOME="`mktemp -d`" - mkdir -p "$XGNUPGHOME/private-keys-v1.d" - for F in $srcdir/$TEST.gpghome/*.asc; do - $GPG --dearmor <"$F" >"$XGNUPGHOME/`basename $F .asc`" - done - for F in $srcdir/$TEST.gpghome/private-keys-v1.d/*.asc; do - $GPG --dearmor <"$F" >"$XGNUPGHOME/private-keys-v1.d/`basename $F .asc`" - done - chmod go-rwx $XGNUPGHOME/* $XGNUPGHOME/*/* - export GNUPGHOME="$XGNUPGHOME" -} - -cleanup_home() -{ - rm -rf -- "$XGNUPGHOME" -} - -assert_keys_usable() -{ - for KEY in C40FDECF ECABF51D; do - $GPG --list-secret-keys $KEY >/dev/null - done -} - -setup_home -assert_keys_usable -cleanup_home - - -# XXX try changing a key, and check that the format is not changed. diff --git a/tests/migrations/from-classic.gpghome/pubring.gpg.asc b/tests/migrations/from-classic.gpghome/pubring.gpg.asc deleted file mode 100644 index ecdfddcd0..000000000 --- a/tests/migrations/from-classic.gpghome/pubring.gpg.asc +++ /dev/null @@ -1,54 +0,0 @@ ------BEGIN PGP ARMORED FILE----- -Version: GnuPG v2 -Comment: Use "gpg --dearmor" for unpacking - -mQGiBD/yNQgRBAC/KSfe6uVfDgA3BrGpNLhVxT/ytwXMpBI8pEdTiY0jWnYrb/Yu -8wtCeZ9GAux/ZA/ted+7pdibHXfX5PzDfgUTZwrIJa57OUpWwI878AzZxNsnVv1I -P6ufGyESKME4PUQO5heKhwAb0gQwFwArS3v4oeYrEljhJ79kpt319JEAEwCg+hTk -nylYwYGT/PEVQ4JlLPoWmqUEAJn1HX1Od5tyoK4OEAM5G+wHz3SBj4FMonZNWs1I -t03JKHoM5ulQ2FgEWmBVIPTKSDm/jQXPYApz5DpxpoGYbTCaEo6zfE32AEzoXDmG -AZE90Xhq/wcEN+JcHpHytAA/n+hYaR3sYegQ52mWMR+vdd99KO0V0jLRcckgBA7Z -2jlFA/98cyy2nYt0QI5Tf+t/d4WBeib2yNWVtZH/j7XpDqHLZDgVAYkazCA6ZF7B -vLddBEqVAh1X5tqua4AXX9L4SGYb7B0LRV72alhYiWWHez126KjVgwRTUxtEJ4En -HmYJRReLlXosPIRhXSz7HFAqalPXJ0DvC9kzTQnnjPOylyMPTbQjVGVzdCBvbmUg -KHBwPWRlZikgPG9uZUBleGFtcGxlLmNvbT6IWgQTEQIAGgUCP/I1CAIbAwILAgMV -AgMDFgIBAh4BAheAAAoJEA73cJbXTF8iUO4AnA8wHb3erMrfWV3ij0d/cEiSJAYF -AJ9fcbShgTXDN1dIVZvLSW5E93TfC7ACAAOIWgQTEQIAGgUCP/I1CAIbAwILAgMV -AgMDFgIBAh4BAheAAAoJEA73cJbXTF8iUO4An3DqZUvcr92tYI+Ewj4jcmzFrNKM -AJ4yYTZj75t4d7WhUv1WjtDgJkkAm7ACAAO5AQ0EP/I1DRAEAOgCS1p47zcdec0U -vVC0phewalHUU6f7mulWr0j0ZY1RU0IOP18HAeT7INcwPcUaUvC9KYenXmYbvO1i -7sNNUCOsKUamwg+oSNMcbM3AwNwxlggTyJS1N6WzIX7MjRLUlUqtbLRhPDGlCltt -6yeAjS0pZT646TANaBDiRIgk94ADAAMFA/9Gh2X1Sy+4Ip/RtMJDPZOY+Y6sWUN7 -OiM2BkdUmCLOmaOVfgrsEevKdSBBj0oVWN81U02i7jQzhhAI3tZMFJmP/hlF7AlS -5HSaLj2+t1nHAKKy70QhskINR41CCv9sHAc5gN1WrY5NDpeI12GmqsWMPQVPUHsT -Te0QsT6XbHzvC4hJBBgRAgAJBQI/8jUNAhsMAAoJEA73cJbXTF8icHgAoMoPkG6U -dFdvTjKc/phZ6XojaDd9AKCokQkuhQ1wgXe2naMXaMGvzRaYzbACAAOZAaIEP/JS -axEEAKxxqlg9Kz9DZ/3N52BC0w+JtYKke39vpdWVDHR3MHmMJ/31Y2iSpm0fvRs3 -h1j9/fBVmLOZglNQyH62SxdJyZwCelkZzfUy/qLm9Qaqi7wpg0p4EbmWdoFF/A1Z -g/MU7D5w5xu+EA1J77Z6QyALN9rIOXZ7rLLa64lw/MV4LdIPAKC449htJbbp5rkJ -HvBDs4YxEIkk5wP/X4hPGlIw5PlHrsG7hdahhTudV5hRGlvosnwsrYJXvKAQLAV1 -EV26SIYUH5pM/ycXrG25dqVoG56uQqnhBdUqo4iSnsxY3ZMA46D14REc9P//CGvJ -/j2Z41gw8u8oB7rS50djvoaWb5myj7bhacTBdfah3U8dVXcIi1ZFvtiaGAYD+gIF -7eNIdpaYiB0427un4ggc26+Y9nkF93DaMnZEaYSeum6g/g7D1vwINFgQkMYEWi4D -K3W+uH0E/n8o20wS2wvMrbeYaQm5v6ucd001wwFDY6AdwpwP7UCLQcu6qqvwNHdx -WYK6+gIsSufLmeMGrsvC0WQqYeu1GfGpHIMCZJlZtCJUZXN0IHR3byAobm8gcHAp -IDx0d29AZXhhbXBsZS5jb20+iF8EExECAB8FAj/yUmsCGwMHCwkIBwMCAQMVAgMD -FgIBAh4BAheAAAoJEJc9UOHED97PgEMAn0F8RGDrnmXv7rqM2+pic2oDz1kpAJ0S -WPHxdjJHWzoGMrHqocAy/3wFi7ACAAO5AQ0EP/JSbxAEAMzYsfnax02AjMUvDYlG -TaVUxp1n8zI8QqlcmWLfQhJuwOCXH0m4EVKaairp8K3rg5pjRhXNVvpU9aC37yWg -4v6EP6Lm4CHKtBGeYDlMnWo/etT1d5bTZmmlEmbCeo0cWmtBQdXIMehFQfPIEeiQ -eJgDOClfgrf3/UMz79kzEvKrAAMGA/43c6bZ7IidduMk1uXsIb1FaZgxrk/QrgN4 -IFuuW4zoX62r1+a3xzAlyz1zDVxYKQNNdr4IVcLp/3pJI+/68WqWZpRNvGKUg4/D -8J/5ZKjQI8uOujMvsFHqAoIO5hIP++YrNqICs8dS+dp2suwRpn0uNeZuwQY1h7Il -AOikbRV7dYhJBBgRAgAJBQI/8lJvAhsMAAoJEJc9UOHED97PLL4AoJlnKVcL7Qzd -5wFU9XTBU7ws9IX8AKCOFbMyQXrBv/Bsi1vnthPi4kF1arACAAOYjAQ/8lO9AQQA -qFJWduzk11/m0Ac/K/mab0kzzr3UUor1bkxh4vcxJHOTZF3a9Y6t1WUpwlOXeCNk -Y98tRYUg6A40wFgkKz/4jdOaiDtHW2bOqrvJmJ/wH/5zdmDpthu53JEgXUKP/+j2 -dfrvYTZYxy2m11DA68QK9iPSBmksglFMQE2IJatwEAEACQEBtCZUZXN0IHRocmVl -IChubyBwcCkgPHRocmVlQGV4YW1wbGUuY29tPoi1BBMBAgAfBQI/8lO9AhsDBwsJ -CAcDAgEDFQIDAxYCAQIeAQIXgAAKCRDRILYm7Kv1HWpDA/9sINfVYaTW7TOQolYn -9Vee4feOTpl6+S4dkgLCOWoDG/V17k/cl7Jr/iQ+YRBOi0S/fFwMBn72kEvdOtmi -UAqHGQFnTyXhBLLvqTJ/yEHR6hnZK+zsusY8EmvoIdfSTIOJqkeACEEpCr0aE0qk -gBm4voMrZ05pAO2hFJbaIHWHibACAAM= -=fphx ------END PGP ARMORED FILE----- diff --git a/tests/migrations/from-classic.gpghome/secring.gpg.asc b/tests/migrations/from-classic.gpghome/secring.gpg.asc deleted file mode 100644 index 6aa367a6b..000000000 --- a/tests/migrations/from-classic.gpghome/secring.gpg.asc +++ /dev/null @@ -1,68 +0,0 @@ ------BEGIN PGP ARMORED FILE----- -Version: GnuPG v2 -Comment: Use "gpg --dearmor" for unpacking - -lQHpBD/yNQgRBAC/KSfe6uVfDgA3BrGpNLhVxT/ytwXMpBI8pEdTiY0jWnYrb/Yu -8wtCeZ9GAux/ZA/ted+7pdibHXfX5PzDfgUTZwrIJa57OUpWwI878AzZxNsnVv1I -P6ufGyESKME4PUQO5heKhwAb0gQwFwArS3v4oeYrEljhJ79kpt319JEAEwCg+hTk -nylYwYGT/PEVQ4JlLPoWmqUEAJn1HX1Od5tyoK4OEAM5G+wHz3SBj4FMonZNWs1I -t03JKHoM5ulQ2FgEWmBVIPTKSDm/jQXPYApz5DpxpoGYbTCaEo6zfE32AEzoXDmG -AZE90Xhq/wcEN+JcHpHytAA/n+hYaR3sYegQ52mWMR+vdd99KO0V0jLRcckgBA7Z -2jlFA/98cyy2nYt0QI5Tf+t/d4WBeib2yNWVtZH/j7XpDqHLZDgVAYkazCA6ZF7B -vLddBEqVAh1X5tqua4AXX9L4SGYb7B0LRV72alhYiWWHez126KjVgwRTUxtEJ4En -HmYJRReLlXosPIRhXSz7HFAqalPXJ0DvC9kzTQnnjPOylyMPTf4HAwI+6Mr+dvBp -XtZVHbBd1xUPHQl/+cIIBV6w3EFQuR6w7OorCYE6OHrHfEsFwCi3PNG5WUsMYIj2 -eddOuyRWtFR/QsaltCNUZXN0IG9uZSAocHA9ZGVmKSA8b25lQGV4YW1wbGUuY29t -PohaBBMRAgAaBQI/8jUIAhsDAgsCAxUCAwMWAgECHgECF4AACgkQDvdwltdMXyJQ -7gCcDzAdvd6syt9ZXeKPR39wSJIkBgUAn19xtKGBNcM3V0hVm8tJbkT3dN8LsAIA -AIhaBBMRAgAaBQI/8jUIAhsDAgsCAxUCAwMWAgECHgECF4AACgkQDvdwltdMXyJQ -7gCfcOplS9yv3a1gj4TCPiNybMWs0owAnjJhNmPvm3h3taFS/VaO0OAmSQCbsAIA -AJ0BXwQ/8jUNEAQA6AJLWnjvNx15zRS9ULSmF7BqUdRTp/ua6VavSPRljVFTQg4/ -XwcB5Psg1zA9xRpS8L0ph6deZhu87WLuw01QI6wpRqbCD6hI0xxszcDA3DGWCBPI -lLU3pbMhfsyNEtSVSq1stGE8MaUKW23rJ4CNLSllPrjpMA1oEOJEiCT3gAMAAwUD -/0aHZfVLL7gin9G0wkM9k5j5jqxZQ3s6IzYGR1SYIs6Zo5V+CuwR68p1IEGPShVY -3zVTTaLuNDOGEAje1kwUmY/+GUXsCVLkdJouPb63WccAorLvRCGyQg1HjUIK/2wc -BzmA3Vatjk0Ol4jXYaaqxYw9BU9QexNN7RCxPpdsfO8L/gcDArbUVjowJlNA1rny -wPbRkyAfJDY8m6+s1oM56PICi8N/E3TM/0A2fOESbsTfW6eKCmrIB3VDnURtVUTv -WS71OKAqhddkD8tUtVQWdKXL5YhJBBgRAgAJBQI/8jUNAhsMAAoJEA73cJbXTF8i -cHgAoMoPkG6UdFdvTjKc/phZ6XojaDd9AKCokQkuhQ1wgXe2naMXaMGvzRaYzbAC -AACVAekEP/JSaxEEAKxxqlg9Kz9DZ/3N52BC0w+JtYKke39vpdWVDHR3MHmMJ/31 -Y2iSpm0fvRs3h1j9/fBVmLOZglNQyH62SxdJyZwCelkZzfUy/qLm9Qaqi7wpg0p4 -EbmWdoFF/A1Zg/MU7D5w5xu+EA1J77Z6QyALN9rIOXZ7rLLa64lw/MV4LdIPAKC4 -49htJbbp5rkJHvBDs4YxEIkk5wP/X4hPGlIw5PlHrsG7hdahhTudV5hRGlvosnws -rYJXvKAQLAV1EV26SIYUH5pM/ycXrG25dqVoG56uQqnhBdUqo4iSnsxY3ZMA46D1 -4REc9P//CGvJ/j2Z41gw8u8oB7rS50djvoaWb5myj7bhacTBdfah3U8dVXcIi1ZF -vtiaGAYD+gIF7eNIdpaYiB0427un4ggc26+Y9nkF93DaMnZEaYSeum6g/g7D1vwI -NFgQkMYEWi4DK3W+uH0E/n8o20wS2wvMrbeYaQm5v6ucd001wwFDY6AdwpwP7UCL -Qcu6qqvwNHdxWYK6+gIsSufLmeMGrsvC0WQqYeu1GfGpHIMCZJlZ/gcDAt0kdqtP -lKPG1udCj4rXVf+JWEOsbdSsnimRh7rcSE5ksh/JzinsE9rm9FRY112AWfzPaj99 -0JAuaDOzn4d/6tPUnHa0IlRlc3QgdHdvIChubyBwcCkgPHR3b0BleGFtcGxlLmNv -bT6IXwQTEQIAHwUCP/JSawIbAwcLCQgHAwIBAxUCAwMWAgECHgECF4AACgkQlz1Q -4cQP3s+AQwCfQXxEYOueZe/uuozb6mJzagPPWSkAnRJY8fF2MkdbOgYyseqhwDL/ -fAWLsAIAAJ0BXwQ/8lJvEAQAzNix+drHTYCMxS8NiUZNpVTGnWfzMjxCqVyZYt9C -Em7A4JcfSbgRUppqKunwreuDmmNGFc1W+lT1oLfvJaDi/oQ/oubgIcq0EZ5gOUyd -aj961PV3ltNmaaUSZsJ6jRxaa0FB1cgx6EVB88gR6JB4mAM4KV+Ct/f9QzPv2TMS -8qsAAwYD/jdzptnsiJ124yTW5ewhvUVpmDGuT9CuA3ggW65bjOhfravX5rfHMCXL -PXMNXFgpA012vghVwun/ekkj7/rxapZmlE28YpSDj8Pwn/lkqNAjy466My+wUeoC -gg7mEg/75is2ogKzx1L52nay7BGmfS415m7BBjWHsiUA6KRtFXt1/gcDAp6cJdVh -287E1o1bCCplLBBjGAPRdWYlnZoJXXn7OUTHTSvMQkEZhAgDOKIiiwC88Drlk+bS -m9MngTW7YnBsrRfIGhpSxLcYSeMk2xu8m4hJBBgRAgAJBQI/8lJvAhsMAAoJEJc9 -UOHED97PLL4AoJlnKVcL7Qzd5wFU9XTBU7ws9IX8AKCOFbMyQXrBv/Bsi1vnthPi -4kF1arACAACVAgQEP/JTvQEEAKhSVnbs5Ndf5tAHPyv5mm9JM8691FKK9W5MYeL3 -MSRzk2Rd2vWOrdVlKcJTl3gjZGPfLUWFIOgONMBYJCs/+I3Tmog7R1tmzqq7yZif -8B/+c3Zg6bYbudyRIF1Cj//o9nX672E2WMctptdQwOvECvYj0gZpLIJRTEBNiCWr -cBABAAkBAf4HAwL3+6VQeHRq3tZqCOiuxPcuaSlTpURzbLJBa70QpeAbLZjOIjbm -dQuNBzmxYZNe5V8mf33q2gn/P9vjki0Z/k96qJOXBgLSJkyK4FPi2dtqKkrOonkx -rFv2AZ6Gt3zGp6dN3meYvG8GIiIvFiZmKYOrt4/XsAnPhXetbN23vO3dJxquD9sw -O8phwR2u6ii789nbXjD6vOyyv7WcogUVQTHC9pJQrOkDX9aMxiVWHvvv2o2FOU/n -JanwL/QN4J0sL36ytLoqhsUnayhhHbAP5TA+Vbk9JWvwO+6n8KDiUOkyaIzDaOgr -BvU1eMSv89MiYH8JiNU9nO9ungT0hxJMn9OwFcrXGCXZ6xXct9yN4nlVV0r16032 -DE7m0JQuwoLm4S7OkQEBHlvtfs/WZzMWkFbduOarPr1uzf92BaSjpQLEAKCFgX1/ -zBPnmqDOnOdL4AIZcYR+q+vWvQLI1RoYSCiodfNQt7iq2IRF8j4qis88QC/JMb60 -JlRlc3QgdGhyZWUgKG5vIHBwKSA8dGhyZWVAZXhhbXBsZS5jb20+iLUEEwECAB8F -Aj/yU70CGwMHCwkIBwMCAQMVAgMDFgIBAh4BAheAAAoJENEgtibsq/UdakMD/2wg -19VhpNbtM5CiVif1V57h945OmXr5Lh2SAsI5agMb9XXuT9yXsmv+JD5hEE6LRL98 -XAwGfvaQS9062aJQCocZAWdPJeEEsu+pMn/IQdHqGdkr7Oy6xjwSa+gh19JMg4mq -R4AIQSkKvRoTSqSAGbi+gytnTmkA7aEUltogdYeJsAIAAA== -=QqWQ ------END PGP ARMORED FILE----- diff --git a/tests/migrations/from-classic.gpghome/trustdb.gpg.asc b/tests/migrations/from-classic.gpghome/trustdb.gpg.asc deleted file mode 100644 index d4ab65d5e..000000000 --- a/tests/migrations/from-classic.gpghome/trustdb.gpg.asc +++ /dev/null @@ -1,31 +0,0 @@ ------BEGIN PGP ARMORED FILE----- -Version: GnuPG v2 -Comment: Use "gpg --dearmor" for unpacking - -AWdwZwMDAQUBAgAAVxdnIQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQoAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -=XUWW ------END PGP ARMORED FILE----- diff --git a/tests/migrations/from-classic.scm b/tests/migrations/from-classic.scm new file mode 100755 index 000000000..2128532d8 --- /dev/null +++ b/tests/migrations/from-classic.scm @@ -0,0 +1,61 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "common.scm")) + +(define src-tarball (in-srcdir "from-classic.tar.asc")) + +(define (setup) + (untar-armored src-tarball) + (setenv "GNUPGHOME" (getcwd) #t)) + +(define (trigger-migration) + (call-check `(,@GPG --list-secret-keys))) + +(define (assert-migrated) + (unless (file-exists? ".gpg-v21-migrated") + (error "Not migrated")) + + (for-each + (lambda (keyid) + (catch (error "Key not found:" keyid) + (call-check `(,@GPG --list-secret-keys ,keyid)))) + '("D74C5F22" "C40FDECF" "ECABF51D"))) + +(info "Testing a clean migration ...") +(with-temporary-working-directory + (setup) + (trigger-migration) + (assert-migrated)) + +(info "Testing a migration with existing private-keys-v1.d ...") +(with-temporary-working-directory + (setup) + (mkdir "private-keys-v1.d" "-rwx") + (trigger-migration) + (assert-migrated)) + +(info "Testing a migration with existing but weird private-keys-v1.d ...") +(with-temporary-working-directory + (setup) + (mkdir "private-keys-v1.d" "") + (trigger-migration) + (assert-migrated)) + +;; XXX Check a case where the migration fails. diff --git a/tests/migrations/from-classic.tar.asc b/tests/migrations/from-classic.tar.asc new file mode 100644 index 000000000..f35637d50 --- /dev/null +++ b/tests/migrations/from-classic.tar.asc @@ -0,0 +1,209 @@ +-----BEGIN PGP ARMORED FILE----- +Version: GnuPG v2 +Comment: Use "gpg --dearmor" for unpacking + +cHVicmluZy5ncGcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAADAwMDA2NDQAMDAwMTc1MAAwMDAxNzUwADAwMDAwMDA0MzQ3ADEyNzM2NzI0 +NjE3ADAxMzYxNgAgMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAB1c3RhcgAwMHRleXRob29uAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAdGV5dGhvb24AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACZAaIEP/I1CBEEAL8pJ97q +5V8OADcGsak0uFXFP/K3BcykEjykR1OJjSNaditv9i7zC0J5n0YC7H9kD+1537ul +2Jsdd9fk/MN+BRNnCsglrns5SlbAjzvwDNnE2ydW/Ug/q58bIRIowTg9RA7mF4qH +ABvSBDAXACtLe/ih5isSWOEnv2Sm3fX0kQATAKD6FOSfKVjBgZP88RVDgmUs+haa +pQQAmfUdfU53m3Kgrg4QAzkb7AfPdIGPgUyidk1azUi3Tckoegzm6VDYWARaYFUg +9MpIOb+NBc9gCnPkOnGmgZhtMJoSjrN8TfYATOhcOYYBkT3ReGr/BwQ34lwekfK0 +AD+f6FhpHexh6BDnaZYxH691330o7RXSMtFxySAEDtnaOUUD/3xzLLadi3RAjlN/ +6393hYF6JvbI1ZW1kf+PtekOoctkOBUBiRrMIDpkXsG8t10ESpUCHVfm2q5rgBdf +0vhIZhvsHQtFXvZqWFiJZYd7PXboqNWDBFNTG0QngSceZglFF4uVeiw8hGFdLPsc +UCpqU9cnQO8L2TNNCeeM87KXIw9NtCNUZXN0IG9uZSAocHA9ZGVmKSA8b25lQGV4 +YW1wbGUuY29tPohaBBMRAgAaBQI/8jUIAhsDAgsCAxUCAwMWAgECHgECF4AACgkQ +DvdwltdMXyJQ7gCcDzAdvd6syt9ZXeKPR39wSJIkBgUAn19xtKGBNcM3V0hVm8tJ +bkT3dN8LsAIAA4haBBMRAgAaBQI/8jUIAhsDAgsCAxUCAwMWAgECHgECF4AACgkQ +DvdwltdMXyJQ7gCfcOplS9yv3a1gj4TCPiNybMWs0owAnjJhNmPvm3h3taFS/VaO +0OAmSQCbsAIAA7kBDQQ/8jUNEAQA6AJLWnjvNx15zRS9ULSmF7BqUdRTp/ua6Vav +SPRljVFTQg4/XwcB5Psg1zA9xRpS8L0ph6deZhu87WLuw01QI6wpRqbCD6hI0xxs +zcDA3DGWCBPIlLU3pbMhfsyNEtSVSq1stGE8MaUKW23rJ4CNLSllPrjpMA1oEOJE +iCT3gAMAAwUD/0aHZfVLL7gin9G0wkM9k5j5jqxZQ3s6IzYGR1SYIs6Zo5V+CuwR +68p1IEGPShVY3zVTTaLuNDOGEAje1kwUmY/+GUXsCVLkdJouPb63WccAorLvRCGy +Qg1HjUIK/2wcBzmA3Vatjk0Ol4jXYaaqxYw9BU9QexNN7RCxPpdsfO8LiEkEGBEC +AAkFAj/yNQ0CGwwACgkQDvdwltdMXyJweACgyg+QbpR0V29OMpz+mFnpeiNoN30A +oKiRCS6FDXCBd7adoxdowa/NFpjNsAIAA5kBogQ/8lJrEQQArHGqWD0rP0Nn/c3n +YELTD4m1gqR7f2+l1ZUMdHcweYwn/fVjaJKmbR+9GzeHWP398FWYs5mCU1DIfrZL +F0nJnAJ6WRnN9TL+oub1BqqLvCmDSngRuZZ2gUX8DVmD8xTsPnDnG74QDUnvtnpD +IAs32sg5dnusstrriXD8xXgt0g8AoLjj2G0ltunmuQke8EOzhjEQiSTnA/9fiE8a +UjDk+UeuwbuF1qGFO51XmFEaW+iyfCytgle8oBAsBXURXbpIhhQfmkz/Jxesbbl2 +pWgbnq5CqeEF1SqjiJKezFjdkwDjoPXhERz0//8Ia8n+PZnjWDDy7ygHutLnR2O+ +hpZvmbKPtuFpxMF19qHdTx1VdwiLVkW+2JoYBgP6AgXt40h2lpiIHTjbu6fiCBzb +r5j2eQX3cNoydkRphJ66bqD+DsPW/Ag0WBCQxgRaLgMrdb64fQT+fyjbTBLbC8yt +t5hpCbm/q5x3TTXDAUNjoB3CnA/tQItBy7qqq/A0d3FZgrr6AixK58uZ4wauy8LR +ZCph67UZ8akcgwJkmVm0IlRlc3QgdHdvIChubyBwcCkgPHR3b0BleGFtcGxlLmNv +bT6IXwQTEQIAHwUCP/JSawIbAwcLCQgHAwIBAxUCAwMWAgECHgECF4AACgkQlz1Q +4cQP3s+AQwCfQXxEYOueZe/uuozb6mJzagPPWSkAnRJY8fF2MkdbOgYyseqhwDL/ +fAWLsAIAA7kBDQQ/8lJvEAQAzNix+drHTYCMxS8NiUZNpVTGnWfzMjxCqVyZYt9C +Em7A4JcfSbgRUppqKunwreuDmmNGFc1W+lT1oLfvJaDi/oQ/oubgIcq0EZ5gOUyd +aj961PV3ltNmaaUSZsJ6jRxaa0FB1cgx6EVB88gR6JB4mAM4KV+Ct/f9QzPv2TMS +8qsAAwYD/jdzptnsiJ124yTW5ewhvUVpmDGuT9CuA3ggW65bjOhfravX5rfHMCXL +PXMNXFgpA012vghVwun/ekkj7/rxapZmlE28YpSDj8Pwn/lkqNAjy466My+wUeoC +gg7mEg/75is2ogKzx1L52nay7BGmfS415m7BBjWHsiUA6KRtFXt1iEkEGBECAAkF +Aj/yUm8CGwwACgkQlz1Q4cQP3s8svgCgmWcpVwvtDN3nAVT1dMFTvCz0hfwAoI4V +szJBesG/8GyLW+e2E+LiQXVqsAIAA5iMBD/yU70BBACoUlZ27OTXX+bQBz8r+Zpv +STPOvdRSivVuTGHi9zEkc5NkXdr1jq3VZSnCU5d4I2Rj3y1FhSDoDjTAWCQrP/iN +05qIO0dbZs6qu8mYn/Af/nN2YOm2G7nckSBdQo//6PZ1+u9hNljHLabXUMDrxAr2 +I9IGaSyCUUxATYglq3AQAQAJAQG0JlRlc3QgdGhyZWUgKG5vIHBwKSA8dGhyZWVA +ZXhhbXBsZS5jb20+iLUEEwECAB8FAj/yU70CGwMHCwkIBwMCAQMVAgMDFgIBAh4B +AheAAAoJENEgtibsq/UdakMD/2wg19VhpNbtM5CiVif1V57h945OmXr5Lh2SAsI5 +agMb9XXuT9yXsmv+JD5hEE6LRL98XAwGfvaQS9062aJQCocZAWdPJeEEsu+pMn/I +QdHqGdkr7Oy6xjwSa+gh19JMg4mqR4AIQSkKvRoTSqSAGbi+gytnTmkA7aEUltog +dYeJsAIAA2aUTbxilIOPw/Cf+WSo0CPLjrozL7BR6gKCDuYSD/vmKzaiArPHUvna +drLsEaZ9LjXmbsEGNYeyJQDopG0Ve3WISQQYEQIACQUCP/JSbwIbDAAKCRCXPVDh +xA/ezyy+AKCZZylXC+0M3ecBVPV0wVO8LPSF/ACgjhWzMkF6wb/wbItb57YT4uJB +dWqwAgADmIwEP/JTvQEEAKhSVnbs5Ndf5tAHPyv5mm9JM8691FKK9W5MYeL3MSRz +k2Rd2vWOrdVlKcJTl3gjZGPfLUWFIOgONMBYJCs/+I3Tmog7R1tmzqq7yZif8B/+ +c3Zg6bYbudyRIF1Cj//o9nX672E2WMctptdQwOvECvYj0gZpLIJRTEBNiCWrcBAB +c2VjcmluZy5ncGcAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAADAwMDA2NDQAMDAwMTc1MAAwMDAxNzUwADAwMDAwMDA1NjIyADEyNzM2NzI0 +NjE3ADAxMzU3NwAgMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAB1c3RhcgAwMHRleXRob29uAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAdGV5dGhvb24AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACVAekEP/I1CBEEAL8pJ97q +5V8OADcGsak0uFXFP/K3BcykEjykR1OJjSNaditv9i7zC0J5n0YC7H9kD+1537ul +2Jsdd9fk/MN+BRNnCsglrns5SlbAjzvwDNnE2ydW/Ug/q58bIRIowTg9RA7mF4qH +ABvSBDAXACtLe/ih5isSWOEnv2Sm3fX0kQATAKD6FOSfKVjBgZP88RVDgmUs+haa +pQQAmfUdfU53m3Kgrg4QAzkb7AfPdIGPgUyidk1azUi3Tckoegzm6VDYWARaYFUg +9MpIOb+NBc9gCnPkOnGmgZhtMJoSjrN8TfYATOhcOYYBkT3ReGr/BwQ34lwekfK0 +AD+f6FhpHexh6BDnaZYxH691330o7RXSMtFxySAEDtnaOUUD/3xzLLadi3RAjlN/ +6393hYF6JvbI1ZW1kf+PtekOoctkOBUBiRrMIDpkXsG8t10ESpUCHVfm2q5rgBdf +0vhIZhvsHQtFXvZqWFiJZYd7PXboqNWDBFNTG0QngSceZglFF4uVeiw8hGFdLPsc +UCpqU9cnQO8L2TNNCeeM87KXIw9N/gcDAj7oyv528Gle1lUdsF3XFQ8dCX/5wggF +XrDcQVC5HrDs6isJgTo4esd8SwXAKLc80blZSwxgiPZ51067JFa0VH9CxqW0I1Rl +c3Qgb25lIChwcD1kZWYpIDxvbmVAZXhhbXBsZS5jb20+iFoEExECABoFAj/yNQgC +GwMCCwIDFQIDAxYCAQIeAQIXgAAKCRAO93CW10xfIlDuAJwPMB293qzK31ld4o9H +f3BIkiQGBQCfX3G0oYE1wzdXSFWby0luRPd03wuwAgAAiFoEExECABoFAj/yNQgC +GwMCCwIDFQIDAxYCAQIeAQIXgAAKCRAO93CW10xfIlDuAJ9w6mVL3K/drWCPhMI+ +I3JsxazSjACeMmE2Y++beHe1oVL9Vo7Q4CZJAJuwAgAAnQFfBD/yNQ0QBADoAkta +eO83HXnNFL1QtKYXsGpR1FOn+5rpVq9I9GWNUVNCDj9fBwHk+yDXMD3FGlLwvSmH +p15mG7ztYu7DTVAjrClGpsIPqEjTHGzNwMDcMZYIE8iUtTelsyF+zI0S1JVKrWy0 +YTwxpQpbbesngI0tKWU+uOkwDWgQ4kSIJPeAAwADBQP/Rodl9UsvuCKf0bTCQz2T +mPmOrFlDezojNgZHVJgizpmjlX4K7BHrynUgQY9KFVjfNVNNou40M4YQCN7WTBSZ +j/4ZRewJUuR0mi49vrdZxwCisu9EIbJCDUeNQgr/bBwHOYDdVq2OTQ6XiNdhpqrF +jD0FT1B7E03tELE+l2x87wv+BwMCttRWOjAmU0DWufLA9tGTIB8kNjybr6zWgzno +8gKLw38TdMz/QDZ84RJuxN9bp4oKasgHdUOdRG1VRO9ZLvU4oCqF12QPy1S1VBZ0 +pcvliEkEGBECAAkFAj/yNQ0CGwwACgkQDvdwltdMXyJweACgyg+QbpR0V29OMpz+ +mFnpeiNoN30AoKiRCS6FDXCBd7adoxdowa/NFpjNsAIAAJUB6QQ/8lJrEQQArHGq +WD0rP0Nn/c3nYELTD4m1gqR7f2+l1ZUMdHcweYwn/fVjaJKmbR+9GzeHWP398FWY +s5mCU1DIfrZLF0nJnAJ6WRnN9TL+oub1BqqLvCmDSngRuZZ2gUX8DVmD8xTsPnDn +G74QDUnvtnpDIAs32sg5dnusstrriXD8xXgt0g8AoLjj2G0ltunmuQke8EOzhjEQ +iSTnA/9fiE8aUjDk+UeuwbuF1qGFO51XmFEaW+iyfCytgle8oBAsBXURXbpIhhQf +mkz/Jxesbbl2pWgbnq5CqeEF1SqjiJKezFjdkwDjoPXhERz0//8Ia8n+PZnjWDDy +7ygHutLnR2O+hpZvmbKPtuFpxMF19qHdTx1VdwiLVkW+2JoYBgP6AgXt40h2lpiI +HTjbu6fiCBzbr5j2eQX3cNoydkRphJ66bqD+DsPW/Ag0WBCQxgRaLgMrdb64fQT+ +fyjbTBLbC8ytt5hpCbm/q5x3TTXDAUNjoB3CnA/tQItBy7qqq/A0d3FZgrr6AixK +58uZ4wauy8LRZCph67UZ8akcgwJkmVn+BwMC3SR2q0+Uo8bW50KPitdV/4lYQ6xt +1KyeKZGHutxITmSyH8nOKewT2ub0VFjXXYBZ/M9qP33QkC5oM7Ofh3/q09ScdrQi +VGVzdCB0d28gKG5vIHBwKSA8dHdvQGV4YW1wbGUuY29tPohfBBMRAgAfBQI/8lJr +AhsDBwsJCAcDAgEDFQIDAxYCAQIeAQIXgAAKCRCXPVDhxA/ez4BDAJ9BfERg655l +7+66jNvqYnNqA89ZKQCdEljx8XYyR1s6BjKx6qHAMv98BYuwAgAAnQFfBD/yUm8Q +BADM2LH52sdNgIzFLw2JRk2lVMadZ/MyPEKpXJli30ISbsDglx9JuBFSmmoq6fCt +64OaY0YVzVb6VPWgt+8loOL+hD+i5uAhyrQRnmA5TJ1qP3rU9XeW02ZppRJmwnqN +HFprQUHVyDHoRUHzyBHokHiYAzgpX4K39/1DM+/ZMxLyqwADBgP+N3Om2eyInXbj +JNbl7CG9RWmYMa5P0K4DeCBbrluM6F+tq9fmt8cwJcs9cw1cWCkDTXa+CFXC6f96 +SSPv+vFqlmaUTbxilIOPw/Cf+WSo0CPLjrozL7BR6gKCDuYSD/vmKzaiArPHUvna +drLsEaZ9LjXmbsEGNYeyJQDopG0Ve3X+BwMCnpwl1WHbzsTWjVsIKmUsEGMYA9F1 +ZiWdmgldefs5RMdNK8xCQRmECAM4oiKLALzwOuWT5tKb0yeBNbticGytF8gaGlLE +txhJ4yTbG7ybiEkEGBECAAkFAj/yUm8CGwwACgkQlz1Q4cQP3s8svgCgmWcpVwvt +DN3nAVT1dMFTvCz0hfwAoI4VszJBesG/8GyLW+e2E+LiQXVqsAIAAJUCBAQ/8lO9 +AQQAqFJWduzk11/m0Ac/K/mab0kzzr3UUor1bkxh4vcxJHOTZF3a9Y6t1WUpwlOX +eCNkY98tRYUg6A40wFgkKz/4jdOaiDtHW2bOqrvJmJ/wH/5zdmDpthu53JEgXUKP +/+j2dfrvYTZYxy2m11DA68QK9iPSBmksglFMQE2IJatwEAEACQEB/gcDAvf7pVB4 +dGre1moI6K7E9y5pKVOlRHNsskFrvRCl4BstmM4iNuZ1C40HObFhk17lXyZ/fera +Cf8/2+OSLRn+T3qok5cGAtImTIrgU+LZ22oqSs6ieTGsW/YBnoa3fManp03eZ5i8 +bwYiIi8WJmYpg6u3j9ewCc+Fd61s3be87d0nGq4P2zA7ymHBHa7qKLvz2dteMPq8 +7LK/tZyiBRVBMcL2klCs6QNf1ozGJVYe++/ajYU5T+clqfAv9A3gnSwvfrK0uiqG +xSdrKGEdsA/lMD5VuT0la/A77qfwoOJQ6TJojMNo6CsG9TV4xK/z0yJgfwmI1T2c +726eBPSHEkyf07AVytcYJdnrFdy33I3ieVVXSvXrTfYMTubQlC7CgubhLs6RAQEe +W+1+z9ZnMxaQVt245qs+vW7N/3YFpKOlAsQAoIWBfX/ME+eaoM6c50vgAhlxhH6r +69a9AsjVGhhIKKh181C3uKrYhEXyPiqKzzxAL8kxvrQmVGVzdCB0aHJlZSAobm8g +cHApIDx0aHJlZUBleGFtcGxlLmNvbT6ItQQTAQIAHwUCP/JTvQIbAwcLCQgHAwIB +AxUCAwMWAgECHgECF4AACgkQ0SC2Juyr9R1qQwP/bCDX1WGk1u0zkKJWJ/VXnuH3 +jk6ZevkuHZICwjlqAxv1de5P3Jeya/4kPmEQTotEv3xcDAZ+9pBL3TrZolAKhxkB +Z08l4QSy76kyf8hB0eoZ2Svs7LrGPBJr6CHX0kyDiapHgAhBKQq9GhNKpIAZuL6D +K2dOaQDtoRSW2iB1h4mwAgAA9gGehrd8xqenTd5nmLxvBiIiLxYmZimDq7eP17AJ +z4V3rWzdt7zt3Scarg/bMDvKYcEdruoou/PZ214w+rzssr+1nKIFFUExwvaSUKzp +A1/WjMYlVh7779qNhTlP5yWp8C/0DeCdLC9+srS6KoZ0cnVzdGRiLmdwZwAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMDAwMDY0NAAwMDAx +NzUwADAwMDE3NTAAMDAwMDAwMDIyNjAAMTI3MzY3MjQ2MTcAMDEzNjI3ACAwAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AHVzdGFyADAwdGV5dGhvb24AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB0ZXl0aG9v +bgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAFncGcDAwEFAQIAAFcXZyEAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAEKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA= +=nYpX +-----END PGP ARMORED FILE----- diff --git a/tests/migrations/from-classic.test b/tests/migrations/from-classic.test deleted file mode 100755 index 9b81d452b..000000000 --- a/tests/migrations/from-classic.test +++ /dev/null @@ -1,77 +0,0 @@ -#!/bin/sh -# Copyright 2016 g10 Code GmbH -# -# This file is free software; as a special exception the author gives -# unlimited permission to copy and/or distribute it, with or without -# modifications, as long as this notice is preserved. This file is -# distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY, to the extent permitted by law; without even the implied -# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -if [ -z "$srcdir" ]; then - echo "not called from make" >&2 - exit 1 -fi - -unset GNUPGHOME -set -e - -# (We may not use a relative name for gpg-agent.) -GPG_AGENT="$(cd ../../agent && /bin/pwd)/gpg-agent" -GPG="../../g10/gpg --no-permission-warning --no-greeting --no-secmem-warning ---batch --agent-program=${GPG_AGENT}|--debug-quick-random" - -TEST="from-classic" - -setup_home() -{ - XGNUPGHOME="`mktemp -d`" - rm -rf -- scratch - mkdir -p "$XGNUPGHOME" - for F in $srcdir/$TEST.gpghome/*.asc; do - $GPG --dearmor <"$F" >"$XGNUPGHOME/`basename $F .asc`" - done - chmod go-rwx $XGNUPGHOME/* - export GNUPGHOME="$XGNUPGHOME" -} - -cleanup_home() -{ - rm -rf -- "$XGNUPGHOME" -} - -trigger_migration() -{ - $GPG --list-secret-keys >/dev/null 2>&1 -} - -assert_migrated() -{ - test -f $GNUPGHOME/.gpg-v21-migrated - - for KEY in D74C5F22 C40FDECF ECABF51D; do - $GPG --list-secret-keys $KEY >/dev/null - done -} - -setup_home -trigger_migration -assert_migrated -cleanup_home - -# Test with an existing private-keys-v1.d. -setup_home -mkdir "$GNUPGHOME/private-keys-v1.d" -trigger_migration -assert_migrated -cleanup_home - -# Test with an existing private-keys-v1.d with weird permissions. -setup_home -mkdir "$GNUPGHOME/private-keys-v1.d" -chmod 0 "$GNUPGHOME/private-keys-v1.d" -trigger_migration -assert_migrated -cleanup_home - -# XXX Check a case where the migration fails. diff --git a/tests/openpgp/4gb-packet.scm b/tests/openpgp/4gb-packet.scm new file mode 100755 index 000000000..8b2fcd6ca --- /dev/null +++ b/tests/openpgp/4gb-packet.scm @@ -0,0 +1,27 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +;; GnuPG through 2.1.7 would incorrect mark packets whose size is +;; 2^32-1 as invalid and exit with status code 2. + +(load (with-path "defs.scm")) + +(if (= 0 (call `(,@GPG --list-packets ,(in-srcdir "4gb-packet.asc")))) + (info "Can parse 4GB packets.") + (error "Failed to parse 4GB packet.")) diff --git a/tests/openpgp/Makefile.am b/tests/openpgp/Makefile.am index bb1047d5e..012a3f20c 100644 --- a/tests/openpgp/Makefile.am +++ b/tests/openpgp/Makefile.am @@ -22,7 +22,8 @@ # Programs required before we can run these tests. required_pgms = ../../g10/gpg$(EXEEXT) ../../agent/gpg-agent$(EXEEXT) \ ../../tools/gpg-connect-agent$(EXEEXT) \ - ../../tools/mk-tdata$(EXEEXT) + ../../tools/mk-tdata$(EXEEXT) \ + ../gpgscm/gpgscm$(EXEEXT) AM_CPPFLAGS = -I$(top_srcdir)/common include $(top_srcdir)/am/cmacros.am @@ -33,32 +34,54 @@ noinst_PROGRAMS = fake-pinentry fake_pinentry_SOURCES = fake-pinentry.c -TESTS_ENVIRONMENT = GNUPGHOME=$(abs_builddir) GPG_AGENT_INFO= LC_ALL=C +TMP ?= /tmp -if SQLITE3 -sqlite3_dependent_tests = tofu.test -else -sqlite3_dependent_tests = -endif +TESTS_ENVIRONMENT = GNUPGHOME=$(abs_builddir) GPG_AGENT_INFO= LC_ALL=C \ + EXEEXT=$(EXEEXT) \ + PATH=../gpgscm:$(PATH) \ + TMP=$(TMP) \ + objdir=$(abs_top_builddir) \ + GPGSCM_PATH=$(top_srcdir)/tests/gpgscm:$(top_srcdir)/tests/openpgp -# Note: version.test needs to be the first test to run and finish.test +# Note: setup.scm needs to be the first test to run and finish.scm # the last one -TESTS = version.test mds.test \ - decrypt.test decrypt-dsa.test \ - sigs.test sigs-dsa.test \ - encrypt.test encrypt-dsa.test \ - seat.test clearsig.test encryptp.test detach.test \ - armsigs.test armencrypt.test armencryptp.test \ - signencrypt.test signencrypt-dsa.test \ - armsignencrypt.test armdetach.test \ - armdetachm.test detachm.test genkey1024.test \ - conventional.test conventional-mdc.test \ - multisig.test verify.test armor.test \ - import.test ecc.test 4gb-packet.test \ - $(sqlite3_dependent_tests) \ - gpgtar.test use-exact-key.test default-key.test \ - export.test \ - finish.test +TESTS = setup.scm \ + version.scm \ + mds.scm \ + decrypt.scm \ + decrypt-dsa.scm \ + sigs.scm \ + sigs-dsa.scm \ + encrypt.scm \ + encrypt-dsa.scm \ + seat.scm \ + clearsig.scm \ + encryptp.scm \ + detach.scm \ + detachm.scm \ + armsigs.scm \ + armencrypt.scm \ + armencryptp.scm \ + signencrypt.scm \ + signencrypt-dsa.scm \ + armsignencrypt.scm \ + armdetach.scm \ + armdetachm.scm \ + genkey1024.scm \ + conventional.scm \ + conventional-mdc.scm \ + multisig.scm \ + verify.scm \ + armor.scm \ + import.scm \ + ecc.scm \ + 4gb-packet.scm \ + tofu.scm \ + gpgtar.scm \ + use-exact-key.scm \ + default-key.scm \ + export.scm \ + finish.scm TEST_FILES = pubring.asc secring.asc plain-1o.asc plain-2o.asc plain-3o.asc \ @@ -98,10 +121,14 @@ priv_keys = privkeys/50B2D4FA4122C212611048BC5FC31BD44393626E.asc \ privkeys/1DF48228FEFF3EC2481B106E0ACA8C465C662CC5.asc \ privkeys/A2832820DC9F40751BDCD375BB0945BA33EC6B4C.asc \ privkeys/ADE710D74409777B7729A7653373D820F67892E0.asc \ - privkeys/CEFC51AF91F68A2904FBFF62C4F075A4785B803F.asc + privkeys/CEFC51AF91F68A2904FBFF62C4F075A4785B803F.asc \ + privkeys/1E28F20E41B54C2D1234D896096495FF57E08D18.asc \ + privkeys/EB33B687EB8581AB64D04852A54453E85F3DF62D.asc \ + privkeys/C6A6390E9388CDBAD71EAEA698233FE5E04F001E.asc \ + privkeys/D69102E0F5AC6B6DB8E4D16DA8E18CF46D88CAE3.asc - -sample_keys = samplekeys/ecc-sample-1-pub.asc \ +sample_keys = samplekeys/README \ + samplekeys/ecc-sample-1-pub.asc \ samplekeys/ecc-sample-2-pub.asc \ samplekeys/ecc-sample-3-pub.asc \ samplekeys/ecc-sample-1-sec.asc \ @@ -114,10 +141,14 @@ sample_keys = samplekeys/ecc-sample-1-pub.asc \ samplekeys/whats-new-in-2.1.asc \ samplekeys/e2e-p256-1-clr.asc \ samplekeys/e2e-p256-1-prt.asc \ - samplekeys/E657FB607BB4F21C90BB6651BC067AF28BC90111.asc + samplekeys/E657FB607BB4F21C90BB6651BC067AF28BC90111.asc \ + samplekeys/rsa-rsa-sample-1.asc \ + samplekeys/ed25519-cv25519-sample-1.asc \ + samplekeys/silent-running.asc -EXTRA_DIST = defs.inc pinentry.sh $(TESTS) $(TEST_FILES) ChangeLog-2011 \ - mkdemodirs signdemokey $(priv_keys) $(sample_keys) +EXTRA_DIST = defs.inc defs.scm pinentry.sh $(TESTS) $(TEST_FILES) \ + mkdemodirs signdemokey $(priv_keys) $(sample_keys) \ + ChangeLog-2011 CLEANFILES = prepared.stamp x y yy z out err $(data_files) \ plain-1 plain-2 plain-3 trustdb.gpg *.lock .\#lk* \ diff --git a/tests/openpgp/README b/tests/openpgp/README new file mode 100644 index 000000000..1f8654b08 --- /dev/null +++ b/tests/openpgp/README @@ -0,0 +1,161 @@ +# Emacs, this is an -*- org -*- file. + +* How to run the test suite +** using the legacy driver +On POSIX you can just use + + $ make -C tests/openpgp check + +or + + $ make -C tests/openpgp check TESTS="setup.scm your-test.scm finish.scm" + +as before. +** using the Scheme driver +This is a bit tricky because one needs to manually set some +environment variables. We should make that easier. See discussion +below. From your build directory, do: + + obj $ srcdir=/tests/openpgp \ + GPGSCM_PATH=/tests/gpgscm:/tests/openpgp \ + $(pwd)/tests/gpgscm/gpgscm [gpgscm args] \ + run-tests.scm [test suite runner args] + +*** Arguments supported by the test suite runner +The test suite runner supports four modes of operation, +{sequential,parallel}x{isolated,shared}. You can select the mode of +operation using a combination of the flags --parallel, --sequential, +--shared, and --isolated. + +By default the tests are run in sequential order, each one in a clean +environment. + +You can specify the tests to run as positional arguments relative to +srcdir (e.g. just 'version.scm'). By default all tests listed in +run-tests.scm are executed. Note that you do not have to specify +setup.scm and finish.scm, they are executed implicitly. + +The test suite runner can be executed in any location that the current +user can write to. It will create temporary files and directories, +but will in general clean up all of them. +*** Discussion of the various environment variables +**** srcdir +Must be set to the source of the openpgp test suite. Used to locate +data files. +**** GPGSCM_PATH +Used to locate the Scheme library as well as code used by the test +suite. +**** BIN_PREFIX +The test suite does not hardcode any paths to tools. If set it is +used to locate the tools to test, otherwise the test suite assumes to +be run from the build directory. +**** MKTDATA and GPG_PRESET_PASSPHRASE +These two tools are not installed by 'make install', hence we need to +explicitly override their position. In fact, the location of any tool +used by the test suite can be overridden this way. See defs.scm. +**** argv[0] +run-tests.scm depends on being able to re-exec gpgscm. It uses +argv[0] for that. Therefore you must use an absolute path to invoke +gpgscm. +* How to write tests +gpgscm provides a number of functions to aid you in writing tests, as +well as bindings to process management abstractions provided by GnuPG. +For the Scheme environment provided by TinySCHEME, see the TinySCHEME +manual that is included in tests/gpgscm/Manual.txt. + +For a quick start, please have a look at various tests that are +already implemented, e.g. 'encrypt.scm'. +** The test framework +The functions info, error, and skip display their first argument and +flush the output buffers. error and skip will also terminate the +process, signaling that the test failed or should be skipped. + +(for-each-p msg proc list) will display msg, and call proc with each +element of list while displaying the progress appropriately. +for-each-p' is similar, but accepts another callback before the 'list' +argument to format each item. for-each-p can be safely nested, and +the inner progress indicator will be abbreviated using '.'. +** Temporary files +(lettmp ) will create and delete temporary files that +you can use in . (with-temporary-working-directory ) will +create a temporary director, change to that, and clean it up after +executing ). + +make-temporary-file will create a temporary file. You can optionally +provide an argument to that function that will serve as tag so you can +distinguish the files for debugging. remove-temporary-file will +delete a file created using make-temporary-file. + +** Monadic transformer and pipe support +Tests often perform sequential transformations on files, or connect +processes using pipes. To aid you in this, the test framework +provides two monadic data structures. + +(Currently, the implementation mashes the 'bind' operation together +with the application of the monad. Also, there is no 'return' +operation. I guess all of that could be implemented on top of +call/cc, but it isn't at the moment.) +*** pipe +The pipe monad constructs pipe lines. It consists of a function +pipe:do that binds the functions together and manages the execution of +the child processes, a family of functions that act as sources, a +function to spawn processes, and a family of functions acting as +sinks. + +Sources are pipe:open, pipe:defer, pipe:echo. To spawn a process use +pipe:spawn, or the convenience function pipe:gpg. To sink the data +use pipe:splice, or pipe:write-to. + +Example: + + (pipe:do + (pipe:echo "3\n1\n2\n") + (pipe:spawn '("/usr/bin/sort")) + (pipe:write-to "sorted" (logior O_WRONLY O_CREAT) #o600)) + +Caveats: Due to the single-threaded nature of gpgscm you cannot use +both a source and sink that is implemented in Scheme. pipe:defer and +pipe:echo are executing in gpgscm, and so does pipe:splice. +*** tr +The transformer monad describes sequential file transformations. + +There is one source function, tr:open. To describe a transformation +using some process, use tr:spawn, tr:gpg, or tr:pipe-do. There are +several sinks, although sink is not quite the right term, because the +data is not consumed, and hence one can use them at any position. The +"sinks" are tr:write-to, tr:call-with-content, tr:assert-identity, and +tr:assert-weak-identity. + +A somewhat contrived example demonstrating many functions is: + + (tr:do + (tr:pipe-do + (pipe:echo "3\n1\n2\n") + (pipe:spawn '("/usr/bin/sort"))) + (tr:write-to "reference") + (tr:call-with-content + (lambda (c) + (echo "currently, c contains" (string-length c) "bytes"))) + (tr:spawn "" '("/usr/bin/gcc" -x c "-E" -o **out** **in**)) + (tr:pipe-do + (pipe:spawn '("/bin/grep" -v "#"))) + (tr:assert-identity "reference")) + +Caveats: As a convenience, gpgscm allows one to specify command line +arguments as Scheme symbols. Scheme symbols, however, are +case-insensitive, and get converted to lower case. Therefore, the -E +argument must be given as a string in the example above. Similarly, +you need to quote numerical values. +** Process management +If you just need to execute a single command, there is (call-with-fds +cmdline infd outfd errfd) which executes cmdline with the given file +descriptors bound to it, and waits for its completion returning the +status code. There is (call cmdline) which is similar, but calls the +command with a closed stdin, connecting stdout and stderr to stderr if +gpgscm is executed with --verbose. (call-check cmdline) raises an +exception if the command does not return 0. + +(call-popen cmdline input) calls a command, writes input to its stdin, +and returns any output from stdout, or raises an exception containing +stderr on failure. +* Sample messages diff --git a/tests/openpgp/armdetach.scm b/tests/openpgp/armdetach.scm new file mode 100755 index 000000000..69e09d8ce --- /dev/null +++ b/tests/openpgp/armdetach.scm @@ -0,0 +1,31 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking armored detached signatures" + (lambda (source) + (lettmp (tmp) + (call-popen `(,@GPG --yes --passphrase-fd "0" -sab + --output ,tmp ,source ) usrpass1) + (pipe:do + (pipe:open source (logior O_RDONLY O_BINARY)) + (pipe:spawn `(,@GPG --yes ,tmp))))) + (append plain-files data-files)) diff --git a/tests/openpgp/armdetachm.scm b/tests/openpgp/armdetachm.scm new file mode 100755 index 000000000..618f7aab4 --- /dev/null +++ b/tests/openpgp/armdetachm.scm @@ -0,0 +1,35 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(define files (append plain-files data-files)) + +(info "Checking armored detached signatures of multiple files") +(lettmp (tmp) + (call-popen `(,@GPG --yes --passphrase-fd "0" -sab + --output ,tmp ,@files) usrpass1) + (pipe:do + (pipe:defer (lambda (sink) + (for-each (lambda (file) + (pipe:do + (pipe:open file (logior O_RDONLY O_BINARY)) + (pipe:splice sink))) + files))) + (pipe:spawn `(,@GPG --yes ,tmp)))) diff --git a/tests/openpgp/armencrypt.scm b/tests/openpgp/armencrypt.scm new file mode 100755 index 000000000..b0cf0991a --- /dev/null +++ b/tests/openpgp/armencrypt.scm @@ -0,0 +1,30 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking armored encryption" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg usrpass1 `(--yes --passphrase-fd "0" -ea --recipient ,usrname2)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + (append plain-files data-files)) diff --git a/tests/openpgp/armencryptp.scm b/tests/openpgp/armencryptp.scm new file mode 100755 index 000000000..7555ce9d9 --- /dev/null +++ b/tests/openpgp/armencryptp.scm @@ -0,0 +1,31 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking armored encryption and decryption using pipes" + (lambda (source) + (tr:do + (tr:open source) + (tr:pipe-do + (pipe:gpg `(--yes -ea --recipient ,usrname2)) + (pipe:gpg '(--yes))) + (tr:assert-identity source))) + (append plain-files data-files)) diff --git a/tests/openpgp/armor.scm b/tests/openpgp/armor.scm new file mode 100755 index 000000000..5b4ea1409 --- /dev/null +++ b/tests/openpgp/armor.scm @@ -0,0 +1,766 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(define armored_key_8192 "-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: SKS 1.0.9 + +mQGiBDnKLQkRBACVlYh6HivoRjHzGedNpnYPISxImK3eFgt+qs/DD9rqhBOSUTYvmKfa1u7M +W4XDc23YEoq3MyhtC35IL2RH6rmeIPz7ZVK5rUKWMqzf94n58gIkgdDZgCcaDWImtZFSjji4 +TGhepaIz75iIbymvtnjr9d++fH/lFkz0HDjbOkXCfwCg9GeOjiWw1yBK8cO11acAjk+QpW8D +/i8ftC1hV0iuh9mswYeG05pBbeeaOW4I2Ps4IcecpXhSyPaP1YiXKRqg9GX2brNgXwc3MEiq +Wn4UU407RzjrUNF4/d20Q7N2g2MDUDzBtmMytfT2LLKlj53Cq+p510yXESA7UHjiOpRrHPN9 +R69wHmHPsLPkdkB/jRTSM1gzQNtXA/96bRpfGMtCssfB449gBA/kYF14iXUM5KTF6YPSFhCC +xPGNMoP1uxTk0NHvcYZe4zW2O6b/f9x5Lh15RI1ozWXakX6u3xEV3OqsvVTtXupe4MljHQlX +YwMDI3MUzFtnHR+He1Bw5lkBVWtkV7rX2kX749J1EgADwlNEP1KFRdjqi7QhU3VzdW11IE9T +QVdBIDxzdXN1bXVvQGRlYmlhbi5vcmc+iEYEEBECAAYFAjvNYPUACgkQU+WZW1FVMwrlTACf +RigokAWd1OqYtcOt3v829fhNqYEAnR9uUslZr6B6RaW0z8/BZZuhGuLViEYEEBECAAYFAjzG +evgACgkQfGUzr9MtPXGWyACg066aP5SSkBHWqqYGGLZv9sVRMNIAoIEHBI1gq4rPJatYDdau +Ni6DUTkGiEYEEBECAAYFAjzGfBAACgkQ9D5yZjzIjAlTqACeJmtp9kpfljkARhfa3QTc2Q56 +WKkAoJmUchp+fAceVeFncpFeo6leM1YhiEYEEBECAAYFAjzGftIACgkQ2QCnNZ2xmQQCegCg +rdTsTWzaZk6gF+mtvIDwKsUx8gwAnRUbdDfOP0qL+83Bbz2r/IzPxjCEiEYEEBECAAYFAj2T +Rd0ACgkQFwU5DuZsm7BfXQCeNVG09VZ2VnuuWTRbgoANXGIyRb0AoI/giUU4DcIpAPbcoNV7 +PzCIreyviEYEExECAAYFAj2508wACgkQ0pu//EQuY8KiUwCdHijK7Wkim2FUPU6i6KxwRH/k +kFwAn1sOAWVOrLfRBfrNNQBANpbr5ufniEYEExECAAYFAj27vpsACgkQKb5dImj9VJ9m2wCc +DeL9IkWpytXLPFhKCH9U9XhzPA4AnRjiY3y6AdNhbUgG/eS8Dumch0dniEYEExECAAYFAj5q +MCcACgkQO/YJxouvzb2O5QCghtxYfrIcbfTcBwvz9vG1sBHkQSkAnj3PMjN9dk1x1e4rUD9d +S00JOoI0iFYEExECABYFAjnKLQkECwoEAwMVAwIDFgIBAheAAAoJEN7sjAneQVsOUfcAoNgN +xaeqMn5EWO2MkwVvVrLjWI2FAKDLnp19rJsU69OK7qHqfMeGWFXsQYheBBMRAgAWBQI5yi0J +BAsKBAMDFQMCAxYCAQIXgAASCRDe7IwJ3kFbDgdlR1BHAAEBUfcAoNgNxaeqMn5EWO2MkwVv +VrLjWI2FAKDLnp19rJsU69OK7qHqfMeGWFXsQYiVAwUQOcrkWi2pLp/VI9wNAQE5mAP/WW9g +shqGqWN/rWevpVKlzwqGSqMUq6E2K34dHrFdqd/WnY8ng5zAd66Ey3OLS5x9/+KI6W9MU5OI +WmxOfrp7PxwqLrQH/BruPTHe9mZbkSyjWIS/V+W8/lYtzIUYTd0584+1x7cK6jah3mAdFu5t +8fr1k3NyVXFH66dLrLF0bBu0JFN1c3VtdSBPU0FXQSA8c3VzdW11LW9AZGViaWFuLm9yLmpw +PohGBBARAgAGBQI7zWD4AAoJEFPlmVtRVTMKpEEAn0Oxl1tcdFf6LxiG2URD7kmHNm+iAJ9l +uLXjsYvo0OXlG1HlaFkFduhgp4hGBBARAgAGBQI8xnr7AAoJEHxlM6/TLT1xZlEAnjSeGhDQ +mbidMrjv4nOaWWDePjN7AKDXoHEhZbpUIJLJBgS4jZfuGtT3VYhGBBARAgAGBQI8xnwTAAoJ +EPQ+cmY8yIwJTjEAnAllI6IPXWJlHjtwqlHHwprrZG4eAJwMTl5Rbqu1lf+Lmz3N8QBrcTjn +zYhGBBARAgAGBQI8xn7VAAoJENkApzWdsZkE6M4AoIpVj26AQLU6dtiJuLNMio8jKx/AAJ9n +8VzpA4GFEL3Rg2eqNvuQC0bJp4hGBBARAgAGBQI9k0XgAAoJEBcFOQ7mbJuwsaUAnRIT1q2W +kEgui423U/TVWLvSp2/aAKDG6xkJ+tdAmBnO5CcQcNswRmK4NIhGBBMRAgAGBQI9u76dAAoJ +ECm+XSJo/VSfDJQAn0pZLQJhXUWzasjG2s2L8egRvvkmAJ4yTxKBoZbvtruTf//8HwNLRs9W +v4hGBBMRAgAGBQI+ajAuAAoJEDv2CcaLr829bTYAoJzZa95z3Ty/rVS8Q5viOnicJwtOAKCG +RKoaw3UZfpm6RLHZ4aHlYxCA0YhXBBMRAgAXBQI6aHxFBQsHCgMEAxUDAgMWAgECF4AACgkQ +3uyMCd5BWw4I+ACfQhdkd2tu9qqWuWW7O1GsLpb359oAoLleotCCH4La5L5ZE/cPIde9+p8o +iF8EExECABcFAjpofEUFCwcKAwQDFQMCAxYCAQIXgAASCRDe7IwJ3kFbDgdlR1BHAAEBCPgA +n0IXZHdrbvaqlrlluztRrC6W9+faAKC5XqLQgh+C2uS+WRP3DyHXvfqfKLQlU3VzdW11IE9T +QVdBIDxzdXN1bXUtb0Bnb2ZvcndhcmQub3JnPohGBBARAgAGBQI7zWD4AAoJEFPlmVtRVTMK +aY0An0oI4Fwko9YsVWS+0M3/Tpc8FB2eAJ4oALojFgFkOWYT97dh8rTQW8BhyohGBBARAgAG +BQI8xnr7AAoJEHxlM6/TLT1xsXcAoJV/9zoudxvWy+LwktkGyCB7aTx4AJ0Z8GWmx2/C4W2M +tSyaUscY3X19uYhGBBARAgAGBQI8xnwTAAoJEPQ+cmY8yIwJpxQAn3efnPpctMJFDQomRDbo +7Q8rg6r4AKCq7LZmOaXvyrBF/JcYjOCLtYMPIIhGBBARAgAGBQI8xn7VAAoJENkApzWdsZkE +iB0AnRQs0XjhpGOpR1lyEOuZkm2xxHPzAJ9Is3sG9UMOr+YS5V1GXXiFM29S3YhGBBARAgAG +BQI9k0XgAAoJEBcFOQ7mbJuwjiAAn2wcQP9HreVLCSQruB1wnX/s79ZcAKCRcecLF+wiRo59 +JJvwtnxp2W24EYhGBBMRAgAGBQI9u76dAAoJECm+XSJo/VSftKUAoJQ/cYKqkyOLSOelU8eM +plFiFJlPAJwK7B0HrN+tDmR7r8Hc0GrRrbAuvYhGBBMRAgAGBQI+ajAuAAoJEDv2CcaLr829 +PX0An2kfEs+3iR5qV35EQlCdL5ITZCSNAKCf8HErpT620TUhU6hI7vW5R3LNgohXBBMRAgAX +BQI6aHxeBQsHCgMEAxUDAgMWAgECF4AACgkQ3uyMCd5BWw5HzwCdF8w3WjnwTvktko3ZB7IM +mFLKvSQAn3GbioDBdV+j6xuhSI90osLMu1jgiF8EExECABcFAjpofF4FCwcKAwQDFQMCAxYC +AQIXgAASCRDe7IwJ3kFbDgdlR1BHAAEBR88AnRfMN1o58E75LZKN2QeyDJhSyr0kAJ9xm4qA +wXVfo+sboUiPdKLCzLtY4IkBIgQQAQIADAUCQpGGggUDABJ1AAAKCRCXELibyletfJEKCACw +Yf5qY4J3RtHnC56HmGiW4GXaahJpBQ1JcWmfx7CkTqJPQveg+KQ4pfLuJvZ8v4YqPZCxPOeK +/ZhIO48UB4obcD8BZdSkRA4QBamRp8iqcgrCot/LA5xQu9tivIhUJP/1dT6PmDy4DAV3Flgt +HgED5niVESDPfz3Gjff5iWWIs6dM3bycxoTcFWLz++578aOasoq9T8Tfua9H8UrouVz3+6TK +xG0rGeb2jOQOQcbLCn3soU/Z60H3SvJYHzgxlS5bqIybrjo3sAnuus/kisrmNjeFfQBdl9v+ +GnK65D1tmBa1+6a95uHb+OG4eHzIXmvnDI4A1RhRKiZ/kpVsT7RViQEiBBABAgAMBQJCo1H8 +BQMAEnUAAAoJEJcQuJvKV618bJgIAMb9Xiv8ps3quJ9ByHhbIQtBOymH0fFiodsutPrcR2Af +1lc/eh3Ik20Z9Ba3g5V6eUW+3sjpDsjKtI1CXuRq0Zgmze3hrUTMRmyrLoaHPocrqfj2G9mW +y2OomLHMDurcJFQkSUJioI4Kxo+1NBZmylPKUEeIEoP8UBJbKxf78dVh00ZUecwZcn9lLiZA +TycRQ0WTT1Yv1fI+tBmvSrpMSe+0k+JS+QigvINN5vUxaV1cN6mkREPYVm7oHzPCQ2C9NX1q +cI/Wkc38ieZw1Sv9vyPCCL6MYd/2t1209a/ZKADaw5l+mhyWUqIT6SXPLxMDy0NvPhTKdDr1 +7S5LOcKhwPqJASIEEAECAAwFAkK2pukFAwASdQAACgkQlxC4m8pXrXxvUQgAlfw6doD0JHtY +iN9uCp2M1orLKS/zm66e9eiYPJwbim96KiwP98Ti5J+QO5hZdT3dhW2Avw5JPFiQukSc/rjT +1YHRyuhZfXKhQhsjom5JmyFSdeIzjnz0PIM2qZaK4OfFihleQfQ8Y94wkPwYtkEXxpBQSClg +Xk6QJEql34sQexIDM7VsREwv/eIQ73RMquat4RZP1L3h4nj1UJu/X7ey3HVVo61gH0RIAR+A +adv59AAp//TkKUNIRCHOsIpFCXHjJsJxRvJKhiz3T6FhqFEQNF2tDJKHFV1FcLAIEZheuGOV +fKNXgmvVATPHrJsg5HsZACg/aRFq9NL9FYskFyGcB4kBIgQQAQIADAUCQrdR0QUDABJ1AAAK +CRCXELibyletfMNMB/49u9oQzbmTtmHaoKuvou7OA6zmrfeu5X9vV1efZgItF78J7G19fVt8 +K3e6kn0KGYVL+FTbPdEbvrYTb+jfMkzrHooxQYSr0j8Baqfh2bMuZzuw2pVtgBUTYHoihNjQ +lv6GPtF7Y3CVWLUYXZ25yqY3Hzh9YneoH8bUVFZWxRFitqGB+noFpvm0YXrCJZ19BDNTQlx7 +5quAl4KTNOAxapsKaBrz/4PrnNbuwZBkzP5EEuEyjTM+6UBhxibXfdWKnZw6ky7k6tuUsc68 +qfQJBK6KBmVLflZ5nrd2N90Ueb0m3xfzdncBAZb43THGhi6XyZ4jvbMjvjm3MCGuUosYYbT6 +iQEiBBABAgAMBQJCyQLdBQMAEnUAAAoJEJcQuJvKV618Jz0IAKstm2VX39p4Lt4k55ZdOqXG +CqHCFT5YYOVcnptx8dKTpHWQXpI2lUJBAcWz0IAXXFhyUbGpvS1E9T/pYF97RSSsQyTncQll +mLbzy3fESVkGT9xpEvF7ZaK+61BKuWFpbKRdpy5wWakk0GRyF0156vxm7vQh4XI91TwXj7DA +v6KYWdjnHcEB8O9jLw6RlD4Y6dKjb/v7vTY6dGmYYyOQVK+Bmr/8vVcNDf+tevExsytTu4FZ +tL9yp+yHODfHP5LZk3mC7UGR/mUKFDYhuEzzIU5ozc6qUfC5ViGt2Hjg45i2T79WeSV0UHSE +8c3JOgE3e7A71bQEUJygPC9S+RTuc8aJASIEEAECAAwFAkLMT3oFAwASdQAACgkQlxC4m8pX +rXwoBgf+MEjA/hx7UMl6LHwheZ9qzH/4P1d4CU46SzoC/XEPqWGs9sJw0dKxEAnRZgrG1WMP +Ml127bOHby5WWDa/xGi0siYM64F386SG0W42FD67vPK9mMPnCDIQ4xn5gGoqUUl8ZzFG0eNv +XRg0bmMVmoZFvaUyf0uah/0dYCYplgAjJtmC3cmNuJ98PoYEVHMKKGtPW4fVf+TcN90HVjXU +kr0GnAvRegb3ZXnte3GrOe3jOfXjfjZMyEM6a16FFuKHmykgfyX/I4tS9GqoxPZ6s0KARKn0 +YLZUuxxFL7i1VaGJR/9duyUc8T0BLc9O4TxNuvd1vd5UKVVmTL04fe0q1Bfu4okBIgQQAQIA +DAUCQtGX8QUDABJ1AAAKCRCXELibyletfNEoCACtKtfWhAfkxLqPihQMbvwXTuSszG61XNYb +a41gTOpjADF2jQAQ2y8oilVyr5RgSvug8knik3EitSpBOOg0o5Y9NHF3e+85r27m8T5cP3g5 +GHAeugRFDqMXXioiAw9WoyvG9ruMY4caD3gAuogM4hB/3EMEHSlMylMrXLUtbGkQKqkLVJQn +7V/3SVG8zfUyGb0lSFaGtHFa6LaIIuvJwkQYGMT/SiK7ISqPKOPD7kKRWhxjgcfzVthqGORn +uQGi+316fdA+JzEYOI/gGdcZsbN/KrMSNQ0DOdSRIeiATy9M0fd+8QtUPOCtaDKLYISSrm72 +xgnKbussJRxAPjxo66dPiQEiBBABAgAMBQJC42DIBQMAEnUAAAoJEJcQuJvKV6181SUIAL/P +gZhrwepyFUhr+nlYvxeflrxgR9Yl1aNtTngcOYlFU273cs3XnkczIpkg4fVikY5s56Y42G8F +NvqRu0M0eL5kJvYi50NNMQnf39GkZZp2LrL9bZ9n7ysWU5tiOJsxCBnaOiAg/p6vCUVN3NV+ +t8vRP1fHwPsd5tYEBqA/g4g1U0xJAG+JqJftSDRDLxfTZ16hBdHzlQ3opqMMmW5Mv005p4o+ +buh4HzQLmBHDE98BeZ7CpjYeXY23bu8oi0tvkcTjCEeBWrXWfA3pKSX5HH63nmG3ryKuP0tr +1A2gTgs9JtLXnGFJUdVYULiQbU781wR6+9o/0h6NuCJDPmJMNmmJASIEEAECAAwFAkLmBFIF +AwASdQAACgkQlxC4m8pXrXxYZwf/ah4IaTK3CbtqF1+4uz7VVRKemSaNg3jMKLey2simqAQs +1JwqkLuwEgrwF7XiejfLAvX0/yFqJZkdtDFqeK0VrwOq3WIpfj7+g5B9YSW0CkasD0HUci/l +oXQiT9CN7PAe1vM5X4X3cqlXfC9tmU7fH7kc0kULxYHAfn96nZQklZS9aVecJ0H+pqMlPoDt +xtxweNa7UJWAanO9kbPZ/xEdSlkuqzk1CK6ThURedc2lCE+qobPpUZri1FEvMBjyXoQ9MyD6 +AFWfax9eNn1ZSRq9t2WpPyFSQmCvyGETHyvM2BBiFR6UAQUKdr+d4ZE09cR0wXpEtoqaNeJ8 +AidTEGkuLYkBIgQQAQIADAUCQuydlwUDABJ1AAAKCRCXELibyletfLsbB/0X/Jafv+v43U26 +W3HD5XdmHaNdxm7uthGzGGzATGcTAUd3/t8fyVFk2XgmUYxtz0wHUdM8GiyK0tpKBu6wqcbO +nGkBlvC1m6Blxy+PvpJxQ2sK4ycN8ToEEn/7HCCJesS2fvDudXkvdvskXkxZprPWe7JTHNxj +fvESUAbLLmSpNGflZnMAOfuQP0hFBQr4D5FEA+zMf7FtrwkBanXt6W65xxEIJ/239ctCsRe8 +jIQ4LesYQN7hyX6x9bP9h3tEw6+OtvjYbMH+2B/3muNVac/9bYqi9rnuGew9eAjmdmm0u8T5 +7Iboy5mUDH2wjpRo6MGU1cHe4oZscW0f9TPE+6XbiQEiBBABAgAMBQJC7UXaBQMAEnUAAAoJ +EJcQuJvKV618zbcH/RlUtrZSBcUafmhY29s9BYycwWx/UoeJRIJmi852TguSGsoPuAYEGeaW +WxCdSru2ibn7GPBXowM5u+4MqYqaRB695sg/Ajxho2Djys3lV0TPeSIbyZ7cXbjoSDnSVw/N +eWGKJLwbFVZPjjC7mcGIMhE1NGGxyRO5H1Z6GA8dEP3zR0rIivklN8KEngfyLRVvB5WYPBs+ +buaNF5HflsBXl2bOP5ueThcal1PSE4HNoQXz79t0Cw7kpsWy3FyFUVVRHPyvwVpJSdYjz8Ur +L4cD3Dj9SOPwa4AvM7WX+JXbPEIFxi+NA4R0TVxIZXJ/HX8AZj87RFxGYlTfP3GFFw+52QaJ +ASIEEAECAAwFAkMHCEAFAwASdQAACgkQlxC4m8pXrXxGXQgAwFY5RYFHKcYkL9nDfblQDjXW +Ictj1rlP2yPsy8dKX579ejhdd8o0TGJf8AzYRaDEpffPf/ZvyfRltqKd979GzdAE3smkrGeD +kPuUY2rEF6Eon549Tn7omGYNueDuO27QQ4zIs0k9h4m+pE6PxPTgC5BsEVF8Hrz647/XSTf2 +G0Wo11y/KBWGJ9BYvZ1YSxwmk5zicGF4sYNktO1Yl6CGS1ugP9zitCuwSiUm+gJrMCZ3am/D ++Of+80Ui7e/V9yOOeyC7/gqQq4okPZbdVzJ3hiG2Y3eip19ewHYlYSiLoBW3rr3M3mKBTcbx ++nLfVOTUHp8HdqxIyI782SaZlpg0mYkBIgQQAQIADAUCQwhbTQUDABJ1AAAKCRCXELibylet +fD7WB/9ydWuVT1DeeL3UBqqeRRN+mt5DChdFeCjJhWcAjds8R6Z8Q9c+kpKEk+MeSevKaOAf +iiM2JBtruIxt1sfh/vVEFgjHP/M0sF1il6TwZEKqVn5c3ikMYCMXy75xheslCJoX7fi4jZut +TO8+JqjVN+z+SYzeRrvQFcjJoIOLRnshh2XgUiXVf/xo/My+fM9rKnMHxF/75PaFVVz8cXz1 +X3jsuUOVLxnUZHsOaP9r1h3bq8uHJxkxPElVPbCuKLdCWrNOHHX6/+TAH9xohUvrBm6HXqbv +O/aVGqf+Bip6oWSB6rSIe9+0GmXLRe4Ph3ekBvyGUJM/nFhN4hQHX69xZS7yiQEiBBABAgAM +BQJDEOyRBQMAEnUAAAoJEJcQuJvKV618IlwIAIPbWp20TBCnU0D3kE6JFqRaVKqNAFaJbmRn +48qxX10NmHnBAluU1iJiUsVL2kOpvf2eyFUsX+sQfVJPzmWkUU2gED/+WZNkcmxPZ72FtJCs +hW30BcJnLjcRo8wv/6nhdEZ2JYNiBIFHxNQ6iiB7BzVpYsMp1l5tI6mIhbxYxMNETTMrb+hK +NNAhxjrqiWxPNlrzw6TaKnBOE0Au/Asjz9n37hsPV5Q9xY3zXbff3yDirVkBC4l0Vc+U6drX +XiFBjQj77yt6AjTYUzBZY7UuGQ0W6o/6QF3KfiC3WAoFJL7SLujIaALkALs+lFzsu3CA9KoB +X8Ca4hA7kzOP1H76VZKJASIEEAECAAwFAkMSPXoFAwASdQAACgkQlxC4m8pXrXx3cQf9GBPO +XIrdbvUWIKTofiwftiy6j3MhKOszHkzR9quCu6aLu/aVvIA/avTZHjfj0EvYaQaSNMWplMiX +i2UhkPHe4cgJYkbjmXEz16GtXYPZXGP1FubQ/RwQ7yQKaVtXSCgz+ZdR5tKhU5kruxAsVjly +KcQvST95wlqxLuvXzSCjPdWj4qBvkuEt6QADx8EYCafraIiHPRkKtAAiK0sXJSkLevXn3zAN +6X6ngvZZiNQFvfWLFV8Rodz1vI4S6Af2MTSlVV9Vw0voJGprcsNDlB8k5B/Kl9LigeKdkFa8 +JVfwOQppAtU+Nq3pHjquEafZrPVF9HWY0G0Szh5tOFEpVMF6g4kBIgQQAQIADAUCQxQ7iwUD +ABJ1AAAKCRCXELibyletfBVfB/9ydVsiBrNWLt0RwbAdMvHRceHz1twh+YeSnpr9Equ7aDMG +qou4ppl/nTbnZIizdWn3dnRKt+vKY/puuPIT9kEVF7DlfBOcWBdLBvJz34eBt29BCFgvsfOS +fwESMNKgquZmrraGpEvj4cSTOmW3DJPevB+6ajsN87BC5Qp2MjDGVkwT/Nj6R60pz/vmeSwl +0BmzgthrBd+NfHSA116HEAF1V21/2UhA1hbkPKe40jWp6HK+GcXDC3+PucTJeS8nX4LLQnWZ +JCr1QUbkaW6jHCw7i/pgCLfqBBdIh7xJE7d+6mut1AKtq2qUSpEM4qTvrR89DLz3OtNiMnr9 +hq7s5SyduQINBDnKLe0QCACUXlS4TkpEZZP06rJ2IVWZ2v7ZSPkLXjDRcC8h6ESQeZdBOSbd +dciiWYiHtGq2kyx+eoltwooP7EgJ9m35wn0FGV+5hpKbhSwz2Up9oYsSbexjx/hlopUYGCL4 +kgezCUWQsKypsitJChjV8MHgePDQcF3ho+qK+0ZJeevbYKSZ9bLyzt/i3/b3Jnt0f8tsFP3P +djel4N76DyQiTyuoOxzZJUJDKx1zr745PUMGcur79oAxuahUfPcRpuwcHFOB0yO7SwEY8fe2 +68U5/AZrGwX+UAZhN7y2MMkU/xK/4BIDY5/W4NY3EX2APAYMRanI+mFW3idui8EEzpzKZ1K1 +8RODAAMFCACOAfgCjg7cgjZe58k0lAV0SANrJbMqgAT1M7v4f5mOf5e3B4si9z8Mk1hx5cRX +I3dDz/W4LPh8eONmMPjov42NOz8z84PksQBbnjlfZ5UCotPS2fZ2actJPhYCho+a4iXwRm8B +aXQ3DFa1CsWdXvkGsNIouuSkGoGh6+sEgAdP6JXanM9YGTQINy9Xsg9YOj1UWInSwRqUmJnj +aNQhxJfj8j5W0uXixzkbKB+Is92mfo8Km3TAi9u0Ge/Acb5Cz0c5sqs+oWqcouaTS3o8/1n6 +CZVmvcHyGI0APiALwU84z7YT9srpXHrjiHo2oS3M4sLxl0nuSFqD6uiIFrg7yF+HiEYEGBEC +AAYFAjnKLe0ACgkQ3uyMCd5BWw6XgQCg7Gu7XOzqnEcnCYR7v6rub5d0zwwAoOsQ9TNDYmVl +nW1ff9rt1YcTH9LiiE4EGBECAAYFAjnKLe0AEgkQ3uyMCd5BWw4HZUdQRwABAZeBAKDsa7tc +7OqcRycJhHu/qu5vl3TPDACg6xD1M0NiZWWdbV9/2u3VhxMf0uI= +=oXxa +-----END PGP PUBLIC KEY BLOCK----- +") + +;; Bug solved 2005-04-07: +;; Try importing the attached key file. As the key is exactly 8192 +;; bytes long, radix64_read is called twice - the first time to read +;; the 8192 bytes, and then once again, to handle the pad '=' on the +;; last four character radix64 block '0uI='. gpg bails out with +;; gpg: [don't know]: invalid packet (ctb=2d) +;; On a read for only the = sign, radix64_read returns -1 for EOF. +;; This causes the iobuf code to pop the armor filter and thus the next +;; byte read is the '-' from the END header line, causing an error. +(info "Checking armored_key_8192") +(pipe:do + (pipe:echo armored_key_8192) + (pipe:gpg '(--import))) + +(define nopad_armored_msg "-----BEGIN PGP MESSAGE----- +Version: GnuPG v1.4.11-svn5139 (GNU/Linux) + +hQEOA2rm1+5GqHH4EAQAi8xXorNRK4QSZR1os2xtbVeZg5pI0hrdyejn0jSnlWmw +wqnhQnoOXsX/ZE8Sq0deOJDKhIJztVcu4QB17R0zRxXhN+huXq/DRGUa3X2xF+Po +4bP1XsZT6jYc6RDiN8KzQkuUgEjGsQhEYzBMFgk+tFDDA6PYKRk2mn0UaTyR6NUD +/jimx1teliNBMhrPQjbBMCdgczfUhH0srGFKovkduf+Fmn0v4rV3JAhtHPYaPrgY +hQtCMdjgCdh3uMK6rbprGdQ2lh4PAFKd25djBJlf8KBqkJXimAYhe5Y1q/x58xbA +R5/tAKZFKT+ooU9qjVzXA0APHBwV50/K76Rsxo0QQOTihQEMA7WIRff0Cc1UAQf+ +MZ5HWEX6+2teJWGVKMmJBFkYF4rAEIoqEmtzRWcsAPx6PFXQt5Ok3PbSGDgOsQTQ +XwR5bEmZ6Gd/O2xIM4BnwKQ/g6PxksPuni0ajZS5YWdoGY7ZTS1LpZMFj++fhtQ9 +1hd8j+i4P+GA2+4TUxVVFwIbHDT58+mw+tYD0KDfizdSwVc22F+5nT1tLaKJVvmu +VX5L9u8OY6kR/xP09uCq+YzzHt1bi49Avrq9PpV2wbo2P0t7H+3bI92oGvpMPM2L +ONAXyh11dlQkIrOiVztWtTYIfoCsV7Ud+25V+jYEfd9hyE0gf4awgqhpLwPrzzAs +aHKQwrjlMaByKKht2teMJNLtARZ+7LbxgF0TR/019x4+XHCBhmwmPzL+OnPTC1r7 +fdB0kte5OefTUfglJyz9tD9QnrvCvuOmKxcsOu0C6NLUqZRJN9knhLBZyXbwx/Cm +yA60Er2dGssL7e4pa+qW2O/xJRL1IaWpgZa6Ne89ut25hbEDWexCAikBnPUrwrLE +sqWOepzPNGxUILOcjDV2jKq0t7XKfwj6UPoCQxY6FQpx/0goWllh+PuVLz7tazsM +c01KGfU61j5EyyuytOkJO2XgyXZj6Zat194NgsMrNGBBWl5QSGUb5W0jW1bHm0Cr +U+xNTvjnlVZzqy8w3GDr2bCWi6qJs20TrbsbDa4+sK9+WDJ2fcb6LzfTGOekbvyc +OKyYcEL/UXMH0uYrReRiH/gheESZqyQ1kCz+/q01D0N0KBqj6LHCJyK6cOukrY5M +Cd+Kdk2gPL5VP0FSVJLoFXfbfwQtjIkbhsP06sFOBszPhd8bh+/r+RKWaqQvHJDX +u5XqE/lJfBpNd+NBPK1p1fMVW/ljj3EwsJCdYOxh2moXD7gcehbaHCN/pFxD2Xiu +wFHAqTghAtge4DuIECN+8QrE6xgCnwx1TYlhd9T4f+OqTcn/RdSrGcR/TtQK7TJY +R2zVvj7vougCx5avrNwmJNX2DiJJl/nDHmjzEFByFv+UvL1PUn4m0dsbyx8alixE +dw4wl352n/ZpjIc7GdLeusuUPJ7xFY3r1xS16QuInhuj+ZIlPVVeo1vI29BxGP7n +HH9JmewN57O8xztGeBSMb5dZCSsGaiZtT7TdF2C+r6NgwcULzpgANVMVjNt0U305 +ZhTf0FxH1LFTDd6IH1ry3EABCRQX+NDi78m9082QJPw0u46P6fchF2xW8MlJHa0W +u+G0+DNrHXUFZBxt0yG7YqWYzqezXX/9ngin/W0o3Myf7RdHxmlwSm7fUuz2nYTn +0gpJqmu1MdDN5wKxuIO3qMOoG8LGJwnR31sDo9BG+8Hpp+yxYMEMMpmW33otfYcq +Qqt7L5kWYDrQb0jGr52hS8fBujYi58AY++a/RqddFkU4c3kgA11A2GNqsbtxw7rU +jN1uqPs2bQA2HqEdlL2ZD71E8jZXztKxMIHyXbJuIEt3GOywJWeHNi2vZa2F4tIw +bEy12FJXLW/6Dac7COzqVILjNH45S37JRQCc/0kAJV1VWMyhuPBU2LoPwMhdXiDm +k2vznYlm2cEuvFL/6DRm32Dd/YaA0fw3S/L7nFyuA2FVJjs17XiIRdUemxXt1kC0 +1KPjNVekwJph2YE8GMyyV4nsuf5yGw0wJkXqRYR72Cf8mgxc6rPIS0panSWlAl1x +5TMf9pEh0TUkNENAbxFazsfpG1RTEVzjpeLXrDSK84O3WW0jUHoG3IyP5iVli3g+ +/HPmOdd6+hBVZq11BcA97xnozZE0d0zFCVkpp2bcK/69X9NC/Cl9FTI0DzdoWMVL +XTwmOV9BYsXAjJLXAfQR2eDrunaNkZO+rr3KT0/TtqhpcCo2AdP2IPglVRcYGLlr +SUoF/sAtUgFLGnVnURrkAnKamSs7KBx6J4Y4uiBUqMxX6L4T456FBxHHMQNy7cQB +quyVixd21NB+P8GYdwb+KLpVjiQRdveqDjBJEn/nTK1yKAhq7SY8B6StVgbzPcmQ +Pt52HkVTh8a45gxvF8qGWcbhw1E9rwVT6yPFJXQiR/4ciEFFEfqQkYzNz7wVstqe +R0Uf/rqwBdUCDpPzMPgl9OPKFMHNJ2tfYYU4kzfzdxBb6aKJbOX8xkxrhmktyUaE +Ap4b2gngCenXf/1zrVoyH8+KOQPZZXlnUK1HfIERZwh2JlmowLvobMlup5zL/+s3 +kRsnxRLbJqn0tYYYFwKsGbEqHZUpzbWR6TKNsJvoRlcgOKbAqel8ggFXiSc4co/f +VZqk2IPzaQCkTyAU+B5Fl29bTfB4LK9gvZlY63y/VFD2bEBVk36pI9M7CokAr+00 +KvAKEzpmSXN4RHKwJ0W1gZz4IGPKvi3eO6a35wd47K2tIS5K3IfTjsIsUM+agh37 +7xJiJByfKgA7ardssI1xeG46U2iIBvdUNeQe4Q2ODF4AjxczK3hJwBPg55FGkhll +dIDa07ZsOTB23LpoCejKi4zzn5DsDNqQLaYaSP0Cud6DOuSsmUFHSHSo+NtzqEQG +rm2o1LkZwQ85iDf1A3b/pzHBf2xhxEEdtMZ2yfWxPJvz+8hsasysqPD8BTJIy0jn +NzmXJKTj8ll9IhQjr3UBCZZXWUPNbrl3zKGUTQMXbdUIV6cB6hjLERILhgm2VhKR +eEOFMaqATMKnGETa03l6wDhWDyj7HbgzgKkveHJ5PDFKz+RJ3sIwgKD4LoSOYtZr +MGuHzMtiFSx+42ZitFm28G6rzj7NUVA+FHvlkogLWCfrXkNyEp0F3D/qbg3S8WS3 +WrdUbLwbjFRSHgkdIUA4yIjCSmRzupfpvXS3UZPFD/tLZicU0ogfVL/2KK5WLYW2 +03q6egJXqYX1iQSOTXwx+Msw9zVzwcAI8j7KKDLVv0fLWXSMOg2ondmznb3s0Y91 +iaYjf7iFhuGH0hk0rTc6+CkxUhet2GeBc51G5XuLt7+Pgml8k7bZHU8kOB6etEP2 +i++7b6uCAhBW3o6shyoRgJNYJmzYbThfIx3yu+3vl1gkSxSQFo4RpEmk8VtjUsio +tYJNRsAq79wGsyLuPwLKPkPihjGEf488A2NKuVnHB7051oU9hWbRGCVhzdOnD04Q +HKzZVjt2HyI0v1sY/Nq3BqVH1Ha1CkmySYeeKXRgVQfD6RIzfd3Dgr34+rZqF3qD +MXna3FeH2W22dbZH/yA+KuQEjU+uOOk8QQsqXorunuyuslrOmGzaDPILW8zJeV+v +tBeecStyR4FdtWl1KH7YTdFDkeGKOQeBAKYpyYUKr3s1grPh6caqgF1FMNL3Qw+s +x4d0zp9efHkGqhp1az97oNFBzGmsBD759iPu44QaElulO3OAPyn2GYZA3NhnFX7Q +uGtFLSexLpVTlVyBHf/QeGJk2lkDuOegiAkW81lorVF0+gFFae/HIOnEZgVK0/Nu +h8XNFvGd7iKlNhfLtRbKPqHYOtxxGC7gpuSa/M4kgvTmN78QonKjZPDxhlDhYE19 +WOHq14t60lZopVLY1bQREvem1K/RmPk8lak+uf/Fa+UqZ5C33m6kmbM8rwYmuSs5 +Y3M3mR2n4tsTrXEO1AN1vShuIJoMEJ0ledDJiWKkLHRZ/SJOBLYMM+F3/hliWB47 +eNkfQgo9JaTiNs9SBVVcxWYEGUieAZjOekD74oN9nOLVaXS82kQostloXhPHvBG3 +gKQufi48gOj1i7REcTyhQMhIXa/NQ80aKZEedH+qQvYTTNGe1XIJnRILyQfirtgX +2m7PTaup+psJEOP/+Yf07G5KzN3wtBIXi3Avlr39ihdbuORERUNvu6kR2psvlXdQ +otIijpBJW3Ur5yTpnTUo7chSlWFzbmVYv2cyXPrQc06RSxzrIQFjyTKI1/Pf6Aax +wA7Uep62ga5r3IuR26XfaxunphrmFwb47EiFYP6JaNCYW7x5y4OGl8w1OYmabhwP +azJsUAAem/lXZpPjx3s9meC48fHpuM5N9myIuRlLN1Rtl7EIG8cuZuubi+VUEhWD +byap1IYIFZjWnS22/yuw6pzyNk5Mr5ccyo5xxvg1ZyC5rondGCcm1egSDcrHXQsE +pR+jKBcR5AUKBhrgSy+N4HHZvsah+eNnTIZIm2Hh92vTLZZF7u3lW3mlePp4/zAt +VMbn09ET1qWaIl9xMuHDIfIsSXMLsj4+o8qKaxipQ2sjFjnsFGIK1cAjjptpoUYU +CffDWoBnLGkFSVTTooOQHuQhUmqaIv2pXWid/f1smPUjkshLoWiPoVl9lLzvo/XH +NhoJ159/qczMsiosx3Y6e/haFlIfrklSklJCO+j4N/PYW+vyqYg/O6FlWF3BPRhp +qnKwe+KfUeAyXQKG5CkONWBmUAhuLWOLU1P5280iAKHnOe3YRxkGIpsFJlIA9dIX +Lf8KW9zFYMS5J1xysSyYtCwUfa/ewpRY+KuLAH/3wSbxViuhwJ1aoS2N6m8hkTqy +SODnP5Nz/n/EZi3wWesBnz8oqBdrwkOWRnfFORpRkAedcsd9XYCbF1dHozHBdY8Y +uu8N91ob/5c4RmP08Q5ama/BjaxskdMH3tw7kW/7r9tpzS7a2SLLzbDnyycZjknV +tPr/xi2bmXHkUNnFwsTL0qvIkcZpae3k2oTwgNrjczqIdYGynflOc/gqxVeBO8gk +t7mqZ5sCOlhqPkf+/1EY9kVwS0lh84yV2SskkuhEOF5BZP7IgNTgeZlgTwYRsGZq +R40pWhW2iuAWfHop7NkrIWRvtyVtVtzwqtTLOs4oNrZU6f8xh+1asPdLqp48h53N +wwS3AduoX31189s/ZnYUR74dfYcf3JehKyBTsfPfq+8rHf/LOHc831bavHQ4ncnW +f//8T5Xipbjo+WX6LQxr9NnCIkZaJ4cjET+SBvEf2YGRjtG+3jGmWdgAkZLhWJFp +xqhhOorpOFItwHiYIqsy6WEcEf2hEAww7NnC1qNmglDXw2ou2WOk/WDL+Oya9ANY +1HAaYrNmyjZ45GXvt9/ISzeiFaClgetu/zmJTe0IG7qxuOsd0MG8DugeFwUDZQrq +rrVL4U6Z9MZLQl/DAYppnxSmne8vQfwHQqRXoazaIxAh3/uWh/w220YuSIHJt8Cm +a6J0w6YlQtBmaeY22/rbiOJLqAMtBDC4cCAp8nSuxZKdVTpJA7axQee6lWTzan5q +WVyvyIkqq/4iuU+WLDtHV441cgnYENyZ/T6jrHwrX1AYIv8d2Bi179JVa0OKO7di +axMS+65agfbswB1wKRU1QYin1sDQUMPjGbEtP0reyAFwpBlmA38rIg3j4xr1nm8p +MkdCKOdqZw2ppWDTLFqqM6iUpTiOUZLzC80si8C0VYkTCZkCRze9QTAD3cdfITZZ +huiHO3K4pS/6ao4QJtr78B4yyUMST8isRibuvqxQYaEIgO7DkFjD0Vh815jkydXB +Mag8MjSydC3MuAYFtruOm0H2OtoBsY8YBbeQXeC04U49P0ktYYI7MNsShhfFxRtR +kXV/PldGwhF3egUjSjk5UBiZEUDw39PMiWy6k/uM1KiT6AewNryw6j5SqqzeWynh +MWAqxK2oIV+zhoR8EaX1sIZ3LtPeDi61GIaeKhnv88FhDQDX+pjm6I2qKgXhnYxr +TI8YqfbGXGpCZWk13AL6CyYqSzcLeJYKInETPbmZ0D/eA00dKvDUcHnt4UEpuVHq +XUHETJR1OEF/xNF2DyXBja1+B8fGfChRMjmk2J3YjmIcg1m6svC5r3Cti7WpbKIs +qldz+u5QKRbAbj+izAd9PEHbJ7azMlFHyL1W69VkO9C2u3qYF3Kx4diDAQFVGisv +6wVaT7kZod6Yn3dkv19EicvCnfyq1vE511OExvi75E01iznFRjdXIjCOpcsbVsnS +vbdCo+TnLi01Fg7c4Bp50VMxZOKwvY083cxbR+csrf8z0TyfuaxPsy4YiLhv7SMU +5D5f85TSgP1j1Gqy2vCqqh5iegpi9+JhO2efZGFTZTyuCsGiIzC9CyQ7BUPHTz12 +nvFa0pYNUjFHJD0FN8qVMVVOgl2SWldRaRD77FbcLsyiS19dFgnvbxXtEdW5OPD/ +AdxCM5PtrJymOijry6jKs7oU/9jZJMw1sooVjcX9Xo9e5HWRqawTAe24nhwzlSRT +3GLcU/jTOmsjq3NLbzzC0VQb6/nqkN5t4f3JJj6jzRo/1lxKhHB4c+/CgVtQ3GPi +aCjiyDt3qey29K5lMNmo+dIMtIh6Sf4klKSOlh3oT0XgM1WNNeJdFt6v344vxOrq +/jw3tSMx9vRMDv52bdtCzzcfkVlSYLPlhS9ErBjaICVWqfaFJMzD2euHmau0RuPV +S96FiHJfc4t0Lgb75bwIXA6a0SSS/JrDRUynBr3kmSUDJs67i3ULJ1rMV553K/3g +xOBRT3t+gAYbl+5Dfu1+btu1MkmpVA1duQYcVxO/Mw2asc/kvXA+rGrs3FsScGmD +Kr/1yLfXvM+p0bYlkCfVoOVEqfU83t1+5Hxp3PlqYwzxlBPx4rgofnDRyeLGtu7j ++1rZ8m1W/lndkJVf445LqcXWJy8c9V476LXpoRL5oNAQkEERDK5NHS45TP7cYFId +0xuLwCQQ5hh3cBw+oBSqRZmjiEuxSArhBaw93S5SM96dXhoAmXEiipNbIXO53pqa +jFeb2kVctAeNhupsUMql4nocwUYWyi0bMBzJH4eUakgBShxJjtAD+k2SEFk+nCVL +76fVSxUwmpdqOTSMNo/L0CpG3zHU+CflPBnmSXFyTgZD9F2FJCUBWWdKst4bHq0T +qoL4Y5Wqj6YK8QtZecrqigrayOk+CEM02C6nhyM7Hdt8sWSPtpWGkF85Ksz9RCxF +QnfIQImjM9Qt6Hd7c8EOxpgdZufvD10vlELH8O5U+TimCoCaViiTcH7p9BziOI4b +18d9bgXkj6GZmS5uOSBsMIF+uZjKQxyMgwzAaEYHA+vlKPS15rDDtlDNGWDHfNik +hj7b/FesKCBCdqYpxKWmcHgX4aN7MNMTy+HroF/XVAPGzxGAnMS6oFahb4C/o4be +T8k1mGhTlTQRWMi3VI9LrXoP1MsH8LwbaPSnSo80X5sbgZmSlctu5QiSaFm0kYc4 +HxMR9fJzxZyuXM/IbXSdlYCc04xwNO7hrF2n2HI4x5BR7fWZSl/E2yfpxwdBtcBf +l2amxpmIjusGprhGCI860vpQxfyWyTfWNdMX+OFL+Jsgog6Qm8A6bSaNTs35Dkf9 +TjvTPS3wUPwDbTuk9++zPiKt5h85IOFaFzyjC/u+C38IvNmvUUcYLha8GEVz4OnA +KT7FrOizC7pdyrqbCIJhoZsOzk8romND67wXfgIWZXYMU1b2K81jIFSvkVwrXT9w +56vollH0x8YJD9xC3U8QcMDnK3FwuOrlGxHY8BfNszCV/OXpT0qlBVC/gywaq993 +YJoQOWugT4CWpmSqnRLjTV3gJTHH+qqQZ23TsoVE9WoByXj/yb14FtdRq9oGL8H4 +Ke03JNOkAlwzohG0XEsoHLC9+o5x6KT37OtLuds2bYV+PzSRVLJjsqNL3C5XSp/a +nfXTim+6VIANM25jzxfCcot+VBz13fhwnaY3Am78ZEjQVmJn+Z4DbWIIIc6XGtBG +eNydm9WNcZ2jF64aMN62DBp3RGqgnhE/qXTv/Sw0l9qiOCeWJ5GwqU+Bj08D4/6y +6xBaaWHcPqCNuyk7pPG/tN59GVUP/jHEX77Z2kn6RiLbnKahcekaifolgBuhgiw1 +/c0fbWmJZVCUVhVPI7fHTAaUIO/VrK878WkSUWL5dRvjXp1yCvAxeYffsdwamPyQ +R67h7sHAPPtYs9XpIjZxTzGF0YDFc+mpfYykLvc5ixrcuHGo3Km/hzdjVRhcCydM +CexKFEHqI97u0Bz5aNW3tOE4iTeNth80tl2rV2PsJoK6FRkdGgFGdIsHZkhy3lsG +GwGcp4bmAawGB/MmjnIQRPeVaSobJSln0BgP/j77h+pe+eTswwxBeCh90umeE9sd +dFfKQNzuZvd5heYwzbLTwlWbNn8wnB/nh/Jh4O6w3db6WDi8Yl54mt1OSFNVjT9b +1rM0CfUDFDk+Jzd3fwY5QQDy+Dy8oPm0lm0xCj7mrzmlVGP5JmLCvPiJUTPuybdr +WlBJe9T3Hyi5xkYgl9P6Itxho+qHEMUYa3ScBBC8Tvl7y91Gp26CIfR5pQxkLKmh +KI2wYSHF9fytr5F6imJ6kTocxq8T6UvVgXi61pWScjifnQdQBYtNcsmu6F2djNAF +RIunpWxbcq9b1nuQaMx6aQhYTMnau/ApeW6Y4bbVwUHyHCWMwy4TiE1ifFrvOYzQ +Ph3WPsfDJ7dfvHfN7/Vr/qF3mcORScAfkWa2yhVitoBnBMJ9fM+q6Qrxulp8xOqH +0UwdTA/FSaIApZbIHVO5xquLVXDD8Hoene6GWz+wep/oUqXc2k1wl/8XbhKlS29z +N6vJZ5zVJqLSWWyHceh9L1fd6ycHaNeYkPSAGBA5IluJfm0NsQHGW6LyGkkpnFVp +mmB+crDof/RHYDU/ep3I+BP27yTFw+j4vgELB6XN689kE2dWetrINmemwilaFoNd +eDmVpKbQR3J3WD9WNTseI2OJtZn/E+W8mzRkp3G54nGVq94nMYqxCMFHSGQm78iW +CLqjp0uNPM1NUdAH9Y5jaWF7NzBQGh5H3KLqvn95ynwMbWeFEZ9tzjLoIO3u3qzJ +eBlhnrM7JnwG/8XYatKQ4JaLteyTdYrlENwmQa0d41kuWiZYGGar4Jwqqf/Ma26V +UR+IXP39j9agKLjzDDJJgt5Z0rknEWy8wQMhIY6WiKYpYGH4c9zrYtdzwRU7+w1I +h85xbqgPMTSVlmRlgn81vpljz61Tw2hkb1sUB2uqgas7nwUod2+eiZWBOKDl3awq +u6kwgp94M0opu9t5xx5oJeb+WdQd1nWo/5E3Pdp1hNPwFpqW0TjMgAtQHmXy3r0r +sI4pjs5PS6JZ05D5+WR3GA5KDA1cCMq3kBDNhsxqUeKkM2BNuq/J/qQL1pyXjlwr +4dqR7r49Op0PDIkkl5BEUOXLjLgwAN+TRMhu52vdM9V1jTBFG1hGFd4M7+4jOviy +jaPsJyzrhvL0tkvxpq5eQUJRqMqqqrJd16UmJZef/xhYFuu+p6sr4oNtE+JxuOmE +JgaC8I2HM6mIBq3VV4heR0CZUzP1WYk/iv+Z8WmYMTa2AVBbgwHlUK2fhLci8uPp +tEsLiwyWubB4elo2VLxvgXPaBROuzqANnGSeFM9B2XZoGejAVsDRk9/cfzHunHcv +is98xkuq9JRtWPdNIXgKVIvP0GuuDP1CNhdWR7XULqMZbZmq6UWsUwRWfPBZ9NM6 +rag4I+gpwnHPHAK3yBe40bgw9J9pSJVClNkH2RLoA4t7V2atSQOatLTP2JictUD1 +2R9kaeRdQ0XHbRe5QnvrByFy1noidLgyv2PXbZMHW+1OyGKMfY3eKa4/k/Wmgw+Z +QUaomeAVqguCRQB/8QBv7f1fLJu+ZqhjhQXZoTk0MdDro40fTI5wxxg/yV25sw42 +McPy8dR14mKAXocHpYhP792wVhemaBPZC17LXt95xLvfAOLDz/ORalrUHdhwUtZu +VKzQcxFhVp4aOCYR8gFgMKYNwX5E7I0ixfoTKf099fqwsAvKlOCqnoOuzFnRPrui +XNg3CkWkJqZG4UgLE9mL0l4CAZ2J9kbleN+4YMLQUXFvlk74Qial8hE0QBIdCCyu +6huelLEGsUZd+c+VsEQRUfq9sVUONGcIt9LQGFb/IYQoko87E1RThq2b5D+R1R4v +AWMIJGit1k0F3SxYdeUEYTCqpUddXtjhjSUGbzikMU/PbmyZXFu5PHMK6L8MVoWL +ZQ2TwphlVTo/gVz7dvW7KeZinnHB1BE2EOoSfhRukO2ckRH+bzuwC76xczosPLGn +LnYQFLqpYBDN1uCrvoyaV4S0xhgHsfl7kyPVdoqDcoVJSik8uKu6KSCUUyUbrrjg +lANey8pArBpI7x9BREUnGWNwZS6s5O9giMI58xljBm9wvu91fqGdga3qrv1QMgQg +Hytb/q+OAgQaQ1wIJpZbKliWz8uqPk41fsDy6ZKOO6UXYwjOg822Wwj7xSpbSRf/ +lhegSXgfihyeEeeWeMTLDWI+N2zuj16zZSCyQHqaDS+vCkMkAXUtJx5Ia3maBHAK +m1UMTJD6pP99zIqum5/QK4QKEk4rIvYtO0nTOW3L9fos2a6Cc2FouFon0Sbz2+IT +fVM7zO7RBwI+xSyDmV1nc8C5VyKxUlAAcuqVKEe9YnG5pwv3ogPKQZ0TqSp8zUCO +YOxHkG4F1kxAXHdrVarP+BYQuYIru1ZFovUQ5vYnl/8F3/7cuD7opnO5hKBr0tvD +6lM2PvPpIzlOVDiNZSZDHOfmYWWVlq4uzzuP8tG3tLyYBGG/AZuDTA7WNrOGTSSB +ZP9FVxvNT3kaxGHmjO7lGA1FtjRmkMJr05EWMHHvatvRcDFBVR1thxLkyfneSWs2 +orwnAqkYe8Fz9U8p38L4UC+J+2EZszHAeSO+eW3jrqZuFYbckROdzhktdUsRZcdL +WFpDIN5zINOo13q2Ei/nG2kIlYKp6Mq0b+wN4x/ILkBWnOuzKXOY6dSrRr4y/zq1 +dpr4ZfQezvsLNh8zjMolwXYdLj32Rg8cgmq6bPWIm0k9Qbln9HCBTO5VihgUfvIe +edpOxvSi+HpgIGnGl1M/w62z9HnZBCIcgZS4Z3EPvi7CWQg4S1aOABj/mri/RBh4 +k2vx1D0EQX5gBRcbgIGdyFyiRT4cAdPiXyje4zLIl0XT+v3/+LJnX7NPWXLPSOM4 +Skq+fDvzrFQYdZ7yefdxIujVKdI3iuo9dWTwITApf/KYop/M4vb5CJfa12Sig+VA +k8wdIDwXkklbOvpe468KAtTdUyoluuoROH0hXNaypKHBLMHk0JJRVB9OxBlIdQSs +jEoUZqQF4Kll7vHSC2sDeYfwiuBp5qZRPet+ew0SdwZfVmXcvjVKr8iPJEtr07Wj +CtyMi2+yw4G4X99em2JJu728dI4OWPUeyuR4x3dRf1fM5OshgLYxEJl0CMDqKVr6 +GqJ/HAhj7lLQ9k4NOLn/RgKt65jXrjEJB+IHFFitqGu9qLKM8QkMAAKwBfsRyJiZ +2e7aMj3w51DrifRL7uq8WZdP+RzvNb81WItRtVBQecHnPHrZI9Hwq7guxlzZTOT1 +lmUYNC48LVuq+aZsaD5i6MmT0hXCTC8GC4W+KAAqM1ZkHi8sV9zztWD0YCxmvjpi +ldx0MTVU8dqySwvBFK0faO31pG1rf8qGVN99Ys/pY4OWGcnbDwGblWhhYlJYZ8uZ +7IHt+0Zh3hpVWtOAttwifKXM6bGRX83O1FVExJhXkjg3zrklxNv+3baMHKrZFryi +uDtE3LLbc5ypK1Afp5oenYpUiQwUeJ0fGYH2NT1fEc8UCRqmvcJGSc/MmBiWRMQN +Iz83mOJ1sP3e0dbbXr4ZcCDf+RLKZRS8AH1zRp1FoBUIhyu4HVOs1C9YBmpaUGyX +t/c2O+1Slh7bpAKQnguBqIno6O7XB9rZrs/PXezDv/03CU5lQkYqai8SZck1LrhE +Ta3ak+EV76QfHTQm0DiVFIMD7IaXAjyYdm6nCDxZkLN+Ir/neEC10UzcWHqNIdKe +o2ao5YePZFY/WW0HicTH62MJDZFvgppWZSxx00IktHmTsILKgHkGgBgMvLTkRX+H +DdAzqFYNeewOnF2m4U3Z8R2pt3/m63p3sMSYsHnpK3OKjI0trrRJHuFjgTDAwhVm +xMimLL/8SnVJW+KtjZ+XazD0hMvBC2GzcrYr4h66iVOZI1tsFE44BAlh9LW7h0D6 +FRRkZkbipDpv5uiKoOr6qrhjf4/2NxCdkYI36cAfU2czuPPZ7OoHkLniBbUuKavc +n45Mn8tkq0qaCfUns46OUCc4qyBb3igBKVLlDlhP6gjNNdYKNaRKsQ09bs7TUk+d +fJupU57YoatfskkG/RPhJebLSuuvh5+Z966ZTfGSVVIOFPDdACv/S6lJN8DiD7H1 +8b+bAVMdVcXn/egeKvsNuWovYZU4DPVdOLM0E5wGGCmqyt1ygFSaUcoFVFiYfnAB +FkIxxBOtp67dLSazZDRRcsJRLroZ0AQRl7x9zN8Z5E/OxvQtiv2C/evhntVm2Tjr +wdJlwPysZfKqjnccXkM5pkoMN3/vrNVjCGMYrCRz2AOPNVHrTr0Hm7TAFJ6QQOPk +xITHOlIHEBGg1T1ZI3gwSyl9WLlGRp5vyQ+rdef4zg1ycDIj7sxFA2nzBsUBm5Xd +SgYzbnp32Nir9MSr7pHy5XFPCKVzs0R3GqfAjGQlyt9Xuxau52u194n386tockI7 +iOe2u7DPjqVXcS9Z6lNFO0o6H27F2x+dicSeHXBoWU6DBxvvjWtHG5E/9blp7zCF +weP5dMmB3UzuL3DcIFprNGJt9kEqmN80eWQRn6H3X/IzNWjLT52AT6pKS1sowOsj +RztQ2qAJ5md7Uz7fTniUtjp831SmxvUx49Sh7XYfNEpqjyY9VizByKPOUdUKmoXr +fgXIfsi6yLYkoR/g34dh2JsKrC1bVtC2AiRVAgtcBDN1zFm5hiQGztq7D/aXzr09 +q9szvRnXUat9iAJjCPsfjVJ6k4YjpmQ3iX2Kz+JHHNBYD7EAW89GhTSqJJB0viM8 +3lhxgxZgxnBz8ymwhKsyu1GKzJCv3cmvTqhlHo5xpn1YMFU7ea5xm5XkYKysWhq5 +w1dSMKhuvA0dNau3XTef7M0AI8iWIXdM70447qn2Gwp0bO7f2KZVtXoYMzr51CaP +QoAEL6FfwULtruriOK26YhmH1F1ey31xgjE0eTbxW6AFLEvYQ0OX0PmjX1/OBW1x +sVil7+beskMwIJpRPlsx1LUc8uojLnaD2j0ymqkxCuF9G/WkX1nlyi1s/SJpqAbF +EzXkwj+4B1wM/c6fHfxyt0wxzaTNoZi/omqG6PdXmJDnNF3DlWs5LpHQOsKKKXSh +2Uv4055evCC9R60LgC/xONXYB4zHTlmeBNnZO9lwcT1AdQ3Ho0h7TnqFm4IBnVva +f5DZ5ntxLyygAdRLLHR2rQ3SN1Ms4rX3CtfMGvISX14CYu9U7WaHtL1XLbfw7Q2e +z+wf0xE2zq/cO2161rUUQ7eq4XmF/qYreQ0nBT29ell6wE0540ncv8FAOO3dWK66 +4PrGQJFY8qgZ8B9wmTuHUBvTZ6du3KI1LYGOS5yIktfFX+0UWK+kPRQnLt/ibzID +n1FoGt4lBlDuOBq3KcVZ5KiwEbS5uNsOuApygXanE9bEIXmGDKqGIMsIz3ZrEURp +vVMxcr5fZDhNFsaJ6W/MuN1F9+V3Xu4qgS6603JiD/TRiZwKmt+YjZkmD90p5xU1 +joRyPUNv2SVkOqAmxVV0DCEctj3UT6S6XN3eDNN5v+JA4qAJqoSdVjV8M+8R8bHs +6bDuwPrmOrQ5IFQKC0u0AqmrxfQjNXNftN0OwymryZcg2YTpOu6XAmwa058b7Dp5 +VR11McEUfl5qGtnc8Nhp3TUdvJ0ugx55LTM70SPZqADChRwdz/LGzA6Cj7DTKtAd +/aD3ccRN4sEXEPGhYacalHKNSAyQPSLWc8+7T2GI8KHZgDQMreHDjzWQwUydEliq +1wgEkXu72pRArUJ5jmE8ac8r3xGukO+HbAsijgQqKPctveQbGJ+Ypv08wKJHXauq +E11NwaijBOZoZ6BrCFG/yOrjStDSbrhqd9qVqm3QCewoA2AifcNnzhcQw5Yk5a2I +ehhGFN7eJxFM+bkXyHMcd3j/4K+7P0WChAS0vujJdm5I8HJYNtz6AlLT+ZT91zGX +pJOUOnguWtWKhOQ3Hkzy3LrRhjFUmpdh56zOuKOoWP3tIhX5NMZyEBe9JQCYgXMX +MXLA7uM/muO+Ju0p6TW9eZbc0vdmAjSDXGfJHsdXwt3XuxnbFIpSHhvLTsBqX78s +cS2kv1IIVvolSeBIFhWmpB8Z0whWNwKWk/Ze9rR+ESmmCM7ykQO+IuEjD/AdzOfC +H85sQ5uJLcL9xtzdkQ5jkryp0wZSgbApXnKMvt5pVxbUqLkEkguuiGwvPmKvAQau +jxnypJh+ygKiDrK1WQmaV6sDHofvLjE7VC0SbH2l6ueQ6lQBhE/26UOFKrsOmxmU +u6fwhiVyv8tiPR5/FLlp3ZuS4FjS6ZzBPAW/8VEhdeU7T6vOvpkDUxQZGsz+L3Nt +u0mHVaMR1NaMIc6LwCoc2UcWJSlVf8C/tjvWDY8cyNDUCeMpnadQCrxgvVhC6r6Q +SIJXxnkRgt9QkOQYzHx+l5I6klB6npXYE02+IVjririiAdIT1SCRBOxW02o8Jefk +lMpqXygQEb21j5LQZgFmwiQSEx5xpvmvjAn7CkWZ+RIwjnLdymz8yUAWHPv433iE +RvkJ3XeKw6TSrHfiJtVPOVoMbILBjxLHP5SxZ6S671WN+aujWpCKeUkIwiemiHBQ +NlpR54J9O0u/yDYhDtTWicSnDvMUJPEPOGMhDXgxzl6JdbnvpjEQhPL4/UMpQCuW +U4kySde3ANyjUgaldWOT4omzh5KLnrBxUrfsV9uFbPnNMROliOU8fpYvkrLaAb32 +mVGbYBncYJPgeVrFQTl2sBM6UMsDFeplGahZ1pzJLkC8aqySgIDpAyvZRBXYDe35 +C5sqCCdjeAUJ+/DOQOoOb8owQR0413HTnHQOU8ZkTsuqSnfNoH6KmjU3XH+xMlhi +8YqLK+83J9ACgk9e1BkYQA6TdJuI2Nt4MRoBdFnXP8SfpcCO5dm1Prs7hOlhEJQb +W7vNkZdwAK4WnotcVHRYScTuqn4eA4FIPBu8Mc56QLe9G7FWD8Z7g3bgbIDmgaw/ +Zc/V/6H8jUKMlEtPfJeHFmRxh1F5nDpjJswmLAGP+xJm9WUvuFDKHo/svpUb8KG3 +JP9gu7Hy39pZCU242AH4PK3cxPifhQU88GDWac5FfbGZ3fzoIW/NdxZnhSY7WY4A +nk9SEv3HGjkmpPGnu3AYDMYnE7XiYk7rtDBMh7ZkZLw26NH9hZeOE4sLqa7aS8KU +/WbhWzobgS4AlIZVNTUAPPkzKnPCIUPofCF13e23d0QI9nZDTe6JktEzP86lpzw2 +kQg1Zr2pm67jC9FQcu3nUgy0/XBPaBzn3LjCIYB9DX8ZjXBvRnG60qatu/yEYDQJ +0KE/4V47I2Qs91jjmmTY3yRkCOWR3Hpbi9JIXLuLivvMz36AYQvCrwBxXImBxjNj +u2d6McMg+LdDrtFjIIViqFJzYSjI/dtCT0aFHN3yF2Cfiy3tvlV8ja2B7Y6w+sOe +BByjguuUl83bDGZWZD3BXRDiKEjeNJMJT/hlVsIjH++370rZD/XMYimE/oe5m5wQ +lL4MMw/WjKHT1X+CJs5tDInM9nyzlbwHXkF25iYwA59Fu1Zbdlagz+SmDp3J1dxm +SbRHKDo3dPp4n3XhHcdH+H4eOdCTOQ9U3jOn5how8DnkHMGHj9NG3Ga6jZqSp5US +GithsWl6RhTeWYI2vZBafYF75whkB/iPTbwz/SKQprh6D5XbfQ23yp6k9CY1jnSK +qrxMsEfuJ07xN5Ri4VRn1EOEs5QXf2aD5znMFXlUrVbNRKuYJ64U92wdHjqwZsUA +CnVlkC+NUWBqLOEWOv7J57Id84Fast/x4DyKri3hqcfw8+t9lXfDFojmHWaPvqSt +t7Hxxr0dYIQddMF0vePV0OGNMXLAcg9wQ0Hhretge4sbWkp2cW0ESTsvNpk12YJ2 +l14yFBgLOZd5T+xsV/NG+3jB5lyXfhRYa+eTC0VbEyXAWog/3Kl4XcPEAL2rXCju +T3Z35x7XdbMCz5GSBvsmU92blmscpBLDOUJNpQBKIHyBmixM77YKMyE5ISpQ1Rk3 +hUAoOKIicF278ToBpdWJ/CyLkROzrTuuR7GAG4hhkor76alvyxW1F1rONuWkZkk9 +kV79E8Et772+7ndPsGQ1ZLkWvCHl9hTUJPdsRMjK/NZhuytD/oMWndUewg9AUY4Y +YUu8iqRsSyE7rcsK/LvBXbjf/LZd5orDCXyWDT7sGZfKtJHiiEHoMhsH/YNcSPKq +KhPyOz/p4hFFAaGfhxAdSnrh91qviqHpdyT5K6J/kzrrMZm3Mbsoxi5n5hIpeO3w +4g5i7nGJ8C+TxZqaOr5jL8qYpHN9e+Lakr3oN5pDlpvKlXNzf2de3OgyOXMkbNie +n0tdlCSkOxh9vCSiekjcclhPzVdcuqNuTriVcZiwcWaGQZq52MGkVbmTY9+qp11T +OPj51ZB5KbEJaSfzLvX4ju1XZWdbz5FAkt9RyDqm0cLNWU1Ue5iEQuK1fLoDqH8N +YyJWoHavKb33jQnqHvZrBnwxUlrpbfvqmqCvdsKdsjNu6lcreQU+reRSIbkgiVjT +jYMWeTLzoMFyo4sVGik2ogUXnVSiWGAxnvc35iB863IlIjr9iYHsiSkZ1Zd2ytQ/ +t2jf7n1chJTyn1wkI3w6Gj1oW1CO+4083O0GfU7aUJUwUACsUAXMso+EdH9uDu5b +UIS4U2WFff2dJgvNKXZh3vdsAruoEzsk3avocj72GvCBg+qbHL8rDfaZeT5qaBy8 +xNhiOqXULKfg/CwU/ilvt+V/QTvo9WIv11f7mYS0j18GJsgaVm4Mrw7uh4T9A5f5 +4PnmZsNM5b0HpW62DCnARfkjGEObdTC0znKbSoGn4wD3H09T5HP88oSd2q+rdx11 +GFCdo3MOYEhI7y0cUBO+onZozOVJELyW9sbGoXy5jcRtah63sXcZN/+hayQiH+3s +eLh7rOtQSV/Et1P3oDK8hrMUnNcK6+BMediPxf/PHWCGBqjZP0t4diaON/UBavvZ +SWA/m2Utgyqvy7h5IEOUbIomiKz90OypeHd57tVNC0BNMIQHnAYvgaDrZbUHpT2T +7LqLPpG9rffH12550v/ZCCUrIFy0SiaXNZYQiDeG5/WiBOzS0MZZ3PVIMqx0czOG +Tx8WUcSEasnjAH+pGK16YGDc66YLnrMhyySgiIrWsKqf8NolxDd67Z6AXcvKh+zy +sCwUHzvTgXJ81ejNWekHIaAUZnpYXe2DCKXUuEOFJpYCdn4EfgOryDwte2WlGvUS +ZPfj3Ym43bG0RoyFSo5qnJNE1Z7jjNJKxOEIFy8NHvb46ipcY7UeT2r6R8OJLi/H +yM/8L2op7rXw6UEPat05dCp90VrXtzrT8UgF72yGVP7Wc0Hosb42JuqxmXtLlX6I +oOu0l7Ht4zaKMm7DGbznsqHs2daXNhJTAQ49e4owHN8zpIZrt+SbN4b1/svO4hZJ +fK5izj6botAkJIAnY8FT+lyrJ3oRtB3dq51lg/tWXsTR7RYyl2UVxXDRw0mpW5pe +J8XS2J7tLaTIsVbuO19Q4de5u47KlzOn+exdvmPu6QwZVBIIs2CIFhYKjXKVxKAs +tTuVv8ygT033gzrXOU9XkbjEPaTY9Dy0WlUf7wwg5Ug5dmEhrRRlhu4+rOc9mGH5 +NzEwSl4ZJmEPP1auB87iM3l1g0KcL81QX0kcTVCS0AnJUNTg1eSr+zc84tn2VLyp +xdWidOZ5V5T5p7O0TDDZ/PJAddWAuGhRmK5vSW0XaNYcKUdSOTwul4+881/i/1mh +ft2mHm5+PymHbBRVLMmVvB/AG9jqACnRXg4pbHwxp8RRMm5AXwQiRrKA7arUPttd +1Faxq6C4e2GIYDdbWmLRg2P3PYZXbZE2HNo5DGpZ60xs9GwirIPeZZbmPjRTTvqC +h7TBHyNZm/mQ3jB+f+2vdH0k9kXFxGCcitg+1faAjCOIkcQKdpc8RMz+e+XSIV39 +ZcIlLrV2Ku5jpJ9MbWNg4BpcCDi14nteey2R4JQGOSyeR27VMjGtVWB+b8fNjT29 +J9fDdgcso4OINe2jDC2oqtmlCHXMYDsaWx9uAB0LKsGbMYsF4kR8EqS10Yo709ij +ARppJ4cRcYmxN+GsVLemIBTYVObK6Ro/k88rOZk00+cLGNWsZwkp2Bgdu5cuNfEX +/0xkeR8dtuIZhAYdc61Hc61TVEQFPUyhbLgS/PEc7jhkLkbD3p4acVNrqt2I6WAH +iAcLHJe6aCB29C1XRJf8DI9a5+7nXqSKFdv1pKQgVBLon+gk5CctlDsl/H2J4ehW +J7/MrWpmKmlG5AUuTESqB9tShUZPCoxkB2wEWgNtPwoCi7+P57NR5A8BD56zP7hJ +3vrkxSLHnzKBVkrN82cDk/RiVJz7PM6108APRRWncXx5kIfeK48A5FxgcZ7RElV6 +UWQGFfoGlC3rRJyMYAKai5Ial/mQVLwtcdTweaQdNiDXVKeAFyXgznA3fkMfE+9d +0v0u6FtMml7KSXUwIT6JKmg17W4Lr8qdGFzz6W2YqAI0RelErgTbuai35i/4YTnW +r5hOuCNTsDYZA0XuNVq2xbIcLoCJPOkOGRNtCKZdIt4CwBFGFg4ak4KVhpFjNTvC +wBhDj7exxsiOdtpniKeHOiGk0hH6IEMITL5e+C9ycXmur9geA4v3Vr8E3MAsFixZ +mYbgqx/xlI8Ahprd36ab+YTwmhRoav1ZsHJiiejNfUmv8Z625nQ7Pj6LPysLNZ0O ++UKZ6wm6mEBYm4hP6GfqJK3k/4V9nOt8sXxfo3FXKVAus26m9dDYOL1qb4NWsRLx +r7hGMJfsf+hwcCpcN2urK/C6Mzpa923kMBBp/E35ObTyv9A9Fnjdpsp2t3Oo+G6z +Q9IYGV2taJt3pPWK+qLGxkTEb8HzfH98vdWfdplr0B5C9pXel+gK0Dmk6+LnxYXk +TA6ao7f8mxzLSMUiPjLW1Rl1udPnNjGFIdgcPQ9ZNJSx+6O3o2LcU6YVcwTcb4ES +vqT+dWkh88O0WoKWkQL36V5mBUudSl6WipcLY2twp+WWweJquHA4xh13uqqbhF4Y +4kwkupt8Im0oQKrLSofMaEalUPMZkIaXai6qhz5niRfo7x5fe8+8jS20HMUljbDG +sn/Uyc1/MBv+8w1TXBOWoAgaoutuzOocARU2RbGrICc0Mm/rbuUt9nVKxpW1WvML +awKfDhbY2XYoYn0CzfYrvA6oGZJ3bNwRa8MtEkmQdR7Qb99H5hn9StOKNE3BVKEu +AZFgiWTGI2Eq/XlCOHW1vL/D4bPun/0PP8IfL3PyPjiELm/CSVYP59v1ZGtZyPqz +2By3MT+7r1gqjU02HMElDq/+2MeJMu5YMzhcibQABS4JmqPHr5fpvqTzyz0T+zs7 +KRdMh7LVQ0WmW1F1pkwHEjVV8oFWkHCh0s4e0pmYPhW3/YRDVyAGSFNY9zKsv8a9 +BpLQEEY0JqW4aXLibKciLcj1dkY7XOrpFTir+LwYaCt7NayHm8ddWjWBg694U4Hc +zxs8FWCp0VKm9/HlS4Nt1VkoYmxWdZCLCpllS7ZmQ4K9m4UfIRcyfh6NGeUOJ+SL +av+L7m8I0TyRZ/0hra1D1c31Rltmt/2BoOnE6oo5plmxOkpV7PX4tLZO5oNlbbel +C1IkzdjI9GLQgqr9XhNszFyeVfb8W3UjRNHzv+NfLY/bqU8vhDjtHmchlsnOiFSL +TbW8I6VtbzhVAh6cwCE+1uLhd4B/pBczdg4DTxv7DkTZamvzOAVfyK5r38A2vCwe +LOFpV0BN9v/4RqfXejFiw8gfXcA+UJNcOvVuRp6Hz8tmnZzyfTWTMRP38FTR6qVL +7TGxeUwCmmAzYR3tUAwBYQzb7rLg5U7jeMtii08URsKUqOMFWvEomrm3Gb+/mRXA +LZSjp18pflAxDtqvHNCxie5Fo1yMbqnO2kYT0BK/mppsLzKYH4QiuYjjTv9ffKjc +A6RtTVJ/U1aUnJZ62nQJcbAw3Lv6YgtNFFqUq+KlwEhudvJpKtMf/zwp+caxyYNn +F04gCsJlIVvqYUAZ2LV53tnLkBMs85bs0nzRBUkPCw1PK7YRv39mirDMYvbV3F5t +bOUjeQvUx+tYzRrnT/ndmpPFR/iS2xatvoErkuIPxMrgX7W3amN6CHKGsqQn9VHd +ujqoTTHMkIdyq7NcC0DIvUGjIXMMOwHL3bq04rYXadpsNgiKxqhvjallJC/1aNKg +ra2KuxKxHT4g1lt501i1Xz91bjwXJPnKB5vwseEm4eElS6k/EUBWoR0AWGWu+nCz +RWt60260ENuSuLT7BB7pbUUfgYxcHd5oJO7jQYK9xY7LImJzR+BYKO0l9M/TMWtL +LxecJE2SdMkUJcNAM8p5BVL6W9gBzDK/UIh4qM4Ja31CwOdyrUUVr29HuUxnTNVh +7RCX+WkSSGdiq1G/PEb8YwPPs7roZSP/nBcj4GNh6aZFiv+RBntOpzJA2oxoJ/z7 +4hK2g+UC62A+krW41h3QvMCZ/ZcNmQWcLg1EsnVGThFajtz5+1MU/p/R0JZ1HE/E +UUoi+Aj6MC1MBsOaTqKNKq+0JL11hxya0uypiBJTQsCex63bdXGmOoN8OK+TQ9gt +GO24H17S3ZXXy3koLUY50YGVXXY6UXgVYL0TlGWQFNjEzDxgZI4/tJckEyv+0gv8 +82eMDz5sMDVFXdYme8Rz3RyrG2+4kS1dYQNQ3vKuSABtAMU8v8RcoBX/EZGgOXy8 +4K0F+nD/Ldoi9d355n/pumiT5uz8omBNFs8Xv5zIArGCGg8fBQAqRslA6su041rp +Uet3zhg3/EICocyFAsEL8a/qmG7SgmiLOx58ehTBs3/WMWr0am59UJUKN0iDHjB7 +lOezHJg78R98dfWIeWq2nSbOcriPvZcaWKbTDmh5ss5bNhwLHn1EwVpIdWzJo51R +3J321Fnm1m1IpPRBkc1DV1Jt7daR27QuC+ikQC33SKOUnKeE9Kb6sRSA/9jBuzIH +Z51iPuEZDLgFlomc5easAMfMYg1JEi9ocRsnzyEL8P5HS5znAdqO3kBFsG6X2b4r +z0wgBl0TO9jKgut/WbW7rp4AhZQlrRo+ARF1J1G7dPov3SZ74eIhbbIOYf5owapY +Fud9ctRnE90T1B8N07RRorhMvhPw0fxiJBPMq0jGVTTxp93gEA79CEBh/c6RhhdZ +++zOma31Jc/nwvxY/FzGEUdzT+m89leib3I2DIHGBaQ5ZKUNXFRz/VF++sH3YrGB +UQXRJEu/rbjJMXCfhs3TLor10cDx2P1bnO6oNTwt+BQuWH6Vz/cV6+KYDheGK5IQ +N8iryCFvr41BDkMj1YaL55EqWpEk64adh5WN8YtruTowlJjsZ+d6MM/vsVz0USLU +TeoXzOiNIfXFO8xjN2PS4PcsEOq2ti/oTPlJJW3hQ6dB4R8nk++iS+NZ6SRUnI8U +mQ0utN+N/1HQKLh9nzUACdWe9BJ4KMJMpF8Vdk7mghIcX3aG9H+duT3FY8P0nsed +cJM5H5tG1RkLw98POYNnPjn7j8iETIAlNG4QFh1qSO27rCHu9X2+9r0XxDPZiNhT ++HmdKXeIrAd2HotvWdwBnBChfxAb32I8QQHqwxkS9eBcexC7IxIkI3HLO1/EqKZU +XqpLF8eyZ5YlNwavBoHPs5yiVJyXX9HHDwF12hGiPpj5cmjgAX5jxV3OTVp7A6rc +cx2Appm5AeN8nz5XE4WrQeQQek19Dd6bM0p0kowmusMRSjOJvLCTtmTyLeVMXsFi +/mLYee6rSEyjrB8lIjVMWq33rz//tnU1NuoqTM0X5Tj9iUd7R2f8DAA8q2NageAR +kFK7B2IAIKpfy+366Axc8cE2+of8SocRdbavX35xTahsnQhaFpoDoxlhoOkCTtzj +Y25jc8xNSO7ULGjE30DIPSNp35KG14rNVNTHJB62ks3z0XirNU4/pUrYOzIfBdZL +49ETu3y7oVb/ouhZs3QCptZlkiFf9quG/eTumY4cm63n5nTLjWwPpUFQzPE2gpgS +FJXFFlm252hRNKtJnNZv55EBUxcd5T6GjykyfpKxEnxBNbOLzsg3c/uXDKbJjpwt +qpCqA4Y2BXHYNti+l4Fxjfy/WQ7a+pwMj8ImA5vqxn14N8cQAKSYI7m8k3ZH5EHy +LMCrU94T6QFvpxzrRB392MIVR0IRe6mAvdPXpbHdKXkIYNYCtVZBt8TC/kPjuoXK +84PlabtFzJAMZlf4Eg1+2WLTPCJageKSUsOKbJqn65tw5OX1i7W+hdQQnNl/c+CC +jR1ZJp+AK5dOi7mR8lV7NPPoI7wkeY8avx4pwFpMtcexxAldfx5sG4Fd3MXSYJAz +4n+qqrXjkTOfYlbuPcG6CPUcFR6siHktns5HyKBrNm8/8pk61/qgtJy/1pMpUia3 +kV8aFL+8Mey3soYij+DBeiOIE/5tyASokdngNiwZvw4K40PsW+jzQCiXYeGfhi9C +YiTydDpT+pWBLxdKdk2B+wTIl+F6XniREcz5o2+ZyJzf8u3Nf1DI/bqwNk1+tg9t +yHcjEHoQsA8YsLkK9JzhE48pLJaLHeGGfJlXlN6lPKhMrvWiEAdjvTLqykyjgv21 +wTgZg8BSf2rKApVGVmJRr1H4hf4eLpT5llt3byZ/lnmTfgJ9gLo32wDfPF4xi1U9 +nW6fk1mLN1tp3YDaIAnr1qbD0kFXkcjGRmWg68vukVNzaRcdF6Su/Y8jLlm3GQM6 +q7hJWH2ZnqiOx+9XPHyb6IDF4AXxbYWu35EiSgqu+5L0W11GlyKbB7plExhPXEn3 +HItmzZ/wuAhf3DOb/szBdeOAevcTjNagohAeax3yvnavgQ2925YGhezxgaEoxo+7 +U9B7T03XEGTaIx5qn8EMqu1wKy546kSWBhAxq8wHXqQfeA3w88f12l3VVDT9nYoU +lEIJyS6kzOASMh0n3AGFv+q1YG4ZGlO88810wFoGXAOJhCQ5jgAWFDrK68F67Lps +Cq9lWODdG9dypIn/bGcv0fOQtoj1YmA5ZzvYgzEawftbGruaMW1FjHJcH4Lnosa3 +0hDBLBclrgG5ZoMeOtTQpmRkmioTawwGVoX3fmi6eKtLWKJWL9znh6KRLWIPOQb9 +/KhHmuxPyVYkpBVc7EDyEXdaZfN57JTCvjBaGZBF3eE826q9mSTOiaTOEUDU/TD4 +vCmsDCL9/hVlWf1IjutZ6Iy/BGupHY04lOM18Wvr3Npm2B1TVB49mtZdhbN5bUw+ +xevTb5dgAfYnaDds4zIX+h2FNeLp5rDty2x3th+5Hre/TUY/zJ2WaM0yigQ1s9Rn +5uZ6sg/bPe+M6nOzPguHz77pqSVa9PrGsHo65Hgb1w71S1NXOMFaCKQEH6lVl6kv +UPKs73P0vUhAJM0njD+8LaXIsaTsILNY2IbOPyMsT6TgpvHkzlO5nR+h7R/o2pao +kDmW0vBuHdw15V58JlYD7DR6eqsP0ESdnJRjEiuvnJEWElXXDA6OX89OqiM6cnFX +LuN8BrmhdfH8nPXDTPkIGLcCOgBg9anEwAWG0T8ZXKY60nElz+bScXijDpyxnGpL +/Wmwr2L0WtYoDyT/X5a8qtWY0B0I72NFeoEkg/A5rHGZ+SfSc79sE+4dm/zVNU37 +AurHotydNRXi5tL8/SgWggSD//KPv39pg8lmUi8AIfe/+Vrmqy3fnCUgyMb2iULM +mMahyuZb7m4Glsd/VbCprT++3ZLV1K+SzP9GCZymos3byCw4CZV6oTrkyw9lqCf/ +O4xXy6Kz+Cl91do8OlIG3PhOmRSvVU1uDQmdX26mbbckLhmk6ZPYltg4/A33rfmB +Atc+5XtVRhRteZ3Bk0csryFi1ljX5jdslsYsiOzPzs4FfzY4pcP/75ec92VEb3C0 +8lF786UbHHVBu6ZGDSBASbhqlVE5vC1z5b2YJRiNolpr+2KUOsDF8ReXDaogAgyj +vcczjik83AV4+Wyc70sc6Y+9kpTxchdhmug8Fdrx7gUwwkqm25m9ia5Z1qIX5RQv +RG/pMtdOLbps0XoE1GEZjOC74bIfRffcspiPmUEDKlfqcHdB78Z6sgNAO3TfRzTV +elsEB27DNDNC4OAYLqfXnt3WPhfKyE2LHGf3jqX+izVgy2LdqxDd5TB6LEnWpLbC +K388OEnmc2HBxhcoPQqcd5zyDGsXXhK1EuNnJMvP2G3Ug26wKd0xo1H8Y5cVMEw1 +W6YHmLvsxKAOEScsjqfEMkwMQri1d21fzCwcfqF1v7sA2GwLf1QNC8Vfrle1vU2E +dvrMtsnv4XZHSPMlsYZpsNpR5L7T79hTjsHIVHvfOwG+VhzL43G8EIdUVLDrwZzk +FtJE4jF0CG/mTcgXPiT9gY5RBDYFjdwEVyz9nCBBopoYmY15tM19g9uZErZ2pm2V +2pJXdsVMTLM/m9kZcShA7I89XtCZyBlvfV2IO/xLeqhKCBhY945k1EDvQGHWyJ+k +lC6zPO1F0ihTLE3mhDIV/9WX9V9iKMMcO7b1XRhH9ym6O/bE6XECIvA6V5Zi2Hvy +p5knHk4cuGSOuQaAxlUHgDTZVuFQrBeygh2xJRHDD0aDKff8lJrUGmSG6STKd2IR +C7YWBdt/nfpSXEqKejOteMxil0XuOxQUTqmIyysvEXsQAluYyEqNd97LleWuKvox +0oUIj3W7AuztDo6NesANMSvMquGE1DCRm+SlVab/LpT05CYpLNhsiPjzRy0vTDhz +RS+2i3d7OFWzmmy0A1dVFojqvVe+rVLgF8L9aVEOg/t8l0/SIS1X7c1deYYIlqyg +aQ1kjUOrUNaxIXyBgo8drkBt/esoO2aG30Ty5BmNerORyWi97Kf9Kz0FFwXFhjWF +wfhV3iVlvfB4yt4xyVOiS23PvRqhQh5FDGUacg7l18VFgQkEPCCXoel9oWQaqB// +efrcNeNlOjRs/zf+gkgQ+YGK1Tg4WkcFCrWyJ4CWp1FDy777m4tgCABc+Uf9elwc +OnEFDjVMJlIojzQ8ojtsMqDyqka71A02UbR22JV5GGLMrZn7v4a7m3IwYKsYDOMq +rdnhETVHpR/MZNpmIl9sJDqp0l9f4nfZ0NXaEGtJWrAi1y8dF7DXw06ejb63m/vP +u3CpEPd031clExD9laaCBX8+eIpZ1qA6auswkck/itIasaeXO0B1pyKKfT8/sdBF +Yec7SXwaZ7YMdwMeQ/q9epaQCjfC6WhiyZFOspC8iKCv+YG9DnL+IPLoz19Uy+0s +3MIo2eEb4UEoVusA+qPmyo2J54jxjoLg3lopEzZy6INaWmLwfLwuUPmW4ZQVGxTX +K48eY7AQVwofe7+bVabVaJt15o0lC4bwwyvUFmVYYiWb6cQPghLlarFhCgQG6PuG +cb2pbwNpS37CR3ClVoKoGpRim8UdgQCc/87wfpKGdIkNHL03U14uE/S+pnWKgxE/ +hVlfAJmEN2XXaxs8EUnyTyChxvXtR6oVPinbtDKUh+K6jhFrc6j4c2W9LaX6x3VW +8YceU4m1088zXoAQ+JQ9ZjEE3EZSBhNTtD2CUBWxVvMtI1aD4pXoGcftSC48nJcm +2yva7a45CfUthHrGM8K5DqHuxgYPkbvMxpQhoSAABg1XttOEBhr0wLCe6GwjB1MV +NJ02CTwcU9NdGCXNwVY8bMQYUNmKWgno59C4nnYKGx89J6ot0oSDeozipqGR6qHH +k6TOjTmJck0x5v4UB2bFTqv2d757j1wHX9aWI+TfE5LId9VNlx8eEceJPwLQCN+x +sklKuZgzJ2kbopE/t6+AmOOf8Exowa74kJFjSRE/T0muNYRFFGUj5s+Q3IVqPc07 +N//rNHGR64YK7rUuIWM225WP9PF4cTIUwReOO9+G/RF/wwlYdPFx7gGE+RZpvRet +idaiJdgWpWq2LCfDUr1lY5tpO5t0HIEEfGfCngGiMmxtBHjlQsnTxxiUbU76omrG +GflKQZprwhbm0QjLr8DdqAWbl9NHyx7sNvNIBvIKfx4ha1HdIWqv7TIc4F7weR03 +zm4S2xk3TvQvF5B5S/wkP2ah1Q4D6s2zb/ltAfEdjZh1OplgUwtdl5qmD+6Gb4Rf +MZhmhwPjFlH6tZbzVlbEKCBAVb1f7fBHdITP9J6vuZdfJX2KLgmowSCvF/CV2eFg +MkYByXc70gFxGVQYWf+iyokBlopcPrUtaE6lz9HdvdYs8h9E6utNfigBO8HwesOv +3mzx8QdZIxjlFobEryoM8coveomoQHMysGW2T7ZZcSH/qdGsim4wbz0Gh/2a3tZt +JLwcuOTnkCy48iRcbmp1yM2v32466e5swRG08jx7WvfksGsyw3s1Bf2aKvXmLTfn +shsnvKATqsbt9oYfNRSkr1VfbSHrtX/4QFSWoKA/y++3BCf1fymNwgZRqyWGiJ1L +J+eXOgl8hPXQqwR6NAONtq81uJP5hPZ96B4W8A69Onlz+0O4yuHL0DzJXR6Y4WAa ++n5TWI7+D5nt5qMpURepwZVFAUblGqnzrt+ObSbZ4439acvFBqn2FqR1l903cMQc +LVM+5iO7QFHh3cAp0wh5q500lgTI6E7isKaphnf7lrYfhu/XGLEMmhiIr6vCHIHZ +qqF4LZ57amrwoa6vdbU0Mb84aN72gTee/hstZUUD9hS2NN6bRwwdV7Q8kCd7KXh4 +ksi+C9ezIkLL5rk/4RJEIVXzAYsk8+EPTLmsOpEld9Fhsz8qVixgMUKGuP7DTME0 +Ho+OlDdCc+LjeZ5PutEd+NErTSnKa0/wvr0p3SoNfNIBbLZ3B5vZmc/PJ/lC78dt +lEJSoPLROxAjjmVL1PBS/xK2C2HFGl5GUtAJr3MBB4AoZqsm0ZE4FzSgkivPbDgT +BC5uErDc8j5XERShES53q+pqsH6iFCWjtxfbQR2ZuaENehgBS9TZ5FC8TqhG+veg +f3nyC6l3N1+2Q2vG37MM+u4de+UueB4J5aYaTOnozJefc+B0yqdShxKFjJczuQ+y +U3DWcLMFVWcxWLJEc/ofdTjaKArlOsPSXcfK+MkGg7uamfmpwBGAVLAg7XQAczQR +xItqTHxdRgyKmVmSQ+W32dPQezdGlwGx6/6xd4tgvkbmvcdiD2Dxd+hERwLxV8ch +/6QZsS+2QLwsfCd5PuowAd4smW+t0hh/T2P9nJj9RFqAGJZjxlk2uiWgXnJqYka8 +9Wh3i+l5VjU9Vp88jbXsgNDnXv2moTm8PhU7xs7yup2OEOyINZQKmP/IruBdnIxL +//mkxVweMNZx/zX8EIU/ZCWJLhTZdD1zQ64qg7OLsbDyoxUgjRqAm3ThGm+/RM2m +4oYmgnEo0992SEooQQdaEaknVqxr3cFBPipBjhtSrvHtTmPdeXZd9LJMzDma1QPN +CVE3N3cFlUjmZc6TbNobJs82eepRP5rReUDh774+Dmzjt9zG/f5lwd9AsMak8tSJ +QqtordsjIBbD9mullL9VCAoEaICDQuKJyuRZKC6Zl8KmUlbJeRWAZoGYzFh9gQNZ +vyowcho94c5OJVoWrkN9orZ3/AilScbdAbbVx1WUge/M1MTIimoyityrctwS1kCj +5mEpsmR0KFkxQa0g/N40ieVaidIKulHKJ7/xXUO8Xev8W/73Foh9iJ4Zzk6WeBr6 +TzopDhv9S9C7DjYyPkIa/h/TcoW0ERGleqaXNUdv4FMw/h5elQz8UNTX44LA8e2C +9rMkErSGRCMJFNMfw1tE9i4bDvfaupbAQ2wpASuLnrE1o8NCHAAVhL4NVhVhuTQZ +0+p9l1MOKB4Mm1lJ7IQctspsgdI6tX8mSHtFkzxGVTV2mReDgM+xCiM/oK5Nqi3u +bLeC/zCdhj08i1S33/NLgDTqXHiRQ4ixwmySXpJOhC/rbvcpS8n8LFY7vstUAg0P +xc+wdjQV2oe7k2nuR/57pExIffynJ7VDbbKwSZ3Dolj78q9WuB7ej+AqXWyJWG8a +aB7ayuu2J9r5kVjvR4XhHsJsPA5HOe79TJwfLdUdGvoH95mHx5G3BnuqShPWFvB0 +ejs4MN7tUoAMa06Te9AR20s867XbFWlA287mptLRKaWeQF7348vEpGjSQIJOzODS +GCqFqaWn4ketWLu/EWfrSFMQMLeOlgIjWroeU2j1pIlPAS275ukJq06Tzs3vKq/u +dDZsFg5skLngk8Uf1IBAuqnvFo+oCmK4Hcjdm22Ab4s7s1cLoRZOOVM+il3kM71X +pcvOL/MnpEZ7z/Dv+0/EkvOaB6h+f6TXk5pSlW8IwlZ1IyXjXshY8uPo4zr9DuGa +yHjCfvQxdHzSjBQ8EFcTarxQngcNynIcOt8EhYcg8sM4l73YoE50GIbJEtQStxO4 +sTdfyE+648y3mVXqMmLslw+W5i5CLN2EHvMLiOPcRccRpyfgSzrKOkAh94FjgRyn +lENX1UgKrCEAQwSdtKW9KdvO0IoLkRqcsISbji0M5H1hxwY3WImYxnPSkLrIDXnx +1W5qCXTjPqRAyuhLO3L49NcwCbCzRUXbfeATqQNWHrqjgI3rDfXhM2CMEzyndQ2v +qRKS6NKd7gCRAUJWwqqZeJhkMjIyEodY8Ni001VxiCAjRIekn7W+p0dxfedQWpVI +mDDElCMlXPQ5wcEftCjNDwrExEV/AAqEPgNzARnzQO3zrdTgs3LNTQ+KD/XRSeE+ +PlRMnR/buNn+EqXFNmF9iQt/y93Btb6GmMe4gAaAUfLpirozlnLYq4crn+LF4HHU +tIi+AFTXrckbd+UH29l1JZLssgC5hNFVyJ5yl1e5XL+G3Ak63UyGeoqTbuNDMCRY +L4FCEG38vzg6KZMzKyRbge3jPvI/ant0OwF2R/xNXaTedwHLBw29ObXNrnjzYMcG +nAhc/i4QSXZpjoucfurBkyeUeRofRc1m62MZJvURsniWqpg1YQeJPBibww3vHd+O +59UrrcXjga11aRhTV91rGMlgigMeOxn3R4yR16QTRIlnwXUpV4fNddJ4YMNBs4yQ +bwvO3LZxAoYInLFBI2RMYaXr+ujFMTpw0INHPqo3TXFsHnNa6HVYdNKbouXv5/2j +bANMr6X1ITuTvtQN4tWGbop5qfp90b9pPyw8P0bxSdro4ZHMeSgbiS9q6qZxjVz7 +jnOKMUrdbDkbYM+ojXZ18/4WPKtaxf6lTLrh3m5CJ1V8slRJp0Jes74aDQf/OXqo +QgqVrI2wnl1klGwn06bhVaymdk0hMkxAfeHBGZIQ4BMMZ3aLuVWjAcBH/HP1tVQ4 +IG7MHRnm81yVNgA6yAuZZIPQwxDWVko7rRm/DnsJcpKfL0nZHoF+bJ6q4Rd6Dey1 +S96L4PDmXseFkVZOH/7dNWyKuvSA/MmthkN14lWJiYJebaXb7oZG3XDC70o7bG6Y +mtGOrOwVthFereg1Ii98ZA4nKgqeu2paMju/t03hQXHY5iqyV9ax0A3B0rdivz4U +VbqCcO7pGNb/Ki3gGc3hfVw9YXnR7E+tra19eE7UM7o+YlunKF1Q5dJaLKY1z3L9 +3UAJmXG/sZcLqrDn9zHfb/YxqbyIkM7VIU2kKztWCCNiNKgLQsIoVzK4sbS2LVDI +grmvZg+Q7EkwxZ1FXeBGJmsiyjKYPU3PI8ZBU1MXjwTjtnQRuBSxh+Ok9glPeE+1 +rUDdlVoogUGgPAvLV3BM43E/Q5VE+X04KvPNKINvvS1nZpGKyyy1MayOfstc7Hsw +W/RgllTEd7VW5jgZKg7YyA8r8cUjMqE7zewrq6MtkoFk6ZVslWxfoADBW3ivwdwe +I4XwNboOgBx77qxf95aHRRdqWZa0JF8zvK5BH6EpBI29hlJU4leax696ACA7QIIM +Rpc+ulkvHsNxsUlrUut9AXoob0MqDJRmZvU4gSVivHjvKLEIlymJw4pLbMWhcrNa +v94TExP21Fy/zYcWiZT2nCX6qZVXTcUcQGIrBTWDbR8bxKll4FNo/2zmelyFmeXt +iH+Zp2EwFAUELsrxx9plNd5WceyU9VnZoeucNFd2QFl7lV9KL8AlQaaMdsYOt27m +8j7iNBID4HtCYM0xLwE/5uqVQPxX6qzPPZc66MSRIi8ZHZPFvVilFVzFyZSrq5Lo +ojQQmAycQGOzx7dwx7vi9SeTrBRY2PK3WVurcLiRxM+2u9vjlxigwimpnK3VU1dh +GDoPghB3O34bfiV5GndcnPDLJxsSGWz2z2WiyCFgCkVp3shHUN5c2PLWDIOf/Ejz +LzNJXFKjO6/6ZGpMmGf6bZCa9MBnvXMNic9/k0lmtbgj8SS+2//gko1EDa/Gpaqo +J2xgEuHLvp9KQABWt9VRI+tNUJQCS/Jq10ZiT1TzhczyJEqbtVDOo0l5A5sMV0PO +HszFNxw2BmuM8RYGgAe5pkrdzVdtB8TLmhys7P+xRXNXnsUb+878kt2EyiXjMl1g +oFeAlj2afj/GgelJG0G0FXm5WPDhbthHOO1hW9RP5WCTybjUTAS+GbikVwxa7bZE +LHrROUOInY0ntR9lRNjpVCMdajCsMiqT/G0C/ApzeW6ErLMFIDdVdGSdnz/WDi5C +xQTIS1FOAdefQ0CohE0yOOvjKTAGzht+g4gYiSa/mOnvXcCVM8t39thglZhq4+6G +oWpOrXwByd8OA5f1aQMqSgoySJOGg8a3X7NR9bEDbF7/6QNJE5FvxwXvA8zcabUo +OGxXen85Gkq1M/VnlJ3RGM8vA5UizsdPESYUCVH1eKg8ROlrQOr3ISj5kaNL42fv +OSROmeHvZrHtvGn6hLTNPtWcm1hGSJS/Q5CEZe0/4ActkorF9kuoHCSG3UegX/lg +5mD9aMTHUhD5VooS6OdyakqD+6LptNqQPL0IQALsS9Ls+8KUBxIi9cOe0xIusAQl +OmyJcUJNr+Oq+Ypr6sWvelbWiymgGDN4gHm6BvzyXv5ihnvnmkIQ16WkAsIChzZx +cZUl/bz9bDsSyJ4FyzSRoWuURTz9la3Bo2x5ufLChv2i9+X9WO6Y3nFc4KOBY4hD +WeFt0ZUiY30SyTiWqrPHP8Lnto9JTBOZcIIHOqPgy4L+685Ou6xwO0cUzicIza5M +TbMBOPfnVSgPSCFImGSjAaahWEvl360B8qjx8i1vgkUOxjqfFMnjZUF5b9lBDS72 +JK0esvGRUQqyC4uQHbTi8EOJYaOnCn+0lXPzLNpN171DHfEg/X6iiD0zTjMX/7Sk +PPm2z3zH7yJmeDnh5e/gvgWaPuTVaN+LdUYv/ijqfS3bx6yF1VpNr+esTI23S+o2 +1HqlCfhZUnVmn6r0J1L8tuVeZaMni1qOFs4KacGA9UwAZeGVdOmK0rFIqUXKDehq +7BAmDZV3hnQD2TQzgfDfXpegRECX/wZZVrcg896NltY1r6AVm9jcKLVCNalyoCwe +Rp6anjx8qsUxnXXYN2rhl/l2Y9D23QZ2OM0cpvb9QPJGGgGeSaQu6p8N4hRUroje +UlL8vBLle6tcvVoiRCvPCja857vnthqUppv9bzM9SAyMz4RXcYgQvFErExOI0eyT +II67WbrY2j9ul7h4fZjNKCND7o2aENbylK8CU1wlwEBYC8BPgkTqi+dErP+VrWte +QAhjomMkOVKKzG8JaoPJoVYBmMkMTCPsFFuTjtgvg2+a+DOiYbI8yTDT4+Mi/Woi +gZUcE0HUosPkkJ2ZU3zDXdwPIr4DI7TlrnZPF99Es68+NXD6lQgc6U2fjnBfKMFw +MfaTfrg3ykA8mBwqZ6hQdIoqha14uje9Ses2axrEF1FY+pU7JEKDozmo3HzgTfYA +UFoHCu4Zbeu1IiHHJuVSRrwVy0BsY0nrq0Tjq2uYSbXyR9KylHCxztpzku5Gncy2 +Cl0sBUqv1uNWIt1v6yHdupzRM/fIZ3F95nPIomgM+uHmdpHaXyizM4D3doRGzNPH +fOm6jWgKCllI8JHYJ1DUBUokYv8TYJLf0gOSaZLZmpEh88iXfBP52ZBlUIokeUN0 +aZlxSqawVMteeqcjCs7TNySBDzfTCZREHr77tnBz4+jINXi06mh+/Hz+LRA3YNRD +Do5hyzvvFBg49rY0JzZPTC9J4bi+w1MPmmdz0OgQGG1Wiu+4LrSuBUOgiA0V+FyY +/Md51ShFwRg/5zgcWS4hK1Eg4kKTKLF6Wjdu88PCKx2+gu9dYjXgdRuzZ6LUqqS2 +It/j3VptrXm8NwQFGM27HnqGwK5u+Ym3qLJ0FE4vWNbbxGlZtX3NS8SqZSqVfbqq +TwIz4lXU3ipZJ5b42IanZ2nfWqKpdYn99C7yK6AbwA+qZf5zmy436dH+Rvo6PC6W ++9MQcrrNgvq0tiAJvA39dzb77bhRjAKzL5cDiA40hPlcZs5+Q5g9XpYtKsSfzu7s +FCFRnhXmhiBXoUqf5jsYNrm5dvtl27wPTaKvVQQ6SsVtXDZSWEbdAj8Xfeq7kev+ +jtvaOUmFRMaFevzu5t2uuLYzH7zufMB6p13chVUH9yRnWBzdha/Sqf78k57UQnZg +EJwvXcDJ+uFbnd2sibgoASzDNljSfERK5RfD7Re3n5dK6W0PXzic+7ljGoSLedtd +6DD11IzD6WjBlE/9Aiof6IUDdzuo2VZ0XtufBxmYHXUx9LF3/dgGOr8hvxz/wpMx +nPnr9QDgF9svoCvYq1toUbtWgKd1LjXeVoprAhHXwbn4Z8hj7+/LpPYwR1X3u1ik +wL916n0bOkLgWgqGjqsrgskk5Lk6ZzyrESZ0xd6/+dSrf2YxLivF8O4eCLfNxB3d +=3akT +-----END PGP MESSAGE----- + +") + +(define alpha_seckey "-----BEGIN PGP PRIVATE KEY BLOCK----- +Version: GnuPG v1.4.8 (GNU/Linux) + +lQHhBDbjjp4RBAC2ZbFDX0wmJI8yLDYQdIiZeAuHLmfyHsqXaLGUMZtWiAvn/hNp +ctwahmzKm5oXinHUvUkLOQ0s8rOlu15nhw4azc30rTP1LsIkn5zORNnFdgYC6RKy +hOeim/63+/yGtdnTm49lVfaCqwsEmBCEkXaeWDGq+ie1b89J89T6n/JquwCgoQkj +VeVGG+B/SzJ6+yifdHWQVkcD/RXDyLXX4+WHGP2aet51XlKojWGwsZmc9LPPYhwU +/RcUO7ce1QQb0XFlUVFBhY0JQpM/ty/kNi+aGWFzigbQ+HAWZkUvA8+VIAVneN+p ++SHhGIyLTXKpAYTq46AwvllZ5Cpvf02Cp/+W1aVyA0qnBWMyeIxXmR9HOi6lxxn5 +cjajA/9VZufOXWqCXkBvz4Oy3Q5FbjQQ0/+ty8rDn8OTaiPi41FyUnEi6LO+qyBS +09FjnZj++PkcRcXW99SNxmEJRY7MuNHt5wIvEH2jNEOJ9lszzZFBDbuwsjXHK35+ +lPbGEy69xCP26iEafysKKbRXJhE1C+tk8SnK+Gm62sivmK/5av4CAwKcF1Qep+Pf +ssOqtJhr+klruUBf55onBJi4vkk0gK3m32p/05YB2bbMURGz8R4JxUZfUxjdDk73 +LaNYRbQpQWxwaGEgVGVzdCAoZGVtbyBrZXkpIDxhbHBoYUBleGFtcGxlLm5ldD6I +VQQTEQIAFQUCNuOOngMLCgMDFQMCAxYCAQIXgAAKCRAtcnzHaGl3NDl4AJ4rouHB ++LpCkNi5C59jHEa1kbANzACgmddtrNSj1yPyTCwUwRghPUomECS0EEFsaWNlIChk +ZW1vIGtleSmIVQQTEQIAFQUCNuO2qwMLCgMDFQMCAxYCAQIXgAAKCRAtcnzHaGl3 +NCeMAJ9MeUVrago5Jc6PdwdeN5OMwby37QCghW65cZTQlD1bBlIq/QM8bz9AN4G0 +J0FsZmEgVGVzdCAoZGVtbyBrZXkpIDxhbGZhQGV4YW1wbGUubmV0PohVBBMRAgAV +BQI247hYAwsKAwMVAwIDFgIBAheAAAoJEC1yfMdoaXc0t8IAoJPwa6j+Vm5Vi3Nv +uo8JZri4PJ/DAJ9dqbmaJdB8FdJnHfGh1rXK3y/Jcp0BuAQ2448PEAQAnI3XH1f0 +uyN9fZnw72zsHMw706g7EW29nD4UDQG4OzRZViSrUa5n39eI7QrfTO+1meVvs0y8 +F/PvFst5jH68rPLnGSrXz4sTl1T4cop1FBkquvCAKwPLy0lE7jjtCyItOSwIOo8x +oTfY4JEEXmcqsbm+KHv9yYSF/YK4Cf7bIzcAAwcD/Rnl5jKxoucDA96pD2829TKs +LFQSau+Xiy8bvOSSDdlyABsOkNBSaeKO3eAQEKgDM7dzjVNTnAlpQ0EQ8Y9Z8pxO +WYEQYlaMrnRBC4DZ2IadzEhLlIOz5BVp/jfhrr8oVVBwKZXsrz9PZLz+e4Yn+siU +Uvlei9boD9L2ZgSOHakP/gIDApwXVB6n49+yw6e5k2VJBGTFDkQbxpgi4oslePpT +7Tc2qjAke4zO8JHkgKSokEgnMpMz412q9otFX/3qC5MpPG5P8f4r00Kfy9Am/thk +ri01WTIUqF8L/VZXJxLKVoRAabSXudG0eavfah14fN5/+Bw5i8vSHhc/xmQEKTya +2X8Nt1F5zMrE1LAGVVCL9i/DUygnJYOZzAd1Ct0RJ4kFj7lOBICF2IWWiEYEGBEC +AAYFAjbjjw8ACgkQLXJ8x2hpdzQgqQCgn81AaW8W/lyVwMh/UBeMuVMUb24An2uz +wg7Md81a5RI3F2FG8747t9gX +=VM1e +-----END PGP PRIVATE KEY BLOCK----- +") + +;; Bug 1179 solved 2010-05-12: +;; It occured for messages of a multiple of the iobuf block size where +;; the last line had no pad character. Due to premature poppng of thea +;; rmor filter gpg swalled the CRC line and passed the '-----END...' +;; line on to the decryption layer. + +(info "Importing alpha_seckey") +(pipe:do + (pipe:echo alpha_seckey) + (pipe:gpg '(--import))) + +(info "Checking for bug #1179") +(tr:do + (tr:pipe-do + (pipe:echo nopad_armored_msg) + (pipe:gpg '()))) diff --git a/tests/openpgp/armsignencrypt.scm b/tests/openpgp/armsignencrypt.scm new file mode 100755 index 000000000..b84bfe4e0 --- /dev/null +++ b/tests/openpgp/armsignencrypt.scm @@ -0,0 +1,30 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking armored signing and encryption" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg usrpass1 `(--yes --passphrase-fd "0" -sea --recipient ,usrname2)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + (append plain-files data-files)) diff --git a/tests/openpgp/armsigs.scm b/tests/openpgp/armsigs.scm new file mode 100755 index 000000000..d897581cb --- /dev/null +++ b/tests/openpgp/armsigs.scm @@ -0,0 +1,30 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking armored signatures" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg usrpass1 `(--yes --passphrase-fd "0" -sa --recipient ,usrname2)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + (append plain-files data-files)) diff --git a/tests/openpgp/clearsig.scm b/tests/openpgp/clearsig.scm new file mode 100755 index 000000000..96b1b4c31 --- /dev/null +++ b/tests/openpgp/clearsig.scm @@ -0,0 +1,107 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(define (check-signing args input) + (lambda (source sink) + (lettmp (signed) + (call-popen `(,@GPG --output ,signed --yes + ,@args ,source) input) + (call-popen `(,@GPG --output ,sink --yes ,signed) "")))) + +(for-each-p + "Checking signing and verifying plain text messages" + (lambda (source) + ((if (equal? "plain-3" source) + ;; plain-3 does not end in a newline, and gpg will add one. + ;; Therefore, we merely check that the verification is ok. + check-execution + ;; Otherwise, we do check that we recover the original file. + check-identity) + source + (check-signing '(--passphrase-fd "0" --clearsign) usrpass1))) + (append plain-files '("plain-large"))) + +;; The test vectors are lists of length three, containing +;; - a string to be signed, +;; - a flag indicating whether we verify that the exact message is +;; reconstructed (whitespace at the end is normalized for plain text +;; messages), +;; - and a list of arguments to add to gpg when encoding +;; the string. + +(define :string car) +(define :check-equality cadr) +(define :options caddr) + +(define + vectors + '(;; one with long lines + ("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxyx + +xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +" #t ()) + + ;; one with only one long line + ("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxyx +" #t ()) + + ;; and one with an empty body + ("" #f ()) + + ;; and one with one empty line at the end + ("line 1 +line 2 +line 3 +there is a blank line after this + +" #t ()) + + ;; I think this file will be constructed wrong (gpg 0.9.3) but it + ;; should verify okay anyway. + ("this is a sig test + " #f ()) + + ;; check our special diff mode + ("--- mainproc.c Tue Jun 27 09:28:11 2000 ++++ mainproc.c~ Thu Jun 8 22:50:25 2000 +@@ -1190,16 +1190,13 @@ + md_enable( c->mfx.md, n1->pkt->pkt.signature->digest_algo); + } + /* ask for file and hash it */ +- if( c->sigs_only ) { ++ if( c->sigs_only ) + rc = hash_datafiles( c->mfx.md, NULL, + c->signed_data, c->sigfilename, + n1? (n1->pkt->pkt.onepass_sig->sig_class == 0x01):0 ); +" #t (--not-dash-escaped)))) + +(let ((counter (make-counter))) + (for-each-p' + "Checking signing and verifying test vectors" + (lambda (vec) + (lettmp (tmp) + (with-output-to-file tmp (lambda () (display (:string vec)))) + ((if (:check-equality vec) check-identity check-execution) + tmp + (check-signing `(--passphrase-fd "0" --clearsign ,@(:options vec)) + usrpass1)))) + (lambda (vec) (counter)) + vectors)) diff --git a/tests/openpgp/conventional-mdc.scm b/tests/openpgp/conventional-mdc.scm new file mode 100755 index 000000000..c52492175 --- /dev/null +++ b/tests/openpgp/conventional-mdc.scm @@ -0,0 +1,65 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(define s2k '--s2k-count=65536) +(define passphrase "Hier spricht HAL") + +(define (file-copy-n from to n) + (catch '() (unlink to)) + (letfd ((source (open from (logior O_RDONLY O_BINARY))) + (sink (open to (logior O_WRONLY O_CREAT O_BINARY) #o600))) + (splice source sink n))) + +(define test-files + (map (lambda (size) + (let ((tmp (make-temporary-file + (string-append "data-80000-" (number->string size))))) + (file-copy-n "data-80000" tmp size) + tmp)) + '(0 1 2 3 9 10 11 19 20 21 22 23 39 40 41 8192 32000))) + +(for-each-p + "Checking conventional encryption with MDC" + (lambda (algo) + (for-each-p + "" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k + --force-mdc -c + --cipher-algo ,algo)) + (tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k)) + (tr:assert-identity source))) + test-files)) + all-cipher-algos) + +(for-each remove-temporary-file test-files) + +(for-each-p + "Checking sign+symencrypt" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k -cs)) + (tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k)) + (tr:assert-identity source))) + (append plain-files data-files)) diff --git a/tests/openpgp/conventional.scm b/tests/openpgp/conventional.scm new file mode 100755 index 000000000..67e28e246 --- /dev/null +++ b/tests/openpgp/conventional.scm @@ -0,0 +1,48 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(define s2k '--s2k-count=65536) +(define passphrase "Hier spricht HAL") + +(for-each-p + "Checking conventional encryption" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k -c)) + (tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k)) + (tr:assert-identity source))) + '("plain-2" "data-32000")) + +(for-each-p + "Checking conventional encryption using a specific cipher" + (lambda (algo) + (for-each-p + "" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k -c + --cipher-algo ,algo)) + (tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k)) + (tr:assert-identity source))) + '("plain-1" "data-80000"))) + all-cipher-algos) diff --git a/tests/openpgp/decrypt-dsa.scm b/tests/openpgp/decrypt-dsa.scm new file mode 100755 index 000000000..b01a0f771 --- /dev/null +++ b/tests/openpgp/decrypt-dsa.scm @@ -0,0 +1,29 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking decryption of supplied DSA encrypted file" + (lambda (name) + (tr:do + (tr:open (in-srcdir (string-append name "-pgp.asc"))) + (tr:gpg "" '(--yes)) + (tr:assert-identity name))) + (list (car plain-files))) diff --git a/tests/openpgp/decrypt.scm b/tests/openpgp/decrypt.scm new file mode 100755 index 000000000..ec0f8e7ee --- /dev/null +++ b/tests/openpgp/decrypt.scm @@ -0,0 +1,29 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking decryption of supplied files" + (lambda (name) + (tr:do + (tr:open (in-srcdir (string-append name ".asc"))) + (tr:gpg "" '(--yes)) + (tr:assert-identity name))) + plain-files) diff --git a/tests/openpgp/default-key.scm b/tests/openpgp/default-key.scm new file mode 100755 index 000000000..443365883 --- /dev/null +++ b/tests/openpgp/default-key.scm @@ -0,0 +1,76 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +;; Import the sample key +;; +;; pub 1024R/8BC90111 2015-12-02 +;; Key fingerprint = E657 FB60 7BB4 F21C 90BB 6651 BC06 7AF2 8BC9 0111 +;; uid [ultimate] Barrett Brown +;; sub 1024R/3E880CFF 2015-12-02 (encryption) +;; sub 1024R/F5F77B83 2015-12-02 (signing) +;; sub 1024R/45117079 2015-12-02 (encryption) +;; sub 1024R/1EA97479 2015-12-02 (signing) + +(info "Importing public key.") +(call-check + `(,(tool 'gpg) --import + ,(in-srcdir "samplekeys/E657FB607BB4F21C90BB6651BC067AF28BC90111.asc"))) + +;; By default, the most recent, valid signing subkey (1EA97479). +(for-each-p + "Checking that the most recent, valid signing subkey is used by default" + (lambda (keyid) + (tr:do + (tr:pipe-do + (pipe:defer (lambda (sink) (display "" (fdopen sink "w")))) + (pipe:gpg `(--default-key ,keyid -s)) + (pipe:gpg '(--verify --status-fd=1))) + (tr:call-with-content + (lambda (c) + (unless (string-contains? + c "VALIDSIG 5FBA84ACE02DCB17DA3DFF6BBCA43C441EA97479") + (exit 1)))))) + '("8BC90111" "3E880CFF" "F5F77B83" "45117079" "1EA97479")) + +;; But, if we request a particular signing key, we should get it. +(for-each-p + "Checking that the most recent, valid encryption subkey is used by default" + (lambda (keyid) + (tr:do + (tr:pipe-do + (pipe:defer (lambda (sink) (display "" (fdopen sink "w")))) + ;; We need another recipient, because --encrypt-to-default-key is + ;; not considered a recipient and gpg doesn't encrypt without any + ;; recipients. + ;; + ;; Note: it doesn't matter whether we specify the primary key or + ;; a subkey: the newest encryption subkey will be used. + (pipe:gpg `(--default-key ,keyid --encrypt-to-default-key + -r "439F02CA" -e)) + (pipe:gpg '(--list-packets))) + (tr:call-with-content + (lambda (c) + (unless (any (lambda (line) + (and (string-prefix? line ":pubkey enc packet:") + (string-suffix? line "45117079"))) + (string-split c #\newline)) + (exit 1)))))) + '("8BC90111" "3E880CFF" "F5F77B83" "45117079" "1EA97479")) diff --git a/tests/openpgp/defs.scm b/tests/openpgp/defs.scm new file mode 100644 index 000000000..8ceffc815 --- /dev/null +++ b/tests/openpgp/defs.scm @@ -0,0 +1,134 @@ +;; Common definitions for the OpenPGP test scripts. +;; +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +;; +;; Constants. +;; + +(define usrname1 "one@example.com") +(define usrpass1 "def") +(define usrname2 "two@example.com") +(define usrpass2 "") +(define usrname3 "three@example.com") +(define usrpass3 "") + +(define dsa-usrname1 "pgp5") +;; we use the sub key because we do not yet have the logic to to derive +;; the first encryption key from a keyblock (I guess) (Well of course +;; we have this by now and the notation below will lookup the primary +;; first and then search for the encryption subkey.) +(define dsa-usrname2 "0xCB879DE9") + +(define key-file1 "samplekeys/rsa-rsa-sample-1.asc") +(define key-file2 "samplekeys/ed25519-cv25519-sample-1.asc") + +(define plain-files '("plain-1" "plain-2" "plain-3")) +(define data-files '("data-500" "data-9000" "data-32000" "data-80000")) +(define exp-files '()) + +(define (qualify executable) + (string-append executable (getenv "EXEEXT"))) + +(define (getenv' key default) + (let ((value (getenv key))) + (if (string=? "" value) + default + value))) + +(define tools + '((gpg "GPG" "g10/gpg") + (gpg-agent "GPG_AGENT" "agent/gpg-agent") + (gpg-connect-agent "GPG_CONNECT_AGENT" "tools/gpg-connect-agent") + (gpgconf "GPGCONF" "tools/gpgconf") + (gpg-preset-passphrase "GPG_PRESET_PASSPHRASE" + "agent/gpg-preset-passphrase") + (mktdata "MKTDATA" "tools/mk-tdata") + (gpgtar "GPGTAR" "tools/gpgtar") + (gpg-zip "GPGZIP" "tools/gpg-zip"))) + +(define (tool which) + (let ((t (assoc which tools)) + (prefix (getenv "BIN_PREFIX"))) + (getenv' (cadr t) + (qualify (if (string=? prefix "") + (string-append (getenv "objdir") "/" (caddr t)) + (string-append prefix "/" (basename (caddr t)))))))) + + +(define have-opt-always-trust + (string-contains? (call-popen `(,(tool 'gpg) --dump-options) "") + "--always-trust")) + +(define GPG `(,(tool 'gpg) --no-permission-warning + ,@(if have-opt-always-trust '(--always-trust) '()))) +(define PINENTRY (string-append (getcwd) "/" (qualify "fake-pinentry"))) + +(define (tr:gpg input args) + (tr:spawn input `(,@GPG --output **out** ,@args **in**))) + +(define (pipe:gpg args) + (pipe:spawn `(,@GPG --output - ,@args -))) + +(define (gpg-with-colons args) + (let ((s (call-popen `(,@GPG --with-colons ,@args) ""))) + (map (lambda (line) (string-split line #\:)) + (string-split s #\newline)))) + +(define (get-config what) + (string-split (caddar (gpg-with-colons `(--list-config ,what))) #\;)) + +(define all-pubkey-algos (get-config "pubkeyname")) +(define all-hash-algos (get-config "digestname")) +(define all-cipher-algos (get-config "ciphername")) + +(define (have-pubkey-algo? x) + (not (not (member x all-pubkey-algos)))) +(define (have-hash-algo? x) + (not (not (member x all-hash-algos)))) +(define (have-cipher-algo? x) + (not (not (member x all-cipher-algos)))) + +(define (gpg-pipe args0 args1 errfd) + (lambda (source sink) + (let* ((p (pipe)) + (task0 (spawn-process-fd `(,@GPG ,@args0) + source (:write-end p) errfd)) + (_ (close (:write-end p))) + (task1 (spawn-process-fd `(,@GPG ,@args1) + (:read-end p) sink errfd))) + (close (:read-end p)) + (wait-processes (list GPG GPG) (list task0 task1) #t)))) + +(setenv "GPG_AGENT_INFO" "" #t) +(setenv "GNUPGHOME" (getcwd) #t) + +;; +;; GnuPG helper. +;; + +;; Call GPG to obtain the hash sums. Either specify an input file in +;; ARGS, or an string in INPUT. Returns a list of ( +;; "") lists. +(define (gpg-hash-string args input) + (map + (lambda (line) + (let ((p (string-split line #\:))) + (list (string->number (cadr p)) (caddr p)))) + (string-split + (call-popen `(,@GPG --with-colons ,@args) input) #\newline))) diff --git a/tests/openpgp/detach.scm b/tests/openpgp/detach.scm new file mode 100755 index 000000000..375e92272 --- /dev/null +++ b/tests/openpgp/detach.scm @@ -0,0 +1,31 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking detached signatures" + (lambda (source) + (lettmp (tmp) + (call-popen `(,@GPG --yes --passphrase-fd "0" -sb + --output ,tmp ,source ) usrpass1) + (pipe:do + (pipe:open source (logior O_RDONLY O_BINARY)) + (pipe:spawn `(,@GPG --yes ,tmp))))) + (append plain-files data-files)) diff --git a/tests/openpgp/detachm.scm b/tests/openpgp/detachm.scm new file mode 100755 index 000000000..a4ebce03e --- /dev/null +++ b/tests/openpgp/detachm.scm @@ -0,0 +1,35 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(define files (append plain-files data-files)) + +(info "Checking detached signatures of multiple files") +(lettmp (tmp) + (call-popen `(,@GPG --yes --passphrase-fd "0" -sb + --output ,tmp ,@files) usrpass1) + (pipe:do + (pipe:defer (lambda (sink) + (for-each (lambda (file) + (pipe:do + (pipe:open file (logior O_RDONLY O_BINARY)) + (pipe:splice sink))) + files))) + (pipe:spawn `(,@GPG --yes ,tmp)))) diff --git a/tests/openpgp/ecc.scm b/tests/openpgp/ecc.scm new file mode 100755 index 000000000..f2f3b7c3a --- /dev/null +++ b/tests/openpgp/ecc.scm @@ -0,0 +1,249 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(define keygrips '("8E06A180EFFE4C65B812150CAF19BF30C0689A4C" + "E4403F3FD7A443FAC29FEF288FA0D20AC212851E" + "0B7554421FFB14A06CB9F63FB49A85A58E97ABAC" + "303ACC892C2D786C8A789677C0BE54DA8538F903" + "9FE5C36985351524B6AFA19FDCBC1A3A750B6F5F" + "145A52CC7ED3FD41C5B0A26BE220FEED36AF24DE")) +(define mainkeyids '("BAA59D9C" "0F54719F" "45AF2FFE")) + +(unless (have-pubkey-algo? "ECDH") + (skip "No ECC support due to an old Libgcrypt")) + +(info "Preparing for ECC test") +(for-each + (lambda (grip) + (catch '() (unlink (string-append "private-keys-v1.d/" grip ".key"))) + (call-check `(,(tool 'gpg-preset-passphrase) + --preset --passphrase ecc ,grip))) + keygrips) + +(info "Importing ECC public keys") +(for-each + (lambda (keyid) + (call `(,(tool 'gpg) --delete-key --batch --yes ,keyid))) + mainkeyids) + +(for-each + (lambda (n) + (call-check `(,(tool 'gpg) --import + ,(in-srcdir (string-append + "samplekeys/ecc-sample-" + (number->string n) + "-pub.asc"))))) + '(1 2 3)) + +;; The following is an opaque ECDSA signature on a message "This is one +;; line\n" (17 byte long) by the primary 256 bit key: +(define msg_opaque_signed_256 "-----BEGIN PGP MESSAGE----- +Version: GnuPG v2.1.0-ecc (GNU/Linux) + +owGbwMvMwCHMvVT3w66lc+cwrlFK4k5N1k3KT6nUK6ko8Zl8MSEkI7NYAYjy81IV +cjLzUrk64lgYhDkY2FiZQNIMXJwCMO31rxgZ+tW/zesUPxWzdKWrtLGW/LkP5rXL +V/Yvnr/EKjBbQuvZSYa/klsum6XFmTze+maVgclT6Rc6hzqqxNy6o6qdTTmLJuvp +AQA= +=GDv4 +-----END PGP MESSAGE----") + +;; The following is an opaque ECDSA signature on a message "This is one +;; line\n" (17 byte long) by the primary 384 bit key: +(define msg_opaque_signed_384 "-----BEGIN PGP MESSAGE----- +Version: PGP Command Line v10.0.0 (Linux) + +qANQR1DIqwE7wsvMwCnM2WDcwR9SOJ/xtFISd25qcXFieqpeSUUJAxCEZGQWKwBR +fl6qQk5mXirXoXJmVgbfYC5xmC5hzsDPjHXqbDLzpXpTBXSZV3L6bAgP3Kq7Ykmo +7Ds1v4UfBS+3CSSon7Pzq79WLjzXXEH54MkjPxnrw+8cfMVnY7Bi18J702Nnsa7a +9lMv/PM0/ao9CZ3KX7Q+Tv1rllTZ5Hj4V1frw431QnHfAA== +=elKT +-----END PGP MESSAGE-----") + +;; The following is an opaque ECDSA signature on a message "This is one +;; line\n" (17 byte long) by the primary 521 bit key: +(define msg_opaque_signed_521 "-----BEGIN PGP MESSAGE----- +Version: PGP Command Line v10.0.0 (Linux) + +qANQR1DIwA8BO8LLzMAlnO3Y8tB1vf4/xtNKSdy5qcXFiempeiUVJQxAEJKRWawA +RPl5qQo5mXmpXIdmMLMy+AaLnoLpEubatpeJY2Lystd7Qt32q2UcvRS5kNPWtDB7 +ryufvcrWtFM7Jx8qXKDxZuqr7b9PGv1Ssk+I8TzB2O9dZC+n/jv+PAdbuu7mLe33 +Gf9pLd3weV3Qno6FOqxGa5ZszQx+uer2xH3/El9x/2pVeO4l15ScsL7qWMTmffmG +Ic1RdzgeCfosMF+l/zVRchcLKzenEQA= +=ATtX +-----END PGP MESSAGE-----") + +(lettmp (z) + (letfd ((fd (open z (logior O_WRONLY O_CREAT O_BINARY) #o600))) + (display "This is one line\n" (fdopen fd "wb"))) + + (for-each-p + "Checking opaque ECDSA signatures" + (lambda (test) + (lettmp (x y) + (call-with-output-file + x (lambda (p) (display (eval test (current-environment)) p))) + (call-check `(,(tool 'gpg) --verify ,x)) + (call-check `(,(tool 'gpg) --output ,y ,x)) + (unless (file=? y z) (error "mismatch")))) + '(msg_opaque_signed_256 msg_opaque_signed_384 msg_opaque_signed_521))) + +;; +;; Import the secret keys so that we now can sign and decrypt. +;; +;; Note that the PGP generated secret keys are not self-signed, thus we +;; need to pass an appropriate option. +;; +(info "Importing ECC secret keys") +(setenv "PINENTRY_USER_DATA" "ecc" #t) +(for-each + (lambda (n) + (call-check `(,(tool 'gpg) --import + ,@(if (> n 1) '(--allow-non-selfsigned-uid) '()) + ,(in-srcdir (string-append + "samplekeys/ecc-sample-" + (number->string n) + "-sec.asc"))))) + '(1 2 3)) + +;; +;; Check a few sample encrtpted messages. +;; +(info "Checking ECC encryption") + +;; The following block encrypts the text "This is one line\n", 17 bytes, +;; with the subkey 4089AB73. +(define msg_encrypted_256 "-----BEGIN PGP MESSAGE----- +Version: GnuPG v2.1.0-ecc (GNU/Linux) + +hH4Dd863o0CJq3MSAgMEHdIYZQx+rV1cjy7qitIOEICFFzp4cjsRX4r+rDdMcQUs +h7VZmbP1c9C0s9sgCKwubWfkcYUl2ZOju4gy+s4MYTBb4/j8JjnJ9Bqn6LWutTXJ +zwsdP13VIJLnhiNqISdR3/6xWQ0ICRYzwb95nUZ1c1DSVgFpjPgUvi4pgYbTpcDB +jzILKWBfBDT/jck169XE8vgtbcqVQYZ7lZpaY9CzEbC+4dXZmV1gm5MafpTyFWgH +VnyrZB4gad9Lp9e0RKHHcOOE7s/NeLuu +=odUZ +-----END PGP MESSAGE-----") + +;; The following block encrypts the text "This is one line\n", 17 bytes, +;; with the subkey 9A201946: +(define msg_encrypted_384 "-----BEGIN PGP MESSAGE----- +Version: PGP Command Line v10.0.0 (Linux) + +qANQR1DBngOqi5OPmiAZRhIDAwQqIr/00cJyf+QP+VA4QKVkk77KMHdz9OVaR2XK +0VYu0F/HPm89vL2orfm2hrAZxY9G2R0PG4Wk5Lg04UjKca/O72uWtjdPYulFidmo +uB0QpzXFz22ZZinxeVPLPEr19Pow0EwCc95cg4HAgrD0nV9vRcTJ/+juVfvsJhAO +isMKqrFNMvwnK5A1ECeyVXe7oLZl0lUBRhLr59QTtvf85QJjg/m5kaGy8XCJvLv3 +61pZa6KUmw89PjtPak7ebcjnINL01vwmyeg1PAyW/xjeGGvcO+R4P1b4ewyFnJyR +svzIJcP7d4DqYOw7 +=oiTJ +-----END PGP MESSAGE-----") + +;; The following block encrypts the text "This is one line\n", 17 bytes, +;; with the subkey A81C4838: +(define msg_encrypted_521 "-----BEGIN PGP MESSAGE----- +Version: PGP Command Line v10.0.0 (Linux) + +qANQR1DBwAIDB+qqSKgcSDgSBCMEAKpzTUxB4c56C7g09ekD9I+ttC5ER/xzDmXU +OJmFqU5w3FllhFj4TgGxxdH+8fv4W2Ag0IKoJvIY9V1V7oUCClfqAR01QbN7jGH/ +I9GFFnH19AYEgMKgFmh14ZwN1BS6/VHh+H4apaYqapbx8/09EL+DV9zWLX4GRLXQ +VqCR1N2rXE29MJFzGmDOCueQNkUjcbuenoCSKcNT+6xhO27U9IYVCg4BhRUDGfD6 +dhfRzBLxL+bKR9JVAe46+K8NLjRVu/bd4Iounx4UF5dBk8ERy+/8k9XantDoQgo6 +RPqCad4Dg/QqkpbK3y574ds3VFNJmc4dVpsXm7lGV5w0FBxhVNPoWNhhECMlTroX +Rg== +=5GqW +-----END PGP MESSAGE-----") + +(lettmp (z) + (letfd ((fd (open z (logior O_WRONLY O_CREAT O_BINARY) #o600))) + (display "This is one line\n" (fdopen fd "wb"))) + + (for-each-p + "Checking ECDSA decryption" + (lambda (test) + (lettmp (x y) + (call-with-output-file + x (lambda (p) (display (eval test (current-environment)) p))) + (call-check `(,@GPG --yes --output ,y ,x)) + (unless (file=? y z) (error "mismatch")))) + '(msg_encrypted_256 msg_encrypted_384 msg_encrypted_521))) + +;; +;; Now check that we can encrypt and decrypt our own messages. +;; +;; Note that we don't need to provide a passppharse because we already +;; preset the passphrase into the gpg-agent. +;; +(for-each-p + "Checking ECC encryption and decryption" + (lambda (source) + (for-each-p + "" + (lambda (keyid) + (tr:do + (tr:open source) + (tr:gpg "" `(--yes --encrypt --recipient ,keyid)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + mainkeyids)) + (append plain-files data-files)) + +;; +;; Now check that we can sign and verify our own messages. +;; +(for-each-p + "Checking ECC signing and verifiction" + (lambda (source) + (for-each-p + "" + (lambda (keyid) + (tr:do + (tr:open source) + (tr:gpg "" `(--yes --sign --local-user ,keyid)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + mainkeyids)) + (append plain-files data-files)) + +;; +;; Let us also try to import the keys only from a secret keyblock. +;; +;; Because PGP does not sign the UID, it is not very useful to work +;; with this key unless we go into the trouble of adding the +;; self-signature. +;; +(info "Importing ECC secret keys directly") +(for-each + (lambda (keyid) + (catch '() (unlink (string-append "private-keys-v1.d/" keyid ".key")))) + keygrips) +(for-each + (lambda (keyid) + (call `(,(tool 'gpg) --delete-key --batch --yes ,keyid))) + mainkeyids) + +(for-each + (lambda (n) + (call-check `(,(tool 'gpg) --import + ,@(if (> n 1) '(--allow-non-selfsigned-uid) '()) + ,(in-srcdir (string-append + "samplekeys/ecc-sample-" + (number->string n) + "-sec.asc"))))) + '(1 2 3)) diff --git a/tests/openpgp/encrypt-dsa.scm b/tests/openpgp/encrypt-dsa.scm new file mode 100755 index 000000000..5228e43a7 --- /dev/null +++ b/tests/openpgp/encrypt-dsa.scm @@ -0,0 +1,45 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking encryption using DSA" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg "" `(--yes --encrypt --recipient ,dsa-usrname2)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + (append plain-files data-files)) + +(for-each-p + "Checking encryption using DSA and a specific cipher algorithm" + (lambda (cipher) + (for-each-p + "" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg "" `(--yes --encrypt --recipient ,dsa-usrname2 + --cipher-algo ,cipher)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + (append plain-files data-files))) + all-cipher-algos) diff --git a/tests/openpgp/encrypt.scm b/tests/openpgp/encrypt.scm new file mode 100755 index 000000000..7452fc5b5 --- /dev/null +++ b/tests/openpgp/encrypt.scm @@ -0,0 +1,60 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking encryption" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg "" `(--yes --encrypt --recipient ,usrname2)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + (append plain-files data-files)) + +(for-each-p + "Checking encryption using a specific cipher algorithm" + (lambda (cipher) + (for-each-p + "" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg "" `(--yes --encrypt --recipient ,usrname2 + --cipher-algo ,cipher)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + (append plain-files data-files))) + all-cipher-algos) + + +;; We encrypt to two keys and we have also put the first key into our +;; pubring, so that decryption will work. +(for-each-p + "Checking encryption using a key from file" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg "" `(--yes -v --no-keyring --encrypt + --recipient-file ,(in-srcdir key-file1) + --hidden-recipient-file ,(in-srcdir key-file2))) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + plain-files) diff --git a/tests/openpgp/encryptp.scm b/tests/openpgp/encryptp.scm new file mode 100755 index 000000000..2b010acd1 --- /dev/null +++ b/tests/openpgp/encryptp.scm @@ -0,0 +1,31 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking encryption and decryption using pipes" + (lambda (source) + (tr:do + (tr:open source) + (tr:pipe-do + (pipe:gpg `(--yes --encrypt --recipient ,usrname2)) + (pipe:gpg '(--yes))) + (tr:assert-identity source))) + (append plain-files data-files)) diff --git a/tests/openpgp/export.scm b/tests/openpgp/export.scm new file mode 100755 index 000000000..829170541 --- /dev/null +++ b/tests/openpgp/export.scm @@ -0,0 +1,99 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(define (check-for predicate lines message) + (unless (any predicate lines) + (error message))) + +(define (check-exported-key dump keyid) + (check-for (lambda (l) + (and (string-prefix? l " keyid: ") + (string-suffix? l keyid))) dump + "Keyid not found") + (check-for (lambda (l) (string-prefix? l ":user ID packet:")) dump + "User ID packet not found") + (check-for (lambda (l) + (and (string-prefix? l ":signature packet:") + (string-contains? l "keyid") + (string-suffix? l keyid))) dump + "Signature packet not found")) + +(define (check-exported-public-key packet-dump keyid) + (let ((dump (string-split packet-dump #\newline))) + (check-for (lambda (l) (string-prefix? l ":public key packet:")) dump + "Public key packet not found") + (check-exported-key dump keyid))) + +(define (check-exported-private-key packet-dump keyid) + (let ((dump (string-split packet-dump #\newline))) + (check-for (lambda (l) (string-prefix? l ":secret key packet:")) dump + "Secret key packet not found") + (check-exported-key dump keyid))) + +(lettmp + ;; Prepare two temporary files for communication with the fake + ;; pinentry program. + (logfile ppfile) + + (define (prepare-passphrases . passphrases) + (call-with-output-file ppfile + (lambda (port) + (for-each (lambda (passphrase) + (display passphrase port) + (display #\newline port)) passphrases)))) + + (define CONFIRM "fake-entry being started to CONFIRM the weak phrase") + + (define (assert-passphrases-consumed) + (call-with-input-file ppfile + (lambda (port) + (unless + (eof-object? (peek-char port)) + (error (string-append + "Expected all passphrases to be consumed, but found: " + (read-all port))))))) + + (setenv "PINENTRY_USER_DATA" + (string-append "--logfile=" logfile " --passphrasefile=" ppfile) #t) + + (for-each-p + "Checking key export" + (lambda (keyid) + (tr:do + (tr:pipe-do + (pipe:gpg `(--export ,keyid)) + (pipe:gpg '(--list-packets))) + (tr:call-with-content check-exported-public-key keyid)) + + (if (string=? "D74C5F22" keyid) + ;; Key D74C5F22 is protected by a passphrase. Prepare this + ;; one. Currently, GnuPG does not ask for an export passphrase + ;; in this case. + (prepare-passphrases usrpass1)) + + (tr:do + (tr:pipe-do + (pipe:gpg `(--export-secret-keys ,keyid)) + (pipe:gpg '(--list-packets))) + (tr:call-with-content check-exported-private-key keyid)) + + (assert-passphrases-consumed)) + '("D74C5F22" "C40FDECF" "ECABF51D"))) diff --git a/tests/openpgp/finish.scm b/tests/openpgp/finish.scm new file mode 100755 index 000000000..48801c861 --- /dev/null +++ b/tests/openpgp/finish.scm @@ -0,0 +1,23 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(echo "Killing gpg-agent...") +(call-check `(,(tool 'gpg-connect-agent) --verbose killagent /bye)) diff --git a/tests/openpgp/genkey1024.scm b/tests/openpgp/genkey1024.scm new file mode 100755 index 000000000..9870f4624 --- /dev/null +++ b/tests/openpgp/genkey1024.scm @@ -0,0 +1,52 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(define (genkey config) + (pipe:do + (pipe:echo config) + (pipe:spawn `(,(tool 'gpg) --quiet --batch --gen-key)))) + +(info "Checking batch key generation") +(genkey "Key-Type: DSA +Key-Length: 1024 +Subkey-Type: ELG +Subkey-Length: 1024 +Name-Real: Harry H. +Name-Comment: test key +Name-Email: hh@@ddorf.de +Expire-Date: 1 +%no-protection +%transient-key +%commit +") + +(if (have-pubkey-algo? "RSA") + (genkey "Key-Type: RSA +Key-Length: 1024 +Key-Usage: sign,encrypt +Name-Real: Harry A. +Name-Comment: RSA test key +Name-Email: hh@@ddorf.de +Expire-Date: 2 +%no-protection +%transient-key +%commit +")) diff --git a/tests/openpgp/gpg-agent.conf.tmpl b/tests/openpgp/gpg-agent.conf.tmpl index b3cb54f09..70e163317 100644 --- a/tests/openpgp/gpg-agent.conf.tmpl +++ b/tests/openpgp/gpg-agent.conf.tmpl @@ -1,4 +1,2 @@ allow-preset-passphrase no-grab - - diff --git a/tests/openpgp/gpgtar.scm b/tests/openpgp/gpgtar.scm new file mode 100755 index 000000000..07f2fd7f7 --- /dev/null +++ b/tests/openpgp/gpgtar.scm @@ -0,0 +1,92 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(unless (= 0 (call `(,(tool 'gpgtar) --help))) + (skip "gpgtar not installed")) + +(define testfiles (append plain-files data-files)) +(define gpgargs + (if have-opt-always-trust + "--no-permission-warning --always-trust" + "--no-permission-warning")) + +(define (do-test create-flags inspect-flags extract-flags) + (lettmp (archive) + (call-check `(,(tool 'gpgtar) --gpg ,(tool 'gpg) --gpg-args ,gpgargs + ,@create-flags + --output ,archive + ,@testfiles)) + (tr:do + (tr:pipe-do + (pipe:spawn `(,(tool 'gpgtar) --gpg ,(tool 'gpg) --gpg-args ,gpgargs + --list-archive ,@inspect-flags + ,archive))) + (tr:call-with-content + (lambda (c) + (unless (all (lambda (f) (string-contains? c f)) testfiles) + (error "some file(s) are missing from archive"))))) + + (with-temporary-working-directory + (call-check `(,(tool 'gpgtar) --gpg ,(tool 'gpg) --gpg-args ,gpgargs + --tar-args --directory=. + ,@extract-flags + ,archive)) + + (for-each + (lambda (f) (unless (call-with-input-file f (lambda (x) #t)) + (error (string-append "missing file: " f)))) + testfiles)))) + +(info "Checking gpgtar without encryption") +(do-test '(--skip-crypto --encrypt) '(--skip-crypto) + '(--skip-crypto --decrypt)) + +(info "Checking gpgtar without encryption with nicer actions") +(do-test '(--create) '(--skip-crypto) '(--extract)) + +(info "Checking gpgtar with asymmetric encryption") +(do-test `(--encrypt --recipient ,usrname2) '() '(--decrypt)) + +(info "Checking gpgtar with asymmetric encryption and signature") +(do-test `(--encrypt --recipient ,usrname2 --sign --local-user ,usrname3) + '() '(--decrypt)) + +(info "Checking gpgtar with signature") +(do-test `(--sign --local-user ,usrname3) '() '(--decrypt)) + +(lettmp (passphrasefile) + (letfd ((fd (open passphrasefile (logior O_WRONLY O_CREAT O_BINARY) #o600))) + (display "streng geheimes hupsipupsi" (fdopen fd "wb"))) + + (let ((ppflags `(--gpg-args ,(string-append "--passphrase-file=" + passphrasefile)))) + (info "Checking gpgtar with symmetric encryption") + (do-test `(,@ppflags --symmetric) ppflags (cons '--decrypt ppflags)) + + (info "Checking gpgtar with symmetric encryption and chosen cipher") + (do-test `(,@ppflags --symmetric --gpg-args + ,(string-append "--cipher=" (car all-cipher-algos))) + ppflags (cons '--decrypt ppflags)) + + (info "Checking gpgtar with both symmetric and asymmetric encryption") + (do-test `(,@ppflags --symmetric --encrypt --recipient ,usrname2 + --sign --local-user ,usrname3) + ppflags (cons '--decrypt ppflags)))) diff --git a/tests/openpgp/import.scm b/tests/openpgp/import.scm new file mode 100755 index 000000000..580acea0d --- /dev/null +++ b/tests/openpgp/import.scm @@ -0,0 +1,60 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(info "Checking bug 894: segv importing certain keys.") +(call-check `(,(tool 'gpg) --import ,(in-srcdir "bug894-test.asc"))) + +(define keyid "0xC108E83A") +(info "Checking bug 1223: designated revoker sigs are not properly merged.") +(call `(,(tool 'gpg) --delete-key --batch --yes ,keyid)) +(call `(,(tool 'gpg) --import ,(in-srcdir "bug1223-bogus.asc"))) +(call `(,(tool 'gpg) --import ,(in-srcdir "bug1223-good.asc"))) +(tr:do + (tr:pipe-do + (pipe:gpg `(--list-keys --with-colons ,keyid))) + (tr:call-with-content + (lambda (c) + ;; XXX we do not have a regexp library + (unless (any (lambda (line) + (and (string-prefix? line "rvk:") + (string-contains? line ":0EE5BE979282D80B9F7540F1CCD2ED94D21739E9:"))) + (string-split c #\newline)) + (exit 1))))) + +(define fpr1 "9E669861368BCA0BE42DAF7DDDA252EBB8EBE1AF") +(define fpr2 "A55120427374F3F7AA5F1166DDA252EBB8EBE1AF") +(info "Checking import of two keys with colliding long key ids.") +(call `(,(tool 'gpg) --delete-key --batch --yes ,fpr1 ,fpr2)) +(call `(,(tool 'gpg) --import ,(in-srcdir "samplekeys/dda252ebb8ebe1af-1.asc"))) +(call `(,(tool 'gpg) --import ,(in-srcdir "samplekeys/dda252ebb8ebe1af-2.asc"))) +(tr:do + (tr:pipe-do + (pipe:gpg `(--list-keys --with-colons ,fpr1 ,fpr2))) + (tr:call-with-content + (lambda (c) + ;; XXX we do not have a regexp library + (let ((keys (filter + (lambda (line) + (and (string-prefix? line "pub:") + (string-contains? line ":4096:1:DDA252EBB8EBE1AF:"))) + (string-split c #\newline)))) + (unless (= 2 (length keys)) + (error "Importing keys with long id collision failed")))))) diff --git a/tests/openpgp/mds.scm b/tests/openpgp/mds.scm new file mode 100755 index 000000000..8ca6c7b31 --- /dev/null +++ b/tests/openpgp/mds.scm @@ -0,0 +1,68 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(define empty-string-hashes + `((1 "D41D8CD98F00B204E9800998ECF8427E" "MD5") + (2 "DA39A3EE5E6B4B0D3255BFEF95601890AFD80709" "SHA1") + (3 "9C1185A5C5E9FC54612808977EE8F548B2258D31" "RIPEMD160") + (11 "D14A028C2A3A2BC9476102BB288234C415A2B01F828EA62AC5B3E42F" "SHA224") + (8 "E3B0C44298FC1C149AFBF4C8996FB92427AE41E4649B934CA495991B7852B855" "SHA256") + (9 "38B060A751AC96384CD9327EB1B1E36A21FDB71114BE07434C0CC7BF63F6E1DA274EDEBFE76F65FBD51AD2F14898B95B" "SHA384") + (10 + "CF83E1357EEFB8BDF1542850D66D8007D620E4050B5715DC83F4A921D36CE9CE47D0D13C5D85F2B0FF8318D2877EEC2F63B931BD47417A81A538327AF927DA3E" + "SHA512"))) + +(define abc-hashes + `((1 "C3FCD3D76192E4007DFB496CCA67E13B" "MD5") + (2 "32D10C7B8CF96570CA04CE37F2A19D84240D3A89" "SHA1") + (3 "F71C27109C692C1B56BBDCEB5B9D2865B3708DBC" "RIPEMD160") + (11 "45A5F72C39C5CFF2522EB3429799E49E5F44B356EF926BCF390DCCC2" "SHA224") + (8 "71C480DF93D6AE2F1EFAD1447C66C9525E316218CF51FC8D9ED832F2DAF18B73" "SHA256") + (9 "FEB67349DF3DB6F5924815D6C3DC133F091809213731FE5C7B5F4999E463479FF2877F5F2936FA63BB43784B12F3EBB4" "SHA384") + (10 "4DBFF86CC2CA1BAE1E16468A05CB9881C97F1753BCE3619034898FAA1AABE429955A1BF8EC483D7421FE3C1646613A59ED5441FB0F321389F77F48A879C7B1F1" "SHA512"))) + +;; Symbolic names for the triples above. +(define :algo car) +(define :value cadr) +(define :name caddr) + +;; Test whether HASH matches REF. +(define (test-hash hash ref) + (unless (eq? #f ref) + (if (not (string=? (:value hash) (:value ref))) + (error "failed")))) + +;; Test whether the hashes computed over S match the REFERENCE set. +(define (test-hashes msg s reference) + (for-each-p' + msg + (lambda (hash) (test-hash hash (assv (:algo hash) reference))) + (lambda (hash) + (let ((ref (assv (:algo hash) reference))) + (if (eq? #f ref) + (string-append "no-ref-for:" (number->string (:algo hash))) + (:name ref)))) + (gpg-hash-string '(--print-mds) s))) + +(test-hashes "Hashing the empty string" + "" empty-string-hashes) +(test-hashes "Hashing the string \"abcdefghijklmnopqrstuvwxyz\"" + "abcdefghijklmnopqrstuvwxyz" abc-hashes) diff --git a/tests/openpgp/multisig.scm b/tests/openpgp/multisig.scm new file mode 100755 index 000000000..53c905fe1 --- /dev/null +++ b/tests/openpgp/multisig.scm @@ -0,0 +1,168 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +;; Check that gpg verifies only signatures where there is no ambiguity +;; in the order of packets. Needs the Demo Keys Lima and Mike. +;; +;; Note: We do not support multiple signatures anymore thus this test is +;; not really needed because verify could do the same. We keep it anyway. + +(load (with-path "defs.scm")) + +(define sig-1ls1ls-valid " +-----BEGIN PGP ARMORED FILE----- + +kA0DAAIRN8q1H7eRA/gBrCdiBXRleHQxOogq9EkgYW0gc29ycnksIEkgY2FuJ3Qg +ZG8gdGhhdAqIPwMFADqIKvQ3yrUft5ED+BEC2joAoJaSaXOZEtSZqQ780HIXG77e +8PB7AJ4wCprmaFTO0fBaTcXDuEOBdAWnOZANAwACETfKtR+3kQP4AawnYgV0ZXh0 +MTqIKvRJIGFtIHNvcnJ5LCBJIGNhbid0IGRvIHRoYXQKiD8DBQA6iCr0N8q1H7eR +A/gRAto6AKCWkmlzmRLUmakO/NByFxu+3vDwewCeMAqa5mhUztHwWk3Fw7hDgXQF +pzk= +=8jSC +-----END PGP ARMORED FILE----- +") +(define sig-ls-valid " +-----BEGIN PGP ARMORED FILE----- + +rCdiBXRleHQxOogrS0kgYW0gc29ycnksIEkgY2FuJ3QgZG8gdGhhdAqIPwMFADqI +K0s3yrUft5ED+BECLQMAn2jZUNOpB4OuurSQkc2TRfg6ek02AJ9+oJS0frQ+yUsT +QDUFTH2PvZRxjw== +=J+lb +-----END PGP ARMORED FILE----- +") +(define sig-sl-valid " +-----BEGIN PGP ARMORED FILE----- + +iD8DBQA6iCtLN8q1H7eRA/gRAi0DAJ9o2VDTqQeDrrq0kJHNk0X4OnpNNgCffqCU +tH60PslLE0A1BUx9j72UcY+sJ2IFdGV4dDE6iCtLSSBhbSBzb3JyeSwgSSBjYW4n +dCBkbyB0aGF0Cg== +=N9MP +-----END PGP ARMORED FILE----- +") +(define sig-11lss-valid-but-is-not " +-----BEGIN PGP ARMORED FILE----- + +kA0DAAIRN8q1H7eRA/gAkA0DAAIRN8q1H7eRA/gBrCdiBXRleHQxOogyXUkgYW0g +c29ycnksIEkgY2FuJ3QgZG8gdGhhdAqIPwMFADqIMl03yrUft5ED+BECwQAAnRXT +mXjVd385oD38W80XuheWKTGcAJ9pZ6/flaKDfw+SLido7xaUHuhp5Yg/AwUAOogy +XTfKtR+3kQP4EQLBAACgnN0IP+NztE0aAc/DZ17yHWR9diwAniN0P01WmbgZJoZB +Q341WRXKS/at +=Ekrs +-----END PGP ARMORED FILE----- +") +(define sig-11lss11lss-valid-but-is-not " +-----BEGIN PGP ARMORED FILE----- + +kA0DAAIRN8q1H7eRA/gAkA0DAAIRN8q1H7eRA/gBrCdiBXRleHQxOogyXUkgYW0g +c29ycnksIEkgY2FuJ3QgZG8gdGhhdAqIPwMFADqIMl03yrUft5ED+BECwQAAnRXT +mXjVd385oD38W80XuheWKTGcAJ9pZ6/flaKDfw+SLido7xaUHuhp5Yg/AwUAOogy +XTfKtR+3kQP4EQLBAACgnN0IP+NztE0aAc/DZ17yHWR9diwAniN0P01WmbgZJoZB +Q341WRXKS/atkA0DAAIRN8q1H7eRA/gAkA0DAAIRN8q1H7eRA/gBrCdiBXRleHQx +OogyXUkgYW0gc29ycnksIEkgY2FuJ3QgZG8gdGhhdAqIPwMFADqIMl03yrUft5ED ++BECwQAAnRXTmXjVd385oD38W80XuheWKTGcAJ9pZ6/flaKDfw+SLido7xaUHuhp +5Yg/AwUAOogyXTfKtR+3kQP4EQLBAACgnN0IP+NztE0aAc/DZ17yHWR9diwAniN0 +P01WmbgZJoZBQ341WRXKS/at +=P1Mu +-----END PGP ARMORED FILE----- +") +(define sig-ssl-valid-but-is-not " +-----BEGIN PGP ARMORED FILE----- + +iD8DBQA6iCtLN8q1H7eRA/gRAi0DAJ9o2VDTqQeDrrq0kJHNk0X4OnpNNgCffqCU +tH60PslLE0A1BUx9j72UcY+IPwMFADqIK0s3yrUft5ED+BECLQMAn2jZUNOpB4Ou +urSQkc2TRfg6ek02AJ9+oJS0frQ+yUsTQDUFTH2PvZRxj6wnYgV0ZXh0MTqIK0tJ +IGFtIHNvcnJ5LCBJIGNhbid0IGRvIHRoYXQK +=Zven +-----END PGP ARMORED FILE----- +") +(define sig-1lsls-invalid " +-----BEGIN PGP ARMORED FILE----- + +kA0DAAIRN8q1H7eRA/gBrCdiBXRleHQxOogq9EkgYW0gc29ycnksIEkgY2FuJ3Qg +ZG8gdGhhdAqIPwMFADqIKvQ3yrUft5ED+BEC2joAoJaSaXOZEtSZqQ780HIXG77e +8PB7AJ4wCprmaFTO0fBaTcXDuEOBdAWnOawnYgV0ZXh0MTqIK0tJIGFtIHNvcnJ5 +LCBJIGNhbid0IGRvIHRoYXQKiD8DBQA6iCtLN8q1H7eRA/gRAi0DAJ9o2VDTqQeD +rrq0kJHNk0X4OnpNNgCffqCUtH60PslLE0A1BUx9j72UcY8= +=nkeu +-----END PGP ARMORED FILE----- +") +(define sig-lsls-invalid " +-----BEGIN PGP ARMORED FILE----- + +rCdiBXRleHQxOogrS0kgYW0gc29ycnksIEkgY2FuJ3QgZG8gdGhhdAqIPwMFADqI +K0s3yrUft5ED+BECLQMAn2jZUNOpB4OuurSQkc2TRfg6ek02AJ9+oJS0frQ+yUsT +QDUFTH2PvZRxj6wnYgV0ZXh0MTqIK0tJIGFtIHNvcnJ5LCBJIGNhbid0IGRvIHRo +YXQKiD8DBQA6iCtLN8q1H7eRA/gRAi0DAJ9o2VDTqQeDrrq0kJHNk0X4OnpNNgCf +fqCUtH60PslLE0A1BUx9j72UcY8= +=BlZH +-----END PGP ARMORED FILE----- +") +(define sig-lss-invalid " +-----BEGIN PGP ARMORED FILE----- + +rCdiBXRleHQxOogrS0kgYW0gc29ycnksIEkgY2FuJ3QgZG8gdGhhdAqIPwMFADqI +K0s3yrUft5ED+BECLQMAn2jZUNOpB4OuurSQkc2TRfg6ek02AJ9+oJS0frQ+yUsT +QDUFTH2PvZRxj4g/AwUAOogrSzfKtR+3kQP4EQItAwCfaNlQ06kHg666tJCRzZNF ++Dp6TTYAn36glLR+tD7JSxNANQVMfY+9lHGP +=jmt6 +-----END PGP ARMORED FILE----- +") +(define sig-slsl-invalid " +-----BEGIN PGP ARMORED FILE----- + +iD8DBQA6iCtLN8q1H7eRA/gRAi0DAJ9o2VDTqQeDrrq0kJHNk0X4OnpNNgCffqCU +tH60PslLE0A1BUx9j72UcY+sJ2IFdGV4dDE6iCtLSSBhbSBzb3JyeSwgSSBjYW4n +dCBkbyB0aGF0Cog/AwUAOogrSzfKtR+3kQP4EQItAwCfaNlQ06kHg666tJCRzZNF ++Dp6TTYAn36glLR+tD7JSxNANQVMfY+9lHGPrCdiBXRleHQxOogrS0kgYW0gc29y +cnksIEkgY2FuJ3QgZG8gdGhhdAo= +=phBF +-----END PGP ARMORED FILE----- +") + +(for-each-p + "Checking that a valid signature is verified as such" + (lambda (armored-file) + (tr:do + (tr:pipe-do + (pipe:echo (eval armored-file (current-environment))) + (pipe:spawn `(,@GPG --dearmor))) + (tr:spawn "" `(,@GPG --verify **in**)))) + '(sig-sl-valid)) + +;; ??? +;; +;; #for i in "$sig-11lss-valid-but-is-not" "$sig-11lss11lss-valid-but-is-not" \ +;; # "$sig-ssl-valid-but-is-not"; do +;; # echo "$i" | $GPG --dearmor >x +;; # $GPG --verify /dev/null || error "valid is invalid" +;; #done + +(for-each-p + "Checking that an invalid signature is verified as such" + (lambda (armored-file) + (lettmp (file) + (pipe:do + (pipe:echo (eval armored-file (current-environment))) + (pipe:spawn `(,@GPG --dearmor)) + (pipe:write-to file (logior O_WRONLY O_CREAT O_BINARY) #o600)) + + (if (= 0 (call `(,@GPG --verify ,file))) + (error "Bad signature verified ok"))) + '(sig-1ls1ls-valid sig-ls-valid sig-1lsls-invalid + sig-lsls-invalid sig-lss-invalid sig-slsl-invalid)) diff --git a/tests/openpgp/privkeys/1E28F20E41B54C2D1234D896096495FF57E08D18.asc b/tests/openpgp/privkeys/1E28F20E41B54C2D1234D896096495FF57E08D18.asc new file mode 100644 index 000000000..d0b621a16 --- /dev/null +++ b/tests/openpgp/privkeys/1E28F20E41B54C2D1234D896096495FF57E08D18.asc @@ -0,0 +1,9 @@ +-----BEGIN PGP ARMORED FILE----- +Version: GnuPG v2 +Comment: Use "gpg --dearmor" for unpacking + +KDExOnByaXZhdGUta2V5KDM6ZWNjKDU6Y3VydmU3OkVkMjU1MTkpKDU6ZmxhZ3M1 +OmVkZHNhKSgxOnEzMzpAZ8zkuQDL9x7rcvvoo6s3iEF1j88Dknd9nZhLnTEoBRkp +KDE6ZDMyOnicJkwzhZjYg5Fd8zqmEsZLPdGwe+z+8DU6lq6zj5HcKSkp +=ZStX +-----END PGP ARMORED FILE----- diff --git a/tests/openpgp/privkeys/C6A6390E9388CDBAD71EAEA698233FE5E04F001E.asc b/tests/openpgp/privkeys/C6A6390E9388CDBAD71EAEA698233FE5E04F001E.asc new file mode 100644 index 000000000..939e8ab8d --- /dev/null +++ b/tests/openpgp/privkeys/C6A6390E9388CDBAD71EAEA698233FE5E04F001E.asc @@ -0,0 +1,27 @@ +-----BEGIN PGP ARMORED FILE----- +Version: GnuPG v2 +Comment: Use "gpg --dearmor" for unpacking + +KDExOnByaXZhdGUta2V5KDM6cnNhKDE6bjI1NzoAqBvNbHXRfWWcek7De5Xpw8bO +d8KibdW2sE6F2ZeqifoTvLTDcv2lIGqqovKQuRV9x5UkUIY0RQ0F6uI0d/o3nBSt +8H8JsUylzCoTeds4UiFgpRA+O+egd8DyE7sABtlmBXHApYa7Vl/I/sASuSKS1VQF +0JzkWSzj+381GZDtSg7t2z+A+n9S0MmrSM4EtPHZ5aelr7CQ65FHhmOkebJqcfX/ +j6gVX1FaZnJGzDkfgWDybaZWU9JXs+KlrJnVm6lO2YXb54TBnE2wW5PVm30dSCab +YoHrivL01NuCadhUI+oiAVfTg41H69dRCelt07x2lrnXXdIX1/Q58h/a4IawxSko +MTplMzoBAAEpKDE6ZDI1Njog6qS8HovBCoLrvf1v9wg5YfWupIlKiWTGu/FgjF6D +uthfhGOa4giRwuEbm/RzkT46NL1SGR0mAilM9zL/5Ro7cR8n7rAWq+PxCLIck6zB +BDEY0QfmkfGtUTX1YBHexXXBDieDIdEP1hyUqUZhQuBObi/fS8E4pt4TMjLTCTo1 +XEqZxqvK11AD6y2GddnCtH8vTgUaALzxNks23nngDEAdaDfJMHobST4Jb9RYVHNN +zsZnLkKRr+GIemOoRXlCvTmTaw+8Vh6vUq8OWB5jryNxmt64FtWAHpLcW0n5OE6S +6OlndqM92Xe9NT12wu75Mn+qTYrVauSPQvVveZMakG/hKSgxOnAxMjk6AMNAbeJx +Bb6BlIWYMYrpAhkuPBgB3HvS0wZQ/n0j8LLEh+BJI8xa9HgDz7LOJPo00w6ERHvb +Q+8VVBP69wxwHFJSfxJsImqUmQYXgoA2n/6GAqfj4oFK/FAsFd350bkaFnZcSxqj +hJai8JQPku0cZqPudfRzThX5XIBbynMBNqIxKSgxOnExMjk6ANxpdW6WqMrWGerg +X1i4MQd9ofyyWaT2XaGrnwMJY1qUqAqPViqZWPpPmya8mVrT9XkajdtPUm0zVzeK +IjEScdvoS/pwkIMmM2+GRCFCo9zrsExeqa1cQpc8GFDZgynZ9/jXWeRiidU1xTMt +gANAiZWOb8Ww6ti9p+t96liUEB7VKSgxOnUxMjk6AK/BZIZC/C6GJyRhEoTBlzmn +nSC5eC6MojPTOQwd5VIkeEq4illBE7DF/5gFw/fufn7s+0vicZx/8yLH1mFYkbwq +DfuoY/Da5lnRFw6fGOj4N0ikS26FApjlh2DS09HtIFuNAhErr5PDPjF1F31XL/1M +50jkxfKPamxMiEs8it0VKSkp +=GHvX +-----END PGP ARMORED FILE----- diff --git a/tests/openpgp/privkeys/D69102E0F5AC6B6DB8E4D16DA8E18CF46D88CAE3.asc b/tests/openpgp/privkeys/D69102E0F5AC6B6DB8E4D16DA8E18CF46D88CAE3.asc new file mode 100644 index 000000000..86f6acfab --- /dev/null +++ b/tests/openpgp/privkeys/D69102E0F5AC6B6DB8E4D16DA8E18CF46D88CAE3.asc @@ -0,0 +1,27 @@ +-----BEGIN PGP ARMORED FILE----- +Version: GnuPG v2 +Comment: Use "gpg --dearmor" for unpacking + +KDExOnByaXZhdGUta2V5KDM6cnNhKDE6bjI1NzoA255CUJxFEKLVwEoSgwZqXd94 +AhjGUbMY6NXdFj5cCq0JmWZrbpT/5OblTrymiH1iLmI0ymo+/s8vh6NtB98dhr1s +yH3asNQfXZRfF+u5X5hLDNPF4sUelsl4+EUef0Hbc9U+e+8F8A9TMxELSqQ8Ul3H +u42hc+/ugkc1G/8++Sv/f60TqWcUR2GmuiAvkuS1WmdATMhwPr7vMfssV0X0mboz +32//b/UfuOyctso5FM+bRaKrEJDQ2WDg57yqnaqsKEgajW0jElpAVIn792W6YWKO +k4auYSpO5f7BVs40Z+bxKGxiH87z9fnmlYAsQwPOOxZwWaCSrReeheK6c6emASko +MTplMzoBAAEpKDE6ZDI1NjoYgHaQ5xkEJcvyhmZm/H8/doq9XnrkazZ7O5OimKsi +Jx4BYZ4uGdeBd9/bbKFTwaauMBddrIQstNFuW5BIJt9KGgtvRC3y49JABClRJ45o +mOVpSp3dkp+6s5hDHUsCvZvjN3D02LzxLx8u0lb6fopFp4rSD5dqB48KNTGQAbvK +hqYZ521wmTfYLiy9taVAhqZLHlhfmrHYmdvvKjdNE3tSActlHWXdu119rdHhJ0zJ +Rxx/N845rl+PXXdFHveQxCBhHBQpSUaKpte+ZbT4vrjyNugD6XjDi4HLI9CysUDP +A0IFD+BJWw7NgYY51yamT7nNcMD6bJdgtt1FXbSgh7jVKSgxOnAxMjk6AN7btgbl +HEHrKf77a9ptklDvd2bEkUOwj3bFavB1lpkliW1USoWMx97zjxRPzQOs6EoE7u9Z +JRDO8xA9ZbI0WOk7io5OHpVp1BHyeqebqfxHzN5wsRphu+peg7vYfENVf0lA8LIU +NeUkbfEWDQ+inXxqkgD51gPfrU3PRdCDM8fnKSgxOnExMjk6APxHMsTrjaUoITcI +LqT35wDinFnX1+OgKD00krcUmc+G0ylLMolVxsB4yDVIkY8QfhbaGtFoP45PCnxS +rvHKrTt/6sZJCWXf+3KaN0QSxyfi/mEPj3KbXhmaY6x8R4aB/M7ipLXNdj/308pu +a50YPwIYyX0L0qoRBBo/xQDgOsXXKSgxOnUxMjk6AMzWw92nzShDRzPZwBvb48YY +YzZFiFtJbcZ1n8DaiM7VmzAkRqwmCu6HPP/8IC4d6UkFUUlHyDyxSaKuA45Y+FR1 +Pb2/Y/mQVsBanK4i+1oL4fYGexFO0qjA+8l2+6BEWbKQX60nIcFXD2hAP0aqWDGO +lXrPhpWPRrwDd4j9DEvfKSkp +=1cwG +-----END PGP ARMORED FILE----- diff --git a/tests/openpgp/privkeys/EB33B687EB8581AB64D04852A54453E85F3DF62D.asc b/tests/openpgp/privkeys/EB33B687EB8581AB64D04852A54453E85F3DF62D.asc new file mode 100644 index 000000000..ede9a9159 --- /dev/null +++ b/tests/openpgp/privkeys/EB33B687EB8581AB64D04852A54453E85F3DF62D.asc @@ -0,0 +1,10 @@ +-----BEGIN PGP ARMORED FILE----- +Version: GnuPG v2 +Comment: Use "gpg --dearmor" for unpacking + +KDExOnByaXZhdGUta2V5KDM6ZWNjKDU6Y3VydmUxMDpDdXJ2ZTI1NTE5KSg1OmZs +YWdzOTpkamItdHdlYWspKDE6cTMzOkAWeeZlz31O4qTmIKr3CZhlRUXZFxc3YKyo +CXyIZBBRaykoMTpkMzI6VN/VGmlcwGBPcLTya2hfU4t37nMcFCKdNSXjJ5DFA0Ap +KSk= +=eVhB +-----END PGP ARMORED FILE----- diff --git a/tests/openpgp/quick-key-manipulation.test b/tests/openpgp/quick-key-manipulation.test new file mode 100755 index 000000000..4185601bb --- /dev/null +++ b/tests/openpgp/quick-key-manipulation.test @@ -0,0 +1,70 @@ +#!/bin/sh +# Copyright 2016 Free Software Foundation, Inc. +# This file is free software; as a special exception the author gives +# unlimited permission to copy and/or distribute it, with or without +# modifications, as long as this notice is preserved. This file is +# distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY, to the extent permitted by law; without even the implied +# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +. $srcdir/defs.inc || exit 3 + +export PINENTRY_USER_DATA=test + +alpha="Alpha " +bravo="Bravo " + +$GPG --with-colons --with-fingerprint --list-secret-keys ="$alpha" && + error "User ID '$alpha'exists when it should not!" +$GPG --with-colons --with-fingerprint --list-secret-keys ="$bravo" && + error "User ID '$bravo' exists when it should not!" + +#info verify that key creation works +$GPG --quick-gen-key "$alpha" || \ + error "failed to generate key" + +fpr=$($GPG --with-colons --with-fingerprint --list-secret-keys ="$alpha" | \ + grep '^fpr:' | cut -f10 -d: | head -n1) + +$GPG --check-trustdb + +cleanup() { + $GPG --batch --yes --delete-secret-key "0x$fpr" + $GPG --batch --yes --delete-key "0x$fpr" +} + +count_uids_of_secret() { + if ! [ $($GPG --with-colons --list-secret-keys ="$1" | \ + grep -c '^uid:u:') = "$2" ] ; then + cleanup + error "wrong number of user IDs for '$1' after $3" + fi +} + +count_uids_of_secret "$alpha" 1 "key generation" + +#info verify that we can add a user ID +if ! $GPG --quick-adduid ="$alpha" "$bravo" ; then + cleanup + error "failed to add user id" +fi + +$GPG --check-trustdb + +count_uids_of_secret "$alpha" 2 "adding User ID" +count_uids_of_secret "$bravo" 2 "adding User ID" + +#info verify that we can revoke a user ID +if ! $GPG --quick-revuid ="$bravo" "$alpha"; then + cleanup + error "failed to revoke user id" +fi + +$GPG --check-trustdb + +count_uids_of_secret "$bravo" 1 "revoking user ID" + +cleanup + +! $GPG --with-colons --list-secret-keys ="$bravo" || + error "key still exists when it should not!" diff --git a/tests/openpgp/run-tests.scm b/tests/openpgp/run-tests.scm new file mode 100644 index 000000000..a921fdbe9 --- /dev/null +++ b/tests/openpgp/run-tests.scm @@ -0,0 +1,209 @@ +;; Test-suite runner. +;; +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(if (string=? "" (getenv "srcdir")) + (begin + (echo "Environment variable 'srcdir' not set. Please point it to" + "tests/openpgp.") + (exit 2))) + +;; Set objdir so that the tests can locate built programs. +(setenv "objdir" (getcwd) #f) + +(define test-pool + (package + (define (new procs) + (package + (define (add test) + (new (cons test procs))) + (define (wait) + (let ((unfinished (filter (lambda (t) (not t::retcode)) procs))) + (if (null? unfinished) + (package) + (let* ((commands (map (lambda (t) t::command) unfinished)) + (pids (map (lambda (t) t::pid) unfinished)) + (results + (map (lambda (pid retcode) (list pid retcode)) + pids + (wait-processes (map stringify commands) pids #t)))) + (new + (map (lambda (t) + (if t::retcode + t + (t::set-retcode (cadr (assoc t::pid results))))) + procs)))))) + (define (passed) + (filter (lambda (p) (= 0 p::retcode)) procs)) + (define (skipped) + (filter (lambda (p) (= 77 p::retcode)) procs)) + (define (hard-errored) + (filter (lambda (p) (= 99 p::retcode)) procs)) + (define (failed) + (filter (lambda (p) + (not (or (= 0 p::retcode) (= 77 p::retcode) + (= 99 p::retcode)))) + procs)) + (define (report) + (echo (length procs) "tests run," + (length (passed)) "succeeded," + (length (failed)) "failed," + (length (skipped)) "skipped.") + (length (failed))))))) + +(define (verbosity n) + (if (= 0 n) '() (cons '--verbose (verbosity (- n 1))))) + +(define test + (package + (define (scm name . args) + (new name #f `(,*argv0* ,@(verbosity *verbose*) ,@args + ,(in-srcdir name)) #f #f)) + (define (new name directory command pid retcode) + (package + (define (set-directory x) + (new name x command pid retcode)) + (define (set-retcode x) + (new name directory command pid x)) + (define (set-pid x) + (new name directory command x retcode)) + (define (run-sync) + (with-working-directory directory + (let* ((p (inbound-pipe)) + (pid (spawn-process-fd command CLOSED_FD + (:write-end p) (:write-end p)))) + (close (:write-end p)) + (splice (:read-end p) STDERR_FILENO) + (close (:read-end p)) + (let ((t' (set-retcode (wait-process name pid #t)))) + (t'::report) + t')))) + (define (run-sync-quiet) + (with-working-directory directory + (set-retcode + (wait-process + name (spawn-process-fd command CLOSED_FD CLOSED_FD CLOSED_FD) #t)))) + (define (run-async) + (with-working-directory directory + (set-pid (spawn-process-fd command CLOSED_FD CLOSED_FD CLOSED_FD)))) + (define (status) + (let ((t (assoc retcode '((0 "PASS") (77 "SKIP") (99 "ERROR"))))) + (if (not t) "FAIL" (cadr t)))) + (define (report) + (echo (string-append (status retcode) ":") name)))))) + +(define (run-tests-parallel-shared setup teardown . tests) + (setup::run-sync) + (let loop ((pool (test-pool::new '())) (tests' tests)) + (if (null? tests') + (let ((results (pool::wait))) + (for-each (lambda (t) (t::report)) results::procs) + (teardown::run-sync) + (exit (results::report))) + (let ((test (car tests'))) + (loop (pool::add (test::run-async)) (cdr tests')))))) + +(define (run-tests-parallel-isolated setup teardown . tests) + (let loop ((pool (test-pool::new '())) (tests' tests)) + (if (null? tests') + (let ((results (pool::wait))) + (for-each (lambda (t) + (let ((teardown' (teardown::set-directory t::directory))) + (teardown'::run-sync-quiet)) + (unlink-recursively t::directory) + (t::report)) results::procs) + (exit (results::report))) + (let* ((wd (mkdtemp "gpgscm-XXXXXX")) + (test (car tests')) + (test' (test::set-directory wd)) + (setup' (setup::set-directory wd))) + (setup'::run-sync-quiet) + (loop (pool::add (test'::run-async)) (cdr tests')))))) + +(define (run-tests-sequential-shared setup teardown . tests) + (let loop ((pool (test-pool::new '())) + (tests' `(,setup ,@tests ,teardown))) + (if (null? tests') + (let ((results (pool::wait))) + (exit (results::report))) + (let ((test (car tests'))) + (loop (pool::add (test::run-sync)) (cdr tests')))))) + +(define (run-tests-sequential-isolated setup teardown . tests) + (let loop ((pool (test-pool::new '())) (tests' tests)) + (if (null? tests') + (let ((results (pool::wait))) + (for-each (lambda (t) + (let ((teardown' (teardown::set-directory t::directory))) + (teardown'::run-sync-quiet)) + (unlink-recursively t::directory)) + results::procs) + (exit (results::report))) + (let* ((wd (mkdtemp "gpgscm-XXXXXX")) + (test (car tests')) + (test' (test::set-directory wd)) + (setup' (setup::set-directory wd))) + (setup'::run-sync-quiet) + (loop (pool::add (test'::run-sync)) (cdr tests')))))) + +(define all-tests + '("version.scm" + "mds.scm" + "decrypt.scm" + "decrypt-dsa.scm" + "sigs.scm" + "sigs-dsa.scm" + "encrypt.scm" + "encrypt-dsa.scm" + "seat.scm" + "clearsig.scm" + "encryptp.scm" + "detach.scm" + "detachm.scm" + "armsigs.scm" + "armencrypt.scm" + "armencryptp.scm" + "signencrypt.scm" + "signencrypt-dsa.scm" + "armsignencrypt.scm" + "armdetach.scm" + "armdetachm.scm" + "genkey1024.scm" + "conventional.scm" + "conventional-mdc.scm" + "multisig.scm" + "verify.scm" + "armor.scm" + "import.scm" + "ecc.scm" + "4gb-packet.scm" + "gpgtar.scm" + "use-exact-key.scm" + "default-key.scm")) + +(let* ((runner (if (member "--parallel" *args*) + (if (member "--shared" *args*) + run-tests-parallel-shared + run-tests-parallel-isolated) + (if (member "--shared" *args*) + run-tests-sequential-shared + run-tests-sequential-isolated))) + (tests' (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*)) + (tests (if (null? tests') all-tests tests'))) + (apply runner (append (list (test::scm "setup.scm") (test::scm "finish.scm")) + (map test::scm tests)))) diff --git a/tests/openpgp/samplekeys/README b/tests/openpgp/samplekeys/README index 20d9f5137..29524d512 100644 --- a/tests/openpgp/samplekeys/README +++ b/tests/openpgp/samplekeys/README @@ -14,3 +14,6 @@ whats-new-in-2.1.asc Collection of sample keys. e2e-p256-1-clr.asc Google End-end-End test key (no protection) e2e-p256-1-prt.asc Ditto, but protected with passphrase "a". E657FB607BB4F21C90BB6651BC067AF28BC90111.asc Key with subkeys (no protection) +rsa-rsa-sample-1.asc RSA+RSA sample key (no passphrase) +ed25519-cv25519-sample-1.asc Ed25519+CV25519 sample key (no passphrase) +silent-running.asc Collection of sample secret keys (no passphrases) diff --git a/tests/openpgp/samplekeys/ed25519-cv25519-sample-1.asc b/tests/openpgp/samplekeys/ed25519-cv25519-sample-1.asc new file mode 100644 index 000000000..54d204427 --- /dev/null +++ b/tests/openpgp/samplekeys/ed25519-cv25519-sample-1.asc @@ -0,0 +1,21 @@ +pub ed25519 2016-06-22 [SC] + B21DEAB4F875FB3DA42F1D1D139563682A020D0A + Keygrip = 1E28F20E41B54C2D1234D896096495FF57E08D18 +uid [ unknown] patrice.lumumba@example.net +sub cv25519 2016-06-22 [E] + 8D0221D9B2877A741D69AC4E9185878E4FCD74C0 + Keygrip = EB33B687EB8581AB64D04852A54453E85F3DF62D + +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG v2 + +mDMEV2o9XRYJKwYBBAHaRw8BAQdAZ8zkuQDL9x7rcvvoo6s3iEF1j88Dknd9nZhL +nTEoBRm0G3BhdHJpY2UubHVtdW1iYUBleGFtcGxlLm5ldIh5BBMWCAAhBQJXaj1d +AhsDBQsJCAcCBhUICQoLAgQWAgMBAh4BAheAAAoJEBOVY2gqAg0KmQ0BAMUNzAlT +OzG7tolSI92lhePi5VqutdqTEQTyYYWi1aEsAP0YfiuosNggTc0oRTSz46S3i0Qj +AlpXwfU00888yIreDbg4BFdqPY0SCisGAQQBl1UBBQEBB0AWeeZlz31O4qTmIKr3 +CZhlRUXZFxc3YKyoCXyIZBBRawMBCAeIYQQYFggACQUCV2o9jQIbDAAKCRATlWNo +KgINCsuFAP9BplWl813pi779V8OMsRGs/ynyihnOESft/H8qlM8PDQEAqIUPpIty +OX/OBFy2RIlIi7J1bTp9RzcbzQ/4Fk4hWQQ= +=qRfF +-----END PGP PUBLIC KEY BLOCK----- diff --git a/tests/openpgp/samplekeys/rsa-rsa-sample-1.asc b/tests/openpgp/samplekeys/rsa-rsa-sample-1.asc new file mode 100644 index 000000000..382d4e64c --- /dev/null +++ b/tests/openpgp/samplekeys/rsa-rsa-sample-1.asc @@ -0,0 +1,38 @@ +pub rsa2048 2016-06-22 [SC] + 5B83120DB1E3A65AE5A8DCF6AA43F1DCC7FED1B7 + Keygrip = C6A6390E9388CDBAD71EAEA698233FE5E04F001E +uid [ unknown] steve.biko@example.net +sub rsa2048 2016-06-22 [E] + 4CB4D8C018C57E60EB3847901D777619BE310D79 + Keygrip = D69102E0F5AC6B6DB8E4D16DA8E18CF46D88CAE3 + +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG v2 + +mQENBFdqP+gBCACoG81sddF9ZZx6TsN7lenDxs53wqJt1bawToXZl6qJ+hO8tMNy +/aUgaqqi8pC5FX3HlSRQhjRFDQXq4jR3+jecFK3wfwmxTKXMKhN52zhSIWClED47 +56B3wPITuwAG2WYFccClhrtWX8j+wBK5IpLVVAXQnORZLOP7fzUZkO1KDu3bP4D6 +f1LQyatIzgS08dnlp6WvsJDrkUeGY6R5smpx9f+PqBVfUVpmckbMOR+BYPJtplZT +0lez4qWsmdWbqU7ZhdvnhMGcTbBbk9WbfR1IJptigeuK8vTU24Jp2FQj6iIBV9OD +jUfr11EJ6W3TvHaWuddd0hfX9DnyH9rghrDFABEBAAG0FnN0ZXZlLmJpa29AZXhh +bXBsZS5uZXSJATcEEwEIACEFAldqP+gCGwMFCwkIBwIGFQgJCgsCBBYCAwECHgEC +F4AACgkQqkPx3Mf+0bd5kggAphS7UDycKadfaRH5JENmKXeI+UUd+E0iERwv7eXq +RcgjNK1oHQSXN+ejDEXzZv2fcCRB7rWEvEXL0pCtPveyzDAQJdhZTRVgmfCXTr1m +9pJfVC3B20jgx6ZxZO8jKDL+bqvufWJczWDT0iHP0Jv04SqASLRs2JRPy+a+w3GJ ++DzG8orfAKiIE1Qycovr8Ol+jdo9ZV9blRA8/j4eqZYg4b7AOf8/mDyXsx3xzSPV +uwkDSluhaOrsV8N0suZ51rfdpapv6VJsXlyQbceJwwgSt2A1n2Sw3ZINwpO7BODy +wO6J44751+qY4cmap4NItyqGQTT6TUEL9ANfrZFmPWmFWLkBDQRXaj/oAQgA255C +UJxFEKLVwEoSgwZqXd94AhjGUbMY6NXdFj5cCq0JmWZrbpT/5OblTrymiH1iLmI0 +ymo+/s8vh6NtB98dhr1syH3asNQfXZRfF+u5X5hLDNPF4sUelsl4+EUef0Hbc9U+ +e+8F8A9TMxELSqQ8Ul3Hu42hc+/ugkc1G/8++Sv/f60TqWcUR2GmuiAvkuS1WmdA +TMhwPr7vMfssV0X0mboz32//b/UfuOyctso5FM+bRaKrEJDQ2WDg57yqnaqsKEga +jW0jElpAVIn792W6YWKOk4auYSpO5f7BVs40Z+bxKGxiH87z9fnmlYAsQwPOOxZw +WaCSrReeheK6c6emAQARAQABiQEfBBgBCAAJBQJXaj/oAhsMAAoJEKpD8dzH/tG3 +baoH/0KI3pIUiIYiLESGXqF+s/W2BmGNwdkYldcyFwkXz84VXoG0B3k7nrwT2DOJ +AEeToavzd3J+aZ4PmxBRAMtDhah0wsMXrwCI8y9Stmm6PIssnu9IP9+jgr4IkKIR +UB/Wn6nzgseaNd7vN4JChCyLSvF+vLd3D56Wzq+hBjybaE+zcEusVLdKYDm2i0YC +pkBkmSuC18lLxhNC8oSCCvVOiyw+TqGHhLnrpA4nGi0MLjAR3OgJ5d/TclYgkLcp +yOupg9GplQsAZUFfQPrY80SJuN9ijBp4xtA1U+WCGKh4ySv1+odpRjPX3eOGUFKZ +sJRKpZupoGWfVN78wm1nPLBKTvM= +=6N/A +-----END PGP PUBLIC KEY BLOCK----- diff --git a/tests/openpgp/samplekeys/silent-running.asc b/tests/openpgp/samplekeys/silent-running.asc new file mode 100644 index 000000000..e7c6db3a6 --- /dev/null +++ b/tests/openpgp/samplekeys/silent-running.asc @@ -0,0 +1,120 @@ +-----BEGIN PGP PRIVATE KEY BLOCK----- +Version: GnuPG v2 + +lFgEV3IffxYJKwYBBAHaRw8BAQdA0exktohYX2Qglxscg720r5ztQNXO8EP9sOE7 +HDy0V+UAAQCrqLqMY3RkiCZfrUTncLPw1sKwswv4CzXrTz9J1FfcqBF8tBRkZXdl +eUB0ZXN0LmdudXBnLm9yZ4h5BBMWCAAhBQJXch9/AhsDBQsJCAcCBhUICQoLAgQW +AgMBAh4BAheAAAoJENGdIrBu54ZoG3MBAN67BaQAle/6688gLNHd7NAK6Y4wpZjp +XQ/f7IvK0pLfAP9OMpB1F9ZTkKSnUK09xbcTZ4cjpXxeWOV9WByAlAALBpxdBFdy +H38SCisGAQQBl1UBBQEBB0Df5kbxuQhCob7r2HS5o1qlKETsFQ+vuvjnZChSMI66 +bgMBCAcAAP9nJLg2+ywR8nkhq+4jCavrLsg7ZeVdD2XVxBGNORf1gA/fiGEEGBYI +AAkFAldyH38CGwwACgkQ0Z0isG7nhmgUMQEAiqUsUHufGyswOGYbyKXzJRDq5++d +dKTGRdSNaqrEfy4A/jZjfQb6h2QxwYd5TODiTkH7E9cVV606xkAPksgtnVAPlFgE +V3IfjRYJKwYBBAHaRw8BAQdAkeNVby/yL09w6/kK7YCoQfY7eX/p8Vrt7mIC0+iP +5jEAAQDFDD31lYLVNxo2tDeOa2bAlCAt4NwVz/TbkzW/5fK5MhEatBNodWV5QHRl +c3QuZ251cGcub3JniHkEExYIACEFAldyH40CGwMFCwkIBwIGFQgJCgsCBBYCAwEC +HgECF4AACgkQO1PIAKpZJYNglwD/ctHCJHYi1/voImCwHH5X/I6CidNX3NXoOhF8 +qdwKnUEBANAT43oV9dLyWtmeIR5on6pU0AAcrIRQFCF4+nmU7UoOnF0EV3IfjRIK +KwYBBAGXVQEFAQEHQKOiOA8BE49l+sYsTCNXuzqO+KX3z2yoxQvBHESc+X47AwEI +BwAA/34rrv4xMpH7nLMFy0YZ704KJXVF9F8wF2ezOmJLa7OoD0iIYQQYFggACQUC +V3IfjQIbDAAKCRA7U8gAqlklg0UyAQCxOjO3xMym0YykBollbcl0dZVYSxC2uJin +1sHNuDPHJgD9Gtivb16M8Uki1nbvGGtBAL9d7gWkc9Bc3y/hTVyx1QSUWARXch+d +FgkrBgEEAdpHDwEBB0CeoZAXe1DVjhfuO0cmGrwj9N7jKtK0Piri1sLyRFxOYQAB +AI0E37I3sdgBE3TMsXmbTYQthNpAqig4qZCW/QYbRLa+D0e0FGxvdWllQHRlc3Qu +Z251cGcub3JniHkEExYIACEFAldyH50CGwMFCwkIBwIGFQgJCgsCBBYCAwECHgEC +F4AACgkQf9VUPZH3nAdD2gD9EJsV/2gjNtyWaUyh3TPdp3++1Mpr8Y/GsO8idxvM +JdABAKszZ+7aUjU2dGRWJ1tjHXO45PRdAZhBD0/BNFF4eS0MnF0EV3IfnRIKKwYB +BAGXVQEFAQEHQFA82/BnrK3JntjvGKIkXN9LCevdNFx4T2v9JzJUxJwZAwEIBwAA +/1h2uhoBkxjdsU4VNgydEqFTVdcAOuqOFoGa9rlXcnzoDw6IYQQYFggACQUCV3If +nQIbDAAKCRB/1VQ9kfecB0sqAQCDOeZpp4AjSREuQKLqGsxj2by8ZLcrcF8CT2Qr +BoDljAD/WOCVNx8hIpyQ/40dzqUDQ79uwYEEUV1EF74aoQcqJg2VA5gEV3IfuQEI +AO5PDCysh81uBsbKNZZSusUJOluMbgywXXw3XUa8cV8hdA50rEJifG7Lsg0jAQDp +wjoPVPadmYcEA+p8q4j2vVcZaROmlahSjQEFePceH8Ufvl6JT/NgEyzkLMThsq/Q +XMxhzU4942p5PO/IG2vFCcVYo01/utuxv/UAgBQZ9qVkk0VN1JiCk9uckJLaX93M +jLLGifEPDAmQxpHsMvAZxoRSeZlgYqxBvizv0UPovgutdWpQ7hyKKuA3ceYOPVPI +PX7fhBJ3JhSqqaOMoK7+EW3b06fjHD6sbSSi7SMJeMgvyI86A/rtJSvpJV16WfQb +3hBBR2/QR6XzmavlL7+Nr60AEQEAAQAH+gKEKyi9maF9q+ylbfNsZDR4aHlW/kJ8 +CkCphP6eNsQ+Yi9U5Ay/ZXj2BadF21jbHwXl64u/FkPqsu/i6RzFHjKxPf7LH4Fr +fbmpCSHy23sFXsk4wfNb7FfpAOADUhOxK4ms7rIIzUHujcoqXr/AkN3YlcDXvG1d +bx1zJ+cObyBH7l5lLZvvl6jLiV+XOWxX3lU95F3akFOuI9q39uhPxn009mVXCNqJ +Jo8OwoPmScADHLYYfv110ywdVQwxAFwBX1oPZ+on/llHnkgf0ijnc/xvdf+zFFEq +qM4bjVbhRiA8ibWvWH+ac2Itcar6esroHt1kgIUM2ee+PK6ub5on37EEAPC4HVh0 +5poQZORMy0kQc/nc9kz9K9VD6cI+bcQiyr606qre6gUVhfr9L+XibpK/6Fdzbcwc +Aug9M7L+QruFQRxtGXj4R07GnPHP83OIGoGYATxcOwrJ3uCCwIS5vK8m9X7Alzaq +zzCmf1wXW5h8rfcztY/Wmxk88Deswwjysn2PBAD9b8L6/LDXnaRfpgXV2i+hON/r +qNCmZ4Oss77w62Qw4V2YmtuoeeBaC79Wa4nWGSON+uFAWn4lzb3EQshYADMFKejT +xd+/KFTowRAxUq9wzS4JjF4S2FN6l2TVA7V6pK54VmJdPUTN0JNG5eFuFiqoJsS4 +gQY3Ead60BtjQHjZAwP/c4AUjetPX23G4pINGrV0Dfw8xKWMSFjf49s2XnJ0tRCS +gFj+jv9qLwivNzK5mqfz1iynbiqe4M4DIAjuPRcci95xBI0m7t1ECw6xeuunUp9x +IlzjX0vejGklA/qSN6oi91Bs/49rVKt6uhEwCi0a8ECr3y4+CCqJ530+boMT6opH +gbQbdmFsbGV5LWZvcmdlQHRlc3QuZ251cGcub3JniQE3BBMBCAAhBQJXch+5AhsD +BQsJCAcCBhUICQoLAgQWAgMBAh4BAheAAAoJEGd0fnraHQ8MWjAIAOMIyXGSfmZh +q6dT4/R/KPRMHiWcZq+1RpHH/it9uLLIkxFn8disnIlYfCHFynj3HwQNWYAmSPQe +jC38O7UVftlWp2zxBw6719YKiopZZNy60/iRgDb3vv1fFxkq6kE+XtXW3n2m/piQ +cI/jY2LRyIkVOEGDvFWcAF4iDHgkQrV4uLH0dmCzg2fIVULBT0ITtybUtOOJmrpp +E+yysTiHfewvhIgiOFzy+CZbdlPfVp3IUGhrNU9XiWraU38dwNXVYnE5uwotqf7G +U03pmw2GCA+txq3NofMM4kFHN+eVE4+lXUEhVJRXa4y2PgKFYmBFoED9SahuxO2o +1Cj+IpFgn2idA5gEV3IfuQEIALsnERBUkAFXZilIJRCpkbT6xhlsT1OZ7a+fHXwZ +1P3uElapJo9ODGX9T93s10GiL+KiXm32wxUP1BdsFkFsnahzo+U7OrB35ASDNpkl +p+CbO+UrUAIPD5NGpWuHKoPzc+SwW69fTeZyLRHqOldOA88/6veA9vbCTYGgpyAR +kwMLKqX6EDnX+mbNhKEEixWp1Elw5OCv7N0NbFLIZ9YTTOGpn/HvHv1CCmlrlc/W +BnJJE0D6345FslQ77V0ImMpNlEl8fy53g4JAYYW/w+CnXHl2vVD8ye9lKuFwB62n +vAnpjOEbAtyOncm2quSkBlcv0jo7EGDMxH31ki+yDuQeoPUAEQEAAQAH+QEwC5ST +pmeAky/lrgKJXCWoLI11wABTHj+6kUVvC1VIzcn9M2okzMEkiePp849bKzwGqFwn +Sdak4PiWR+l5xuH0r4OuMnGmcrmxAXqYU0fo6q9KIC0n9+lvdDywWppqw/+dobKF +UGlX34xZDnsf9ITVexuMY6s7BKKzDv+nmbJWIx9PehNUlh7Ucvy0/Lm0hHr/G1B/ +6ziybm5gCUTKBm4MsepTCCyFf/C/i53l+qdHUnWQdg+lGoU3Y98MiRM7Zr2QKznJ +fn74eVlYi4byjKeFujQyIw8tbH+G/RWw+WQzEjY8VLdLMf6u/T1g6htumQxPDLIQ +WxPz29ney9+WFZMEAM7itO8IEFUqy9MLp2kjRlwCMc+rRzLzh1d2c7gbdtxCOVoc +krq5QPeOyWM7IMxImvcTXJUB2jQikw7NXtCRfDHD2egyJRGN2J5SdE2EHvQRtFwl +6GoQ+mrJnPqetSoSZnC54HrlxIZEWE1Tzg79JoDbzPkwRKY8MIf4U3NniAmnBADn +lRsJLygRb1xZ5aUhRkJc8KYdwrcCSgG5gvm+yzv5aOMXWU1P65GARCUFEOzHJVMs +ML620SKS3RQ50hM1QLYSdox/vuEyk5m7Ty6cSGtagvohckWFh9Jry5FthlMYqVzR +HZmZXlCngc7umuWrzBdtAJAQt9sQ9M41iCjn8k3cAwQAu92QEan/m46qnszif++G +PzrbwKFsQzU45DPCx4QXBcnZT4jz3a2vSq99COBob4oVlETP2S6wy8w5KS4xQXVN +Q88TZZmJwdxsw5cUc3ANapMofwhrddhswFF/lmE1at1J0Uvpq79ZJt7yaSmZibXy +jDc3ygf26B0SKThVA4IUzYQ3u4kBHwQYAQgACQUCV3IfuQIbDAAKCRBndH562h0P +DP/rCACNRLCM6oyCyu+bB+UFdgN1UMsPGmh8xlfHFB3WG24JWDflEgN2Co+5ltzo +CI8AQ+6va86PeE8LgLCvLhrZbCnCxmjPb4SIHgPLC1aaTM9mu86iDLEERHEBLVhS +n57XSLpJqZMXSIJO74BGn+t0sBSZvGtQF56EImc9AyTLW99EPc4rXARL/V850rVa +PzTVbDOfm5lRbmt1+G0mo51SrFZh0Vy0cydk6uGpqxxkxE5y54vBMyZuUMmlkr71 +14TPfuNB0Wkd7coE3xKPOp5b+ntDPAuxgXej8OtrBeZxcOnSP84IcATSkReMIqJy +31+hvjDtkhZq0FMIBmz0RFFmS7+qlFgEV3If3hYJKwYBBAHaRw8BAQdAfyxylIVJ +wo+mAg95LN3U9BHYRtKa0tPmOgDzYKcTElcAAQC/fqSbQ5ghgYJ2/F+Nl2ZA1+co +EE4o48YvknnmcP5OpBCstB1mcmVlbWFuLmxvd2VsbEB0ZXN0LmdudXBnLm9yZ4h5 +BBMWCAAhBQJXch/eAhsDBQsJCAcCBhUICQoLAgQWAgMBAh4BAheAAAoJED3AlPrw +yKQlrNcBAOsJAoLfXYv+z519rALFI+crxv5z9p2xXSplKliWNJ+ZAQCvpfUIDynR +n/s+IBGjwR30BlZF63NxQ9i9cIxUBzXSAZxdBFdyH94SCisGAQQBl1UBBQEBB0A5 +052JXUgFlcERPDwoQqJIbLIE3hoFp3qL3/YvPuOFawMBCAcAAP93FWcg/I/NAq0j +spa8n8gVgn8FZA9RqGptElNIHnamgA5siGEEGBYIAAkFAldyH94CGwwACgkQPcCU ++vDIpCWaCgEAwkDqEeC+fCKkoNAslozwf+VJQDNpzzpLaDwO5oSZaiwA/3jIErkx +UMuG5sa5hR6CYVY8Iiwy4NRCM/r66oDqwr8OlFgEV3If8BYJKwYBBAHaRw8BAQdA +GwS/1um/1QQXarZFcDgmaYjRBc/m4BV9iQVOrJBIroEAAQD8rIxduReDq/gYofIG +GGfOF1Smb4XCQ30uZlkIMDR6+Q7ZtBpqb2huLmtlZW5hbkB0ZXN0LmdudXBnLm9y +Z4h5BBMWCAAhBQJXch/wAhsDBQsJCAcCBhUICQoLAgQWAgMBAh4BAheAAAoJEDIG +dpEV2WgEG6sA+gN5F+IftoJ3cSONXL5mddA9TTX0VV6Znf0OyvBv0DDnAPwNXZVa +eCr4OfGNkapOViamN6ndRzT1OYbU1gvcKNwUDpxdBFdyH/ASCisGAQQBl1UBBQEB +B0BVSesW6o8soaWsMmvizFt7dwYAt4GdoJUA0aKyTTAFWAMBCAcAAP9vJIIHAR/w ++IvwZq0POVxmevdWXJ78tA/yvY2e12P0mBHbiGEEGBYIAAkFAldyH/ACGwwACgkQ +MgZ2kRXZaARftQD+P4TwgTJdftgvk1H60MoCN9B4RLH2pieeiHTcqvrErE4A/2y1 +ynHx1S3VwE8C++aZ5/WLiv6Dtjd8JKjw8wKEqswBlFgEV3IgBhYJKwYBBAHaRw8B +AQdAbqmt5oTNiHg1qhAylVX2eHdXSDCzovbZ8q7hrZpd95oAAP497J3U+4M4G+Ec +hW30e+Ye7DArAzVj+moq1tVCZVe3pRFAtBtNYXJ0eS5CYXJrZXJAdGVzdC5nbnVw +Zy5vcmeIeQQTFggAIQUCV3IgBgIbAwULCQgHAgYVCAkKCwIEFgIDAQIeAQIXgAAK +CRAGGYXu0KJiLW1OAQD9KtP+snTW+rOA4EtquLI6e3mk9geLTICbNo8bk58v/gD/ +QkFaXjRkRwD1S9X1z6rWPR3fH0CHfyymyMKgmoelgAOcXQRXciAGEgorBgEEAZdV +AQUBAQdAycZZHE3yuTQECmpx+X+hgjR38KPxKiQ51OSB6WsFrC0DAQgHAAD/VUz9 +WYTnMkjvH7JZCw7yswLBO/FVJFlqrXsDlNMYBzgOxohhBBgWCAAJBQJXciAGAhsM +AAoJEAYZhe7QomItaZcBAMCzB1ks9GOQL1og/q643obuGoB0xmsUJoQO2xo67z0o +AQC7NeBSnzYXfGwvPwsc9kgkgMt3RmzuYgwdyRtNOL+GAZRYBFdyIBQWCSsGAQQB +2kcPAQEHQDDvfVidNYqiTBgBqDDTa40gxTdrgO1q3ssIaOigtntlAAEAxbKQpqA8 +huHRHAiQXkUaRAKLzP5xPDHnnqN5u6GeMDYPrbQYQW5keS5Xb2xmQHRlc3QuZ251 +cGcub3JniHkEExYIACEFAldyIBQCGwMFCwkIBwIGFQgJCgsCBBYCAwECHgECF4AA +CgkQFO3P+6onnuT3IAD9Ek+AmmvN9CU3LdLl0ADX2ba92fY++8u11AZULvys/RkA ++wRix4Rw1xL59EpowGWGuZ9Ky9aG5w7iZICBakgvs+QBnF0EV3IgFBIKKwYBBAGX +VQEFAQEHQCdfyKinwttnpD0M/OIZGMwkLHtPdAgOnvnpdj8/gNxEAwEIBwAA/27g +/G5idxYoUaAsG8cq5ziA9OvRovQKT3E6MLGIBv7QER2IYQQYFggACQUCV3IgFAIb +DAAKCRAU7c/7qiee5KeqAQC96Df0rgZteOKtiMt+wXwQufkjT5XrDWNyvI+NaVhS +2QD/cUSRyh72N4sp8MV8BhN9RE+snFc2OW6ROafIizDtRgE= +=tU5z +-----END PGP PRIVATE KEY BLOCK----- diff --git a/tests/openpgp/samplemsgs/clearsig-1-key-1.asc b/tests/openpgp/samplemsgs/clearsig-1-key-1.asc new file mode 100644 index 000000000..4673c4007 --- /dev/null +++ b/tests/openpgp/samplemsgs/clearsig-1-key-1.asc @@ -0,0 +1,17 @@ +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA256 + +You are scrupulously honest, frank, and straightforward. Therefore you +have few friends. +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 + +iQE0BAEBCAAeBQJXakWmFxxzdGV2ZS5iaWtvQGV4YW1wbGUubmV0AAoJEKpD8dzH +/tG3OiIH/18NlMSXXRFRrxXq9OZySzJxgLI7BjGilRTqb4ALeFzNjmCwu3Y+Gkdg +t7NjYjSe0erWiKYDEmALICwcpmSmXHA//gol3QkHJKIlKQGXJP1qLvIde5+lnK8K +YVwLKLBQBQtlGMkMXPdUEn9PgzSoBFoFIqrzQmAdLO3yijSdm0Mzl9wyIhtbUXk+ +VgX2d/6DRIwcKcFoX2QbFlM/z1kdrS6cOYFbJWavEpLDz9ON8Q8a8uqcBiqRlSpW +eGOMMsysJs+44+qX6uE3hu2KJE9xvHwhSjJOxqtw8dN3KZ1+8IkxsDrvDAhn+Klf +Hbtj647f/iTOF88o1ihO7goDi93Bpv4= +=xAv4 +-----END PGP SIGNATURE----- diff --git a/tests/openpgp/samplemsgs/clearsig-2-keys-1.asc b/tests/openpgp/samplemsgs/clearsig-2-keys-1.asc new file mode 100644 index 000000000..0d7823ec1 --- /dev/null +++ b/tests/openpgp/samplemsgs/clearsig-2-keys-1.asc @@ -0,0 +1,20 @@ +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA256 + +"The geeks shall inherit the earth." + -- Karl Lehenbauer +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 + +iQE0BAEBCAAeBQJXakX/FxxzdGV2ZS5iaWtvQGV4YW1wbGUubmV0AAoJEKpD8dzH +/tG3g1AH/iQakK5FoXpNQs6Nj9NR4NUwtIPmlLS/Tas21CDs1Lo1Fum1gjU0VUFN +63+FTnbRg8nXfee9RPddLnec9lYWVqWSkggTFER8qQrj/EurltLMv/tHAZ+B0ueI +mh2XkNHA6KXu3DFipAXQezWaUqi485TGTY6Qv9JtG/plOZBakcRTgCSAamyaDPBA +PHgp85bPf5Zu4aFRBfmJp+IUH/EFLNFIHNXpYyZZy5ZdB3GuhAHGFp6tlpRFk4Z5 +vRU9BtdoeiIeoRHp4orMESGlbeZxUXG3CCrgzVk0e1pab0NrehwQ23+axMxFipya +t6mi8Zrxpp7eFc9+ozp+7r4cH//uw8+IewQBFggAIwUCV2pF/xwccGF0cmljZS5s +dW11bWJhQGV4YW1wbGUubmV0AAoJEBOVY2gqAg0Ko1YBAKVC98xZvGsNoaq0yDHG +AJKmsvjnc8z3qmEHzGtxOQCiAP92ffXZr0EM4qNqbDR0EAws9qNo0XlDPcm0LDxy +0JVcDw== +=Ta4l +-----END PGP SIGNATURE----- diff --git a/tests/openpgp/samplemsgs/clearsig-2-keys-2.asc b/tests/openpgp/samplemsgs/clearsig-2-keys-2.asc new file mode 100644 index 000000000..992f2baf9 --- /dev/null +++ b/tests/openpgp/samplemsgs/clearsig-2-keys-2.asc @@ -0,0 +1,20 @@ +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA256 + +The very remembrance of my former misfortune proves a new one to me. + -- Miguel de Cervantes +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 + +iHsEARYIACMFAldqRlwcHHBhdHJpY2UubHVtdW1iYUBleGFtcGxlLm5ldAAKCRAT +lWNoKgINCubRAQC0VyMKKFXWWxLOwCFO5ovhONxq2VLQ6c7jklZt0AAETgEA8ikc +doPxIamOCta2QwgS0JHPhvgmL98GWM1dMLfD3gOJATQEAQEIAB4FAldqRlwXHHN0 +ZXZlLmJpa29AZXhhbXBsZS5uZXQACgkQqkPx3Mf+0beYKQgAp60uW2OmVAyaP2MC +F6alWqWVkxw66L6QW6ciOpiuqjEoc9TN6pNIIP+MeSPu+SE71kw4nD0Vvu5mgH/2 +74dZMf7vFX3vERL/g8u7lTOv2GkXyKpFKAwvMxqPJ7zKUH9z6LxeBc2tNImjQ4mS +7OL30n+SPrsY4FR3BS/d/EY2y+L9spi92oiJeXjgNHH7iIr5iWiSSXS7AwBla0zu +r+mkX2Aats488CEfENACugg79q7cNLpUioeKdOHcqDxCS9wSpYK5Y2+IBqmFEv6t +DKZ1iZnLlk6rHpkZ8aQi96PFbZVZPGnxsOFKkNPWwHjniKeJzoJwd7FqR5i2vrsJ +UiWYwA== +=gWAP +-----END PGP SIGNATURE----- diff --git a/tests/openpgp/samplemsgs/enc-1-key-1.asc b/tests/openpgp/samplemsgs/enc-1-key-1.asc new file mode 100644 index 000000000..bd653307b --- /dev/null +++ b/tests/openpgp/samplemsgs/enc-1-key-1.asc @@ -0,0 +1,9 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +hF4DkYWHjk/NdMASAQdAPDV6Y3JTfAGDX8pfZcT6YggC7qV3g8B1ezijcfIcdVAw ++hCFGXS1EikBbZ21v79GtGh6Wp3fmyZFRQcsJZciLE/EFcbf9Mv4Q2qfRhKYHlqj +0lwBRYQrwTJbMNspOwd2MidjYYUxb/02PNiqZSrWUeX0iPsgHFToJol9RVAqs4Zz +bZNKL6y/GeRIRZY12Lzo2TIXSLfjvbMTdkoz53mMKiUXsi/fCKXkTmgIheni8w== +=kmqY +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/enc-1-key-1.gpg b/tests/openpgp/samplemsgs/enc-1-key-1.gpg new file mode 100644 index 000000000..6f0fe4fc1 Binary files /dev/null and b/tests/openpgp/samplemsgs/enc-1-key-1.gpg differ diff --git a/tests/openpgp/samplemsgs/enc-1-key-2.asc b/tests/openpgp/samplemsgs/enc-1-key-2.asc new file mode 100644 index 000000000..e9e6e7040 --- /dev/null +++ b/tests/openpgp/samplemsgs/enc-1-key-2.asc @@ -0,0 +1,16 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +hQEMAx13dhm+MQ15AQf8DKnGFmadCHP3k8blxdRa73pC3BL0fn9YSp2+EvKP7n4Y +KsVHmKSZ43RL2pq24y5CImLCu6gPkyFGzTn/vmxq8E2Ul8WOvyJiEuRTczNr5NNs +rZiF7dRMSjeZXCEHme24XIXKGzbnlkALHxh83GpgxVmLqKIlHEjgXYn9fneH85M4 +KTBxIxpAhIKzninnGk2ikmAS2C6z370tRLYP+tQ6gcP8BbehCZFM+TRqyS3aXjdq +WaV3OgY7uWzj4P0PBXBWx0V829tfgRF9Z70Zx+HA1BpOqvmOcsztah1Jq/pyAaeR +7t2FunUZuUwbBIYg67/cxStYAXF9ih70tjSRfYBiotLAEAEvZfW1G7lMnfFCWxx8 +S8L+AD+BEdycI/kUZhgxFVde985CSYcpIcQZE4IuTYCoc96ZXsvil5Zlf5I//KDz +toq+bxa+VU4Gr+h4lbcq8Sj8OPkx11/P4dOyydiYKLqEThig5l/h5IiROL8AvIMf +TpNhu8TnECbjaEDaDt3RE3vIFP7ZV8zfpsibSFDaK9K0UhniSt/wF4NekBltUcBc +kozlxWbvQ0k3A+xl1dBCBEpFaJrywRYFvz2sY5ISJS1X3ePJ4c9fsPXePTiy9a3W +ItE= +=rFeH +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/enc-1-key-2.gpg b/tests/openpgp/samplemsgs/enc-1-key-2.gpg new file mode 100644 index 000000000..c62b63a97 Binary files /dev/null and b/tests/openpgp/samplemsgs/enc-1-key-2.gpg differ diff --git a/tests/openpgp/samplemsgs/enc-2-keys-1.asc b/tests/openpgp/samplemsgs/enc-2-keys-1.asc new file mode 100644 index 000000000..abff59621 --- /dev/null +++ b/tests/openpgp/samplemsgs/enc-2-keys-1.asc @@ -0,0 +1,17 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +hQEMAx13dhm+MQ15AQgAkI1KV+RVcuDJlzwXShDT9d2r+1GlV2r16z5vp0aDLETz +Ga+OCTSiDR8So9xqM8kNKp12t2OrhmIerYu3dHQxZAWuqbhj/xkxfh0OyAP2wZb4 +MtwXIcRKWgUz5pUPYcp/7+Eo/dlBs1QaqxF8Lnh5jAlpxDeQvfSgjTZicZAS0rtY +XONLWaX4nuuHb2DNrQWLDsMvDrwu8fJLPMNy7+tEzECs1G7Tv7D9xu/QHbGw6Zvk +fxjWlLsD2nUQYwn/GpqitD02y7BHDoZKXIO8GccHdPhPOxZHLCiGIHQ7r61ResHA +3SlqEsNF9OV81RaIg55ndM72ZLbDTC8ZQDIu/5cXaoReA5GFh45PzXTAEgEHQIFu +PbA2WmzBGnzmBfXmRg8AVKE2JVvSYLjBynfTPbtKMAUbz9U2grH/0BdZPWaGuYUh +HNPg9vmmzL5Ch3rSSunzhtxadesh/Gsic9ETkFz/d9K3AVzb9WEneFuEkk43lJAu +X+btUyQ8rBhkmBQPorvZN+1i+NL0XOP3UJ0iIpo3bn/J7Dy9IEDojQAFtdOBuw6F +hbWOMoRVodE5aA6JcRDR2HLj68X3TAou91a8krHJ8NAK84ilrZd07XEwGtNbaom5 +rZK9xNFIUV0Ddog6r5rJ/pqsN6o3iEYI2uhh0KYntbIHrRD05ZWRCXhQIGPb6qp8 +wEEydtbQpfJFRru8q7Y0V6MlzYflxI1H +=m6X7 +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/enc-2-keys-1.gpg b/tests/openpgp/samplemsgs/enc-2-keys-1.gpg new file mode 100644 index 000000000..1485b0430 Binary files /dev/null and b/tests/openpgp/samplemsgs/enc-2-keys-1.gpg differ diff --git a/tests/openpgp/samplemsgs/enc-2-keys-2.asc b/tests/openpgp/samplemsgs/enc-2-keys-2.asc new file mode 100644 index 000000000..ec6202ce6 --- /dev/null +++ b/tests/openpgp/samplemsgs/enc-2-keys-2.asc @@ -0,0 +1,16 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +hF4DkYWHjk/NdMASAQdALju99o8iXdJNYTuUNrk3ZgfLNvw4GuaLed/2PDLbLUEw +LaFnwh5u4djUOPPtZHbNzmJimOobJxYg3gwDew3ERLBqweQqRcqFaypu9+Ss86Df +hQEMAx13dhm+MQ15AQgAwHCbQ5TeyLGsrs+oC/dB7AZphqWwsSoVXTuxAi3NPbEF +upvp3mu19HpBJFXijsjysaMbwUGB+DRVhMYwAANfnJJ2oxltNbhMeGic/vRsCjHx +cJhjv/T0Jc3Yuh3YFlp4V3wMiTa7METMBL/2CQtT+MSQbBubkegcNPBkB5ss1civ +WpQckerDKtv9ik0+gvYCgHw0wLyf7UmHRekiJigUats0IhEHoZYv/qa3kvcmJaKV +WffHsOwxoS0jCwj15eV2YHQVJp7nnyxXlX9E7z4gzjxH4MbXpi+tVvBLGM8pHEg6 +EJ3U7koABqQ8446CnWC+OJKWO5cHoJjkOSCGALDoENKRAenz/t9qGzMWPInAx2iH +lNg2brHS7UM8z53ESeqpYfaHS1QiMvtZWo8Wl9QPJa8vfrDw/bCtNALYU/OHw95N +k9E+/JgWk9oQFc+syNHDJzw0qfEzblxzng5/d6W8vjggFkIrKwMwE1/6x1w6ZLoV +MYG0TXjnLNBGzGCFRSoDx/RuzybgdDSySV/6OFfPAMSo1g== +=iPxe +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/enc-2-keys-2.gpg b/tests/openpgp/samplemsgs/enc-2-keys-2.gpg new file mode 100644 index 000000000..a2889cb27 Binary files /dev/null and b/tests/openpgp/samplemsgs/enc-2-keys-2.gpg differ diff --git a/tests/openpgp/samplemsgs/encsig-2-2-keys-3.asc b/tests/openpgp/samplemsgs/encsig-2-2-keys-3.asc new file mode 100644 index 000000000..e563e8df9 --- /dev/null +++ b/tests/openpgp/samplemsgs/encsig-2-2-keys-3.asc @@ -0,0 +1,35 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +hQEMAx13dhm+MQ15AQf7B8SvOp1oKADLmqzPCJp8kLUvt2oemNHYvSU06gTlTT8m +DGJnA8a4S0+3q3Oqt/CObBX5tNr9KIB3OOgL8LujUffFVo2A6qfBWYnpyrDeJQOH +idilyZvAu4CdovVvp+2DxAfBYNb0jinIjZEcF3YuIFqk1o5n9Jx0C3LDMgQwjKkb +xEZeUkjt4i9Pb2JNP6+LQ8deDwLLcpS5ykP98MTHgG1OGw5QX1xxKArEq4YJXye3 +ubQBAifE3fGKswGiV5UuwrP3cB92KdtqYLCckrheDa96YJp7kZNDPFds4aqaD5i4 +Ps/bxXeZmeybhgxTT8Q1Ld7wUd+sFV36uRieHOMEIoReA5GFh45PzXTAEgEHQEyw +MoBXgqtfF8+TdiUcIqeH+eXNOHjqGujt00BRn8JTMJNuCXoMZDmu45AaXZqiYxov +TTfDyKGLVvaiTxEJdl/ty55X9C9ANppdFm3qZGZ6GdLqAQBRsaHHa5lSfUBrgJXC +DLidkt1TA0u7owjuWRkUDlzBt3lEcgYEFd6c2zy3wxljpU0zB/gEmlEQiQAYB9dR +alrnENgo93aExGoTW0LgsZlf1n8GuPCyK+3m+1+2ryr3qNreg69Y5HaW3aV4pEG/ +mMnxVffq0sJGtEQRAx8dESImO+jPVmdKx6JcGWQ4B3RmD3qzOgbGwRoeC+C/isV7 +t+VEC0iOlC+QyK7S1QgxcWwzl9ExSs1d+BM3cwNlwe2mLckgsayEUGXrafpifiTR +w1CSyt25fb23iwOu1XZeHGnth/XAAJQcUsi02E+fpMPyS4S0v71PBn8By7iXHE8W +stFZMP9Gcly6lh9qOFg108P+mIWOVj7xtCUMl0RRwxS2hrKypucJtPSmVZ6EgVok +8j0tNm5nSjLzQ4A8I+O20Tx0sPBjmvH3IbMNCvjAQp6gXYlDgiHv2zxAgHwNJjRh +ft1AJy/61HG3MtRNV1QP06l6tofGAzP4gBBqLJkVcK1bCGpx17LZ7t9GI573Y7Jr +CIFN+CUWqzN64Q90IMDFwOl2ghQGZsIRh0jG3wOjd3C5cFo176BJiAq5WVelVEO8 +A3J/xMofeDdAVTkbpDpW+rE66I5dBwa8s9ej1zTpM0hmbiON+Ld9cCW3VPuDjjj3 +pAndSOcbfoq0Qd1RwshQVpfJJYjuhz9qCdlp392KWSvwTD/YuMIZ+nudgxk9Vbu/ +Z3ro/ggyH0FmnaJ53GnJ3NjsiJkSbQ21fSw0zJDNabpwdVPSzSvPtflh1qKiU60M +eNI/QI6lKyZzwFCuAkcZKGWGQrDLjmbRtSMJHAw2cT1sQQJ5XtciiL+pOixawyNE +pTnYI4f/983JewwweUwFJ5GkD/uY6hM10b4OKpjjm8rfpBVmW8rsuAGa5sSOAZB4 +xt+u6/dzVDCdQKtYV4pQHsHahAAkIGT1pWi0PMyWM3deo3sGaiCGcpM7qpO2qE4b +paimL2Un0J1qPkr4cbykzzUx4U1zgHUHKDPhmSEtqLfPEd2DjUHsAvJZJFER4lD9 +yursATLzunEYiWUTuE6DKjcfQYPrAmat/mzquvf+oV5YgPvcY85U3t1XeyW9Zyip +APYSJdgYdN8Wemh21vvGj8B7xnWMaJlcbsCbvuu2GALUGQKbhYzV02lMPSbEUHRH +pRI8NviMcR4UD0/FK7g91I7yDqX6BLBckUw+W1KYKqVvlcMuDUOc5nQTxWXrPWJu +o6EU4sD4bDaFOdDW8cuSBhxiifU+I+1s89p6+6M/Qwenh0hTvUsQwpUx/cXwjNXT +0uRaIk/yjbEZj80lTKyAn1TvlJ4A2vYjscqfiiVYBU1/enfnsYgUf+TTK2qm3TtV +HiuLLNvE2uy2IQfeZ3DnzZlMoCY8PA67yQCxJXR/hVX+/hzlZ0PoPylkYejs +=yD/C +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/encsig-2-2-keys-3.gpg b/tests/openpgp/samplemsgs/encsig-2-2-keys-3.gpg new file mode 100644 index 000000000..b262d458f Binary files /dev/null and b/tests/openpgp/samplemsgs/encsig-2-2-keys-3.gpg differ diff --git a/tests/openpgp/samplemsgs/encsig-2-2-keys-4.asc b/tests/openpgp/samplemsgs/encsig-2-2-keys-4.asc new file mode 100644 index 000000000..1b63617de --- /dev/null +++ b/tests/openpgp/samplemsgs/encsig-2-2-keys-4.asc @@ -0,0 +1,33 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +hF4DkYWHjk/NdMASAQdAtNe4V9DKNR+N65wm9hJk8xRewYZPhmWADCcFraD0rnUw +MWX9tj1E6GIKEhCAMomt/PoboZ8ncBJ4JZ/x4fltX5qsfIZkVqILolPAzrp5EbeE +hQEMAx13dhm+MQ15AQgAkQn04BIdVZ6w0q13WfIoSepk2aQs39E6rmfZRUUs5Axk +aTkHLQa3jSIpWXtSdrm5DBX0rhuNSiFk1h2pwc0OSnIhl6jxrjX1TN4dbXrtaJUz +rguevhF72sfksr7p5sy/yFF1DBv3Z6MRKyyt4FjpbhzczDU0BD4cz0IGMb5tHLB0 +kTS1pJYtkajuWEGiyfT2dR1g0SdNoVwXiu+Hw+buPabAdjgVKocyGmdbYr/ip88t +9o9AayTN2BH0z35YBwpdULcoM3Dww+sTcO2sG6xiy7E24t8RPFUQOfFm5vfmI8EH +Zy4nId6ZkGEdkzX2UkU6FvX5vvru76My07nqKENDBdLpAXp08EPSUkTgnl9d7Hyq +R1jMFiML3/QtMH7azdmjKdmkhrYPMgNoAiK1lO7pw3dU4eHfWDnPUWw8y/WHmoUT +lxtZunT8GUh8ZxXl+skOqy2UXHPPRSN602oqma+yYKZrzn8hQm7Rq/tbmFPRTE7V +cPCuRD0u3Rwnhldq//r5w6AgG1jKu0gXXzLYcubEl7S8fvXG/udSg1ASjhdhbYPD +larTKCby1fESurfhwFnyaIGPknpzGooGFU7sIkrjilNPfVGv8CC10yMp7jOM7nXH +hZ3w6JNHzB3UxlVjOjUkXFRxm3X4ydNXFgrp8soGyOnhjcUcN8A8gIXJoDQwB9G1 +STIilDwsBzFJOZfJSdy0/mjecvqT2slFsl3fjr0h0M2cTsYw1Ws5iG17HTJBVjpW +frmWVjGVLRXkLGkumNbLpGxImlz2wlvuSlk/mqgrbRyyz6ifEpQc2o7uFvT6BGTp +pG6qPafKLEAOkfOZGt/BKMsWESoOXlIa5B8B/4/t8me0Lni7RS09908ait1poKEM +cDYNPtClQlBLJB3GLxPDDUT1WNcEBc+vScU317S5BRgDXBdao16DLzoIoh0C8kYu +JBIQvXYLw23IBilHxzv0Fr/ta2joAUOnojNZMAaOawWj8i8/EwO2Hl0epx8Ww3ft +VMnCF3nVuAIhjYEEzYI90dzA35lcSyEcBDXKBUAnOLi0LhwySi3rzM/d0yxdDGZH +oPw2JQWpgCuv4OMin5YSRowUPhgFmltNc9I6qgVdy1vLKndC/OnCCtQj2OpUrYsH +l1H3ADreaiunjtCrFTGYLey4EK6koLcb+qdKAOkRTaH28nRQGEyzZ4U93mbTsNmJ +nAW4JCbZtMap9on9koJwiopEA+ONuktCD0j6RSAC+HdyhwN+MTWqCtTbO/tIvaqZ +HtAlhiHk3GSi/qaox5dLKZqu5pa92OwiZrS6vS+dWTQpmyCyHYZcglsaRiHAGIEB +3MVPKMvLgp5wV9uuSnr0aXaXoyEXjjMHbP8UnAxojnVxGJTOzsijE59ovddLgqUD +81jYd4K3XIX+aWy3GicJaiAgzOYwJzBrOLZFGIlm9HkXKwM2gqd6TNjKQHxS63o0 +H6vXirtZmnRfA2SnmkGACbwTEa7vKARt4W45rXXk1GiQcxV0U7QrdQ9jMHIPtJF+ +py8jqdfjnNsUNM7PyTVjB9nTk9V3BkwIjUs46R6LqElZsAQQGcVo/EzBoPhjNUaf +K+I= +=kQLr +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/encsig-2-2-keys-4.gpg b/tests/openpgp/samplemsgs/encsig-2-2-keys-4.gpg new file mode 100644 index 000000000..940a96458 Binary files /dev/null and b/tests/openpgp/samplemsgs/encsig-2-2-keys-4.gpg differ diff --git a/tests/openpgp/samplemsgs/encsig-2-keys-1.asc b/tests/openpgp/samplemsgs/encsig-2-keys-1.asc new file mode 100644 index 000000000..649921e58 --- /dev/null +++ b/tests/openpgp/samplemsgs/encsig-2-keys-1.asc @@ -0,0 +1,18 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +hQEMAx13dhm+MQ15AQgAiZPJa/zmtJ6cDpHVze6zBS+4OCbGeEpzcHBkpWiLKV91 +6CiwLTtL6Fhs7P/i5lEUzWQnRp0IGmUe8Ft5tugAL3ibv3Xm9PstXPZ2Q6EGzDCY +98x1aQooSuiUwIB4uQ8zFqA2TYGNfRcDCGdHHLpWAps4F/QkZkQGEWmy7KQZetc+ +mLP6z04fQz5XemL0MaJcarLRE0OK8FI4+413DqQB3RyZsMFiFDAY46g3rA7xymuo +Elum8PjMDXtAEpYAs2NHR29okFMinB7rR/DFGabQtzWIJPlgyGOFUVXs7YWj0Git +SgEje73u8eEYAJYTpud1zup/KPUYOqJzyIMvOHDMz4ReA5GFh45PzXTAEgEHQGSH +2coczePYstzayq418VjtNF+0ohoFKm8lrR9THREYMFJ4oA6/e7r3g38CWlb8kKxN +butxPKCcO2OjZYU5PZMk03CwbpSWM0FTNJEzXfqdKtLAOgHgccG9wgBqAbcTejiX +FQBBsLXRybq8Bra8qW+RVJ5noCav3TH06h8ZVXz/jJMLSUfKt8l+xRQDkYZ88cN3 +GhWNSc1eBOjS8e3JwGYaGs4vuoRVECbzee1DWNk3CUQOgeqZKLoSYHDRwHMpzP/N +suXLpGTV7EoN4+qOcF5q/6cZV4gaGxgokoCUrM+IYfhOjmqK3lfo9/1GUxppyE+x +XsWKiUMta3tJ6zhWYJPCZCqIZvzmkSfk3pNtOnsmmhF9gzwN8ehi/FHGFyHc8/gW +qxx0KsCG7FO4Y514pdoa70KqA8QO63YjxTaFBH858yZr5ORlhzElwctgivU= +=cWGf +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/encsig-2-keys-1.gpg b/tests/openpgp/samplemsgs/encsig-2-keys-1.gpg new file mode 100644 index 000000000..38ff6b6d4 Binary files /dev/null and b/tests/openpgp/samplemsgs/encsig-2-keys-1.gpg differ diff --git a/tests/openpgp/samplemsgs/encsig-2-keys-2.asc b/tests/openpgp/samplemsgs/encsig-2-keys-2.asc new file mode 100644 index 000000000..4eee21db7 --- /dev/null +++ b/tests/openpgp/samplemsgs/encsig-2-keys-2.asc @@ -0,0 +1,18 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +hF4DkYWHjk/NdMASAQdA9op1WNWUj4E0PZ2h33tolomYTag75nRNg8qLo/2xfXcw +QrekSuMoLtkv1KO6/tLIohqYYYdZL5cGadTxlBLyIEj32ISVj7El6DxJrmqKIK3y +hQEMAx13dhm+MQ15AQgAnY6drrcce7MeloBIECLSbFIDjKOloUT4xtqspTg3GM1d +wkXtTJOdEm1yLcNQsb+d8ZdZZfYZhotCyMlZ5QQtvf+0XOieb/FlitUI0twAMsj/ +kwjN9dop+KGLZadFoar5A8TBXUz25PfWmwEzz2qSmIPuoIUzhK90B3eGUG6foGzm +1zEAawfyJ9w7XVAV6pNGJWG2LHSQr2POaMbZs/3iqxQl8p2yb25SlKrg3I35UClZ +0FC9Hidw8bZ8/rZCyX9KYtHIENHzqT5+XEpaXwN4hBqwpVgUn6DcESv2BAR7KCHD +ZwRRNVZtUvrftj05UIxAgnSAdK5GAyhLfWjCsH5Q3tLAPQGFdlgyYU9q+hWrrqwW +1tAvUJQpSW97WyK1Aa9RJOLPNpfU1wzRGzzOuNuuqbL4l9OQktJ81Mihh4IWCXQD +4mN7+nvltCm13bANdujRvZstGGFefRiwkBlEQq9uQMM2SVXA+JAff+AvD5F1Ofq8 +DPVMf/WDsKcoTTdqJahk/zoX4yFHprS50tO2z0Mb9souX14+AN+JJzAGQaGRlXXD +TWeEkUXD18HcVzHfooqLUlYYr5zD2f2gNNVskPYH/iP3FGllvzBeQI1NCznAj+Zr +AdOEXHKOkCJmj2RKnxXeOWTJSczoBlQgIQGd/yP/2TPsGesd4SbqFStYuefEZtw= +=hq0A +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/encsig-2-keys-2.gpg b/tests/openpgp/samplemsgs/encsig-2-keys-2.gpg new file mode 100644 index 000000000..6407387d4 Binary files /dev/null and b/tests/openpgp/samplemsgs/encsig-2-keys-2.gpg differ diff --git a/tests/openpgp/samplemsgs/encsig-2-keys-3.asc b/tests/openpgp/samplemsgs/encsig-2-keys-3.asc new file mode 100644 index 000000000..f10e92a7f --- /dev/null +++ b/tests/openpgp/samplemsgs/encsig-2-keys-3.asc @@ -0,0 +1,23 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +hQEMAx13dhm+MQ15AQf+KX1A2pYF9HnvwZZU6kmiOKs6NL/d/8Y+kwfiLot5SnQW +S/2JJm0b7ijyxBOoTyXu8UOqyaPa/eIJWeMqNANExkX83S1hoKfzgrBluzZR4sUB +r6bZ5E26pn+gy+r1RvQJnxUWMX41ux+DSc+oqf36cZ5A4R1Ai6cD9jqW7vE0KINo +jn6Od45NHNG16Q7igH9HgJiOXaibHFyiAfV5du0XB0HxpBlBKIBSV/4ewFUzxVy+ +oR4/3F7SkaUtGwcEi+PUEU26KuYz2ltYA9Ex/yTd59YcYbPTiiq+ynGRpOTgB0ti +y7aYzJVOPWGCKn/TFy69QIoJZgcWTrmUJK39wxFNM4ReA5GFh45PzXTAEgEHQKqL +epFBazPDtJvYGye9GW9gHMSjuTFuEm3yuo6kPIggMBRK/vWfTa7emGniukdA/8Bn +hXrpSZUBab19RlT/mDhC8+CBE7MvEQMHsZvwsEWzt9LBAQFgEPLmrwSchnzw5+vN +bcfeBye2n5STluKZ5IrW4XwZAvmp54w2OI/FDzf5dL1r+KCNiZpcmVO6IVVbEIeL +eZj++YAPDS0cf/bPfWbyfvC/MLNM6IFICdkdlKQ30FC801Xv4OuXvgctjIkZBEDR +CkDvkyrIEUtN9jJaAWjP3KopsCsxGtZ/ZPVU2yv8ekPRZ1paUIb370/NhEz9l2kK +GwmqNm9g6/ekJwIF6kZKoEzncX7cpF0diSTHCyB/CsWc1ncWgn/nktZDsd7UicKP +ypHScloUZfXDiQBcKV+0p6BxYib1MJOFrRbJTu+0Xu3KjcbecQ/mymgfDlkVUwXP +QeGaQNUgQzO+iAW1hPH5Qf8eB8n2DlbqsFEWIXG7B3pGCI0eBWPeR/JpuCnIHMTh +50YOwGqNQLjqRnl6hFi8amSIK5jRvRMzRWYO8TSZaYVh7uLh83cKkSV2e7d2pax6 +CqubZsoiaX71x+r3NaPYf+4hzAQUxPDZET2hTR4GOeEGT14t9RhqMPLTS+f9Ij7D +/LbCpm6sc6eSmbKXZF/XAPpkBmnRIpgqJuA0TgNBnU7a0NEQP6nsicOpviH9SFEL +waeu +=6uha +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/encsig-2-keys-3.gpg b/tests/openpgp/samplemsgs/encsig-2-keys-3.gpg new file mode 100644 index 000000000..144936690 Binary files /dev/null and b/tests/openpgp/samplemsgs/encsig-2-keys-3.gpg differ diff --git a/tests/openpgp/samplemsgs/encsig-2-keys-4.asc b/tests/openpgp/samplemsgs/encsig-2-keys-4.asc new file mode 100644 index 000000000..8937f5e88 --- /dev/null +++ b/tests/openpgp/samplemsgs/encsig-2-keys-4.asc @@ -0,0 +1,23 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +hF4DkYWHjk/NdMASAQdAM+CNEu/KZIBKoKmvE96atl4CEdxThqamGsRt9IgeMxcw +Te0hTUQf5LrrK9MhGymBcB2nCCy0bPtqVhA8TdZ6y3CH0QYMObkbSbIcVnGaVmGd +hQEMAx13dhm+MQ15AQf9FcEbvw9ocsmqrteF2Cu6W2ChxrNy6ay0gcDwvd2QfbAE +muM+OcKrvXhgDikOt3gAv4ES+2/ACzsqIZZJGUVWlrkSXYq9Uon+YX1zeK3BfmOK +GvfLqc7p9x0YtrC8KEeMaqpd8z5bRhpF0ZPF4WbvZyiauDAa62FJiH/r4YngGLoY +2hXFNZ2FFHa2EuobUfJUJwfA7VC13IdvqZ76bixrSSjxJjhntiswxYQI+OaXnEg8 +S/UwxR06GT7vOra1O9TGIHYwTcRGQT/3NHcIO3aJMRCHVP2dOLBMkFqkYf44kGeA +e718nBN1UB7cfgv+n2bj7SYGdlEH0bmmpNTavEsDZdLBGQEcNlkdz3CqdqRhXUek +hoWzCKTzOhIkoIhdyZd0stBlYJ54dT+9470JogkVqkNCWjAP1svI6LprOAR5b1sV +m5ar5pCspumNRfMv6oDjXIsjCaux4zJfJV8XO38wmMn30eMPg1CzbKjhqMW+IfXe +Tn8yxDBVGScIKkmaks6AE1v9WtfBSz+zT8sFe1ZFUMRcJ4+vohYmLVZXqkXGFJu7 +F3j8URhctnGb88h33y2+xglaqptso7XpM91OR17e6Vhh4dNAWB/GdKy4VviVY3W+ +fJ+zoimrPTFmPo2Ag+mveTsnTzmGdy4FHDDQCKE6QVcJPfVcfN0+yiPIOx/XacZR +ZnQlI9Z+iYuN5yEchnVK65XZGQkdK+4/5Q/QGq7vLwaOHkMtItplIsretCGHAGEj +XcCeHIY4pVZOd8Of8CSSPvtcaz4+FbZ/cfKXXf1zjdxg5BRkVvBAAtAYqquDUPJn +qcG7tcUD6pQXVDHq+s0j8BofK9BXjjicrTI64RZw2RYntdbRSqd82offshvF4MJm +72hIMbg5ExZsvdUa+IcRw49PoX/fEhKkmElZCI+5fsMG/NJuTfAtNjG5RbdgrYzQ +eR6eIMr6BnY9ZZQRPbuv0te4di55B+HqmTry +=/grx +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/encsig-2-keys-4.gpg b/tests/openpgp/samplemsgs/encsig-2-keys-4.gpg new file mode 100644 index 000000000..46d2037b7 Binary files /dev/null and b/tests/openpgp/samplemsgs/encsig-2-keys-4.gpg differ diff --git a/tests/openpgp/samplemsgs/encz0-1-key-1.asc b/tests/openpgp/samplemsgs/encz0-1-key-1.asc new file mode 100644 index 000000000..cf534db06 --- /dev/null +++ b/tests/openpgp/samplemsgs/encz0-1-key-1.asc @@ -0,0 +1,12 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +hF4DkYWHjk/NdMASAQdAPo9H2rEUOisFYLfLQu91wGJCSIGs9jFiYwQsKlhsZlMw +itRELU7+unvpPp8bIINqu4X6FP7hDzkZjOlQM/5JS0Z/q2jaWo4av8DCxYCK+yHU +0sATAZtMvHD99HWEAis3GUlFBzf/jxPBmayNElVyifc5eH4d2pRfCqlZPx9gKX69 +OYymTKuUkkmzCgBxVfA7XPdIdqTmDbSjVwQ2LFeB8hQv6PsYFHY1vqs4xVmeotIu +pgG1a40+6f8HC9YDNn2lUzktui/mi/VNqDwV9vOHYklGqpVDd81nHAl1wGkAzgBs +8sYAcQjRAArAPKBaPTCtn6PZF4p4sDcabGImGR8cWwZHb9yxkHIomJRHUVTF1Uz4 +MUANuPQHpJE4eqKHUaE6wyTXyGEqJQ== +=UB/1 +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/encz0-1-key-2.asc b/tests/openpgp/samplemsgs/encz0-1-key-2.asc new file mode 100644 index 000000000..a885f5b8d --- /dev/null +++ b/tests/openpgp/samplemsgs/encz0-1-key-2.asc @@ -0,0 +1,13 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +hQEMAx13dhm+MQ15AQf/WO25gVi//kxCs0RH+BbJ5OWRRkyZ5fD7mYUs6anJ/zRE +SE/SKwNk4KsWi4ajRR7b7txj7HQN8l6RpjUFXDJwd0onkb5JoCcvVIdaSTRR8z3s +5tkI/KTkPhlDPN+E5jCllUnJNSLoUwIIMw5Zgn0gRXxZeR6pUCB00+GmSPpoV+6X +pEk8yuP5gcCFz2uiPmRl6QBezq6QLwlzYS6Kj+m2k2zqgEEgBc31aVnze8FTElbf +Mm2wQ+w50PVaqHKkH7206PMIAd3Jsv2QP4XfgDDRxOe1/s6dHiCOfnhdrx/Fblp2 +VjluZFc/yL2YfofqqEWAxLLzh47aVN6JLr3bhdAVvNJEATedhlr+GTfhfI+KYO9r +rZlP9aDHzvMKkqyX4WDD0O6a+698AnoseFVmrrBIsokdIt1RjLcpycE4BsCQOXHe +EDBJtGo= +=O1Fl +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/sig-1-key-1.asc b/tests/openpgp/samplemsgs/sig-1-key-1.asc new file mode 100644 index 000000000..875cf831b --- /dev/null +++ b/tests/openpgp/samplemsgs/sig-1-key-1.asc @@ -0,0 +1,8 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 + +iHsEABYIACMFAldqTEMcHHBhdHJpY2UubHVtdW1iYUBleGFtcGxlLm5ldAAKCRAT +lWNoKgINCu0XAQC6VSdsGyTbvFPp5e6BmkmBzPcb5Kex4ar722k0jzhLzgD+Js2q +Y1JIdjfW4GnFhdzqyUbuGTlk1wNY7Re1uNyD6gw= +=c0oW +-----END PGP SIGNATURE----- diff --git a/tests/openpgp/samplemsgs/sig-1-key-1.sig b/tests/openpgp/samplemsgs/sig-1-key-1.sig new file mode 100644 index 000000000..9c823cd3e Binary files /dev/null and b/tests/openpgp/samplemsgs/sig-1-key-1.sig differ diff --git a/tests/openpgp/samplemsgs/sig-1-key-2.asc b/tests/openpgp/samplemsgs/sig-1-key-2.asc new file mode 100644 index 000000000..f7ae1209f --- /dev/null +++ b/tests/openpgp/samplemsgs/sig-1-key-2.asc @@ -0,0 +1,12 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 + +iQE0BAABCAAeBQJXaky2FxxzdGV2ZS5iaWtvQGV4YW1wbGUubmV0AAoJEKpD8dzH +/tG3LSUH+gJ++JOZuy5GfHwK+5GEGmeVbex4U9N84tYYAwZOsOpQsh4JxT44IH8S +OG9OViY9xUaUmeSvVsuDR890RiZtKOXO3hCMwUo+HCDFLXgIXxosLlS55G1vfi8X +NPl78Y9NFdtwtAkirpOT0oULJcbZ9NItkPjhoxZ16TlgG3GUE6lZzlZJLFAVCw7u +6twOtPnq1AB4xB49rsIIW1XhCNrajwzBCghhl/PD4uM7ptSpGkZur5uOJ7nLjNEM +Qo1mF+jQ6rjWA4OrvpmtW482yvNWejAS+JMlhNcP63hlBySjX3tFhGm8tWtUauCT +3Ky7iF4dFFmhpIXUBT6mMmci4WdA3gE= +=VdOj +-----END PGP SIGNATURE----- diff --git a/tests/openpgp/samplemsgs/sig-1-key-2.sig b/tests/openpgp/samplemsgs/sig-1-key-2.sig new file mode 100644 index 000000000..a4f5199e5 Binary files /dev/null and b/tests/openpgp/samplemsgs/sig-1-key-2.sig differ diff --git a/tests/openpgp/samplemsgs/sig-2-keys-1.asc b/tests/openpgp/samplemsgs/sig-2-keys-1.asc new file mode 100644 index 000000000..8c767b246 --- /dev/null +++ b/tests/openpgp/samplemsgs/sig-2-keys-1.asc @@ -0,0 +1,15 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 + +iHsEABYIACMFAldqTMccHHBhdHJpY2UubHVtdW1iYUBleGFtcGxlLm5ldAAKCRAT +lWNoKgINCgcQAP0f1yNJcHiBvy3nK7SSuzBf1EgSpy/lFlVSjZ1e/7CEKQD/W68C +Zs8iGAyZplpsXKoz/g7LWSU5z/K3lLWwfre7gAGJATQEAAEIAB4FAldqTMcXHHN0 +ZXZlLmJpa29AZXhhbXBsZS5uZXQACgkQqkPx3Mf+0bdg8wf/ff4tEMfqdwk1dXJm +4+iyrNvKyCfv/T5W8BVL16wc8jn+80HJkHK/pSw5Rr6nsEf1P00u5AnothUPfUl2 +Yqvjg4+oQYvutePo1uLq0LA1lyWfQ1PV6I14B/dd9rBYdPjYIJJsPjr/k5N3Qz9M +8RNtDp/rPDVNVHzDbZN77oGE2jokGRfodRo6qnurqU4CnJYinrnzKV4wqrilNKlE +R2CBieb3riDFUH59PH9S9fHuTHBV7q0HlxNJkI6NeoFwtRcS2f8P5B7FK7VCMrUB +R46JExeWhvUlY2ZkKLU98bI3TLnFD0aQHRzKgJj8sWjD+Akzf408EmnOIyyf6MF8 +H7uIHg== +=ErBQ +-----END PGP SIGNATURE----- diff --git a/tests/openpgp/samplemsgs/sig-2-keys-1.sig b/tests/openpgp/samplemsgs/sig-2-keys-1.sig new file mode 100644 index 000000000..541285f19 Binary files /dev/null and b/tests/openpgp/samplemsgs/sig-2-keys-1.sig differ diff --git a/tests/openpgp/samplemsgs/sig-2-keys-2.asc b/tests/openpgp/samplemsgs/sig-2-keys-2.asc new file mode 100644 index 000000000..16ae64c8b --- /dev/null +++ b/tests/openpgp/samplemsgs/sig-2-keys-2.asc @@ -0,0 +1,15 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v2 + +iQE0BAABCAAeBQJXakzUFxxzdGV2ZS5iaWtvQGV4YW1wbGUubmV0AAoJEKpD8dzH +/tG3B8EH/247hq+cJ8eR8eXb1mv1Bdj9SwYI4yDs/xCZ7FIkU8vVSRYQpeYz59ie +3WZw8Cj1Sd44tr3+viVK682lWXwpHIAl3xUizP+HTFs23tfyH3er7IhDO/aApZ+V +Wd+0oDJY7E/ztsD3CpU50ptKU9D72CgJT8K1/pwBtivzOiMto/scPwVFNDzGlny8 +FC06j+2FyXFkXCLwvz/Xdk+hJmv8lQRGNxnSIB5bU+0/GLEd9wJUFTV3WSs5enEM +zqtGBh6v395BXnqrDHpOmT+EkWrpBOSo5vkPZrbN4bOC9nKSa9isCvU/+fjHW3Dn +GpHVTH1hCWsKRhQjxuOOq/X21YpvgJ2IewQAFggAIwUCV2pM1BwccGF0cmljZS5s +dW11bWJhQGV4YW1wbGUubmV0AAoJEBOVY2gqAg0KPJMA/0+3s4HPotwYw8K8pug3 +7Mxgd9LNIBi/d0nSpBnZTHySAQDURAoIZp0IZI/PS7Jc9A8M3TgWdm1LUkj+qU9x +3L6RCQ== +=3oWb +-----END PGP SIGNATURE----- diff --git a/tests/openpgp/samplemsgs/sig-2-keys-2.sig b/tests/openpgp/samplemsgs/sig-2-keys-2.sig new file mode 100644 index 000000000..187e22a32 Binary files /dev/null and b/tests/openpgp/samplemsgs/sig-2-keys-2.sig differ diff --git a/tests/openpgp/samplemsgs/signed-1-key-1.asc b/tests/openpgp/samplemsgs/signed-1-key-1.asc new file mode 100644 index 000000000..d71c74d80 --- /dev/null +++ b/tests/openpgp/samplemsgs/signed-1-key-1.asc @@ -0,0 +1,15 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +owGbwMvMwMG4yvnjneP/Lm5nPJ2exBCe5XbZI7E8O7UyVb1YwTk/LzmntDgzP8+K +i9OzBCiSl1+ikJpYXKlQkq9QkJMIpDNSFZJz8svzFMozUvMUKvNL1ctSFdKByoAq +ikrzwArKM/JzUrk4kzOLkkuL9bg6GU1YGBg5GORYmUD2icsUl6SWpeolZWbnO6RW +JOYW5KTq5aWWMHBxCsAcl9zJ/od/6lrXa9snvZR9wrpXuEblNq/F3pzYWed8DZd8 +aApUzgkTy1K64+QU7HuL525G4vM3Yibfvq+VLTf/aFx46FSc7I2MpE2vElhvztZ5 +8SQ2ZWe7m5apT9qu7UfXyhrxxfutyt+ot3daXp3hyxuVPzdfKD147N8djoc5634y +6n9Uvfa7Uec030zZjae3VHScMDY1tD7yQjrFNnXptYQXP+RPtD1l+Kn33I87jeHT +SYnUk8r3zD71zahJbfZYwem0c+WbOzs/+qQeKeE/kaL+Y8GHeY9vbkq6eGNKWag+ +Y+Ydhac6bccZHEpXHFBfy3iBJ9OrZub93Oulx4Tnz5U5tZuL31VZOSzlyESvoJeb +/0kDAA== +=T94L +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/signed-1-key-1.gpg b/tests/openpgp/samplemsgs/signed-1-key-1.gpg new file mode 100644 index 000000000..8ab90c13c --- /dev/null +++ b/tests/openpgp/samplemsgs/signed-1-key-1.gpg @@ -0,0 +1,6 @@ +£5RkhTGÞ´‘ì½¢ø£â¶]ä¨SÙLÖÇF_1I£˜õA|döîlîdïάwæîfUÄZTÔ¶T#Z m}‚ ¢±?DÉ[bÚþð–ÈBµ>óCDÑöÌ.þ›9ç;çûÎwÎã>öùKN/yy¯çýðå’›b¾æÖº£kl +ˈTT*XJ”(hà°Ä¦Rš†NÆX p’¢.x…á¬p8ˆX +LB‹/Ë\Ê-»˜1Sº¹[iض‰¸Œ{.ã-03R݉Hˆ!/å@Á²y.¤D†b2Ä\!¸dcËÉâÆ+êI:Í +HÒB“0• ÄëˆKÁ¥–pã4„ÇA +³¨–re{’¡2 )’+ ¸T®g)¬g:ØÂY‚YK8IKúarK¤R™8;~êÍr°EŠJ²¨®8“C¬d·è dm¦hi̬¦Šh8ª¢qqµiTÕèg´*„ñÆ°iT# ­©˜W³L#¬ WU#³M£YwÒì¥KÖÂ%š†Oâ°-ÚZeã $XBÙ3p]®‹ñŒp2Ô¤ k7º‰bßYzS(}Ôó9Âá´›=J9ŽeTTÀjEÓš±‰94Sõm,"©¡õÔÌÂ;bŽ‡‚¦š{KÂ¥¾¿oò˜ô‘M +âz2´2Æ’b!m#©´C+9U>Ó˜ðá"_u”½Ÿs²®kÆ'_¶æË—?þë»îÞOäËYÚ;Û|;¢v~›Ú9ÅÿOà«k Ñw‹>oÔ¶ö?\ÙÑÚð}Ç †wº³dÚKƒ3ÿÜŸ]÷Ç®š¶oý/½³g=¼bøwwN¸økUòFp(–º:r!”TçÞ+«í_¿`܉½¥Ùg«§ ¿ú÷ìùšÏvµúúzïøïÖv®-ý:> ÍÛ|áÔ×ûGWÚµ_<Øtý~ä@¤ûОŸÖmÌ ö T ¾¹óøö5údëÏÁ›;^È[ûGÙñmyþÎ:Tî&ÊþûíÅŠ CÆë[ÎÜ…Ýj{Û™‘1*ÿ–_ÞuîÈ%1òû£ÿ \ No newline at end of file diff --git a/tests/openpgp/samplemsgs/signed-1-key-2.asc b/tests/openpgp/samplemsgs/signed-1-key-2.asc new file mode 100644 index 000000000..64483fb7a --- /dev/null +++ b/tests/openpgp/samplemsgs/signed-1-key-2.asc @@ -0,0 +1,12 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +owGbwMvMwCEmPDU5Q4uJl4vx9AG9JIbwLLcnnCHl+Qq5qXkKOfn52akpCvmlJQpp +Rfm5CiUZqQoFRZnF+XkKSYlFxTpcnP55qQrFieUKuaUpurpcnCFABflAVUVgweIS +oCI9Li6//HKFnNQSoJEK6UCqJCOzWKEoMz2jxEqhBGgTxMTUomKFxKJUsJ2Zeelg +S0H2lWfmpeSX63GFZ2TmAA0H2pefBpLIVShPLIarTixRSMzJAWsAOkVBVxfMhDgF +pCc9v0QhI7OEKzMPLJGRmpiix9VRzcIgxsGgzMoE8rWMTEFiSVFmcqpeTmluaW5S +okNqRWJuQU6qXl5qCQMXpwAsoD78YWRY1rZ/7kOLr4GrbvSU6HqKnVy6+1BllLYd +c5ebbu2ltZ89GRkOBN6327Z+J4eaa5ppOGeA08P8xgvlcft8tz5u9i7jncwKAA== +=uuW/ +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/signed-1-key-2.gpg b/tests/openpgp/samplemsgs/signed-1-key-2.gpg new file mode 100644 index 000000000..23f045701 Binary files /dev/null and b/tests/openpgp/samplemsgs/signed-1-key-2.gpg differ diff --git a/tests/openpgp/samplemsgs/signed-2-keys-1.asc b/tests/openpgp/samplemsgs/signed-2-keys-1.asc new file mode 100644 index 000000000..38d25b113 --- /dev/null +++ b/tests/openpgp/samplemsgs/signed-2-keys-1.asc @@ -0,0 +1,17 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +owGbwMvMwMG4yvnjneP/Lm5nmADiiglPTc7QYuLlYjwdm8QQnuVu45iTo+CWmZeY +npOq4JNYXqyQm1ipkJSqkFRZkFhcnJoCZCjkpCYW5WXmpSuUZKQqFGfmFgDVJhaV +KOSnKaTkA8W5yjNLMvJLS4DymXnZQAE9ro5qFgYxDgZlViaQJTIyBYklRZnJqXo5 +pbmluUmJDqkViSBj9PJSSxi4OAVgzpoVw/A/fBVnTGzGFd0DUzZcu6HNcm/6mpaZ +CeuOc+89eOsmg9YGRYb/5U3LTx4pf5Ru3ceW/X+Vkdq22kuGCxqaVwYJHZSL/xfN +08lowsLAyMEgB7FdXKa4JLUsVS8pMzsf3WJY8LR2sv/P9VLy+VZyrvhebd6WMyoz +V/kIXW+p2WbcI1vw58xdofBbU9eHtM2Y47ft6Bm5bS0NL6d6zzl7YsfLl5qKLFJb +s/cVKFe1MM7POqrEqzEr7cqe3amsN08ntDsvbLr3tc1ATKhTgMVKMIhjznseR54F +L1tyl7eUv96SYCbIf+uzu5vZnjWHvulP1zm579qel7afa77Enc94Nnn+U4Xf7F8W +PA5Kumj01S639ux3PcYFLR9+tey0bTDyNPhkqiddvLY9O8ztd94SDw4ph4+bbol+ +5S1+5dJ1vl1w7VSbtSf5dPfV1uxLr7UQnvGiwplnVpzt8XOvFXbHZ6yx2Hm52Kry +0TndFZfZqkRzFGxn7bkOAA== +=iswv +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/signed-2-keys-1.gpg b/tests/openpgp/samplemsgs/signed-2-keys-1.gpg new file mode 100644 index 000000000..ebf677129 Binary files /dev/null and b/tests/openpgp/samplemsgs/signed-2-keys-1.gpg differ diff --git a/tests/openpgp/samplemsgs/signed-2-keys-2.asc b/tests/openpgp/samplemsgs/signed-2-keys-2.asc new file mode 100644 index 000000000..5219e130b --- /dev/null +++ b/tests/openpgp/samplemsgs/signed-2-keys-2.asc @@ -0,0 +1,24 @@ +-----BEGIN PGP MESSAGE----- +Version: GnuPG v2 + +owFdk21sFFUUhqcf4O7wIQQLpi71skoKZFj4wUdrgiwYxVaUFrZUvkzuzJ7ZuezM +3M3Mnd2OEpNiTVGTQlSKUn+A1WjBBFMDRIWAKG0qJYEWhVKgkECqBkrQ8AM1u96Z +hVT9NTmZc573ve+5d8eEIiEwdcpORZtTOEEUdnhlwb5n7lzqzp49XHDqV1mo37xi +ZTC8jjrIAGxKiKjI5QXWdZpBTANkYJuBhRhFMiDHVEia6JJXMgsw85pFbLqI6nGU +wS7iEzpJgi0hbMa9NmLaju73WShOEiZhruSBTeTDXRQHMHyMSpg3oAG2kEZslCaQ +QVTlzcRM2EvDYjBc6xAGvi2FmszClhtByDfv2IyTVOCivhQxGSQsXwzbtmNwhOgd +TMNpGP3p6eWnOGe549v8D4tbMqmsc4pJGZJdkRiEYcZpvkWaMZEXlAycS6jFKVX3 +A7QAJcBkOqCMBrzgnvmARZ2EJolktClFde9M/27iKVOHaaMxZYiuIwsUyuN7FfKj +tpiijAsQvioXZajFNDcvzwfiFGzP8SiC+DXC9/fJU1H5J+YtWhJxPjV/HSqAjlQL +wMsmSZSkf1CeYYQvIDh3LopRA62msswXK6FwNWGcIzsJVAOW6hgQFt8qWFAsFASE +sjGF3u2aFuKCaYjIJEmj0ICNlA4RE5ggBic9uIpd6kPZyjdLVjSdbP+96b2J2rhc +6bKGZXtvnJv+1L7wY4MZdSC06tOxx74KzS7rosOTWn6MbN8wPHT1txnNVwJjRnpz +j7wxs7uxV5+8dsPWRzsbetK3bx0emD0wuWfhJ92pNT8fbNh1oO5O1clXbo9r6u96 +ePDQ3ujiwc9PPP3n+x+t7r320xKnONu3deXGlmhh4+nhDyraXv871ifYtUvGt7Wd +jw0PdexeVDLyS1Wd3tizqXx/y/XpFaj1h7e3dLofJ7+YX8NK9xRFrweaZ/4hvTy2 +dekL+w+tiu3JFlX2GJ+VH6m7cXHdc3drl3//+MXO6tx3E53si32nDo7ULO5o73qp +XbnUG2xtP13XX7roKB3Z9lqxMDUgPJFPLRRKYWYRBSK6YziGjP8f3YNHXV4v5BTt +5qbStev/6ghX7xz/4e4jQ09Wtm5898Ss4LfbmkswuyDkttyc9807ZRfmfX3m+Vv1 +/bO+HIzB9sv3pGjwzHGlv+JZ8R8= +=pstx +-----END PGP MESSAGE----- diff --git a/tests/openpgp/samplemsgs/signed-2-keys-2.gpg b/tests/openpgp/samplemsgs/signed-2-keys-2.gpg new file mode 100644 index 000000000..42741b394 Binary files /dev/null and b/tests/openpgp/samplemsgs/signed-2-keys-2.gpg differ diff --git a/tests/openpgp/samplemsgs/signed-data-1.txt b/tests/openpgp/samplemsgs/signed-data-1.txt new file mode 100644 index 000000000..060720104 --- /dev/null +++ b/tests/openpgp/samplemsgs/signed-data-1.txt @@ -0,0 +1,7 @@ +This conjunction of an immense military establishment and a large arms +industry is now in the American experience... We must not fail to +comprehend its grave implications... We must guard against the +acquisition of unwarranted influence...by the military-industrial +complex. The potential for the disastrous rise of misplaced power +exists and will persist. + -- Dwight D. Eisenhower, from his farewell address in 1961 diff --git a/tests/openpgp/samplemsgs/signedz0-1-key-1.gpg b/tests/openpgp/samplemsgs/signedz0-1-key-1.gpg new file mode 100644 index 000000000..400bcba02 Binary files /dev/null and b/tests/openpgp/samplemsgs/signedz0-1-key-1.gpg differ diff --git a/tests/openpgp/samplemsgs/signedz0-1-key-2.gpg b/tests/openpgp/samplemsgs/signedz0-1-key-2.gpg new file mode 100644 index 000000000..55f3637b3 Binary files /dev/null and b/tests/openpgp/samplemsgs/signedz0-1-key-2.gpg differ diff --git a/tests/openpgp/samplemsgs/signedz0-2-keys-1.gpg b/tests/openpgp/samplemsgs/signedz0-2-keys-1.gpg new file mode 100644 index 000000000..84f2fd293 Binary files /dev/null and b/tests/openpgp/samplemsgs/signedz0-2-keys-1.gpg differ diff --git a/tests/openpgp/samplemsgs/signedz0-2-keys-2.gpg b/tests/openpgp/samplemsgs/signedz0-2-keys-2.gpg new file mode 100644 index 000000000..7e142b910 Binary files /dev/null and b/tests/openpgp/samplemsgs/signedz0-2-keys-2.gpg differ diff --git a/tests/openpgp/seat.scm b/tests/openpgp/seat.scm new file mode 100755 index 000000000..aceeccac1 --- /dev/null +++ b/tests/openpgp/seat.scm @@ -0,0 +1,30 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking encryption, signing, and producing armored output" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg usrpass1 '(--yes -seat -r two@example.com --passphrase-fd "0")) + (tr:gpg "" '(--yes)) + (tr:assert-weak-identity source))) + plain-files) diff --git a/tests/openpgp/setup.scm b/tests/openpgp/setup.scm new file mode 100755 index 000000000..9ad19c284 --- /dev/null +++ b/tests/openpgp/setup.scm @@ -0,0 +1,129 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(echo "Creating test environment...") + +(letfd ((fd (open "random_seed" (logior O_WRONLY O_CREAT O_BINARY) #o600))) + (call-with-fds (list (tool 'mktdata) "600") CLOSED_FD fd STDERR_FILENO)) + +(for-each-p + "Creating configuration files" + (lambda (name) + (file-copy (in-srcdir (string-append name ".tmpl")) name) + (let ((p (open-input-output-file name))) + (cond + ((string=? "gpg.conf" name) + (if have-opt-always-trust + (display "no-auto-check-trustdb\n" p)) + (display (string-append "agent-program " + (tool 'gpg-agent) + "|--debug-quick-random\n") p) + (display "allow-weak-digest-algos\n" p)) + ((string=? "gpg-agent.conf" name) + (display (string-append "pinentry-program " PINENTRY "\n") p))))) + '("gpg.conf" "gpg-agent.conf")) + +(echo "Starting gpg-agent...") +(call-check `(,(tool 'gpg-connect-agent) --verbose + ,(string-append "--agent-program=" (tool 'gpg-agent) + "|--debug-quick-random") + /bye)) + +(for-each-p "Creating sample data files" + (lambda (size) + (letfd ((fd (open (string-append "data-" (number->string size)) + (logior O_WRONLY O_CREAT O_BINARY) #o600))) + (call-with-fds (list (tool 'mktdata) (number->string size)) + CLOSED_FD fd STDERR_FILENO))) + '(500 9000 32000 80000)) + +(define (dearmor source-name sink-name) + (pipe:do + (pipe:open source-name (logior O_RDONLY O_BINARY)) + (pipe:spawn `(,@GPG --dearmor)) + (pipe:write-to sink-name + (logior O_WRONLY O_CREAT O_BINARY) + #o600))) + +(for-each-p "Unpacking samples" + (lambda (name) + (dearmor (in-srcdir (string-append name "o.asc")) name)) + '("plain-1" "plain-2" "plain-3" "plain-large")) + +;; XXX implement cleanup +(catch '() + (mkdir "private-keys-v1.d" "-rwx")) + +(define counter (make-counter)) +(for-each-p' "Storing private keys" + (lambda (name) + (dearmor (in-srcdir (string-append "/privkeys/" name ".asc")) + (string-append "private-keys-v1.d/" name ".key"))) + (lambda (name) (counter)) + '("50B2D4FA4122C212611048BC5FC31BD44393626E" + "7E201E28B6FEB2927B321F443205F4724EBE637E" + "13FDB8809B17C5547779F9D205C45F47CE0217CE" + "343D8AF79796EE107D645A2787A9D9252F924E6F" + "8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34" + "0D6F6AD4C4C803B25470F9104E9F4E6A4CA64255" + "FD692BD59D6640A84C8422573D469F84F3B98E53" + "76F7E2B35832976B50A27A282D9B87E44577EB66" + "A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD" + "00FE67F28A52A8AA08FFAED20AF832DA916D1985" + "1DF48228FEFF3EC2481B106E0ACA8C465C662CC5" + "A2832820DC9F40751BDCD375BB0945BA33EC6B4C" + "ADE710D74409777B7729A7653373D820F67892E0" + "CEFC51AF91F68A2904FBFF62C4F075A4785B803F" + "1E28F20E41B54C2D1234D896096495FF57E08D18" + "EB33B687EB8581AB64D04852A54453E85F3DF62D" + "C6A6390E9388CDBAD71EAEA698233FE5E04F001E" + "D69102E0F5AC6B6DB8E4D16DA8E18CF46D88CAE3")) + +(info "Importing public demo and test keys") +(call-check `(,@GPG --yes --import + ,(in-srcdir "pubdemo.asc") + ,(in-srcdir "pubring.asc") + ,(in-srcdir key-file1))) +;; (letfd ((source (open (in-srcdir "pubring.pkr.asc") O_RDONLY))) +;; ((gpg-pipe '(--dearmor) '(--yes --import) STDERR_FILENO) +;; source CLOSED_FD)) +(pipe:do + (pipe:open (in-srcdir "pubring.pkr.asc") (logior O_RDONLY O_BINARY)) + (pipe:spawn `(,@GPG --dearmor)) + (pipe:spawn `(,@GPG --yes --import))) + +(info "Preset passphrases") +;; one@example.com +(call-check `(,(tool 'gpg-preset-passphrase) + --preset --passphrase def + "50B2D4FA4122C212611048BC5FC31BD44393626E")) +(call-check `(,(tool 'gpg-preset-passphrase) + --preset --passphrase def + "7E201E28B6FEB2927B321F443205F4724EBE637E")) +;; alpha@example.net +(call-check `(,(tool 'gpg-preset-passphrase) + --preset --passphrase abc + "76F7E2B35832976B50A27A282D9B87E44577EB66")) +(call-check `(,(tool 'gpg-preset-passphrase) + --preset --passphrase abc + "A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD")) + +(echo "All set up.") diff --git a/tests/openpgp/signencrypt-dsa.scm b/tests/openpgp/signencrypt-dsa.scm new file mode 100755 index 000000000..baf1def53 --- /dev/null +++ b/tests/openpgp/signencrypt-dsa.scm @@ -0,0 +1,48 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking signing and encryption using DSA" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg usrpass1 `(--yes --passphrase-fd "0" -se + -u ,dsa-usrname1 + --recipient ,dsa-usrname2)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + (append plain-files data-files)) + +(define algos (if (have-hash-algo? "RIPEMD160") + '("SHA1" "RIPEMD160") + '("SHA1"))) +(for-each-p + "Checking signing and encryption using DSA with a specific hash algorithm" + (lambda (hash) + (tr:do + (tr:open (car plain-files)) + (tr:gpg usrpass1 `(--yes --passphrase-fd "0" -se + -u ,dsa-usrname1 + --recipient ,dsa-usrname2 + --digest-algo ,hash)) + (tr:gpg "" '(--yes)) + (tr:assert-identity (car plain-files)))) + algos) diff --git a/tests/openpgp/signencrypt.scm b/tests/openpgp/signencrypt.scm new file mode 100755 index 000000000..b138dce50 --- /dev/null +++ b/tests/openpgp/signencrypt.scm @@ -0,0 +1,39 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking signing and encryption" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg usrpass1 `(--yes --passphrase-fd "0" -se --recipient ,usrname2)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + (append plain-files data-files)) + +(info "Checking bug 537: MDC problem with old style compressed packets.") +(lettmp (tmp) + (call-popen `(,@GPG --yes --passphrase-fd "0" + --output ,tmp ,(in-srcdir "bug537-test.data.asc")) + usrpass1) + (if (not (string=? "4336AE2A528FAE091E73E59E325B588FEE795F9B" + (cadar (gpg-hash-string `(--print-md SHA1 ,tmp) "")))) + (error "bug537-test.data.asc: mismatch (bug 537)"))) diff --git a/tests/openpgp/sigs-dsa.scm b/tests/openpgp/sigs-dsa.scm new file mode 100755 index 000000000..bf5e41501 --- /dev/null +++ b/tests/openpgp/sigs-dsa.scm @@ -0,0 +1,43 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking signing using DSA with the default hash algorithm" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg "" `(--yes --sign --user ,dsa-usrname1)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + (append plain-files data-files)) + +(define algos (if (have-hash-algo? "RIPEMD160") + '("SHA1" "RIPEMD160") + '("SHA1"))) +(for-each-p + "Checking signing using DSA with a specific hash algorithm" + (lambda (hash) + (tr:do + (tr:open (car plain-files)) + (tr:gpg "" `(--yes --sign --user ,dsa-usrname1 --digest-algo ,hash)) + (tr:gpg "" '(--yes)) + (tr:assert-identity (car plain-files)))) + algos) diff --git a/tests/openpgp/sigs.scm b/tests/openpgp/sigs.scm new file mode 100755 index 000000000..c47823108 --- /dev/null +++ b/tests/openpgp/sigs.scm @@ -0,0 +1,50 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(for-each-p + "Checking signing with the default hash algorithm" + (lambda (source) + (tr:do + (tr:open source) + (tr:gpg "" '(--yes --sign)) + (tr:gpg "" '(--yes)) + (tr:assert-identity source))) + (append plain-files data-files)) + +(for-each-p + "Checking signing with a specific hash algorithm" + (lambda (hash) + (if (have-pubkey-algo? "RSA") + ;; RSA key, so any hash is okay. + (tr:do + (tr:open (car plain-files)) + (tr:gpg "" `(--yes --sign --user ,usrname3 --digest-algo ,hash)) + (tr:gpg "" '(--yes)) + (tr:assert-identity (car plain-files)))) + (if (not (equal? "MD5" hash)) + ;; Using the DSA sig key - only 160 bit or larger hashes + (tr:do + (tr:open (car plain-files)) + (tr:gpg usrpass1 + `(--yes --sign --passphrase-fd "0" --digest-algo ,hash)) + (tr:gpg "" '(--yes)) + (tr:assert-identity (car plain-files))))) + all-hash-algos) diff --git a/tests/openpgp/tofu.scm b/tests/openpgp/tofu.scm new file mode 100755 index 000000000..38b6a0f0f --- /dev/null +++ b/tests/openpgp/tofu.scm @@ -0,0 +1,167 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + + ;; Redefine GPG without --always-trust and a fixed time. +(define GPG `(,(tool 'gpg) --no-permission-warning + --faked-system-time=1466684990)) +(define GNUPGHOME (getenv "GNUPGHOME")) +(if (string=? "" GNUPGHOME) + (error "GNUPGHOME not set")) + +(catch (skip "Tofu not supported") + (call-check `(,@GPG --trust-model=tofu --list-config))) + +(define KEYS '("2183839A" "BC15C85A" "EE37CF96")) + +;; Import the test keys. +(call-check `(,@GPG --import ,(in-srcdir "tofu-keys.asc"))) + +;; Make sure the keys are imported. +(for-each (lambda (keyid) + (catch (error "Missing key" keyid) + (call-check `(,@GPG --list-keys ,keyid)))) + KEYS) + +;; Get tofu policy for KEYID. Any remaining arguments are simply +;; passed to GPG. +;; +;; This function only supports keys with a single user id. +(define (getpolicy keyid format . args) + (let ((policy + (list-ref (assoc "uid" (gpg-with-colons + `(--tofu-db-format ,format + --trust-model=tofu + ,@args + --list-keys ,keyid))) 17))) + (unless (member policy '("auto" "good" "unknown" "bad" "ask")) + (error "Bad policy:" policy)) + policy)) + +;; Check that KEYID's tofu policy matches EXPECTED-POLICY. Any +;; remaining arguments are simply passed to GPG. +;; +;; This function only supports keys with a single user id. +(define (checkpolicy keyid format expected-policy . args) + (let ((policy (apply getpolicy `(,keyid ,format ,@args)))) + (unless (string=? policy expected-policy) + (error keyid ": Expected policy to be" expected-policy + "but got" policy)))) + +;; Get the trust level for KEYID. Any remaining arguments are simply +;; passed to GPG. +;; +;; This function only supports keys with a single user id. +(define (gettrust keyid format . args) + (let ((trust + (list-ref (assoc "pub" (gpg-with-colons + `(--tofu-db-format ,format + --trust-model=tofu + ,@args + --list-keys ,keyid))) 1))) + (unless (and (= 1 (string-length trust)) + (member (string-ref trust 0) (string->list "oidreqnmfuws-"))) + (error "Bad trust value:" trust)) + trust)) + +;; Check that KEYID's trust level matches EXPECTED-TRUST. Any +;; remaining arguments are simply passed to GPG. +;; +;; This function only supports keys with a single user id. +(define (checktrust keyid format expected-trust . args) + (let ((trust (apply gettrust `(,keyid ,format ,@args)))) + (unless (string=? trust expected-trust) + (error keyid ": Expected trust to be" expected-trust + "but got" trust)))) + +;; Set key KEYID's policy to POLICY. Any remaining arguments are +;; passed as options to gpg. +(define (setpolicy keyid format policy . args) + (call-check `(,@GPG --tofu-db-format ,format + --trust-model=tofu ,@args + --tofu-policy ,policy ,keyid))) + +(for-each-p + "Testing tofu db formats" + (lambda (format) + ;; Carefully remove the TOFU db. + (catch '() (unlink (string-append GNUPGHOME "/tofu.db"))) + (catch '() (unlink-recursively (string-append GNUPGHOME "/tofu.d"))) + + ;; Verify a message. There should be no conflict and the trust + ;; policy should be set to auto. + (call-check `(,@GPG --tofu-db-format ,format --trust-model=tofu + --verify ,(in-srcdir "tofu-2183839A-1.txt"))) + + (checkpolicy "2183839A" format "auto") + ;; Check default trust. + (checktrust "2183839A" format "m") + + ;; Trust should be derived lazily. Thus, if the policy is set to + ;; auto and we change --tofu-default-policy, then the trust should + ;; change as well. Try it. + (checktrust "2183839A" format "f" '--tofu-default-policy=good) + (checktrust "2183839A" format "-" '--tofu-default-policy=unknown) + (checktrust "2183839A" format "n" '--tofu-default-policy=bad) + + ;; Change the policy to something other than auto and make sure the + ;; policy and the trust are correct. + (for-each-p + "" + (lambda (policy) + (let ((expected-trust + (cond + ((string=? "good" policy) "f") + ((string=? "unknown" policy) "-") + (else "n")))) + (setpolicy "2183839A" format policy) + + ;; Since we have a fixed policy, the trust level shouldn't + ;; change if we change the default policy. + (for-each-p + "" + (lambda (default-policy) + (checkpolicy "2183839A" format policy + '--tofu-default-policy default-policy) + (checktrust "2183839A" format expected-trust + '--tofu-default-policy default-policy)) + '("auto" "good" "unknown" "bad" "ask")))) + '("good" "unknown" "bad")) + + ;; BC15C85A conflicts with 2183839A. On conflict, this will set + ;; BC15C85A to ask. If 2183839A is auto (it's not, it's bad), then + ;; it will be set to ask. + (call-check `(,@GPG --tofu-db-format ,format --trust-model=tofu + --verify ,(in-srcdir "tofu-BC15C85A-1.txt"))) + (checkpolicy "BC15C85A" format "ask") + (checkpolicy "2183839A" format "bad") + + ;; EE37CF96 conflicts with 2183839A and BC15C85A. We change + ;; BC15C85A's policy to auto and leave 2183839A's policy at bad. + ;; This conflict should cause BC15C85A's policy to be changed to + ;; ask (since it is auto), but not affect 2183839A's policy. + (setpolicy "BC15C85A" format "auto") + (checkpolicy "BC15C85A" format "auto") + (call-check `(,@GPG --tofu-db-format ,format --trust-model=tofu + --verify ,(in-srcdir "tofu-EE37CF96-1.txt"))) + (checkpolicy "BC15C85A" format "ask") + (checkpolicy "2183839A" format "bad") + (checkpolicy "EE37CF96" format "ask")) + '("split" "flat")) diff --git a/tests/openpgp/tofu.test b/tests/openpgp/tofu.test index 18c17562c..0d34af409 100755 --- a/tests/openpgp/tofu.test +++ b/tests/openpgp/tofu.test @@ -4,6 +4,9 @@ # set -x +# Redefine GPG with a fixed time. +GPG="$GPG --faked-system-time=1466684990" + KEYS="2183839A BC15C85A EE37CF96" # Make sure $srcdir is set. diff --git a/tests/openpgp/use-exact-key.scm b/tests/openpgp/use-exact-key.scm new file mode 100755 index 000000000..bec537bb9 --- /dev/null +++ b/tests/openpgp/use-exact-key.scm @@ -0,0 +1,68 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +;; Import the sample key +;; +;; pub 1024R/8BC90111 2015-12-02 +;; Key fingerprint = E657 FB60 7BB4 F21C 90BB 6651 BC06 7AF2 8BC9 0111 +;; uid [ultimate] Barrett Brown +;; sub 1024R/3E880CFF 2015-12-02 (encryption) +;; sub 1024R/F5F77B83 2015-12-02 (signing) +;; sub 1024R/45117079 2015-12-02 (encryption) +;; sub 1024R/1EA97479 2015-12-02 (signing) + +(info "Importing public key.") +(call-check + `(,(tool 'gpg) --import + ,(in-srcdir "samplekeys/E657FB607BB4F21C90BB6651BC067AF28BC90111.asc"))) + +;; By default, the most recent, valid signing subkey (1EA97479). +(for-each-p + "Checking that the most recent, valid signing subkey is used by default" + (lambda (keyid) + (tr:do + (tr:pipe-do + (pipe:defer (lambda (sink) (display "" (fdopen sink "w")))) + (pipe:gpg `(-s -u ,keyid)) + (pipe:gpg '(--verify --status-fd=1))) + (tr:call-with-content + (lambda (c) + (unless (string-contains? + c "VALIDSIG 5FBA84ACE02DCB17DA3DFF6BBCA43C441EA97479") + (exit 1)))))) + '("8BC90111" "3E880CFF" "F5F77B83" "45117079" "1EA97479")) + +;; But, if we request a particular signing key, we should get it. +(for-each-p + "Checking that we can select a specific signing key" + (lambda (keyid) + (tr:do + (tr:pipe-do + (pipe:defer (lambda (sink) (display "" (fdopen sink "w")))) + (pipe:gpg `(-s -u ,(string-append keyid "!"))) + (pipe:gpg '(--verify --status-fd=1))) + (tr:call-with-content + (lambda (c) + ;; XXX we do not have a regexp library + (unless (and (string-contains? c "VALIDSIG") + (string-contains? c keyid)) + (exit 1)))))) + '("8BC90111" "F5F77B83" "1EA97479")) diff --git a/tests/openpgp/verify.scm b/tests/openpgp/verify.scm new file mode 100755 index 000000000..de03db531 --- /dev/null +++ b/tests/openpgp/verify.scm @@ -0,0 +1,274 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +;; +;; Two simple tests to check that verify fails for bad input data +;; +(for-each-p + "Checking bogus signature" + (lambda (char) + (lettmp (x) + (pipe:do + (pipe:spawn `(,(tool 'mktdata) --char ,char "64")) + (pipe:write-to x (logior O_WRONLY O_CREAT O_BINARY) #o600)) + (if (= 0 (call `(,@GPG --verify ,x data-500))) + (error "no error code from verify")))) + '("0x2d" "0xca")) + +;; A plain signed message created using +;; echo abc | gpg --homedir . --passphrase-fd 0 -u Alpha -z0 -sa msg +(define msg_ols_asc " +-----BEGIN PGP MESSAGE----- + +kA0DAAIRLXJ8x2hpdzQBrQEHYgNtc2dEDFJaSSB0aGluayB0aGF0IGFsbCByaWdo +dC10aGlua2luZyBwZW9wbGUgaW4gdGhpcyBjb3VudHJ5IGFyZSBzaWNrIGFuZAp0 +aXJlZCBvZiBiZWluZyB0b2xkIHRoYXQgb3JkaW5hcnkgZGVjZW50IHBlb3BsZSBh +cmUgZmVkIHVwIGluIHRoaXMKY291bnRyeSB3aXRoIGJlaW5nIHNpY2sgYW5kIHRp +cmVkLiAgSSdtIGNlcnRhaW5seSBub3QuICBCdXQgSSdtCnNpY2sgYW5kIHRpcmVk +IG9mIGJlaW5nIHRvbGQgdGhhdCBJIGFtLgotIE1vbnR5IFB5dGhvbgqIPwMFAEQM +UlotcnzHaGl3NBECR4IAoJlEGTY+bHjD2HYuCixLQCmk01pbAKCIjkzLOAmkZNm0 +D8luT78c/1x45Q== +=a29i +-----END PGP MESSAGE----- +") + +;; A plain signed message created using +;; echo abc | gpg --homedir . --passphrase-fd 0 -u Alpha -sa msg +(define msg_cols_asc " +-----BEGIN PGP MESSAGE----- + +owGbwMvMwCSoW1RzPCOz3IRxLSN7EnNucboLT6Cgp0JJRmZeNpBMLFFIzMlRKMpM +zyjRBQtm5qUrFKTmF+SkKmTmgdQVKyTnl+aVFFUqJBalKhRnJmcrJOalcJVkFqWm +KOSnKSSlgrSU5OekQMzLL0rJzEsEKk9JTU7NK4EZBtKcBtRRWgAzlwtmbnlmSQbU +GJjxCmDj9RQUPNVzFZJTi0oSM/NyKhXy8kuAYk6lJSBxLlTF2NziqZCYq8elq+Cb +n1dSqRBQWZKRn8fVYc/MygAKBljYCDIFiTDMT+9seu836Q+bevyHTJ0dzPNuvCjn +ZpgrwX38z58rJsfYDhwOSS4SkN/d6vUAAA== +=s6sY +-----END PGP MESSAGE----- +") + +;; A PGP 2 style message. +(define msg_sl_asc " +-----BEGIN PGP MESSAGE----- + +iD8DBQBEDFJaLXJ8x2hpdzQRAkeCAKCZRBk2Pmx4w9h2LgosS0AppNNaWwCgiI5M +yzgJpGTZtA/Jbk+/HP9ceOWtAQdiA21zZ0QMUlpJIHRoaW5rIHRoYXQgYWxsIHJp +Z2h0LXRoaW5raW5nIHBlb3BsZSBpbiB0aGlzIGNvdW50cnkgYXJlIHNpY2sgYW5k +CnRpcmVkIG9mIGJlaW5nIHRvbGQgdGhhdCBvcmRpbmFyeSBkZWNlbnQgcGVvcGxl +IGFyZSBmZWQgdXAgaW4gdGhpcwpjb3VudHJ5IHdpdGggYmVpbmcgc2ljayBhbmQg +dGlyZWQuICBJJ20gY2VydGFpbmx5IG5vdC4gIEJ1dCBJJ20Kc2ljayBhbmQgdGly +ZWQgb2YgYmVpbmcgdG9sZCB0aGF0IEkgYW0uCi0gTW9udHkgUHl0aG9uCg== +=0ukK +-----END PGP MESSAGE----- +") + +;; An OpenPGP message lacking the onepass packet. We used to accept +;; such messages but now consider them invalid. +(define bad_ls_asc " +-----BEGIN PGP MESSAGE----- + +rQEHYgNtc2dEDFJaSSB0aGluayB0aGF0IGFsbCByaWdodC10aGlua2luZyBwZW9w +bGUgaW4gdGhpcyBjb3VudHJ5IGFyZSBzaWNrIGFuZAp0aXJlZCBvZiBiZWluZyB0 +b2xkIHRoYXQgb3JkaW5hcnkgZGVjZW50IHBlb3BsZSBhcmUgZmVkIHVwIGluIHRo +aXMKY291bnRyeSB3aXRoIGJlaW5nIHNpY2sgYW5kIHRpcmVkLiAgSSdtIGNlcnRh +aW5seSBub3QuICBCdXQgSSdtCnNpY2sgYW5kIHRpcmVkIG9mIGJlaW5nIHRvbGQg +dGhhdCBJIGFtLgotIE1vbnR5IFB5dGhvbgqIPwMFAEQMUlotcnzHaGl3NBECR4IA +oJlEGTY+bHjD2HYuCixLQCmk01pbAKCIjkzLOAmkZNm0D8luT78c/1x45Q== +=Mpiu +-----END PGP MESSAGE----- +") + + +;; A signed message prefixed with an unsigned literal packet. +;; (fols = faked-literal-data, one-pass, literal-data, signature) +;; This should throw an error because running gpg to extract the +;; signed data will return both literal data packets +(define bad_fols_asc " +-----BEGIN PGP MESSAGE----- + +rF1iDG1zZy51bnNpZ25lZEQMY0x0aW1lc2hhcmluZywgbjoKCUFuIGFjY2VzcyBt +ZXRob2Qgd2hlcmVieSBvbmUgY29tcHV0ZXIgYWJ1c2VzIG1hbnkgcGVvcGxlLgqQ +DQMAAhEtcnzHaGl3NAGtAQdiA21zZ0QMUlpJIHRoaW5rIHRoYXQgYWxsIHJpZ2h0 +LXRoaW5raW5nIHBlb3BsZSBpbiB0aGlzIGNvdW50cnkgYXJlIHNpY2sgYW5kCnRp +cmVkIG9mIGJlaW5nIHRvbGQgdGhhdCBvcmRpbmFyeSBkZWNlbnQgcGVvcGxlIGFy +ZSBmZWQgdXAgaW4gdGhpcwpjb3VudHJ5IHdpdGggYmVpbmcgc2ljayBhbmQgdGly +ZWQuICBJJ20gY2VydGFpbmx5IG5vdC4gIEJ1dCBJJ20Kc2ljayBhbmQgdGlyZWQg +b2YgYmVpbmcgdG9sZCB0aGF0IEkgYW0uCi0gTW9udHkgUHl0aG9uCog/AwUARAxS +Wi1yfMdoaXc0EQJHggCgmUQZNj5seMPYdi4KLEtAKaTTWlsAoIiOTMs4CaRk2bQP +yW5Pvxz/XHjl +=UNM4 +-----END PGP MESSAGE----- +") + +;; A signed message suffixed with an unsigned literal packet. +;; (fols = faked-literal-data, one-pass, literal-data, signature) +;; This should throw an error because running gpg to extract the +;; signed data will return both literal data packets +(define bad_olsf_asc " +-----BEGIN PGP MESSAGE----- + +kA0DAAIRLXJ8x2hpdzQBrQEHYgNtc2dEDFJaSSB0aGluayB0aGF0IGFsbCByaWdo +dC10aGlua2luZyBwZW9wbGUgaW4gdGhpcyBjb3VudHJ5IGFyZSBzaWNrIGFuZAp0 +aXJlZCBvZiBiZWluZyB0b2xkIHRoYXQgb3JkaW5hcnkgZGVjZW50IHBlb3BsZSBh +cmUgZmVkIHVwIGluIHRoaXMKY291bnRyeSB3aXRoIGJlaW5nIHNpY2sgYW5kIHRp +cmVkLiAgSSdtIGNlcnRhaW5seSBub3QuICBCdXQgSSdtCnNpY2sgYW5kIHRpcmVk +IG9mIGJlaW5nIHRvbGQgdGhhdCBJIGFtLgotIE1vbnR5IFB5dGhvbgqIPwMFAEQM +UlotcnzHaGl3NBECR4IAoJlEGTY+bHjD2HYuCixLQCmk01pbAKCIjkzLOAmkZNm0 +D8luT78c/1x45axdYgxtc2cudW5zaWduZWREDGNMdGltZXNoYXJpbmcsIG46CglB +biBhY2Nlc3MgbWV0aG9kIHdoZXJlYnkgb25lIGNvbXB1dGVyIGFidXNlcyBtYW55 +IHBlb3BsZS4K +=3gnG +-----END PGP MESSAGE----- +") + + +;; Two standard signed messages in a row +(define msg_olsols_asc_multiple " +-----BEGIN PGP MESSAGE----- + +kA0DAAIRLXJ8x2hpdzQBrQEHYgNtc2dEDFJaSSB0aGluayB0aGF0IGFsbCByaWdo +dC10aGlua2luZyBwZW9wbGUgaW4gdGhpcyBjb3VudHJ5IGFyZSBzaWNrIGFuZAp0 +aXJlZCBvZiBiZWluZyB0b2xkIHRoYXQgb3JkaW5hcnkgZGVjZW50IHBlb3BsZSBh +cmUgZmVkIHVwIGluIHRoaXMKY291bnRyeSB3aXRoIGJlaW5nIHNpY2sgYW5kIHRp +cmVkLiAgSSdtIGNlcnRhaW5seSBub3QuICBCdXQgSSdtCnNpY2sgYW5kIHRpcmVk +IG9mIGJlaW5nIHRvbGQgdGhhdCBJIGFtLgotIE1vbnR5IFB5dGhvbgqIPwMFAEQM +UlotcnzHaGl3NBECR4IAoJlEGTY+bHjD2HYuCixLQCmk01pbAKCIjkzLOAmkZNm0 +D8luT78c/1x45ZANAwACES1yfMdoaXc0Aa0BB2IDbXNnRAxSWkkgdGhpbmsgdGhh +dCBhbGwgcmlnaHQtdGhpbmtpbmcgcGVvcGxlIGluIHRoaXMgY291bnRyeSBhcmUg +c2ljayBhbmQKdGlyZWQgb2YgYmVpbmcgdG9sZCB0aGF0IG9yZGluYXJ5IGRlY2Vu +dCBwZW9wbGUgYXJlIGZlZCB1cCBpbiB0aGlzCmNvdW50cnkgd2l0aCBiZWluZyBz +aWNrIGFuZCB0aXJlZC4gIEknbSBjZXJ0YWlubHkgbm90LiAgQnV0IEknbQpzaWNr +IGFuZCB0aXJlZCBvZiBiZWluZyB0b2xkIHRoYXQgSSBhbS4KLSBNb250eSBQeXRo +b24KiD8DBQBEDFJaLXJ8x2hpdzQRAkeCAKCZRBk2Pmx4w9h2LgosS0AppNNaWwCg +iI5MyzgJpGTZtA/Jbk+/HP9ceOU= +=8nLN +-----END PGP MESSAGE----- +") + +;; A standard message with two signatures (actually the same signature +;; duplicated). +(define msg_oolss_asc " +-----BEGIN PGP MESSAGE----- + +kA0DAAIRLXJ8x2hpdzQBkA0DAAIRLXJ8x2hpdzQBrQEHYgNtc2dEDFJaSSB0aGlu +ayB0aGF0IGFsbCByaWdodC10aGlua2luZyBwZW9wbGUgaW4gdGhpcyBjb3VudHJ5 +IGFyZSBzaWNrIGFuZAp0aXJlZCBvZiBiZWluZyB0b2xkIHRoYXQgb3JkaW5hcnkg +ZGVjZW50IHBlb3BsZSBhcmUgZmVkIHVwIGluIHRoaXMKY291bnRyeSB3aXRoIGJl +aW5nIHNpY2sgYW5kIHRpcmVkLiAgSSdtIGNlcnRhaW5seSBub3QuICBCdXQgSSdt +CnNpY2sgYW5kIHRpcmVkIG9mIGJlaW5nIHRvbGQgdGhhdCBJIGFtLgotIE1vbnR5 +IFB5dGhvbgqIPwMFAEQMUlotcnzHaGl3NBECR4IAoJlEGTY+bHjD2HYuCixLQCmk +01pbAKCIjkzLOAmkZNm0D8luT78c/1x45Yg/AwUARAxSWi1yfMdoaXc0EQJHggCg +mUQZNj5seMPYdi4KLEtAKaTTWlsAoIiOTMs4CaRk2bQPyW5Pvxz/XHjl +=KVw5 +-----END PGP MESSAGE----- +") + +;; A standard message with two one-pass packet but only one signature +;; packet +(define bad_ools_asc " +-----BEGIN PGP MESSAGE----- + +kA0DAAIRLXJ8x2hpdzQBkA0DAAIRLXJ8x2hpdzQBrQEHYgNtc2dEDFJaSSB0aGlu +ayB0aGF0IGFsbCByaWdodC10aGlua2luZyBwZW9wbGUgaW4gdGhpcyBjb3VudHJ5 +IGFyZSBzaWNrIGFuZAp0aXJlZCBvZiBiZWluZyB0b2xkIHRoYXQgb3JkaW5hcnkg +ZGVjZW50IHBlb3BsZSBhcmUgZmVkIHVwIGluIHRoaXMKY291bnRyeSB3aXRoIGJl +aW5nIHNpY2sgYW5kIHRpcmVkLiAgSSdtIGNlcnRhaW5seSBub3QuICBCdXQgSSdt +CnNpY2sgYW5kIHRpcmVkIG9mIGJlaW5nIHRvbGQgdGhhdCBJIGFtLgotIE1vbnR5 +IFB5dGhvbgqIPwMFAEQMUlotcnzHaGl3NBECR4IAoJlEGTY+bHjD2HYuCixLQCmk +01pbAKCIjkzLOAmkZNm0D8luT78c/1x45Q== +=1/ix +-----END PGP MESSAGE----- +") + +;; Standard cleartext signature +(define msg_cls_asc " +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA1 + +I think that all right-thinking people in this country are sick and +tired of being told that ordinary decent people are fed up in this +country with being sick and tired. I'm certainly not. But I'm +sick and tired of being told that I am. +- - Monty Python +-----BEGIN PGP SIGNATURE----- + +iD8DBQFEDVp1LXJ8x2hpdzQRAplUAKCMfpG3GPw/TLN52tosgXP5lNECkwCfQhAa +emmev7IuQjWYrGF9Lxj+zj8= +=qJsY +-----END PGP SIGNATURE----- +") + +;; Cleartext signature with two signatures +(define msg_clss_asc " +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA1 + +What is the difference between a Turing machine and the modern computer? +It's the same as that between Hillary's ascent of Everest and the +establishment of a Hilton on its peak. +-----BEGIN PGP SIGNATURE----- + +iD8DBQFEDVz6LXJ8x2hpdzQRAtkGAKCeMhNbHnh339fpjNj9owsYcC4zBwCfYO5l +2u+KEfXX0FKyk8SMzLjZ536IPwMFAUQNXPr+GAsdqeOwshEC2QYAoPOWAiQm0EF/ +FWIAQUplk7JWbyRKAJ92ZJyJpWfzb0yc1s7MY65r2qEHrg== +=1Xvv +-----END PGP SIGNATURE----- +") + +;; Two clear text signatures in a row +(define msg_clsclss_asc_multiple (string-append msg_cls_asc msg_clss_asc)) + +;; Fixme: We need more tests with manipulated cleartext signatures. + +;; +;; Now run the tests. +;; +(for-each-p + "Checking that a valid signature is verified as such" + (lambda (armored-file) + (pipe:do + (pipe:echo (eval armored-file (current-environment))) + (pipe:spawn `(,@GPG --verify)))) + '(msg_ols_asc msg_cols_asc msg_sl_asc msg_oolss_asc msg_cls_asc msg_clss_asc)) + +(for-each-p + "Checking that a valid signature over multiple messages is verified as such" + (lambda (armored-file) + (pipe:do + (pipe:echo (eval armored-file (current-environment))) + (pipe:spawn `(,@GPG --verify --allow-multiple-messages))) + (catch '() + (pipe:do + (pipe:defer (lambda (sink) + (display armored-file (fdopen sink "w")))) + (pipe:spawn `(,@GPG --verify))) + (error "verification succeded but should not"))) + '(msg_olsols_asc_multiple msg_clsclss_asc_multiple)) + +(for-each-p + "Checking that an invalid signature is verified as such" + (lambda (armored-file) + (catch '() + (pipe:do + (pipe:echo (eval armored-file (current-environment))) + (pipe:spawn `(,@GPG --verify))) + (error "verification succeded but should not"))) + '(bad_ls_asc bad_fols_asc bad_olsf_asc bad_ools_asc)) diff --git a/tests/openpgp/version.scm b/tests/openpgp/version.scm new file mode 100755 index 000000000..57efb937b --- /dev/null +++ b/tests/openpgp/version.scm @@ -0,0 +1,24 @@ +#!/usr/bin/env gpgscm + +;; Copyright (C) 2016 g10 Code GmbH +;; +;; This file is part of GnuPG. +;; +;; GnuPG is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; GnuPG is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, see . + +(load (with-path "defs.scm")) + +(info "Printing the GPG version") +(assert (string-contains? (call-check `(,@GPG --version)) + "gpg (GnuPG) 2.")) diff --git a/tools/Makefile.am b/tools/Makefile.am index d43ede8d1..7bc14568a 100644 --- a/tools/Makefile.am +++ b/tools/Makefile.am @@ -51,9 +51,17 @@ else gpgtar = endif +if BUILD_WKS_TOOLS + gpg_wks_server = gpg-wks-server + gpg_wks_client = gpg-wks-client +else + gpg_wks_server = + gpg_wks_client = +endif + bin_PROGRAMS = gpgconf gpg-connect-agent ${symcryptrun} if !HAVE_W32_SYSTEM -bin_PROGRAMS += watchgnupg gpgparsemail +bin_PROGRAMS += watchgnupg gpgparsemail ${gpg_wks_server} ${gpg_wks_client} endif if !HAVE_W32CE_SYSTEM bin_PROGRAMS += ${gpgtar} @@ -136,6 +144,34 @@ gpgtar_CFLAGS = $(GPG_ERROR_CFLAGS) gpgtar_LDADD = $(libcommon) $(LIBGCRYPT_LIBS) $(GPG_ERROR_LIBS) \ $(LIBINTL) $(NETLIBS) $(LIBICONV) $(W32SOCKLIBS) +gpg_wks_server_SOURCES = \ + gpg-wks-server.c \ + gpg-wks.h \ + wks-util.c \ + wks-receive.c \ + rfc822parse.c rfc822parse.h \ + mime-parser.c mime-parser.h \ + mime-maker.c mime-maker.h \ + send-mail.c send-mail.h + +gpg_wks_server_CFLAGS = $(GPG_ERROR_CFLAGS) +gpg_wks_server_LDADD = $(libcommon) $(LIBGCRYPT_LIBS) $(GPG_ERROR_LIBS) + +gpg_wks_client_SOURCES = \ + gpg-wks-client.c \ + gpg-wks.h \ + wks-util.c \ + wks-receive.c \ + rfc822parse.c rfc822parse.h \ + mime-parser.c mime-parser.h \ + mime-maker.h mime-maker.c \ + send-mail.c send-mail.h \ + call-dirmngr.c call-dirmngr.h + +gpg_wks_client_CFLAGS = $(LIBASSUAN_CFLAGS) $(GPG_ERROR_CFLAGS) +gpg_wks_client_LDADD = $(libcommon) \ + $(LIBASSUAN_LIBS) $(LIBGCRYPT_LIBS) $(GPG_ERROR_LIBS) + # Make sure that all libs are build before we use them. This is # important for things like make -j2. diff --git a/tools/call-dirmngr.c b/tools/call-dirmngr.c new file mode 100644 index 000000000..0e591dd6d --- /dev/null +++ b/tools/call-dirmngr.c @@ -0,0 +1,205 @@ +/* call-dirmngr.c - Interact with the Dirmngr. + * Copyright (C) 2016 g10 Code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#include +#include +#include +#include +#include +#include +#include +#ifdef HAVE_LOCALE_H +# include +#endif + +#include +#include "util.h" +#include "i18n.h" +#include "asshelp.h" +#include "mbox-util.h" +#include "./call-dirmngr.h" + +static struct +{ + int verbose; + int debug_ipc; + int autostart; +} opt; + + + +void +set_dirmngr_options (int verbose, int debug_ipc, int autostart) +{ + opt.verbose = verbose; + opt.debug_ipc = debug_ipc; + opt.autostart = autostart; +} + + +/* Connect to the Dirmngr and return an assuan context. */ +static gpg_error_t +connect_dirmngr (assuan_context_t *r_ctx) +{ + gpg_error_t err; + assuan_context_t ctx; + + *r_ctx = NULL; + err = start_new_dirmngr (&ctx, + GPG_ERR_SOURCE_DEFAULT, + NULL, + opt.autostart, opt.verbose, opt.debug_ipc, + NULL, NULL); + if (!opt.autostart && gpg_err_code (err) == GPG_ERR_NO_DIRMNGR) + { + static int shown; + + if (!shown) + { + shown = 1; + log_info (_("no dirmngr running in this session\n")); + } + } + + if (err) + assuan_release (ctx); + else + { + *r_ctx = ctx; + } + + return err; +} + + + + +/* Parameter structure used with the WKD_GET command. */ +struct wkd_get_parm_s +{ + estream_t memfp; +}; + + +/* Data callback for the WKD_GET command. */ +static gpg_error_t +wkd_get_data_cb (void *opaque, const void *data, size_t datalen) +{ + struct wkd_get_parm_s *parm = opaque; + gpg_error_t err = 0; + size_t nwritten; + + if (!data) + return 0; /* Ignore END commands. */ + if (!parm->memfp) + return 0; /* Data is not required. */ + + if (es_write (parm->memfp, data, datalen, &nwritten)) + err = gpg_error_from_syserror (); + + return err; +} + + +/* Status callback for the WKD_GET command. */ +static gpg_error_t +wkd_get_status_cb (void *opaque, const char *line) +{ + struct wkd_get_parm_s *parm = opaque; + gpg_error_t err = 0; + + (void)line; + (void)parm; + + return err; +} + + +/* Ask the dirmngr for the submission address of a WKD server for the + * mail address ADDRSPEC. On success the submission address is stored + * at R_ADDRSPEC. */ +gpg_error_t +wkd_get_submission_address (const char *addrspec, char **r_addrspec) +{ + gpg_error_t err; + assuan_context_t ctx; + struct wkd_get_parm_s parm; + char *line = NULL; + void *vp; + char *buffer = NULL; + char *p; + + memset (&parm, 0, sizeof parm); + *r_addrspec = NULL; + + err = connect_dirmngr (&ctx); + if (err) + return err; + + line = es_bsprintf ("WKD_GET --submission-address -- %s", addrspec); + if (!line) + { + err = gpg_error_from_syserror (); + goto leave; + } + if (strlen (line) + 2 >= ASSUAN_LINELENGTH) + { + err = gpg_error (GPG_ERR_TOO_LARGE); + goto leave; + } + + parm.memfp = es_fopenmem (0, "rwb"); + if (!parm.memfp) + { + err = gpg_error_from_syserror (); + goto leave; + } + err = assuan_transact (ctx, line, wkd_get_data_cb, &parm, + NULL, NULL, wkd_get_status_cb, &parm); + if (err) + goto leave; + + es_fputc (0, parm.memfp); + if (es_fclose_snatch (parm.memfp, &vp, NULL)) + { + err = gpg_error_from_syserror (); + goto leave; + } + buffer = vp; + parm.memfp = NULL; + p = strchr (buffer, '\n'); + if (p) + *p = 0; + trim_spaces (buffer); + if (!is_valid_mailbox (buffer)) + { + err = gpg_error (GPG_ERR_INV_USER_ID); + goto leave; + } + *r_addrspec = xtrystrdup (buffer); + if (!*r_addrspec) + err = gpg_error_from_syserror (); + + leave: + es_free (buffer); + es_fclose (parm.memfp); + xfree (line); + assuan_release (ctx); + return err; +} diff --git a/tools/call-dirmngr.h b/tools/call-dirmngr.h new file mode 100644 index 000000000..f1bc3686b --- /dev/null +++ b/tools/call-dirmngr.h @@ -0,0 +1,28 @@ +/* call-dirmngr.h - Interact with the Dirmngr. + * Copyright (C) 2016 g10 Code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ +#ifndef GNUPG_TOOLS_CALL_DIRMNGR_H +#define GNUPG_TOOLS_CALL_DIRMNGR_H + +void set_dirmngr_options (int verbose, int debug_ipc, int autostart); + +gpg_error_t wkd_get_submission_address (const char *addrspec, + char **r_addrspec); + + +#endif /*GNUPG_TOOLS_CALL_DIRMNGR_H*/ diff --git a/tools/gpg-connect-agent.c b/tools/gpg-connect-agent.c index 1cd554f1f..6b5f507ca 100644 --- a/tools/gpg-connect-agent.c +++ b/tools/gpg-connect-agent.c @@ -1879,6 +1879,16 @@ main (int argc, char **argv) if (opt.verbose) log_info ("closing connection to agent\n"); + /* XXX: We would like to release the context here, but libassuan + nicely says good bye to the server, which results in a SIGPIPE if + the server died. Unfortunately, libassuan does not ignore + SIGPIPE when used with UNIX sockets, hence we simply leak the + context here. */ + if (0) + assuan_release (ctx); + else + gpgrt_annotate_leaked_object (ctx); + xfree (line); return 0; } diff --git a/tools/gpg-wks-client.c b/tools/gpg-wks-client.c new file mode 100644 index 000000000..2ee23d7cb --- /dev/null +++ b/tools/gpg-wks-client.c @@ -0,0 +1,758 @@ +/* gpg-wks-client.c - A client for the Web Key Service protocols. + * Copyright (C) 2016 Werner Koch + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#include +#include +#include +#include + +#include "util.h" +#include "i18n.h" +#include "sysutils.h" +#include "init.h" +#include "asshelp.h" +#include "userids.h" +#include "ccparray.h" +#include "exectool.h" +#include "mbox-util.h" +#include "name-value.h" +#include "call-dirmngr.h" +#include "mime-maker.h" +#include "send-mail.h" +#include "gpg-wks.h" + + +/* Constants to identify the commands and options. */ +enum cmd_and_opt_values + { + aNull = 0, + + oQuiet = 'q', + oVerbose = 'v', + oOutput = 'o', + + oDebug = 500, + + aCreate, + aReceive, + aRead, + + oGpgProgram, + oSend, + + oDummy + }; + + +/* The list of commands and options. */ +static ARGPARSE_OPTS opts[] = { + ARGPARSE_group (300, ("@Commands:\n ")), + + ARGPARSE_c (aCreate, "create", + ("create a publication request")), + ARGPARSE_c (aReceive, "receive", + ("receive a MIME confirmation request")), + ARGPARSE_c (aRead, "read", + ("receive a plain text confirmation request")), + + ARGPARSE_group (301, ("@\nOptions:\n ")), + + ARGPARSE_s_n (oVerbose, "verbose", ("verbose")), + ARGPARSE_s_n (oQuiet, "quiet", ("be somewhat more quiet")), + ARGPARSE_s_s (oDebug, "debug", "@"), + ARGPARSE_s_s (oGpgProgram, "gpg", "@"), + ARGPARSE_s_n (oSend, "send", "send the mail using sendmail"), + ARGPARSE_s_s (oOutput, "output", "|FILE|write the mail to FILE"), + + + ARGPARSE_end () +}; + + +/* The list of supported debug flags. */ +static struct debug_flags_s debug_flags [] = + { + { DBG_CRYPTO_VALUE , "crypto" }, + { DBG_MEMORY_VALUE , "memory" }, + { DBG_MEMSTAT_VALUE, "memstat" }, + { DBG_IPC_VALUE , "ipc" }, + { DBG_EXTPROG_VALUE, "extprog" }, + { 0, NULL } + }; + + +static void wrong_args (const char *text) GPGRT_ATTR_NORETURN; +static gpg_error_t command_send (const char *fingerprint, char *userid); +static gpg_error_t process_confirmation_request (estream_t msg); +static gpg_error_t command_receive_cb (void *opaque, + const char *mediatype, estream_t fp); + + + +/* Print usage information and and provide strings for help. */ +static const char * +my_strusage( int level ) +{ + const char *p; + + switch (level) + { + case 11: p = "gpg-wks-client (@GNUPG@)"; + break; + case 13: p = VERSION; break; + case 17: p = PRINTABLE_OS_NAME; break; + case 19: p = ("Please report bugs to <@EMAIL@>.\n"); break; + + case 1: + case 40: + p = ("Usage: gpg-wks-client [command] [options] [args] (-h for help)"); + break; + case 41: + p = ("Syntax: gpg-wks-client [command] [options] [args]\n" + "Client for the Web Key Service\n"); + break; + + default: p = NULL; break; + } + return p; +} + + +static void +wrong_args (const char *text) +{ + es_fprintf (es_stderr, _("usage: %s [options] %s\n"), strusage (11), text); + exit (2); +} + + + +/* Command line parsing. */ +static enum cmd_and_opt_values +parse_arguments (ARGPARSE_ARGS *pargs, ARGPARSE_OPTS *popts) +{ + enum cmd_and_opt_values cmd = 0; + int no_more_options = 0; + + while (!no_more_options && optfile_parse (NULL, NULL, NULL, pargs, popts)) + { + switch (pargs->r_opt) + { + case oQuiet: opt.quiet = 1; break; + case oVerbose: opt.verbose++; break; + case oDebug: + if (parse_debug_flag (pargs->r.ret_str, &opt.debug, debug_flags)) + { + pargs->r_opt = ARGPARSE_INVALID_ARG; + pargs->err = ARGPARSE_PRINT_ERROR; + } + break; + + case oGpgProgram: + opt.gpg_program = pargs->r.ret_str; + break; + case oSend: + opt.use_sendmail = 1; + break; + case oOutput: + opt.output = pargs->r.ret_str; + break; + + case aCreate: + case aReceive: + case aRead: + cmd = pargs->r_opt; + break; + + default: pargs->err = 2; break; + } + } + + return cmd; +} + + + +/* gpg-wks-client main. */ +int +main (int argc, char **argv) +{ + gpg_error_t err; + ARGPARSE_ARGS pargs; + enum cmd_and_opt_values cmd; + + gnupg_reopen_std ("gpg-wks-client"); + set_strusage (my_strusage); + log_set_prefix ("gpg-wks-client", GPGRT_LOG_WITH_PREFIX); + + /* Make sure that our subsystems are ready. */ + i18n_init(); + init_common_subsystems (&argc, &argv); + + assuan_set_gpg_err_source (GPG_ERR_SOURCE_DEFAULT); + setup_libassuan_logging (&opt.debug); + + /* Parse the command line. */ + pargs.argc = &argc; + pargs.argv = &argv; + pargs.flags = ARGPARSE_FLAG_KEEP; + cmd = parse_arguments (&pargs, opts); + + if (log_get_errorcount (0)) + exit (2); + + /* Print a warning if an argument looks like an option. */ + if (!opt.quiet && !(pargs.flags & ARGPARSE_FLAG_STOP_SEEN)) + { + int i; + + for (i=0; i < argc; i++) + if (argv[i][0] == '-' && argv[i][1] == '-') + log_info (("NOTE: '%s' is not considered an option\n"), argv[i]); + } + + /* Set defaults for non given options. */ + if (!opt.gpg_program) + opt.gpg_program = gnupg_module_name (GNUPG_MODULE_NAME_GPG); + + /* Tell call-dirmngr what options we want. */ + set_dirmngr_options (opt.verbose, (opt.debug & DBG_IPC_VALUE), 1); + + /* Run the selected command. */ + switch (cmd) + { + case aCreate: + if (argc != 2) + wrong_args ("--create FINGERPRINT USER-ID"); + err = command_send (argv[0], argv[1]); + if (err) + log_error ("creating request failed: %s\n", gpg_strerror (err)); + break; + + case aReceive: + if (argc) + wrong_args ("--receive < MIME-DATA"); + err = wks_receive (es_stdin, command_receive_cb, NULL); + if (err) + log_error ("processing mail failed: %s\n", gpg_strerror (err)); + break; + + case aRead: + if (argc) + wrong_args ("--read < WKS-DATA"); + err = process_confirmation_request (es_stdin); + if (err) + log_error ("processing mail failed: %s\n", gpg_strerror (err)); + break; + + default: + usage (1); + break; + } + + return log_get_errorcount (0)? 1:0; +} + + + +struct get_key_status_parm_s +{ + const char *fpr; + int found; + int count; +}; + +static void +get_key_status_cb (void *opaque, const char *keyword, char *args) +{ + struct get_key_status_parm_s *parm = opaque; + + /*log_debug ("%s: %s\n", keyword, args);*/ + if (!strcmp (keyword, "EXPORTED")) + { + parm->count++; + if (!ascii_strcasecmp (args, parm->fpr)) + parm->found = 1; + } +} + + +/* Get a key by fingerprint from gpg's keyring and make sure that the + * mail address ADDRSPEC is included in the key. The key is returned + * as a new memory stream at R_KEY. + * + * Fixme: After we have implemented import and export filters for gpg + * this function shall only return a key with just this user id. */ +static gpg_error_t +get_key (estream_t *r_key, const char *fingerprint, const char *addrspec) +{ + gpg_error_t err; + ccparray_t ccp; + const char **argv = NULL; + estream_t key = NULL; + struct get_key_status_parm_s parm; + char *filterexp = NULL; + + memset (&parm, 0, sizeof parm); + + *r_key = NULL; + + key = es_fopenmem (0, "w+b"); + if (!key) + { + err = gpg_error_from_syserror (); + log_error ("error allocating memory buffer: %s\n", gpg_strerror (err)); + goto leave; + } + + filterexp = es_bsprintf ("keep-uid=mbox = %s", addrspec); + if (!filterexp) + { + err = gpg_error_from_syserror (); + log_error ("error allocating memory buffer: %s\n", gpg_strerror (err)); + goto leave; + } + + ccparray_init (&ccp, 0); + + ccparray_put (&ccp, "--no-options"); + if (!opt.verbose) + ccparray_put (&ccp, "--quiet"); + else if (opt.verbose > 1) + ccparray_put (&ccp, "--verbose"); + ccparray_put (&ccp, "--batch"); + ccparray_put (&ccp, "--status-fd=2"); + ccparray_put (&ccp, "--always-trust"); + ccparray_put (&ccp, "--armor"); + ccparray_put (&ccp, "--export-options=export-minimal"); + ccparray_put (&ccp, "--export-filter"); + ccparray_put (&ccp, filterexp); + ccparray_put (&ccp, "--export"); + ccparray_put (&ccp, "--"); + ccparray_put (&ccp, fingerprint); + + ccparray_put (&ccp, NULL); + argv = ccparray_get (&ccp, NULL); + if (!argv) + { + err = gpg_error_from_syserror (); + goto leave; + } + parm.fpr = fingerprint; + err = gnupg_exec_tool_stream (opt.gpg_program, argv, NULL, + NULL, key, + get_key_status_cb, &parm); + if (!err && parm.count > 1) + err = gpg_error (GPG_ERR_TOO_MANY); + else if (!err && !parm.found) + err = gpg_error (GPG_ERR_NOT_FOUND); + if (err) + { + log_error ("export failed: %s\n", gpg_strerror (err)); + goto leave; + } + + es_rewind (key); + *r_key = key; + key = NULL; + + leave: + es_fclose (key); + xfree (argv); + xfree (filterexp); + return err; +} + + + +/* Locate the key by fingerprint and userid and send a publication + * request. */ +static gpg_error_t +command_send (const char *fingerprint, char *userid) +{ + gpg_error_t err; + KEYDB_SEARCH_DESC desc; + char *addrspec = NULL; + estream_t key = NULL; + char *submission_to = NULL; + mime_maker_t mime = NULL; + + if (classify_user_id (fingerprint, &desc, 1) + || !(desc.mode == KEYDB_SEARCH_MODE_FPR + || desc.mode == KEYDB_SEARCH_MODE_FPR20)) + { + log_error (_("\"%s\" is not a fingerprint\n"), fingerprint); + err = gpg_error (GPG_ERR_INV_NAME); + goto leave; + } + addrspec = mailbox_from_userid (userid); + if (!addrspec) + { + log_error (_("\"%s\" is not a proper mail address\n"), userid); + err = gpg_error (GPG_ERR_INV_USER_ID); + goto leave; + } + err = get_key (&key, fingerprint, addrspec); + if (err) + goto leave; + + /* Get the submission address. */ + err = wkd_get_submission_address (addrspec, &submission_to); + if (err) + goto leave; + log_info ("submitting request to '%s'\n", submission_to); + + /* Send the key. */ + err = mime_maker_new (&mime, NULL); + if (err) + goto leave; + err = mime_maker_add_header (mime, "From", addrspec); + if (err) + goto leave; + err = mime_maker_add_header (mime, "To", submission_to); + if (err) + goto leave; + err = mime_maker_add_header (mime, "Subject", "Key publishing request"); + if (err) + goto leave; + + err = mime_maker_add_header (mime, "Content-type", "application/pgp-keys"); + if (err) + goto leave; + + err = mime_maker_add_stream (mime, &key); + if (err) + goto leave; + + err = wks_send_mime (mime); + + leave: + mime_maker_release (mime); + xfree (submission_to); + es_fclose (key); + xfree (addrspec); + return err; +} + + + +static void +encrypt_response_status_cb (void *opaque, const char *keyword, char *args) +{ + gpg_error_t *failure = opaque; + char *fields[2]; + + if (opt.debug) + log_debug ("%s: %s\n", keyword, args); + + if (!strcmp (keyword, "FAILURE")) + { + if (split_fields (args, fields, DIM (fields)) >= 2 + && !strcmp (fields[0], "encrypt")) + *failure = strtoul (fields[1], NULL, 10); + } + +} + + +/* Encrypt the INPUT stream to a new stream which is stored at success + * at R_OUTPUT. Encryption is done for ADDRSPEC. We currently + * retrieve that key from the WKD, DANE, or from "local". "local" is + * last to prefer the latest key version but use a local copy in case + * we are working offline. It might be useful for the server to send + * the fingerprint of its encryption key - or even the entire key + * back. */ +static gpg_error_t +encrypt_response (estream_t *r_output, estream_t input, const char *addrspec) +{ + gpg_error_t err; + ccparray_t ccp; + const char **argv; + estream_t output; + gpg_error_t gpg_err = 0; + + *r_output = NULL; + + output = es_fopenmem (0, "w+b"); + if (!output) + { + err = gpg_error_from_syserror (); + log_error ("error allocating memory buffer: %s\n", gpg_strerror (err)); + return err; + } + + ccparray_init (&ccp, 0); + + ccparray_put (&ccp, "--no-options"); + if (!opt.verbose) + ccparray_put (&ccp, "--quiet"); + else if (opt.verbose > 1) + ccparray_put (&ccp, "--verbose"); + ccparray_put (&ccp, "--batch"); + ccparray_put (&ccp, "--status-fd=2"); + ccparray_put (&ccp, "--always-trust"); + ccparray_put (&ccp, "--armor"); + ccparray_put (&ccp, "--auto-key-locate=clear,wkd,dane,local"); + ccparray_put (&ccp, "--recipient"); + ccparray_put (&ccp, addrspec); + ccparray_put (&ccp, "--encrypt"); + ccparray_put (&ccp, "--"); + + ccparray_put (&ccp, NULL); + argv = ccparray_get (&ccp, NULL); + if (!argv) + { + err = gpg_error_from_syserror (); + goto leave; + } + err = gnupg_exec_tool_stream (opt.gpg_program, argv, input, + NULL, output, + encrypt_response_status_cb, &gpg_err); + if (err) + { + if (gpg_err) + err = gpg_err; + log_error ("encryption failed: %s\n", gpg_strerror (err)); + goto leave; + } + + es_rewind (output); + *r_output = output; + output = NULL; + + leave: + es_fclose (output); + xfree (argv); + return err; +} + + +static gpg_error_t +send_confirmation_response (const char *sender, const char *address, + const char *nonce, int encrypt) +{ + gpg_error_t err; + estream_t body = NULL; + estream_t bodyenc = NULL; + mime_maker_t mime = NULL; + + body = es_fopenmem (0, "w+b"); + if (!body) + { + err = gpg_error_from_syserror (); + log_error ("error allocating memory buffer: %s\n", gpg_strerror (err)); + return err; + } + + /* It is fine to use 8 bit encoding because that is encrypted and + * only our client will see it. */ + if (encrypt) + { + es_fputs ("Content-Type: application/vnd.gnupg.wks\n" + "Content-Transfer-Encoding: 8bit\n" + "\n", + body); + } + + es_fprintf (body, ("type: confirmation-response\n" + "sender: %s\n" + "address: %s\n" + "nonce: %s\n"), + sender, + address, + nonce); + + es_rewind (body); + if (encrypt) + { + err = encrypt_response (&bodyenc, body, sender); + if (err) + goto leave; + es_fclose (body); + body = NULL; + } + + err = mime_maker_new (&mime, NULL); + if (err) + goto leave; + err = mime_maker_add_header (mime, "From", address); + if (err) + goto leave; + err = mime_maker_add_header (mime, "To", sender); + if (err) + goto leave; + err = mime_maker_add_header (mime, "Subject", "Key publication confirmation"); + if (err) + goto leave; + + if (encrypt) + { + err = mime_maker_add_header (mime, "Content-Type", + "multipart/encrypted; " + "protocol=\"application/pgp-encrypted\""); + if (err) + goto leave; + err = mime_maker_add_container (mime, "multipart/encrypted"); + if (err) + goto leave; + + err = mime_maker_add_header (mime, "Content-Type", + "application/pgp-encrypted"); + if (err) + goto leave; + err = mime_maker_add_body (mime, "Version: 1\n"); + if (err) + goto leave; + err = mime_maker_add_header (mime, "Content-Type", + "application/octet-stream"); + if (err) + goto leave; + + err = mime_maker_add_stream (mime, &bodyenc); + if (err) + goto leave; + } + else + { + err = mime_maker_add_header (mime, "Content-Type", + "application/vnd.gnupg.wks"); + if (err) + goto leave; + err = mime_maker_add_stream (mime, &body); + if (err) + goto leave; + } + + err = wks_send_mime (mime); + + leave: + mime_maker_release (mime); + es_fclose (bodyenc); + es_fclose (body); + return err; +} + + +/* Reply to a confirmation request. The MSG has already been + * decrypted and we only need to send the nonce back. */ +static gpg_error_t +process_confirmation_request (estream_t msg) +{ + gpg_error_t err; + nvc_t nvc; + nve_t item; + const char *value, *sender, *address, *nonce; + + err = nvc_parse (&nvc, NULL, msg); + if (err) + { + log_error ("parsing the WKS message failed: %s\n", gpg_strerror (err)); + goto leave; + } + + if (opt.debug) + { + log_debug ("request follows:\n"); + nvc_write (nvc, log_get_stream ()); + } + + /* Check that this is a confirmation request. */ + if (!((item = nvc_lookup (nvc, "type:")) && (value = nve_value (item)) + && !strcmp (value, "confirmation-request"))) + { + if (item && value) + log_error ("received unexpected wks message '%s'\n", value); + else + log_error ("received invalid wks message: %s\n", "'type' missing"); + err = gpg_error (GPG_ERR_UNEXPECTED_MSG); + goto leave; + } + + /* FIXME: Check that the fingerprint matches the key used to decrypt the + * message. */ + + /* Get the address. */ + if (!((item = nvc_lookup (nvc, "address:")) && (value = nve_value (item)) + && is_valid_mailbox (value))) + { + log_error ("received invalid wks message: %s\n", + "'address' missing or invalid"); + err = gpg_error (GPG_ERR_INV_DATA); + goto leave; + } + address = value; + /* FIXME: Check that the "address" matches the User ID we want to + * publish. */ + + /* Get the sender. */ + if (!((item = nvc_lookup (nvc, "sender:")) && (value = nve_value (item)) + && is_valid_mailbox (value))) + { + log_error ("received invalid wks message: %s\n", + "'sender' missing or invalid"); + err = gpg_error (GPG_ERR_INV_DATA); + goto leave; + } + sender = value; + /* FIXME: Check that the "sender" matches the From: address. */ + + /* Get the nonce. */ + if (!((item = nvc_lookup (nvc, "nonce:")) && (value = nve_value (item)) + && strlen (value) > 16)) + { + log_error ("received invalid wks message: %s\n", + "'nonce' missing or too short"); + err = gpg_error (GPG_ERR_INV_DATA); + goto leave; + } + nonce = value; + + /* Send the confirmation. If no key was found, try again without + * encryption. */ + err = send_confirmation_response (sender, address, nonce, 1); + if (gpg_err_code (err) == GPG_ERR_NO_PUBKEY) + { + log_info ("no encryption key found - sending response in the clear\n"); + err = send_confirmation_response (sender, address, nonce, 0); + } + + leave: + nvc_release (nvc); + return err; +} + + +/* Called from the MIME receiver to process the plain text data in MSG. */ +static gpg_error_t +command_receive_cb (void *opaque, const char *mediatype, estream_t msg) +{ + gpg_error_t err; + + (void)opaque; + + if (!strcmp (mediatype, "application/vnd.gnupg.wks")) + err = process_confirmation_request (msg); + else + { + log_info ("ignoring unexpected message of type '%s'\n", mediatype); + err = gpg_error (GPG_ERR_UNEXPECTED_MSG); + } + + return err; +} diff --git a/tools/gpg-wks-server.c b/tools/gpg-wks-server.c new file mode 100644 index 000000000..f15085f7d --- /dev/null +++ b/tools/gpg-wks-server.c @@ -0,0 +1,1548 @@ +/* gpg-wks-server.c - A server for the Web Key Service protocols. + * Copyright (C) 2016 Werner Koch + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +/* The Web Key Service I-D defines an update protocol to stpre a + * public key in the Web Key Directory. The current specification is + * draft-koch-openpgp-webkey-service-01.txt. + */ + +#include +#include +#include +#include +#include +#include +#include +#include + +#include "util.h" +#include "init.h" +#include "sysutils.h" +#include "ccparray.h" +#include "exectool.h" +#include "zb32.h" +#include "mbox-util.h" +#include "name-value.h" +#include "mime-maker.h" +#include "send-mail.h" +#include "gpg-wks.h" + + +/* The time we wait for a confirmation response. */ +#define PENDING_TTL (86400 * 3) /* 3 days. */ + + +/* Constants to identify the commands and options. */ +enum cmd_and_opt_values + { + aNull = 0, + + oQuiet = 'q', + oVerbose = 'v', + oOutput = 'o', + + oDebug = 500, + + aReceive, + aCron, + aListDomains, + + oGpgProgram, + oSend, + oFrom, + oHeader, + + oDummy + }; + + +/* The list of commands and options. */ +static ARGPARSE_OPTS opts[] = { + ARGPARSE_group (300, ("@Commands:\n ")), + + ARGPARSE_c (aReceive, "receive", + ("receive a submission or confirmation")), + ARGPARSE_c (aCron, "cron", + ("run regular jobs")), + ARGPARSE_c (aListDomains, "list-domains", + ("list configured domains")), + + ARGPARSE_group (301, ("@\nOptions:\n ")), + + ARGPARSE_s_n (oVerbose, "verbose", ("verbose")), + ARGPARSE_s_n (oQuiet, "quiet", ("be somewhat more quiet")), + ARGPARSE_s_s (oDebug, "debug", "@"), + ARGPARSE_s_s (oGpgProgram, "gpg", "@"), + ARGPARSE_s_n (oSend, "send", "send the mail using sendmail"), + ARGPARSE_s_s (oOutput, "output", "|FILE|write the mail to FILE"), + ARGPARSE_s_s (oFrom, "from", "|ADDR|use ADDR as the default sender"), + ARGPARSE_s_s (oHeader, "header" , + "|NAME=VALUE|add \"NAME: VALUE\" as header to all mails"), + + ARGPARSE_end () +}; + + +/* The list of supported debug flags. */ +static struct debug_flags_s debug_flags [] = + { + { DBG_CRYPTO_VALUE , "crypto" }, + { DBG_MEMORY_VALUE , "memory" }, + { DBG_MEMSTAT_VALUE, "memstat" }, + { DBG_IPC_VALUE , "ipc" }, + { DBG_EXTPROG_VALUE, "extprog" }, + { 0, NULL } + }; + + +/* State for processing a message. */ +struct server_ctx_s +{ + char *fpr; + strlist_t mboxes; /* List of addr-specs taken from the UIDs. */ +}; +typedef struct server_ctx_s *server_ctx_t; + +/* Prototypes. */ +static gpg_error_t get_domain_list (strlist_t *r_list); + +static gpg_error_t command_receive_cb (void *opaque, + const char *mediatype, estream_t fp); +static gpg_error_t command_list_domains (void); +static gpg_error_t command_cron (void); + + + +/* Print usage information and and provide strings for help. */ +static const char * +my_strusage( int level ) +{ + const char *p; + + switch (level) + { + case 11: p = "gpg-wks-server (@GNUPG@)"; + break; + case 13: p = VERSION; break; + case 17: p = PRINTABLE_OS_NAME; break; + case 19: p = ("Please report bugs to <@EMAIL@>.\n"); break; + + case 1: + case 40: + p = ("Usage: gpg-wks-server command [options] (-h for help)"); + break; + case 41: + p = ("Syntax: gpg-wks-server command [options]\n" + "Server for the Web Key Service protocol\n"); + break; + + default: p = NULL; break; + } + return p; +} + + +static void +wrong_args (const char *text) +{ + es_fprintf (es_stderr, "usage: %s [options] %s\n", strusage (11), text); + exit (2); +} + + + +/* Command line parsing. */ +static enum cmd_and_opt_values +parse_arguments (ARGPARSE_ARGS *pargs, ARGPARSE_OPTS *popts) +{ + enum cmd_and_opt_values cmd = 0; + int no_more_options = 0; + + while (!no_more_options && optfile_parse (NULL, NULL, NULL, pargs, popts)) + { + switch (pargs->r_opt) + { + case oQuiet: opt.quiet = 1; break; + case oVerbose: opt.verbose++; break; + case oDebug: + if (parse_debug_flag (pargs->r.ret_str, &opt.debug, debug_flags)) + { + pargs->r_opt = ARGPARSE_INVALID_ARG; + pargs->err = ARGPARSE_PRINT_ERROR; + } + break; + + case oGpgProgram: + opt.gpg_program = pargs->r.ret_str; + break; + case oFrom: + opt.default_from = pargs->r.ret_str; + break; + case oHeader: + append_to_strlist (&opt.extra_headers, pargs->r.ret_str); + break; + case oSend: + opt.use_sendmail = 1; + break; + case oOutput: + opt.output = pargs->r.ret_str; + break; + + case aReceive: + case aCron: + case aListDomains: + cmd = pargs->r_opt; + break; + + default: pargs->err = 2; break; + } + } + + return cmd; +} + + + +/* gpg-wks-server main. */ +int +main (int argc, char **argv) +{ + gpg_error_t err; + ARGPARSE_ARGS pargs; + enum cmd_and_opt_values cmd; + + gnupg_reopen_std ("gpg-wks-server"); + set_strusage (my_strusage); + log_set_prefix ("gpg-wks-server", GPGRT_LOG_WITH_PREFIX); + + /* Make sure that our subsystems are ready. */ + init_common_subsystems (&argc, &argv); + + /* Parse the command line. */ + pargs.argc = &argc; + pargs.argv = &argv; + pargs.flags = ARGPARSE_FLAG_KEEP; + cmd = parse_arguments (&pargs, opts); + + if (log_get_errorcount (0)) + exit (2); + + /* Print a warning if an argument looks like an option. */ + if (!opt.quiet && !(pargs.flags & ARGPARSE_FLAG_STOP_SEEN)) + { + int i; + + for (i=0; i < argc; i++) + if (argv[i][0] == '-' && argv[i][1] == '-') + log_info (("NOTE: '%s' is not considered an option\n"), argv[i]); + } + + /* Set defaults for non given options. */ + if (!opt.gpg_program) + opt.gpg_program = gnupg_module_name (GNUPG_MODULE_NAME_GPG); + + if (!opt.directory) + opt.directory = "/var/lib/gnupg/wks"; + + /* Check for syntax errors in the --header option to avoid later + * error messages with a not easy to find cause */ + if (opt.extra_headers) + { + strlist_t sl; + + for (sl = opt.extra_headers; sl; sl = sl->next) + { + err = mime_maker_add_header (NULL, sl->d, NULL); + if (err) + log_error ("syntax error in \"--header %s\": %s\n", + sl->d, gpg_strerror (err)); + } + } + + if (log_get_errorcount (0)) + exit (2); + + + /* Check that we have a working directory. */ +#if defined(HAVE_STAT) + { + struct stat sb; + + if (stat (opt.directory, &sb)) + { + err = gpg_error_from_syserror (); + log_error ("error accessing directory '%s': %s\n", + opt.directory, gpg_strerror (err)); + exit (2); + } + if (!S_ISDIR(sb.st_mode)) + { + log_error ("error accessing directory '%s': %s\n", + opt.directory, "not a directory"); + exit (2); + } + if (sb.st_uid != getuid()) + { + log_error ("directory '%s' not owned by user\n", opt.directory); + exit (2); + } + if ((sb.st_mode & S_IRWXO)) + { + log_error ("directory '%s' has too relaxed permissions\n", + opt.directory); + exit (2); + } + } +#else /*!HAVE_STAT*/ + log_fatal ("program build w/o stat() call\n"); +#endif /*!HAVE_STAT*/ + + /* Run the selected command. */ + switch (cmd) + { + case aReceive: + if (argc) + wrong_args ("--receive"); + err = wks_receive (es_stdin, command_receive_cb, NULL); + break; + + case aCron: + if (argc) + wrong_args ("--cron"); + err = command_cron (); + break; + + case aListDomains: + err = command_list_domains (); + break; + + default: + usage (1); + err = gpg_error (GPG_ERR_BUG); + break; + } + + if (err) + log_error ("command failed: %s\n", gpg_strerror (err)); + return log_get_errorcount (0)? 1:0; +} + + + +static void +list_key_status_cb (void *opaque, const char *keyword, char *args) +{ + server_ctx_t ctx = opaque; + (void)ctx; + if (opt.debug) + log_debug ("%s: %s\n", keyword, args); +} + + +static gpg_error_t +list_key (server_ctx_t ctx, estream_t key) +{ + gpg_error_t err; + ccparray_t ccp; + const char **argv; + estream_t listing; + char *line = NULL; + size_t length_of_line = 0; + size_t maxlen; + ssize_t len; + char **fields = NULL; + int nfields; + int lnr; + char *mbox = NULL; + + /* We store our results in the context - clear it first. */ + xfree (ctx->fpr); + ctx->fpr = NULL; + free_strlist (ctx->mboxes); + ctx->mboxes = NULL; + + /* Open a memory stream. */ + listing = es_fopenmem (0, "w+b"); + if (!listing) + { + err = gpg_error_from_syserror (); + log_error ("error allocating memory buffer: %s\n", gpg_strerror (err)); + return err; + } + + ccparray_init (&ccp, 0); + + ccparray_put (&ccp, "--no-options"); + if (!opt.verbose) + ccparray_put (&ccp, "--quiet"); + else if (opt.verbose > 1) + ccparray_put (&ccp, "--verbose"); + ccparray_put (&ccp, "--batch"); + ccparray_put (&ccp, "--status-fd=2"); + ccparray_put (&ccp, "--always-trust"); + ccparray_put (&ccp, "--with-colons"); + ccparray_put (&ccp, "--dry-run"); + ccparray_put (&ccp, "--import-options=import-minimal,import-show"); + ccparray_put (&ccp, "--import"); + + ccparray_put (&ccp, NULL); + argv = ccparray_get (&ccp, NULL); + if (!argv) + { + err = gpg_error_from_syserror (); + goto leave; + } + err = gnupg_exec_tool_stream (opt.gpg_program, argv, key, + NULL, listing, + list_key_status_cb, ctx); + if (err) + { + log_error ("import failed: %s\n", gpg_strerror (err)); + goto leave; + } + + es_rewind (listing); + lnr = 0; + maxlen = 2048; /* Set limit. */ + while ((len = es_read_line (listing, &line, &length_of_line, &maxlen)) > 0) + { + lnr++; + if (!maxlen) + { + log_error ("received line too long\n"); + err = gpg_error (GPG_ERR_LINE_TOO_LONG); + goto leave; + } + /* Strip newline and carriage return, if present. */ + while (len > 0 + && (line[len - 1] == '\n' || line[len - 1] == '\r')) + line[--len] = '\0'; + /* log_debug ("line '%s'\n", line); */ + + xfree (fields); + fields = strtokenize (line, ":"); + if (!fields) + { + err = gpg_error_from_syserror (); + log_error ("strtokenize failed: %s\n", gpg_strerror (err)); + goto leave; + } + for (nfields = 0; fields[nfields]; nfields++) + ; + if (!nfields) + { + err = gpg_error (GPG_ERR_INV_ENGINE); + goto leave; + } + if (!strcmp (fields[0], "sec")) + { + /* gpg may return "sec" as the first record - but we do not + * accept secret keys. */ + err = gpg_error (GPG_ERR_NO_PUBKEY); + goto leave; + } + if (lnr == 1 && strcmp (fields[0], "pub")) + { + /* First record is not a public key. */ + err = gpg_error (GPG_ERR_INV_ENGINE); + goto leave; + } + if (lnr > 1 && !strcmp (fields[0], "pub")) + { + /* More than one public key. */ + err = gpg_error (GPG_ERR_TOO_MANY); + goto leave; + } + if (!strcmp (fields[0], "sub") || !strcmp (fields[0], "ssb")) + break; /* We can stop parsing here. */ + + if (!strcmp (fields[0], "fpr") && nfields > 9 && !ctx->fpr) + { + ctx->fpr = xtrystrdup (fields[9]); + if (!ctx->fpr) + { + err = gpg_error_from_syserror (); + goto leave; + } + } + else if (!strcmp (fields[0], "uid") && nfields > 9) + { + /* Fixme: Unescape fields[9] */ + xfree (mbox); + mbox = mailbox_from_userid (fields[9]); + if (mbox && !append_to_strlist_try (&ctx->mboxes, mbox)) + { + err = gpg_error_from_syserror (); + goto leave; + } + } + } + if (len < 0 || es_ferror (listing)) + log_error ("error reading memory stream\n"); + + leave: + xfree (mbox); + xfree (fields); + es_free (line); + xfree (argv); + es_fclose (listing); + return err; +} + + +/* Take the key in KEYFILE and write it to DANEFILE using the DANE + * output format. */ +static gpg_error_t +copy_key_as_dane (const char *keyfile, const char *danefile) +{ + gpg_error_t err; + ccparray_t ccp; + const char **argv; + + ccparray_init (&ccp, 0); + + ccparray_put (&ccp, "--no-options"); + if (!opt.verbose) + ccparray_put (&ccp, "--quiet"); + else if (opt.verbose > 1) + ccparray_put (&ccp, "--verbose"); + ccparray_put (&ccp, "--batch"); + ccparray_put (&ccp, "--yes"); + ccparray_put (&ccp, "--always-trust"); + ccparray_put (&ccp, "--no-keyring"); + ccparray_put (&ccp, "--output"); + ccparray_put (&ccp, danefile); + ccparray_put (&ccp, "--export-options=export-dane"); + ccparray_put (&ccp, "--import-options=import-export"); + ccparray_put (&ccp, "--import"); + ccparray_put (&ccp, "--"); + ccparray_put (&ccp, keyfile); + + ccparray_put (&ccp, NULL); + argv = ccparray_get (&ccp, NULL); + if (!argv) + { + err = gpg_error_from_syserror (); + goto leave; + } + err = gnupg_exec_tool_stream (opt.gpg_program, argv, NULL, + NULL, NULL, NULL, NULL); + if (err) + { + log_error ("%s failed: %s\n", __func__, gpg_strerror (err)); + goto leave; + } + + leave: + xfree (argv); + return err; +} + + +static void +encrypt_stream_status_cb (void *opaque, const char *keyword, char *args) +{ + (void)opaque; + + if (opt.debug) + log_debug ("%s: %s\n", keyword, args); +} + + +/* Encrypt the INPUT stream to a new stream which is stored at success + * at R_OUTPUT. Encryption is done for the key in file KEYFIL. */ +static gpg_error_t +encrypt_stream (estream_t *r_output, estream_t input, const char *keyfile) +{ + gpg_error_t err; + ccparray_t ccp; + const char **argv; + estream_t output; + + *r_output = NULL; + + output = es_fopenmem (0, "w+b"); + if (!output) + { + err = gpg_error_from_syserror (); + log_error ("error allocating memory buffer: %s\n", gpg_strerror (err)); + return err; + } + + ccparray_init (&ccp, 0); + + ccparray_put (&ccp, "--no-options"); + if (!opt.verbose) + ccparray_put (&ccp, "--quiet"); + else if (opt.verbose > 1) + ccparray_put (&ccp, "--verbose"); + ccparray_put (&ccp, "--batch"); + ccparray_put (&ccp, "--status-fd=2"); + ccparray_put (&ccp, "--always-trust"); + ccparray_put (&ccp, "--no-keyring"); + ccparray_put (&ccp, "--armor"); + ccparray_put (&ccp, "--recipient-file"); + ccparray_put (&ccp, keyfile); + ccparray_put (&ccp, "--encrypt"); + ccparray_put (&ccp, "--"); + + ccparray_put (&ccp, NULL); + argv = ccparray_get (&ccp, NULL); + if (!argv) + { + err = gpg_error_from_syserror (); + goto leave; + } + err = gnupg_exec_tool_stream (opt.gpg_program, argv, input, + NULL, output, + encrypt_stream_status_cb, NULL); + if (err) + { + log_error ("encryption failed: %s\n", gpg_strerror (err)); + goto leave; + } + + es_rewind (output); + *r_output = output; + output = NULL; + + leave: + es_fclose (output); + xfree (argv); + return err; +} + + +/* Get the submission address for address MBOX. Caller must free the + * value. If no address can be found NULL is returned. */ +static char * +get_submission_address (const char *mbox) +{ + gpg_error_t err; + const char *domain; + char *fname, *line, *p; + size_t n; + estream_t fp; + + domain = strchr (mbox, '@'); + if (!domain) + return NULL; + domain++; + + fname = make_filename_try (opt.directory, domain, "submission-address", NULL); + if (!fname) + { + err = gpg_error_from_syserror (); + log_error ("make_filename failed in %s: %s\n", + __func__, gpg_strerror (err)); + return NULL; + } + + fp = es_fopen (fname, "r"); + if (!fp) + { + err = gpg_error_from_syserror (); + if (gpg_err_code (err) == GPG_ERR_ENOENT) + log_info ("Note: no specific submission address configured" + " for domain '%s'\n", domain); + else + log_error ("error reading '%s': %s\n", fname, gpg_strerror (err)); + xfree (fname); + return NULL; + } + + line = NULL; + n = 0; + if (es_getline (&line, &n, fp) < 0) + { + err = gpg_error_from_syserror (); + log_error ("error reading '%s': %s\n", fname, gpg_strerror (err)); + xfree (line); + es_fclose (fp); + xfree (fname); + return NULL; + } + es_fclose (fp); + xfree (fname); + + p = strchr (line, '\n'); + if (p) + *p = 0; + trim_spaces (line); + if (!is_valid_mailbox (line)) + { + log_error ("invalid submission address for domain '%s' detected\n", + domain); + xfree (line); + return NULL; + } + + return line; +} + + +/* We store the key under the name of the nonce we will then send to + * the user. On success the nonce is stored at R_NONCE and the file + * name at R_FNAME. */ +static gpg_error_t +store_key_as_pending (const char *dir, estream_t key, + char **r_nonce, char **r_fname) +{ + gpg_error_t err; + char *dname = NULL; + char *fname = NULL; + char *nonce = NULL; + estream_t outfp = NULL; + char buffer[1024]; + size_t nbytes, nwritten; + + *r_nonce = NULL; + *r_fname = NULL; + + dname = make_filename_try (dir, "pending", NULL); + if (!dname) + { + err = gpg_error_from_syserror (); + goto leave; + } + + /* Create the nonce. We use 20 bytes so that we don't waste a + * character in our zBase-32 encoding. Using the gcrypt's nonce + * function is faster than using the strong random function; this is + * Good Enough for our purpose. */ + log_assert (sizeof buffer > 20); + gcry_create_nonce (buffer, 20); + nonce = zb32_encode (buffer, 8 * 20); + memset (buffer, 0, 20); /* Not actually needed but it does not harm. */ + if (!nonce) + { + err = gpg_error_from_syserror (); + goto leave; + } + + fname = strconcat (dname, "/", nonce, NULL); + if (!fname) + { + err = gpg_error_from_syserror (); + goto leave; + } + + /* With 128 bits of random we can expect that no other file exists + * under this name. We use "x" to detect internal errors. */ + outfp = es_fopen (fname, "wbx,mode=-rw"); + if (!outfp) + { + err = gpg_error_from_syserror (); + log_error ("error creating '%s': %s\n", fname, gpg_strerror (err)); + goto leave; + } + es_rewind (key); + for (;;) + { + if (es_read (key, buffer, sizeof buffer, &nbytes)) + { + err = gpg_error_from_syserror (); + log_error ("error reading '%s': %s\n", + es_fname_get (key), gpg_strerror (err)); + break; + } + + if (!nbytes) + { + err = 0; + goto leave; /* Ready. */ + } + if (es_write (outfp, buffer, nbytes, &nwritten)) + { + err = gpg_error_from_syserror (); + log_error ("error writing '%s': %s\n", fname, gpg_strerror (err)); + goto leave; + } + else if (nwritten != nbytes) + { + err = gpg_error (GPG_ERR_EIO); + log_error ("error writing '%s': %s\n", fname, "short write"); + goto leave; + } + } + + leave: + if (err) + { + es_fclose (outfp); + gnupg_remove (fname); + } + else if (es_fclose (outfp)) + { + err = gpg_error_from_syserror (); + log_error ("error closing '%s': %s\n", fname, gpg_strerror (err)); + } + + if (!err) + { + *r_nonce = nonce; + *r_fname = fname; + } + else + { + xfree (nonce); + xfree (fname); + } + xfree (dname); + return err; +} + + +/* Send a confirmation rewqyest. DIR is the directory used for the + * address MBOX. NONCE is the nonce we want to see in the response to + * this mail. FNAME the name of the file with the key. */ +static gpg_error_t +send_confirmation_request (server_ctx_t ctx, + const char *mbox, const char *nonce, + const char *keyfile) +{ + gpg_error_t err; + estream_t body = NULL; + estream_t bodyenc = NULL; + mime_maker_t mime = NULL; + char *from_buffer = NULL; + const char *from; + strlist_t sl; + + from = from_buffer = get_submission_address (mbox); + if (!from) + { + from = opt.default_from; + if (!from) + { + log_error ("no sender address found for '%s'\n", mbox); + err = gpg_error (GPG_ERR_CONFIGURATION); + goto leave; + } + log_info ("Note: using default sender address '%s'\n", from); + } + + body = es_fopenmem (0, "w+b"); + if (!body) + { + err = gpg_error_from_syserror (); + log_error ("error allocating memory buffer: %s\n", gpg_strerror (err)); + goto leave; + } + /* It is fine to use 8 bit encoding because that is encrypted and + * only our client will see it. */ + es_fputs ("Content-Type: application/vnd.gnupg.wks\n" + "Content-Transfer-Encoding: 8bit\n" + "\n", + body); + + es_fprintf (body, ("type: confirmation-request\n" + "sender: %s\n" + "address: %s\n" + "fingerprint: %s\n" + "nonce: %s\n"), + from, + mbox, + ctx->fpr, + nonce); + + es_rewind (body); + err = encrypt_stream (&bodyenc, body, keyfile); + if (err) + goto leave; + es_fclose (body); + body = NULL; + + + err = mime_maker_new (&mime, NULL); + if (err) + goto leave; + err = mime_maker_add_header (mime, "From", from); + if (err) + goto leave; + err = mime_maker_add_header (mime, "To", mbox); + if (err) + goto leave; + err = mime_maker_add_header (mime, "Subject", "Confirm your key publication"); + if (err) + goto leave; + for (sl = opt.extra_headers; sl; sl = sl->next) + { + err = mime_maker_add_header (mime, sl->d, NULL); + if (err) + goto leave; + } + + err = mime_maker_add_header (mime, "Content-Type", + "multipart/encrypted; " + "protocol=\"application/pgp-encrypted\""); + if (err) + goto leave; + err = mime_maker_add_container (mime, "multipart/encrypted"); + if (err) + goto leave; + + err = mime_maker_add_header (mime, "Content-Type", + "application/pgp-encrypted"); + if (err) + goto leave; + err = mime_maker_add_body (mime, "Version: 1\n"); + if (err) + goto leave; + err = mime_maker_add_header (mime, "Content-Type", + "application/octet-stream"); + if (err) + goto leave; + + err = mime_maker_add_stream (mime, &bodyenc); + if (err) + goto leave; + + err = wks_send_mime (mime); + + leave: + mime_maker_release (mime); + es_fclose (bodyenc); + es_fclose (body); + xfree (from_buffer); + return err; +} + + +/* Store the key given by KEY into the pending directory and send a + * confirmation requests. */ +static gpg_error_t +process_new_key (server_ctx_t ctx, estream_t key) +{ + gpg_error_t err; + strlist_t sl; + const char *s; + char *dname = NULL; + char *nonce = NULL; + char *fname = NULL; + + /* First figure out the user id from the key. */ + err = list_key (ctx, key); + if (err) + goto leave; + if (!ctx->fpr) + { + log_error ("error parsing key (no fingerprint)\n"); + err = gpg_error (GPG_ERR_NO_PUBKEY); + goto leave; + } + log_info ("fingerprint: %s\n", ctx->fpr); + for (sl = ctx->mboxes; sl; sl = sl->next) + { + log_info (" addr-spec: %s\n", sl->d); + } + + /* Walk over all user ids and send confirmation requests for those + * we support. */ + for (sl = ctx->mboxes; sl; sl = sl->next) + { + s = strchr (sl->d, '@'); + log_assert (s && s[1]); + xfree (dname); + dname = make_filename_try (opt.directory, s+1, NULL); + if (!dname) + { + err = gpg_error_from_syserror (); + goto leave; + } + /* Fixme: check for proper directory permissions. */ + if (access (dname, W_OK)) + { + log_info ("skipping address '%s': Domain not configured\n", sl->d); + continue; + } + log_info ("storing address '%s'\n", sl->d); + + xfree (nonce); + xfree (fname); + err = store_key_as_pending (dname, key, &nonce, &fname); + if (err) + goto leave; + + err = send_confirmation_request (ctx, sl->d, nonce, fname); + if (err) + goto leave; + } + + leave: + if (nonce) + wipememory (nonce, strlen (nonce)); + xfree (nonce); + xfree (fname); + xfree (dname); + return err; +} + + + +/* Check that we have send a request with NONCE and publish the key. */ +static gpg_error_t +check_and_publish (server_ctx_t ctx, const char *address, const char *nonce) +{ + gpg_error_t err; + char *fname = NULL; + char *fnewname = NULL; + estream_t key = NULL; + char *hash = NULL; + const char *domain; + const char *s; + strlist_t sl; + char shaxbuf[32]; /* Used for SHA-1 and SHA-256 */ + + /* FIXME: There is a bug in name-value.c which adds white space for + * the last pair and thus we strip the nonce here until this has + * been fixed. */ + char *nonce2 = xstrdup (nonce); + trim_trailing_spaces (nonce2); + nonce = nonce2; + + + domain = strchr (address, '@'); + log_assert (domain && domain[1]); + domain++; + fname = make_filename_try (opt.directory, domain, "pending", nonce, NULL); + if (!fname) + { + err = gpg_error_from_syserror (); + goto leave; + } + + /* Try to open the file with the key. */ + key = es_fopen (fname, "rb"); + if (!key) + { + err = gpg_error_from_syserror (); + if (gpg_err_code (err) == GPG_ERR_ENOENT) + { + log_info ("no pending request for '%s'\n", address); + err = gpg_error (GPG_ERR_NOT_FOUND); + } + else + log_error ("error reading '%s': %s\n", fname, gpg_strerror (err)); + goto leave; + } + + /* We need to get the fingerprint from the key. */ + err = list_key (ctx, key); + if (err) + goto leave; + if (!ctx->fpr) + { + log_error ("error parsing key (no fingerprint)\n"); + err = gpg_error (GPG_ERR_NO_PUBKEY); + goto leave; + } + log_info ("fingerprint: %s\n", ctx->fpr); + for (sl = ctx->mboxes; sl; sl = sl->next) + log_info (" addr-spec: %s\n", sl->d); + + /* Check that the key has 'address' as a user id. We use + * case-insensitive matching because the client is expected to + * return the address verbatim. */ + for (sl = ctx->mboxes; sl; sl = sl->next) + if (!strcmp (sl->d, address)) + break; + if (!sl) + { + log_error ("error publishing key: '%s' is not a user ID of %s\n", + address, ctx->fpr); + err = gpg_error (GPG_ERR_NO_PUBKEY); + goto leave; + } + + + /* Hash user ID and create filename. */ + s = strchr (address, '@'); + log_assert (s); + gcry_md_hash_buffer (GCRY_MD_SHA1, shaxbuf, address, s - address); + hash = zb32_encode (shaxbuf, 8*20); + if (!hash) + { + err = gpg_error_from_syserror (); + goto leave; + } + + fnewname = make_filename_try (opt.directory, domain, "hu", hash, NULL); + if (!fnewname) + { + err = gpg_error_from_syserror (); + goto leave; + } + + /* Publish. */ + if (rename (fname, fnewname)) + { + err = gpg_error_from_syserror (); + log_error ("renaming '%s' to '%s' failed: %s\n", + fname, fnewname, gpg_strerror (err)); + goto leave; + } + + log_info ("key %s published for '%s'\n", ctx->fpr, address); + + + /* Try to publish as DANE record if the DANE directory exists. */ + xfree (fname); + fname = fnewname; + fnewname = make_filename_try (opt.directory, domain, "dane", NULL); + if (!fnewname) + { + err = gpg_error_from_syserror (); + goto leave; + } + if (!access (fnewname, W_OK)) + { + /* Yes, we have a dane directory. */ + s = strchr (address, '@'); + log_assert (s); + gcry_md_hash_buffer (GCRY_MD_SHA256, shaxbuf, address, s - address); + xfree (hash); + hash = bin2hex (shaxbuf, 28, NULL); + if (!hash) + { + err = gpg_error_from_syserror (); + goto leave; + } + xfree (fnewname); + fnewname = make_filename_try (opt.directory, domain, "dane", hash, NULL); + if (!fnewname) + { + err = gpg_error_from_syserror (); + goto leave; + } + err = copy_key_as_dane (fname, fnewname); + if (err) + goto leave; + log_info ("key %s published for '%s' (DANE record)\n", ctx->fpr, address); + } + + + leave: + es_fclose (key); + xfree (hash); + xfree (fnewname); + xfree (fname); + xfree (nonce2); + return err; +} + + +/* Process a confirmation response in MSG. */ +static gpg_error_t +process_confirmation_response (server_ctx_t ctx, estream_t msg) +{ + gpg_error_t err; + nvc_t nvc; + nve_t item; + const char *value, *sender, *address, *nonce; + + err = nvc_parse (&nvc, NULL, msg); + if (err) + { + log_error ("parsing the WKS message failed: %s\n", gpg_strerror (err)); + goto leave; + } + + if (opt.debug) + { + log_debug ("response follows:\n"); + nvc_write (nvc, log_get_stream ()); + } + + /* Check that this is a confirmation response. */ + if (!((item = nvc_lookup (nvc, "type:")) && (value = nve_value (item)) + && !strcmp (value, "confirmation-response"))) + { + if (item && value) + log_error ("received unexpected wks message '%s'\n", value); + else + log_error ("received invalid wks message: %s\n", "'type' missing"); + err = gpg_error (GPG_ERR_UNEXPECTED_MSG); + goto leave; + } + + /* Get the sender. */ + if (!((item = nvc_lookup (nvc, "sender:")) && (value = nve_value (item)) + && is_valid_mailbox (value))) + { + log_error ("received invalid wks message: %s\n", + "'sender' missing or invalid"); + err = gpg_error (GPG_ERR_INV_DATA); + goto leave; + } + sender = value; + (void)sender; + /* FIXME: Do we really need the sender?. */ + + /* Get the address. */ + if (!((item = nvc_lookup (nvc, "address:")) && (value = nve_value (item)) + && is_valid_mailbox (value))) + { + log_error ("received invalid wks message: %s\n", + "'address' missing or invalid"); + err = gpg_error (GPG_ERR_INV_DATA); + goto leave; + } + address = value; + + /* Get the nonce. */ + if (!((item = nvc_lookup (nvc, "nonce:")) && (value = nve_value (item)) + && strlen (value) > 16)) + { + log_error ("received invalid wks message: %s\n", + "'nonce' missing or too short"); + err = gpg_error (GPG_ERR_INV_DATA); + goto leave; + } + nonce = value; + + err = check_and_publish (ctx, address, nonce); + + + leave: + nvc_release (nvc); + return err; +} + + + +/* Called from the MIME receiver to process the plain text data in MSG . */ +static gpg_error_t +command_receive_cb (void *opaque, const char *mediatype, estream_t msg) +{ + gpg_error_t err; + struct server_ctx_s ctx; + + memset (&ctx, 0, sizeof ctx); + + (void)opaque; + + if (!strcmp (mediatype, "application/pgp-keys")) + err = process_new_key (&ctx, msg); + else if (!strcmp (mediatype, "application/vnd.gnupg.wks")) + err = process_confirmation_response (&ctx, msg); + else + { + log_info ("ignoring unexpected message of type '%s'\n", mediatype); + err = gpg_error (GPG_ERR_UNEXPECTED_MSG); + } + + xfree (ctx.fpr); + free_strlist (ctx.mboxes); + + return err; +} + + + +/* Return a list of all configured domains. ECh list element is the + * top directory for for the domain. To figure out the actual domain + * name strrchr(name, '/') can be used. */ +static gpg_error_t +get_domain_list (strlist_t *r_list) +{ + gpg_error_t err; + DIR *dir = NULL; + char *fname = NULL; + struct dirent *dentry; + struct stat sb; + strlist_t list = NULL; + + *r_list = NULL; + + dir = opendir (opt.directory); + if (!dir) + { + err = gpg_error_from_syserror (); + goto leave; + } + + while ((dentry = readdir (dir))) + { + if (*dentry->d_name == '.') + continue; + if (!strchr (dentry->d_name, '.')) + continue; /* No dot - can't be a domain subdir. */ + + xfree (fname); + fname = make_filename_try (opt.directory, dentry->d_name, NULL); + if (!fname) + { + err = gpg_error_from_syserror (); + log_error ("make_filename failed in %s: %s\n", + __func__, gpg_strerror (err)); + goto leave; + } + + if (stat (fname, &sb)) + { + err = gpg_error_from_syserror (); + log_error ("error accessing '%s': %s\n", fname, gpg_strerror (err)); + continue; + } + if (!S_ISDIR(sb.st_mode)) + continue; + + if (!add_to_strlist_try (&list, fname)) + { + err = gpg_error_from_syserror (); + log_error ("add_to_strlist failed in %s: %s\n", + __func__, gpg_strerror (err)); + goto leave; + } + } + err = 0; + *r_list = list; + list = NULL; + + leave: + free_strlist (list); + if (dir) + closedir (dir); + xfree (fname); + return err; +} + + + +static gpg_error_t +expire_one_domain (const char *top_dirname, const char *domain) +{ + gpg_error_t err; + char *dirname; + char *fname = NULL; + DIR *dir = NULL; + struct dirent *dentry; + struct stat sb; + time_t now = gnupg_get_time (); + + dirname = make_filename_try (top_dirname, "pending", NULL); + if (!dirname) + { + err = gpg_error_from_syserror (); + log_error ("make_filename failed in %s: %s\n", + __func__, gpg_strerror (err)); + goto leave; + } + + dir = opendir (dirname); + if (!dir) + { + err = gpg_error_from_syserror (); + log_error (("can't access directory '%s': %s\n"), + dirname, gpg_strerror (err)); + goto leave; + } + + while ((dentry = readdir (dir))) + { + if (*dentry->d_name == '.') + continue; + xfree (fname); + fname = make_filename_try (dirname, dentry->d_name, NULL); + if (!fname) + { + err = gpg_error_from_syserror (); + log_error ("make_filename failed in %s: %s\n", + __func__, gpg_strerror (err)); + goto leave; + } + if (strlen (dentry->d_name) != 32) + { + log_info ("garbage file '%s' ignored\n", fname); + continue; + } + if (stat (fname, &sb)) + { + err = gpg_error_from_syserror (); + log_error ("error accessing '%s': %s\n", fname, gpg_strerror (err)); + continue; + } + if (S_ISDIR(sb.st_mode)) + { + log_info ("garbage directory '%s' ignored\n", fname); + continue; + } + if (sb.st_mtime + PENDING_TTL < now) + { + if (opt.verbose) + log_info ("domain %s: removing pending key '%s'\n", + domain, dentry->d_name); + if (remove (fname)) + { + err = gpg_error_from_syserror (); + /* In case the file has just been renamed or another + * processes is cleaning up, we don't print a diagnostic + * for ENOENT. */ + if (gpg_err_code (err) != GPG_ERR_ENOENT) + log_error ("error removing '%s': %s\n", + fname, gpg_strerror (err)); + } + } + } + err = 0; + + leave: + if (dir) + closedir (dir); + xfree (dirname); + xfree (fname); + return err; + +} + + +/* Scan spool directories and expire too old pending keys. */ +static gpg_error_t +expire_pending_confirmations (strlist_t domaindirs) +{ + gpg_error_t err = 0; + strlist_t sl; + const char *domain; + + for (sl = domaindirs; sl; sl = sl->next) + { + domain = strrchr (sl->d, '/'); + log_assert (domain); + domain++; + + expire_one_domain (sl->d, domain); + } + + return err; +} + + +/* List all configured domains. */ +static gpg_error_t +command_list_domains (void) +{ + static struct { + const char *name; + const char *perm; + } requireddirs[] = { + { "pending", "-rwx" }, + { "hu", "-rwxr-xr-x" } + }; + + gpg_error_t err; + strlist_t domaindirs; + strlist_t sl; + const char *domain; + char *fname = NULL; + int i; + + err = get_domain_list (&domaindirs); + if (err) + { + log_error ("error reading list of domains: %s\n", gpg_strerror (err)); + return err; + } + + for (sl = domaindirs; sl; sl = sl->next) + { + domain = strrchr (sl->d, '/'); + log_assert (domain); + domain++; + es_printf ("%s\n", domain); + + /* Check that the required directories are there. */ + for (i=0; i < DIM (requireddirs); i++) + { + xfree (fname); + fname = make_filename_try (sl->d, requireddirs[i].name, NULL); + if (!fname) + { + err = gpg_error_from_syserror (); + goto leave; + } + if (access (fname, W_OK)) + { + err = gpg_error_from_syserror (); + if (gpg_err_code (err) == GPG_ERR_ENOENT) + { + if (gnupg_mkdir (fname, requireddirs[i].perm)) + { + err = gpg_error_from_syserror (); + log_error ("domain %s: error creating subdir '%s': %s\n", + domain, requireddirs[i].name, + gpg_strerror (err)); + } + else + log_info ("domain %s: subdir '%s' created\n", + domain, requireddirs[i].name); + } + else if (err) + log_error ("domain %s: problem with subdir '%s': %s\n", + domain, requireddirs[i].name, gpg_strerror (err)); + } + } + + /* Print a warning if the sumbission address is not configured. */ + xfree (fname); + fname = make_filename_try (sl->d, "submission-address", NULL); + if (!fname) + { + err = gpg_error_from_syserror (); + goto leave; + } + if (access (fname, F_OK)) + { + err = gpg_error_from_syserror (); + if (gpg_err_code (err) == GPG_ERR_ENOENT) + log_error ("domain %s: submission address not configured\n", + domain); + else + log_error ("domain %s: problem with '%s': %s\n", + domain, fname, gpg_strerror (err)); + } + } + err = 0; + + leave: + xfree (fname); + free_strlist (domaindirs); + return err; +} + + +/* Run regular maintenance jobs. */ +static gpg_error_t +command_cron (void) +{ + gpg_error_t err; + strlist_t domaindirs; + + err = get_domain_list (&domaindirs); + if (err) + { + log_error ("error reading list of domains: %s\n", gpg_strerror (err)); + return err; + } + + err = expire_pending_confirmations (domaindirs); + + free_strlist (domaindirs); + return err; +} diff --git a/tools/gpg-wks.h b/tools/gpg-wks.h new file mode 100644 index 000000000..be85eecfb --- /dev/null +++ b/tools/gpg-wks.h @@ -0,0 +1,61 @@ +/* gpg-wks.h - Common definitions for wks server and client. + * Copyright (C) 2016 g10 Code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#ifndef GNUPG_GPG_WKS_H +#define GNUPG_GPG_WKS_H + +#include "../common/util.h" +#include "../common/strlist.h" +#include "mime-maker.h" + +/* We keep all global options in the structure OPT. */ +struct +{ + int verbose; + unsigned int debug; + int quiet; + int use_sendmail; + const char *output; + const char *gpg_program; + const char *directory; + const char *default_from; + strlist_t extra_headers; +} opt; + +/* Debug values and macros. */ +#define DBG_CRYPTO_VALUE 4 /* Debug low level crypto. */ +#define DBG_MEMORY_VALUE 32 /* Debug memory allocation stuff. */ +#define DBG_MEMSTAT_VALUE 128 /* Show memory statistics. */ +#define DBG_IPC_VALUE 1024 /* Debug assuan communication. */ +#define DBG_EXTPROG_VALUE 16384 /* debug external program calls */ + + +/*-- wks-util.c --*/ +gpg_error_t wks_send_mime (mime_maker_t mime); + +/*-- wks-receive.c --*/ +gpg_error_t wks_receive (estream_t fp, + gpg_error_t (*result_cb)(void *opaque, + const char *mediatype, + estream_t data), + void *cb_data); + + + +#endif /*GNUPG_GPG_WKS_H*/ diff --git a/tools/gpgconf.c b/tools/gpgconf.c index 2b177e233..ad61511d3 100644 --- a/tools/gpgconf.c +++ b/tools/gpgconf.c @@ -147,6 +147,64 @@ get_outfp (estream_t *fp) } +static void +list_dirs (estream_t fp, char **names) +{ + static struct { + const char *name; + const char *(*fnc)(void); + const char *extra; + int special; + } list[] = { + { "sysconfdir", gnupg_sysconfdir, NULL }, + { "bindir", gnupg_bindir, NULL }, + { "libexecdir", gnupg_libexecdir, NULL }, + { "libdir", gnupg_libdir, NULL }, + { "datadir", gnupg_datadir, NULL }, + { "localedir", gnupg_localedir, NULL }, + { "dirmngr-socket", dirmngr_user_socket_name, NULL, 1 }, + { "dirmngr-socket", dirmngr_sys_socket_name, NULL, 2 }, + { "dirmngr-sys-socket", dirmngr_sys_socket_name, NULL, 1 }, + { "agent-ssh-socket", gnupg_socketdir, GPG_AGENT_SSH_SOCK_NAME }, + { "agent-socket", gnupg_socketdir, GPG_AGENT_SOCK_NAME }, + { "homedir", gnupg_homedir, NULL } + }; + int idx, j; + char *tmp; + const char *s; + + + for (idx = 0; idx < DIM (list); idx++) + { + if (list[idx].special == 1 && dirmngr_user_socket_name ()) + ; + else if (list[idx].special == 2 && !dirmngr_user_socket_name ()) + ; + else if (list[idx].special == 1 || list[idx].special == 2) + continue; + + s = list[idx].fnc (); + if (list[idx].extra) + { + tmp = make_filename (s, list[idx].extra, NULL); + s = tmp; + } + else + tmp = NULL; + if (!names) + es_fprintf (fp, "%s:%s\n", list[idx].name, gc_percent_escape (s)); + else + { + for (j=0; names[j]; j++) + if (!strcmp (names[j], list[idx].name)) + es_fprintf (fp, "%s\n", s); + } + + xfree (tmp); + } +} + + /* gpgconf main. */ int main (int argc, char **argv) @@ -357,43 +415,7 @@ main (int argc, char **argv) case aListDirs: /* Show the system configuration directories for gpgconf. */ get_outfp (&outfp); - es_fprintf (outfp, "sysconfdir:%s\n", - gc_percent_escape (gnupg_sysconfdir ())); - es_fprintf (outfp, "bindir:%s\n", - gc_percent_escape (gnupg_bindir ())); - es_fprintf (outfp, "libexecdir:%s\n", - gc_percent_escape (gnupg_libexecdir ())); - es_fprintf (outfp, "libdir:%s\n", - gc_percent_escape (gnupg_libdir ())); - es_fprintf (outfp, "datadir:%s\n", - gc_percent_escape (gnupg_datadir ())); - es_fprintf (outfp, "localedir:%s\n", - gc_percent_escape (gnupg_localedir ())); - - if (dirmngr_user_socket_name ()) - { - es_fprintf (outfp, "dirmngr-socket:%s\n", - gc_percent_escape (dirmngr_user_socket_name ())); - es_fprintf (outfp, "dirmngr-sys-socket:%s\n", - gc_percent_escape (dirmngr_sys_socket_name ())); - } - else - { - es_fprintf (outfp, "dirmngr-socket:%s\n", - gc_percent_escape (dirmngr_sys_socket_name ())); - } - - { - char *tmp = make_filename (gnupg_socketdir (), - GPG_AGENT_SOCK_NAME, NULL); - es_fprintf (outfp, "agent-socket:%s\n", gc_percent_escape (tmp)); - xfree (tmp); - } - { - char *tmp = xstrdup (gnupg_homedir ()); - es_fprintf (outfp, "homedir:%s\n", gc_percent_escape (tmp)); - xfree (tmp); - } + list_dirs (outfp, argc? argv : NULL); break; case aCreateSocketDir: diff --git a/tools/gpgtar-extract.c b/tools/gpgtar-extract.c index 866215b2c..cee609c6a 100644 --- a/tools/gpgtar-extract.c +++ b/tools/gpgtar-extract.c @@ -282,7 +282,7 @@ gpgtar_extract (const char *filename, int decrypt) if (filename) { if (!strcmp (filename, "-")) - stream = es_stdout; + stream = es_stdin; else stream = es_fopen (filename, "rb"); if (!stream) diff --git a/tools/gpgtar-list.c b/tools/gpgtar-list.c index 1d59d9c65..cb2e70048 100644 --- a/tools/gpgtar-list.c +++ b/tools/gpgtar-list.c @@ -282,7 +282,7 @@ gpgtar_list (const char *filename, int decrypt) if (filename) { if (!strcmp (filename, "-")) - stream = es_stdout; + stream = es_stdin; else stream = es_fopen (filename, "rb"); if (!stream) diff --git a/tools/gpgtar.c b/tools/gpgtar.c index 416f51446..fcbee5086 100644 --- a/tools/gpgtar.c +++ b/tools/gpgtar.c @@ -48,6 +48,8 @@ enum cmd_and_opt_values { aNull = 0, + aCreate = 600, + aExtract, aEncrypt = 'e', aDecrypt = 'd', aSign = 's', @@ -84,8 +86,10 @@ enum cmd_and_opt_values static ARGPARSE_OPTS opts[] = { ARGPARSE_group (300, N_("@Commands:\n ")), - ARGPARSE_c (aEncrypt, "encrypt", N_("create an archive")), - ARGPARSE_c (aDecrypt, "decrypt", N_("extract an archive")), + ARGPARSE_c (aCreate, "create", N_("create an archive")), + ARGPARSE_c (aExtract, "extract", N_("extract an archive")), + ARGPARSE_c (aEncrypt, "encrypt", N_("create an encrypted archive")), + ARGPARSE_c (aDecrypt, "decrypt", N_("extract an encrypted archive")), ARGPARSE_c (aSign, "sign", N_("create a signed archive")), ARGPARSE_c (aList, "list-archive", N_("list an archive")), @@ -275,7 +279,12 @@ shell_parse_argv (const char *s, int *r_argc, char ***r_argv) return 1; for (i = 0; list; i++) - (*r_argv)[i] = list->d, list = list->next; + { + gpgrt_annotate_leaked_object (list); + (*r_argv)[i] = list->d; + list = list->next; + } + gpgrt_annotate_leaked_object (*r_argv); return 0; } @@ -312,6 +321,16 @@ parse_arguments (ARGPARSE_ARGS *pargs, ARGPARSE_OPTS *popts) set_cmd (&cmd, pargs->r_opt); break; + case aCreate: + set_cmd (&cmd, aEncrypt); + skip_crypto = 1; + break; + + case aExtract: + set_cmd (&cmd, aDecrypt); + skip_crypto = 1; + break; + case oRecipient: add_to_strlist (&opt.recipients, pargs->r.ret_str); break; diff --git a/tools/mime-maker.c b/tools/mime-maker.c new file mode 100644 index 000000000..fa4204328 --- /dev/null +++ b/tools/mime-maker.c @@ -0,0 +1,667 @@ +/* mime-maker.c - Create MIME structures + * Copyright (C) 2016 g10 Code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#include +#include +#include +#include + +#include "util.h" +#include "zb32.h" +#include "mime-maker.h" + + +/* All valid charachters in a header name. */ +#define HEADER_NAME_CHARS ("abcdefghijklmnopqrstuvwxyz" \ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" \ + "-01234567890") + +/* An object to store an header. Also used for a list of headers. */ +struct header_s +{ + struct header_s *next; + char *value; /* Malloced value. */ + char name[1]; /* Name. */ +}; +typedef struct header_s *header_t; + + +/* An object to store a MIME part. A part is the header plus the + * content (body). */ +struct part_s +{ + struct part_s *next; /* Next part in the current container. */ + struct part_s *child; /* Child container. */ + char *mediatype; /* Mediatype of the container (malloced). */ + char *boundary; /* Malloced boundary string. */ + header_t headers; /* List of headers. */ + header_t *headers_tail;/* Address of last header in chain. */ + size_t bodylen; /* Length of BODY. */ + char *body; /* Malloced buffer with the body. This is the + * non-encoded value. */ +}; +typedef struct part_s *part_t; + + + +/* Definition of the mime parser object. */ +struct mime_maker_context_s +{ + void *cookie; /* Cookie passed to all callbacks. */ + + unsigned int verbose:1; /* Enable verbose mode. */ + unsigned int debug:1; /* Enable debug mode. */ + + part_t mail; /* The MIME tree. */ + part_t current_part; + + int boundary_counter; /* Used to create easy to read boundaries. */ + char *boundary_suffix; /* Random string used in the boundaries. */ + + struct b64state *b64state; /* NULL or malloced Base64 decoder state. */ + + /* Helper to convey the output stream to recursive functions. */ + estream_t outfp; +}; + + +/* Create a new mime make object. COOKIE is a values woich will be + * used as first argument for all callbacks registered with this + * object. */ +gpg_error_t +mime_maker_new (mime_maker_t *r_maker, void *cookie) +{ + mime_maker_t ctx; + + *r_maker = NULL; + + ctx = xtrycalloc (1, sizeof *ctx); + if (!ctx) + return gpg_error_from_syserror (); + ctx->cookie = cookie; + + *r_maker = ctx; + return 0; +} + + +static void +release_parts (part_t part) +{ + while (part) + { + part_t partnext = part->next; + while (part->headers) + { + header_t hdrnext = part->headers->next; + xfree (part->headers); + part->headers = hdrnext; + } + release_parts (part->child); + xfree (part->mediatype); + xfree (part->boundary); + xfree (part->body); + xfree (part); + part = partnext; + } +} + + +/* Release a mime maker object. */ +void +mime_maker_release (mime_maker_t ctx) +{ + if (!ctx) + return; + + release_parts (ctx->mail); + xfree (ctx->boundary_suffix); + xfree (ctx); +} + + +/* Set verbose and debug mode. */ +void +mime_maker_set_verbose (mime_maker_t ctx, int level) +{ + if (!level) + { + ctx->verbose = 0; + ctx->debug = 0; + } + else + { + ctx->verbose = 1; + if (level > 10) + ctx->debug = 1; + } +} + + +static void +dump_parts (part_t part, int level) +{ + header_t hdr; + + for (; part; part = part->next) + { + log_debug ("%*s[part]\n", level*2, ""); + for (hdr = part->headers; hdr; hdr = hdr->next) + { + log_debug ("%*s%s: %s\n", level*2, "", hdr->name, hdr->value); + } + log_debug ("%*s[body %zu bytes]\n", level*2, "", part->bodylen); + if (part->child) + { + log_debug ("%*s[container]\n", level*2, ""); + dump_parts (part->child, level+1); + } + } +} + + +/* Dump the mime tree for debugging. */ +void +mime_maker_dump_tree (mime_maker_t ctx) +{ + dump_parts (ctx->mail, 0); +} + + +/* Find the parent node for NEEDLE starting at ROOT. */ +static part_t +find_parent (part_t root, part_t needle) +{ + part_t node, n; + + for (node = root->child; node; node = node->next) + { + if (node == needle) + return root; + if ((n = find_parent (node, needle))) + return n; + } + return NULL; +} + + +/* Create a boundary string. Outr codes is aware of the general + * structure of that string (gebins with "=-=") so that + * it can protect against accidently used boundaries within the + * content. */ +static char * +generate_boundary (mime_maker_t ctx) +{ + if (!ctx->boundary_suffix) + { + char buffer[12]; + + gcry_create_nonce (buffer, sizeof buffer); + ctx->boundary_suffix = zb32_encode (buffer, 8 * sizeof buffer); + if (!ctx->boundary_suffix) + return NULL; + } + + ctx->boundary_counter++; + return es_bsprintf ("=-=%02d-%s=-=", + ctx->boundary_counter, ctx->boundary_suffix); +} + + +/* Ensure that the context has a MAIL and CURRENT_PART object and + * return the parent object if available */ +static gpg_error_t +ensure_part (mime_maker_t ctx, part_t *r_parent) +{ + if (!ctx->mail) + { + ctx->mail = xtrycalloc (1, sizeof *ctx->mail); + if (!ctx->mail) + return gpg_error_from_syserror (); + log_assert (!ctx->current_part); + ctx->current_part = ctx->mail; + ctx->current_part->headers_tail = &ctx->current_part->headers; + } + log_assert (ctx->current_part); + if (r_parent) + *r_parent = find_parent (ctx->mail, ctx->current_part); + + return 0; +} + + +/* Transform a header name into a standard capitalized format. + * "Content-Type". Conversion stops at the colon. */ +static void +capitalize_header_name (char *name) +{ + unsigned char *p = name; + int first = 1; + + /* Special cases first. */ + if (!ascii_strcasecmp (name, "MIME-Version")) + { + strcpy (name, "MIME-Version"); + return; + } + + /* Regular cases. */ + for (; *p && *p != ':'; p++) + { + if (*p == '-') + first = 1; + else if (first) + { + if (*p >= 'a' && *p <= 'z') + *p = *p - 'a' + 'A'; + first = 0; + } + else if (*p >= 'A' && *p <= 'Z') + *p = *p - 'A' + 'a'; + } +} + + +/* Check whether a header with NAME has already been set into PART. + * NAME must be in canonical capitalized format. Return true or + * false. */ +static int +have_header (part_t part, const char *name) +{ + header_t hdr; + + for (hdr = part->headers; hdr; hdr = hdr->next) + if (!strcmp (hdr->name, name)) + return 1; + return 0; +} + + +/* Helper to add a header to a part. */ +static gpg_error_t +add_header (part_t part, const char *name, const char *value) +{ + gpg_error_t err; + header_t hdr; + size_t namelen; + const char *s; + + if (!value) + { + s = strchr (name, '='); + if (!s) + return gpg_error (GPG_ERR_INV_ARG); + namelen = s - name; + value = s+1; + } + else + namelen = strlen (name); + + hdr = xtrymalloc (sizeof *hdr + namelen); + if (!hdr) + return gpg_error_from_syserror (); + hdr->next = NULL; + memcpy (hdr->name, name, namelen); + hdr->name[namelen] = 0; + + /* Check that the header name is valid. We allow all lower and + * uppercase letters and, except for the first character, digits and + * the dash. */ + if (strspn (hdr->name, HEADER_NAME_CHARS) != namelen + || strchr ("-0123456789", *hdr->name)) + { + xfree (hdr); + return gpg_error (GPG_ERR_INV_NAME); + } + + capitalize_header_name (hdr->name); + hdr->value = xtrystrdup (value); + if (!hdr->value) + { + err = gpg_error_from_syserror (); + xfree (hdr); + return err; + } + + if (part) + { + *part->headers_tail = hdr; + part->headers_tail = &hdr->next; + } + else + xfree (hdr); + + return 0; +} + + +/* Add a header with NAME and VALUE to the current mail. A LF in the + * VALUE will be handled automagically. If NULL is used for VALUE it + * is expected that the NAME has the format "NAME=VALUE" and VALUE is + * taken from there. + * + * If no container has been added, the header will be used for the + * regular mail headers and not for a MIME part. If the current part + * is in a container and a body has been added, we append a new part + * to the current container. Thus for a non-MIME mail the caller + * needs to call this function followed by a call to add a body. When + * adding a Content-Type the boundary parameter must not be included. + */ +gpg_error_t +mime_maker_add_header (mime_maker_t ctx, const char *name, const char *value) +{ + gpg_error_t err; + part_t part, parent; + + /* Hack to use this fucntion for a synacx check of NAME and VALUE. */ + if (!ctx) + return add_header (NULL, name, value); + + err = ensure_part (ctx, &parent); + if (err) + return err; + part = ctx->current_part; + + if (part->body && !parent) + { + /* We already have a body but no parent. Adding another part is + * thus not possible. */ + return gpg_error (GPG_ERR_CONFLICT); + } + if (part->body) + { + /* We already have a body and there is a parent. We now append + * a new part to the current container. */ + part = xtrycalloc (1, sizeof *part); + if (!part) + return gpg_error_from_syserror (); + part->headers_tail = &part->headers; + log_assert (!ctx->current_part->next); + ctx->current_part->next = part; + ctx->current_part = part; + } + + /* If no NAME and no VALUE has been given we do not add a header. + * This can be used to create a new part without any header. */ + if (!name && !value) + return 0; + + /* If we add Content-Type, make sure that we have a MIME-version + * header first; this simply looks better. */ + if (!ascii_strcasecmp (name, "Content-Type") + && !have_header (ctx->mail, "MIME-Version")) + { + err = add_header (ctx->mail, "MIME-Version", "1.0"); + if (err) + return err; + } + return add_header (part, name, value); +} + + +/* Helper for mime_maker_add_{body,stream}. */ +static gpg_error_t +add_body (mime_maker_t ctx, const void *data, size_t datalen) +{ + gpg_error_t err; + part_t part, parent; + + err = ensure_part (ctx, &parent); + if (err) + return err; + part = ctx->current_part; + if (part->body) + return gpg_error (GPG_ERR_CONFLICT); + + part->body = xtrymalloc (datalen? datalen : 1); + if (!part->body) + return gpg_error_from_syserror (); + part->bodylen = datalen; + if (data) + memcpy (part->body, data, datalen); + + return 0; +} + + +/* Add STRING as body to the mail or the current MIME container. A + * second call to this function is not allowed. + * + * FIXME: We may want to have an append_body to add more data to a body. + */ +gpg_error_t +mime_maker_add_body (mime_maker_t ctx, const char *string) +{ + return add_body (ctx, string, strlen (string)); +} + + +/* This is the same as mime_maker_add_body but takes a stream as + * argument. As of now the stream is copied to the MIME object but + * eventually we may delay that and read the stream only at the time + * it is needed. Note that the address of the stream object must be + * passed and that the ownership of the stream is transferred to this + * MIME object. To indicate the latter the function will store NULL + * at the ADDR_STREAM so that a caller can't use that object anymore + * except for es_fclose which accepts a NULL pointer. */ +gpg_error_t +mime_maker_add_stream (mime_maker_t ctx, estream_t *stream_addr) +{ + void *data; + size_t datalen; + + es_rewind (*stream_addr); + if (es_fclose_snatch (*stream_addr, &data, &datalen)) + return gpg_error_from_syserror (); + *stream_addr = NULL; + return add_body (ctx, data, datalen); +} + + +/* Add a new MIME container. The caller needs to provide the media + * and media-subtype in MEDIATYPE. If MEDIATYPE is NULL + * "multipart/mixed" is assumed. This function will then add a + * Content-Type header with that media type and an approriate boundary + * string to the parent part. */ +gpg_error_t +mime_maker_add_container (mime_maker_t ctx, const char *mediatype) +{ + gpg_error_t err; + part_t part; + + if (!mediatype) + mediatype = "multipart/mixed"; + + err = ensure_part (ctx, NULL); + if (err) + return err; + part = ctx->current_part; + if (part->body) + return gpg_error (GPG_ERR_CONFLICT); /* There is already a body. */ + if (part->child || part->mediatype || part->boundary) + return gpg_error (GPG_ERR_CONFLICT); /* There is already a container. */ + + /* If a content type has not yet been set, do it now. The boundary + * will be added while writing the headers. */ + if (!have_header (ctx->mail, "Content-Type")) + { + err = add_header (ctx->mail, "Content-Type", mediatype); + if (err) + return err; + } + + /* Create a child node. */ + part->child = xtrycalloc (1, sizeof *part->child); + if (!part->child) + return gpg_error_from_syserror (); + part->child->headers_tail = &part->child->headers; + + part->mediatype = xtrystrdup (mediatype); + if (!part->mediatype) + { + err = gpg_error_from_syserror (); + xfree (part->child); + part->child = NULL; + return err; + } + + part->boundary = generate_boundary (ctx); + if (!part->boundary) + { + err = gpg_error_from_syserror (); + xfree (part->child); + part->child = NULL; + xfree (part->mediatype); + part->mediatype = NULL; + return err; + } + + part = part->child; + ctx->current_part = part; + + return 0; +} + + +/* Write the Content-Type header with the boundary value. */ +static gpg_error_t +write_ct_with_boundary (mime_maker_t ctx, + const char *value, const char *boundary) +{ + const char *s; + + if (!*value) + return gpg_error (GPG_ERR_INV_VALUE); /* Empty string. */ + + for (s=value + strlen (value) - 1; + (s >= value + && (*s == ' ' || *s == '\t' || *s == '\n')); + s--) + ; + if (!(s >= value)) + return gpg_error (GPG_ERR_INV_VALUE); /* Only spaces. */ + + /* Fixme: We should use a dedicated header write functions which + * properly wraps the header. */ + es_fprintf (ctx->outfp, "Content-Type: %s%s\n\tboundary=\"%s\"\n", + value, + (*s == ';')? "":";", + boundary); + return 0; +} + + +/* Recursive worker for mime_maker_make. */ +static gpg_error_t +write_tree (mime_maker_t ctx, part_t parent, part_t part) +{ + gpg_error_t err; + header_t hdr; + + for (; part; part = part->next) + { + for (hdr = part->headers; hdr; hdr = hdr->next) + { + if (part->child && !strcmp (hdr->name, "Content-Type")) + write_ct_with_boundary (ctx, hdr->value, part->boundary); + else + es_fprintf (ctx->outfp, "%s: %s\n", hdr->name, hdr->value); + } + es_fputc ('\n', ctx->outfp); + if (part->body) + { + if (es_write (ctx->outfp, part->body, part->bodylen, NULL)) + return gpg_error_from_syserror (); + } + if (part->child) + { + log_assert (part->boundary); + if (es_fprintf (ctx->outfp, "\n--%s\n", part->boundary) < 0) + return gpg_error_from_syserror (); + err = write_tree (ctx, part, part->child); + if (err) + return err; + if (es_fprintf (ctx->outfp, "\n--%s--\n", part->boundary) < 0) + return gpg_error_from_syserror (); + } + + if (part->next) + { + log_assert (parent && parent->boundary); + if (es_fprintf (ctx->outfp, "\n--%s\n", parent->boundary) < 0) + return gpg_error_from_syserror (); + } + } + return 0; +} + + +/* Add headers we always require. */ +static gpg_error_t +add_missing_headers (mime_maker_t ctx) +{ + gpg_error_t err; + + if (!ctx->mail) + return gpg_error (GPG_ERR_NO_DATA); + if (!have_header (ctx->mail, "MIME-Version")) + { + /* Even if a Content-Type has never been set, we want to + * announce that we do MIME. */ + err = add_header (ctx->mail, "MIME-Version", "1.0"); + if (err) + goto leave; + } + + if (!have_header (ctx->mail, "Date")) + { + char *p = rfctimestamp (make_timestamp ()); + if (!p) + err = gpg_error_from_syserror (); + else + err = add_header (ctx->mail, "Date", p); + xfree (p); + if (err) + goto leave; + } + + + leave: + return err; +} + + +/* Create message from the tree MIME and write it to FP. Noet that + * the output uses only a LF and a later called sendmail(1) is + * expected to convert them to network line endings. */ +gpg_error_t +mime_maker_make (mime_maker_t ctx, estream_t fp) +{ + gpg_error_t err; + + err = add_missing_headers (ctx); + if (err) + return err; + + ctx->outfp = fp; + err = write_tree (ctx, NULL, ctx->mail); + + ctx->outfp = NULL; + return err; +} diff --git a/tools/mime-maker.h b/tools/mime-maker.h new file mode 100644 index 000000000..b21f7dd3d --- /dev/null +++ b/tools/mime-maker.h @@ -0,0 +1,43 @@ +/* mime-maker.h - Create MIME structures + * Copyright (C) 2016 g10 Code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#ifndef GNUPG_MIME_MAKER_H +#define GNUPG_MIME_MAKER_H + +struct mime_maker_context_s; +typedef struct mime_maker_context_s *mime_maker_t; + +gpg_error_t mime_maker_new (mime_maker_t *r_ctx, void *cookie); +void mime_maker_release (mime_maker_t ctx); + +void mime_maker_set_verbose (mime_maker_t ctx, int level); + +void mime_maker_dump_tree (mime_maker_t ctx); + +gpg_error_t mime_maker_add_header (mime_maker_t ctx, + const char *name, const char *value); +gpg_error_t mime_maker_add_body (mime_maker_t ctx, const char *string); +gpg_error_t mime_maker_add_stream (mime_maker_t ctx, estream_t *stream_addr); +gpg_error_t mime_maker_add_container (mime_maker_t ctx, const char *mediatype); + +gpg_error_t mime_maker_make (mime_maker_t ctx, estream_t fp); + + + +#endif /*GNUPG_MIME_MAKER_H*/ diff --git a/tools/mime-parser.c b/tools/mime-parser.c new file mode 100644 index 000000000..5f3659ee5 --- /dev/null +++ b/tools/mime-parser.c @@ -0,0 +1,772 @@ +/* mime-parser.c - Parse MIME structures (high level rfc822 parser). + * Copyright (C) 2016 g10 Code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#include +#include +#include +#include + +#include "util.h" +#include "rfc822parse.h" +#include "mime-parser.h" + + +enum pgpmime_states + { + PGPMIME_NONE = 0, + PGPMIME_WAIT_ENCVERSION, + PGPMIME_IN_ENCVERSION, + PGPMIME_WAIT_ENCDATA, + PGPMIME_IN_ENCDATA, + PGPMIME_GOT_ENCDATA, + PGPMIME_WAIT_SIGNEDDATA, + PGPMIME_IN_SIGNEDDATA, + PGPMIME_WAIT_SIGNATURE, + PGPMIME_IN_SIGNATURE, + PGPMIME_GOT_SIGNATURE, + PGPMIME_INVALID + }; + + +/* Definition of the mime parser object. */ +struct mime_parser_context_s +{ + void *cookie; /* Cookie passed to all callbacks. */ + + /* The callback to announce a new part. */ + gpg_error_t (*new_part) (void *cookie, + const char *mediatype, + const char *mediasubtype); + /* The callback to return data of a part. */ + gpg_error_t (*part_data) (void *cookie, + const void *data, + size_t datalen); + /* The callback to collect encrypted data. */ + gpg_error_t (*collect_encrypted) (void *cookie, const char *data); + /* The callback to collect signed data. */ + gpg_error_t (*collect_signeddata) (void *cookie, const char *data); + /* The callback to collect a signature. */ + gpg_error_t (*collect_signature) (void *cookie, const char *data); + + /* Helper to convey error codes from user callbacks. */ + gpg_error_t err; + + int nesting_level; /* The current nesting level. */ + int hashing_at_level; /* The nesting level at which we are hashing. */ + enum pgpmime_states pgpmime; /* Current PGP/MIME state. */ + unsigned int delay_hashing:1;/* Helper for PGPMIME_IN_SIGNEDDATA. */ + unsigned int want_part:1; /* Return the current part. */ + unsigned int decode_part:2; /* Decode the part. 1 = QP, 2 = Base64. */ + + unsigned int verbose:1; /* Enable verbose mode. */ + unsigned int debug:1; /* Enable debug mode. */ + + /* Flags to help with debug output. */ + struct { + unsigned int n_skip; /* Skip showing these number of lines. */ + unsigned int header:1; /* Show the header lines. */ + unsigned int data:1; /* Show the data lines. */ + unsigned int as_note:1; /* Show the next data line as a note. */ + unsigned int boundary : 1; + } show; + + struct b64state *b64state; /* NULL or malloced Base64 decoder state. */ + + /* A buffer for reading a mail line, */ + char line[5000]; +}; + + +/* Print the event received by the parser for debugging. */ +static void +show_message_parser_event (rfc822parse_event_t event) +{ + const char *s; + + switch (event) + { + case RFC822PARSE_OPEN: s= "Open"; break; + case RFC822PARSE_CLOSE: s= "Close"; break; + case RFC822PARSE_CANCEL: s= "Cancel"; break; + case RFC822PARSE_T2BODY: s= "T2Body"; break; + case RFC822PARSE_FINISH: s= "Finish"; break; + case RFC822PARSE_RCVD_SEEN: s= "Rcvd_Seen"; break; + case RFC822PARSE_LEVEL_DOWN: s= "Level_Down"; break; + case RFC822PARSE_LEVEL_UP: s= "Level_Up"; break; + case RFC822PARSE_BOUNDARY: s= "Boundary"; break; + case RFC822PARSE_LAST_BOUNDARY: s= "Last_Boundary"; break; + case RFC822PARSE_BEGIN_HEADER: s= "Begin_Header"; break; + case RFC822PARSE_PREAMBLE: s= "Preamble"; break; + case RFC822PARSE_EPILOGUE: s= "Epilogue"; break; + default: s= "[unknown event]"; break; + } + log_debug ("*** RFC822 event %s\n", s); +} + + +/* Do in-place decoding of quoted-printable data of LENGTH in BUFFER. + Returns the new length of the buffer and stores true at R_SLBRK if + the line ended with a soft line break; false is stored if not. + This fucntion asssumes that a complete line is passed in + buffer. */ +static size_t +qp_decode (char *buffer, size_t length, int *r_slbrk) +{ + char *d, *s; + + if (r_slbrk) + *r_slbrk = 0; + + /* Fixme: We should remove trailing white space first. */ + for (s=d=buffer; length; length--) + { + if (*s == '=') + { + if (length > 2 && hexdigitp (s+1) && hexdigitp (s+2)) + { + s++; + *(unsigned char*)d++ = xtoi_2 (s); + s += 2; + length -= 2; + } + else if (length > 2 && s[1] == '\r' && s[2] == '\n') + { + /* Soft line break. */ + s += 3; + length -= 2; + if (r_slbrk && length == 1) + *r_slbrk = 1; + } + else if (length > 1 && s[1] == '\n') + { + /* Soft line break with only a Unix line terminator. */ + s += 2; + length -= 1; + if (r_slbrk && length == 1) + *r_slbrk = 1; + } + else if (length == 1) + { + /* Soft line break at the end of the line. */ + s += 1; + if (r_slbrk) + *r_slbrk = 1; + } + else + *d++ = *s++; + } + else + *d++ = *s++; + } + + return d - buffer; +} + + +/* This function is called by parse_mail to communicate events. This + * callback communicates with the caller using a structure passed in + * OPAQUE. Should return 0 on success or set ERRNO and return -1. */ +static int +parse_message_cb (void *opaque, rfc822parse_event_t event, rfc822parse_t msg) +{ + mime_parser_t ctx = opaque; + const char *s; + int rc = 0; + + if (ctx->debug) + show_message_parser_event (event); + + if (event == RFC822PARSE_BEGIN_HEADER || event == RFC822PARSE_T2BODY) + { + /* We need to check here whether to start collecting signed data + * because attachments might come without header lines and thus + * we won't see the BEGIN_HEADER event. */ + if (ctx->pgpmime == PGPMIME_WAIT_SIGNEDDATA) + { + if (ctx->debug) + log_debug ("begin_hash\n"); + ctx->hashing_at_level = ctx->nesting_level; + ctx->pgpmime = PGPMIME_IN_SIGNEDDATA; + ctx->delay_hashing = 0; + } + } + + if (event == RFC822PARSE_OPEN) + { + /* Initialize for a new message. */ + ctx->show.header = 1; + } + else if (event == RFC822PARSE_T2BODY) + { + rfc822parse_field_t field; + + ctx->want_part = 0; + ctx->decode_part = 0; + field = rfc822parse_parse_field (msg, "Content-Type", -1); + if (field) + { + const char *s1, *s2; + + s1 = rfc822parse_query_media_type (field, &s2); + if (s1) + { + if (ctx->verbose) + log_debug ("h media: %*s%s %s\n", + ctx->nesting_level*2, "", s1, s2); + if (ctx->pgpmime == PGPMIME_WAIT_ENCVERSION) + { + if (!strcmp (s1, "application") + && !strcmp (s2, "pgp-encrypted")) + { + if (ctx->debug) + log_debug ("c begin_encversion\n"); + ctx->pgpmime = PGPMIME_IN_ENCVERSION; + } + else + { + log_error ("invalid PGP/MIME structure;" + " expected '%s', got '%s/%s'\n", + "application/pgp-encrypted", s1, s2); + ctx->pgpmime = PGPMIME_INVALID; + } + } + else if (ctx->pgpmime == PGPMIME_WAIT_ENCDATA) + { + if (!strcmp (s1, "application") + && !strcmp (s2, "octet-stream")) + { + if (ctx->debug) + log_debug ("c begin_encdata\n"); + ctx->pgpmime = PGPMIME_IN_ENCDATA; + } + else + { + log_error ("invalid PGP/MIME structure;" + " expected '%s', got '%s/%s'\n", + "application/octet-stream", s1, s2); + ctx->pgpmime = PGPMIME_INVALID; + } + } + else if (ctx->pgpmime == PGPMIME_WAIT_SIGNATURE) + { + if (!strcmp (s1, "application") + && !strcmp (s2, "pgp-signature")) + { + if (ctx->debug) + log_debug ("c begin_signature\n"); + ctx->pgpmime = PGPMIME_IN_SIGNATURE; + } + else + { + log_error ("invalid PGP/MIME structure;" + " expected '%s', got '%s/%s'\n", + "application/pgp-signature", s1, s2); + ctx->pgpmime = PGPMIME_INVALID; + } + } + else if (!strcmp (s1, "multipart") + && !strcmp (s2, "encrypted")) + { + s = rfc822parse_query_parameter (field, "protocol", 0); + if (s) + { + if (ctx->debug) + log_debug ("h encrypted.protocol: %s\n", s); + if (!strcmp (s, "application/pgp-encrypted")) + { + if (ctx->pgpmime) + log_error ("note: " + "ignoring nested PGP/MIME signature\n"); + else + ctx->pgpmime = PGPMIME_WAIT_ENCVERSION; + } + else if (ctx->verbose) + log_debug ("# this protocol is not supported\n"); + } + } + else if (!strcmp (s1, "multipart") + && !strcmp (s2, "signed")) + { + s = rfc822parse_query_parameter (field, "protocol", 1); + if (s) + { + if (ctx->debug) + log_debug ("h signed.protocol: %s\n", s); + if (!strcmp (s, "application/pgp-signature")) + { + if (ctx->pgpmime) + log_error ("note: " + "ignoring nested PGP/MIME signature\n"); + else + ctx->pgpmime = PGPMIME_WAIT_SIGNEDDATA; + } + else if (ctx->verbose) + log_debug ("# this protocol is not supported\n"); + } + } + else if (ctx->new_part) + { + ctx->err = ctx->new_part (ctx->cookie, s1, s2); + if (!ctx->err) + ctx->want_part = 1; + else if (gpg_err_code (ctx->err) == GPG_ERR_FALSE) + ctx->err = 0; + else if (gpg_err_code (ctx->err) == GPG_ERR_TRUE) + { + ctx->want_part = ctx->decode_part = 1; + ctx->err = 0; + } + } + } + else + { + if (ctx->debug) + log_debug ("h media: %*s none\n", ctx->nesting_level*2, ""); + if (ctx->new_part) + { + ctx->err = ctx->new_part (ctx->cookie, "", ""); + if (!ctx->err) + ctx->want_part = 1; + else if (gpg_err_code (ctx->err) == GPG_ERR_FALSE) + ctx->err = 0; + else if (gpg_err_code (ctx->err) == GPG_ERR_TRUE) + { + ctx->want_part = ctx->decode_part = 1; + ctx->err = 0; + } + } + } + + rfc822parse_release_field (field); + } + else + { + if (ctx->verbose) + log_debug ("h media: %*stext plain [assumed]\n", + ctx->nesting_level*2, ""); + if (ctx->new_part) + { + ctx->err = ctx->new_part (ctx->cookie, "text", "plain"); + if (!ctx->err) + ctx->want_part = 1; + else if (gpg_err_code (ctx->err) == GPG_ERR_FALSE) + ctx->err = 0; + else if (gpg_err_code (ctx->err) == GPG_ERR_TRUE) + { + ctx->want_part = ctx->decode_part = 1; + ctx->err = 0; + } + } + } + + /* Figure out the encoding if needed. */ + if (ctx->decode_part) + { + char *value; + size_t valueoff; + + ctx->decode_part = 0; /* Fallback for unknown encoding. */ + value = rfc822parse_get_field (msg, "Content-Transfer-Encoding", -1, + &valueoff); + if (value) + { + if (!stricmp (value+valueoff, "quoted-printable")) + ctx->decode_part = 1; + else if (!stricmp (value+valueoff, "base64")) + { + ctx->decode_part = 2; + if (ctx->b64state) + b64dec_finish (ctx->b64state); /* Reuse state. */ + else + { + ctx->b64state = xtrymalloc (sizeof *ctx->b64state); + if (!ctx->b64state) + rc = gpg_error_from_syserror (); + } + if (!rc) + rc = b64dec_start (ctx->b64state, NULL); + } + free (value); /* Right, we need a plain free. */ + } + } + + ctx->show.header = 0; + ctx->show.data = 1; + ctx->show.n_skip = 1; + } + else if (event == RFC822PARSE_PREAMBLE) + ctx->show.as_note = 1; + else if (event == RFC822PARSE_LEVEL_DOWN) + { + if (ctx->debug) + log_debug ("b down\n"); + ctx->nesting_level++; + } + else if (event == RFC822PARSE_LEVEL_UP) + { + if (ctx->debug) + log_debug ("b up\n"); + if (ctx->nesting_level) + ctx->nesting_level--; + else + log_error ("invalid structure (bad nesting level)\n"); + } + else if (event == RFC822PARSE_BOUNDARY || event == RFC822PARSE_LAST_BOUNDARY) + { + ctx->show.data = 0; + ctx->show.boundary = 1; + if (event == RFC822PARSE_BOUNDARY) + { + ctx->show.header = 1; + ctx->show.n_skip = 1; + if (ctx->debug) + log_debug ("b part\n"); + } + else if (ctx->debug) + log_debug ("b last\n"); + + if (ctx->pgpmime == PGPMIME_IN_ENCDATA) + { + if (ctx->debug) + log_debug ("c end_encdata\n"); + ctx->pgpmime = PGPMIME_GOT_ENCDATA; + /* FIXME: We should assert (event == LAST_BOUNDARY). */ + } + else if (ctx->pgpmime == PGPMIME_IN_SIGNEDDATA + && ctx->nesting_level == ctx->hashing_at_level) + { + if (ctx->debug) + log_debug ("c end_hash\n"); + ctx->pgpmime = PGPMIME_WAIT_SIGNATURE; + if (ctx->collect_signeddata) + ctx->err = ctx->collect_signeddata (ctx->cookie, NULL); + } + else if (ctx->pgpmime == PGPMIME_IN_SIGNATURE) + { + if (ctx->debug) + log_debug ("c end_signature\n"); + ctx->pgpmime = PGPMIME_GOT_SIGNATURE; + /* FIXME: We should assert (event == LAST_BOUNDARY). */ + } + else if (ctx->want_part) + { + if (ctx->part_data) + { + /* FIXME: We may need to flush things. */ + ctx->err = ctx->part_data (ctx->cookie, NULL, 0); + } + ctx->want_part = 0; + } + } + + return rc; +} + + +/* Create a new mime parser object. COOKIE is a values which will be + * used as first argument for all callbacks registered with this + * parser object. */ +gpg_error_t +mime_parser_new (mime_parser_t *r_parser, void *cookie) +{ + mime_parser_t ctx; + + *r_parser = NULL; + + ctx = xtrycalloc (1, sizeof *ctx); + if (!ctx) + return gpg_error_from_syserror (); + ctx->cookie = cookie; + + *r_parser = ctx; + return 0; +} + + +/* Release a mime parser object. */ +void +mime_parser_release (mime_parser_t ctx) +{ + if (!ctx) + return; + + if (ctx->b64state) + { + b64dec_finish (ctx->b64state); + xfree (ctx->b64state); + } + xfree (ctx); +} + + +/* Set verbose and debug mode. */ +void +mime_parser_set_verbose (mime_parser_t ctx, int level) +{ + if (!level) + { + ctx->verbose = 0; + ctx->debug = 0; + } + else + { + ctx->verbose = 1; + if (level > 10) + ctx->debug = 1; + } +} + + +/* Set the callback used to announce a new part. It will be called + * with the media type and media subtype of the part. If no + * Content-type header was given both values are the empty string. + * The callback should return 0 on success or an error code. The + * error code GPG_ERR_FALSE indicates that the caller is not + * interested in the part and data shall not be returned via a + * registered part_data callback. The error code GPG_ERR_TRUE + * indicates that the parts shall be redurned in decoded format + * (i.e. base64 or QP encoding is removed). */ +void +mime_parser_set_new_part (mime_parser_t ctx, + gpg_error_t (*fnc) (void *cookie, + const char *mediatype, + const char *mediasubtype)) +{ + ctx->new_part = fnc; +} + + +/* Set the callback used to return the data of a part to the caller. + * The end of the part is indicated by passing NUL for DATA. */ +void +mime_parser_set_part_data (mime_parser_t ctx, + gpg_error_t (*fnc) (void *cookie, + const void *data, + size_t datalen)) +{ + ctx->part_data = fnc; +} + + +/* Set the callback to collect encrypted data. A NULL passed to the + * callback indicates the end of the encrypted data; the callback may + * then decrypt the collected data. */ +void +mime_parser_set_collect_encrypted (mime_parser_t ctx, + gpg_error_t (*fnc) (void *cookie, + const char *data)) +{ + ctx->collect_encrypted = fnc; +} + + +/* Set the callback to collect signed data. A NULL passed to the + * callback indicates the end of the signed data. */ +void +mime_parser_set_collect_signeddata (mime_parser_t ctx, + gpg_error_t (*fnc) (void *cookie, + const char *data)) +{ + ctx->collect_signeddata = fnc; +} + + +/* Set the callback to collect the signature. A NULL passed to the + * callback indicates the end of the signature; the callback may the + * verify the signature. */ +void +mime_parser_set_collect_signature (mime_parser_t ctx, + gpg_error_t (*fnc) (void *cookie, + const char *data)) +{ + ctx->collect_signature = fnc; +} + + +/* Read and parse a message from FP and call the appropriate + * callbacks. */ +gpg_error_t +mime_parser_parse (mime_parser_t ctx, estream_t fp) +{ + gpg_error_t err; + rfc822parse_t msg = NULL; + unsigned int lineno = 0; + size_t length, nbytes; + char *line; + + line = ctx->line; + + msg = rfc822parse_open (parse_message_cb, ctx); + if (!msg) + { + err = gpg_error_from_syserror (); + log_error ("can't open mail parser: %s", gpg_strerror (err)); + goto leave; + } + + /* Fixme: We should not use fgets because it can't cope with + embedded nul characters. */ + while (es_fgets (ctx->line, sizeof (ctx->line), fp)) + { + lineno++; + if (lineno == 1 && !strncmp (line, "From ", 5)) + continue; /* We better ignore a leading From line. */ + + length = strlen (line); + if (length && line[length - 1] == '\n') + line[--length] = 0; + else + log_error ("mail parser detected too long or" + " non terminated last line (lnr=%u)\n", lineno); + if (length && line[length - 1] == '\r') + line[--length] = 0; + + ctx->err = 0; + if (rfc822parse_insert (msg, line, length)) + { + err = gpg_error_from_syserror (); + log_error ("mail parser failed: %s", gpg_strerror (err)); + goto leave; + } + if (ctx->err) + { + /* Error from a callback detected. */ + err = ctx->err; + goto leave; + } + + + /* Debug output. Note that the boundary is shown before n_skip + * is evaluated. */ + if (ctx->show.boundary) + { + if (ctx->debug) + log_debug ("# Boundary: %s\n", line); + ctx->show.boundary = 0; + } + if (ctx->show.n_skip) + ctx->show.n_skip--; + else if (ctx->show.data) + { + if (ctx->show.as_note) + { + if (ctx->verbose) + log_debug ("# Note: %s\n", line); + ctx->show.as_note = 0; + } + else if (ctx->debug) + log_debug ("# Data: %s\n", line); + } + else if (ctx->show.header && ctx->verbose) + log_debug ("# Header: %s\n", line); + + if (ctx->pgpmime == PGPMIME_IN_ENCVERSION) + { + trim_trailing_spaces (line); + if (!*line) + ; /* Skip empty lines. */ + else if (!strcmp (line, "Version: 1")) + ctx->pgpmime = PGPMIME_WAIT_ENCDATA; + else + { + log_error ("invalid PGP/MIME structure;" + " garbage in pgp-encrypted part ('%s')\n", line); + ctx->pgpmime = PGPMIME_INVALID; + } + } + else if (ctx->pgpmime == PGPMIME_IN_ENCDATA) + { + if (ctx->collect_encrypted) + { + err = ctx->collect_encrypted (ctx->cookie, line); + if (!err) + err = ctx->collect_encrypted (ctx->cookie, "\r\n"); + if (err) + goto leave; + } + } + else if (ctx->pgpmime == PGPMIME_GOT_ENCDATA) + { + ctx->pgpmime = PGPMIME_NONE; + if (ctx->collect_encrypted) + ctx->collect_encrypted (ctx->cookie, NULL); + } + else if (ctx->pgpmime == PGPMIME_IN_SIGNEDDATA) + { + /* If we are processing signed data, store the signed data. + * We need to delay the hashing of the CR/LF because the + * last line ending belongs to the next boundary. This is + * the reason why we can't use the PGPMIME state as a + * condition. */ + if (ctx->debug) + log_debug ("# hashing %s'%s'\n", + ctx->delay_hashing? "CR,LF+":"", line); + if (ctx->collect_signeddata) + { + if (ctx->delay_hashing) + ctx->collect_signeddata (ctx->cookie, "\r\n"); + ctx->collect_signeddata (ctx->cookie, line); + } + ctx->delay_hashing = 1; + } + else if (ctx->pgpmime == PGPMIME_IN_SIGNATURE) + { + if (ctx->collect_signeddata) + { + ctx->collect_signature (ctx->cookie, line); + ctx->collect_signature (ctx->cookie, "\r\n"); + } + } + else if (ctx->pgpmime == PGPMIME_GOT_SIGNATURE) + { + ctx->pgpmime = PGPMIME_NONE; + if (ctx->collect_signeddata) + ctx->collect_signature (ctx->cookie, NULL); + } + else if (ctx->want_part) + { + if (ctx->part_data) + { + if (ctx->decode_part == 1) + { + length = qp_decode (line, length, NULL); + } + else if (ctx->decode_part == 2) + { + log_assert (ctx->b64state); + err = b64dec_proc (ctx->b64state, line, length, &nbytes); + if (err) + goto leave; + length = nbytes; + } + err = ctx->part_data (ctx->cookie, line, length); + if (err) + goto leave; + } + } + } + + rfc822parse_close (msg); + msg = NULL; + err = 0; + + leave: + rfc822parse_cancel (msg); + return err; +} diff --git a/tools/mime-parser.h b/tools/mime-parser.h new file mode 100644 index 000000000..ab0d79288 --- /dev/null +++ b/tools/mime-parser.h @@ -0,0 +1,52 @@ +/* mime-parser.h - Parse MIME structures (high level rfc822 parser). + * Copyright (C) 2016 g10 Code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#ifndef GNUPG_MIME_PARSER_H +#define GNUPG_MIME_PARSER_H + +struct mime_parser_context_s; +typedef struct mime_parser_context_s *mime_parser_t; + +gpg_error_t mime_parser_new (mime_parser_t *r_ctx, void *cookie); +void mime_parser_release (mime_parser_t ctx); + +void mime_parser_set_verbose (mime_parser_t ctx, int level); +void mime_parser_set_new_part (mime_parser_t ctx, + gpg_error_t (*fnc) (void *cookie, + const char *mediatype, + const char *mediasubtype)); +void mime_parser_set_part_data (mime_parser_t ctx, + gpg_error_t (*fnc) (void *cookie, + const void *data, + size_t datalen)); +void mime_parser_set_collect_encrypted (mime_parser_t ctx, + gpg_error_t (*fnc) (void *cookie, + const char *data)); +void mime_parser_set_collect_signeddata (mime_parser_t ctx, + gpg_error_t (*fnc) (void *cookie, + const char *data)); +void mime_parser_set_collect_signature (mime_parser_t ctx, + gpg_error_t (*fnc) (void *cookie, + const char *data)); + +gpg_error_t mime_parser_parse (mime_parser_t ctx, estream_t fp); + + + +#endif /*GNUPG_MIME_PARSER_H*/ diff --git a/tools/rfc822parse.h b/tools/rfc822parse.h index 8bb5536a1..c5579fe44 100644 --- a/tools/rfc822parse.h +++ b/tools/rfc822parse.h @@ -1,6 +1,6 @@ /* rfc822parse.h - Simple mail and MIME parser * Copyright (C) 1999 Werner Koch, Duesseldorf - * Copyright (C) 2003, g10 Code GmbH + * Copyright (C) 2003 g10 Code GmbH * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License diff --git a/tools/send-mail.c b/tools/send-mail.c new file mode 100644 index 000000000..2266521a4 --- /dev/null +++ b/tools/send-mail.c @@ -0,0 +1,129 @@ +/* send-mail.c - Invoke sendmail or other delivery tool. + * Copyright (C) 2016 g10 Code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#include +#include +#include +#include + +#include "util.h" +#include "exectool.h" +#include "sysutils.h" +#include "send-mail.h" + + +static gpg_error_t +run_sendmail (estream_t data) +{ + gpg_error_t err; + const char pgmname[] = "/usr/lib/sendmail"; + const char *argv[3]; + + argv[0] = "-oi"; + argv[1] = "-t"; + argv[2] = NULL; + + err = gnupg_exec_tool_stream (pgmname, argv, data, NULL, NULL, NULL, NULL); + if (err) + log_error ("running '%s' failed: %s\n", pgmname, gpg_strerror (err)); + return err; +} + + +/* Send the data in FP as mail. */ +gpg_error_t +send_mail (estream_t fp) +{ + return run_sendmail (fp); +} + + +/* Convenience function to write a mail to a named file. */ +gpg_error_t +send_mail_to_file (estream_t fp, const char *fname) +{ + gpg_error_t err; + estream_t outfp = NULL; + char *buffer = NULL; + size_t buffersize = 32 * 1024; + size_t nbytes, nwritten; + + if (!fname) + fname = "-"; + + buffer = xtrymalloc (buffersize); + if (!buffer) + return gpg_error_from_syserror (); + + outfp = !strcmp (fname,"-")? es_stdout : es_fopen (fname, "wb"); + if (!outfp) + { + err = gpg_error_from_syserror (); + log_error ("error creating '%s': %s\n", fname, gpg_strerror (err)); + goto leave; + } + for (;;) + { + if (es_read (fp, buffer, sizeof buffer, &nbytes)) + { + err = gpg_error_from_syserror (); + log_error ("error reading '%s': %s\n", + es_fname_get (fp), gpg_strerror (err)); + goto leave; + } + + if (!nbytes) + { + err = 0; + break; /* Ready. */ + } + + if (es_write (outfp, buffer, nbytes, &nwritten)) + { + err = gpg_error_from_syserror (); + log_error ("error writing '%s': %s\n", fname, gpg_strerror (err)); + goto leave; + } + else if (nwritten != nbytes) + { + err = gpg_error (GPG_ERR_EIO); + log_error ("error writing '%s': %s\n", fname, "short write"); + goto leave; + } + } + + + leave: + if (err) + { + if (outfp && outfp != es_stdout) + { + es_fclose (outfp); + gnupg_remove (fname); + } + } + else if (outfp && outfp != es_stdout && es_fclose (outfp)) + { + err = gpg_error_from_syserror (); + log_error ("error closing '%s': %s\n", fname, gpg_strerror (err)); + } + + xfree (buffer); + return err; +} diff --git a/tools/send-mail.h b/tools/send-mail.h new file mode 100644 index 000000000..5f57854af --- /dev/null +++ b/tools/send-mail.h @@ -0,0 +1,27 @@ +/* send-mail.h - Invoke sendmail or other delivery tool. + * Copyright (C) 2016 g10 Code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#ifndef GNUPG_SEND_MAIL_H +#define GNUPG_SEND_MAIL_H + +gpg_error_t send_mail (estream_t fp); +gpg_error_t send_mail_to_file (estream_t fp, const char *fname); + + +#endif /*GNUPG_SEND_MAIL_H*/ diff --git a/tools/wks-receive.c b/tools/wks-receive.c new file mode 100644 index 000000000..59141fcdc --- /dev/null +++ b/tools/wks-receive.c @@ -0,0 +1,464 @@ +/* wks-receive.c - Receive a WKS mail + * Copyright (C) 2016 g10 Code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#include +#include +#include +#include + +#include "util.h" +#include "ccparray.h" +#include "exectool.h" +#include "gpg-wks.h" +#include "mime-parser.h" + + +/* Limit of acceptable signed data. */ +#define MAX_SIGNEDDATA 10000 + +/* Limit of acceptable signature. */ +#define MAX_SIGNATURE 10000 + +/* Limit of acceptable encrypted data. */ +#define MAX_ENCRYPTED 100000 + +/* Data for a received object. */ +struct receive_ctx_s +{ + estream_t encrypted; + estream_t plaintext; + estream_t signeddata; + estream_t signature; + estream_t key_data; + estream_t wkd_data; + unsigned int collect_key_data:1; + unsigned int collect_wkd_data:1; +}; +typedef struct receive_ctx_s *receive_ctx_t; + + + +static void +decrypt_data_status_cb (void *opaque, const char *keyword, char *args) +{ + receive_ctx_t ctx = opaque; + (void)ctx; + log_debug ("%s: %s\n", keyword, args); +} + + +/* Decrypt the collected data. */ +static void +decrypt_data (receive_ctx_t ctx) +{ + gpg_error_t err; + ccparray_t ccp; + const char **argv; + int c; + + es_rewind (ctx->encrypted); + + if (!ctx->plaintext) + ctx->plaintext = es_fopenmem (0, "w+b"); + if (!ctx->plaintext) + { + err = gpg_error_from_syserror (); + log_error ("error allocating space for plaintext: %s\n", + gpg_strerror (err)); + return; + } + + ccparray_init (&ccp, 0); + + /* We limit the output to 64 KiB to avoid DoS using compression + * tricks. A regular client will anyway only send a minimal key; + * that is one w/o key signatures and attribute packets. */ + ccparray_put (&ccp, "--max-output=0xf0000"); /*FIXME: Change s/F/1/ */ + ccparray_put (&ccp, "--batch"); + if (opt.verbose) + ccparray_put (&ccp, "--verbose"); + ccparray_put (&ccp, "--always-trust"); + ccparray_put (&ccp, "--decrypt"); + ccparray_put (&ccp, "--"); + + ccparray_put (&ccp, NULL); + argv = ccparray_get (&ccp, NULL); + if (!argv) + { + err = gpg_error_from_syserror (); + goto leave; + } + err = gnupg_exec_tool_stream (opt.gpg_program, argv, ctx->encrypted, + NULL, ctx->plaintext, + decrypt_data_status_cb, ctx); + if (err) + { + log_error ("decryption failed: %s\n", gpg_strerror (err)); + goto leave; + } + + if (opt.debug) + { + es_rewind (ctx->plaintext); + log_debug ("plaintext: '"); + while ((c = es_getc (ctx->plaintext)) != EOF) + log_printf ("%c", c); + log_printf ("'\n"); + } + es_rewind (ctx->plaintext); + + leave: + xfree (argv); +} + + +static void +verify_signature_status_cb (void *opaque, const char *keyword, char *args) +{ + receive_ctx_t ctx = opaque; + (void)ctx; + log_debug ("%s: %s\n", keyword, args); +} + +/* Verify the signed data. */ +static void +verify_signature (receive_ctx_t ctx) +{ + gpg_error_t err; + ccparray_t ccp; + const char **argv; + + log_assert (ctx->signeddata); + log_assert (ctx->signature); + es_rewind (ctx->signeddata); + es_rewind (ctx->signature); + + ccparray_init (&ccp, 0); + + ccparray_put (&ccp, "--batch"); + if (opt.verbose) + ccparray_put (&ccp, "--verbose"); + ccparray_put (&ccp, "--enable-special-filenames"); + ccparray_put (&ccp, "--status-fd=2"); + ccparray_put (&ccp, "--verify"); + ccparray_put (&ccp, "--"); + ccparray_put (&ccp, "-&@INEXTRA@"); + ccparray_put (&ccp, "-"); + + ccparray_put (&ccp, NULL); + argv = ccparray_get (&ccp, NULL); + if (!argv) + { + err = gpg_error_from_syserror (); + goto leave; + } + err = gnupg_exec_tool_stream (opt.gpg_program, argv, ctx->signeddata, + ctx->signature, NULL, + verify_signature_status_cb, ctx); + if (err) + { + log_error ("verification failed: %s\n", gpg_strerror (err)); + goto leave; + } + + leave: + xfree (argv); +} + + +static gpg_error_t +collect_encrypted (void *cookie, const char *data) +{ + receive_ctx_t ctx = cookie; + + if (!ctx->encrypted) + if (!(ctx->encrypted = es_fopenmem (MAX_ENCRYPTED, "w+b,samethread"))) + return gpg_error_from_syserror (); + if (data) + es_fputs (data, ctx->encrypted); + + if (es_ferror (ctx->encrypted)) + return gpg_error_from_syserror (); + + if (!data) + { + decrypt_data (ctx); + } + + return 0; +} + + +static gpg_error_t +collect_signeddata (void *cookie, const char *data) +{ + receive_ctx_t ctx = cookie; + + if (!ctx->signeddata) + if (!(ctx->signeddata = es_fopenmem (MAX_SIGNEDDATA, "w+b,samethread"))) + return gpg_error_from_syserror (); + if (data) + es_fputs (data, ctx->signeddata); + + if (es_ferror (ctx->signeddata)) + return gpg_error_from_syserror (); + return 0; +} + +static gpg_error_t +collect_signature (void *cookie, const char *data) +{ + receive_ctx_t ctx = cookie; + + if (!ctx->signature) + if (!(ctx->signature = es_fopenmem (MAX_SIGNATURE, "w+b,samethread"))) + return gpg_error_from_syserror (); + if (data) + es_fputs (data, ctx->signature); + + if (es_ferror (ctx->signature)) + return gpg_error_from_syserror (); + + if (!data) + { + verify_signature (ctx); + } + + return 0; +} + + +static gpg_error_t +new_part (void *cookie, const char *mediatype, const char *mediasubtype) +{ + receive_ctx_t ctx = cookie; + gpg_error_t err = 0; + + ctx->collect_key_data = 0; + ctx->collect_wkd_data = 0; + + if (!strcmp (mediatype, "application") + && !strcmp (mediasubtype, "pgp-keys")) + { + log_info ("new '%s/%s' message part\n", mediatype, mediasubtype); + if (ctx->key_data) + { + log_error ("we already got a key - ignoring this part\n"); + err = gpg_error (GPG_ERR_FALSE); + } + else + { + ctx->key_data = es_fopenmem (0, "w+b"); + if (!ctx->key_data) + { + err = gpg_error_from_syserror (); + log_error ("error allocating space for key: %s\n", + gpg_strerror (err)); + } + else + { + ctx->collect_key_data = 1; + err = gpg_error (GPG_ERR_TRUE); /* We want the part decoded. */ + } + } + } + else if (!strcmp (mediatype, "application") + && !strcmp (mediasubtype, "vnd.gnupg.wks")) + { + log_info ("new '%s/%s' message part\n", mediatype, mediasubtype); + if (ctx->wkd_data) + { + log_error ("we already got a wkd part - ignoring this part\n"); + err = gpg_error (GPG_ERR_FALSE); + } + else + { + ctx->wkd_data = es_fopenmem (0, "w+b"); + if (!ctx->wkd_data) + { + err = gpg_error_from_syserror (); + log_error ("error allocating space for key: %s\n", + gpg_strerror (err)); + } + else + { + ctx->collect_wkd_data = 1; + err = gpg_error (GPG_ERR_TRUE); /* We want the part decoded. */ + } + } + } + else + { + log_error ("unexpected '%s/%s' message part\n", mediatype, mediasubtype); + err = gpg_error (GPG_ERR_FALSE); /* We do not want the part. */ + } + + return err; +} + + +static gpg_error_t +part_data (void *cookie, const void *data, size_t datalen) +{ + receive_ctx_t ctx = cookie; + + if (data) + { + if (opt.debug) + log_debug ("part_data: '%.*s'\n", (int)datalen, (const char*)data); + if (ctx->collect_key_data) + { + if (es_write (ctx->key_data, data, datalen, NULL) + || es_fputs ("\n", ctx->key_data)) + return gpg_error_from_syserror (); + } + if (ctx->collect_wkd_data) + { + if (es_write (ctx->wkd_data, data, datalen, NULL) + || es_fputs ("\n", ctx->wkd_data)) + return gpg_error_from_syserror (); + } + } + else + { + if (opt.debug) + log_debug ("part_data: finished\n"); + ctx->collect_key_data = 0; + ctx->collect_wkd_data = 0; + } + return 0; +} + + +/* Receive a WKS mail from FP and process it accordingly. On success + * the RESULT_CB is called with the mediatype and a stream with the + * decrypted data. */ +gpg_error_t +wks_receive (estream_t fp, + gpg_error_t (*result_cb)(void *opaque, + const char *mediatype, + estream_t data), + void *cb_data) +{ + gpg_error_t err; + receive_ctx_t ctx; + mime_parser_t parser; + estream_t plaintext = NULL; + int c; + + ctx = xtrycalloc (1, sizeof *ctx); + if (!ctx) + return gpg_error_from_syserror (); + + err = mime_parser_new (&parser, ctx); + if (err) + goto leave; + if (opt.verbose > 1 || opt.debug) + mime_parser_set_verbose (parser, opt.debug? 10: 1); + mime_parser_set_new_part (parser, new_part); + mime_parser_set_part_data (parser, part_data); + mime_parser_set_collect_encrypted (parser, collect_encrypted); + mime_parser_set_collect_signeddata (parser, collect_signeddata); + mime_parser_set_collect_signature (parser, collect_signature); + + err = mime_parser_parse (parser, fp); + if (err) + goto leave; + + if (ctx->key_data) + log_info ("key data found\n"); + if (ctx->wkd_data) + log_info ("wkd data found\n"); + + if (ctx->plaintext) + { + if (opt.verbose) + log_info ("parsing decrypted message\n"); + plaintext = ctx->plaintext; + ctx->plaintext = NULL; + if (ctx->encrypted) + es_rewind (ctx->encrypted); + if (ctx->signeddata) + es_rewind (ctx->signeddata); + if (ctx->signature) + es_rewind (ctx->signature); + err = mime_parser_parse (parser, plaintext); + if (err) + return err; + } + + if (!ctx->key_data && !ctx->wkd_data) + { + log_error ("no suitable data found in the message\n"); + err = gpg_error (GPG_ERR_NO_DATA); + goto leave; + } + + if (ctx->key_data) + { + if (opt.debug) + { + es_rewind (ctx->key_data); + log_debug ("Key: '"); + log_printf ("\n"); + while ((c = es_getc (ctx->key_data)) != EOF) + log_printf ("%c", c); + log_printf ("'\n"); + } + if (result_cb) + { + es_rewind (ctx->key_data); + err = result_cb (cb_data, "application/pgp-keys", ctx->key_data); + if (err) + goto leave; + } + } + if (ctx->wkd_data) + { + if (opt.debug) + { + es_rewind (ctx->wkd_data); + log_debug ("WKD: '"); + log_printf ("\n"); + while ((c = es_getc (ctx->wkd_data)) != EOF) + log_printf ("%c", c); + log_printf ("'\n"); + } + if (result_cb) + { + es_rewind (ctx->wkd_data); + err = result_cb (cb_data, "application/vnd.gnupg.wks", ctx->wkd_data); + if (err) + goto leave; + } + } + + + leave: + es_fclose (plaintext); + mime_parser_release (parser); + es_fclose (ctx->encrypted); + es_fclose (ctx->plaintext); + es_fclose (ctx->signeddata); + es_fclose (ctx->signature); + es_fclose (ctx->key_data); + es_fclose (ctx->wkd_data); + xfree (ctx); + return err; +} diff --git a/tools/wks-util.c b/tools/wks-util.c new file mode 100644 index 000000000..8d9f92bd3 --- /dev/null +++ b/tools/wks-util.c @@ -0,0 +1,65 @@ +/* wks-utils.c - Common helper fucntions for wks tools + * Copyright (C) 2016 g10 Code GmbH + * + * This file is part of GnuPG. + * + * GnuPG is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * GnuPG is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, see . + */ + +#include +#include +#include +#include + +#include "util.h" +#include "mime-maker.h" +#include "send-mail.h" +#include "gpg-wks.h" + + +/* Helper to write mail to the output(s). */ +gpg_error_t +wks_send_mime (mime_maker_t mime) +{ + gpg_error_t err; + estream_t mail; + + /* Without any option we take a short path. */ + if (!opt.use_sendmail && !opt.output) + return mime_maker_make (mime, es_stdout); + + mail = es_fopenmem (0, "w+b"); + if (!mail) + { + err = gpg_error_from_syserror (); + return err; + } + + err = mime_maker_make (mime, mail); + + if (!err && opt.output) + { + es_rewind (mail); + err = send_mail_to_file (mail, opt.output); + } + + if (!err && opt.use_sendmail) + { + es_rewind (mail); + err = send_mail (mail); + } + + es_fclose (mail); + return err; +}