Hans of Guardian <hans@guardianproject.info>
2013-06-26:D84473D7-F3F7-43D5-A9CE-16580B88D574@guardianproject.info:
+Ineiev <ineiev@gnu.org>
+2017-05-09:20170509121611.GH25850@gnu.org:
+
Jonas Borgström <jonas@borgstrom.se>
2013-08-29:521F1E7A.5080602@borgstrom.se:
stowinstall:
$(MAKE) $(AM_MAKEFLAGS) install prefix=/usr/local/stow/gnupg
+
+TESTS_ENVIRONMENT = \
+ LC_ALL=C \
+ EXEEXT=$(EXEEXT) \
+ PATH=$(abs_top_builddir)/tests/gpgscm:$(PATH) \
+ abs_top_srcdir=$(abs_top_srcdir) \
+ objdir=$(abs_top_builddir) \
+ GPGSCM_PATH=$(abs_top_srcdir)/tests/gpgscm
+
+.PHONY: check-all
+check-all:
+ $(TESTS_ENVIRONMENT) \
+ $(abs_top_builddir)/tests/gpgscm/gpgscm \
+ $(abs_srcdir)/tests/run-tests.scm $(TESTFLAGS) $(TESTS)
+Noteworthy changes in version 2.1.21 (2017-05-15)
+-------------------------------------------------
+
+ * gpg,gpgsm: Fix corruption of old style keyring.gpg files. This
+ bug was introduced with version 2.1.20. Note that the default
+ pubring.kbx format was not affected.
+
+ * gpg,dirmngr: Removed the skeleton config file support. The
+ system's standard methods for providing default configuration
+ files should be used instead.
+
+ * w32: The Windows installer now allows installion of GnuPG without
+ Administrator permissions.
+
+ * gpg: Fixed import filter property match bug.
+
+ * scd: Removed Linux support for Cardman 4040 PCMCIA reader.
+
+ * scd: Fixed some corner case bugs in resume/suspend handling.
+
+ * Many minor bug fixes and code cleanup.
+
+
Noteworthy changes in version 2.1.20 (2017-04-03)
-------------------------------------------------
- * gpg: New properties 'expired', 'revoked', and 'disbaled' for the
+ * gpg: New properties 'expired', 'revoked', and 'disabled' for the
import and export filters.
* gpg: New command --quick-set-primary-uid.
can be freely used, modified and distributed under the terms of the
GNU General Public License.
- We are currently maintaining three branches of GnuPG:
-
- - 2.1 (i.e. this release) is the latest stable version with a lot of
- new features.
-
- - 2.0 is an often used stable version. This branch will reach
- end-of-life on 2017-12-31.
-
- - 1.4 is the old standalone version which is most suitable for older
- or embedded platforms.
-
- You may not install 2.1 and 2.0 at the same time. However, it is
- possible to install 1.4 along with any of the 2.x versions.
+ Note that the 2.0 series of GnuPG will reach end-of-life on
+ 2017-12-31. It is not possible to install a 2.1.x version along
+ with any 2.0.x version. However, it is possible to install GnuPG
+ 1.4 along with a 2.x version.
* BUILD INSTRUCTIONS
endif
noinst_PROGRAMS = $(TESTS)
-EXTRA_DIST = ChangeLog-2011 gpg-agent-w32info.rc
+EXTRA_DIST = ChangeLog-2011 gpg-agent-w32info.rc all-tests.scm
AM_CPPFLAGS =
--- /dev/null
+;; Copyright (C) 2017 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 <http://www.gnu.org/licenses/>.
+
+(export all-tests
+ ;; Parse the Makefile.am to find all tests.
+
+ (load (with-path "makefile.scm"))
+
+ (define (expander filename port key)
+ (parse-makefile port key))
+
+ (define (parse filename key)
+ (parse-makefile-expand filename expander key))
+
+ (map (lambda (name)
+ (test::binary #f
+ (path-join "agent" name)
+ (path-join (getenv "objdir") "agent" name)))
+ (parse-makefile-expand (in-srcdir "agent" "Makefile.am")
+ (lambda (filename port key) (parse-makefile port key))
+ "TESTS")))
/* The size of the encryption key in bytes. */
#define ENCRYPTION_KEYSIZE (128/8)
-/* A mutex used to protect the encryption. This is required because
- we use one context to do all encryption and decryption. */
-static npth_mutex_t encryption_lock;
+/* A mutex used to serialize access to the cache. */
+static npth_mutex_t cache_lock;
/* The encryption context. This is the only place where the
encryption key for all cached entries is available. It would be nice
to keep this (or just the key) in some hardware device, for example
{
int err;
- err = npth_mutex_init (&encryption_lock, NULL);
+ err = npth_mutex_init (&cache_lock, NULL);
if (err)
log_fatal ("error initializing cache module: %s\n", strerror (err));
{
gpg_error_t err;
void *key;
- int res;
if (encryption_handle)
return 0; /* Shortcut - Already initialized. */
- res = npth_mutex_lock (&encryption_lock);
- if (res)
- log_fatal ("failed to acquire cache encryption mutex: %s\n", strerror (res));
-
err = gcry_cipher_open (&encryption_handle, GCRY_CIPHER_AES128,
GCRY_CIPHER_MODE_AESWRAP, GCRY_CIPHER_SECURE);
if (!err)
log_error ("error initializing cache encryption context: %s\n",
gpg_strerror (err));
- res = npth_mutex_unlock (&encryption_lock);
- if (res)
- log_fatal ("failed to release cache encryption mutex: %s\n", strerror (res));
-
return err? gpg_error (GPG_ERR_NOT_INITIALIZED) : 0;
}
struct secret_data_s *d, *d_enc;
size_t length;
int total;
- int res;
*r_data = NULL;
}
d_enc->totallen = total;
- res = npth_mutex_lock (&encryption_lock);
- if (res)
- log_fatal ("failed to acquire cache encryption mutex: %s\n",
- strerror (res));
-
err = gcry_cipher_encrypt (encryption_handle, d_enc->data, total,
d->data, total - 8);
xfree (d);
- res = npth_mutex_unlock (&encryption_lock);
- if (res)
- log_fatal ("failed to release cache encryption mutex: %s\n", strerror (res));
if (err)
{
xfree (d_enc);
agent_flush_cache (void)
{
ITEM r;
+ int res;
if (DBG_CACHE)
log_debug ("agent_flush_cache\n");
+ res = npth_mutex_lock (&cache_lock);
+ if (res)
+ log_fatal ("failed to acquire cache mutex: %s\n", strerror (res));
+
for (r=thecache; r; r = r->next)
{
if (r->pw)
r->accessed = 0;
}
}
+
+ res = npth_mutex_unlock (&cache_lock);
+ if (res)
+ log_fatal ("failed to release cache mutex: %s\n", strerror (res));
}
{
gpg_error_t err = 0;
ITEM r;
+ int res;
+
+ res = npth_mutex_lock (&cache_lock);
+ if (res)
+ log_fatal ("failed to acquire cache mutex: %s\n", strerror (res));
if (DBG_CACHE)
log_debug ("agent_put_cache '%s' (mode %d) requested ttl=%d\n",
}
}
if ((!ttl && data) || cache_mode == CACHE_MODE_IGNORE)
- return 0;
+ goto out;
for (r=thecache; r; r = r->next)
{
if (err)
log_error ("error inserting cache item: %s\n", gpg_strerror (err));
}
+
+ out:
+ res = npth_mutex_unlock (&cache_lock);
+ if (res)
+ log_fatal ("failed to release cache mutex: %s\n", strerror (res));
+
return err;
}
if (cache_mode == CACHE_MODE_IGNORE)
return NULL;
+ res = npth_mutex_lock (&cache_lock);
+ if (res)
+ log_fatal ("failed to acquire cache mutex: %s\n", strerror (res));
+
if (!key)
{
key = last_stored_cache_key;
if (!key)
- return NULL;
+ goto out;
last_stored = 1;
}
-
if (DBG_CACHE)
log_debug ("agent_get_cache '%s' (mode %d)%s ...\n",
key, cache_mode,
err = gpg_error_from_syserror ();
else
{
- res = npth_mutex_lock (&encryption_lock);
- if (res)
- log_fatal ("failed to acquire cache encryption mutex: %s\n",
- strerror (res));
err = gcry_cipher_decrypt (encryption_handle,
value, r->pw->totallen - 8,
r->pw->data, r->pw->totallen);
- res = npth_mutex_unlock (&encryption_lock);
- if (res)
- log_fatal ("failed to release cache encryption mutex: %s\n",
- strerror (res));
}
if (err)
{
log_error ("retrieving cache entry '%s' failed: %s\n",
key, gpg_strerror (err));
}
- return value;
+ break;
}
}
- if (DBG_CACHE)
+ if (DBG_CACHE && value == NULL)
log_debug ("... miss\n");
- return NULL;
+ out:
+ res = npth_mutex_unlock (&cache_lock);
+ if (res)
+ log_fatal ("failed to release cache mutex: %s\n", strerror (res));
+
+ return value;
}
-/* This function may be called to print infromation pertaining to the
+/* This function may be called to print information pertaining to the
current state of this module to the log. */
void
agent_query_dump_state (void)
log_error ("error flushing pending output: %s\n", strerror (errno));
/* At least Windows XP fails here with EBADF. According to docs
and Wine an fflush(NULL) is the same as _flushall. However
- the Wine implementaion does not flush stdin,stdout and stderr
+ the Wine implementation does not flush stdin,stdout and stderr
- see above. Let's try to ignore the error. */
#ifndef HAVE_W32_SYSTEM
return unlock_pinentry (tmperr);
xfree (flavor_version);
- return 0;
+ return rc;
}
}
-/* Build a SETDESC command line. This is a dedicated funcion so that
+/* Build a SETDESC command line. This is a dedicated function so that
* it can remove control characters which are not supported by the
* current Pinentry. */
static void
}
-/* This function may be called to print infromation pertaining to the
+/* This function may be called to print information pertaining to the
current state of this module to the log. */
void
agent_scd_dump_state (void)
log_error ("error flushing pending output: %s\n", strerror (errno));
/* At least Windows XP fails here with EBADF. According to docs
and Wine an fflush(NULL) is the same as _flushall. However
- the Wime implementaion does not flush stdin,stdout and stderr
+ the Wime implementation does not flush stdin,stdout and stderr
- see above. Lets try to ignore the error. */
#ifndef HAVE_W32_SYSTEM
goto leave;
static gpg_error_t
stream_read_cstring (estream_t stream, char **string)
{
- gpg_error_t err;
- unsigned char *buffer;
-
- err = stream_read_string (stream, 0, &buffer, NULL);
- if (!err)
- *string = (char *)buffer;
- return err;
+ return stream_read_string (stream, 0, (unsigned char **)string, NULL);
}
* string private_key
*
* Note that the private key is the concatenation of the private
- * key with the public key. Thus theres are 64 bytes; however
+ * key with the public key. Thus there's are 64 bytes; however
* we only want the real 32 byte private key - Libgcrypt expects
* this.
*/
key_public = NULL;
key_counter = 0;
- err = 0;
key_blobs = es_fopenmem (0, "r+b");
if (! key_blobs)
unsigned int buffer_new_n;
gpg_error_t err;
- err = 0;
buffer_new_n = gcry_sexp_sprint (key, GCRYSEXP_FMT_CANON, NULL, 0);
buffer_new = xtrymalloc_secure (buffer_new_n);
if (! buffer_new)
static unsigned long
get_client_pid (int fd)
{
- pid_t client_pid = (pid_t)(-1);
+ pid_t client_pid = (pid_t)0;
#ifdef SO_PEERCRED
{
#endif
socklen_t cl = sizeof cr;
- if ( !getsockopt (fd, SOL_SOCKET, SO_PEERCRED, &cr, &cl))
+ if (!getsockopt (fd, SOL_SOCKET, SO_PEERCRED, &cr, &cl))
{
#if defined (HAVE_STRUCT_SOCKPEERCRED_PID) || defined (HAVE_STRUCT_UCRED_PID)
client_pid = cr.pid;
{
socklen_t len = sizeof (pid_t);
- getsockopt(fd, SOL_LOCAL, LOCAL_PEERPID, &client_pid, &len);
+ getsockopt (fd, SOL_LOCAL, LOCAL_PEERPID, &client_pid, &len);
}
#elif defined (LOCAL_PEEREID)
{
ucred_free (ucred);
}
}
+#else
+ (void)fd;
#endif
- return client_pid == (pid_t)(-1)? 0 : (unsigned long)client_pid;
+ return (unsigned long)client_pid;
}
/* Main processing loop. */
while ( !ssh_request_process (ctrl, stream_sock) )
{
- /* Check wether we have reached EOF before trying to read
+ /* Check whether we have reached EOF before trying to read
another request. */
int c;
line = skip_options (line);
- p = line;
for (p=line; *p && *p != ' ' && *p != '\t'; p++)
;
*p = '\0';
}
line = skip_options (line);
- p = line;
for (p=line; *p && *p != ' ' && *p != '\t'; p++)
;
*p = '\0';
force = has_option (line, "--force");
line = skip_options (line);
- p = line;
for (p=line; *p && *p != ' ' && *p != '\t'; p++)
;
*p = '\0';
\f
+#if SIZEOF_TIME_T > SIZEOF_UNSIGNED_LONG
+#define KEYTOCARD_TIMESTAMP_FORMAT "(10:created-at10:%010llu))"
+#else
+#define KEYTOCARD_TIMESTAMP_FORMAT "(10:created-at10:%010lu))"
+#endif
+
static const char hlp_keytocard[] =
"KEYTOCARD [--force] <hexstring_with_keygrip> <serialno> <id> <timestamp>\n"
"\n";
gcry_sexp_release (s_skey);
keydatalen--; /* Decrement for last '\0'. */
/* Add timestamp "created-at" in the private key */
- snprintf (keydata+keydatalen-1, 30, "(10:created-at10:%010lu))", timestamp);
+ snprintf (keydata+keydatalen-1, 30, KEYTOCARD_TIMESTAMP_FORMAT, timestamp);
keydatalen += 10 + 19 - 1;
err = divert_writekey (ctrl, force, serialno, id, keydata, keydatalen);
xfree (keydata);
xfree (desc);
}
- return 0;
+ return err;
}
return 0;
}
xfree (pw);
- rc = 0;
}
else if (cache_mode == CACHE_MODE_NORMAL)
{
return 0;
}
xfree (pw);
- rc = 0;
}
}
/* FIXME: The following thing is pretty ugly code; we should
investigate how to make it cleaner. Probably code to handle
canonical S-expressions in a memory buffer is better suited for
- such a task. After all that is what we do in protect.c. Neeed
+ such a task. After all that is what we do in protect.c. Need
to find common patterns and write a straightformward API to use
them. */
assert (sizeof (size_t) <= sizeof (void*));
xfree (ctrl);
}
}
- fd = GNUPG_INVALID_FD;
}
}
}
-/* pkdecrypt.c - public key decryption (well, acually using a secret key)
+/* pkdecrypt.c - public key decryption (well, actually using a secret key)
* Copyright (C) 2001, 2003 Free Software Foundation, Inc.
*
* This file is part of GnuPG.
}
/* ECDSA 521 is special has it is larger than the largest hash
- we have (SHA-512). Thus we chnage the size for further
+ we have (SHA-512). Thus we change the size for further
processing to 512. */
if (pkalgo == GCRY_PK_ECDSA && qbits > 512)
qbits = 512;
/* Check whether we are at all allowed to modify the trustlist.
This is useful so that the trustlist may be a symlink to a global
- trustlist with only admin priviliges to modify it. Of course
+ trustlist with only admin privileges to modify it. Of course
this is not a secure way of denying access, but it avoids the
usual clicking on an Okay button most users are used to. */
fname = make_filename_try (gnupg_homedir (), "trustlist.txt", NULL);
#define ENV_REG "SYSTEM\\CurrentControlSet\\Control\\" \
"Session Manager\\Environment"
/* The following setting can be used for a per-user setting. */
-#if 0
-#define ENV_HK HKEY_CURRENT_USER
-#define ENV_REG "Environment"
-#endif
+#define ENV_HK_USER HKEY_CURRENT_USER
+#define ENV_REG_USER "Environment"
/* Due to a bug in Windows7 (kb 2685893) we better put a lower limit
than 8191 on the maximum length of the PATH variable. Note, that
depending on the used toolchain we used to had a 259 byte limit in
stack_t **stacktop, extra_parameters_t *extra)
{
char dir[PATH_LENGTH_LIMIT];
+ char is_user_install[2];
char *path;
char *path_new;
int path_new_size;
char *comp;
const char delims[] = ";";
+ int is_user;
HKEY key_handle = 0;
+ HKEY root_key;
+ const char *env_reg;
g_hwndParent = hwndParent;
EXDLL_INIT();
if (popstring (dir, sizeof (dir)))
return;
-/* MessageBox (g_hwndParent, "XXX 2", 0, MB_OK); */
+ /* The expected stack layout: HKEY component. */
+ if (popstring (is_user_install, sizeof (is_user_install)))
+ return;
+
+ if (!strcmp(is_user_install, "1"))
+ {
+ root_key = ENV_HK_USER;
+ env_reg = ENV_REG_USER;
+ }
+ else
+ {
+ root_key = ENV_HK;
+ env_reg = ENV_REG;
+ }
+
+ path = read_w32_registry_string (root_key, env_reg, "Path");
- path = read_w32_registry_string (ENV_HK, ENV_REG, "Path");
if (! path)
{
- MessageBox (g_hwndParent, "No PATH variable found", 0, MB_OK);
- return;
+ path = strdup ("");
}
/* MessageBox (g_hwndParent, "XXX 3", 0, MB_OK); */
do
{
/* MessageBox (g_hwndParent, comp, 0, MB_OK); */
+ if (!comp)
+ break;
if (!strcmp (comp, dir))
{
while (comp);
free (path);
-/* MessageBox (g_hwndParent, "XXX 8", 0, MB_OK); */
-
- /* Set a key for our CLSID. */
- RegCreateKey (ENV_HK, ENV_REG, &key_handle);
+ /* Update the path key. */
+ RegCreateKey (root_key, env_reg, &key_handle);
RegSetValueEx (key_handle, "Path", 0, REG_EXPAND_SZ,
path_new, path_new_size);
RegCloseKey (key_handle);
stack_t **stacktop, extra_parameters_t *extra)
{
char dir[PATH_LENGTH_LIMIT];
+ char is_user_install[2];
char *path;
char *path_new;
int path_new_size;
HKEY key_handle = 0;
int changed = 0;
int count = 0;
+ HKEY root_key;
+ const char *env_reg;
g_hwndParent = hwndParent;
EXDLL_INIT();
if (popstring (dir, sizeof (dir)))
return;
- path = read_w32_registry_string (ENV_HK, ENV_REG, "Path");
+ /* The expected stack layout: HKEY component. */
+ if (popstring (is_user_install, sizeof (is_user_install)))
+ return;
+
+ if (!strcmp(is_user_install, "1"))
+ {
+ root_key = ENV_HK_USER;
+ env_reg = ENV_REG_USER;
+ }
+ else
+ {
+ root_key = ENV_HK;
+ env_reg = ENV_REG;
+ }
+
+ path = read_w32_registry_string (root_key, env_reg, "Path");
+
+ if (!path)
+ return;
/* Old path plus semicolon plus dir plus terminating nul. */
path_new_size = strlen (path) + 1;
path_new = malloc (path_new_size);
return;
/* Set a key for our CLSID. */
- RegCreateKey (ENV_HK, ENV_REG, &key_handle);
+ RegCreateKey (root_key, env_reg, &key_handle);
RegSetValueEx (key_handle, "Path", 0, REG_EXPAND_SZ,
path_new, path_new_size);
RegCloseKey (key_handle);
# inst.nsi - Installer for GnuPG on Windows. -*- coding: latin-1; -*-
# Copyright (C) 2005, 2014 g10 Code GmbH
+# 2017 Intevation GmbH
#
# This file is part of GnuPG.
#
!define PRETTY_PACKAGE "GNU Privacy Guard"
!define PRETTY_PACKAGE_SHORT "GnuPG"
!define COMPANY "The GnuPG Project"
-!define COPYRIGHT "Copyright (C) 2015 The GnuPG Project"
+!define COPYRIGHT "Copyright (C) 2017 The GnuPG Project"
!define DESCRIPTION "GnuPG: The GNU Privacy Guard for Windows"
!define INSTALL_DIR "GnuPG"
# SetCompressorDictSize 8
!endif
-# Include the generic parts.
-!define HAVE_STARTMENU
-
# We use the modern UI.
!include "MUI.nsh"
!include "LogicLib.nsh"
!include "x64.nsh"
+# We support user mode installation but prefer system wide
+!define MULTIUSER_EXECUTIONLEVEL Highest
+!define MULTIUSER_MUI
+!define MULTIUSER_INSTALLMODE_COMMANDLINE
+!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_KEY "Software\${PACKAGE_SHORT}"
+!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_VALUENAME ""
+!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_KEY "Software\${PACKAGE_SHORT}"
+!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_VALUENAME "Install Directory"
+!define MULTIUSER_INSTALLMODE_INSTDIR "${PACKAGE_SHORT}"
+!include "MultiUser.nsh"
+
# Set the package name. Note that this name should not be suffixed
# with the version because this would get displayed in the start menu.
# Given that a slash in the name troubles Windows startmenu creation
!endif
InstallDir "$PROGRAMFILES\${INSTALL_DIR}"
-InstallDirRegKey HKLM "Software\${PACKAGE_SHORT}" "Install Directory"
-
-
# Add version information to the file properties.
VIProductVersion "${PROD_VERSION}"
VIAddVersionKey "ProductName" "${PRETTY_PACKAGE_SHORT} (${VERSION})"
# We don't have MUI_PAGE_DIRECTORY
-!ifdef HAVE_STARTMENU
+!ifdef WITH_GUI
Page custom CustomPageOptions
!define MUI_PAGE_CUSTOMFUNCTION_PRE CheckIfStartMenuWanted
!define MUI_STARTMENUPAGE_NODISABLE
-!define MUI_STARTMENUPAGE_REGISTRY_ROOT "HKCU"
+!define MUI_STARTMENUPAGE_REGISTRY_ROOT "SHCTX"
!define MUI_STARTMENUPAGE_REGISTRY_KEY "Software\GnuPG"
!define MUI_STARTMENUPAGE_REGISTRY_VALUENAME "Start Menu Folder"
# We need to set the Startmenu name explicitly because a slash in the
UserInfo::GetAccountType
Pop $1
StrCmp $1 "Admin" leave +1
- MessageBox MB_OK "$(T_AdminNeeded)"
- Quit
-
+ MessageBox MB_YESNO "$(T_AdminWanted)" IDNO exit
+ goto leave
+ exit:
+ Quit
leave:
FunctionEnd
eine neuere oder dieselbe Version handelt.)"
LangString T_FoundExistingVersionB ${LANG_ENGLISH} \
"A version of GnuPG has already been installed on the system. \
- There will be no problem installing and thus overwriting this \
- Version. $\r$\n\
+ $\r$\n\
$\r$\n\
Do you want to continue installing GnuPG?"
LangString T_FoundExistingVersionB ${LANG_GERMAN} \
"Eine Version von GnuPG ist hier bereits installiert. \
- Es ist problemlos möglich, die Installation fortzuführen. $\r$\n\
+ $\r$\n\
$\r$\n\
Möchten die die Installation von GnuPG fortführen?"
# From Function PrintNonAdminWarning
-LangString T_AdminNeeded ${LANG_ENGLISH} \
- "Warning: Administrator permissions required for a successful installation"
-LangString T_AdminNeeded ${LANG_GERMAN} \
- "Achtung: Für eine erfolgreiche Installation werden \
- Administratorrechte benötigt."
+LangString T_AdminWanted ${LANG_ENGLISH} \
+ "Warning: It is recommended to install GnuPG system-wide with \
+ administrator rights. \
+ $\r$\n\
+ $\r$\n\
+ Do you want to continue installing GnuPG without administrator rights?"
+LangString T_AdminWanted ${LANG_GERMAN} \
+ "Achtung: Es wird empfohlen GnuPG systemweit mit \
+ Administratorrechten zu installieren. \
+ $\r$\n\
+ $\r$\n\
+ Möchten die die Installation von GnuPG ohne Administratorrechte fortführen?"
# From Function PrintCloseOtherApps
LangString T_CloseOtherApps ${LANG_ENGLISH} \
# AddToPath - Adds the given dir to the search path.
# Input - head of the stack
Function AddToPath
+ ClearErrors
+ UserInfo::GetName
+ IfErrors add_admin
+ Pop $0
+ UserInfo::GetAccountType
+ Pop $1
+ StrCmp $1 "Admin" add_admin add_user
+
+add_admin:
Exch $0
- g4wihelp::path_add "$0"
+ g4wihelp::path_add "$0" "0"
+ goto add_done
+add_user:
+ Exch $0
+ g4wihelp::path_add "$0" "1"
+ goto add_done
+
+add_done:
StrCmp $R5 "0" add_to_path_done
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
add_to_path_done:
# RemoveFromPath - Remove a given dir from the path
# Input: head of the stack
Function un.RemoveFromPath
+ ClearErrors
+ UserInfo::GetName
+ IfErrors remove_admin
+ Pop $0
+ UserInfo::GetAccountType
+ Pop $1
+ StrCmp $1 "Admin" remove_admin remove_user
+
+remove_admin:
Exch $0
- g4wihelp::path_remove "$0"
+ g4wihelp::path_remove "$0" "0"
+ goto remove_done
+remove_user:
+ Exch $0
+ g4wihelp::path_remove "$0" "1"
+ goto remove_done
+
+remove_done:
StrCmp $R5 "0" remove_from_path_done
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
remove_from_path_done:
FileWrite $0 "${VERSION}$\r$\n"
FileClose $0
- WriteRegStr HKLM "Software\GnuPG" "Install Directory" $INSTDIR
+ WriteRegStr SHCTX "Software\GnuPG" "Install Directory" $INSTDIR
# If we are reinstalling, try to kill a possible running gpa using
# an already installed gpa.
Rename /REBOOTOK scdaemon.exe.tmp scdaemon.exe
SetOutPath "$INSTDIR\share\gnupg"
- File "share/gnupg/gpg-conf.skel"
- File "share/gnupg/dirmngr-conf.skel"
File "share/gnupg/distsigkey.gpg"
File "share/gnupg/sks-keyservers.netCA.pem"
RMDir "$INSTDIR"
# Clean the registry.
- DeleteRegValue HKLM "Software\GNU\GnuPG" "Install Directory"
+ DeleteRegValue SHCTX "Software\GNU\GnuPG" "Install Directory"
SectionEnd
!insertmacro MUI_INSTALLOPTIONS_EXTRACT "${W32_SRCDIR}/inst-options.ini"
#Call CalcDepends
+
+ Var /GLOBAL changed_dir
+ # Check if the install directory was modified on the command line
+ StrCmp "$INSTDIR" "$PROGRAMFILES\${INSTALL_DIR}" unmodified 0
+ # It is modified. Save that value.
+ StrCpy $changed_dir "$INSTDIR"
+
+ # MULITUSER_INIT overwrites directory setting from command line
+ !insertmacro MULTIUSER_INIT
+ StrCpy $INSTDIR "$changed_dir"
+ goto initDone
+unmodified:
+ !insertmacro MULTIUSER_INIT
+initDone:
FunctionEnd
+Function "un.onInit"
+ !insertmacro MULTIUSER_UNINIT
+FunctionEnd
#Function .onInstFailed
# Delete $TEMP\gpgspltmp.wav
!ifdef WITH_GUI
Section "-startmenu"
-!ifdef HAVE_STARTMENU
- # Make sure that the context of the automatic variables has been set to
- # the "all users" shell folder. This guarantees that the menu gets written
- # for all users. We have already checked that we are running as Admin; or
- # we printed a warning that installation will not succeed.
- SetShellVarContext all
-
# Check if the start menu entries where requested.
!insertmacro MUI_INSTALLOPTIONS_READ $R0 "${W32_SRCDIR}/inst-options.ini" \
"Field 2" "State"
no_quick_launch:
-!endif
SectionEnd
!endif
# Windows Add/Remove Programs support
StrCpy $MYTMP "Software\Microsoft\Windows\CurrentVersion\Uninstall\GnuPG"
- WriteRegExpandStr HKLM $MYTMP "UninstallString" '"$INSTDIR\gnupg-uninstall.exe"'
- WriteRegExpandStr HKLM $MYTMP "InstallLocation" "$INSTDIR"
- WriteRegStr HKLM $MYTMP "DisplayName" "${PRETTY_PACKAGE}"
+ WriteRegExpandStr SHCTX $MYTMP "UninstallString" '"$INSTDIR\gnupg-uninstall.exe"'
+ WriteRegExpandStr SHCTX $MYTMP "InstallLocation" "$INSTDIR"
+ WriteRegStr SHCTX $MYTMP "DisplayName" "${PRETTY_PACKAGE}"
!ifdef WITH_GUI
- WriteRegStr HKLM $MYTMP "DisplayIcon" "$INSTDIR\bin\gpa.exe,0"
+ WriteRegStr SHCTX $MYTMP "DisplayIcon" "$INSTDIR\bin\gpa.exe,0"
+!else
+ WriteRegStr SHCTX $MYTMP "DisplayIcon" "$INSTDIR\bin\gpg.exe,0"
!endif
- WriteRegStr HKLM $MYTMP "DisplayVersion" "${VERSION}"
- WriteRegStr HKLM $MYTMP "Publisher" "The GnuPG Project"
- WriteRegStr HKLM $MYTMP "URLInfoAbout" "https://gnupg.org"
- WriteRegDWORD HKLM $MYTMP "NoModify" "1"
- WriteRegDWORD HKLM $MYTMP "NoRepair" "1"
+ WriteRegStr SHCTX $MYTMP "DisplayVersion" "${VERSION}"
+ WriteRegStr SHCTX $MYTMP "Publisher" "The GnuPG Project"
+ WriteRegStr SHCTX $MYTMP "URLInfoAbout" "https://gnupg.org"
+ WriteRegDWORD SHCTX $MYTMP "NoModify" "1"
+ WriteRegDWORD SHCTX $MYTMP "NoRepair" "1"
SectionEnd
-
Section Uninstall
-
!ifdef WITH_GUI
-!ifdef HAVE_STARTMENU
- # Make sure that the context of the automatic variables has been set to
- # the "all users" shell folder. This guarantees that the menu gets written
- # for all users. We have already checked that we are running as Admin; or
- # we printed a warning that installation will not succeed.
- SetShellVarContext all
-
#---------------------------------------------------
# Delete the menu entries and any empty parent menus
#---------------------------------------------------
StrCmp $MYTMP $SMPROGRAMS startMenuDeleteLoopDone startMenuDeleteLoop
startMenuDeleteLoopDone:
- DeleteRegValue HKLM "Software\GNU\GnuPG" "Start Menu Folder"
+ DeleteRegValue SHCTX "Software\GNU\GnuPG" "Start Menu Folder"
# Delete Desktop links.
Delete "$DESKTOP\GPA.lnk"
no_quick_launch_uninstall:
!endif
-!endif
Delete "$INSTDIR\gnupg-uninstall.exe"
RMDir "$INSTDIR"
# Clean the registry.
- DeleteRegValue HKLM "Software\GnuPG" "Install Directory"
- DeleteRegKey /ifempty HKLM "Software\GnuPG"
+ DeleteRegValue SHCTX "Software\GnuPG" "Install Directory"
+ DeleteRegKey /ifempty SHCTX "Software\GnuPG"
# Remove Windows Add/Remove Programs support.
- DeleteRegKey HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\GnuPG"
+ DeleteRegKey SHCTX "Software\Microsoft\Windows\CurrentVersion\Uninstall\GnuPG"
SectionEnd
\def\argremovecomment#1\comment#2\ArgTerm{\argremovec #1\c\ArgTerm}
\def\argremovec#1\c#2\ArgTerm{\argcheckspaces#1\^^M\ArgTerm}
-% Each occurence of `\^^M' or `<space>\^^M' is replaced by a single space.
+% Each occurrence of `\^^M' or `<space>\^^M' is replaced by a single space.
%
% \argremovec might leave us with trailing space, e.g.,
% @end itemize @c foo
% to get _exactly_ the rest of the line, we had to prevent such situation.
% We prepended an \empty token at the very beginning and we expand it now,
% just before passing the control to \argtorun.
-% (Similarily, we have to think about #3 of \argcheckspacesY above: it is
+% (Similarly, we have to think about #3 of \argcheckspacesY above: it is
% either the null string, or it ends with \^^M---thus there is no danger
% that a pair of braces would be stripped.
%
% used to check whether the current environment is the one expected.
%
% Non-false conditionals (@iftex, @ifset) don't fit into this, so they
-% are not treated as enviroments; they don't open a group. (The
+% are not treated as environments; they don't open a group. (The
% implementation of @end takes care not to call \endgroup in this
% special case.)
\fi
}
-% Evironment mismatch, #1 expected:
+% Environment mismatch, #1 expected:
\def\badenverr{%
\errhelp = \EMsimple
\errmessage{This command can appear only \inenvironment\temp,
% In case a @footnote appears in a vbox, save the footnote text and create
% the real \insert just after the vbox finished. Otherwise, the insertion
% would be lost.
-% Similarily, if a @footnote appears inside an alignment, save the footnote
+% Similarly, if a @footnote appears inside an alignment, save the footnote
% text to a box and make the \insert when a row of the table is finished.
% And the same can be done for other insert classes. --kasal, 16nov03.
2001-12-19 Werner Koch <wk@gnupg.org>
* util.h [CYGWIN32]: Allow this as an alias for MINGW32. Include
- stdarg.h becuase we use the va_list type. By Disastry.
+ stdarg.h because we use the va_list type. By Disastry.
2001-09-28 Werner Koch <wk@gnupg.org>
EXTRA_DIST = mkstrtable.awk exaudit.awk exstatus.awk ChangeLog-2011 \
audit-events.h status-codes.h ChangeLog.jnlib \
- ChangeLog-2011.include w32info-rc.h.in gnupg.ico
+ ChangeLog-2011.include w32info-rc.h.in gnupg.ico \
+ all-tests.scm
noinst_LIBRARIES = libcommon.a libcommonpth.a libgpgrl.a
if !HAVE_W32CE_SYSTEM
--- /dev/null
+;; Copyright (C) 2017 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 <http://www.gnu.org/licenses/>.
+
+(export all-tests
+ ;; XXX: Currently, the makefile parser does not understand this
+ ;; Makefile.am, so we hardcode the list of tests here.
+ (map (lambda (name)
+ (test::binary #f
+ (path-join "common" name)
+ (path-join (getenv "objdir") "common" name)))
+ (list "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-name-value"
+ "t-ccparray"
+ "t-recsel"
+ "t-exechelp"
+ "t-exectool"
+ )))
/* List the chain of certificates from STARTITEM up to STOPEVENT. The
- certifcates are written out as comments. */
+ certificates are written out as comments. */
static void
list_certchain (audit_ctx_t ctx, log_item_t startitem, audit_event_t stopevent)
{
break;
case s_init:
ds = s_lfseen;
+ /* fall through */
case s_lfseen:
if (*s != "-----BEGIN "[pos])
{
return err;
}
- /* The first time we are used, intialize the gpg_program variable. */
+ /* The first time we are used, initialize the gpg_program variable. */
if ( !gpg_program || !*gpg_program )
gpg_program = gnupg_module_name (GNUPG_MODULE_NAME_GPG);
# endif
#endif
-/* In GnuPG we use wrappers around the malloc fucntions. If they are
+/* In GnuPG we use wrappers around the malloc functions. If they are
not defined we assume that this code is used outside of GnuPG and
fall back to the regular malloc functions. */
#ifndef xtrymalloc
GNUPG_SPAWN_RUN_ASFW
On W32 (but not on W32CE) run AllowSetForegroundWindow for
the child. Note that due to unknown problems this actually
- allows SetForegroundWindow for all childs of this process.
+ allows SetForegroundWindow for all children of this process.
*/
gpg_error_t
Other error codes may be returned as well. Unless otherwise noted,
-1 will be stored at R_EXITCODE. R_EXITCODE may be passed as NULL
- if the exit code is not required (in that case an error messge will
+ if the exit code is not required (in that case an error message will
be printed). Note that under Windows PID is not the process id but
the handle of the process. */
gpg_error_t gnupg_wait_process (const char *pgmname, pid_t pid, int hang,
/* 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. */
+ other error messages or remaining output. */
while (! (fds[1].ignore && fds[2].ignore))
{
count = es_poll (fds, DIM(fds), -1);
-/* init.h - Definitions for init fucntions.
+/* init.h - Definitions for init functions.
* Copyright (C) 2007, 2012 Free Software Foundation, Inc.
*
* This file is part of GnuPG.
#include "sysutils.h"
#ifdef HAVE_W32_SYSTEM
-# define S_IRGRP S_IRUSR
-# define S_IROTH S_IRUSR
-# define S_IWGRP S_IWUSR
-# define S_IWOTH S_IWUSR
+# ifndef S_IRWXG
+# define S_IRGRP S_IRUSR
+# define S_IWGRP S_IWUSR
+# endif
+# ifndef S_IRWXO
+# define S_IROTH S_IRUSR
+# define S_IWOTH S_IWUSR
+# endif
#endif
if (arcno == 1)
{
if (val > 2)
- break; /* Not allowed, error catched below. */
+ break; /* Not allowed, error caught below. */
val1 = val;
}
else if (arcno == 2)
CIPHER_ALGO_TWOFISH = 10, /* 256 bit */
CIPHER_ALGO_CAMELLIA128 = 11,
CIPHER_ALGO_CAMELLIA192 = 12,
- CIPHER_ALGO_CAMELLIA256 = 13
+ CIPHER_ALGO_CAMELLIA256 = 13,
+ CIPHER_ALGO_PRIVATE10 = 110
}
cipher_algo_t;
PUBKEY_ALGO_ECDSA = 19, /* RFC-6637 */
PUBKEY_ALGO_ELGAMAL = 20, /* Elgamal encrypt+sign (legacy). */
/* 21 reserved by OpenPGP. */
- PUBKEY_ALGO_EDDSA = 22 /* EdDSA (not yet assigned). */
+ PUBKEY_ALGO_EDDSA = 22, /* EdDSA (not yet assigned). */
+ PUBKEY_ALGO_PRIVATE10 = 110
}
pubkey_algo_t;
DIGEST_ALGO_SHA256 = 8,
DIGEST_ALGO_SHA384 = 9,
DIGEST_ALGO_SHA512 = 10,
- DIGEST_ALGO_SHA224 = 11
+ DIGEST_ALGO_SHA224 = 11,
+ DIGEST_ALGO_PRIVATE10 = 110
}
digest_algo_t;
COMPRESS_ALGO_NONE = 0,
COMPRESS_ALGO_ZIP = 1,
COMPRESS_ALGO_ZLIB = 2,
- COMPRESS_ALGO_BZIP2 = 3
+ COMPRESS_ALGO_BZIP2 = 3,
+ COMPRESS_ALGO_PRIVATE10 = 110
}
compress_algo_t;
if (result)
{
- /* This expression evaluated to true. See wether there are
+ /* This expression evaluated to true. See whether there are
remaining expressions in this conjunction. */
if (!se->next || se->next->disjun)
break; /* All expressions are true. Return True. */
*/
/* This file implements a few utility functions useful when working
- with canonical encrypted S-expresions (i.e. not the S-exprssion
+ with canonical encrypted S-expressions (i.e. not the S-exprssion
objects from libgcrypt). */
#include <config.h>
/* Create a simple S-expression from the hex string at LINE. Returns
a newly allocated buffer with that canonical encoded S-expression
or NULL in case of an error. On return the number of characters
- scanned in LINE will be stored at NSCANNED. This fucntions stops
+ scanned in LINE will be stored at NSCANNED. This functions stops
converting at the first character not representing a hexdigit. Odd
numbers of hex digits are allowed; a leading zero is then
assumed. If no characters have been found, NULL is returned.*/
-/* simple-pwquery.c - A simple password query cleint for gpg-agent
+/* simple-pwquery.c - A simple password query client for gpg-agent
* Copyright (C) 2002 Free Software Foundation, Inc.
*
* This file is part of GnuPG.
\f
/* Format a string so that it fits within about TARGET_COLS columns.
- If IN_PLACE is 0, then TEXT is copied to a new buffer, which is
- returned. Otherwise, TEXT is modified in place and returned.
- Normally, target_cols will be 72 and max_cols is 80. */
+ * TEXT_IN is copied to a new buffer, which is returned. Normally,
+ * target_cols will be 72 and max_cols is 80. On error NULL is
+ * returned and ERRNO is set. */
char *
-format_text (char *text, int in_place, int target_cols, int max_cols)
+format_text (const char *text_in, int target_cols, int max_cols)
{
- const int do_debug = 0;
+ /* const int do_debug = 0; */
/* The character under consideration. */
char *p;
char *last_space = NULL;
int last_space_cols = 0;
int copied_last_space = 0;
+ char *text;
- if (! in_place)
- text = xstrdup (text);
+ text = xtrystrdup (text_in);
+ if (!text)
+ return NULL;
p = line = text;
while (1)
cols_with_left_space = last_space_cols;
cols_with_right_space = cols;
- if (do_debug)
- log_debug ("Breaking: '%.*s'\n",
- (int) ((uintptr_t) p - (uintptr_t) line), line);
+ /* if (do_debug) */
+ /* log_debug ("Breaking: '%.*s'\n", */
+ /* (int) ((uintptr_t) p - (uintptr_t) line), line); */
/* The number of columns away from TARGET_COLS. We prefer
to underflow than to overflow. */
max_cols. */
right_penalty += 4 * (cols_with_right_space - max_cols);
- if (do_debug)
- log_debug ("Left space => %d cols (penalty: %d); right space => %d cols (penalty: %d)\n",
- cols_with_left_space, left_penalty,
- cols_with_right_space, right_penalty);
+ /* if (do_debug) */
+ /* log_debug ("Left space => %d cols (penalty: %d); " */
+ /* "right space => %d cols (penalty: %d)\n", */
+ /* cols_with_left_space, left_penalty, */
+ /* cols_with_right_space, right_penalty); */
if (last_space_cols && left_penalty <= right_penalty)
- /* Prefer the left space. */
{
- if (do_debug)
- log_debug ("Breaking at left space.\n");
+ /* Prefer the left space. */
+ /* if (do_debug) */
+ /* log_debug ("Breaking at left space.\n"); */
p = last_space;
}
else
{
- if (do_debug)
- log_debug ("Breaking at right space.\n");
+ /* if (do_debug) */
+ /* log_debug ("Breaking at right space.\n"); */
}
if (! *p)
int compare_version_strings (const char *my_version, const char *req_version);
/* Format a string so that it fits within about TARGET_COLS columns. */
-char *format_text (char *text, int in_place, int target_cols, int max_cols);
+char *format_text (const char *text, int target_cols, int max_cols);
/*-- mapstrings.c --*/
/* Check whether FNAME has the form "-&nnnn", where N is a non-zero
* number. Returns this number or -1 if it is not the case. If the
* caller wants to use the file descriptor for writing FOR_WRITE shall
- * be set to 1. If NOTRANSLATE is set the Windows spefic mapping is
+ * be set to 1. If NOTRANSLATE is set the Windows specific mapping is
* not done. */
int
check_special_filename (const char *fname, int for_write, int notranslate)
if (gpg_err_code (err) != GPG_ERR_INV_VALUE)
fail (err);
- /* Delete some nonexistant variables. */
+ /* Delete some nonexistent variables. */
err = session_env_putenv (se, "A");
if (err)
fail (err);
{
struct test *test = &tests[i];
char *result =
- format_text (test->input, 0, test->target_cols, test->max_cols);
+ format_text (test->input, test->target_cols, test->max_cols);
+ if (!result)
+ {
+ fail (1);
+ exit (2);
+ }
if (strcmp (result, test->expected) != 0)
{
printf ("%s: Test #%d failed.\nExpected: '%s'\nResult: '%s'\n",
# configure.ac - for GnuPG 2.1
-# Copyright (C) 1998-2012 Free Software Foundation, Inc.
-# Copyright (C) 1998-2016 Werner Koch
+# Copyright (C) 1998-2017 Free Software Foundation, Inc.
+# Copyright (C) 1998-2017 Werner Koch
#
# This file is part of GnuPG.
#
m4_define([mym4_package],[gnupg])
m4_define([mym4_major], [2])
m4_define([mym4_minor], [1])
-m4_define([mym4_micro], [20])
+m4_define([mym4_micro], [21])
# To start a new development series, i.e a new major or minor number
# you need to mark an arbitrary commit before the first beta release
AC_SUBST(LIBUSB_CPPFLAGS)
#
-# Check wether it is necessary to link against libdl.
+# Check whether it is necessary to link against libdl.
# (For example to load libpcsclite)
#
gnupg_dlopen_save_libs="$LIBS"
AC_CHECK_HEADERS([string.h unistd.h langinfo.h termio.h locale.h getopt.h \
pty.h utmp.h pwd.h inttypes.h signal.h sys/select.h \
stdint.h signal.h util.h libutil.h termios.h \
- ucred.h])
+ ucred.h sys/sysmacros.h sys/mkdev.h])
AC_HEADER_TIME
# Dirmngr requires mmap on Unix systems.
if test $ac_cv_func_mmap != yes -a $mmap_needed = yes; then
- AC_MSG_ERROR([[Sorry, the current implemenation requires mmap.]])
+ AC_MSG_ERROR([[Sorry, the current implementation requires mmap.]])
fi
mycflags=
mycflags_save=$CFLAGS
- # Check whether gcc does not emit a diagnositc for unknow -Wno-*
+ # Check whether gcc does not emit a diagnositc for unknown -Wno-*
# options. This is the case for gcc >= 4.6
AC_MSG_CHECKING([if gcc ignores unknown -Wno-* options])
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
else
r = 1;
}
- /* fall */
+ /* fall through */
case CDB_PUT_ADD:
rl = cdbmp->cdb_rec[hval&255];
#ifdef HAVE_W32_SYSTEM
/* We load some functions dynamically. Provide typedefs for tehse
- * fucntions. */
+ * functions. */
typedef HCERTSTORE (WINAPI *CERTOPENSYSTEMSTORE)
(HCRYPTPROV hProv, LPCSTR szSubsystemProtocol);
typedef PCCERT_CONTEXT (WINAPI *CERTENUMCERTIFICATESINSTORE)
}
break;
case s_init:
- state = s_lfseen;
+ state = s_lfseen; /* fall through */
case s_lfseen:
if (c != "-----BEGIN "[pos])
state = s_idle;
local storage. We use this in conjunction with the
log_set_pid_suffix_cb feature. */
#ifndef HAVE_W32_SYSTEM
-static int my_tlskey_current_fd;
+static npth_key_t my_tlskey_current_fd;
#endif
/* Prototypes. */
#endif
struct sockaddr_un paddr;
socklen_t plen = sizeof( paddr );
- gnupg_fd_t fd;
int nfd, ret;
fd_set fdset, read_fdset;
struct timespec abstime;
if (FD_ISSET (FD2INT (listen_fd), &read_fdset))
{
+ gnupg_fd_t fd;
+
plen = sizeof paddr;
fd = INT2FD (npth_accept (FD2INT(listen_fd),
(struct sockaddr *)&paddr, &plen));
}
npth_setname_np (thread, threadname);
}
- fd = GNUPG_INVALID_FD;
}
}
#endif /*HAVE_INOTIFY_INIT*/
npth_attr_destroy (&tattr);
if (listen_fd != GNUPG_INVALID_FD)
- assuan_sock_close (fd);
+ assuan_sock_close (listen_fd);
cleanup ();
log_info ("%s %s stopped\n", strusage(11), strusage(13));
}
#ifndef T_SRV
#define T_SRV 33
#endif
-#ifndef T_CERT
-# define T_CERT 37
-#endif
+#undef T_CERT
+#define T_CERT 37
/* The standard SOCKS and TOR ports. */
#define SOCKS_PORT 1080
/* No DNS resolution type found in the list. This might be
* due to systemd based systems which allow for custom
* keywords which are not known to us and thus we do not
- * know whether DNS is wanted or not. Becuase DNS is
+ * know whether DNS is wanted or not. Because DNS is
* important for our infrastructure, we forcefully append
* DNS to the end of the list. */
if (strlen (ld.resolv_conf->lookup)+2 < sizeof ld.resolv_conf->lookup)
(*r_canonname)[strlen (*r_canonname)-1] = 0;
}
- dai = xtrymalloc (sizeof *dai + ent->ai_addrlen -1);
+ dai = xtrymalloc (sizeof *dai);
if (dai == NULL)
{
err = gpg_error_from_syserror ();
if (opt_disable_ipv6 && ai->ai_family == AF_INET6)
continue;
- dai = xtrymalloc (sizeof *dai + ai->ai_addrlen - 1);
+ dai = xtrymalloc (sizeof *dai);
dai->family = ai->ai_family;
dai->socktype = ai->ai_socktype;
dai->protocol = ai->ai_protocol;
#ifdef USE_LIBDNS
/* Resolve an address using libdns. */
static gpg_error_t
-resolve_addr_libdns (const struct sockaddr *addr, int addrlen,
+resolve_addr_libdns (const struct sockaddr_storage *addr, int addrlen,
unsigned int flags, char **r_name)
{
gpg_error_t err;
/* First we turn ADDR into a DNS name (with ".arpa" suffix). */
err = 0;
- if (addr->sa_family == AF_INET6)
+ if (addr->ss_family == AF_INET6)
{
const struct sockaddr_in6 *a6 = (const struct sockaddr_in6 *)addr;
if (!dns_aaaa_arpa (host, sizeof host, (void*)&a6->sin6_addr))
err = gpg_error (GPG_ERR_INV_OBJ);
}
- else if (addr->sa_family == AF_INET)
+ else if (addr->ss_family == AF_INET)
{
const struct sockaddr_in *a4 = (const struct sockaddr_in *)addr;
if (!dns_a_arpa (host, sizeof host, (void*)&a4->sin_addr))
buflen = sizeof ptr.host;
p = buffer;
- if (addr->sa_family == AF_INET6 && (flags & DNS_WITHBRACKET))
+ if (addr->ss_family == AF_INET6 && (flags & DNS_WITHBRACKET))
{
*p++ = '[';
buflen -= 2;
}
- ec = getnameinfo (addr, addrlen, p, buflen, NULL, 0, NI_NUMERICHOST);
+ ec = getnameinfo ((const struct sockaddr *)addr,
+ addrlen, p, buflen, NULL, 0, NI_NUMERICHOST);
if (ec)
{
err = map_eai_to_gpg_error (ec);
goto leave;
}
- if (addr->sa_family == AF_INET6 && (flags & DNS_WITHBRACKET))
+ if (addr->ss_family == AF_INET6 && (flags & DNS_WITHBRACKET))
strcat (buffer, "]");
}
/* Resolve an address using the standard system function. */
static gpg_error_t
-resolve_addr_standard (const struct sockaddr *addr, int addrlen,
+resolve_addr_standard (const struct sockaddr_storage *addr, int addrlen,
unsigned int flags, char **r_name)
{
gpg_error_t err;
if ((flags & DNS_NUMERICHOST) || tor_mode)
ec = EAI_NONAME;
else
- ec = getnameinfo (addr, addrlen, buffer, buflen, NULL, 0, NI_NAMEREQD);
+ ec = getnameinfo ((const struct sockaddr *)addr,
+ addrlen, buffer, buflen, NULL, 0, NI_NAMEREQD);
if (!ec && *buffer == '[')
ec = EAI_FAIL; /* A name may never start with a bracket. */
else if (ec == EAI_NONAME)
{
p = buffer;
- if (addr->sa_family == AF_INET6 && (flags & DNS_WITHBRACKET))
+ if (addr->ss_family == AF_INET6 && (flags & DNS_WITHBRACKET))
{
*p++ = '[';
buflen -= 2;
}
- ec = getnameinfo (addr, addrlen, p, buflen, NULL, 0, NI_NUMERICHOST);
- if (!ec && addr->sa_family == AF_INET6 && (flags & DNS_WITHBRACKET))
+ ec = getnameinfo ((const struct sockaddr *)addr,
+ addrlen, p, buflen, NULL, 0, NI_NUMERICHOST);
+ if (!ec && addr->ss_family == AF_INET6 && (flags & DNS_WITHBRACKET))
strcat (buffer, "]");
}
/* A wrapper around getnameinfo. */
gpg_error_t
-resolve_dns_addr (const struct sockaddr *addr, int addrlen,
+resolve_dns_addr (const struct sockaddr_storage *addr, int addrlen,
unsigned int flags, char **r_name)
{
gpg_error_t err;
int socktype;
int protocol;
int addrlen;
- struct sockaddr addr[1];
+ struct sockaddr_storage addr[1];
};
dns_addrinfo_t *r_dai, char **r_canonname);
/* Function similar to getnameinfo. */
-gpg_error_t resolve_dns_addr (const struct sockaddr *addr, int addrlen,
+gpg_error_t resolve_dns_addr (const struct sockaddr_storage *addr, int addrlen,
unsigned int flags, char **r_name);
/* Return true if NAME is a numerical IP address. */
/* Get the canonical name for NAME. */
gpg_error_t get_dns_cname (const char *name, char **r_cname);
-/* Return a CERT record or an arbitray RR. */
+/* Return a CERT record or an arbitrary RR. */
gpg_error_t get_dns_cert (const char *name, int want_certtype,
void **r_key, size_t *r_keylen,
unsigned char **r_fpr, size_t *r_fprlen,
#endif
#include <winsock2.h>
#include <ws2tcpip.h>
+typedef SOCKET socket_fd_t;
+#define STDCALL __stdcall
+#ifdef TIME_WITH_SYS_TIME
+#include <sys/time.h> /* gettimeofday(2) */
+#endif
#else
+typedef int socket_fd_t;
+#define STDCALL
#include <sys/time.h> /* gettimeofday(2) */
#include <sys/types.h> /* FD_SETSIZE socklen_t */
#include <sys/select.h> /* FD_ZERO FD_SET fd_set select(2) */
} /* dns_p_dictadd() */
+static inline uint16_t
+plus1_ns (uint16_t count_net)
+{
+ uint16_t count = ntohs (count_net);
+
+ count++;
+ return htons (count);
+}
+
int dns_p_push(struct dns_packet *P, enum dns_section section, const void *dn, size_t dnlen, enum dns_type type, enum dns_class class, unsigned ttl, const void *any) {
size_t end = P->end;
int error;
if (!P->memo.qd.base && (error = dns_p_study(P)))
goto error;
- dns_header(P)->qdcount = htons(ntohs(dns_header(P)->qdcount) + 1);
+ dns_header(P)->qdcount = plus1_ns (dns_header(P)->qdcount);
P->memo.qd.end = P->end;
P->memo.an.base = P->end;
if (!P->memo.an.base && (error = dns_p_study(P)))
goto error;
- dns_header(P)->ancount = htons(ntohs(dns_header(P)->ancount) + 1);
+ dns_header(P)->ancount = plus1_ns (dns_header(P)->ancount);
P->memo.an.end = P->end;
P->memo.ns.base = P->end;
if (!P->memo.ns.base && (error = dns_p_study(P)))
goto error;
- dns_header(P)->nscount = htons(ntohs(dns_header(P)->nscount) + 1);
+ dns_header(P)->nscount = plus1_ns (dns_header(P)->nscount);
P->memo.ns.end = P->end;
P->memo.ar.base = P->end;
if (!P->memo.ar.base && (error = dns_p_study(P)))
goto error;
- dns_header(P)->arcount = htons(ntohs(dns_header(P)->arcount) + 1);
+ dns_header(P)->arcount = plus1_ns (dns_header(P)->arcount);
P->memo.ar.end = P->end;
/* Some of the function pointers of DNS_RRTYPES are initialized with
- * slighlly different fucntions, thus we can't use prototypes. */
+ * slighlly different functions, thus we can't use prototypes. */
DNS_PRAGMA_PUSH
#if __clang__
#pragma clang diagnostic ignored "-Wstrict-prototypes"
} cnames;
};
-static void dns_te_initname(struct sockaddr_storage *ss, int fd, int (*f)(int, struct sockaddr *, socklen_t *)) {
+static void dns_te_initname(struct sockaddr_storage *ss, int fd, int (* STDCALL f)(socket_fd_t, struct sockaddr *, socklen_t *)) {
socklen_t n = sizeof *ss;
if (0 != f(fd, (struct sockaddr *)ss, &n))
if (fwrite(&tmp, 1, headsize, fp) < headsize)
return errno;
- if (fwrite(data, 1, datasize, fp) < datasize)
- return errno;
+ if (data)
+ if (fwrite(data, 1, datasize, fp) < datasize)
+ return errno;
if (fflush(fp))
return errno;
static int dns_ai_setent(struct addrinfo **ent, union dns_any *any, enum dns_type type, struct dns_addrinfo *ai) {
- struct sockaddr *saddr;
- struct sockaddr_in sin;
- struct sockaddr_in6 sin6;
+ union u {
+ struct sockaddr_in sin;
+ struct sockaddr_in6 sin6;
+ struct sockaddr_storage ss;
+ } addr;
const char *cname;
size_t clen;
switch (type) {
case DNS_T_A:
- saddr = memset(&sin, '\0', sizeof sin);
+ memset(&addr.sin, '\0', sizeof addr.sin);
- sin.sin_family = AF_INET;
- sin.sin_port = htons(ai->port);
+ addr.sin.sin_family = AF_INET;
+ addr.sin.sin_port = htons(ai->port);
- memcpy(&sin.sin_addr, any, sizeof sin.sin_addr);
+ memcpy(&addr.sin.sin_addr, any, sizeof addr.sin.sin_addr);
break;
case DNS_T_AAAA:
- saddr = memset(&sin6, '\0', sizeof sin6);
+ memset(&addr.sin6, '\0', sizeof addr.sin6);
- sin6.sin6_family = AF_INET6;
- sin6.sin6_port = htons(ai->port);
+ addr.sin6.sin6_family = AF_INET6;
+ addr.sin6.sin6_port = htons(ai->port);
- memcpy(&sin6.sin6_addr, any, sizeof sin6.sin6_addr);
+ memcpy(&addr.sin6.sin6_addr, any, sizeof addr.sin6.sin6_addr);
break;
default:
clen = 0;
}
- if (!(*ent = malloc(sizeof **ent + dns_sa_len(saddr) + ((ai->hints.ai_flags & AI_CANONNAME)? clen + 1 : 0))))
+ if (!(*ent = malloc(sizeof **ent + dns_sa_len(&addr) + ((ai->hints.ai_flags & AI_CANONNAME)? clen + 1 : 0))))
return dns_syerr();
memset(*ent, '\0', sizeof **ent);
- (*ent)->ai_family = saddr->sa_family;
+ (*ent)->ai_family = addr.ss.ss_family;
(*ent)->ai_socktype = ai->hints.ai_socktype;
(*ent)->ai_protocol = ai->hints.ai_protocol;
- (*ent)->ai_addr = memcpy((unsigned char *)*ent + sizeof **ent, saddr, dns_sa_len(saddr));
- (*ent)->ai_addrlen = dns_sa_len(saddr);
+ (*ent)->ai_addr = memcpy((unsigned char *)*ent + sizeof **ent, &addr, dns_sa_len(&addr));
+ (*ent)->ai_addrlen = dns_sa_len(&addr);
if (ai->hints.ai_flags & AI_CANONNAME)
- (*ent)->ai_canonname = memcpy((unsigned char *)*ent + sizeof **ent + dns_sa_len(saddr), cname, clen + 1);
+ (*ent)->ai_canonname = memcpy((unsigned char *)*ent + sizeof **ent + dns_sa_len(&addr), cname, clen + 1);
ai->found++;
*/
/* Simple HTTP client implementation. We try to keep the code as
- self-contained as possible. There are some contraints however:
+ self-contained as possible. There are some constraints however:
- estream is required. We now require estream because it provides a
very useful and portable asprintf implementation and the fopencookie
#include "../common/util.h"
#include "../common/i18n.h"
+#include "../common/sysutils.h" /* (gnupg_fd_t) */
#include "dns-stuff.h"
#include "http.h"
#include "http-common.h"
static gpg_error_t connect_server (const char *server, unsigned short port,
unsigned int flags, const char *srvtag,
assuan_fd_t *r_sock);
-static gpgrt_ssize_t read_server (int sock, void *buffer, size_t size);
-static gpg_error_t write_server (int sock, const char *data, size_t length);
+static gpgrt_ssize_t read_server (assuan_fd_t sock, void *buffer, size_t size);
+static gpg_error_t write_server (assuan_fd_t sock, const char *data, size_t length);
static gpgrt_ssize_t cookie_read (void *cookie, void *buffer, size_t size);
static gpgrt_ssize_t cookie_write (void *cookie,
const void *buffer, size_t size);
static int cookie_close (void *cookie);
-#ifdef HAVE_W32_SYSTEM
+#if defined(HAVE_W32_SYSTEM) && defined(HTTP_USE_NTBTLS)
static gpgrt_ssize_t simple_cookie_read (void *cookie,
void *buffer, size_t size);
static gpgrt_ssize_t simple_cookie_write (void *cookie,
/* Simple cookie functions. Here the cookie is an int with the
* socket. */
-#ifdef HAVE_W32_SYSTEM
+#if defined(HAVE_W32_SYSTEM) && defined(HTTP_USE_NTBTLS)
static es_cookie_io_functions_t simple_cookie_functions =
{
simple_cookie_read,
so->refcount = 1;
if (opt_debug)
log_debug ("http.c:%d:socket_new: object %p for fd %d created\n",
- lnr, so, so->fd);
+ lnr, so, (int)so->fd);
return so;
}
#define my_socket_new(a) _my_socket_new (__LINE__, (a))
so->refcount++;
if (opt_debug > 1)
log_debug ("http.c:%d:socket_ref: object %p for fd %d refcount now %d\n",
- lnr, so, so->fd, so->refcount);
+ lnr, so, (int)so->fd, so->refcount);
return so;
}
#define my_socket_ref(a) _my_socket_ref (__LINE__,(a))
so->refcount--;
if (opt_debug > 1)
log_debug ("http.c:%d:socket_unref: object %p for fd %d ref now %d\n",
- lnr, so, so->fd, so->refcount);
+ lnr, so, (int)so->fd, so->refcount);
if (!so->refcount)
{
is not required but some very old servers (e.g. the original pksd
keyserver didn't worked without it. */
if ((hd->flags & HTTP_FLAG_SHUTDOWN))
- shutdown (hd->sock->fd, 1);
+ shutdown (FD2INT (hd->sock->fd), 1);
hd->in_data = 0;
/* Create a new cookie and a stream for reading. */
if ((n = remove_escapes (uri->host)) < 0)
return GPG_ERR_BAD_URI;
if (n != strlen (uri->host))
- return GPG_ERR_BAD_URI; /* Hostname incudes a Nul. */
+ return GPG_ERR_BAD_URI; /* Hostname includes a Nul. */
p = p2 ? p2 : NULL;
}
else if (uri->is_http)
const char *http_proxy = NULL;
char *proxy_authstr = NULL;
char *authstr = NULL;
- int sock;
+ assuan_fd_t sock;
if (hd->uri->use_tls && !hd->session)
{
if (*line == ' ' || *line == '\t')
{
/* Continuation. This won't happen too often as it is not
- recommended. We use a straightforward implementaion. */
+ recommended. We use a straightforward implementation. */
if (!hd->headers)
return GPG_ERR_PROTOCOL_VIOLATION;
n += strlen (hd->headers->value);
/* Return true if SOCKS shall be used. This is the case if tor_mode
* is enabled and the desired address is not the loopback address.
- * This function is basically a copy of the same internal fucntion in
+ * This function is basically a copy of the same internal function in
* Libassuan. */
static int
-use_socks (struct sockaddr *addr)
+use_socks (struct sockaddr_storage *addr)
{
int mode;
if (assuan_sock_get_flag (ASSUAN_INVALID_FD, "tor-mode", &mode) || !mode)
return 0; /* Not in Tor mode. */
- else if (addr->sa_family == AF_INET6)
+ else if (addr->ss_family == AF_INET6)
{
struct sockaddr_in6 *addr_in6 = (struct sockaddr_in6 *)addr;
const unsigned char *s;
return 0; /* This is the loopback address. */
}
- else if (addr->sa_family == AF_INET)
+ else if (addr->ss_family == AF_INET)
{
struct sockaddr_in *addr_in = (struct sockaddr_in *)addr;
/* Wrapper around assuan_sock_new which takes the domain from an
* address parameter. */
static assuan_fd_t
-my_sock_new_for_addr (struct sockaddr *addr, int type, int proto)
+my_sock_new_for_addr (struct sockaddr_storage *addr, int type, int proto)
{
int domain;
domain = AF_INET;
}
else
- domain = addr->sa_family;
+ domain = addr->ss_family;
return assuan_sock_new (domain, type, proto);
}
}
anyhostaddr = 1;
- if (assuan_sock_connect (sock, ai->addr, ai->addrlen))
+ if (assuan_sock_connect (sock, (struct sockaddr *)ai->addr,
+ ai->addrlen))
{
last_err = gpg_err_make (default_errsource,
gpg_err_code_from_syserror ());
/* Helper to read from a socket. This handles npth things and
* EINTR. */
static gpgrt_ssize_t
-read_server (int sock, void *buffer, size_t size)
+read_server (assuan_fd_t sock, void *buffer, size_t size)
{
int nread;
# if defined(USE_NPTH)
npth_unprotect ();
# endif
- nread = recv (sock, buffer, size, 0);
+ nread = recv (FD2INT (sock), buffer, size, 0);
# if defined(USE_NPTH)
npth_protect ();
# endif
static gpg_error_t
-write_server (int sock, const char *data, size_t length)
+write_server (assuan_fd_t sock, const char *data, size_t length)
{
int nleft;
int nwritten;
# if defined(USE_NPTH)
npth_unprotect ();
# endif
- nwritten = send (sock, data, nleft, 0);
+ nwritten = send (FD2INT (sock), data, nleft, 0);
# if defined(USE_NPTH)
npth_protect ();
# endif
}
-#ifdef HAVE_W32_SYSTEM
+#if defined(HAVE_W32_SYSTEM) && defined(HTTP_USE_NTBTLS)
static gpgrt_ssize_t
simple_cookie_read (void *cookie, void *buffer, size_t size)
{
- int sock = (int)(uintptr_t)cookie;
+ assuan_fd_t sock = (assuan_fd_t)cookie;
return read_server (sock, buffer, size);
}
static gpgrt_ssize_t
simple_cookie_write (void *cookie, const void *buffer_arg, size_t size)
{
- int sock = (int)(uintptr_t)cookie;
+ assuan_fd_t sock = (assuan_fd_t)cookie;
const char *buffer = buffer_arg;
int nwritten;
case KEYDB_SEARCH_MODE_FPR16:
log_error ("HKP keyservers do not support v3 fingerprints\n");
+ /* fall through */
default:
return gpg_error (GPG_ERR_INV_USER_ID);
}
char buffer[4000]; /* Data ring buffer. */
size_t buffer_len; /* The amount of data in the BUFFER. */
size_t buffer_pos; /* The next read position of the BUFFER. */
+ size_t buffer_read_pos; /* The next read position of the BUFFER. */
};
#define BUFFER_EMPTY(c) ((c)->buffer_len == 0)
#define BUFFER_SPACE_AVAILABLE(c) (DIM((c)->buffer) - (c)->buffer_len)
#define BUFFER_INC_POS(c,n) (c)->buffer_pos = ((c)->buffer_pos + (n)) % DIM((c)->buffer)
#define BUFFER_CUR_POS(c) (&(c)->buffer[(c)->buffer_pos])
+#define BUFFER_INC_READ_POS(c,n) (c)->buffer_read_pos = ((c)->buffer_read_pos + (n)) % DIM((c)->buffer)
+#define BUFFER_CUR_READ_POS(c) (&(c)->buffer[(c)->buffer_read_pos])
static int
buffer_get_data (struct outstream_cookie_s *cookie, char *dst, int cnt)
if (chunk > left)
chunk = left;
- memcpy (dst, BUFFER_CUR_POS (cookie), chunk);
- BUFFER_INC_POS (cookie, chunk);
+ memcpy (dst, BUFFER_CUR_READ_POS (cookie), chunk);
+ BUFFER_INC_READ_POS (cookie, chunk);
left -= chunk;
dst += chunk;
if (left)
{
- memcpy (dst, BUFFER_CUR_POS (cookie), left);
- BUFFER_INC_POS (cookie, left);
+ memcpy (dst, BUFFER_CUR_READ_POS (cookie), left);
+ BUFFER_INC_READ_POS (cookie, left);
}
return amount;
/* The writer function for the outstream. This is used to transfer
the output of the ldap wrapper thread to the ksba reader object. */
-static ssize_t
+static gpgrt_ssize_t
outstream_cookie_writer (void *cookie_arg, const void *buffer, size_t size)
{
struct outstream_cookie_s *cookie = cookie_arg;
-/* We keep a global list of spawed wrapper process. A separate thread
+/* We keep a global list of spawned wrapper process. A separate thread
makes use of this list to log error messages and to watch out for
finished processes. */
static struct wrapper_context_s *wrapper_list;
/* Get the time from the current swdb file and store it at R_FILEDATE
* and R_VERIFIED. If the file does not exist 0 is stored at there.
- * The function returns 0 on sucess or an error code. */
+ * The function returns 0 on success or an error code. */
static gpg_error_t
time_of_saved_swdb (const char *fname, time_t *r_filedate, time_t *r_verified)
{
goto leave;
}
- /* Note that the parser uses the first occurance of a matching
+ /* Note that the parser uses the first occurrence of a matching
* values and ignores possible duplicated values. */
maxlen = 2048; /* Set limit. */
while ((len = es_read_line (fp, &line, &length_of_line, &maxlen)) > 0)
}
}
- /* First look through the internal cache. The certifcates returned
+ /* First look through the internal cache. The certificates returned
here are not counted towards the truncation limit. */
if (single && !cache_only)
; /* Do not read from the local cache in this case. */
}
}
- /* Decide which to use. Note that the sesssion has no keyservers
+ /* Decide which to use. Note that the session has no keyservers
yet set. */
if (onion_items && !onion_items->next && plain_items && !plain_items->next)
{
}
/* Ask for the key meta data. Not actually needed for HKP servers
- but we do it anyway to test the client implementaion. */
+ but we do it anyway to test the client implementation. */
err = assuan_inquire (ctx, "KEYBLOCK_INFO",
&info, &infolen, MAX_KEYBLOCK_LENGTH);
if (err)
if (tls_dbg)
gnutls_global_set_log_level (tls_dbg);
+#else
+ (void)err;
+ (void)tls_dbg;
+ (void)no_crl;
#endif /*HTTP_USE_GNUTLS*/
rc = http_parse_uri (&uri, *argv, 1);
}
}
if (err && gpg_err_code (err) != GPG_ERR_EOF)
- rc = err; /* Such an error takes precendence. */
+ rc = err; /* Such an error takes precedence. */
return rc;
}
{
if (gpg_err_code (err) == GPG_ERR_NO_DATA)
return 1; /* Yes. Without a authorityKeyIdentifier this needs
- to be the Root certifcate (our trust anchor). */
+ to be the Root certificate (our trust anchor). */
log_error ("error getting authorityKeyIdentifier: %s\n",
gpg_strerror (err));
return 0; /* Well, it is broken anyway. Return No. */
log_info ("root certificate is good and trusted\n");
}
- break; /* Okay: a self-signed certicate is an end-point. */
+ break; /* Okay: a self-signed certificate is an end-point. */
}
/* To avoid loops, we use an arbitrary limit on the length of
- g10/mdfilter.c :: Filter to calculate hashs
- g10/textfilter.c :: Filter to handle CR/LF and trailing white space
- g10/cipher.c :: En-/Decryption filter
- - g10/misc.c :: Utlity functions
+ - g10/misc.c :: Utility functions
- g10/options.h :: Structure with all the command line options
and related constants
- g10/openfile.c :: Create/Open Files
- g10/pubkey-enc.c :: Process a public key encoded packet.
- g10/seckey-cert.c :: Not anymore used
- - g10/seskey.c :: Make sesssion keys etc.
+ - g10/seskey.c :: Make session keys etc.
- g10/import.c :: Import keys into our key storage.
- g10/export.c :: Export keys to the OpenPGP format.
- g10/sign.c :: Create signature and optionally encrypt.
@c recursive process because a CRL has to be checked for each certificate
@c in the chain except for the root certificate, of which we already know
@c that it is trusted and we avoid checking a CRL here due to common
-@c setup problems and the assumption that a revoked root certifcate has
+@c setup problems and the assumption that a revoked root certificate has
@c been removed from the list of trusted certificates.
@c
@c
@opindex verbose
Outputs additional information while running.
You can increase the verbosity by giving several
-verbose commands to @command{gpgsm}, such as @samp{-vv}.
+verbose commands to @command{gpg-agent}, such as @samp{-vv}.
@item -q
@item --quiet
PRESET_PASSPHRASE [--inquire] <string_or_keygrip> <timeout> [<hexstring>]
@end example
-The passphrase is a hexidecimal string when specified. When not specified, the
+The passphrase is a hexadecimal string when specified. When not specified, the
passphrase will be retrieved from the pinentry module unless the
@option{--inquire} option was specified in which case the passphrase will be
retrieved from the client.
@itemx -K
@opindex list-secret-keys
List the specified secret keys. If no keys are specified, then all
-known secret keys are listed. A @code{#} after the letters @code{sec}
-means that the secret key is not usable (for example, if it was
-exported using @option{--export-secret-subkeys}). See also
-@option{--list-keys}.
+known secret keys are listed. A @code{#} after the intial tags
+@code{sec} or @code{ssb} means that the secret key or subkey is
+currently not usable. We also say that this key has been taken
+offline (for example, a primary key can be taken offline by exported
+the key using the command @option{--export-secret-subkeys}). A
+@code{>} after these tags indicate that the key is stored on a
+smartcard. See also @option{--list-keys}.
@item --list-signatures
@opindex list-signatures
@option{--edit-card} command.
@item --delete-keys @code{name}
-@itemx --delete-keys @code{name}
+@opindex delete-keys
Remove key from the public keyring. In batch mode either @option{--yes} is
required or the key must be specified by fingerprint. This is a
safeguard against accidental deletion of multiple keys.
You should backup all files in this directory and take care to keep
this backup closed away.
- @item @value{DATADIR}/options.skel
- @efindex options.skel
- The skeleton options file.
-
@end table
Operation is further controlled by a few environment variables:
This option overrides the command line option
@option{--include-certs}. A @var{value} of -2 includes all
certificates except for the root certificate, -1 includes all
-certicates, 0 does not include any certicates, 1 includes only the
-signers certicate and all other positive values include up to
+certificates, 0 does not include any certificates, 1 includes only the
+signers certificate and all other positive values include up to
@var{value} certificates starting with the signer cert.
@item list-mode
## Process this file with automake to produce Makefile.in
-EXTRA_DIST = options.skel dirmngr-conf.skel distsigkey.gpg \
+EXTRA_DIST = distsigkey.gpg \
ChangeLog-2011 gpg-w32info.rc \
gpg.w32-manifest.in test.c t-keydb-keyring.kbx \
- t-keydb-get-keyblock.gpg t-stutter-data.asc
+ t-keydb-get-keyblock.gpg t-stutter-data.asc \
+ all-tests.scm
AM_CPPFLAGS =
endif
noinst_PROGRAMS += $(module_tests)
TESTS = $(module_tests)
+TESTS_ENVIRONMENT = \
+ abs_top_srcdir=$(abs_top_srcdir)
if ENABLE_BZIP2_SUPPORT
bzip2_source = compress-bz2.c
install-data-local:
$(mkinstalldirs) $(DESTDIR)$(pkgdatadir)
- $(INSTALL_DATA) $(srcdir)/options.skel \
- $(DESTDIR)$(pkgdatadir)/gpg-conf.skel
- $(INSTALL_DATA) $(srcdir)/dirmngr-conf.skel \
- $(DESTDIR)$(pkgdatadir)/dirmngr-conf.skel
$(INSTALL_DATA) $(srcdir)/distsigkey.gpg \
$(DESTDIR)$(pkgdatadir)/distsigkey.gpg
# NB: For uninstalling gpg and gpgv we use -local because there is
# no need for a specific order the targets need to be run.
uninstall-local:
- -@rm $(DESTDIR)$(pkgdatadir)/gpg-conf.skel
- -@rm $(DESTDIR)$(pkgdatadir)/dirmngr-conf.skel
-@rm $(DESTDIR)$(pkgdatadir)/distsigkey.gpg
-@files=`for p in $(gpg2_hack_uninst); do echo "$$p"; done | \
sed -e 'h;s,^.*/,,;s/$(EXEEXT)$$//;$(transform)' \
--- /dev/null
+;; Copyright (C) 2017 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 <http://www.gnu.org/licenses/>.
+
+(export all-tests
+ ;; Parse the Makefile.am to find all tests.
+
+ (load (with-path "makefile.scm"))
+
+ (define (expander filename port key)
+ (parse-makefile port key))
+
+ (define (parse filename key)
+ (parse-makefile-expand filename expander key))
+
+ (map (lambda (name)
+ (test::binary #f
+ (path-join "g10" name)
+ (path-join (getenv "objdir") "g10" name)))
+ (parse-makefile-expand (in-srcdir "g10" "Makefile.am")
+ (lambda (filename port key) (parse-makefile port key))
+ "module_tests")))
break;
case STA_first_dash: /* just need for initialization */
x->pos = 0;
- x->state = STA_compare_header;
+ x->state = STA_compare_header; /* fall through */
case STA_compare_header:
if ( "-----BEGIN PGP SIGNATURE-----"[++x->pos] == c ) {
if ( x->pos == 28 )
/* assume that we are at the next line */
x->state = STA_read_crc;
x->pos = 0;
- x->mycrc = 0;
+ x->mycrc = 0; /* fall through */
case STA_read_crc:
if( (c = asctobin[c]) == 255 ) {
rval = -1; /* ready */
\f
/* Call the agent to retrieve a data object. This function returns
the data in the same structure as used by the learn command. It is
- allowed to update such a structure using this commmand. */
+ allowed to update such a structure using this command. */
int
agent_scd_getattr (const char *name, struct agent_card_info_s *info)
{
#include <config.h>
#include <string.h>
#include <stdio.h> /* Early versions of bzlib (1.0) require stdio.h */
-#include <bzlib.h>
#include "gpg.h"
#include "../common/util.h"
+#include <bzlib.h>
+
#include "packet.h"
#include "filter.h"
#include "main.h"
+++ /dev/null
-# dirmngr-conf.skel - Skeleton to create dirmngr.conf.
-# (Note that the first three lines are not copied.)
-#
-# dirmngr.conf - Options for Dirmngr
-# Written in 2015 by The GnuPG Project <https://gnupg.org>
-#
-# To the extent possible under law, the authors have dedicated all
-# copyright and related and neighboring rights to this file to the
-# public domain worldwide. This file is distributed without any
-# warranty. You should have received a copy of the CC0 Public Domain
-# Dedication along with this file. If not, see
-# <http://creativecommons.org/publicdomain/zero/1.0/>.
-#
-#
-# Unless you specify which option file to use (with the command line
-# option "--options filename"), the file ~/.gnupg/dirmngr.conf is used
-# by dirmngr. The file can contain any long options which are valid
-# for Dirmngr. If the first non white space character of a line is a
-# '#', the line is ignored. Empty lines are also ignored. See the
-# dirmngr man page or the manual for a list of options.
-#
-
-# --keyserver URI
-#
-# GPG can send and receive keys to and from a keyserver. These
-# servers can be HKP, Email, or LDAP (if GnuPG is built with LDAP
-# support).
-#
-# Example HKP keyservers:
-# hkp://keys.gnupg.net
-#
-# Example HKP keyserver using a Tor OnionBalance service
-# hkp://jirk5u4osbsr34t5.onion
-#
-# Example HKPS keyservers (see --hkp-cacert below):
-# hkps://hkps.pool.sks-keyservers.net
-#
-# Example LDAP keyservers:
-# ldap://pgp.surfnet.nl:11370
-#
-# Regular URL syntax applies, and you can set an alternate port
-# through the usual method:
-# hkp://keyserver.example.net:22742
-#
-# Note that most servers (with the notable exception of
-# ldap://keyserver.pgp.com) synchronize changes with each other. Note
-# also that a single server name may actually point to multiple
-# servers via DNS round-robin or service records.
-#
-# If exactly two keyservers are configured and only one is a Tor hidden
-# service, Dirmngr selects the keyserver to use depending on whether
-# Tor is locally running or not (on a per session base). Example:
-#
-# keyserver hkp://jirk5u4osbsr34t5.onion
-# keyserver hkps://hkps.pool.sks-keyservers.net
-#
-# If no keyserver is specified GnuPG uses
-# hkps://hkps.pool.sks-keyservers.net
-
-
-# --hkp-cacert FILENAME
-#
-# For the "hkps" scheme (keyserver access over TLS), Dirmngr needs to
-# know the root certificates for verification of the TLS certificates
-# used for the connection. Enter the full name of a file with the
-# root certificates here. If that file is in PEM format a ".pem"
-# suffix is expected. This option may be given multiple times to add
-# more root certificates. Tilde expansion is supported.
-# This is not required when the default server
-# hkps://hkps.pool.sks-keyservers.net
-# is used.
-
-#hkp-cacert /path/to/CA/sks-keyservers.netCA.pem
static gpg_error_t
cleartext_secret_key_to_openpgp (gcry_sexp_t s_key, PKT_public_key *pk)
{
- gpg_error_t err = gpg_error (GPG_ERR_NOT_IMPLEMENTED);
+ gpg_error_t err;
gcry_sexp_t top_list;
gcry_sexp_t key = NULL;
char *key_type = NULL;
KEYDB_SEARCH_DESC *desc, size_t ndesc,
size_t descindex, gcry_cipher_hd_t cipherhd)
{
- gpg_error_t err;
+ gpg_error_t err = gpg_error (GPG_ERR_NOT_FOUND);
char *cache_nonce = NULL;
subkey_list_t subkey_list = NULL; /* Track already processed subkeys. */
int skip_until_subkey = 0;
u32 curtime = make_timestamp ();
kbnode_t latest_key, node;
PKT_public_key *pk;
- const char *identifier;
+ const char *identifier = NULL;
membuf_t mb;
estream_t fp = NULL;
struct b64state b64_state;
identifier = "ecdsa-sha2-nistp384";
else if (!strcmp (curve, "nistp521"))
identifier = "ecdsa-sha2-nistp521";
- else
- identifier = NULL;
if (!identifier)
err = gpg_error (GPG_ERR_UNKNOWN_CURVE);
break;
}
- if (err)
+ if (!identifier)
goto leave;
if (opt.outfile && *opt.outfile && strcmp (opt.outfile, "-"))
es_fprintf (fp, "%s ", identifier);
err = b64enc_start_es (&b64_state, fp, "");
- if (err)
- goto leave;
- {
- void *blob;
- size_t bloblen;
+ if (!err)
+ {
+ void *blob;
+ size_t bloblen;
- blob = get_membuf (&mb, &bloblen);
- if (!blob)
- err = gpg_error_from_syserror ();
- else
- err = b64enc_write (&b64_state, blob, bloblen);
- xfree (blob);
- if (err)
- goto leave;
- }
- err = b64enc_finish (&b64_state);
+ blob = get_membuf (&mb, &bloblen);
+ if (blob)
+ {
+ err = b64enc_write (&b64_state, blob, bloblen);
+ xfree (blob);
+ if (err)
+ goto leave;
+ }
+ err = b64enc_finish (&b64_state);
+ }
if (err)
goto leave;
es_fprintf (fp, " openpgp:0x%08lX\n", (ulong)keyid_from_pk (pk, NULL));
/* Disable and drop the public key cache (which is filled by
cache_public_key and get_pubkey). Note: there is currently no way
- to reenable this cache. */
+ to re-enable this cache. */
void
getkey_disable_caches ()
{
}
}
-/* Returns all keys that match the search specfication SEARCH_TERMS.
+/* Returns all keys that match the search specification SEARCH_TERMS.
This function also checks for and warns about duplicate entries in
the keydb, which can occur if the user has configured multiple
if (! ctx->kr_handle)
{
xfree (ctx);
- *retctx = NULL;
+ if (retctx)
+ *retctx = NULL;
rc = gpg_error_from_syserror ();
}
else
#define MY_O_BINARY 0
#endif
+#ifdef __MINGW32__
+int _dowildcard = -1;
+#endif
enum cmd_and_opt_values
{
-/* Helper to set compliance related options. This is a separte
+/* Helper to set compliance related options. This is a separate
* function so that it can also be used by the --compliance option
* parser. */
static void
break;
case aCheckKeys:
- opt.check_sigs = 1;
+ opt.check_sigs = 1; /* fall through */
case aListSigs:
- opt.list_sigs = 1;
+ opt.list_sigs = 1; /* fall through */
case aListKeys:
sl = NULL;
for( ; argc; argc--, argv++ )
break;
case aFastImport:
- opt.import_options |= IMPORT_FAST;
+ opt.import_options |= IMPORT_FAST; /* fall through */
case aImport:
import_keys (ctrl, argc? argv:NULL, argc, NULL, opt.import_options);
break;
if (!opt.quiet)
log_info (_("WARNING: no command supplied."
" Trying to guess what you mean ...\n"));
- /*FALLTHU*/
+ /*FALLTHRU*/
case aListPackets:
if( argc > 1 )
wrong_args("[filename]");
if (! option)
space = 72;
- formatted = format_text (tmp, 0, space, space + 4);
+ formatted = format_text (tmp, space, space + 4);
+ if (!format_text)
+ abort ();
if (tmp != help)
xfree (tmp);
/****************
* Read the next keyblock from stream A.
* Meta data (ring trust packets) are only considered of WITH_META is set.
- * PENDING_PKT should be initialzed to NULL and not changed by the caller.
+ * PENDING_PKT should be initialized to NULL and not changed by the caller.
* Return: 0 = okay, -1 no more blocks or another errorcode.
* The int at at R_V3KEY counts the number of unsupported v3
* keyblocks.
pkt = NULL;
goto ready;
}
- in_cert = 1;
+ in_cert = 1; /* fall through */
default:
x_default:
if (in_cert && valid_keyblock_packet (pkt->pkttype))
snprintf (numbuf, sizeof numbuf, "%d", pk->pubkey_algo);
result = numbuf;
}
- if (!strcmp (propname, "key_created"))
+ else if (!strcmp (propname, "key_created"))
{
snprintf (numbuf, sizeof numbuf, "%lu", (ulong)pk->timestamp);
result = numbuf;
/* Delete all parts which are invalid and those signatures whose
- * public key algorithm is not available in this implemenation; but
+ * public key algorithm is not available in this implementation; but
* consider RSA as valid, because parse/build_packets knows about it.
*
* Returns: True if at least one valid user-id is left over.
};
-/* Helper type for preference fucntions. */
+/* Helper type for preference functions. */
union pref_hint
{
int digest_length;
/* Free a list of public keys. */
void pubkeys_free (pubkey_t keys);
-/* Returns all keys that match the search specfication SEARCH_TERMS.
+/* Returns all keys that match the search specification SEARCH_TERMS.
The returned keys should be freed using pubkeys_free. */
gpg_error_t
get_pubkeys (ctrl_t ctrl,
continue;
/* Now we can sign the user ids. */
- reloop: /* (Must use this, because we are modifing the list.) */
+ reloop: /* (Must use this, because we are modifying the list.) */
primary_pk = NULL;
for (node = keyblock; node; node = node->next)
{
&& pk->seckey_info->is_protected
&& pk->seckey_info->s2k.mode == 1002)
{
- /* FIXME: Check wether this code path is still used. */
+ /* FIXME: Check whether this code path is still used. */
tty_fprintf (fp, "%*s%s", opt.legacy_list_mode? 21:5, "",
_("card-no: "));
if (pk->seckey_info->ivlen == 16
}
/* now we can sign the user ids */
-reloop: /* (must use this, because we are modifing the list) */
+reloop: /* (must use this, because we are modifying the list) */
primary_pk = keyblock->pkt->pkt.public_key;
for (node = keyblock; node; node = node->next)
{
if (!reason)
return 0; /* User decided to cancel. */
- reloop: /* (better this way because we are modifing the keyring) */
+ reloop: /* (better this way because we are modifying the keyring) */
mainpk = pub_keyblock->pkt->pkt.public_key;
for (node = pub_keyblock; node; node = node->next)
{
case 2:
pktlen = (size_t)buf[mark++] << 24;
pktlen |= buf[mark++] << 16;
-
+ /* fall through */
case 1:
pktlen |= buf[mark++] << 8;
-
+ /* fall through */
case 0:
pktlen |= buf[mark++];
}
listctx.check_sigs = 1;
/* fixme: using the bynames function has the disadvantage that we
- * don't know wether one of the names given was not found. OTOH,
+ * don't know whether one of the names given was not found. OTOH,
* this function has the advantage to list the names in the
* sequence as defined by the keyDB and does not duplicate
* outputs. A solution could be do test whether all given have
if (!agent_get_keyinfo (NULL, hexgrip, &serialno, NULL))
secret = serialno? 3 : 1;
else
- secret = '2'; /* Key not found. */
+ secret = 2; /* Key not found. */
}
/* Print the "sub" line. */
pkt = xmalloc (sizeof *pkt);
init_packet (pkt);
init_parse_packet (&parsectx, a);
- hd->found.n_packets = 0;;
+ hd->found.n_packets = 0;
lastnode = NULL;
save_mode = set_packet_list_mode(0);
while ((rc=parse_packet (&parsectx, pkt)) != -1) {
- hd->found.n_packets++;
+ hd->found.n_packets = parsectx.n_parsed_packets;
if (gpg_err_code (rc) == GPG_ERR_UNKNOWN_PACKET) {
free_packet (pkt, &parsectx);
init_packet (pkt);
{
log_assert (hd);
- hd->current.kr = NULL;
iobuf_close (hd->current.iobuf);
hd->current.iobuf = NULL;
hd->current.eof = 0;
hd->found.kr = NULL;
hd->found.offset = 0;
+
+ if (hd->current.kr)
+ iobuf_ioctl (NULL, IOBUF_IOCTL_INVALIDATE_CACHE, 0,
+ (char*)hd->current.kr->fname);
+ hd->current.kr = NULL;
+
return 0;
}
DEK *dek, iobuf_t out);
/*-- sign.c --*/
-int complete_sig (ctrl_t ctrl, PKT_signature *sig, PKT_public_key *pksk,
- gcry_md_hd_t md, const char *cache_nonce);
int sign_file (ctrl_t ctrl, strlist_t filenames, int detached, strlist_t locusr,
int do_encrypt, strlist_t remusr, const char *outfile );
int clearsign_file (ctrl_t ctrl,
#else
case CIPHER_ALGO_CAMELLIA256: return 0;
#endif
+ default: return 0;
}
- return 0;
}
/* The inverse function of above. */
{
case GCRY_PK_ECDSA: return PUBKEY_ALGO_ECDSA;
case GCRY_PK_ECDH: return PUBKEY_ALGO_ECDH;
- default: return algo < 110 ? algo : 0;
+ default: return algo < 110 ? (pubkey_algo_t)algo : 0;
}
}
{
switch (algo)
{
- case CIPHER_ALGO_NONE: break;
case CIPHER_ALGO_IDEA: return "IDEA";
case CIPHER_ALGO_3DES: return "3DES";
case CIPHER_ALGO_CAST5: return "CAST5";
case CIPHER_ALGO_CAMELLIA128: return "CAMELLIA128";
case CIPHER_ALGO_CAMELLIA192: return "CAMELLIA192";
case CIPHER_ALGO_CAMELLIA256: return "CAMELLIA256";
+ case CIPHER_ALGO_NONE:
+ default: return "?";
}
- return "?";
}
if (RFC2440)
ga = GCRY_PK_ELG;
break;
+
+ default:
+ break;
}
if (!ga)
return gpg_error (GPG_ERR_PUBKEY_ALGO);
case PUBKEY_ALGO_ECDH: return "ECDH";
case PUBKEY_ALGO_ECDSA: return "ECDSA";
case PUBKEY_ALGO_EDDSA: return "EDDSA";
+ default: return "?";
}
- return "?";
}
#else
case DIGEST_ALGO_SHA512: return 0;
#endif
+ default: return 0;
}
- return 0;
}
case PUBKEY_ALGO_ECDSA: return 2;
case PUBKEY_ALGO_ELGAMAL: return 3;
case PUBKEY_ALGO_EDDSA: return 2;
+ default: return 0;
}
- return 0;
}
case PUBKEY_ALGO_ECDSA: return 3;
case PUBKEY_ALGO_ELGAMAL: return 4;
case PUBKEY_ALGO_EDDSA: return 3;
+ default: return 0;
}
- return 0;
}
/* Temporary helper. */
case PUBKEY_ALGO_ECDSA: return 2;
case PUBKEY_ALGO_ELGAMAL: return 2;
case PUBKEY_ALGO_EDDSA: return 2;
+ default: return 0;
}
- return 0;
}
case PUBKEY_ALGO_ECDSA: return 0;
case PUBKEY_ALGO_ELGAMAL: return 2;
case PUBKEY_ALGO_EDDSA: return 0;
+ default: return 0;
}
- return 0;
}
#include "../common/status.h"
#include "../common/i18n.h"
-#ifdef USE_ONLY_8DOT3
-#define SKELEXT ".skl"
-#else
-#define SKELEXT EXTSEP_S "skel"
-#endif
-
#ifdef HAVE_W32_SYSTEM
#define NAME_OF_DEV_NULL "nul"
#else
/* Ask for an output filename; use the given one as default. Return
NULL if no file has been given or if it is not possible to ask the
- user. NAME is the template len which might conatin enbedded Nuls.
+ user. NAME is the template len which might contain enbedded Nuls.
NAMELEN is its actual length.
*/
char *
}
-/****************
- * Copy the option file skeleton for NAME to the given directory.
- * Returns true if the new option file has any option.
- */
-static int
-copy_options_file (const char *destdir, const char *name)
-{
- const char *datadir = gnupg_datadir ();
- char *fname;
- FILE *src, *dst;
- int linefeeds=0;
- int c;
- mode_t oldmask;
- int esc = 0;
- int any_option = 0;
-
- if (opt.dry_run)
- return 0;
-
- fname = xstrconcat (datadir, DIRSEP_S, name, "-conf", SKELEXT, NULL);
- src = fopen (fname, "r");
- if (src && is_secured_file (fileno (src)))
- {
- fclose (src);
- src = NULL;
- gpg_err_set_errno (EPERM);
- }
- if (!src)
- {
- log_info (_("can't open '%s': %s\n"), fname, strerror(errno));
- xfree(fname);
- return 0;
- }
- xfree (fname);
- fname = xstrconcat (destdir, DIRSEP_S, name, EXTSEP_S, "conf", NULL);
-
- oldmask = umask (077);
- if (is_secured_filename (fname))
- {
- dst = NULL;
- gpg_err_set_errno (EPERM);
- }
- else
- dst = fopen( fname, "w" );
- umask (oldmask);
-
- if (!dst)
- {
- log_info (_("can't create '%s': %s\n"), fname, strerror(errno) );
- fclose (src);
- xfree (fname);
- return 0;
- }
-
- while ((c = getc (src)) != EOF)
- {
- if (linefeeds < 3)
- {
- if (c == '\n')
- linefeeds++;
- }
- else
- {
- putc (c, dst);
- if (c== '\n')
- esc = 1;
- else if (esc == 1)
- {
- if (c == ' ' || c == '\t')
- ;
- else if (c == '#')
- esc = 2;
- else
- any_option = 1;
- }
- }
- }
-
- fclose (dst);
- fclose (src);
-
- log_info (_("new configuration file '%s' created\n"), fname);
- xfree (fname);
- return any_option;
-}
-
-
void
try_make_homedir (const char *fname)
{
fname, strerror(errno) );
else if (!opt.quiet )
log_info ( _("directory '%s' created\n"), fname );
-
- /* Note that we also copy a dirmngr.conf file here. This is
- because gpg is likely the first invoked tool and thus creates
- the directory. */
- copy_options_file (fname, DIRMNGR_NAME);
- if (copy_options_file (fname, GPG_NAME))
- log_info (_("WARNING: options in '%s'"
- " are not yet active during this run\n"),
- fname);
}
}
+++ /dev/null
-# These first three lines are not copied to the gpg.conf file in
-# the users home directory.
-# $Id$
-# Options for GnuPG
-# Copyright 1998-2003, 2010 Free Software Foundation, Inc.
-# Copyright 1998-2003, 2010 Werner Koch
-#
-# 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.
-#
-# Unless you specify which option file to use (with the command line
-# option "--options filename"), GnuPG uses the file ~/.gnupg/gpg.conf
-# by default.
-#
-# An options file can contain any long options which are available in
-# GnuPG. If the first non white space character of a line is a '#',
-# this line is ignored. Empty lines are also ignored.
-#
-# See the gpg man page for a list of options.
-
-
-# If you have more than 1 secret key in your keyring, you may want to
-# uncomment the following option and set your preferred keyid.
-
-#default-key 621CC013
-
-
-# If you do not pass a recipient to gpg, it will ask for one. Using
-# this option you can encrypt to a default key. Key validation will
-# not be done in this case. The second form uses the default key as
-# default recipient.
-
-#default-recipient some-user-id
-#default-recipient-self
-
-
-# Group names may be defined like this:
-# group mynames = paige 0x12345678 joe patti
-#
-# Any time "mynames" is a recipient (-r or --recipient), it will be
-# expanded to the names "paige", "joe", and "patti", and the key ID
-# "0x12345678". Note there is only one level of expansion - you
-# cannot make an group that points to another group. Note also that
-# if there are spaces in the recipient name, this will appear as two
-# recipients. In these cases it is better to use the key ID.
-
-#group mynames = paige 0x12345678 joe patti
-
-
-# GnuPG can automatically locate and retrieve keys as needed using
-# this option. This happens when encrypting to an email address (in
-# the "user@@example.com" form) and there are no keys matching
-# "user@example.com" in the local keyring. This option takes any
-# number mechanisms which are tried in the given order. The default
-# is "--auto-key-locate local" to search for keys only in the local
-# key database. Uncomment the next line to locate a missing key using
-# two DNS based mechanisms.
-
-#auto-key-locate local,pka,dane
-
-
-# Common options for keyserver functions:
-# (Note that the --keyserver option has been moved to dirmngr.conf)
-#
-# include-disabled = when searching, include keys marked as "disabled"
-# on the keyserver (not all keyservers support this).
-#
-# no-include-revoked = when searching, do not include keys marked as
-# "revoked" on the keyserver.
-#
-# verbose = show more information as the keys are fetched.
-# Can be used more than once to increase the amount
-# of information shown.
-#
-# auto-key-retrieve = automatically fetch keys as needed from the keyserver
-# when verifying signatures or when importing keys that
-# have been revoked by a revocation key that is not
-# present on the keyring.
-#
-# no-include-attributes = do not include attribute IDs (aka "photo IDs")
-# when sending keys to the keyserver.
-
-#keyserver-options auto-key-retrieve
-
-
-# Uncomment this line to display photo user IDs in key listings and
-# when a signature from a key with a photo is verified.
-
-#show-photos
-
-
-# Use this program to display photo user IDs
-#
-# %i is expanded to a temporary file that contains the photo.
-# %I is the same as %i, but the file isn't deleted afterwards by GnuPG.
-# %k is expanded to the key ID of the key.
-# %K is expanded to the long OpenPGP key ID of the key.
-# %t is expanded to the extension of the image (e.g. "jpg").
-# %T is expanded to the MIME type of the image (e.g. "image/jpeg").
-# %f is expanded to the fingerprint of the key.
-# %% is %, of course.
-#
-# If %i or %I are not present, then the photo is supplied to the
-# viewer on standard input. If your platform supports it, standard
-# input is the best way to do this as it avoids the time and effort in
-# generating and then cleaning up a secure temp file.
-#
-# The default program is "xloadimage -fork -quiet -title 'KeyID 0x%k' stdin"
-# On Mac OS X and Windows, the default is to use your regular JPEG image
-# viewer.
-#
-# Some other viewers:
-# photo-viewer "qiv %i"
-# photo-viewer "ee %i"
-# photo-viewer "display -title 'KeyID 0x%k'"
-#
-# This one saves a copy of the photo ID in your home directory:
-# photo-viewer "cat > ~/photoid-for-key-%k.%t"
-#
-# Use your MIME handler to view photos:
-# photo-viewer "metamail -q -d -b -c %T -s 'KeyID 0x%k' -f GnuPG"
-
-
-# Because some mailers change lines starting with "From " to ">From "
-# it is good to handle such lines in a special way when creating
-# cleartext signatures; all other PGP versions do it this way too.
-# To enable full OpenPGP compliance you may want to use this option.
-
-#no-escape-from-lines
-
-
-# Uncomment the following option to get rid of the copyright notice
-
-#no-greeting
* implementation defined. GnuPG uses this to cache signature
* verification status and since 2.1.18 also to convey information
* about the origin of a key. Note that this packet is not part
- * struct packet_struct becuase we use it only local in the packet
+ * struct packet_struct because we use it only local in the packet
* parser and builder. */
typedef struct {
unsigned int trustval;
iobuf_t inp; /* The input stream with the packets. */
struct packet_struct last_pkt; /* The last parsed packet. */
int free_last_pkt; /* Indicates that LAST_PKT must be freed. */
- int skip_meta; /* Skip right trust packets. */
+ int skip_meta; /* Skip ring trust packets. */
+ unsigned int n_parsed_packets; /* Number of parsed packets. */
};
typedef struct parse_packet_ctx_s *parse_packet_ctx_t;
(a)->last_pkt.pkt.generic= NULL;\
(a)->free_last_pkt = 0; \
(a)->skip_meta = 0; \
+ (a)->n_parsed_packets = 0; \
} while (0)
#define deinit_parse_packet(a) do { \
partial? (new_ctb ? " partial" : " indeterminate") :"",
new_ctb? " new-ctb":"");
+ /* Count it. */
+ ctx->n_parsed_packets++;
+
pkt->pkttype = pkttype;
rc = GPG_ERR_UNKNOWN_PACKET; /* default error */
switch (pkttype)
if (namelen && pktlen)
{
rt.url = xtrymalloc (namelen + 1);
- if (rt.url)
+ if (!rt.url)
{
err = gpg_error_from_syserror ();
goto leave;
log_info (_("trustlevel adjusted to FULL"
" due to valid PKA info\n"));
}
- /* (fall through) */
+ /* fall through */
case TRUST_FULLY:
if (!okay)
{
-/* seskey.c - make sesssion keys etc.
+/* seskey.c - make session keys etc.
* Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
* 2006, 2009, 2010 Free Software Foundation, Inc.
*
/* ECDSA 521 is special has it is larger than the largest hash
- we have (SHA-512). Thus we chnage the size for further
+ we have (SHA-512). Thus we change the size for further
processing to 512. */
if (pk->pubkey_algo == PUBKEY_ALGO_ECDSA && qbits > 512)
qbits = 512;
}
-int
+static int
complete_sig (ctrl_t ctrl,
PKT_signature *sig, PKT_public_key *pksk, gcry_md_hd_t md,
const char *cache_nonce)
#include "keydb.h"
#include "../common/util.h"
#include "../common/i18n.h"
+#include "call-agent.h"
/* Return true if Libgcrypt's RNG is in faked mode. */
select the best key. If a key specification is ambiguous and we
are in batch mode, die. */
- if (!locusr) /* No user ids given - use the default key. */
+ if (!locusr) /* No user ids given - use the card key or the default key. */
{
+ struct agent_card_info_s info;
PKT_public_key *pk;
+ char *serialno;
+ memset (&info, 0, sizeof(info));
pk = xmalloc_clear (sizeof *pk);
pk->req_usage = use;
- if ((err = getkey_byname (ctrl, NULL, pk, NULL, 1, NULL)))
+
+ /* Check if a card is available. If any, use it. */
+ err = agent_scd_serialno (&serialno, NULL);
+ if (!err)
+ {
+ xfree (serialno);
+ err = agent_scd_getattr ("KEY-FPR", &info);
+ if (err)
+ log_error ("error retrieving key fingerprint from card: %s\n",
+ gpg_strerror (err));
+ else if (info.fpr1valid)
+ {
+ if ((err = get_pubkey_byfprint (ctrl, pk, NULL, info.fpr1, 20)))
+ {
+ info.fpr1valid = 0;
+ log_error ("error on card key to sign: %s, try default\n",
+ gpg_strerror (err));
+ }
+ }
+ }
+
+ if (!info.fpr1valid
+ && (err = getkey_byname (ctrl, NULL, pk, NULL, 1, NULL)))
{
free_public_key (pk);
pk = NULL;
#include "dek.h"
#include "../common/logging.h"
+#include "test.c"
+
static void
log_hexdump (byte *buffer, int length)
{
return oracle (debug, probe, blocksize + 2, NULL, NULL) == 0;
}
-int
-main (int argc, char *argv[])
+static void
+do_test (int argc, char *argv[])
{
int i;
int debug = 0;
byte *raw_data;
int raw_data_len;
- int failed = 0;
-
+ (void)current_test_group_failed;
for (i = 1; i < argc; i ++)
{
if (strcmp (argv[i], "--debug") == 0)
}
}
- if (! blocksize && ! filename && (filename = getenv ("srcdir")))
+ if (! blocksize && ! filename && (filename = prepend_srcdir ("t-stutter-data.asc")))
/* Try defaults. */
{
parse_session_key ("9:9274A8EC128E850C6DDDF9EAC68BFA84FC7BC05F340DA41D78C93D0640C7C503");
- filename = xasprintf ("%s/t-stutter-data.asc", filename);
}
if (help || ! blocksize || ! filename)
isprint (pt[0]) ? pt[0] : '?',
isprint (pt[1]) ? pt[1] : '?',
hexstr (m));
- failed = 1;
+ tests_failed++;
}
}
}
xfree (filename);
- return failed;
}
if (rc)
return rc;
- /* Now we can chnage it to a free record. */
+ /* Now we can change it to a free record. */
rc = tdbio_read_record (0, &vr, RECTYPE_VER);
if (rc)
log_fatal (_("%s: error reading version record: %s\n"),
static const char *srcdir;
char *result;
- if (!srcdir && !(srcdir = getenv ("srcdir")))
+ if (!srcdir && !(srcdir = getenv ("abs_top_srcdir")))
srcdir = ".";
- result = malloc (strlen (srcdir) + 1 + strlen (fname) + 1);
+ result = malloc (strlen (srcdir) + strlen ("/g10/") + strlen (fname) + 1);
strcpy (result, srcdir);
- strcat (result, "/");
+ strcat (result, "/g10/");
strcat (result, fname);
return result;
}
}
/* Format the first part of a conflict message and return that as a
- * malloced string. */
+ * malloced string. Returns NULL on error. */
static char *
format_conflict_msg_part1 (int policy, strlist_t conflict_set,
const char *email)
es_fputc (0, fp);
if (es_fclose_snatch (fp, (void **)&tmpstr, NULL))
log_fatal ("error snatching memory stream\n");
- text = format_text (tmpstr, 0, 72, 80);
+ text = format_text (tmpstr, 72, 80);
es_free (tmpstr);
return text;
struct signature_stats *stats = NULL;
struct signature_stats *stats_iter = NULL;
char *prompt = NULL;
- char *choices;
+ const char *choices;
dbs = ctrl->tofu.dbs;
log_assert (dbs);
{
char *text = format_conflict_msg_part1 (*policy, conflict_set, email);
+ if (!text) /* FIXME: Return the error all the way up. */
+ log_fatal ("format failed: %s\n",
+ gpg_strerror (gpg_error_from_syserror()));
+
es_fputs (text, fp);
es_fputc ('\n', fp);
xfree (text);
if ((binding->flags & BINDING_REVOKED))
{
es_fprintf (fp, _("revoked"));
- es_fprintf (fp, _(", "));
+ es_fprintf (fp, ", ");
}
else if ((binding->flags & BINDING_EXPIRED))
{
es_fprintf (fp, _("expired"));
- es_fprintf (fp, _(", "));
+ es_fprintf (fp, ", ");
}
if (this_key)
/* TRANSLATORS: Please translate the text found in the source
* file below. We don't directly internationalize that text so
* that we can tweak it without breaking translations. */
- char *text = _("TOFU detected a binding conflict");
+ const char *text = _("TOFU detected a binding conflict");
char *textbuf;
if (!strcmp (text, "TOFU detected a binding conflict"))
{
"attack! Before accepting this association, you should talk to or "
"call the person to make sure this new key is legitimate.";
}
- textbuf = format_text (text, 0, 72, 80);
- es_fprintf (fp, "\n%s\n", textbuf);
+ textbuf = format_text (text, 72, 80);
+ es_fprintf (fp, "\n%s\n", textbuf? textbuf : "[OUT OF CORE!]");
xfree (textbuf);
}
/* I think showing the large message once is sufficient. If we
* would move it right before the cpr_get many lines will scroll
* away and the user might not realize that he merely entered a
- * wrong choise (because he does not see that either). As a small
+ * wrong choice (because he does not see that either). As a small
* benefit we allow C-L to redisplay everything. */
tty_printf ("%s", prompt);
if (!die)
{
/*err = gpg_error_from_syserror ();*/
- xoutofcore (); /* Fixme: Let the fucntion return an error. */
+ xoutofcore (); /* Fixme: Let the function return an error. */
}
for (i = 0; i < conflict_set_count; i ++)
es_fputc (0, fp);
if (es_fclose_snatch (fp, (void **) &tmpmsg, NULL))
log_fatal ("error snatching memory stream\n");
- msg = format_text (tmpmsg, 0, 72, 80);
+ msg = format_text (tmpmsg, 72, 80);
+ if (!msg) /* FIXME: Return the error all the way up. */
+ log_fatal ("format failed: %s\n",
+ gpg_strerror (gpg_error_from_syserror()));
es_free (tmpmsg);
/* Print a status line but suppress the trailing LF.
strlist_length (user_id_list)),
set_policy_command);
- text = format_text (tmpmsg, 0, 72, 80);
+ text = format_text (tmpmsg, 72, 80);
+ if (!text) /* FIXME: Return the error all the way up. */
+ log_fatal ("format failed: %s\n",
+ gpg_strerror (gpg_error_from_syserror()));
xfree (tmpmsg);
log_string (GPGRT_LOG_INFO, text);
xfree (text);
gpg_error_t
tofu_set_policy (ctrl_t ctrl, kbnode_t kb, enum tofu_policy policy)
{
- gpg_error_t err;
+ gpg_error_t err = 0;
time_t now = gnupg_get_time ();
tofu_dbs_t dbs;
PKT_public_key *pk;
/* There are basically two commonly-used regexps here. GPG and most
versions of PGP use "<[^>]+[@.]example\.com>$" and PGP (9)
- command line uses "example.com" (i.e. whatever the user specfies,
+ command line uses "example.com" (i.e. whatever the user specifies,
and we can't expect users know to use "\." instead of "."). So
here are the rules: we're allowed to start with "<[^>]+[@.]" and
end with ">$" or start and end with nothing. In between, the
/* Decide whether we should handle a detached or a normal signature,
* which is needed so that the code later can hash the correct data and
* not have a normal signature act as detached signature and ignoring the
- * indended signed material from the 2nd file or stdin.
+ * intended signed material from the 2nd file or stdin.
* 1. gpg <file - normal
* 2. gpg file - normal (or detached)
* 3. gpg file <file2 - detached
## Process this file with automake to produce Makefile.in
-EXTRA_DIST = ChangeLog-2011
+EXTRA_DIST = ChangeLog-2011 all-tests.scm
bin_PROGRAMS = g13
sbin_PROGRAMS = g13-syshelp
--- /dev/null
+;; Copyright (C) 2017 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 <http://www.gnu.org/licenses/>.
+
+(export all-tests
+ ;; Parse the Makefile.am to find all tests.
+
+ (load (with-path "makefile.scm"))
+
+ (define (expander filename port key)
+ (parse-makefile port key))
+
+ (define (parse filename key)
+ (parse-makefile-expand filename expander key))
+
+ (map (lambda (name)
+ (test::binary #f
+ (path-join "g13" name)
+ (path-join (getenv "objdir") "g13" name)))
+ (parse-makefile-expand (in-srcdir "g13" "Makefile.am")
+ (lambda (filename port key) (parse-makefile port key))
+ "module_tests")))
*r_lock = NULL;
/* A DM-crypt container requires special treatment by using the
- syshelper fucntions. */
+ syshelper functions. */
if (ctrl->conttype == CONTTYPE_DM_CRYPT)
{
/* */
-/* Create a new container under the name FILENAME and intialize it
+/* Create a new container under the name FILENAME and initialize it
using the current settings. If the file already exists an error is
returned. */
gpg_error_t
const char *agent_program;
/* Filename of the GPG program. Unless set via an program option it
- is initialzed at the first engine startup to the standard gpg
+ is initialized at the first engine startup to the standard gpg
filename. */
const char *gpg_program;
#include <errno.h>
#include <assert.h>
#include <sys/types.h>
+#ifdef HAVE_SYS_MKDEV_H
+#include <sys/mkdev.h>
+#endif
+#ifdef HAVE_SYS_SYSMACROS_H
+# include <sys/sysmacros.h>
+#endif
#ifdef HAVE_STAT
# include <sys/stat.h>
#endif
1 = The only defined value
- u16 Blob flags
bit 0 = contains secret key material (not used)
- bit 1 = ephemeral blob (e.g. used while quering external resources)
+ bit 1 = ephemeral blob (e.g. used while querying external resources)
- u32 Offset to the OpenPGP keyblock or the X.509 DER encoded
certificate
- u32 The length of the keyblock or certificate
\f
-/* A simple implemention of a dynamic buffer. Use init_membuf() to
+/* A simple implementation of a dynamic buffer. Use init_membuf() to
create a buffer, put_membuf to append bytes and get_membuf to
release and return the buffer. Allocation errors are detected but
only returned at the final get_membuf(), this helps not to clutter
#include <sys/types.h> /* off_t */
-/* We include the type defintions from jnlib instead of defining our
+/* We include the type definitions from jnlib instead of defining our
owns here. This will not allow us build KBX in a standalone way
but there is currently no need for it anyway. Same goes for
stringhelp.h which for example provides a replacement for stpcpy -
}
else
{
- /* Its a pitty that we need to prefix the buffer with the tag
+ /* Its a pity that we need to prefix the buffer with the tag
and a length header: We can't simply pass it to the fast
hashing function for that reason. It might be a good idea to
have a scatter-gather enabled hash function. What we do here
fi
])
dnl Search the library and its dependencies in $additional_libdir and
- dnl $LDFLAGS. Using breadth-first-seach.
+ dnl $LDFLAGS. Using breadth-first-search.
LIB[]NAME=
LTLIB[]NAME=
INC[]NAME=
test -n "$as_me" && echo "$as_me: setting ALL_LINGUAS in configure.in is obsolete" || echo "setting ALL_LINGUAS in configure.in is obsolete"
fi
ALL_LINGUAS_=`sed -e "/^#/d" -e "s/#.*//" "$ac_given_srcdir/$ac_dir/LINGUAS"`
- # Hide the ALL_LINGUAS assigment from automake < 1.5.
+ # Hide the ALL_LINGUAS assignment from automake < 1.5.
eval 'ALL_LINGUAS''=$ALL_LINGUAS_'
POMAKEFILEDEPS="$POMAKEFILEDEPS LINGUAS"
else
# The set of available languages was given in configure.in.
- # Hide the ALL_LINGUAS assigment from automake < 1.5.
+ # Hide the ALL_LINGUAS assignment from automake < 1.5.
eval 'ALL_LINGUAS''=$OBSOLETE_ALL_LINGUAS'
fi
# Compute POFILES
sed_x_LINGUAS=`$gt_echo "$sed_x_variable" | sed -e '/^ *#/d' -e 's/VARIABLE/LINGUAS/g'`
ALL_LINGUAS_=`sed -n -e "$sed_x_LINGUAS" < "$ac_file"`
fi
- # Hide the ALL_LINGUAS assigment from automake < 1.5.
+ # Hide the ALL_LINGUAS assignment from automake < 1.5.
eval 'ALL_LINGUAS''=$ALL_LINGUAS_'
# Compute POFILES
# as $(foreach lang, $(ALL_LINGUAS), $(srcdir)/$(lang).po)
msgid "assuming signed data in '%s'\n"
msgstr "s'asumeix que hi ha dades signades en «%s»\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "s'ha creat el nou fitxer d'opcions «%s»\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr ""
-"AVÍS: les opcions en «%s» encara no estan actives durant aquesta execució\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "no es pot treballar amb l'algoritme de clau pública %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "s'ha creat el nou fitxer d'opcions «%s»\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "AVÍS: les opcions en «%s» encara no estan actives durant aquesta "
+#~ "execució\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "La generació de claus ha fallat: %s\n"
msgstr "v „%s“ se předpokládají podepsaná data\n"
#, c-format
-msgid "new configuration file '%s' created\n"
-msgstr "vytvořen nový konfigurační soubor „%s“\n"
-
-#, c-format
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "VAROVÁNÍ: nastavení z „%s“ nejsou při tomto spuštění zatím aktivní\n"
-
-#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "nemohu pracovat s algoritmem veřejného klíče %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
"Syntaxe: gpg-check-pattern [volby] soubor_se_vzorem\n"
"Prověří heslo zadané na vstupu proti souboru se vzory\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "vytvořen nový konfigurační soubor „%s“\n"
+
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "VAROVÁNÍ: nastavení z „%s“ nejsou při tomto spuštění zatím aktivní\n"
+
#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "antager underskrevne data i »%s«\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "ny konfigurationsfil »%s« oprettet\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr ""
-"ADVARSEL: indstillinger i »%s« er endnu ikke aktive under denne kørsel\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "kan ikke håndtere offentlig nøglealgoritme %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
"Kontroller en adgangsfrase angivet på stdin mod mønsterfilen\n"
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "ny konfigurationsfil »%s« oprettet\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "ADVARSEL: indstillinger i »%s« er endnu ikke aktive under denne kørsel\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Nøgleoprettelse mislykkedes: %s\n"
msgstr ""
"Project-Id-Version: gnupg-2.1.0\n"
"Report-Msgid-Bugs-To: translations@gnupg.org\n"
-"PO-Revision-Date: 2017-04-03 17:10+0200\n"
+"PO-Revision-Date: 2017-05-15 16:00+0200\n"
"Last-Translator: Werner Koch <wk@gnupg.org>\n"
"Language-Team: German <de@li.org>\n"
"Language: de\n"
msgstr "die unterzeichneten Daten sind wohl in '%s'\n"
#, c-format
-msgid "new configuration file '%s' created\n"
-msgstr "Neue Konfigurationsdatei `%s' erstellt\n"
-
-#, c-format
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr ""
-"WARNUNG: Optionen in `%s' sind während dieses Laufes noch nicht wirksam\n"
-
-#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "dieses Public-Key Verfahren %d kann nicht benutzt werden\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr "Statistik für Schlüssel mit der Email-Adresse \"%s\":\n"
-msgid ", "
-msgstr ""
-
msgid "this key"
msgstr "dieser Schlüssel"
msgid "error changing TOFU policy: %s\n"
msgstr "Fehler beim Ändern der TOFU Richtlinie: %s\n"
-#, fuzzy, c-format
-#| msgid "%d~year"
-#| msgid_plural "%d~years"
+#, c-format
msgid "%lld~year"
msgid_plural "%lld~years"
-msgstr[0] "%d~Jahr"
-msgstr[1] "%d~Jahre"
+msgstr[0] "%lld~Jahr"
+msgstr[1] "%lld~Jahre"
-#, fuzzy, c-format
-#| msgid "%d~month"
-#| msgid_plural "%d~months"
+#, c-format
msgid "%lld~month"
msgid_plural "%lld~months"
-msgstr[0] "%d~Monat"
-msgstr[1] "%d~Monate"
+msgstr[0] "%lld~Monat"
+msgstr[1] "%lld~Monate"
#, c-format
msgid "%lld~week"
msgid_plural "%lld~weeks"
-msgstr[0] ""
-msgstr[1] ""
+msgstr[0] "%lld~Woche"
+msgstr[1] "%lld Wochen"
-#, fuzzy, c-format
-#| msgid "%d~day"
-#| msgid_plural "%d~days"
+#, c-format
msgid "%lld~day"
msgid_plural "%lld~days"
-msgstr[0] "%d~Tag"
-msgstr[1] "%d~Tage"
+msgstr[0] "%lld~Tag"
+msgstr[1] "%lld~Tage"
-#, fuzzy, c-format
-#| msgid "%d~hour"
-#| msgid_plural "%d~hours"
+#, c-format
msgid "%lld~hour"
msgid_plural "%lld~hours"
-msgstr[0] "%d~Stunde"
-msgstr[1] "%d~Stunden"
+msgstr[0] "%lld~Stunde"
+msgstr[1] "%lld~Stunden"
-#, fuzzy, c-format
-#| msgid "%d~minute"
-#| msgid_plural "%d~minutes"
+#, c-format
msgid "%lld~minute"
msgid_plural "%lld~minutes"
-msgstr[0] "%d~Minute"
-msgstr[1] "%d~Minuten"
+msgstr[0] "%lld~Minute"
+msgstr[1] "%lld~Minuten"
-#, fuzzy, c-format
-#| msgid "%d~second"
-#| msgid_plural "%d~seconds"
+#, c-format
msgid "%lld~second"
msgid_plural "%lld~seconds"
-msgstr[0] "%d~Sekunde"
-msgstr[1] "%d~Sekunden"
+msgstr[0] "%lld~Sekunde"
+msgstr[1] "%lld~Sekunden"
#, fuzzy, c-format
#| msgid "TOFU: few signatures %d message %s"
"Syntax: gpg-check-pattern [optionen] Musterdatei\n"
"Die von stdin gelesene Passphrase gegen die Musterdatei prüfen\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "Neue Konfigurationsdatei `%s' erstellt\n"
+
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "WARNUNG: Optionen in `%s' sind während dieses Laufes noch nicht wirksam\n"
+
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Widerufen der User-ID fehlgeschlagen: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "υπόθεση υπογεγραμμένων δεδομένων στο `%s'\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "δημιουργήθηκε νέο αρχείο επιλογών `%s'\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr ""
-"ΠΡΟΕΙΔΟΠΟΙΗΣΗ: οι επιλογες στο `%s' δεν είναι ενεργές σε αυτή την εκτέλεση\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "αδυναμία χειρισμού του αλγόριθμου δημοσίου κλειδιού %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "δημιουργήθηκε νέο αρχείο επιλογών `%s'\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "ΠΡΟΕΙΔΟΠΟΙΗΣΗ: οι επιλογες στο `%s' δεν είναι ενεργές σε αυτή την "
+#~ "εκτέλεση\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Η δημιουργία κλειδιού απέτυχε: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "supozas subskribitajn datenojn en '%s'\n"
-#, fuzzy, c-format
-msgid "new configuration file '%s' created\n"
-msgstr "%s: nova opcio-dosiero kreita\n"
-
-#, c-format
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr ""
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "ne povas trakti publikŝlosilan metodon %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "%s: nova opcio-dosiero kreita\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Kreado de ŝlosiloj malsukcesis: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "asumiendo que hay datos firmados en `%s'\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "creado un nuevo fichero de configuración `%s'\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "AVISO: las opciones en `%s' no están aún activas en esta ejecución\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "no puedo manejar el algoritmo de clave pública %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
"patrones\n"
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "creado un nuevo fichero de configuración `%s'\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "AVISO: las opciones en `%s' no están aún activas en esta ejecución\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Creación de la clave fallida: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "eeldan allkirjastatud andmeid failis `%s'\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "uus omaduste fail `%s' on loodud\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "HOIATUS: seaded failis `%s' pole seekord veel aktiivsed\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "ei oska käsitleda avaliku võtme algoritmi %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "uus omaduste fail `%s' on loodud\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr "HOIATUS: seaded failis `%s' pole seekord veel aktiivsed\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Võtme genereerimine ebaõnnestus: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "data kohteessa \"%s\" oletetaan allekirjoitetuksi\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "uusi asetustiedosto \"%s\" luotu\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr ""
-"VAROITUS: asetukset tiedostossa \"%s\" eivät ole käytössä vielä tässä "
-"ajossa\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "julkisen avaimen algorimin %d käsittely ei onnistu\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "uusi asetustiedosto \"%s\" luotu\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "VAROITUS: asetukset tiedostossa \"%s\" eivät ole käytössä vielä tässä "
+#~ "ajossa\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Avaimen luonti epäonnistui: %s\n"
msgstr "les données signées sont supposées être dans « %s »\n"
#, c-format
-msgid "new configuration file '%s' created\n"
-msgstr "nouveau fichier de configuration « %s » créé\n"
-
-#, c-format
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr ""
-"Attention : les options de « %s » ne sont pas encore actives cette fois\n"
-
-#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "impossible de gérer l'algorithme à clef publique %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
"Vérifier une phrase secrète donnée sur l'entrée standard par rapport à "
"ficmotif\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "nouveau fichier de configuration « %s » créé\n"
+
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "Attention : les options de « %s » ne sont pas encore actives cette fois\n"
+
#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "suponse que hai datos asinados en `%s'\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr " creouse un novo ficheiro de configuración `%s'\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "AVISO: as opcións de `%s' aínda non están activas nesta execución\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "non é posible manexa-lo algoritmo de chave pública %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr " creouse un novo ficheiro de configuración `%s'\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr "AVISO: as opcións de `%s' aínda non están activas nesta execución\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "A xeración da chave fallou: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "Azt feltételezem, hogy az aláírt adat a %s állományban van.\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "\"%s\" új konfigurációs állományt létrehoztam.\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr ""
-"FIGYELEM: \"%s\" opciói csak a következő futáskor lesznek érvényesek!\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "Nem tudom kezelni a(z) %d. számú nyilvános kulcsú algoritmust!\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "\"%s\" új konfigurációs állományt létrehoztam.\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "FIGYELEM: \"%s\" opciói csak a következő futáskor lesznek érvényesek!\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Kulcsgenerálás sikertelen: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "mengasumsikan data bertanda dalam `%s'\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "file konfigurasi baru `%s' tercipta\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "PERINGATAN: opsi dalam `%s' belum aktif selama pelaksanaan ini\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "tidak dapat menangani algoritma kunci publik %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "file konfigurasi baru `%s' tercipta\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr "PERINGATAN: opsi dalam `%s' belum aktif selama pelaksanaan ini\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Pembuatan kunci gagal: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "suppongo che i dati firmati siano in `%s'\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "creato un nuovo file di configurazione `%s'\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr ""
-"ATTENZIONE: le opzioni in `%s' non sono ancora attive durante questa\n"
-"esecuzione del programma\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "impossibile gestire l'algoritmo a chiave pubblica %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "creato un nuovo file di configurazione `%s'\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "ATTENZIONE: le opzioni in `%s' non sono ancora attive durante questa\n"
+#~ "esecuzione del programma\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Generazione della chiave fallita: %s\n"
#
msgid ""
msgstr ""
-"Project-Id-Version: gnupg 2.1.16\n"
+"Project-Id-Version: gnupg 2.1.20\n"
"Report-Msgid-Bugs-To: translations@gnupg.org\n"
-"PO-Revision-Date: 2016-12-17 16:29+0900\n"
+"PO-Revision-Date: 2017-04-04 10:45+0900\n"
"Last-Translator: NIIBE Yutaka <gniibe@fsij.org>\n"
"Language-Team: none\n"
"Language: ja\n"
msgstr "署名の検証時に失効したユーザID、期限切れとなったユーザIDを表示する"
msgid "show only the primary user ID in signature verification"
-msgstr "署名の検証時に主なユーザIDだけをを表示する"
+msgstr "署名の検証時にプライマリ・ユーザIDだけをを表示する"
msgid "validate signatures with PKA data"
msgstr "PKAデータで署名を検証する"
msgid "Key not changed so no update needed.\n"
msgstr "鍵は無変更なので更新は不要です。\n"
-#, fuzzy
-#| msgid "You can't delete the last user ID!\n"
msgid "cannot revoke the last valid user ID.\n"
-msgstr "最後のユーザIDは削除できません!\n"
+msgstr "最後の有効なユーザIDは失効できません。\n"
-#, fuzzy, c-format
-#| msgid "checking the trust list failed: %s\n"
+#, c-format
msgid "revoking the user ID failed: %s\n"
-msgstr "信用リストの検査に失敗しました: %s\n"
+msgstr "ユーザIDの失効に失敗しました: %s\n"
-#, fuzzy, c-format
-#| msgid "checking the trust list failed: %s\n"
+#, c-format
msgid "setting the primary user ID failed: %s\n"
-msgstr "信用リストの検査に失敗しました: %s\n"
+msgstr "プライマリ・ユーザIDの設定に失敗しました: %s\n"
#, c-format
msgid "\"%s\" is not a fingerprint\n"
msgid "WARNING: a user ID signature is dated %d seconds in the future\n"
msgstr "*警告*: ユーザID署名が、%d秒未来です\n"
-#, fuzzy
-#| msgid "You can't delete the last user ID!\n"
msgid "Cannot revoke the last valid user ID.\n"
-msgstr "最後のユーザIDは削除できません!\n"
+msgstr "最後の有効なユーザIDは失効できません。\n"
#, c-format
msgid "Key %s is already revoked.\n"
msgstr "署名されたデータが'%s'にあると想定します\n"
#, c-format
-msgid "new configuration file '%s' created\n"
-msgstr "新しいコンフィグレーション・ファイル'%s'ができました\n"
-
-#, c-format
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "*警告*: '%s'のオプションはこの実行では、まだ有効になりません\n"
-
-#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "公開鍵のアルゴリズム%dは、取り扱えません\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr "この電子メールアドレス\"%s\"の鍵の統計:\n"
-msgid ", "
-msgstr ", "
-
msgid "this key"
msgstr "この鍵"
"形式: gpg-check-pattern [オプション] パターンファイル\n"
"パターンファイルに対して標準入力のパスフレーズを確認する\n"
+#~ msgid ", "
+#~ msgstr ", "
+
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "新しいコンフィグレーション・ファイル'%s'ができました\n"
+
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr "*警告*: '%s'のオプションはこの実行では、まだ有効になりません\n"
+
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "ユーザIDの失効に失敗しました: %s\n"
msgstr "antar signert data i «%s»\n"
#, c-format
-msgid "new configuration file '%s' created\n"
-msgstr "ny oppsettsfil «%s» opprettet\n"
-
-#, c-format
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "ADVARSEL: valgene i «%s» trer ikke i kraft for gjeldende programøkt\n"
-
-#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "klarte ikke å håndtere offentlig nøkkelalgoritme %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr "Statistikk for nøkler med e-postadresse «%s»:\n"
-msgid ", "
-msgstr ""
-
msgid "this key"
msgstr "denne nøkkelen"
"Syntaks: gpg-check-pattern [valg] mønsterfil\n"
"Kontroller passordfrase oppgitt på standard innkanal mot valgt mønsterfil\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "ny oppsettsfil «%s» opprettet\n"
+
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "ADVARSEL: valgene i «%s» trer ikke i kraft for gjeldende programøkt\n"
+
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "oppheving av bruker-ID mislyktes: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "przyjęto obecność podpisanych danych w '%s'\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "nowy plik ustawień ,,%s'' został utworzony\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "OSTRZEŻENIE: opcje w ,,%s'' nie są jeszcze uwzględnione.\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "nie można obsłużyć tego algorytmu klucza publicznego: %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
"Sprawdzanie hasła ze standardowego wejścia względem pliku wzorców\n"
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "nowy plik ustawień ,,%s'' został utworzony\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr "OSTRZEŻENIE: opcje w ,,%s'' nie są jeszcze uwzględnione.\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Generacja klucza nie powiodła się: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "a assumir dados assinados em `%s'\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "criado um novo ficheiro de configuração `%s'\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "AVISO: opções em `%s' ainda não estão activas nesta execução\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "impossível manipular algoritmo de chave pública %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "criado um novo ficheiro de configuração `%s'\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr "AVISO: opções em `%s' ainda não estão activas nesta execução\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "A geração de chaves falhou: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "presupun date semnate în `%s'\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "fişier de configurare nou `%s' creat\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr ""
-"AVERTISMENT: opţiunile din %s nu sunt încă active în timpul acestei rulări\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "nu pot mânui algoritmul cu cheie publică %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "fişier de configurare nou `%s' creat\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "AVERTISMENT: opţiunile din %s nu sunt încă active în timpul acestei "
+#~ "rulări\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Generarea cheii a eşuat: %s\n"
msgstr "предполагается, что подписанные данные находятся в '%s'\n"
#, c-format
-msgid "new configuration file '%s' created\n"
-msgstr "создан новый файл настроек '%s'\n"
-
-#, c-format
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "Внимание: параметры в '%s' при этом запуске еще не действуют\n"
-
-#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "не могу использовать алгоритм с открытым ключом %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr "Статистика ключей с адресом электронной почты \"%s\":\n"
-msgid ", "
-msgstr ", "
-
msgid "this key"
msgstr "этот ключ"
"Синтаксис: gpg-check-pattern [параметры] файл_образцов\n"
"Проверить фразу-пароль, поступающую из stdin, по файлу образцов\n"
+#~ msgid ", "
+#~ msgstr ", "
+
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "создан новый файл настроек '%s'\n"
+
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr "Внимание: параметры в '%s' при этом запуске еще не действуют\n"
+
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Сбой при отзыве идентификатора: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "predpokladám podpísané dáta v `%s'\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "vytvorený nový konfiguračný súbor `%s'\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "VAROVANIE: nastavenie v `%s' ešte nie je aktívne\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "nemôžem pracovať s algoritmom verejného kľúča %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "vytvorený nový konfiguračný súbor `%s'\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr "VAROVANIE: nastavenie v `%s' ešte nie je aktívne\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Vytvorenie kľúča sa nepodarilo: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "antar att signerad data finns i filen \"%s\"\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "ny konfigurationsfil \"%s\" skapad\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr ""
-"VARNING: inställningar i \"%s\" är ännu inte aktiva under denna körning\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "kan inte hantera algoritmen %d för publika nycklar\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
"Kontrollera en lösenfras angiven på standard in mot mönsterfilen\n"
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "ny konfigurationsfil \"%s\" skapad\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "VARNING: inställningar i \"%s\" är ännu inte aktiva under denna körning\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Nyckelgenereringen misslyckades: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "\"%s\" içindeki veri imzalı kabul ediliyor\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "yeni yapılandırma dosyası `%s' oluşturuldu\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr ""
-"UYARI: `%s' deki seçenekler bu çalıştırma sırasında henüz etkin değil\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "%d genel anahtar algoritması kullanılamadı\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
"karşılaştırır\n"
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "yeni yapılandırma dosyası `%s' oluşturuldu\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr ""
+#~ "UYARI: `%s' deki seçenekler bu çalıştırma sırasında henüz etkin değil\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Anahtar üretimi başarısızlığa uğradı: %s\n"
msgstr "припускаємо підписані дані у «%s»\n"
#, c-format
-msgid "new configuration file '%s' created\n"
-msgstr "створено новий файл налаштувань «%s»\n"
-
-#, c-format
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "УВАГА: параметри у «%s» ще не є активними під час цього запуску\n"
-
-#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "робота з алгоритмом створення відкритого ключа %d неможлива\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr "Статистичні дані для ключів із адресою електронної пошти «%s»:\n"
-msgid ", "
-msgstr ", "
-
msgid "this key"
msgstr "цей ключ"
"Синтаксис: gpg-check-pattern [параметри] файл_шаблонів\n"
"Перевірити пароль, вказаний у stdin, за допомогою файла_шаблонів\n"
+#~ msgid ", "
+#~ msgstr ", "
+
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "створено новий файл налаштувань «%s»\n"
+
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr "УВАГА: параметри у «%s» ще не є активними під час цього запуску\n"
+
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "Спроба відкликання ідентифікатор користувача зазнала невдачі: %s\n"
msgid "assuming signed data in '%s'\n"
msgstr "假定被签名的数据是‘%s’\n"
-#, fuzzy, c-format
-#| msgid "new configuration file `%s' created\n"
-msgid "new configuration file '%s' created\n"
-msgstr "新的配置文件‘%s’已建立\n"
-
-#, fuzzy, c-format
-#| msgid "WARNING: options in `%s' are not yet active during this run\n"
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "警告：在‘%s’里的选项于此次运行期间未被使用\n"
-
#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "无法操作公钥算法 %d\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
msgstr ""
#, fuzzy
+#~| msgid "new configuration file `%s' created\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "新的配置文件‘%s’已建立\n"
+
+#, fuzzy
+#~| msgid "WARNING: options in `%s' are not yet active during this run\n"
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr "警告：在‘%s’里的选项于此次运行期间未被使用\n"
+
+#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
#~ msgstr "生成密钥失败：%s\n"
msgstr "假設被簽署的資料在 '%s'\n"
#, c-format
-msgid "new configuration file '%s' created\n"
-msgstr "新的組態檔案 '%s' 已建立\n"
-
-#, c-format
-msgid "WARNING: options in '%s' are not yet active during this run\n"
-msgstr "警告: 在 '%s' 裡的選項於這次執行期間並沒有被啟用\n"
-
-#, c-format
msgid "can't handle public key algorithm %d\n"
msgstr "無法操作 %d 公開金鑰演算法\n"
msgid "Statistics for keys with the email address \"%s\":\n"
msgstr ""
-msgid ", "
-msgstr ""
-
#, fuzzy
#| msgid "list keys"
msgid "this key"
"語法: gpg-check-pattern [選項] 樣式檔案\n"
"用樣式檔案來檢查由標準輸入給定的密語\n"
+#~ msgid "new configuration file '%s' created\n"
+#~ msgstr "新的組態檔案 '%s' 已建立\n"
+
+#~ msgid "WARNING: options in '%s' are not yet active during this run\n"
+#~ msgstr "警告: 在 '%s' 裡的選項於這次執行期間並沒有被啟用\n"
+
#, fuzzy
#~| msgid "Key generation failed: %s\n"
#~ msgid "User ID revocation failed: %s\n"
int used; /* True if slot is used. */
unsigned short port; /* Port number: 0 = unused, 1 - dev/tty */
- /* Function pointers intialized to the various backends. */
+ /* Function pointers initialized to the various backends. */
int (*connect_card)(int);
int (*disconnect_card)(int);
int (*close_reader)(int);
#define PCSC_E_SERVICE_STOPPED 0x8010001E
#define PCSC_W_REMOVED_CARD 0x80100069
-/* Fix pcsc-lite ABI incompatibilty. */
+/* Fix pcsc-lite ABI incompatibility. */
#ifndef SCARD_CTL_CODE
#ifdef _WIN32
#include <winioctl.h>
err = ccid_open_reader (dl->portstr, dl->idx, dl->ccid_table,
&slotp->ccid.handle, &slotp->rdrname);
+ if (!err)
+ err = ccid_get_atr (slotp->ccid.handle,
+ slotp->atr, sizeof slotp->atr, &slotp->atrlen);
if (err)
{
slotp->used = 0;
return -1;
}
- err = ccid_get_atr (slotp->ccid.handle,
- slotp->atr, sizeof slotp->atr, &slotp->atrlen);
- if (err)
- {
- slotp->atrlen = 0;
- err = 0;
- }
-
require_get_status = ccid_require_get_status (slotp->ccid.handle);
reader_table[slot].close_reader = close_ccid_reader;
}
-/* Get the public key for KEYNO and store it as an S-expresion with
+/* Get the public key for KEYNO and store it as an S-expression with
the APP handle. On error that field gets cleared. If we already
know about the public key we will just return. Note that this does
not mean a key is available; this is solely indicated by the
Note that GnuPG 1.x does not need this and it would be too time
consuming to send it just for the fun of it. However, given that we
- use the same code in gpg 1.4, we can't use the gcry S-expresion
+ use the same code in gpg 1.4, we can't use the gcry S-expression
here but need to open encode it. */
#if GNUPG_MAJOR_VERSION > 1
static gpg_error_t
if (!err && (objlen > nn
|| class != CLASS_UNIVERSAL || tag != TAG_ENUMERATED))
err = gpg_error (GPG_ERR_INV_OBJ);
- if (!err && (objlen > sizeof (pin_type_t) || objlen > sizeof (ul)))
+ if (!err && objlen > sizeof (ul))
err = gpg_error (GPG_ERR_UNSUPPORTED_ENCODING);
if (err)
goto parse_error;
npth_mutex_unlock (&app_list_lock);
}
-/* Check wether the application NAME is allowed. This does not mean
+/* Check whether the application NAME is allowed. This does not mean
we have support for it though. */
static int
is_app_allowed (const char *name)
/* Perform a VERIFY operation without doing anything lese. This may
- be used to initialze a the PIN cache for long lasting other
+ be used to initialize a the PIN cache for long lasting other
operations. Its use is highly application dependent. */
gpg_error_t
app_check_pin (app_t app, ctrl_t ctrl, const char *keyidstr,
-/* atr.c - ISO 7816 ATR fucntions
+/* atr.c - ISO 7816 ATR functions
* Copyright (C) 2003, 2011 Free Software Foundation, Inc.
*
* This file is part of GnuPG.
#define CCID_ERROR_CODE(buf) (((unsigned char *)(buf))[8])
-/* A list and a table with special transport descriptions. */
-enum {
- TRANSPORT_USB = 0, /* Standard USB transport. */
- TRANSPORT_CM4040 = 1 /* As used by the Cardman 4040. */
-};
-
-static struct
-{
- char *name; /* Device name. */
- int type;
-
-} transports[] = {
- { "/dev/cmx0", TRANSPORT_CM4040 },
- { "/dev/cmx1", TRANSPORT_CM4040 },
- { NULL },
-};
-
-
/* Store information on the driver's state. A pointer to such a
structure is used as handle for most functions. */
struct ccid_driver_s
{
libusb_device_handle *idev;
- int dev_fd; /* -1 for USB transport or file descriptor of the
- transport device. */
unsigned int bai;
unsigned short id_vendor;
unsigned short id_product;
static void
-my_sleep (int seconds)
-{
-#ifdef USE_NPTH
- npth_sleep (seconds);
-#else
-# ifdef HAVE_W32_SYSTEM
- Sleep (seconds*1000);
-# else
- sleep (seconds);
-# endif
-#endif
-}
-
-static void
print_progress (ccid_driver_t handle)
{
time_t ct = time (NULL);
}
-/* Given a handle used for special transport prepare it for use. In
- particular setup all information in way that resembles what
- parse_cccid_descriptor does. */
-static void
-prepare_special_transport (ccid_driver_t handle)
-{
- assert (!handle->id_vendor);
-
- handle->nonnull_nad = 0;
- handle->auto_ifsd = 0;
- handle->max_ifsd = 32;
- handle->max_ccid_msglen = CCID_MAX_BUF;
- handle->has_pinpad = 0;
- handle->apdu_level = 0;
- switch (handle->id_product)
- {
- case TRANSPORT_CM4040:
- DEBUGOUT ("setting up transport for CardMan 4040\n");
- handle->apdu_level = 1;
- break;
-
- default: assert (!"transport not defined");
- }
-}
-
/* Parse a CCID descriptor, optionally print all available features
and test whether this reader is usable by this driver. Returns 0
if it is usable.
}
-/* Helper for scan_or_find_devices. This function returns true if a
+/* Helper for scan_devices. This function returns true if a
requested device has been found or the caller should stop scanning
for other reasons. */
-static int
-scan_or_find_usb_device (int scan_mode,
- int readerno, int *count, char **rid_list,
- const char *readerid,
- struct libusb_device *dev,
- char **r_rid,
- struct libusb_device_descriptor *desc,
- libusb_device_handle **r_idev,
- unsigned char **ifcdesc_extra,
- size_t *ifcdesc_extra_len,
- int *interface_number, int *setting_number,
- int *ep_bulk_out, int *ep_bulk_in, int *ep_intr)
+static void
+scan_usb_device (int *count, char **rid_list, struct libusb_device *dev)
{
int ifc_no;
int set_no;
libusb_device_handle *idev = NULL;
int err;
struct libusb_config_descriptor *config;
+ struct libusb_device_descriptor desc;
+ char *p;
- err = libusb_get_device_descriptor (dev, desc);
+ err = libusb_get_device_descriptor (dev, &desc);
if (err)
- return 0;
-
- *r_idev = NULL;
+ return;
err = libusb_get_active_config_descriptor (dev, &config);
if (err)
- return 0;
+ return;
for (ifc_no=0; ifc_no < config->bNumInterfaces; ifc_no++)
for (set_no=0; set_no < config->interface[ifc_no].num_altsetting; set_no++)
&& ifcdesc->bInterfaceSubClass == 0
&& ifcdesc->bInterfaceProtocol == 0)
|| (ifcdesc->bInterfaceClass == 255
- && desc->idVendor == VENDOR_SCM
- && desc->idProduct == SCM_SPR532)
+ && desc.idVendor == VENDOR_SCM
+ && desc.idProduct == SCM_SPR532)
|| (ifcdesc->bInterfaceClass == 255
- && desc->idVendor == VENDOR_CHERRY
- && desc->idProduct == CHERRY_ST2000)))
+ && desc.idVendor == VENDOR_CHERRY
+ && desc.idProduct == CHERRY_ST2000)))
{
++*count;
- if (!scan_mode && ((readerno > 0 && readerno != *count - 1)))
- continue;
err = libusb_open (dev, &idev);
if (err)
continue; /* with next setting. */
}
- rid = make_reader_id (idev, desc->idVendor, desc->idProduct,
- desc->iSerialNumber);
+ rid = make_reader_id (idev, desc.idVendor, desc.idProduct,
+ desc.iSerialNumber);
if (!rid)
{
libusb_free_config_descriptor (config);
- return 0;
+ return;
}
- if (!scan_mode && readerno == -1 && readerid
- && strncmp (rid, readerid, strlen (readerid)))
- continue;
-
- if (scan_mode)
+ /* We are collecting infos about all available CCID
+ readers. Store them and continue. */
+ DEBUGOUT_2 ("found CCID reader %d (ID=%s)\n", *count, rid);
+ p = malloc ((*rid_list? strlen (*rid_list):0) + 1
+ + strlen (rid) + 1);
+ if (p)
{
- char *p;
-
- /* We are collecting infos about all
- available CCID readers. Store them and
- continue. */
- DEBUGOUT_2 ("found CCID reader %d (ID=%s)\n", *count, rid);
- p = malloc ((*rid_list? strlen (*rid_list):0) + 1
- + strlen (rid) + 1);
- if (p)
+ *p = 0;
+ if (*rid_list)
{
- *p = 0;
- if (*rid_list)
- {
- strcat (p, *rid_list);
- free (*rid_list);
- }
- strcat (p, rid);
- strcat (p, "\n");
- *rid_list = p;
- }
- else /* Out of memory. */
- {
- libusb_free_config_descriptor (config);
- free (rid);
- return 0;
+ strcat (p, *rid_list);
+ free (*rid_list);
}
+ strcat (p, rid);
+ strcat (p, "\n");
+ *rid_list = p;
}
- else
+ else /* Out of memory. */
{
- /* We found the requested reader. */
- if (ifcdesc_extra && ifcdesc_extra_len)
- {
- *ifcdesc_extra = malloc (ifcdesc->extra_length);
- if (!*ifcdesc_extra)
- {
- libusb_close (idev);
- free (rid);
- libusb_free_config_descriptor (config);
- return 1; /* Out of core. */
- }
- memcpy (*ifcdesc_extra, ifcdesc->extra,
- ifcdesc->extra_length);
- *ifcdesc_extra_len = ifcdesc->extra_length;
- }
-
- if (interface_number)
- *interface_number = ifc_no;
-
- if (setting_number)
- *setting_number = set_no;
-
- if (ep_bulk_out)
- *ep_bulk_out = find_endpoint (ifcdesc, 0);
- if (ep_bulk_in)
- *ep_bulk_in = find_endpoint (ifcdesc, 1);
- if (ep_intr)
- *ep_intr = find_endpoint (ifcdesc, 2);
-
- if (r_rid)
- {
- *r_rid = rid;
- rid = NULL;
- }
- else
- free (rid);
-
- *r_idev = idev;
libusb_free_config_descriptor (config);
- return 1; /* Found requested device. */
+ free (rid);
+ return;
}
free (rid);
}
libusb_free_config_descriptor (config);
-
- return 0;
}
-/* Combination function to either scan all CCID devices or to find and
- open one specific device.
+/* Scan all CCID devices.
The function returns 0 if a reader has been found or when a scan
returned without error.
- With READERNO = -1 and READERID is NULL, scan mode is used and
R_RID should be the address where to store the list of reader_ids
we found. If on return this list is empty, no CCID device has been
found; otherwise it points to an allocated linked list of reader
- IDs. Note that in this mode the function always returns NULL.
-
- With READERNO >= 0 or READERID is not NULL find mode is used. This
- uses the same algorithm as the scan mode but stops and returns at
- the entry number READERNO and return the handle for the opened
- USB device. If R_RID is not NULL it will receive the reader ID of
- that device. If R_DEV is not NULL it will the device pointer of
- that device. If IFCDESC_EXTRA is NOT NULL it will receive a
- malloced copy of the interfaces "extra: data filed;
- IFCDESC_EXTRA_LEN receive the length of this field. If there is
- no reader with number READERNO or that reader is not usable by our
- implementation NULL will be returned. The caller must close a
- returned USB device handle and free (if not passed as NULL) the
- returned reader ID info as well as the IFCDESC_EXTRA. On error
- NULL will get stored at R_RID, R_DEV, IFCDESC_EXTRA and
- IFCDESC_EXTRA_LEN. With READERID being -1 the function stops if
- the READERID was found.
-
- If R_FD is not -1 on return the device is not using USB for
- transport but the device associated with that file descriptor. In
- this case INTERFACE will receive the transport type and the other
- USB specific return values are not used; the return value is
- (void*)(1).
-
- Note that the first entry of the returned reader ID list in scan mode
- corresponds with a READERNO of 0 in find mode.
+ IDs.
*/
static int
-scan_or_find_devices (int readerno, const char *readerid,
- char **r_rid,
- struct libusb_device_descriptor *r_desc,
- unsigned char **ifcdesc_extra,
- size_t *ifcdesc_extra_len,
- int *interface_number, int *setting_number,
- int *ep_bulk_out, int *ep_bulk_in, int *ep_intr,
- libusb_device_handle **r_idev,
- int *r_fd)
+scan_devices (char **r_rid)
{
char *rid_list = NULL;
int count = 0;
libusb_device **dev_list = NULL;
libusb_device *dev;
- libusb_device_handle *idev = NULL;
- int scan_mode = (readerno == -1 && !readerid);
int i;
ssize_t n;
- struct libusb_device_descriptor desc;
/* Set return values to a default. */
if (r_rid)
*r_rid = NULL;
- if (ifcdesc_extra)
- *ifcdesc_extra = NULL;
- if (ifcdesc_extra_len)
- *ifcdesc_extra_len = 0;
- if (interface_number)
- *interface_number = 0;
- if (setting_number)
- *setting_number = 0;
- if (r_idev)
- *r_idev = NULL;
- if (r_fd)
- *r_fd = -1;
-
- /* See whether we want scan or find mode. */
- if (scan_mode)
- {
- assert (r_rid);
- }
n = libusb_get_device_list (NULL, &dev_list);
for (i = 0; i < n; i++)
{
dev = dev_list[i];
- if (scan_or_find_usb_device (scan_mode, readerno, &count, &rid_list,
- readerid,
- dev,
- r_rid,
- &desc,
- &idev,
- ifcdesc_extra,
- ifcdesc_extra_len,
- interface_number, setting_number,
- ep_bulk_out, ep_bulk_in, ep_intr))
- {
- libusb_free_device_list (dev_list, 1);
- /* Found requested device or out of core. */
- if (!idev)
- {
- free (rid_list);
- return -1; /* error */
- }
- *r_idev = idev;
- if (r_desc)
- memcpy (r_desc, &desc, sizeof (struct libusb_device_descriptor));
- return 0;
- }
+ scan_usb_device (&count, &rid_list, dev);
}
libusb_free_device_list (dev_list, 1);
- /* Now check whether there are any devices with special transport types. */
- for (i=0; transports[i].name; i++)
- {
- int fd;
- char *rid, *p;
-
- fd = open (transports[i].name, O_RDWR);
- if (fd == -1 && scan_mode && errno == EBUSY)
- {
- /* Ignore this error in scan mode because it indicates that
- the device exists but is already open (most likely by us)
- and thus in general suitable as a reader. */
- }
- else if (fd == -1)
- {
- DEBUGOUT_2 ("failed to open '%s': %s\n",
- transports[i].name, strerror (errno));
- continue;
- }
-
- rid = malloc (strlen (transports[i].name) + 30 + 10);
- if (!rid)
- {
- if (fd != -1)
- close (fd);
- free (rid_list);
- return -1; /* Error. */
- }
- sprintf (rid, "0000:%04X:%s:0", transports[i].type, transports[i].name);
- if (scan_mode)
- {
- DEBUGOUT_2 ("found CCID reader %d (ID=%s)\n", count, rid);
- p = malloc ((rid_list? strlen (rid_list):0) + 1 + strlen (rid) + 1);
- if (!p)
- {
- if (fd != -1)
- close (fd);
- free (rid_list);
- free (rid);
- return -1; /* Error. */
- }
- *p = 0;
- if (rid_list)
- {
- strcat (p, rid_list);
- free (rid_list);
- }
- strcat (p, rid);
- strcat (p, "\n");
- rid_list = p;
- ++count;
- }
- else if (!readerno ||
- (readerno < 0 && readerid && !strcmp (readerid, rid)))
- {
- /* Found requested device. */
- if (interface_number)
- *interface_number = transports[i].type;
- if (r_rid)
- *r_rid = rid;
- else
- free (rid);
- if (r_fd)
- *r_fd = fd;
- return 0; /* Okay, found device */
- }
- else /* This is not yet the reader we want. */
- {
- if (readerno >= 0)
- --readerno;
- }
- free (rid);
- if (fd != -1)
- close (fd);
- }
-
- if (scan_mode)
- {
- *r_rid = rid_list;
- return 0;
- }
- else
- return -1;
+ *r_rid = rid_list;
+ return 0;
}
initialized_usb = 1;
}
- if (scan_or_find_devices (-1, NULL, &reader_list, NULL, NULL, NULL, NULL,
- NULL, NULL, NULL, NULL, NULL, NULL))
+ if (scan_devices (&reader_list))
return NULL; /* Error. */
return reader_list;
}
struct ccid_dev_table {
int n; /* Index to ccid_usb_dev_list */
- int transport;
int interface_number;
int setting_number;
unsigned char *ifcdesc_extra;
}
memcpy (ifcdesc_extra, ifcdesc->extra, ifcdesc->extra_length);
- ccid_dev_table[idx].transport = TRANSPORT_USB;
ccid_dev_table[idx].n = i;
ccid_dev_table[idx].interface_number = ifc_no;
ccid_dev_table[idx].setting_number = set_no;
libusb_free_config_descriptor (config);
}
- /* Now check whether there are any devices with special transport types. */
- for (i=0; transports[i].name; i++)
- {
- if (access (transports[i].name, (R_OK|W_OK)) == 0)
- {
- /* Found a device. */
- DEBUGOUT_1 ("Found CCID reader %d\n", idx);
-
- ccid_dev_table[idx].transport = TRANSPORT_CM4040;
- ccid_dev_table[idx].n = i;
- ccid_dev_table[idx].interface_number = 0;
- ccid_dev_table[idx].setting_number = 0;
- ccid_dev_table[idx].ifcdesc_extra = NULL;
- ccid_dev_table[idx].ifcdesc_extra_len = 0;
- ccid_dev_table[idx].ep_bulk_out = 0;
- ccid_dev_table[idx].ep_bulk_in = 0;
- ccid_dev_table[idx].ep_intr = 0;
-
- idx++;
- if (idx >= MAX_DEVICE)
- goto scan_finish;
- }
- }
-
scan_finish:
if (err)
for (i = 0; i < idx; i++)
{
free (ccid_dev_table[idx].ifcdesc_extra);
- ccid_dev_table[idx].transport = 0;
ccid_dev_table[idx].n = 0;
ccid_dev_table[idx].interface_number = 0;
ccid_dev_table[idx].setting_number = 0;
for (i = 0; i < max; i++)
{
free (tbl[i].ifcdesc_extra);
- tbl[i].transport = 0;
tbl[i].n = 0;
tbl[i].interface_number = 0;
tbl[i].setting_number = 0;
int n;
int bus, addr, intf;
unsigned int bai;
+ libusb_device *dev;
- if (tbl[idx].transport == TRANSPORT_USB)
- {
- libusb_device *dev;
-
- n = tbl[idx].n;
- dev = ccid_usb_dev_list[n];
+ n = tbl[idx].n;
+ dev = ccid_usb_dev_list[n];
- bus = libusb_get_bus_number (dev);
- addr = libusb_get_device_address (dev);
- intf = tbl[idx].interface_number;
- bai = (bus << 16) | (addr << 8) | intf;
- }
- else
- {
- n = tbl[idx].n;
- bai = 0xFFFF0000 | n;
- }
+ bus = libusb_get_bus_number (dev);
+ addr = libusb_get_device_address (dev);
+ intf = tbl[idx].interface_number;
+ bai = (bus << 16) | (addr << 8) | intf;
return bai;
}
(*handle)->id_vendor = desc.idVendor;
(*handle)->id_product = desc.idProduct;
(*handle)->idev = idev;
- (*handle)->dev_fd = -1;
(*handle)->bai = bai;
(*handle)->ifc_no = ifc_no;
(*handle)->ep_bulk_out = ccid_table[idx].ep_bulk_out;
struct ccid_dev_table *ccid_table,
ccid_driver_t *handle, char **rdrname_p)
{
- int n;
- int fd;
- char *rid;
-
*handle = calloc (1, sizeof **handle);
if (!*handle)
{
return CCID_DRIVER_ERR_OUT_OF_CORE;
}
- if (ccid_table[idx].transport == TRANSPORT_USB)
- return ccid_open_usb_reader (spec_reader_name, idx, ccid_table,
- handle, rdrname_p);
-
- /* Special transport support. */
-
- n = ccid_table[idx].n;
- fd = open (transports[n].name, O_RDWR);
- if (fd < 0)
- {
- DEBUGOUT_2 ("failed to open '%s': %s\n",
- transports[n].name, strerror (errno));
- free (*handle);
- *handle = NULL;
- return -1;
- }
-
- rid = malloc (strlen (transports[n].name) + 30 + 10);
- if (!rid)
- {
- close (fd);
- free (*handle);
- *handle = NULL;
- return -1; /* Error. */
- }
-
- sprintf (rid, "0000:%04X:%s:0", transports[n].type, transports[n].name);
-
- /* Check to see if reader name matches the spec. */
- if (spec_reader_name
- && strncmp (rid, spec_reader_name, strlen (spec_reader_name)))
- {
- DEBUGOUT ("device not matched\n");
- free (rid);
- close (fd);
- free (*handle);
- *handle = NULL;
- return -1;
- }
-
- (*handle)->id_vendor = 0;
- (*handle)->id_product = transports[n].type;
- (*handle)->idev = NULL;
- (*handle)->dev_fd = fd;
- (*handle)->bai = 0xFFFF0000 | n;
- prepare_special_transport (*handle);
- if (rdrname_p)
- *rdrname_p = rid;
- else
- free (rid);
-
- return 0;
+ return ccid_open_usb_reader (spec_reader_name, idx, ccid_table,
+ handle, rdrname_p);
}
bulk_in (handle, msg, sizeof msg, &msglen, RDR_to_PC_SlotStatus,
seqno, 2000, 0);
}
- if (handle->idev)
+
+ if (handle->transfer)
{
- if (handle->transfer)
+ if (!handle->powered_off)
{
- if (!handle->powered_off)
- {
- DEBUGOUT ("libusb_cancel_transfer\n");
+ DEBUGOUT ("libusb_cancel_transfer\n");
- rc = libusb_cancel_transfer (handle->transfer);
- if (rc != LIBUSB_ERROR_NOT_FOUND)
- while (!handle->powered_off)
- {
- DEBUGOUT ("libusb_handle_events_completed\n");
+ rc = libusb_cancel_transfer (handle->transfer);
+ if (rc != LIBUSB_ERROR_NOT_FOUND)
+ while (!handle->powered_off)
+ {
+ DEBUGOUT ("libusb_handle_events_completed\n");
#ifdef USE_NPTH
- npth_unprotect ();
+ npth_unprotect ();
#endif
- libusb_handle_events_completed (NULL, &handle->powered_off);
+ libusb_handle_events_completed (NULL, &handle->powered_off);
#ifdef USE_NPTH
- npth_protect ();
+ npth_protect ();
#endif
- }
- }
-
- libusb_free_transfer (handle->transfer);
+ }
}
- libusb_release_interface (handle->idev, handle->ifc_no);
- --ccid_usb_thread_is_alive;
- libusb_close (handle->idev);
- handle->idev = NULL;
- }
- if (handle->dev_fd != -1)
- {
- close (handle->dev_fd);
- handle->dev_fd = -1;
+
+ libusb_free_transfer (handle->transfer);
}
+ libusb_release_interface (handle->idev, handle->ifc_no);
+ --ccid_usb_thread_is_alive;
+ libusb_close (handle->idev);
+ handle->idev = NULL;
}
int
ccid_close_reader (ccid_driver_t handle)
{
- if (!handle || (!handle->idev && handle->dev_fd == -1))
+ if (!handle)
return 0;
do_close_reader (handle);
}
-/* Write NBYTES of BUF to file descriptor FD. */
-static int
-writen (int fd, const void *buf, size_t nbytes)
-{
- size_t nleft = nbytes;
- int nwritten;
-
- while (nleft > 0)
- {
- nwritten = write (fd, buf, nleft);
- if (nwritten < 0)
- {
- if (errno == EINTR)
- nwritten = 0;
- else
- return -1;
- }
- nleft -= nwritten;
- buf = (const char*)buf + nwritten;
- }
-
- return 0;
-}
-
-
/* Write a MSG of length MSGLEN to the designated bulk out endpoint.
Returns 0 on success. */
static int
int no_debug)
{
int rc;
+ int transferred;
/* No need to continue and clutter the log with USB write error
messages after we got the first ENODEV. */
}
}
- if (handle->idev)
- {
- int transferred;
-
#ifdef USE_NPTH
- npth_unprotect ();
+ npth_unprotect ();
#endif
- rc = libusb_bulk_transfer (handle->idev, handle->ep_bulk_out,
- (char*)msg, msglen, &transferred,
- 5000 /* ms timeout */);
+ rc = libusb_bulk_transfer (handle->idev, handle->ep_bulk_out,
+ (char*)msg, msglen, &transferred,
+ 5000 /* ms timeout */);
#ifdef USE_NPTH
- npth_protect ();
+ npth_protect ();
#endif
- if (rc == 0 && transferred == msglen)
- return 0;
+ if (rc == 0 && transferred == msglen)
+ return 0;
- if (rc)
+ if (rc)
+ {
+ DEBUGOUT_1 ("usb_bulk_write error: %s\n", libusb_error_name (rc));
+ if (rc == LIBUSB_ERROR_NO_DEVICE)
{
- DEBUGOUT_1 ("usb_bulk_write error: %s\n", libusb_error_name (rc));
- if (rc == LIBUSB_ERROR_NO_DEVICE)
- {
- handle->enodev_seen = 1;
- return CCID_DRIVER_ERR_NO_READER;
- }
+ handle->enodev_seen = 1;
+ return CCID_DRIVER_ERR_NO_READER;
}
}
- else
- {
- rc = writen (handle->dev_fd, msg, msglen);
- if (!rc)
- return 0;
- DEBUGOUT_2 ("writen to %d failed: %s\n",
- handle->dev_fd, strerror (errno));
- }
- return CCID_DRIVER_ERR_CARD_IO_ERROR;
+ return 0;
}
{
int rc;
int msglen;
- int eagain_retries = 0;
/* Fixme: The next line for the current Valgrind without support
for USB IOCTLs. */
memset (buffer, 0, length);
retry:
- if (handle->idev)
- {
+
#ifdef USE_NPTH
- npth_unprotect ();
+ npth_unprotect ();
#endif
- rc = libusb_bulk_transfer (handle->idev, handle->ep_bulk_in,
- (char*)buffer, length, &msglen, timeout);
+ rc = libusb_bulk_transfer (handle->idev, handle->ep_bulk_in,
+ (char*)buffer, length, &msglen, timeout);
#ifdef USE_NPTH
- npth_protect ();
+ npth_protect ();
#endif
- if (rc)
- {
- DEBUGOUT_1 ("usb_bulk_read error: %s\n", libusb_error_name (rc));
- if (rc == LIBUSB_ERROR_NO_DEVICE)
- {
- handle->enodev_seen = 1;
- return CCID_DRIVER_ERR_NO_READER;
- }
-
- return CCID_DRIVER_ERR_CARD_IO_ERROR;
- }
- if (msglen < 0)
- return CCID_DRIVER_ERR_INV_VALUE; /* Faulty libusb. */
- *nread = msglen;
- }
- else
+ if (rc)
{
- rc = read (handle->dev_fd, buffer, length);
- if (rc < 0)
+ DEBUGOUT_1 ("usb_bulk_read error: %s\n", libusb_error_name (rc));
+ if (rc == LIBUSB_ERROR_NO_DEVICE)
{
- rc = errno;
- DEBUGOUT_2 ("read from %d failed: %s\n",
- handle->dev_fd, strerror (rc));
- if (rc == EAGAIN && eagain_retries++ < 5)
- {
- my_sleep (1);
- goto retry;
- }
- return CCID_DRIVER_ERR_CARD_IO_ERROR;
+ handle->enodev_seen = 1;
+ return CCID_DRIVER_ERR_NO_READER;
}
- *nread = msglen = rc;
+
+ return CCID_DRIVER_ERR_CARD_IO_ERROR;
}
- eagain_retries = 0;
+ if (msglen < 0)
+ return CCID_DRIVER_ERR_INV_VALUE; /* Faulty libusb. */
+ *nread = msglen;
if (msglen < 10)
{
goto retry;
}
- if (buffer[0] != expected_type)
+ if (buffer[0] != expected_type && buffer[0] != RDR_to_PC_SlotStatus)
{
DEBUGOUT_1 ("unexpected bulk-in msg type (%02x)\n", buffer[0]);
abort_cmd (handle, seqno);
switch ((buffer[7] & 0x03))
{
case 0: /* no error */ break;
- case 1: return CCID_DRIVER_ERR_CARD_INACTIVE;
- case 2: return CCID_DRIVER_ERR_NO_CARD;
+ case 1: rc = CCID_DRIVER_ERR_CARD_INACTIVE; break;
+ case 2: rc = CCID_DRIVER_ERR_NO_CARD; break;
case 3: /* RFU */ break;
}
- return 0;
+
+ if (rc)
+ {
+ /*
+ * Communication failure by device side.
+ * Possibly, it was forcibly suspended and resumed.
+ */
+ DEBUGOUT ("CCID: card inactive/removed\n");
+ handle->powered_off = 1;
+ scd_kick_the_loop ();
+ }
+
+ return rc;
}
unsigned char msg[100];
int msglen;
- if (!handle->idev)
- {
- /* I don't know how to send an abort to non-USB devices. */
- rc = CCID_DRIVER_ERR_NOT_SUPPORTED;
- }
-
seqno &= 0xff;
DEBUGOUT_1 ("sending abort sequence for seqno %d\n", seqno);
/* Send the abort command to the control pipe. Note that we don't
else
{
memcpy (result, msg, msglen);
- *resultlen = msglen;
+ if (resultlen)
+ *resultlen = msglen;
rc = 0;
}
}
int msglen;
int i, j;
- if (handle->idev)
- {
- rc = libusb_interrupt_transfer (handle->idev, handle->ep_intr,
- (char*)msg, sizeof msg, &msglen,
- 0 /* ms timeout */ );
- if (rc == LIBUSB_ERROR_TIMEOUT)
- return 0;
- }
- else
+ rc = libusb_interrupt_transfer (handle->idev, handle->ep_intr,
+ (char*)msg, sizeof msg, &msglen,
+ 0 /* ms timeout */ );
+ if (rc == LIBUSB_ERROR_TIMEOUT)
return 0;
if (rc)
ccid_transceive_secure which leads to a loss of sync on the
CCID level. If Cherry wants to make their keyboard work
again, they should hand over some docs. */
- if ((handle->id_vendor == VENDOR_OMNIKEY
- || (!handle->idev && handle->id_product == TRANSPORT_CM4040))
+ if ((handle->id_vendor == VENDOR_OMNIKEY)
&& handle->apdu_level < 2
&& is_exlen_apdu (apdu_buf, apdu_buflen))
via_escape = 1;
}
memcpy (resp, p, n);
- resp += n;
*nresp += n;
- maxresplen -= n;
}
if (!(tpdu[1] & 0x20))
xfree (serial);
return rc;
}
- /* Not canceled, so we have to proceeed. */
+ /* Not canceled, so we have to proceed. */
}
xfree (serial);
}
}
-/* This funcion sends an already formatted APDU to the card. With
+/* This function sends an already formatted APDU to the card. With
HANDLE_MORE set to true a MORE DATA status will be handled
internally. The return value is a gpg error code (i.e. a mapped
status word). This is basically the same as apdu_send_direct but
if (!dup_certs)
gpgsm_add_cert_to_certlist (ctrl, cert, &dup_certs, 0);
- /* We have to ignore ambigious names as long as
+ /* We have to ignore ambiguous names as long as
there only fault is a bad key usage. This is
required to support encryption and signing
certificates of the same subject.
}
/* If we don't have the KEYID filter we need to check for
- ambigious search results. Note, that it is somehwat
+ ambiguous search results. Note, that it is somehwat
reasonable to assume that a specification of a KEYID
won't lead to ambiguous names. */
if (!rc && !keyid)
case aListChain:
case aDumpChain:
- ctrl.with_chain = 1;
+ ctrl.with_chain = 1; /* fall through */
case aListKeys:
case aDumpKeys:
case aListExternalKeys:
/* print_mpi (" q", sk.q); */
/* print_mpi (" u", sk.u); */
- /* Create an S-expresion from the parameters. */
+ /* Create an S-expression from the parameters. */
err = gcry_sexp_build (&s_key, NULL,
"(private-key(rsa(n%m)(e%m)(d%m)(p%m)(q%m)(u%m)))",
sk.n, sk.e, sk.d, sk.p, sk.q, sk.u, NULL);
/* Do not print this extension in the list of extensions. This is set
- for oids which are already available via ksba fucntions. */
+ for oids which are already available via ksba functions. */
#define OID_FLAG_SKIP 1
/* The extension is a simple UTF8String and should be printed. */
#define OID_FLAG_UTF8 2
-/* misc.c - Miscellaneous fucntions
+/* misc.c - Miscellaneous functions
* Copyright (C) 2004, 2009, 2011 Free Software Foundation, Inc.
*
* This file is part of GnuPG.
/* We open the file only once and keep the open file pointer as well
as the name of the file here. Note that, a listname not equal to
- NULL indicates that this module has been intialized and if the
+ NULL indicates that this module has been initialized and if the
LISTFP is also NULL, no list of qualified signatures exists. */
static char *listname;
static FILE *listfp;
{
gpgsm_status2 (ctrl, STATUS_INV_SGNR,
get_inv_recpsgnr_code (rc), line, NULL);
- /* For compatibiliy reasons we also issue the old code after the
+ /* For compatibility reasons we also issue the old code after the
new one. */
gpgsm_status2 (ctrl, STATUS_INV_RECP,
get_inv_recpsgnr_code (rc), line, NULL);
goto leave;
}
- /* Although we don't check for ambigious specification we will
+ /* Although we don't check for ambiguous specification we will
check that the signer's certificate is usable and valid. */
rc = gpgsm_cert_use_sign_p (cert);
if (!rc)
samplekeys/32100C27173EF6E9C4E9A25D3D69F86D37A4F939.key \
samplekeys/cert_g10code_pete1.pem \
samplekeys/cert_g10code_test1.pem \
- samplekeys/cert_g10code_theo1.pem
+ samplekeys/cert_g10code_theo1.pem \
+ run-tests.scm
# We used to run $(testscripts) here but these asschk scripts are not
# completely reliable in all environments and thus we better disable
TESTS_ENVIRONMENT = LC_ALL=C \
EXEEXT=$(EXEEXT) \
PATH=../gpgscm:$(PATH) \
- srcdir=$(abs_srcdir) \
+ abs_top_srcdir=$(abs_top_srcdir) \
objdir=$(abs_top_builddir) \
- GPGSCM_PATH=$(abs_top_srcdir)/tests/gpgscm:$(abs_top_srcdir)/tests/openpgp:$(abs_top_srcdir)/tests/gpgme
+ GPGSCM_PATH=$(abs_top_srcdir)/tests/gpgscm
# XXX: Currently, one cannot override automake's 'check' target. As a
# workaround, we avoid defining 'TESTS', thus automake will not emit
.PHONY: xcheck
xcheck:
$(TESTS_ENVIRONMENT) $(abs_top_builddir)/tests/gpgscm/gpgscm \
- $(abs_srcdir)/run-tests.scm $(TESTFLAGS) $(XTESTS)
+ $(abs_srcdir)/run-tests.scm $(TESTFLAGS) $(TESTS)
-EXTRA_DIST = gpgme-defs.scm run-tests.scm setup.scm wrap.scm
+EXTRA_DIST = gpgme-defs.scm run-tests.scm setup.scm wrap.scm all-tests.scm
-CLEANFILES = *.log
+CLEANFILES = *.log report.xml
# We need to depend on a couple of programs so that the tests don't
# start before all programs are built.
--- /dev/null
+;; 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 <http://www.gnu.org/licenses/>.
+
+(export all-tests
+ ;; Parse GPGME's makefiles to find all tests.
+
+ (load (in-srcdir "tests" "gpgme" "gpgme-defs.scm"))
+ (load (with-path "makefile.scm"))
+
+ (define (expander filename port key)
+ ;;(interactive-repl (current-environment))
+ (cond
+ ((string=? key "tests_unix")
+ (if *win32*
+ (parse-makefile port key) ;; Use win32 definition.
+ (begin
+ (parse-makefile port key) ;; Skip win32 definition.
+ (parse-makefile port key))))
+ (else
+ (parse-makefile port key))))
+
+ (define (parse filename key)
+ (parse-makefile-expand filename expander key))
+
+ (define setup-c
+ (make-environment-cache
+ (test::scm
+ #f
+ (path-join "tests" "gpgme" "setup.scm" "tests" "gpg")
+ (in-srcdir "tests" "gpgme" "setup.scm")
+ "--" "tests" "gpg")))
+ (define setup-py
+ (make-environment-cache
+ (test::scm
+ #f
+ (path-join "tests" "gpgme" "setup.scm" "lang" "python" "tests")
+ (in-srcdir "tests" "gpgme" "setup.scm")
+ "--" "lang" "python" "tests")))
+
+ (define (compiled? name)
+ (not (or (string-suffix? name ".py")
+ (string-suffix? name ".test"))))
+ (define :path car)
+ (define :key cadr)
+ (define :setup caddr)
+
+ (if (have-gpgme?)
+ (apply append
+ (map (lambda (cmpnts)
+ (define (find-test name)
+ (apply path-join
+ `(,(if (compiled? name)
+ gpgme-builddir
+ gpgme-srcdir) ,@(:path cmpnts) ,(qualify name))))
+ (let ((makefile (apply path-join `(,gpgme-srcdir ,@(:path cmpnts)
+ "Makefile.am"))))
+ (map (lambda (name)
+ (apply test::scm
+ `(,(:setup cmpnts)
+ ,(apply path-join
+ `("tests" "gpgme" ,@(:path cmpnts) ,name))
+ ,(in-srcdir "tests" "gpgme" "wrap.scm")
+ --executable
+ ,(find-test name)
+ -- ,@(:path cmpnts))))
+ (parse makefile (:key cmpnts)))))
+ `((("tests" "gpg") "c_tests" ,setup-c)
+ ,@(if (run-python-tests?)
+ `((("lang" "python" "tests") "py_tests" ,setup-py))
+ '())
+ (("lang" "qt" "tests") "TESTS" ,setup-c))))
+ '()))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(define gpgme-srcdir (getenv "XTEST_GPGME_SRCDIR"))
-(when (string=? "" gpgme-srcdir)
- (info
- "SKIP: Environment variable 'XTEST_GPGME_SRCDIR' not set. Please"
- "point it to a recent GPGME source tree to run the GPGME test suite.")
- (exit 0))
(define (in-gpgme-srcdir . names)
(canonical-path (apply path-join (cons gpgme-srcdir names))))
(define gpgme-builddir (getenv "XTEST_GPGME_BUILDDIR"))
-(when (string=? "" gpgme-builddir)
+
+(define (have-gpgme?)
+ (cond
+ ((string=? "" gpgme-srcdir)
+ (info
+ "SKIP: Environment variable 'XTEST_GPGME_SRCDIR' not set. Please"
+ "point it to a recent GPGME source tree to run the GPGME test suite.")
+ #f)
+ ((string=? "" gpgme-builddir)
(info
"SKIP: Environment variable 'XTEST_GPGME_BUILDDIR' not set. Please"
"point it to a recent GPGME build tree to run the GPGME test suite.")
- (exit 0))
+ #f)
+ (else
+ #t)))
;; Make sure that GPGME picks up our gpgconf. This makes GPGME use
;; and thus executes the tests with GnuPG components from the build
;; The tests expect the pinentry to return the passphrase "abc".
(setenv "PINENTRY_USER_DATA" "abc" #t)
-(define (create-file name . lines)
- (letfd ((fd (open name (logior O_WRONLY O_CREAT O_BINARY) #o600)))
- (let ((port (fdopen fd "wb")))
- (for-each (lambda (line) (display line port) (newline port)) lines))))
-
(define (create-gpgmehome . path)
;; Support for various environments.
(define mode
(start-agent))
(apply create-gpgme-gpghome path)))
-(define (parse-makefile port key)
- (define (is-continuation? tokens)
- (string=? (last tokens) "\\"))
- (define (valid-token? s)
- (< 0 (string-length s)))
- (define (drop-continuations tokens)
- (let loop ((acc '()) (tks tokens))
- (if (null? tks)
- (reverse acc)
- (loop (if (string=? "\\" (car tks))
- acc
- (cons (car tks) acc)) (cdr tks)))))
- (let next ((acc '()) (found #f))
- (let ((line (read-line port)))
- (if (eof-object? line)
- acc
- (let ((tokens (filter valid-token?
- (string-splitp (string-trim char-whitespace?
- line)
- char-whitespace? -1))))
- (cond
- ((or (null? tokens)
- (string-prefix? (car tokens) "#")
- (and (not found) (not (and (string=? key (car tokens))
- (string=? "=" (cadr tokens))))))
- (next acc found))
- ((not found)
- (assert (and (string=? key (car tokens))
- (string=? "=" (cadr tokens))))
- (if (is-continuation? tokens)
- (next (drop-continuations (cddr tokens)) #t)
- (drop-continuations (cddr tokens))))
- (else
- (assert found)
- (if (is-continuation? tokens)
- (next (append acc (drop-continuations tokens)) found)
- (append acc (drop-continuations tokens))))))))))
-
-(define (parse-makefile-expand filename expand key)
- (define (variable? v)
- (and (string-prefix? v "$(") (string-suffix? v ")")))
-
- (let expand-all ((values (parse-makefile (open-input-file filename) key)))
- (if (any variable? values)
- (expand-all
- (let expand-one ((acc '()) (v values))
- (cond
- ((null? v)
- acc)
- ((variable? (car v))
- (let ((makefile (open-input-file filename))
- (key (substring (car v) 2 (- (string-length (car v)) 1))))
- (expand-one (append acc (expand filename makefile key))
- (cdr v))))
- (else
- (expand-one (append acc (list (car v))) (cdr v))))))
- values)))
-
-(define python (catch #f
- (path-expand "python" (string-split (getenv "PATH") *pathsep*))))
+(define python
+ (let loop ((pythons (list "python" "python2" "python3")))
+ (if (null? pythons)
+ #f
+ (catch (loop (cdr pythons))
+ (unless (file-exists? (path-join gpgme-builddir "lang" "python"
+ (string-append (car pythons) "-gpg")))
+ (throw "next please"))
+ (path-expand (car pythons) (string-split (getenv "PATH") *pathsep*))))))
+
(define (run-python-tests?)
- (and python
- (let* ((python-version
- (string-trim char-whitespace?
- (call-popen `(,python -c "import sys; print('{0}.{1}'.format(sys.version_info[0], sys.version_info[1]))") "")))
- (build-path (path-join gpgme-builddir "lang" "python"
- (string-append "python" python-version "-gpg"))))
- (file-exists? build-path))))
+ (not (not python)))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "gpgme-defs.scm"))
-
-(info "Running GPGME's test suite...")
-
-(define (gpgme-makefile-expand filename port key)
- ;;(interactive-repl (current-environment))
- (cond
- ((string=? key "tests_unix")
- (if *win32*
- (parse-makefile port key) ;; Use win32 definition.
- (begin
- (parse-makefile port key) ;; Skip win32 definition.
- (parse-makefile port key))))
- (else
- (parse-makefile port key))))
-
-(define (all-tests filename key)
- (parse-makefile-expand filename gpgme-makefile-expand key))
-
-(let* ((runner (if (member "--parallel" *args*)
- run-tests-parallel
- run-tests-sequential))
- (setup-c (make-environment-cache
- (test::scm #f "setup.scm (tests/gpg)" (in-srcdir "setup.scm")
- "--" "tests" "gpg")))
- (setup-py (make-environment-cache
- (test::scm #f "setup.scm (lang/python/tests)" (in-srcdir "setup.scm")
- "--" "lang" "python" "tests")))
- (tests (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*)))
- (runner
- (apply
- append
- (map (lambda (cmpnts)
- (define (compiled? name)
- (not (or (string-suffix? name ".py")
- (string-suffix? name ".test"))))
- (define :path car)
- (define :key cadr)
- (define :setup caddr)
- (define (find-test name)
- (apply path-join
- `(,(if (compiled? name)
- gpgme-builddir
- gpgme-srcdir) ,@(:path cmpnts) ,(qualify name))))
- (let ((makefile (apply path-join `(,gpgme-srcdir ,@(:path cmpnts)
- "Makefile.am"))))
- (map (lambda (name)
- (apply test::scm
- `(,(:setup cmpnts)
- ,name ,(in-srcdir "wrap.scm") --executable
- ,(find-test name)
- -- ,@(:path cmpnts))))
- (if (null? tests) (all-tests makefile (:key cmpnts)) tests))))
- `((("tests" "gpg") "c_tests" ,setup-c)
- ,@(if (run-python-tests?)
- `((("lang" "python" "tests") "py_tests" ,setup-py))
- '())
- (("lang" "qt" "tests") "TESTS" ,setup-c))))))
+(run-tests (load-tests "tests" "gpgme"))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "gpgme-defs.scm"))
+(load (in-srcdir "tests" "gpgme" "gpgme-defs.scm"))
(define tarball (flag "--create-tarball" *args*))
(unless (and tarball (not (null? tarball)))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "gpgme-defs.scm"))
+(load (in-srcdir "tests" "gpgme" "gpgme-defs.scm"))
(define executable (flag "--executable" *args*))
(unless (and executable (not (null? executable)))
(setenv "abs_builddir" (getcwd) #t)
(setenv "top_srcdir" gpgme-srcdir #t)
(setenv "srcdir" (path-join gpgme-srcdir "tests" "gpg") #t)
+(setenv "abs_top_srcdir" (path-join gpgme-srcdir "tests" "gpg") #t)
(define (run what)
(if (string-suffix? (car what) ".py")
ffi.scm \
init.scm \
lib.scm \
+ makefile.scm \
repl.scm \
t-child.scm \
+ xml.scm \
tests.scm \
+ gnupg.scm \
time.scm
AM_CPPFLAGS = -I$(top_srcdir)/common
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
+ scheme-config.h scheme.c scheme.h scheme-private.h \
+ opdefines.h small-integers.h
gpgscm_LDADD = $(LDADD) $(common_libs) \
$(NETLIBS) $(LIBICONV) $(LIBREADLINE) $(LIBINTL) \
$(LIBGCRYPT_LIBS) $(GPG_ERROR_LIBS)
--- /dev/null
+;; Common definitions for executing gpg and related tools.
+;;
+;; Copyright (C) 2016, 2017 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 <http://www.gnu.org/licenses/>.
+
+;; Evaluate a sequence of expressions with the given home directory.
+(define-macro (with-home-directory gnupghome . expressions)
+ (let ((original-home-directory (gensym)))
+ `(let ((,original-home-directory (getenv "GNUPGHOME")))
+ (dynamic-wind
+ (lambda () (setenv "GNUPGHOME" ,gnupghome #t))
+ (lambda () ,@expressions)
+ (lambda () (setenv "GNUPGHOME" ,original-home-directory #t))))))
+
+;; Evaluate a sequence of expressions with an ephemeral home
+;; directory.
+(define-macro (with-ephemeral-home-directory setup-fn . expressions)
+ (let ((original-home-directory (gensym))
+ (ephemeral-home-directory (gensym))
+ (setup (gensym)))
+ `(let ((,original-home-directory (getenv "GNUPGHOME"))
+ (,ephemeral-home-directory (mkdtemp))
+ (,setup (delay (,setup-fn))))
+ (finally (unlink-recursively ,ephemeral-home-directory)
+ (dynamic-wind
+ (lambda ()
+ (setenv "GNUPGHOME" ,ephemeral-home-directory #t)
+ (with-working-directory ,ephemeral-home-directory (force ,setup)))
+ (lambda () ,@expressions)
+ (lambda () (setenv "GNUPGHOME" ,original-home-directory #t)))))))
(quit (cadr args)))
(else
(display message)
- (if args (begin
- (display ": ")
+ (when (and args (not (null? args)))
+ (display ": ")
+ (if (string? (car args))
+ (begin (display (car args))
+ (unless (null? (cdr args))
+ (newline)
+ (write (cdr args))))
(write args)))
(newline)
(vm-history-print history)
,@(cdr form)
(current-environment))))
+(define-macro (export name . expressions)
+ `(define ,name
+ (begin
+ ,@expressions)))
+
;;;;; I/O
(define (input-output-port? p)
(assert #t)
(assert (not #f))
+;; 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)))
+
(define (filter pred lst)
(cond ((null? lst) '())
((pred (car lst))
(let ((length (string-length haystack)))
(define (split acc offset n)
(if (>= offset length)
- (reverse acc)
+ (reverse! acc)
(let ((i (lookahead haystack offset)))
(if (or (eq? i #f) (= 0 n))
- (reverse (cons (substring haystack offset length) acc))
+ (reverse! (cons (substring haystack offset length) acc))
(split (cons (substring haystack offset i) acc)
(+ i 1) (- n 1))))))
(split '() 0 n)))
(define (string-rtrim predicate s)
(if (string=? s "")
""
- (let loop ((s' (reverse (string->list s))))
+ (let loop ((s' (reverse! (string->list s))))
(if (predicate (car s'))
(loop (cdr s'))
- (list->string (reverse s'))))))
+ (list->string (reverse! s'))))))
(assert (string=? "" (string-rtrim char-whitespace? "")))
(assert (string=? "foo" (string-rtrim char-whitespace? "foo ")))
(assert (string-contains? "Hallo" "llo"))
(assert (not (string-contains? "Hallo" "olla")))
+;; Translate characters.
+(define (string-translate s from to)
+ (list->string (map (lambda (c)
+ (let ((i (string-index from c)))
+ (if i (string-ref to i) c))) (string->list s))))
+(assert (equal? (string-translate "foo/bar" "/" ".") "foo.bar"))
+
;; Read a word from port P.
(define (read-word . p)
(list->string
#include <assert.h>
#include <ctype.h>
#include <errno.h>
+#include <fcntl.h>
#include <gcrypt.h>
#include <gpg-error.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
+#include <sys/types.h>
+#include <sys/stat.h>
#include <unistd.h>
+#if HAVE_MMAP
+#include <sys/mman.h>
+#endif
+
#include "private.h"
#include "scheme.h"
#include "scheme-private.h"
}
if (verbose > 1)
fprintf (stderr, "Loading %s...\n", qualified_name);
- scheme_load_named_file (sc, h, qualified_name);
+
+#if HAVE_MMAP
+ /* Always try to mmap the file. This allows the pages to be shared
+ * between processes. If anything fails, we fall back to using
+ * buffered streams. */
+ if (1)
+ {
+ struct stat st;
+ void *map;
+ size_t len;
+ int fd = fileno (h);
+
+ if (fd < 0)
+ goto fallback;
+
+ if (fstat (fd, &st))
+ goto fallback;
+
+ len = (size_t) st.st_size;
+ if ((off_t) len != st.st_size)
+ goto fallback; /* Truncated. */
+
+ map = mmap (NULL, len, PROT_READ, MAP_SHARED, fd, 0);
+ if (map == MAP_FAILED)
+ goto fallback;
+
+ scheme_load_memory (sc, map, len, qualified_name);
+ munmap (map, len);
+ }
+ else
+ fallback:
+#endif
+ scheme_load_named_file (sc, h, qualified_name);
fclose (h);
if (sc->retcode && sc->nesting)
if (! err)
err = load (sc, "repl.scm", 0, 1);
if (! err)
+ err = load (sc, "xml.scm", 0, 1);
+ if (! err)
err = load (sc, "tests.scm", 0, 1);
+ if (! err)
+ err = load (sc, "gnupg.scm", 0, 1);
if (err)
{
fprintf (stderr, "Error initializing gpgscm: %s.\n",
--- /dev/null
+;; Support for parsing Makefiles
+;;
+;; 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 <http://www.gnu.org/licenses/>.
+
+(define (parse-makefile port key)
+ (define (is-continuation? tokens)
+ (string=? (last tokens) "\\"))
+ (define (valid-token? s)
+ (< 0 (string-length s)))
+ (define (drop-continuations tokens)
+ (let loop ((acc '()) (tks tokens))
+ (if (null? tks)
+ (reverse acc)
+ (loop (if (string=? "\\" (car tks))
+ acc
+ (cons (car tks) acc)) (cdr tks)))))
+ (let next ((acc '()) (found #f))
+ (let ((line (read-line port)))
+ (if (eof-object? line)
+ acc
+ (let ((tokens (filter valid-token?
+ (string-splitp (string-trim char-whitespace?
+ line)
+ char-whitespace? -1))))
+ (cond
+ ((or (null? tokens)
+ (string-prefix? (car tokens) "#")
+ (and (not found) (not (and (string=? key (car tokens))
+ (string=? "=" (cadr tokens))))))
+ (next acc found))
+ ((not found)
+ (assert (and (string=? key (car tokens))
+ (string=? "=" (cadr tokens))))
+ (if (is-continuation? tokens)
+ (next (drop-continuations (cddr tokens)) #t)
+ (drop-continuations (cddr tokens))))
+ (else
+ (assert found)
+ (if (is-continuation? tokens)
+ (next (append acc (drop-continuations tokens)) found)
+ (append acc (drop-continuations tokens))))))))))
+
+(define (parse-makefile-expand filename expand key)
+ (define (variable? v)
+ (and (string-prefix? v "$(") (string-suffix? v ")")))
+
+ (let expand-all ((values (parse-makefile (open-input-file filename) key)))
+ (if (any variable? values)
+ (expand-all
+ (let expand-one ((acc '()) (v values))
+ (cond
+ ((null? v)
+ acc)
+ ((variable? (car v))
+ (let ((makefile (open-input-file filename))
+ (key (substring (car v) 2 (- (string-length (car v)) 1))))
+ (expand-one (append acc (expand filename makefile key))
+ (cdr v))))
+ (else
+ (expand-one (append acc (list (car v))) (cdr v))))))
+ values)))
- _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 )
+_OP_DEF("load", 1, 1, TST_STRING, OP_LOAD )
+_OP_DEF(0, 0, 0, 0, OP_T0LVL )
+_OP_DEF(0, 0, 0, 0, OP_T1LVL )
+_OP_DEF(0, 0, 0, 0, OP_READ_INTERNAL )
+_OP_DEF("gensym", 0, 0, 0, OP_GENSYM )
+_OP_DEF(0, 0, 0, 0, OP_VALUEPRINT )
+_OP_DEF(0, 0, 0, 0, OP_EVAL )
#if USE_TRACING
- _OP_DEF(opexe_0, 0, 0, 0, 0, OP_REAL_EVAL )
+_OP_DEF(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(0, 0, 0, 0, OP_E0ARGS )
+_OP_DEF(0, 0, 0, 0, OP_E1ARGS )
#if USE_HISTORY
- _OP_DEF(opexe_0, 0, 0, 0, 0, OP_CALLSTACK_POP )
+_OP_DEF(0, 0, 0, 0, OP_CALLSTACK_POP )
#endif
- _OP_DEF(opexe_0, 0, 0, 0, 0, OP_APPLY_CODE )
- _OP_DEF(opexe_0, 0, 0, 0, 0, OP_APPLY )
+_OP_DEF(0, 0, 0, 0, OP_APPLY_CODE )
+_OP_DEF(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 )
+_OP_DEF(0, 0, 0, 0, OP_REAL_APPLY )
+_OP_DEF("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 )
+_OP_DEF(0, 0, 0, 0, OP_DOMACRO )
+_OP_DEF(0, 0, 0, 0, OP_LAMBDA )
+_OP_DEF(0, 0, 0, 0, OP_LAMBDA1 )
+_OP_DEF("make-closure", 1, 2, TST_PAIR TST_ENVIRONMENT, OP_MKCLOSURE )
+_OP_DEF(0, 0, 0, 0, OP_QUOTE )
+_OP_DEF(0, 0, 0, 0, OP_DEF0 )
+_OP_DEF(0, 0, 0, 0, OP_DEF1 )
+_OP_DEF("defined?", 1, 2, TST_SYMBOL TST_ENVIRONMENT, OP_DEFP )
+_OP_DEF(0, 0, 0, 0, OP_BEGIN )
+_OP_DEF(0, 0, 0, 0, OP_IF0 )
+_OP_DEF(0, 0, 0, 0, OP_IF1 )
+_OP_DEF(0, 0, 0, 0, OP_SET0 )
+_OP_DEF(0, 0, 0, 0, OP_SET1 )
+_OP_DEF(0, 0, 0, 0, OP_LET0 )
+_OP_DEF(0, 0, 0, 0, OP_LET1 )
+_OP_DEF(0, 0, 0, 0, OP_LET2 )
+_OP_DEF(0, 0, 0, 0, OP_LET0AST )
+_OP_DEF(0, 0, 0, 0, OP_LET1AST )
+_OP_DEF(0, 0, 0, 0, OP_LET2AST )
+_OP_DEF(0, 0, 0, 0, OP_LET0REC )
+_OP_DEF(0, 0, 0, 0, OP_LET1REC )
+_OP_DEF(0, 0, 0, 0, OP_LET2REC )
+_OP_DEF(0, 0, 0, 0, OP_COND0 )
+_OP_DEF(0, 0, 0, 0, OP_COND1 )
+_OP_DEF(0, 0, 0, 0, OP_DELAY )
+_OP_DEF(0, 0, 0, 0, OP_AND0 )
+_OP_DEF(0, 0, 0, 0, OP_AND1 )
+_OP_DEF(0, 0, 0, 0, OP_OR0 )
+_OP_DEF(0, 0, 0, 0, OP_OR1 )
+_OP_DEF(0, 0, 0, 0, OP_C0STREAM )
+_OP_DEF(0, 0, 0, 0, OP_C1STREAM )
+_OP_DEF(0, 0, 0, 0, OP_MACRO0 )
+_OP_DEF(0, 0, 0, 0, OP_MACRO1 )
+_OP_DEF(0, 0, 0, 0, OP_CASE0 )
+_OP_DEF(0, 0, 0, 0, OP_CASE1 )
+_OP_DEF(0, 0, 0, 0, OP_CASE2 )
+_OP_DEF("eval", 1, 2, TST_ANY TST_ENVIRONMENT, OP_PEVAL )
+_OP_DEF("apply", 1, INF_ARG, TST_NONE, OP_PAPPLY )
+_OP_DEF("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 )
+_OP_DEF("inexact->exact", 1, 1, TST_NUMBER, OP_INEX2EX )
+_OP_DEF("exp", 1, 1, TST_NUMBER, OP_EXP )
+_OP_DEF("log", 1, 1, TST_NUMBER, OP_LOG )
+_OP_DEF("sin", 1, 1, TST_NUMBER, OP_SIN )
+_OP_DEF("cos", 1, 1, TST_NUMBER, OP_COS )
+_OP_DEF("tan", 1, 1, TST_NUMBER, OP_TAN )
+_OP_DEF("asin", 1, 1, TST_NUMBER, OP_ASIN )
+_OP_DEF("acos", 1, 1, TST_NUMBER, OP_ACOS )
+_OP_DEF("atan", 1, 2, TST_NUMBER, OP_ATAN )
+_OP_DEF("sqrt", 1, 1, TST_NUMBER, OP_SQRT )
+_OP_DEF("expt", 2, 2, TST_NUMBER, OP_EXPT )
+_OP_DEF("floor", 1, 1, TST_NUMBER, OP_FLOOR )
+_OP_DEF("ceiling", 1, 1, TST_NUMBER, OP_CEILING )
+_OP_DEF("truncate", 1, 1, TST_NUMBER, OP_TRUNCATE )
+_OP_DEF("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 )
+_OP_DEF("+", 0, INF_ARG, TST_NUMBER, OP_ADD )
+_OP_DEF("-", 1, INF_ARG, TST_NUMBER, OP_SUB )
+_OP_DEF("*", 0, INF_ARG, TST_NUMBER, OP_MUL )
+_OP_DEF("/", 1, INF_ARG, TST_NUMBER, OP_DIV )
+_OP_DEF("quotient", 1, INF_ARG, TST_INTEGER, OP_INTDIV )
+_OP_DEF("remainder", 2, 2, TST_INTEGER, OP_REM )
+_OP_DEF("modulo", 2, 2, TST_INTEGER, OP_MOD )
+_OP_DEF("car", 1, 1, TST_PAIR, OP_CAR )
+_OP_DEF("cdr", 1, 1, TST_PAIR, OP_CDR )
+_OP_DEF("cons", 2, 2, TST_NONE, OP_CONS )
+_OP_DEF("set-car!", 2, 2, TST_PAIR TST_ANY, OP_SETCAR )
+_OP_DEF("set-cdr!", 2, 2, TST_PAIR TST_ANY, OP_SETCDR )
+_OP_DEF("char->integer", 1, 1, TST_CHAR, OP_CHAR2INT )
+_OP_DEF("integer->char", 1, 1, TST_NATURAL, OP_INT2CHAR )
+_OP_DEF("char-upcase", 1, 1, TST_CHAR, OP_CHARUPCASE )
+_OP_DEF("char-downcase", 1, 1, TST_CHAR, OP_CHARDNCASE )
+_OP_DEF("symbol->string", 1, 1, TST_SYMBOL, OP_SYM2STR )
+_OP_DEF("atom->string", 1, 2, TST_ANY TST_NATURAL, OP_ATOM2STR )
+_OP_DEF("string->symbol", 1, 1, TST_STRING, OP_STR2SYM )
+_OP_DEF("string->atom", 1, 2, TST_STRING TST_NATURAL, OP_STR2ATOM )
+_OP_DEF("make-string", 1, 2, TST_NATURAL TST_CHAR, OP_MKSTRING )
+_OP_DEF("string-length", 1, 1, TST_STRING, OP_STRLEN )
+_OP_DEF("string-ref", 2, 2, TST_STRING TST_NATURAL, OP_STRREF )
+_OP_DEF("string-set!", 3, 3, TST_STRING TST_NATURAL TST_CHAR, OP_STRSET )
+_OP_DEF("string-append", 0, INF_ARG, TST_STRING, OP_STRAPPEND )
+_OP_DEF("substring", 2, 3, TST_STRING TST_NATURAL, OP_SUBSTR )
+_OP_DEF("vector", 0, INF_ARG, TST_NONE, OP_VECTOR )
+_OP_DEF("make-vector", 1, 2, TST_NATURAL TST_ANY, OP_MKVECTOR )
+_OP_DEF("vector-length", 1, 1, TST_VECTOR, OP_VECLEN )
+_OP_DEF("vector-ref", 2, 2, TST_VECTOR TST_NATURAL, OP_VECREF )
+_OP_DEF("vector-set!", 3, 3, TST_VECTOR TST_NATURAL TST_ANY, OP_VECSET )
+_OP_DEF("not", 1, 1, TST_NONE, OP_NOT )
+_OP_DEF("boolean?", 1, 1, TST_NONE, OP_BOOLP )
+_OP_DEF("eof-object?", 1, 1, TST_NONE, OP_EOFOBJP )
+_OP_DEF("null?", 1, 1, TST_NONE, OP_NULLP )
+_OP_DEF("=", 2, INF_ARG, TST_NUMBER, OP_NUMEQ )
+_OP_DEF("<", 2, INF_ARG, TST_NUMBER, OP_LESS )
+_OP_DEF(">", 2, INF_ARG, TST_NUMBER, OP_GRE )
+_OP_DEF("<=", 2, INF_ARG, TST_NUMBER, OP_LEQ )
+_OP_DEF(">=", 2, INF_ARG, TST_NUMBER, OP_GEQ )
+_OP_DEF("symbol?", 1, 1, TST_ANY, OP_SYMBOLP )
+_OP_DEF("number?", 1, 1, TST_ANY, OP_NUMBERP )
+_OP_DEF("string?", 1, 1, TST_ANY, OP_STRINGP )
+_OP_DEF("integer?", 1, 1, TST_ANY, OP_INTEGERP )
+_OP_DEF("real?", 1, 1, TST_ANY, OP_REALP )
+_OP_DEF("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 )
+_OP_DEF("char-alphabetic?", 1, 1, TST_CHAR, OP_CHARAP )
+_OP_DEF("char-numeric?", 1, 1, TST_CHAR, OP_CHARNP )
+_OP_DEF("char-whitespace?", 1, 1, TST_CHAR, OP_CHARWP )
+_OP_DEF("char-upper-case?", 1, 1, TST_CHAR, OP_CHARUP )
+_OP_DEF("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 )
+_OP_DEF("port?", 1, 1, TST_ANY, OP_PORTP )
+_OP_DEF("input-port?", 1, 1, TST_ANY, OP_INPORTP )
+_OP_DEF("output-port?", 1, 1, TST_ANY, OP_OUTPORTP )
+_OP_DEF("procedure?", 1, 1, TST_ANY, OP_PROCP )
+_OP_DEF("pair?", 1, 1, TST_ANY, OP_PAIRP )
+_OP_DEF("list?", 1, 1, TST_ANY, OP_LISTP )
+_OP_DEF("environment?", 1, 1, TST_ANY, OP_ENVP )
+_OP_DEF("vector?", 1, 1, TST_ANY, OP_VECTORP )
+_OP_DEF("eq?", 2, 2, TST_ANY, OP_EQ )
+_OP_DEF("eqv?", 2, 2, TST_ANY, OP_EQV )
+_OP_DEF("force", 1, 1, TST_ANY, OP_FORCE )
+_OP_DEF(0, 0, 0, 0, OP_SAVE_FORCED )
+_OP_DEF("write", 1, 2, TST_ANY TST_OUTPORT, OP_WRITE )
+_OP_DEF("write-char", 1, 2, TST_CHAR TST_OUTPORT, OP_WRITE_CHAR )
+_OP_DEF("display", 1, 2, TST_ANY TST_OUTPORT, OP_DISPLAY )
+_OP_DEF("newline", 0, 1, TST_OUTPORT, OP_NEWLINE )
+_OP_DEF("error", 1, INF_ARG, TST_NONE, OP_ERR0 )
+_OP_DEF(0, 0, 0, 0, OP_ERR1 )
+_OP_DEF("reverse", 1, 1, TST_LIST, OP_REVERSE )
+_OP_DEF("reverse!", 1, 1, TST_LIST, OP_REVERSE_IN_PLACE )
+_OP_DEF("list*", 1, INF_ARG, TST_NONE, OP_LIST_STAR )
+_OP_DEF("append", 0, INF_ARG, TST_NONE, OP_APPEND )
#if USE_PLIST
- _OP_DEF(opexe_4, "set-symbol-property!", 3, 3, TST_SYMBOL TST_SYMBOL TST_ANY, OP_SET_SYMBOL_PROPERTY )
- _OP_DEF(opexe_4, "symbol-property", 2, 2, TST_SYMBOL TST_SYMBOL, OP_SYMBOL_PROPERTY )
+_OP_DEF("set-symbol-property!", 3, 3, TST_SYMBOL TST_SYMBOL TST_ANY, OP_SET_SYMBOL_PROPERTY )
+_OP_DEF("symbol-property", 2, 2, TST_SYMBOL TST_SYMBOL, OP_SYMBOL_PROPERTY )
#endif
-#if USE_TAGS
- _OP_DEF(opexe_4, NULL, 0, 0, TST_NONE, OP_TAG_VALUE )
- _OP_DEF(opexe_4, "make-tagged-value", 2, 2, TST_ANY TST_PAIR, OP_MK_TAGGED )
- _OP_DEF(opexe_4, "get-tag", 1, 1, TST_ANY, OP_GET_TAG )
-#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 )
+_OP_DEF(0, 0, 0, TST_NONE, OP_TAG_VALUE )
+_OP_DEF("make-tagged-value", 2, 2, TST_ANY TST_PAIR, OP_MK_TAGGED )
+_OP_DEF("get-tag", 1, 1, TST_ANY, OP_GET_TAG )
+_OP_DEF("quit", 0, 1, TST_NUMBER, OP_QUIT )
+_OP_DEF("gc", 0, 0, 0, OP_GC )
+_OP_DEF("gc-verbose", 0, 1, TST_NONE, OP_GCVERB )
+_OP_DEF("new-segment", 0, 1, TST_NUMBER, OP_NEWSEGMENT )
+_OP_DEF("oblist", 0, 0, 0, OP_OBLIST )
+_OP_DEF("current-input-port", 0, 0, 0, OP_CURR_INPORT )
+_OP_DEF("current-output-port", 0, 0, 0, OP_CURR_OUTPORT )
+_OP_DEF("open-input-file", 1, 1, TST_STRING, OP_OPEN_INFILE )
+_OP_DEF("open-output-file", 1, 1, TST_STRING, OP_OPEN_OUTFILE )
+_OP_DEF("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 )
+_OP_DEF("open-input-string", 1, 1, TST_STRING, OP_OPEN_INSTRING )
+_OP_DEF("open-input-output-string", 1, 1, TST_STRING, OP_OPEN_INOUTSTRING )
+_OP_DEF("open-output-string", 0, 1, TST_STRING, OP_OPEN_OUTSTRING )
+_OP_DEF("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 )
- _OP_DEF(opexe_6, "*vm-history*", 0, 0, TST_NONE, OP_VM_HISTORY )
+_OP_DEF("close-input-port", 1, 1, TST_INPORT, OP_CLOSE_INPORT )
+_OP_DEF("close-output-port", 1, 1, TST_OUTPORT, OP_CLOSE_OUTPORT )
+_OP_DEF("interaction-environment", 0, 0, 0, OP_INT_ENV )
+_OP_DEF("current-environment", 0, 0, 0, OP_CURR_ENV )
+_OP_DEF("read", 0, 1, TST_INPORT, OP_READ )
+_OP_DEF("read-char", 0, 1, TST_INPORT, OP_READ_CHAR )
+_OP_DEF("peek-char", 0, 1, TST_INPORT, OP_PEEK_CHAR )
+_OP_DEF("char-ready?", 0, 1, TST_INPORT, OP_CHAR_READY )
+_OP_DEF("set-input-port", 1, 1, TST_INPORT, OP_SET_INPORT )
+_OP_DEF("set-output-port", 1, 1, TST_OUTPORT, OP_SET_OUTPORT )
+_OP_DEF(0, 0, 0, 0, OP_RDSEXPR )
+_OP_DEF(0, 0, 0, 0, OP_RDLIST )
+_OP_DEF(0, 0, 0, 0, OP_RDDOT )
+_OP_DEF(0, 0, 0, 0, OP_RDQUOTE )
+_OP_DEF(0, 0, 0, 0, OP_RDQQUOTE )
+_OP_DEF(0, 0, 0, 0, OP_RDQQUOTEVEC )
+_OP_DEF(0, 0, 0, 0, OP_RDUNQUOTE )
+_OP_DEF(0, 0, 0, 0, OP_RDUQTSP )
+_OP_DEF(0, 0, 0, 0, OP_RDVEC )
+_OP_DEF(0, 0, 0, 0, OP_P0LIST )
+_OP_DEF(0, 0, 0, 0, OP_P1LIST )
+_OP_DEF(0, 0, 0, 0, OP_PVECFROM )
+_OP_DEF("length", 1, 1, TST_LIST, OP_LIST_LENGTH )
+_OP_DEF("assq", 2, 2, TST_NONE, OP_ASSQ )
+_OP_DEF("get-closure-code", 1, 1, TST_NONE, OP_GET_CLOSURE )
+_OP_DEF("closure?", 1, 1, TST_NONE, OP_CLOSUREP )
+_OP_DEF("macro?", 1, 1, TST_NONE, OP_MACROP )
+_OP_DEF("*vm-history*", 0, 0, TST_NONE, OP_VM_HISTORY )
#undef _OP_DEF
#ifndef _SCHEME_PRIVATE_H
#define _SCHEME_PRIVATE_H
+#include <stdint.h>
#include "scheme.h"
/*------------------ Ugly internals -----------------------------------*/
/*------------------ Of interest only to FFI users --------------------*/
/* cell structure */
struct cell {
- unsigned int _flag;
+ uintptr_t _flag;
union {
+ num _number;
struct {
char *_svalue;
int _length;
} _string;
- num _number;
port *_port;
foreign_func _ff;
struct {
#ifndef CELL_SEGSIZE
#define CELL_SEGSIZE 5000 /* # of cells in one segment */
#endif
-#ifndef CELL_NSEGMENT
-#define CELL_NSEGMENT 10 /* # of segments for cells */
+
+/* If less than # of cells are recovered in a garbage collector run,
+ * allocate a new cell segment to avoid fruitless collection cycles in
+ * the near future. */
+#ifndef CELL_MINRECOVER
+#define CELL_MINRECOVER (CELL_SEGSIZE >> 2)
#endif
-void *alloc_seg[CELL_NSEGMENT];
-pointer cell_seg[CELL_NSEGMENT];
-int last_cell_seg;
+struct cell_segment *cell_segments;
/* 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 */
+pointer frame_freelist;
#if USE_HISTORY
struct history history; /* we keep track of the call history for
pointer COMPILE_HOOK; /* *compile-hook* */
#endif
-#if USE_SMALL_INTEGERS
-/* A fixed allocation of small integers. */
-void *integer_alloc;
-pointer integer_cells;
-#endif
-
pointer free_cell; /* pointer to top of free cells */
long fcells; /* # of free cells */
size_t inhibit_gc; /* nesting of gc_disable */
int tok;
int print_flag;
pointer value;
-int op;
unsigned int flags;
void *ext_data; /* For the benefit of foreign functions */
long gensym_cnt;
-struct scheme_interface *vptr;
+const struct scheme_interface *vptr;
};
/* operator code */
enum scheme_opcodes {
-#define _OP_DEF(A,B,C,D,E,OP) OP,
+#define _OP_DEF(A,B,C,D,OP) OP,
#include "opdefines.h"
OP_MAXDEFINED
};
T_NIL = 17 << 1 | 1,
T_EOF_OBJ = 18 << 1 | 1,
T_SINK = 19 << 1 | 1,
- T_LAST_SYSTEM_TYPE = 19 << 1 | 1
+ T_FRAME = 20 << 1 | 1,
+ T_LAST_SYSTEM_TYPE = 20 << 1 | 1
};
static const char *
case T_NIL: return "nil";
case T_EOF_OBJ: return "eof object";
case T_SINK: return "sink";
+ case T_FRAME: return "frame";
}
assert (! "not reached");
}
#define TYPE_BITS 6
#define ADJ (1 << TYPE_BITS)
#define T_MASKTYPE (ADJ - 1)
+ /* 0000000000111111 */
#define T_TAGGED 1024 /* 0000010000000000 */
#define T_FINALIZE 2048 /* 0000100000000000 */
#define T_SYNTAX 4096 /* 0001000000000000 */
return ((p)->_object._number.is_fixnum);
}
-static num num_zero;
-static num num_one;
+static const struct num num_zero = { 1, {0} };
+static const struct num num_one = { 1, {1} };
/* macros for cell operations */
#define typeflag(p) ((p)->_flag)
#define type(p) (typeflag(p)&T_MASKTYPE)
+#define settype(p, typ) (typeflag(p) = (typeflag(p) & ~T_MASKTYPE) | (typ))
INTERFACE INLINE int is_string(pointer p) { return (type(p)==T_STRING); }
#define strvalue(p) ((p)->_object._string._svalue)
INTERFACE INLINE int is_environment(pointer p) { return (type(p)==T_ENVIRONMENT); }
#define setenvironment(p) typeflag(p) = T_ENVIRONMENT
+INTERFACE INLINE int is_frame(pointer p) { return (type(p) == T_FRAME); }
+#define setframe(p) settype(p, T_FRAME)
+
#define is_atom(p) (typeflag(p)&T_ATOM)
#define setatom(p) typeflag(p) |= T_ATOM
#define clratom(p) typeflag(p) &= CLRATOM
#endif
#if USE_ASCII_NAMES
-static const char *charnames[32]={
+static const char charnames[32][3]={
"nul",
"soh",
"stx",
static int is_ascii_name(const char *name, int *pc) {
int i;
for(i=0; i<32; i++) {
- if(stricmp(name,charnames[i])==0) {
+ if (strncasecmp(name, charnames[i], 3) == 0) {
*pc=i;
return 1;
}
}
- if(stricmp(name,"del")==0) {
+ if (strcasecmp(name, "del") == 0) {
*pc=127;
return 1;
}
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 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 pointer reverse(scheme *sc, pointer term, pointer list);
static pointer reverse_in_place(scheme *sc, pointer term, pointer list);
static pointer revappend(scheme *sc, pointer a, pointer b);
+static void dump_stack_preallocate_frame(scheme *sc);
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);
+struct op_code_info {
+ char name[31]; /* strlen ("call-with-current-continuation") + 1 */
+ unsigned char min_arity;
+ unsigned char max_arity;
+ char arg_tests_encoding[3];
+};
+static const struct op_code_info dispatch_table[];
+static int check_arguments (scheme *sc, const struct op_code_info *pcd, char *msg, size_t msg_size);
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);
+static void assign_syntax(scheme *sc, enum scheme_opcodes op, char *name);
+static int syntaxnum(scheme *sc, pointer p);
+static void assign_proc(scheme *sc, enum scheme_opcodes, const 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)
\f
+/*
+ * Copying values.
+ *
+ * Occasionally, we need to copy a value from one location in the
+ * storage to another. Scheme objects are fine. Some primitive
+ * objects, however, require finalization, usually to free resources.
+ *
+ * For these values, we either make a copy or acquire a reference.
+ */
+
+/*
+ * Copy SRC to DST.
+ *
+ * Copies the representation of SRC to DST. This makes SRC
+ * indistinguishable from DST from the perspective of a Scheme
+ * expression modulo the fact that they reside at a different location
+ * in the store.
+ *
+ * Conditions:
+ *
+ * - SRC must not be a vector.
+ * - Caller must ensure that any resources associated with the
+ * value currently stored in DST is accounted for.
+ */
+static void
+copy_value(scheme *sc, pointer dst, pointer src)
+{
+ memcpy(dst, src, sizeof *src);
+
+ /* We may need to make a copy or acquire a reference. */
+ if (typeflag(dst) & T_FINALIZE)
+ switch (type(dst)) {
+ case T_STRING:
+ strvalue(dst) = store_string(sc, strlength(dst), strvalue(dst), 0);
+ break;
+ case T_PORT:
+ /* XXX acquire reference */
+ assert (!"implemented");
+ break;
+ case T_FOREIGN_OBJECT:
+ /* XXX acquire reference */
+ assert (!"implemented");
+ break;
+ case T_VECTOR:
+ assert (!"vectors cannot be copied");
+ }
+}
+
+\f
+
/* Tags are like property lists, but can be attached to arbitrary
* values. */
-#if USE_TAGS
-
static pointer
mk_tagged_value(scheme *sc, pointer v, pointer tag_car, pointer tag_cdr)
{
if (r == sc->sink)
return sc->sink;
- memcpy(r, v, sizeof *v);
+ copy_value(sc, r, v);
typeflag(r) |= T_TAGGED;
t = r + 1;
return sc->NIL;
}
-#else
-
-#define mk_tagged_value(SC, X, A, B) (X)
-#define has_tag(V) 0
-#define get_tag(SC, V) (SC)->NIL
+\f
-#endif
+/* Low-level allocator.
+ *
+ * Memory is allocated in segments. Every segment holds a fixed
+ * number of cells. Segments are linked into a list, sorted in
+ * reverse address order (i.e. those with a higher address first).
+ * This is used in the garbage collector to build the freelist in
+ * address order.
+ */
-\f
+struct cell_segment
+{
+ struct cell_segment *next;
+ void *alloc;
+ pointer cells;
+ size_t cells_len;
+};
/* Allocate a new cell segment but do not make it available yet. */
static int
-_alloc_cellseg(scheme *sc, size_t len, void **alloc, pointer *cells)
+_alloc_cellseg(scheme *sc, size_t len, struct cell_segment **segment)
{
int adj = ADJ;
void *cp;
if (adj < sizeof(struct cell))
adj = sizeof(struct cell);
- cp = sc->malloc(len * sizeof(struct cell) + adj);
+ /* The segment header is conveniently allocated with the cells. */
+ cp = sc->malloc(sizeof **segment + len * sizeof(struct cell) + adj);
if (cp == NULL)
return 1;
- *alloc = cp;
+ *segment = cp;
+ (*segment)->next = NULL;
+ (*segment)->alloc = cp;
+ cp = (void *) ((uintptr_t) cp + sizeof **segment);
/* adjust in TYPE_BITS-bit boundary */
if (((uintptr_t) cp) % adj != 0)
cp = (void *) (adj * ((uintptr_t) cp / adj + 1));
- *cells = cp;
+ (*segment)->cells = cp;
+ (*segment)->cells_len = len;
return 0;
}
+/* Deallocate a cell segment. Returns the next cell segment.
+ * Convenient for deallocation in a loop. */
+static struct cell_segment *
+_dealloc_cellseg(scheme *sc, struct cell_segment *segment)
+{
+
+ struct cell_segment *next;
+
+ if (segment == NULL)
+ return NULL;
+
+ next = segment->next;
+ sc->free(segment->alloc);
+ return next;
+}
+
/* allocate new cell segment */
static int alloc_cellseg(scheme *sc, int n) {
- pointer newp;
pointer last;
pointer p;
- long i;
int k;
for (k = 0; k < n; k++) {
- if (sc->last_cell_seg >= CELL_NSEGMENT - 1)
- return k;
- i = ++sc->last_cell_seg;
- if (_alloc_cellseg(sc, CELL_SEGSIZE, &sc->alloc_seg[i], &newp)) {
- sc->last_cell_seg--;
+ struct cell_segment *new, **s;
+ if (_alloc_cellseg(sc, CELL_SEGSIZE, &new)) {
return k;
}
- /* insert new segment in address order */
- 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++) {
+ /* insert new segment in reverse address order */
+ for (s = &sc->cell_segments;
+ *s && (uintptr_t) (*s)->alloc > (uintptr_t) new->alloc;
+ s = &(*s)->next) {
+ /* walk */
+ }
+ new->next = *s;
+ *s = new;
+
+ sc->fcells += new->cells_len;
+ last = new->cells + new->cells_len - 1;
+ for (p = new->cells; 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;
+ sc->free_cell = new->cells;
} else {
p = sc->free_cell;
- while (cdr(p) != sc->NIL && newp > cdr(p))
+ while (cdr(p) != sc->NIL && (uintptr_t) new->cells > (uintptr_t) cdr(p))
p = cdr(p);
cdr(last) = cdr(p);
- cdr(p) = newp;
+ cdr(p) = new->cells;
}
}
return n;
"insufficient reservation\n")
#else
fprintf(stderr,
- "insufficient reservation in line %d\n",
+ "insufficient %s reservation in line %d\n",
+ sc->frame_freelist == sc->NIL ? "frame" : "cell",
sc->reserved_lineno);
#endif
abort();
sc->inhibit_gc += 1;
}
#define gc_disable(sc, reserve) \
- _gc_disable (sc, reserve, __LINE__)
+ do { \
+ if (sc->frame_freelist == sc->NIL) { \
+ if (gc_enabled(sc)) \
+ dump_stack_preallocate_frame(sc); \
+ else \
+ gc_reservation_failure(sc); \
+ } \
+ _gc_disable (sc, reserve, __LINE__); \
+ } while (0)
/* Enable the garbage collector. */
#define gc_enable(sc) \
#else /* USE_GC_LOCKING */
-#define gc_disable(sc, reserve) (void) 0
+#define gc_reservation_failure(sc) (void) 0
+#define gc_disable(sc, reserve) \
+ do { \
+ if (sc->frame_freelist == sc->NIL) \
+ dump_stack_preallocate_frame(sc); \
+ } while (0)
#define gc_enable(sc) (void) 0
#define gc_enabled(sc) 1
#define gc_consume(sc) (void) 0
assert (gc_enabled (sc));
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;
- }
+ if (sc->free_cell == sc->NIL) {
+ sc->no_memory=1;
+ return sc->sink;
}
}
x = sc->free_cell;
static pointer get_vector_object(scheme *sc, int len, pointer init)
{
pointer cells = get_consecutive_cells(sc, vector_size(len));
+ int i;
+ int alloc_len = 1 + 3 * (vector_size(len) - 1);
if(sc->no_memory) { return sc->sink; }
/* Record it as a vector so that gc understands it. */
typeflag(cells) = (T_VECTOR | T_ATOM | T_FINALIZE);
vector_length(cells) = len;
fill_vector(cells,init);
+
+ /* Initialize the unused slots at the end. */
+ assert (alloc_len - len < 3);
+ for (i = len; i < alloc_len; i++)
+ cells->_object._vector._elements[i] = sc->NIL;
+
if (gc_enabled (sc))
push_recent_alloc(sc, cells, sc->NIL);
return cells;
return (x);
}
+\f
/* ========== oblist implementation ========== */
#ifndef USE_OBJECT_LIST
return mk_vector(sc, 1009);
}
-/* Add a new symbol NAME at SLOT. SLOT must be obtained using
- * oblist_find_by_name, and no insertion must be done between
- * obtaining the SLOT and calling this function. Returns the new
- * symbol. */
-static pointer oblist_add_by_name(scheme *sc, const char *name, pointer *slot)
-{
-#define oblist_add_by_name_allocates 3
- pointer x;
-
- gc_disable(sc, gc_reservations (oblist_add_by_name));
- x = immutable_cons(sc, mk_string(sc, name), sc->NIL);
- typeflag(x) = T_SYMBOL;
- setimmutable(car(x));
- *slot = immutable_cons(sc, x, *slot);
- gc_enable(sc);
- return x;
-}
-
/* Lookup the symbol NAME. Returns the symbol, or NIL if it does not
* exist. In that case, SLOT points to the point where the new symbol
* is to be inserted. */
return sc->NIL;
}
+static pointer oblist_all_symbols(scheme *sc)
+{
+ return sc->oblist;
+}
+
+#endif
+
/* Add a new symbol NAME at SLOT. SLOT must be obtained using
* oblist_find_by_name, and no insertion must be done between
* obtaining the SLOT and calling this function. Returns the new
#define oblist_add_by_name_allocates 3
pointer x;
+ gc_disable(sc, gc_reservations (oblist_add_by_name));
x = immutable_cons(sc, mk_string(sc, name), sc->NIL);
typeflag(x) = T_SYMBOL;
setimmutable(car(x));
*slot = immutable_cons(sc, x, *slot);
+ gc_enable(sc);
return x;
}
-static pointer oblist_all_symbols(scheme *sc)
-{
- return sc->oblist;
-}
-#endif
+\f
static pointer mk_port(scheme *sc, port *p) {
pointer x = get_cell(sc, sc->NIL, sc->NIL);
#if USE_SMALL_INTEGERS
-/* s_save assumes that all opcodes can be expressed as a small
- * integer. */
-#define MAX_SMALL_INTEGER OP_MAXDEFINED
-
-static int
-initialize_small_integers(scheme *sc)
-{
- int i;
- if (_alloc_cellseg(sc, MAX_SMALL_INTEGER, &sc->integer_alloc,
- &sc->integer_cells))
- return 1;
-
- for (i = 0; i < MAX_SMALL_INTEGER; i++) {
- pointer x = &sc->integer_cells[i];
- typeflag(x) = T_NUMBER | T_ATOM | MARK;
- ivalue_unchecked(x) = i;
- set_num_integer(x);
- }
+static const struct cell small_integers[] = {
+#define DEFINE_INTEGER(n) { T_NUMBER | T_ATOM | MARK, {{ 1, {n}}}},
+#include "small-integers.h"
+#undef DEFINE_INTEGER
+ {0}
+};
- return 0;
-}
+#define MAX_SMALL_INTEGER (sizeof small_integers / sizeof *small_integers - 1)
static INLINE pointer
mk_small_integer(scheme *sc, long n)
{
#define mk_small_integer_allocates 0
+ (void) sc;
assert(0 <= n && n < MAX_SMALL_INTEGER);
- return &sc->integer_cells[n];
+ return (pointer) &small_integers[n];
}
#else
/* ========== garbage collector ========== */
+const int frame_length;
+static void dump_stack_deallocate_frame(scheme *sc, pointer frame);
+
/*--
* We use algorithm E (Knuth, The Art of Computer Programming Vol.1,
* sec. 2.3.5), the Schorr-Deutsch-Waite link-inversion algorithm,
t = (pointer) 0;
p = a;
-E2: setmark(p);
- if(is_vector(p)) {
+E2: if (! is_mark(p))
+ setmark(p);
+ if (is_vector(p) || is_frame(p)) {
int i;
- for (i = 0; i < vector_length(p); i++) {
+ int len = is_vector(p) ? vector_length(p) : frame_length;
+ for (i = 0; i < len; i++) {
mark(p->_object._vector._elements[i]);
}
}
/* garbage collection. parameter a, b is marked. */
static void gc(scheme *sc, pointer a, pointer b) {
pointer p;
+ struct cell_segment *s;
int i;
assert (gc_enabled (sc));
(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]) {
+ for (s = sc->cell_segments; s; s = s->next) {
+ p = s->cells + s->cells_len;
+ while (--p >= s->cells) {
if ((typeflag(p) & 1) == 0)
/* All types have the LSB set. This is not a typeflag. */
continue;
if (is_mark(p)) {
clrmark(p);
} else {
- /* reclaim cell */
- if (typeflag(p) & T_FINALIZE) {
- finalize_cell(sc, p);
- }
- ++sc->fcells;
- typeflag(p) = 0;
- car(p) = sc->NIL;
- cdr(p) = sc->free_cell;
- sc->free_cell = p;
+ /* reclaim cell */
+ if ((typeflag(p) & T_FINALIZE) == 0
+ || finalize_cell(sc, p)) {
+ /* Reclaim cell. */
+ ++sc->fcells;
+ typeflag(p) = 0;
+ car(p) = sc->NIL;
+ cdr(p) = sc->free_cell;
+ sc->free_cell = p;
+ }
}
}
}
snprintf(msg,80,"done: %ld cells were recovered.\n", sc->fcells);
putstr(sc,msg);
}
+
+ /* if only a few recovered, get more to avoid fruitless gc's */
+ if (sc->fcells < CELL_MINRECOVER
+ && alloc_cellseg(sc, 1) == 0)
+ sc->no_memory = 1;
}
-static void finalize_cell(scheme *sc, pointer a) {
- if(is_string(a)) {
+/* Finalize A. Returns true if a can be added to the list of free
+ * cells. */
+static int
+finalize_cell(scheme *sc, pointer a)
+{
+ switch (type(a)) {
+ case T_STRING:
sc->free(strvalue(a));
- } else if(is_port(a)) {
+ break;
+
+ case T_PORT:
if(a->_object._port->kind&port_file
&& a->_object._port->rep.stdio.closeit) {
port_close(sc,a,port_input|port_output);
sc->free(a->_object._port->rep.string.start);
}
sc->free(a->_object._port);
- } else if(is_foreign_object(a)) {
+ break;
+
+ case T_FOREIGN_OBJECT:
a->_object._foreign_object._vtable->finalize(sc, a->_object._foreign_object._data);
- } else if (is_vector(a)) {
- int i;
- for (i = vector_size(vector_length(a)) - 1; i > 0; i--) {
- pointer p = a + i;
- typeflag(p) = 0;
- car(p) = sc->NIL;
- cdr(p) = sc->free_cell;
- sc->free_cell = p;
- sc->fcells += 1;
- }
+ break;
+
+ case T_VECTOR:
+ do {
+ int i;
+ for (i = vector_size(vector_length(a)) - 1; i > 0; i--) {
+ pointer p = a + i;
+ typeflag(p) = 0;
+ car(p) = sc->NIL;
+ cdr(p) = sc->free_cell;
+ sc->free_cell = p;
+ sc->fcells += 1;
+ }
+ } while (0);
+ break;
+
+ case T_FRAME:
+ dump_stack_deallocate_frame(sc, a);
+ return 0; /* Do not free cell. */
}
+
+ return 1; /* Free cell. */
}
#if SHOW_ERROR_LINE
#define is_true(p) ((p) != sc->F)
#define is_false(p) ((p) == sc->F)
+\f
/* ========== Environment implementation ========== */
#if !defined(USE_ALIST_ENV) || !defined(USE_OBJECT_LIST)
setenvironment(sc->envir);
}
-/* Insert (VARIABLE, VALUE) at SSLOT. SSLOT must be obtained using
- * find_slot_spec_in_env, and no insertion must be done between
- * obtaining SSLOT and the call to this function. */
-static INLINE void new_slot_spec_in_env(scheme *sc,
- pointer variable, pointer value,
- pointer *sslot)
-{
-#define new_slot_spec_in_env_allocates 2
- pointer slot;
- gc_disable(sc, gc_reservations (new_slot_spec_in_env));
- slot = immutable_cons(sc, variable, value);
- *sslot = immutable_cons(sc, slot, *sslot);
- gc_enable(sc);
-}
-
/* Find the slot in ENV under the key HDL. If ALL is given, look in
* all environments enclosing ENV. If the lookup fails, and SSLOT is
* given, the position where the new slot has to be inserted is stored
setenvironment(sc->envir);
}
-/* Insert (VARIABLE, VALUE) at SSLOT. SSLOT must be obtained using
- * find_slot_spec_in_env, and no insertion must be done between
- * obtaining SSLOT and the call to this function. */
-static INLINE void new_slot_spec_in_env(scheme *sc,
- pointer variable, pointer value,
- pointer *sslot)
-{
-#define new_slot_spec_in_env_allocates 2
- assert(is_symbol(variable));
- *sslot = immutable_cons(sc, immutable_cons(sc, variable, value), *sslot);
-}
-
/* Find the slot in ENV under the key HDL. If ALL is given, look in
* all environments enclosing ENV. If the lookup fails, and SSLOT is
* given, the position where the new slot has to be inserted is stored
return find_slot_spec_in_env(sc, env, hdl, all, NULL);
}
+/* Insert (VARIABLE, VALUE) at SSLOT. SSLOT must be obtained using
+ * find_slot_spec_in_env, and no insertion must be done between
+ * obtaining SSLOT and the call to this function. */
+static INLINE void new_slot_spec_in_env(scheme *sc,
+ pointer variable, pointer value,
+ pointer *sslot)
+{
+#define new_slot_spec_in_env_allocates 2
+ pointer slot;
+ gc_disable(sc, gc_reservations (new_slot_spec_in_env));
+ slot = immutable_cons(sc, variable, value);
+ *sslot = immutable_cons(sc, slot, *sslot);
+ gc_enable(sc);
+}
+
static INLINE void new_slot_in_env(scheme *sc, pointer variable, pointer value)
{
#define new_slot_in_env_allocates new_slot_spec_in_env_allocates
return cdr(slot);
}
+\f
/* ========== Evaluation Cycle ========== */
-static pointer _Error_1(scheme *sc, const char *s, pointer a) {
+static enum scheme_opcodes
+_Error_1(scheme *sc, const char *s, pointer a) {
const char *str = s;
pointer history;
#if USE_ERROR_HOOK
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;
+ return OP_EVAL;
}
#endif
}
sc->args = cons(sc, mk_string(sc, str), sc->args);
setimmutable(car(sc->args));
- sc->op = (int)OP_ERR0;
- return sc->T;
+ return OP_ERR0;
}
-#define Error_1(sc,s, a) return _Error_1(sc,s,a)
-#define Error_0(sc,s) return _Error_1(sc,s,0)
+#define Error_1(sc,s, a) { op = _Error_1(sc,s,a); goto dispatch; }
+#define Error_0(sc,s) { op = _Error_1(sc,s,0); goto dispatch; }
/* Too small to turn into function */
# define BEGIN do {
\f
/* Bounce back to Eval_Cycle and execute A. */
-#define s_goto(sc,a) BEGIN \
- sc->op = (int)(a); \
- return sc->T; END
+#define s_goto(sc, a) { op = (a); goto dispatch; }
#if USE_THREADED_CODE
/* Do not bounce back to Eval_Cycle but execute A by jumping directly
- * to it. Only applicable if A is part of the same dispatch
- * function. */
+ * to it. */
#define s_thread_to(sc, a) \
BEGIN \
- op = (int) (a); \
+ op = (a); \
goto a; \
END
/* Define a label OP and emit a case statement for OP. For use in the
- * dispatch functions. The slightly peculiar goto that is never
+ * dispatch function. The slightly peculiar goto that is never
* executed avoids warnings about unused labels. */
#define CASE(OP) if (0) goto OP; OP: case OP
/* Return to the previous frame on the dump stack, setting the current
* value to A. */
-#define s_return(sc, a) return _s_return(sc, a, 0)
+#define s_return(sc, a) s_goto(sc, _s_return(sc, a, 0))
/* Return to the previous frame on the dump stack, setting the current
* value to A, and re-enable the garbage collector. */
-#define s_return_enable_gc(sc, a) return _s_return(sc, a, 1)
+#define s_return_enable_gc(sc, a) s_goto(sc, _s_return(sc, a, 1))
static INLINE void dump_stack_reset(scheme *sc)
{
static INLINE void dump_stack_initialize(scheme *sc)
{
dump_stack_reset(sc);
+ sc->frame_freelist = sc->NIL;
}
static void dump_stack_free(scheme *sc)
{
- sc->dump = sc->NIL;
+ dump_stack_initialize(sc);
+}
+
+const int frame_length = 4;
+
+static pointer
+dump_stack_make_frame(scheme *sc)
+{
+ pointer frame;
+
+ frame = mk_vector(sc, frame_length);
+ if (! sc->no_memory)
+ setframe(frame);
+
+ return frame;
+}
+
+static INLINE pointer *
+frame_slots(pointer frame)
+{
+ return &frame->_object._vector._elements[0];
+}
+
+#define frame_payload vector_length
+
+static pointer
+dump_stack_allocate_frame(scheme *sc)
+{
+ pointer frame = sc->frame_freelist;
+ if (frame == sc->NIL) {
+ if (gc_enabled(sc))
+ frame = dump_stack_make_frame(sc);
+ else
+ gc_reservation_failure(sc);
+ } else
+ sc->frame_freelist = *frame_slots(frame);
+ return frame;
+}
+
+static void
+dump_stack_deallocate_frame(scheme *sc, pointer frame)
+{
+ pointer *p = frame_slots(frame);
+ *p++ = sc->frame_freelist;
+ *p++ = sc->NIL;
+ *p++ = sc->NIL;
+ *p++ = sc->NIL;
+ sc->frame_freelist = frame;
+}
+
+static void
+dump_stack_preallocate_frame(scheme *sc)
+{
+ pointer frame = dump_stack_make_frame(sc);
+ if (! sc->no_memory)
+ dump_stack_deallocate_frame(sc, frame);
}
-static pointer _s_return(scheme *sc, pointer a, int enable_gc) {
+static enum scheme_opcodes
+_s_return(scheme *sc, pointer a, int enable_gc) {
pointer dump = sc->dump;
- pointer op;
+ pointer *p;
unsigned long v;
+ enum scheme_opcodes next_op;
sc->value = (a);
if (enable_gc)
gc_enable(sc);
if (dump == sc->NIL)
- return sc->NIL;
- free_cons(sc, dump, &op, &dump);
- v = (unsigned long) ivalue_unchecked(op);
- sc->op = (int) (v & S_OP_MASK);
+ return OP_QUIT;
+ v = frame_payload(dump);
+ next_op = (int) (v & S_OP_MASK);
sc->flags = v & S_FLAG_MASK;
-#ifdef USE_SMALL_INTEGERS
- if (v < MAX_SMALL_INTEGER) {
- /* This is a small integer, we must not free it. */
- } else
- /* Normal integer. Recover the cell. */
-#endif
- free_cell(sc, op);
- free_cons(sc, dump, &sc->args, &dump);
- free_cons(sc, dump, &sc->envir, &dump);
- free_cons(sc, dump, &sc->code, &sc->dump);
- return sc->T;
+ p = frame_slots(dump);
+ sc->args = *p++;
+ sc->envir = *p++;
+ sc->code = *p++;
+ sc->dump = *p++;
+ dump_stack_deallocate_frame(sc, dump);
+ return next_op;
}
static void s_save(scheme *sc, enum scheme_opcodes op, pointer args, pointer code) {
-#define s_save_allocates 5
+#define s_save_allocates 0
pointer dump;
- unsigned long v = sc->flags | ((unsigned long) op);
+ pointer *p;
gc_disable(sc, gc_reservations (s_save));
- dump = cons(sc, sc->envir, cons(sc, (code), sc->dump));
- dump = cons(sc, (args), dump);
- sc->dump = cons(sc, mk_integer(sc, (long) v), dump);
+ dump = dump_stack_allocate_frame(sc);
+ frame_payload(dump) = (size_t) (sc->flags | (unsigned long) op);
+ p = frame_slots(dump);
+ *p++ = args;
+ *p++ = sc->envir;
+ *p++ = code;
+ *p++ = sc->dump;
+ sc->dump = dump;
gc_enable(sc);
}
static INLINE void dump_stack_mark(scheme *sc)
{
mark(sc->dump);
+ mark(sc->frame_freelist);
}
\f
\f
+#if USE_PLIST
+static pointer
+get_property(scheme *sc, pointer obj, pointer key)
+{
+ pointer x;
+
+ assert (is_symbol(obj));
+ assert (is_symbol(key));
+
+ for (x = symprop(obj); x != sc->NIL; x = cdr(x)) {
+ if (caar(x) == key)
+ break;
+ }
+
+ if (x != sc->NIL)
+ return cdar(x);
+
+ return sc->NIL;
+}
+
+static pointer
+set_property(scheme *sc, pointer obj, pointer key, pointer value)
+{
+#define set_property_allocates 2
+ pointer x;
+
+ assert (is_symbol(obj));
+ assert (is_symbol(key));
+
+ for (x = symprop(obj); x != sc->NIL; x = cdr(x)) {
+ if (caar(x) == key)
+ break;
+ }
+
+ if (x != sc->NIL)
+ cdar(x) = value;
+ else {
+ gc_disable(sc, gc_reservations(set_property));
+ symprop(obj) = cons(sc, cons(sc, key, value), symprop(obj));
+ gc_enable(sc);
+ }
+
+ return sc->T;
+}
+#endif
+
+\f
+
+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;
+ }
+ }
+}
+
+\f
+
#define s_retbool(tf) s_return(sc,(tf) ? sc->T : sc->F)
-static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
+/* kernel of this interpreter */
+static void
+Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
+ for (;;) {
pointer x, y;
pointer callsite;
+ num v;
+#if USE_MATH
+ double dd;
+#endif
+ int (*comp_func)(num, num) = NULL;
+ const struct op_code_info *pcd = &dispatch_table[op];
+
+ dispatch:
+ if (pcd->name[0] != 0) { /* if built-in function, check arguments */
+ char msg[STRBUFFSIZE];
+ if (! check_arguments (sc, pcd, msg, sizeof msg)) {
+ s_goto(sc, _Error_1(sc, msg, 0));
+ }
+ }
+
+ if(sc->no_memory) {
+ fprintf(stderr,"No memory!\n");
+ exit(1);
+ }
+ ok_to_freely_gc(sc);
switch (op) {
CASE(OP_LOAD): /* load */
{
sc->args=sc->NIL;
sc->nesting = sc->nesting_stack[0];
- s_goto(sc,OP_QUIT);
+ s_thread_to(sc,OP_QUIT);
}
else
{
sc->tok = token(sc);
if(sc->tok==TOK_EOF)
{ s_return(sc,sc->EOF_OBJ); }
- s_goto(sc,OP_RDSEXPR);
+ s_thread_to(sc,OP_RDSEXPR);
CASE(OP_GENSYM):
s_return(sc, gensym(sc));
if(file_interactive(sc)) {
sc->print_flag = 1;
sc->args = sc->value;
- s_goto(sc,OP_P0LIST);
+ s_thread_to(sc,OP_P0LIST);
} else {
s_return(sc,sc->value);
}
s_save(sc,OP_REAL_EVAL,sc->args,sc->code);
sc->args=sc->code;
putstr(sc,"\nEval: ");
- s_goto(sc,OP_P0LIST);
+ s_thread_to(sc,OP_P0LIST);
}
/* fall through */
CASE(OP_REAL_EVAL):
} else if (is_pair(sc->code)) {
if (is_syntax(x = car(sc->code))) { /* SYNTAX */
sc->code = cdr(sc->code);
- s_goto(sc,syntaxnum(x));
+ s_goto(sc, syntaxnum(sc, 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->print_flag = 1;
/* sc->args=cons(sc,sc->code,sc->args);*/
putstr(sc,"\nApply to: ");
- s_goto(sc,OP_P0LIST);
+ s_thread_to(sc,OP_P0LIST);
}
/* fall through */
CASE(OP_REAL_APPLY):
is_pair(x); x = cdr(x), y = cdr(y)) {
if (y == sc->NIL) {
Error_1(sc, "not enough arguments, missing:", x);
- } else {
+ } else if (is_symbol(car(x))) {
new_slot_in_env(sc, car(x), car(y));
- }
+ } else {
+ Error_1(sc, "syntax error in closure: not a symbol", car(x));
+ }
}
+
if (x == sc->NIL) {
if (y != sc->NIL) {
Error_0(sc, "too many arguments");
sc->args = sc->NIL;
s_thread_to(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->code = cadar(sc->code);
sc->args = sc->NIL;
s_clear_flag(sc, TAIL_CONTEXT);
- s_goto(sc,OP_EVAL);
+ s_thread_to(sc,OP_EVAL);
} else { /* end */
sc->args = reverse_in_place(sc, sc->NIL, sc->args);
sc->code = car(sc->args);
}
sc->code = cdr(sc->code);
sc->args = sc->NIL;
- s_goto(sc,OP_BEGIN);
+ s_thread_to(sc,OP_BEGIN);
CASE(OP_COND0): /* cond */
if (!is_pair(sc->code)) {
s_save(sc,OP_COND1, sc->NIL, sc->code);
sc->code = caar(sc->code);
s_clear_flag(sc, TAIL_CONTEXT);
- s_goto(sc,OP_EVAL);
+ s_thread_to(sc,OP_EVAL);
CASE(OP_COND1): /* cond */
if (is_true(sc->value)) {
x=cons(sc, sc->QUOTE, cons(sc, sc->value, sc->NIL));
sc->code=cons(sc,cadr(sc->code),cons(sc,x,sc->NIL));
gc_enable(sc);
- s_goto(sc,OP_EVAL);
+ s_thread_to(sc,OP_EVAL);
}
- s_goto(sc,OP_BEGIN);
+ s_thread_to(sc,OP_BEGIN);
} else {
if ((sc->code = cdr(sc->code)) == sc->NIL) {
s_return(sc,sc->NIL);
s_save(sc,OP_COND1, sc->NIL, sc->code);
sc->code = caar(sc->code);
s_clear_flag(sc, TAIL_CONTEXT);
- s_goto(sc,OP_EVAL);
+ s_thread_to(sc,OP_EVAL);
}
}
if (cdr(sc->code) != sc->NIL)
s_clear_flag(sc, TAIL_CONTEXT);
sc->code = car(sc->code);
- s_goto(sc,OP_EVAL);
+ s_thread_to(sc,OP_EVAL);
CASE(OP_AND1): /* and */
if (is_false(sc->value)) {
if (cdr(sc->code) != sc->NIL)
s_clear_flag(sc, TAIL_CONTEXT);
sc->code = car(sc->code);
- s_goto(sc,OP_EVAL);
+ s_thread_to(sc,OP_EVAL);
}
CASE(OP_OR0): /* or */
if (cdr(sc->code) != sc->NIL)
s_clear_flag(sc, TAIL_CONTEXT);
sc->code = car(sc->code);
- s_goto(sc,OP_EVAL);
+ s_thread_to(sc,OP_EVAL);
CASE(OP_OR1): /* or */
if (is_true(sc->value)) {
if (cdr(sc->code) != sc->NIL)
s_clear_flag(sc, TAIL_CONTEXT);
sc->code = car(sc->code);
- s_goto(sc,OP_EVAL);
+ s_thread_to(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);
+ s_thread_to(sc,OP_EVAL);
CASE(OP_C1STREAM): /* cons-stream */
sc->args = sc->value; /* save sc->value to register sc->args for gc */
Error_0(sc,"variable is not a symbol");
}
s_save(sc,OP_MACRO1, sc->NIL, x);
- s_goto(sc,OP_EVAL);
+ s_thread_to(sc,OP_EVAL);
CASE(OP_MACRO1): { /* macro */
pointer *sslot;
s_save(sc,OP_CASE1, sc->NIL, cdr(sc->code));
sc->code = car(sc->code);
s_clear_flag(sc, TAIL_CONTEXT);
- s_goto(sc,OP_EVAL);
+ s_thread_to(sc,OP_EVAL);
CASE(OP_CASE1): /* case */
for (x = sc->code; x != sc->NIL; x = cdr(x)) {
if (x != sc->NIL) {
if (is_pair(caar(x))) {
sc->code = cdar(x);
- s_goto(sc,OP_BEGIN);
+ s_thread_to(sc,OP_BEGIN);
} else {/* else */
s_save(sc,OP_CASE2, sc->NIL, cdar(x));
sc->code = caar(x);
- s_goto(sc,OP_EVAL);
+ s_thread_to(sc,OP_EVAL);
}
} else {
s_return(sc,sc->NIL);
CASE(OP_CASE2): /* case */
if (is_true(sc->value)) {
- s_goto(sc,OP_BEGIN);
+ s_thread_to(sc,OP_BEGIN);
} else {
s_return(sc,sc->NIL);
}
sc->code = car(sc->args);
sc->args = list_star(sc,cdr(sc->args));
/*sc->args = cadr(sc->args);*/
- s_goto(sc,OP_APPLY);
+ s_thread_to(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);
+ s_thread_to(sc,OP_EVAL);
CASE(OP_CONTINUATION): /* call-with-current-continuation */
sc->code = car(sc->args);
gc_disable(sc, 2);
sc->args = cons(sc, mk_continuation(sc, sc->dump), sc->NIL);
gc_enable(sc);
- s_goto(sc,OP_APPLY);
-
- default:
- snprintf(sc->strbuff,STRBUFFSIZE,"%d: illegal operator", sc->op);
- Error_0(sc,sc->strbuff);
- }
- return sc->T;
-}
+ s_thread_to(sc,OP_APPLY);
-#if USE_PLIST
-static pointer
-get_property(scheme *sc, pointer obj, pointer key)
-{
- pointer x;
-
- assert (is_symbol(obj));
- assert (is_symbol(key));
-
- for (x = symprop(obj); x != sc->NIL; x = cdr(x)) {
- if (caar(x) == key)
- break;
- }
-
- if (x != sc->NIL)
- return cdar(x);
-
- return sc->NIL;
-}
-
-static pointer
-set_property(scheme *sc, pointer obj, pointer key, pointer value)
-{
-#define set_property_allocates 2
- pointer x;
-
- assert (is_symbol(obj));
- assert (is_symbol(key));
-
- for (x = symprop(obj); x != sc->NIL; x = cdr(x)) {
- if (caar(x) == key)
- break;
- }
-
- if (x != sc->NIL)
- cdar(x) = value;
- else {
- gc_disable(sc, gc_reservations(set_property));
- symprop(obj) = cons(sc, cons(sc, key, value), symprop(obj));
- gc_enable(sc);
- }
-
- return sc->T;
-}
-#endif
-
-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);
char *str;
int index0;
int index1;
- int len;
str=strvalue(car(sc->args));
index1=strlength(car(sc->args));
}
- len=index1-index0;
gc_disable(sc, 1);
- x=mk_empty_string(sc,len,' ');
- memcpy(strvalue(x),str+index0,len);
- strvalue(x)[len]=0;
-
- s_return_enable_gc(sc, x);
+ s_return_enable_gc(sc, mk_counted_string(sc, str + index0, index1 - index0));
}
CASE(OP_VECTOR): { /* vector */
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) == 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);
+ s_thread_to(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));
+ copy_value(sc, sc->code, sc->value);
s_return(sc,sc->value);
CASE(OP_WRITE): /* write */
} else {
sc->print_flag = 0;
}
- s_goto(sc,OP_P0LIST);
+ s_thread_to(sc,OP_P0LIST);
CASE(OP_NEWLINE): /* newline */
if(is_pair(sc->args)) {
s_save(sc,OP_ERR1, cdr(sc->args), sc->NIL);
sc->args = car(sc->args);
sc->print_flag = 1;
- s_goto(sc,OP_P0LIST);
+ s_thread_to(sc,OP_P0LIST);
} else {
putstr(sc, "\n");
if(sc->interactive_repl) {
- s_goto(sc,OP_T0LVL);
+ s_thread_to(sc,OP_T0LVL);
} else {
- return sc->NIL;
+ return;
}
}
CASE(OP_REVERSE): /* reverse */
s_return(sc,reverse(sc, sc->NIL, car(sc->args)));
+ CASE(OP_REVERSE_IN_PLACE): /* reverse! */
+ s_return(sc, reverse_in_place(sc, sc->NIL, car(sc->args)));
+
CASE(OP_LIST_STAR): /* list* */
s_return(sc,list_star(sc,sc->args));
s_return(sc, get_property(sc, car(sc->args), cadr(sc->args)));
#endif /* USE_PLIST */
-#if USE_TAGS
CASE(OP_TAG_VALUE): { /* not exposed */
/* This tags sc->value with car(sc->args). Useful to tag
* results of opcode evaluations. */
CASE(OP_GET_TAG): /* get-tag */
s_return(sc, get_tag(sc, car(sc->args)));
-#endif /* USE_TAGS */
CASE(OP_QUIT): /* quit */
if(is_pair(sc->args)) {
sc->retcode=ivalue(car(sc->args));
}
- return (sc->NIL);
+ return;
CASE(OP_GC): /* gc */
gc(sc, sc->NIL, sc->NIL);
}
s_return(sc,p);
break;
- default: assert (! "reached");
}
#if USE_STRING_PORTS
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);
- }
+ gc_disable(sc, 1);
+ s_return_enable_gc(
+ sc,
+ mk_counted_string(sc,
+ p->rep.string.start,
+ p->rep.string.curr - p->rep.string.start));
}
s_return(sc,sc->F);
}
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);
+ s_thread_to(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);
+ s_thread_to(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);
+ s_thread_to(sc,OP_READ_INTERNAL);
CASE(OP_READ_CHAR): /* read-char */
CASE(OP_PEEK_CHAR): /* peek-char */ {
if(c==EOF) {
s_return(sc,sc->EOF_OBJ);
}
- if(sc->op==OP_PEEK_CHAR) {
+ if(op==OP_PEEK_CHAR) {
backchar(sc,c);
}
s_return(sc,mk_character(sc,c));
} else if (sc->tok == TOK_DOT) {
Error_0(sc,"syntax error: illegal dot expression");
} else {
-#if USE_TAGS && SHOW_ERROR_LINE
+#if SHOW_ERROR_LINE
pointer filename;
pointer lineno;
#endif
sc->nesting_stack[sc->file_i]++;
-#if USE_TAGS && SHOW_ERROR_LINE
+#if SHOW_ERROR_LINE
filename = sc->load_stack[sc->file_i].filename;
lineno = sc->load_stack[sc->file_i].curr_line;
Error_0(sc,"undefined sharp expression");
} else {
sc->code=cons(sc,slot_value_in_env(f),sc->NIL);
- s_goto(sc,OP_EVAL);
+ s_thread_to(sc,OP_EVAL);
}
}
case TOK_SHARP_CONST:
CASE(OP_RDVEC):
/*sc->code=cons(sc,mk_proc(sc,OP_VECTOR),sc->value);
- s_goto(sc,OP_EVAL); Cannot be quoted*/
+ s_thread_to(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);*/
+ s_thread_to(sc,OP_APPLY);*/
sc->args=sc->value;
- s_goto(sc,OP_VECTOR);
+ s_thread_to(sc,OP_VECTOR);
/* ========== printing part ========== */
CASE(OP_P0LIST):
s_return(sc,sc->T);
} else {
pointer elem=vector_elem(vec,i);
- ivalue_unchecked(cdr(sc->args))=i+1;
+ cdr(sc->args) = mk_integer(sc, i + 1);
s_save(sc,OP_PVECFROM, sc->args, sc->NIL);
sc->args=elem;
if (i > 0)
}
}
- 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) {
+ CASE(OP_LIST_LENGTH): { /* length */ /* a.k */
+ long l = list_length(sc, car(sc->args));
+ if(l<0) {
Error_1(sc,"length: not a list:",car(sc->args));
}
gc_disable(sc, 1);
- s_return_enable_gc(sc, mk_integer(sc, v));
-
+ s_return_enable_gc(sc, mk_integer(sc, l));
+ }
CASE(OP_ASSQ): /* assq */ /* a.k */
x = car(sc->args);
for (y = cadr(sc->args); is_pair(y); y = cdr(y)) {
CASE(OP_VM_HISTORY): /* *vm-history* */
s_return(sc, history_flatten(sc));
default:
- snprintf(sc->strbuff,STRBUFFSIZE,"%d: illegal operator", sc->op);
+ snprintf(sc->strbuff,STRBUFFSIZE,"%d: illegal operator", 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) {
}
/* Correspond carefully with following defines! */
-static struct {
+static const struct {
test_predicate fct;
const char *kind;
} tests[]={
#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
+#define INF_ARG 0xff
-static op_code_info dispatch_table[]= {
-#define _OP_DEF(A,B,C,D,E,OP) {A,B,C,D,E},
+static const struct op_code_info dispatch_table[]= {
+#define _OP_DEF(A,B,C,D,OP) {{A},B,C,{D}},
#include "opdefines.h"
- { 0 }
+#undef _OP_DEF
+ {{0},0,0,{0}},
};
static const char *procname(pointer x) {
int n=procnum(x);
const char *name=dispatch_table[n].name;
- if(name==0) {
+ if (name[0] == 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(n<pcd->min_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;
- }
+static int
+check_arguments (scheme *sc, const struct op_code_info *pcd, char *msg, size_t msg_size)
+{
+ int ok = 1;
+ int n = list_length(sc, sc->args);
+
+ /* Check number of arguments */
+ if (n < pcd->min_arity) {
+ ok = 0;
+ snprintf(msg, msg_size, "%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, msg_size, "%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] != 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(i<n);
- if(i<n) {
- ok=0;
- snprintf(msg, STRBUFFSIZE, "%s: argument %d must be: %s, got: %s",
- pcd->name,
- 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;
+ if (t[1] != 0 && i < sizeof pcd->arg_tests_encoding) {
+ /* last test is replicated as necessary */
+ t++;
+ }
+ arglist = cdr(arglist);
+ i++;
+ } while (i < n);
+
+ if (i < n) {
+ ok = 0;
+ snprintf(msg, msg_size, "%s: argument %d must be: %s, got: %s",
+ pcd->name,
+ i + 1,
+ tests[j].kind,
+ type_to_string(type(car(arglist))));
}
}
- 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);
- }
}
+
+ return ok;
}
/* ========== Initialization of internal keywords ========== */
-static void assign_syntax(scheme *sc, char *name) {
- pointer x;
+/* Symbols representing syntax are tagged with (OP . '()). */
+static void assign_syntax(scheme *sc, enum scheme_opcodes op, char *name) {
+ pointer x, y;
pointer *slot;
x = oblist_find_by_name(sc, name, &slot);
assert (x == sc->NIL);
- x = oblist_add_by_name(sc, name, slot);
- typeflag(x) |= T_SYNTAX;
+ x = immutable_cons(sc, mk_string(sc, name), sc->NIL);
+ typeflag(x) = T_SYMBOL | T_SYNTAX;
+ setimmutable(car(x));
+ y = mk_tagged_value(sc, x, mk_integer(sc, op), sc->NIL);
+ free_cell(sc, x);
+ setimmutable(get_tag(sc, y));
+ *slot = immutable_cons(sc, y, *slot);
+}
+
+/* Returns the opcode for the syntax represented by P. */
+static int syntaxnum(scheme *sc, pointer p) {
+ int op = ivalue_unchecked(car(get_tag(sc, p)));
+ assert (op < OP_MAXDEFINED);
+ return op;
}
-static void assign_proc(scheme *sc, enum scheme_opcodes op, char *name) {
+static void assign_proc(scheme *sc, enum scheme_opcodes op, const char *name) {
pointer x, y;
x = mk_symbol(sc, name);
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 immutable_cons(sc,a,b);
}
-static struct scheme_interface vtbl ={
+static const struct scheme_interface vtbl = {
scheme_define,
s_cons,
s_immutable_cons,
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;
-#if USE_SMALL_INTEGERS
- if (initialize_small_integers(sc)) {
- sc->no_memory=1;
- return 0;
- }
-#endif
-
sc->free_cell = &sc->_NIL;
sc->fcells = 0;
sc->inhibit_gc = GC_ENABLED;
}
sc->strbuff_size = STRBUFFSIZE;
+ sc->cell_segments = NULL;
if (alloc_cellseg(sc,FIRST_CELLSEGS) != FIRST_CELLSEGS) {
sc->no_memory=1;
return 0;
dump_stack_initialize(sc);
sc->code = sc->NIL;
sc->tracing=0;
- sc->op = -1;
sc->flags = 0;
/* init sc->NIL */
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");
+ assign_syntax(sc, OP_LAMBDA, "lambda");
+ assign_syntax(sc, OP_QUOTE, "quote");
+ assign_syntax(sc, OP_DEF0, "define");
+ assign_syntax(sc, OP_IF0, "if");
+ assign_syntax(sc, OP_BEGIN, "begin");
+ assign_syntax(sc, OP_SET0, "set!");
+ assign_syntax(sc, OP_LET0, "let");
+ assign_syntax(sc, OP_LET0AST, "let*");
+ assign_syntax(sc, OP_LET0REC, "letrec");
+ assign_syntax(sc, OP_COND0, "cond");
+ assign_syntax(sc, OP_DELAY, "delay");
+ assign_syntax(sc, OP_AND0, "and");
+ assign_syntax(sc, OP_OR0, "or");
+ assign_syntax(sc, OP_C0STREAM, "cons-stream");
+ assign_syntax(sc, OP_MACRO0, "macro");
+ assign_syntax(sc, OP_CASE0, "case");
for(i=0; i<n; i++) {
- if(dispatch_table[i].name!=0) {
+ if (dispatch_table[i].name[0] != 0) {
assign_proc(sc, (enum scheme_opcodes)i, dispatch_table[i].name);
}
}
}
void scheme_deinit(scheme *sc) {
+ struct cell_segment *s;
int i;
sc->oblist=sc->NIL;
sc->gc_verbose=0;
gc(sc,sc->NIL,sc->NIL);
-#if USE_SMALL_INTEGERS
- sc->free(sc->integer_alloc);
-#endif
-
- for(i=0; i<=sc->last_cell_seg; i++) {
- sc->free(sc->alloc_seg[i]);
+ for (s = sc->cell_segments; s; s = _dealloc_cellseg(sc, s)) {
+ /* nop */
}
sc->free(sc->strbuff);
}
}
void scheme_load_string(scheme *sc, const char *cmd) {
+ scheme_load_memory(sc, cmd, strlen(cmd), NULL);
+}
+
+void scheme_load_memory(scheme *sc, const char *buf, size_t len, const char *filename) {
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;
- port_init_location(sc, &sc->load_stack[0], NULL);
+ sc->load_stack[0].rep.string.start = (char *) buf; /* This func respects const */
+ sc->load_stack[0].rep.string.past_the_end = (char *) buf + len;
+ sc->load_stack[0].rep.string.curr = (char *) buf;
+ port_init_location(sc, &sc->load_stack[0], filename ? mk_string(sc, filename) : NULL);
sc->loadport=mk_port(sc,sc->load_stack);
sc->retcode=0;
sc->interactive_repl=0;
# define USE_DL 0
# define USE_PLIST 0
# define USE_SMALL_INTEGERS 0
-# define USE_TAGS 0
# define USE_HISTORY 0
#endif
# define USE_PLIST 0
#endif
-/* If set, then every object can be tagged. */
-#ifndef USE_TAGS
-# define USE_TAGS 1
-#endif
-
/* Keep a history of function calls. This enables a feature similar
* to stack traces. */
#ifndef USE_HISTORY
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 void scheme_load_memory(scheme *sc, const char *buf, size_t len,
+ const char *filename);
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);
--- /dev/null
+/* Constant integer objects for TinySCHEME.
+ *
+ * Copyright (C) 2017 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 <https://www.gnu.org/licenses/>.
+ */
+
+/*
+ * Ohne Worte. Generated using:
+ *
+ * $ n=0; while read line ; do \
+ * echo "DEFINE_INTEGER($n)" ; \
+ * n="$(expr $n + 1)" ; \
+ * done <./init.scm >> small-integers.h
+ */
+
+DEFINE_INTEGER(0)
+DEFINE_INTEGER(1)
+DEFINE_INTEGER(2)
+DEFINE_INTEGER(3)
+DEFINE_INTEGER(4)
+DEFINE_INTEGER(5)
+DEFINE_INTEGER(6)
+DEFINE_INTEGER(7)
+DEFINE_INTEGER(8)
+DEFINE_INTEGER(9)
+DEFINE_INTEGER(10)
+DEFINE_INTEGER(11)
+DEFINE_INTEGER(12)
+DEFINE_INTEGER(13)
+DEFINE_INTEGER(14)
+DEFINE_INTEGER(15)
+DEFINE_INTEGER(16)
+DEFINE_INTEGER(17)
+DEFINE_INTEGER(18)
+DEFINE_INTEGER(19)
+DEFINE_INTEGER(20)
+DEFINE_INTEGER(21)
+DEFINE_INTEGER(22)
+DEFINE_INTEGER(23)
+DEFINE_INTEGER(24)
+DEFINE_INTEGER(25)
+DEFINE_INTEGER(26)
+DEFINE_INTEGER(27)
+DEFINE_INTEGER(28)
+DEFINE_INTEGER(29)
+DEFINE_INTEGER(30)
+DEFINE_INTEGER(31)
+DEFINE_INTEGER(32)
+DEFINE_INTEGER(33)
+DEFINE_INTEGER(34)
+DEFINE_INTEGER(35)
+DEFINE_INTEGER(36)
+DEFINE_INTEGER(37)
+DEFINE_INTEGER(38)
+DEFINE_INTEGER(39)
+DEFINE_INTEGER(40)
+DEFINE_INTEGER(41)
+DEFINE_INTEGER(42)
+DEFINE_INTEGER(43)
+DEFINE_INTEGER(44)
+DEFINE_INTEGER(45)
+DEFINE_INTEGER(46)
+DEFINE_INTEGER(47)
+DEFINE_INTEGER(48)
+DEFINE_INTEGER(49)
+DEFINE_INTEGER(50)
+DEFINE_INTEGER(51)
+DEFINE_INTEGER(52)
+DEFINE_INTEGER(53)
+DEFINE_INTEGER(54)
+DEFINE_INTEGER(55)
+DEFINE_INTEGER(56)
+DEFINE_INTEGER(57)
+DEFINE_INTEGER(58)
+DEFINE_INTEGER(59)
+DEFINE_INTEGER(60)
+DEFINE_INTEGER(61)
+DEFINE_INTEGER(62)
+DEFINE_INTEGER(63)
+DEFINE_INTEGER(64)
+DEFINE_INTEGER(65)
+DEFINE_INTEGER(66)
+DEFINE_INTEGER(67)
+DEFINE_INTEGER(68)
+DEFINE_INTEGER(69)
+DEFINE_INTEGER(70)
+DEFINE_INTEGER(71)
+DEFINE_INTEGER(72)
+DEFINE_INTEGER(73)
+DEFINE_INTEGER(74)
+DEFINE_INTEGER(75)
+DEFINE_INTEGER(76)
+DEFINE_INTEGER(77)
+DEFINE_INTEGER(78)
+DEFINE_INTEGER(79)
+DEFINE_INTEGER(80)
+DEFINE_INTEGER(81)
+DEFINE_INTEGER(82)
+DEFINE_INTEGER(83)
+DEFINE_INTEGER(84)
+DEFINE_INTEGER(85)
+DEFINE_INTEGER(86)
+DEFINE_INTEGER(87)
+DEFINE_INTEGER(88)
+DEFINE_INTEGER(89)
+DEFINE_INTEGER(90)
+DEFINE_INTEGER(91)
+DEFINE_INTEGER(92)
+DEFINE_INTEGER(93)
+DEFINE_INTEGER(94)
+DEFINE_INTEGER(95)
+DEFINE_INTEGER(96)
+DEFINE_INTEGER(97)
+DEFINE_INTEGER(98)
+DEFINE_INTEGER(99)
+DEFINE_INTEGER(100)
+DEFINE_INTEGER(101)
+DEFINE_INTEGER(102)
+DEFINE_INTEGER(103)
+DEFINE_INTEGER(104)
+DEFINE_INTEGER(105)
+DEFINE_INTEGER(106)
+DEFINE_INTEGER(107)
+DEFINE_INTEGER(108)
+DEFINE_INTEGER(109)
+DEFINE_INTEGER(110)
+DEFINE_INTEGER(111)
+DEFINE_INTEGER(112)
+DEFINE_INTEGER(113)
+DEFINE_INTEGER(114)
+DEFINE_INTEGER(115)
+DEFINE_INTEGER(116)
+DEFINE_INTEGER(117)
+DEFINE_INTEGER(118)
+DEFINE_INTEGER(119)
+DEFINE_INTEGER(120)
+DEFINE_INTEGER(121)
+DEFINE_INTEGER(122)
+DEFINE_INTEGER(123)
+DEFINE_INTEGER(124)
+DEFINE_INTEGER(125)
+DEFINE_INTEGER(126)
+DEFINE_INTEGER(127)
+DEFINE_INTEGER(128)
+DEFINE_INTEGER(129)
+DEFINE_INTEGER(130)
+DEFINE_INTEGER(131)
+DEFINE_INTEGER(132)
+DEFINE_INTEGER(133)
+DEFINE_INTEGER(134)
+DEFINE_INTEGER(135)
+DEFINE_INTEGER(136)
+DEFINE_INTEGER(137)
+DEFINE_INTEGER(138)
+DEFINE_INTEGER(139)
+DEFINE_INTEGER(140)
+DEFINE_INTEGER(141)
+DEFINE_INTEGER(142)
+DEFINE_INTEGER(143)
+DEFINE_INTEGER(144)
+DEFINE_INTEGER(145)
+DEFINE_INTEGER(146)
+DEFINE_INTEGER(147)
+DEFINE_INTEGER(148)
+DEFINE_INTEGER(149)
+DEFINE_INTEGER(150)
+DEFINE_INTEGER(151)
+DEFINE_INTEGER(152)
+DEFINE_INTEGER(153)
+DEFINE_INTEGER(154)
+DEFINE_INTEGER(155)
+DEFINE_INTEGER(156)
+DEFINE_INTEGER(157)
+DEFINE_INTEGER(158)
+DEFINE_INTEGER(159)
+DEFINE_INTEGER(160)
+DEFINE_INTEGER(161)
+DEFINE_INTEGER(162)
+DEFINE_INTEGER(163)
+DEFINE_INTEGER(164)
+DEFINE_INTEGER(165)
+DEFINE_INTEGER(166)
+DEFINE_INTEGER(167)
+DEFINE_INTEGER(168)
+DEFINE_INTEGER(169)
+DEFINE_INTEGER(170)
+DEFINE_INTEGER(171)
+DEFINE_INTEGER(172)
+DEFINE_INTEGER(173)
+DEFINE_INTEGER(174)
+DEFINE_INTEGER(175)
+DEFINE_INTEGER(176)
+DEFINE_INTEGER(177)
+DEFINE_INTEGER(178)
+DEFINE_INTEGER(179)
+DEFINE_INTEGER(180)
+DEFINE_INTEGER(181)
+DEFINE_INTEGER(182)
+DEFINE_INTEGER(183)
+DEFINE_INTEGER(184)
+DEFINE_INTEGER(185)
+DEFINE_INTEGER(186)
+DEFINE_INTEGER(187)
+DEFINE_INTEGER(188)
+DEFINE_INTEGER(189)
+DEFINE_INTEGER(190)
+DEFINE_INTEGER(191)
+DEFINE_INTEGER(192)
+DEFINE_INTEGER(193)
+DEFINE_INTEGER(194)
+DEFINE_INTEGER(195)
+DEFINE_INTEGER(196)
+DEFINE_INTEGER(197)
+DEFINE_INTEGER(198)
+DEFINE_INTEGER(199)
+DEFINE_INTEGER(200)
+DEFINE_INTEGER(201)
+DEFINE_INTEGER(202)
+DEFINE_INTEGER(203)
+DEFINE_INTEGER(204)
+DEFINE_INTEGER(205)
+DEFINE_INTEGER(206)
+DEFINE_INTEGER(207)
+DEFINE_INTEGER(208)
+DEFINE_INTEGER(209)
+DEFINE_INTEGER(210)
+DEFINE_INTEGER(211)
+DEFINE_INTEGER(212)
+DEFINE_INTEGER(213)
+DEFINE_INTEGER(214)
+DEFINE_INTEGER(215)
+DEFINE_INTEGER(216)
+DEFINE_INTEGER(217)
+DEFINE_INTEGER(218)
+DEFINE_INTEGER(219)
+DEFINE_INTEGER(220)
+DEFINE_INTEGER(221)
+DEFINE_INTEGER(222)
+DEFINE_INTEGER(223)
+DEFINE_INTEGER(224)
+DEFINE_INTEGER(225)
+DEFINE_INTEGER(226)
+DEFINE_INTEGER(227)
+DEFINE_INTEGER(228)
+DEFINE_INTEGER(229)
+DEFINE_INTEGER(230)
+DEFINE_INTEGER(231)
+DEFINE_INTEGER(232)
+DEFINE_INTEGER(233)
+DEFINE_INTEGER(234)
+DEFINE_INTEGER(235)
+DEFINE_INTEGER(236)
+DEFINE_INTEGER(237)
+DEFINE_INTEGER(238)
+DEFINE_INTEGER(239)
+DEFINE_INTEGER(240)
+DEFINE_INTEGER(241)
+DEFINE_INTEGER(242)
+DEFINE_INTEGER(243)
+DEFINE_INTEGER(244)
+DEFINE_INTEGER(245)
+DEFINE_INTEGER(246)
+DEFINE_INTEGER(247)
+DEFINE_INTEGER(248)
+DEFINE_INTEGER(249)
+DEFINE_INTEGER(250)
+DEFINE_INTEGER(251)
+DEFINE_INTEGER(252)
+DEFINE_INTEGER(253)
+DEFINE_INTEGER(254)
+DEFINE_INTEGER(255)
+DEFINE_INTEGER(256)
+DEFINE_INTEGER(257)
+DEFINE_INTEGER(258)
+DEFINE_INTEGER(259)
+DEFINE_INTEGER(260)
+DEFINE_INTEGER(261)
+DEFINE_INTEGER(262)
+DEFINE_INTEGER(263)
+DEFINE_INTEGER(264)
+DEFINE_INTEGER(265)
+DEFINE_INTEGER(266)
+DEFINE_INTEGER(267)
+DEFINE_INTEGER(268)
+DEFINE_INTEGER(269)
+DEFINE_INTEGER(270)
+DEFINE_INTEGER(271)
+DEFINE_INTEGER(272)
+DEFINE_INTEGER(273)
+DEFINE_INTEGER(274)
+DEFINE_INTEGER(275)
+DEFINE_INTEGER(276)
+DEFINE_INTEGER(277)
+DEFINE_INTEGER(278)
+DEFINE_INTEGER(279)
+DEFINE_INTEGER(280)
+DEFINE_INTEGER(281)
+DEFINE_INTEGER(282)
+DEFINE_INTEGER(283)
+DEFINE_INTEGER(284)
+DEFINE_INTEGER(285)
+DEFINE_INTEGER(286)
+DEFINE_INTEGER(287)
+DEFINE_INTEGER(288)
+DEFINE_INTEGER(289)
+DEFINE_INTEGER(290)
+DEFINE_INTEGER(291)
+DEFINE_INTEGER(292)
+DEFINE_INTEGER(293)
+DEFINE_INTEGER(294)
+DEFINE_INTEGER(295)
+DEFINE_INTEGER(296)
+DEFINE_INTEGER(297)
+DEFINE_INTEGER(298)
+DEFINE_INTEGER(299)
+DEFINE_INTEGER(300)
+DEFINE_INTEGER(301)
+DEFINE_INTEGER(302)
+DEFINE_INTEGER(303)
+DEFINE_INTEGER(304)
+DEFINE_INTEGER(305)
+DEFINE_INTEGER(306)
+DEFINE_INTEGER(307)
+DEFINE_INTEGER(308)
+DEFINE_INTEGER(309)
+DEFINE_INTEGER(310)
+DEFINE_INTEGER(311)
+DEFINE_INTEGER(312)
+DEFINE_INTEGER(313)
+DEFINE_INTEGER(314)
+DEFINE_INTEGER(315)
+DEFINE_INTEGER(316)
+DEFINE_INTEGER(317)
+DEFINE_INTEGER(318)
+DEFINE_INTEGER(319)
+DEFINE_INTEGER(320)
+DEFINE_INTEGER(321)
+DEFINE_INTEGER(322)
+DEFINE_INTEGER(323)
+DEFINE_INTEGER(324)
+DEFINE_INTEGER(325)
+DEFINE_INTEGER(326)
+DEFINE_INTEGER(327)
+DEFINE_INTEGER(328)
+DEFINE_INTEGER(329)
+DEFINE_INTEGER(330)
+DEFINE_INTEGER(331)
+DEFINE_INTEGER(332)
+DEFINE_INTEGER(333)
+DEFINE_INTEGER(334)
+DEFINE_INTEGER(335)
+DEFINE_INTEGER(336)
+DEFINE_INTEGER(337)
+DEFINE_INTEGER(338)
+DEFINE_INTEGER(339)
+DEFINE_INTEGER(340)
+DEFINE_INTEGER(341)
+DEFINE_INTEGER(342)
+DEFINE_INTEGER(343)
+DEFINE_INTEGER(344)
+DEFINE_INTEGER(345)
+DEFINE_INTEGER(346)
+DEFINE_INTEGER(347)
+DEFINE_INTEGER(348)
+DEFINE_INTEGER(349)
+DEFINE_INTEGER(350)
+DEFINE_INTEGER(351)
+DEFINE_INTEGER(352)
+DEFINE_INTEGER(353)
+DEFINE_INTEGER(354)
+DEFINE_INTEGER(355)
+DEFINE_INTEGER(356)
+DEFINE_INTEGER(357)
+DEFINE_INTEGER(358)
+DEFINE_INTEGER(359)
+DEFINE_INTEGER(360)
+DEFINE_INTEGER(361)
+DEFINE_INTEGER(362)
+DEFINE_INTEGER(363)
+DEFINE_INTEGER(364)
+DEFINE_INTEGER(365)
+DEFINE_INTEGER(366)
+DEFINE_INTEGER(367)
+DEFINE_INTEGER(368)
+DEFINE_INTEGER(369)
+DEFINE_INTEGER(370)
+DEFINE_INTEGER(371)
+DEFINE_INTEGER(372)
+DEFINE_INTEGER(373)
+DEFINE_INTEGER(374)
+DEFINE_INTEGER(375)
+DEFINE_INTEGER(376)
+DEFINE_INTEGER(377)
+DEFINE_INTEGER(378)
+DEFINE_INTEGER(379)
+DEFINE_INTEGER(380)
+DEFINE_INTEGER(381)
+DEFINE_INTEGER(382)
+DEFINE_INTEGER(383)
+DEFINE_INTEGER(384)
+DEFINE_INTEGER(385)
+DEFINE_INTEGER(386)
+DEFINE_INTEGER(387)
+DEFINE_INTEGER(388)
+DEFINE_INTEGER(389)
+DEFINE_INTEGER(390)
+DEFINE_INTEGER(391)
+DEFINE_INTEGER(392)
+DEFINE_INTEGER(393)
+DEFINE_INTEGER(394)
+DEFINE_INTEGER(395)
+DEFINE_INTEGER(396)
+DEFINE_INTEGER(397)
+DEFINE_INTEGER(398)
+DEFINE_INTEGER(399)
+DEFINE_INTEGER(400)
+DEFINE_INTEGER(401)
+DEFINE_INTEGER(402)
+DEFINE_INTEGER(403)
+DEFINE_INTEGER(404)
+DEFINE_INTEGER(405)
+DEFINE_INTEGER(406)
+DEFINE_INTEGER(407)
+DEFINE_INTEGER(408)
+DEFINE_INTEGER(409)
+DEFINE_INTEGER(410)
+DEFINE_INTEGER(411)
+DEFINE_INTEGER(412)
+DEFINE_INTEGER(413)
+DEFINE_INTEGER(414)
+DEFINE_INTEGER(415)
+DEFINE_INTEGER(416)
+DEFINE_INTEGER(417)
+DEFINE_INTEGER(418)
+DEFINE_INTEGER(419)
+DEFINE_INTEGER(420)
+DEFINE_INTEGER(421)
+DEFINE_INTEGER(422)
+DEFINE_INTEGER(423)
+DEFINE_INTEGER(424)
+DEFINE_INTEGER(425)
+DEFINE_INTEGER(426)
+DEFINE_INTEGER(427)
+DEFINE_INTEGER(428)
+DEFINE_INTEGER(429)
+DEFINE_INTEGER(430)
+DEFINE_INTEGER(431)
+DEFINE_INTEGER(432)
+DEFINE_INTEGER(433)
+DEFINE_INTEGER(434)
+DEFINE_INTEGER(435)
+DEFINE_INTEGER(436)
+DEFINE_INTEGER(437)
+DEFINE_INTEGER(438)
+DEFINE_INTEGER(439)
+DEFINE_INTEGER(440)
+DEFINE_INTEGER(441)
+DEFINE_INTEGER(442)
+DEFINE_INTEGER(443)
+DEFINE_INTEGER(444)
+DEFINE_INTEGER(445)
+DEFINE_INTEGER(446)
+DEFINE_INTEGER(447)
+DEFINE_INTEGER(448)
+DEFINE_INTEGER(449)
+DEFINE_INTEGER(450)
+DEFINE_INTEGER(451)
+DEFINE_INTEGER(452)
+DEFINE_INTEGER(453)
+DEFINE_INTEGER(454)
+DEFINE_INTEGER(455)
+DEFINE_INTEGER(456)
+DEFINE_INTEGER(457)
+DEFINE_INTEGER(458)
+DEFINE_INTEGER(459)
+DEFINE_INTEGER(460)
+DEFINE_INTEGER(461)
+DEFINE_INTEGER(462)
+DEFINE_INTEGER(463)
+DEFINE_INTEGER(464)
+DEFINE_INTEGER(465)
+DEFINE_INTEGER(466)
+DEFINE_INTEGER(467)
+DEFINE_INTEGER(468)
+DEFINE_INTEGER(469)
+DEFINE_INTEGER(470)
+DEFINE_INTEGER(471)
+DEFINE_INTEGER(472)
+DEFINE_INTEGER(473)
+DEFINE_INTEGER(474)
+DEFINE_INTEGER(475)
+DEFINE_INTEGER(476)
+DEFINE_INTEGER(477)
+DEFINE_INTEGER(478)
+DEFINE_INTEGER(479)
+DEFINE_INTEGER(480)
+DEFINE_INTEGER(481)
+DEFINE_INTEGER(482)
+DEFINE_INTEGER(483)
+DEFINE_INTEGER(484)
+DEFINE_INTEGER(485)
+DEFINE_INTEGER(486)
+DEFINE_INTEGER(487)
+DEFINE_INTEGER(488)
+DEFINE_INTEGER(489)
+DEFINE_INTEGER(490)
+DEFINE_INTEGER(491)
+DEFINE_INTEGER(492)
+DEFINE_INTEGER(493)
+DEFINE_INTEGER(494)
+DEFINE_INTEGER(495)
+DEFINE_INTEGER(496)
+DEFINE_INTEGER(497)
+DEFINE_INTEGER(498)
+DEFINE_INTEGER(499)
+DEFINE_INTEGER(500)
+DEFINE_INTEGER(501)
+DEFINE_INTEGER(502)
+DEFINE_INTEGER(503)
+DEFINE_INTEGER(504)
+DEFINE_INTEGER(505)
+DEFINE_INTEGER(506)
+DEFINE_INTEGER(507)
+DEFINE_INTEGER(508)
+DEFINE_INTEGER(509)
+DEFINE_INTEGER(510)
+DEFINE_INTEGER(511)
+DEFINE_INTEGER(512)
+DEFINE_INTEGER(513)
+DEFINE_INTEGER(514)
+DEFINE_INTEGER(515)
+DEFINE_INTEGER(516)
+DEFINE_INTEGER(517)
+DEFINE_INTEGER(518)
+DEFINE_INTEGER(519)
+DEFINE_INTEGER(520)
+DEFINE_INTEGER(521)
+DEFINE_INTEGER(522)
+DEFINE_INTEGER(523)
+DEFINE_INTEGER(524)
+DEFINE_INTEGER(525)
+DEFINE_INTEGER(526)
+DEFINE_INTEGER(527)
+DEFINE_INTEGER(528)
+DEFINE_INTEGER(529)
+DEFINE_INTEGER(530)
+DEFINE_INTEGER(531)
+DEFINE_INTEGER(532)
+DEFINE_INTEGER(533)
+DEFINE_INTEGER(534)
+DEFINE_INTEGER(535)
+DEFINE_INTEGER(536)
+DEFINE_INTEGER(537)
+DEFINE_INTEGER(538)
+DEFINE_INTEGER(539)
+DEFINE_INTEGER(540)
+DEFINE_INTEGER(541)
+DEFINE_INTEGER(542)
+DEFINE_INTEGER(543)
+DEFINE_INTEGER(544)
+DEFINE_INTEGER(545)
+DEFINE_INTEGER(546)
+DEFINE_INTEGER(547)
+DEFINE_INTEGER(548)
+DEFINE_INTEGER(549)
+DEFINE_INTEGER(550)
+DEFINE_INTEGER(551)
+DEFINE_INTEGER(552)
+DEFINE_INTEGER(553)
+DEFINE_INTEGER(554)
+DEFINE_INTEGER(555)
+DEFINE_INTEGER(556)
+DEFINE_INTEGER(557)
+DEFINE_INTEGER(558)
+DEFINE_INTEGER(559)
+DEFINE_INTEGER(560)
+DEFINE_INTEGER(561)
+DEFINE_INTEGER(562)
+DEFINE_INTEGER(563)
+DEFINE_INTEGER(564)
+DEFINE_INTEGER(565)
+DEFINE_INTEGER(566)
+DEFINE_INTEGER(567)
+DEFINE_INTEGER(568)
+DEFINE_INTEGER(569)
+DEFINE_INTEGER(570)
+DEFINE_INTEGER(571)
+DEFINE_INTEGER(572)
+DEFINE_INTEGER(573)
+DEFINE_INTEGER(574)
+DEFINE_INTEGER(575)
+DEFINE_INTEGER(576)
+DEFINE_INTEGER(577)
+DEFINE_INTEGER(578)
+DEFINE_INTEGER(579)
+DEFINE_INTEGER(580)
+DEFINE_INTEGER(581)
+DEFINE_INTEGER(582)
+DEFINE_INTEGER(583)
+DEFINE_INTEGER(584)
+DEFINE_INTEGER(585)
+DEFINE_INTEGER(586)
+DEFINE_INTEGER(587)
+DEFINE_INTEGER(588)
+DEFINE_INTEGER(589)
+DEFINE_INTEGER(590)
+DEFINE_INTEGER(591)
+DEFINE_INTEGER(592)
+DEFINE_INTEGER(593)
+DEFINE_INTEGER(594)
+DEFINE_INTEGER(595)
+DEFINE_INTEGER(596)
+DEFINE_INTEGER(597)
+DEFINE_INTEGER(598)
+DEFINE_INTEGER(599)
+DEFINE_INTEGER(600)
+DEFINE_INTEGER(601)
+DEFINE_INTEGER(602)
+DEFINE_INTEGER(603)
+DEFINE_INTEGER(604)
+DEFINE_INTEGER(605)
+DEFINE_INTEGER(606)
+DEFINE_INTEGER(607)
+DEFINE_INTEGER(608)
+DEFINE_INTEGER(609)
+DEFINE_INTEGER(610)
+DEFINE_INTEGER(611)
+DEFINE_INTEGER(612)
+DEFINE_INTEGER(613)
+DEFINE_INTEGER(614)
+DEFINE_INTEGER(615)
+DEFINE_INTEGER(616)
+DEFINE_INTEGER(617)
+DEFINE_INTEGER(618)
+DEFINE_INTEGER(619)
+DEFINE_INTEGER(620)
+DEFINE_INTEGER(621)
+DEFINE_INTEGER(622)
+DEFINE_INTEGER(623)
+DEFINE_INTEGER(624)
+DEFINE_INTEGER(625)
+DEFINE_INTEGER(626)
+DEFINE_INTEGER(627)
+DEFINE_INTEGER(628)
+DEFINE_INTEGER(629)
+DEFINE_INTEGER(630)
+DEFINE_INTEGER(631)
+DEFINE_INTEGER(632)
+DEFINE_INTEGER(633)
+DEFINE_INTEGER(634)
+DEFINE_INTEGER(635)
+DEFINE_INTEGER(636)
+DEFINE_INTEGER(637)
+DEFINE_INTEGER(638)
+DEFINE_INTEGER(639)
+DEFINE_INTEGER(640)
+DEFINE_INTEGER(641)
+DEFINE_INTEGER(642)
+DEFINE_INTEGER(643)
+DEFINE_INTEGER(644)
+DEFINE_INTEGER(645)
+DEFINE_INTEGER(646)
+DEFINE_INTEGER(647)
+DEFINE_INTEGER(648)
+DEFINE_INTEGER(649)
+DEFINE_INTEGER(650)
+DEFINE_INTEGER(651)
+DEFINE_INTEGER(652)
+DEFINE_INTEGER(653)
+DEFINE_INTEGER(654)
+DEFINE_INTEGER(655)
+DEFINE_INTEGER(656)
+DEFINE_INTEGER(657)
+DEFINE_INTEGER(658)
+DEFINE_INTEGER(659)
+DEFINE_INTEGER(660)
+DEFINE_INTEGER(661)
+DEFINE_INTEGER(662)
+DEFINE_INTEGER(663)
+DEFINE_INTEGER(664)
+DEFINE_INTEGER(665)
+DEFINE_INTEGER(666)
+DEFINE_INTEGER(667)
+DEFINE_INTEGER(668)
+DEFINE_INTEGER(669)
+DEFINE_INTEGER(670)
+DEFINE_INTEGER(671)
+DEFINE_INTEGER(672)
+DEFINE_INTEGER(673)
+DEFINE_INTEGER(674)
+DEFINE_INTEGER(675)
+DEFINE_INTEGER(676)
+DEFINE_INTEGER(677)
+DEFINE_INTEGER(678)
+DEFINE_INTEGER(679)
+DEFINE_INTEGER(680)
+DEFINE_INTEGER(681)
+DEFINE_INTEGER(682)
+DEFINE_INTEGER(683)
+DEFINE_INTEGER(684)
+DEFINE_INTEGER(685)
+DEFINE_INTEGER(686)
+DEFINE_INTEGER(687)
+DEFINE_INTEGER(688)
+DEFINE_INTEGER(689)
+DEFINE_INTEGER(690)
+DEFINE_INTEGER(691)
+DEFINE_INTEGER(692)
+DEFINE_INTEGER(693)
+DEFINE_INTEGER(694)
+DEFINE_INTEGER(695)
+DEFINE_INTEGER(696)
+DEFINE_INTEGER(697)
+DEFINE_INTEGER(698)
+DEFINE_INTEGER(699)
+DEFINE_INTEGER(700)
+DEFINE_INTEGER(701)
+DEFINE_INTEGER(702)
+DEFINE_INTEGER(703)
+DEFINE_INTEGER(704)
+DEFINE_INTEGER(705)
+DEFINE_INTEGER(706)
+DEFINE_INTEGER(707)
+DEFINE_INTEGER(708)
+DEFINE_INTEGER(709)
+DEFINE_INTEGER(710)
+DEFINE_INTEGER(711)
+DEFINE_INTEGER(712)
+DEFINE_INTEGER(713)
+DEFINE_INTEGER(714)
+DEFINE_INTEGER(715)
+DEFINE_INTEGER(716)
+DEFINE_INTEGER(717)
+DEFINE_INTEGER(718)
+DEFINE_INTEGER(719)
+DEFINE_INTEGER(720)
+DEFINE_INTEGER(721)
+DEFINE_INTEGER(722)
+DEFINE_INTEGER(723)
+DEFINE_INTEGER(724)
+DEFINE_INTEGER(725)
+DEFINE_INTEGER(726)
+DEFINE_INTEGER(727)
+DEFINE_INTEGER(728)
+DEFINE_INTEGER(729)
+DEFINE_INTEGER(730)
+DEFINE_INTEGER(731)
+DEFINE_INTEGER(732)
+DEFINE_INTEGER(733)
+DEFINE_INTEGER(734)
+DEFINE_INTEGER(735)
+DEFINE_INTEGER(736)
+DEFINE_INTEGER(737)
+DEFINE_INTEGER(738)
+DEFINE_INTEGER(739)
+DEFINE_INTEGER(740)
+DEFINE_INTEGER(741)
+DEFINE_INTEGER(742)
+DEFINE_INTEGER(743)
+DEFINE_INTEGER(744)
+DEFINE_INTEGER(745)
+DEFINE_INTEGER(746)
+DEFINE_INTEGER(747)
+DEFINE_INTEGER(748)
+DEFINE_INTEGER(749)
+DEFINE_INTEGER(750)
+DEFINE_INTEGER(751)
+DEFINE_INTEGER(752)
+DEFINE_INTEGER(753)
+DEFINE_INTEGER(754)
+DEFINE_INTEGER(755)
+DEFINE_INTEGER(756)
+DEFINE_INTEGER(757)
+DEFINE_INTEGER(758)
+DEFINE_INTEGER(759)
+DEFINE_INTEGER(760)
+DEFINE_INTEGER(761)
+DEFINE_INTEGER(762)
+DEFINE_INTEGER(763)
+DEFINE_INTEGER(764)
+DEFINE_INTEGER(765)
+DEFINE_INTEGER(766)
+DEFINE_INTEGER(767)
+DEFINE_INTEGER(768)
+DEFINE_INTEGER(769)
+DEFINE_INTEGER(770)
+DEFINE_INTEGER(771)
+DEFINE_INTEGER(772)
+DEFINE_INTEGER(773)
+DEFINE_INTEGER(774)
+DEFINE_INTEGER(775)
+DEFINE_INTEGER(776)
+DEFINE_INTEGER(777)
+DEFINE_INTEGER(778)
+DEFINE_INTEGER(779)
+DEFINE_INTEGER(780)
+DEFINE_INTEGER(781)
+DEFINE_INTEGER(782)
+DEFINE_INTEGER(783)
+DEFINE_INTEGER(784)
+DEFINE_INTEGER(785)
+DEFINE_INTEGER(786)
+DEFINE_INTEGER(787)
+DEFINE_INTEGER(788)
+DEFINE_INTEGER(789)
+DEFINE_INTEGER(790)
+DEFINE_INTEGER(791)
+DEFINE_INTEGER(792)
+DEFINE_INTEGER(793)
+DEFINE_INTEGER(794)
+DEFINE_INTEGER(795)
+DEFINE_INTEGER(796)
+DEFINE_INTEGER(797)
+DEFINE_INTEGER(798)
+DEFINE_INTEGER(799)
+DEFINE_INTEGER(800)
+DEFINE_INTEGER(801)
+DEFINE_INTEGER(802)
+DEFINE_INTEGER(803)
+DEFINE_INTEGER(804)
+DEFINE_INTEGER(805)
+DEFINE_INTEGER(806)
+DEFINE_INTEGER(807)
+DEFINE_INTEGER(808)
+DEFINE_INTEGER(809)
+DEFINE_INTEGER(810)
+DEFINE_INTEGER(811)
+DEFINE_INTEGER(812)
+DEFINE_INTEGER(813)
+DEFINE_INTEGER(814)
+DEFINE_INTEGER(815)
+DEFINE_INTEGER(816)
+DEFINE_INTEGER(817)
char buffer[4096];
memset (buffer, 'A', sizeof buffer);
#if _WIN32
- if (! setmode (stdin, O_BINARY))
+ if (! setmode (fileno (stdin), O_BINARY))
return 23;
- if (! setmode (stdout, O_BINARY))
+ if (! setmode (fileno (stdout), O_BINARY))
return 23;
#endif
(pipe:spawn `(,child stdout4096))
(pipe:spawn `(,child cat)))
(tr:call-with-content (lambda (c)
- (assert (= 4096 (length c))))))
+ (assert (= 4096 (string-length c))))))
(tr:do
(tr:pipe-do
(pipe:spawn `(,child stdout8192))
(pipe:spawn `(,child cat)))
(tr:call-with-content (lambda (c)
- (assert (= 8192 (length c))))))
+ (assert (= 8192 (string-length c))))))
(echo "All good.")
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-;; 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)
(es-fclose (:stdout h))
(es-fclose (:stderr h))
(if (> (*verbose*) 2)
- (begin
- (echo (stringify what) "returned:" result)
- (echo (stringify what) "wrote to stdout:" out)
- (echo (stringify what) "wrote to stderr:" err)))
+ (info "Child" (:pid h) "returned:"
+ `((command ,(stringify what))
+ (status ,result)
+ (stdout ,out)
+ (stderr ,err))))
(list result out err))))
;; Accessor function for the results of 'call-with-io'. ':stdout' and
(if (absolute-path? path) path (path-join (getcwd) path)))
(define (in-srcdir . names)
- (canonical-path (apply path-join (cons (getenv "srcdir") names))))
+ (canonical-path (apply path-join (cons (getenv "abs_top_srcdir") names))))
;; Try to find NAME in PATHS. Returns the full path name on success,
;; or raises an error.
(substring path 0 (- (string-length path) (string-length suffix)))
path)))
+(define (dirname path)
+ (let ((i (string-rindex path #\/)))
+ (if i (substring path 0 i) ".")))
+(assert (string=? "foo/bar" (dirname "foo/bar/baz")))
+
;; Helper for (pipe).
(define :read-end car)
(define :write-end cadr)
;; (letfd <bindings> <body>)
;;
;; Bind all variables given in <bindings> and initialize each of them
-;; to the given initial value, and close them after evaluting <body>.
+;; to the given initial value, and close them after evaluating <body>.
(define-macro (letfd bindings . body)
(let bind ((bindings' bindings))
(if (null? bindings')
;;
;; Bind all variables given in <bindings>, initialize each of them to
;; a string representing an unique path in the filesystem, and delete
-;; them after evaluting <body>.
+;; them after evaluating <body>.
(define-macro (lettmp bindings . body)
(let bind ((bindings' bindings))
(if (null? bindings')
(define (new procs)
(package
(define (add test)
- (new (cons test procs)))
+ (set! procs (cons test procs))
+ (current-environment))
+ (define (pid->test pid)
+ (let ((t (filter (lambda (x) (= pid x::pid)) procs)))
+ (if (null? t) #f (car t))))
(define (wait)
(let ((unfinished (filter (lambda (t) (not t::retcode)) procs)))
(if (null? unfinished)
- (package)
- (let* ((names (map (lambda (t) t::name) unfinished))
- (pids (map (lambda (t) t::pid) unfinished))
- (results
- (map (lambda (pid retcode) (list pid retcode))
- pids
- (wait-processes (map stringify names) 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))
+ (current-environment)
+ (let ((names (map (lambda (t) t::name) unfinished))
+ (pids (map (lambda (t) t::pid) unfinished)))
+ (for-each
+ (lambda (test retcode)
+ (test::set-end-time!)
+ (test:::set! 'retcode retcode))
+ (map pid->test pids)
+ (wait-processes (map stringify names) pids #t)))))
+ (current-environment))
+ (define (filter-tests status)
+ (filter (lambda (p) (eq? status (p::status))) procs))
(define (report)
(define (print-tests tests message)
(unless (null? tests)
(apply echo (cons message
(map (lambda (t) t::name) tests)))))
- (let ((failed' (failed)) (skipped' (skipped)))
+ (let ((failed (filter-tests 'FAIL))
+ (xfailed (filter-tests 'XFAIL))
+ (xpassed (filter-tests 'XPASS))
+ (skipped (filter-tests 'SKIP)))
(echo (length procs) "tests run,"
- (length (passed)) "succeeded,"
- (length failed') "failed,"
- (length skipped') "skipped.")
- (print-tests failed' "Failed tests:")
- (print-tests skipped' "Skipped tests:")
- (length failed')))))))
+ (length (filter-tests 'PASS)) "succeeded,"
+ (length failed) "failed,"
+ (length xfailed) "failed expectedly,"
+ (length xpassed) "succeeded unexpectedly,"
+ (length skipped) "skipped.")
+ (print-tests failed "Failed tests:")
+ (print-tests xfailed "Expectedly failed tests:")
+ (print-tests xpassed "Unexpectedly passed tests:")
+ (print-tests skipped "Skipped tests:")
+ (+ (length failed) (length xpassed))))
+
+ (define (xml)
+ (xx::document
+ (xx::tag 'testsuites
+ `((xmlns:xsi "http://www.w3.org/2001/XMLSchema-instance")
+ ("xsi:noNamespaceSchemaLocation"
+ "https://windyroad.com.au/dl/Open%20Source/JUnit.xsd"))
+ (map (lambda (t) (t::xml)) procs))))))))
(define (verbosity n)
(if (= 0 n) '() (cons '--verbose (verbosity (- n 1)))))
;; A single test.
(define test
+ (begin
+
+ ;; Private definitions.
+
+ (define (isotime->junit t)
+ "[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}"
+ "20170418T145809"
+ (string-append (substring t 0 4)
+ "-"
+ (substring t 4 6)
+ "-"
+ (substring t 6 11)
+ ":"
+ (substring t 11 13)
+ ":"
+ (substring t 13 15)))
+
+ ;; If a tests name ends with a bang (!), it is expected to fail.
+ (define (expect-failure? name)
+ (string-suffix? name "!"))
+ ;; Strips the bang (if any).
+ (define (test-name name)
+ (if (expect-failure? name)
+ (substring name 0 (- (string-length name) 1))
+ name))
+
(package
(define (scm setup name path . args)
;; Start the process.
(define (spawn-scm args' in out err)
(spawn-process-fd `(,*argv0* ,@(verbosity (*verbose*))
- ,(locate-test path)
+ ,(locate-test (test-name path))
,@(if setup (force setup) '())
,@args' ,@args) in out err))
- (new name #f spawn-scm #f #f CLOSED_FD))
+ (new name #f spawn-scm #f #f CLOSED_FD (expect-failure? name)))
(define (binary setup name path . args)
;; Start the process.
(define (spawn-binary args' in out err)
- (spawn-process-fd `(,path ,@(if setup (force setup) '()) ,@args' ,@args)
+ (spawn-process-fd `(,(test-name path)
+ ,@(if setup (force setup) '()) ,@args' ,@args)
in out err))
- (new name #f spawn-binary #f #f CLOSED_FD))
+ (new name #f spawn-binary #f #f CLOSED_FD (expect-failure? name)))
- (define (new name directory spawn pid retcode logfd)
+ (define (new name directory spawn pid retcode logfd expect-failure)
(package
- (define (set-directory x)
- (new name x spawn pid retcode logfd))
- (define (set-retcode x)
- (new name directory spawn pid x logfd))
- (define (set-pid x)
- (new name directory spawn x retcode logfd))
- (define (set-logfd x)
- (new name directory spawn pid retcode x))
+
+ ;; XXX: OO glue.
+ (define self (current-environment))
+ (define (:set! key value)
+ (eval `(set! ,key ,value) (current-environment))
+ (current-environment))
+
+ ;; The log is written here.
+ (define log-file-name #f)
+
+ ;; Record time stamps.
+ (define timestamp #f)
+ (define start-time 0)
+ (define end-time 0)
+
+ (define (set-start-time!)
+ (set! timestamp (isotime->junit (get-isotime)))
+ (set! start-time (get-time)))
+ (define (set-end-time!)
+ (set! end-time (get-time)))
+
(define (open-log-file)
- (let ((filename (string-append (basename name) ".log")))
- (catch '() (unlink filename))
- (open filename (logior O_RDWR O_BINARY O_CREAT) #o600)))
+ (unless log-file-name
+ (set! log-file-name (string-append (basename name) ".log")))
+ (catch '() (unlink log-file-name))
+ (open log-file-name (logior O_RDWR O_BINARY O_CREAT) #o600))
+
(define (run-sync . args)
+ (set-start-time!)
(letfd ((log (open-log-file)))
(with-working-directory directory
(let* ((p (inbound-pipe))
- (pid (spawn args 0 (:write-end p) (:write-end p))))
+ (pid' (spawn args 0 (:write-end p) (:write-end p))))
(close (:write-end p))
(splice (:read-end p) STDERR_FILENO log)
(close (:read-end p))
- (let ((t' (set-retcode (wait-process name pid #t))))
- (t'::report)
- t')))))
+ (set! pid pid')
+ (set! retcode (wait-process name pid' #t)))))
+ (report)
+ (current-environment))
(define (run-sync-quiet . args)
+ (set-start-time!)
(with-working-directory directory
- (set-retcode
- (wait-process
- name (spawn args CLOSED_FD CLOSED_FD CLOSED_FD) #t))))
+ (set! pid (spawn args CLOSED_FD CLOSED_FD CLOSED_FD)))
+ (set! retcode (wait-process name pid #t))
+ (set-end-time!)
+ (current-environment))
(define (run-async . args)
+ (set-start-time!)
(let ((log (open-log-file)))
(with-working-directory directory
- (new name directory spawn
- (spawn args CLOSED_FD log log)
- retcode log))))
+ (set! pid (spawn args CLOSED_FD log log)))
+ (set! logfd log))
+ (current-environment))
(define (status)
- (let ((t (assoc retcode '((0 "PASS") (77 "SKIP") (99 "ERROR")))))
- (if (not t) "FAIL" (cadr t))))
+ (let* ((t' (assoc retcode '((0 PASS) (77 SKIP) (99 ERROR))))
+ (t (if (not t') 'FAIL (cadr t'))))
+ (if expect-failure
+ (case t ((PASS) 'XPASS) ((FAIL) 'XFAIL) (else t))
+ t)))
+ (define (status-string)
+ (cadr (assoc (status) '((PASS "PASS")
+ (SKIP "SKIP")
+ (ERROR "ERROR")
+ (FAIL "FAIL")
+ (XPASS "XPASS")
+ (XFAIL "XFAIL")))))
(define (report)
(unless (= logfd CLOSED_FD)
(seek logfd 0 SEEK_SET)
(splice logfd STDERR_FILENO)
(close logfd))
- (echo (string-append (status) ":") name))))))
+ (echo (string-append (status-string) ":") name))
+
+ (define (xml)
+ (xx::tag
+ 'testsuite
+ `((name ,name)
+ (time ,(- end-time start-time))
+ (package ,(dirname name))
+ (id 0)
+ (timestamp ,timestamp)
+ (hostname "unknown")
+ (tests 1)
+ (failures ,(if (eq? FAIL (status)) 1 0))
+ (errors ,(if (eq? ERROR (status)) 1 0)))
+ (list
+ (xx::tag 'properties)
+ (xx::tag 'testcase
+ `((name ,(basename name))
+ (classname ,(string-translate (dirname name) "/" "."))
+ (time ,(- end-time start-time)))
+ `(,@(case (status)
+ ((PASS XFAIL) '())
+ ((SKIP) (list (xx::tag 'skipped)))
+ ((ERROR) (list
+ (xx::tag 'error '((message "Unknown error.")))))
+ (else
+ (list (xx::tag 'failure '((message "Unknown error."))))))))
+ (xx::tag 'system-out '()
+ (list (xx::textnode (read-all (open-input-file log-file-name)))))
+ (xx::tag 'system-err '() (list (xx::textnode "")))))))))))
;; Run the setup target to create an environment, then run all given
;; tests in parallel.
(if (null? tests')
(let ((results (pool::wait)))
(for-each (lambda (t) (t::report)) (reverse results::procs))
+ ((results::xml) (open-output-file "report.xml"))
(exit (results::report)))
- (let* ((wd (mkdtemp-autoremove))
- (test (car tests'))
- (test' (test::set-directory wd)))
- (loop (pool::add (test'::run-async))
+ (let ((wd (mkdtemp-autoremove))
+ (test (car tests')))
+ (test:::set! 'directory wd)
+ (loop (pool::add (test::run-async))
(cdr tests'))))))
;; Run the setup target to create an environment, then run all given
(let loop ((pool (test-pool::new '())) (tests' tests))
(if (null? tests')
(let ((results (pool::wait)))
+ ((results::xml) (open-output-file "report.xml"))
(exit (results::report)))
- (let* ((wd (mkdtemp-autoremove))
- (test (car tests'))
- (test' (test::set-directory wd)))
- (loop (pool::add (test'::run-sync))
+ (let ((wd (mkdtemp-autoremove))
+ (test (car tests')))
+ (test:::set! 'directory wd)
+ (loop (pool::add (test::run-sync))
(cdr tests'))))))
+;; Run tests either in sequence or in parallel, depending on the
+;; number of tests and the command line flags.
+(define (run-tests tests)
+ (if (and (flag "--parallel" *args*)
+ (> (length tests) 1))
+ (run-tests-parallel tests)
+ (run-tests-sequential tests)))
+
+;; Load all tests from the given path.
+(define (load-tests . path)
+ (load (apply in-srcdir `(,@path "all-tests.scm")))
+ all-tests)
+
;; Helper to create environment caches from test functions. SETUP
;; must be a test implementing the producer side cache protocol.
;; Returns a promise containing the arguments that must be passed to a
--- /dev/null
+;; A tiny XML library.
+;;
+;; Copyright (C) 2017 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 <http://www.gnu.org/licenses/>.
+
+(define xx
+ (begin
+
+ ;; Private declarations.
+ (define quote-text
+ '((#\< "<")
+ (#\> ">")
+ (#\& "&")))
+
+ (define quote-attribute-'
+ '((#\< "<")
+ (#\> ">")
+ (#\& "&")
+ (#\' "'")))
+
+ (define quote-attribute-''
+ '((#\< "<")
+ (#\> ">")
+ (#\& "&")
+ (#\" """)))
+
+ (define (escape-string quotation string sink)
+ ;; This implementation is a bit awkward because iteration is so
+ ;; slow in TinySCHEME. We rely on string-index to skip to the
+ ;; next character we need to escape. We also avoid allocations
+ ;; wherever possible.
+
+ ;; Given a list of integers or #f, return the sublist that
+ ;; starts with the lowest integer.
+ (define (min* x)
+ (let loop ((lowest x) (rest x))
+ (if (null? rest)
+ lowest
+ (loop (if (or (null? lowest) (not (car lowest))
+ (and (car rest) (> (car lowest) (car rest)))) rest lowest)
+ (cdr rest)))))
+
+ (let ((i 0) (start 0) (len (string-length string))
+ (indices (map (lambda (x) (string-index string (car x))) quotation))
+ (next #f) (c #f))
+
+ ;; Set 'i' to the index of the next character that needs
+ ;; escaping, 'c' to the character that needs to be escaped,
+ ;; and update 'indices'.
+ (define (skip!)
+ (set! next (min* indices))
+ (set! i (if (null? next) #f (car next)))
+ (if i
+ (begin
+ (set! c (string-ref string i))
+ (set-car! next (string-index string c (+ 1 i))))
+ (set! i (string-length string))))
+
+ (let loop ()
+ (skip!)
+ (if (< i len)
+ (begin
+ (display (substring string start i) sink)
+ (display (cadr (assv c quotation)) sink)
+ (set! i (+ 1 i))
+ (set! start i)
+ (loop))
+ (display (substring string start len) sink)))))
+
+ (let ((escape-string-s (lambda (quotation string)
+ (let ((sink (open-output-string)))
+ (escape-string quotation string sink)
+ (get-output-string sink)))))
+ (assert (equal? (escape-string-s quote-text "foo") "foo"))
+ (assert (equal? (escape-string-s quote-text "foo&") "foo&"))
+ (assert (equal? (escape-string-s quote-text "&foo") "&foo"))
+ (assert (equal? (escape-string-s quote-text "foo&bar") "foo&bar"))
+ (assert (equal? (escape-string-s quote-text "foo<bar") "foo<bar"))
+ (assert (equal? (escape-string-s quote-text "foo>bar") "foo>bar")))
+
+ (define (escape quotation datum sink)
+ (cond
+ ((string? datum) (escape-string quotation datum sink))
+ ((symbol? datum) (escape-string quotation (symbol->string datum) sink))
+ ((number? datum) (display (number->string datum) sink))
+ (else
+ (throw "Do not know how to encode" datum))))
+
+ (define (name->string name)
+ (cond
+ ((symbol? name) (symbol->string name))
+ (else name)))
+
+ (package
+
+ (define (textnode string)
+ (lambda (sink)
+ (escape quote-text string sink)))
+
+ (define (tag name . rest)
+ (let ((attributes (if (null? rest) '() (car rest)))
+ (children (if (> (length rest) 1) (cadr rest) '())))
+ (lambda (sink)
+ (display "<" sink)
+ (display (name->string name) sink)
+ (unless (null? attributes)
+ (display " " sink)
+ (for-each (lambda (a)
+ (display (car a) sink)
+ (display "=\"" sink)
+ (escape quote-attribute-'' (cadr a) sink)
+ (display "\" " sink)) attributes))
+ (if (null? children)
+ (display "/>\n" sink)
+ (begin
+ (display ">\n" sink)
+ (for-each (lambda (c) (c sink)) children)
+ (display "</" sink)
+ (display (name->string name) sink)
+ (display ">\n" sink))))))
+
+ (define (document root . rest)
+ (let ((attributes (if (null? rest) '() (car rest))))
+ (lambda (sink)
+ ;; xxx ignores attributes
+ (display "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" sink)
+ (root sink)
+ (newline sink)))))))
TESTS_ENVIRONMENT = LC_ALL=C \
EXEEXT=$(EXEEXT) \
PATH=../gpgscm:$(PATH) \
- srcdir=$(abs_srcdir) \
+ abs_top_srcdir=$(abs_top_srcdir) \
objdir=$(abs_top_builddir) \
- GPGSCM_PATH=$(abs_top_srcdir)/tests/gpgscm:$(abs_top_srcdir)/tests/openpgp:$(abs_top_srcdir)/tests/gpgsm
+ GPGSCM_PATH=$(abs_top_srcdir)/tests/gpgscm
XTESTS = \
import.scm \
.PHONY: xcheck
xcheck:
$(TESTS_ENVIRONMENT) $(abs_top_builddir)/tests/gpgscm/gpgscm \
- $(abs_srcdir)/run-tests.scm $(TESTFLAGS) $(XTESTS)
+ $(abs_srcdir)/run-tests.scm $(TESTFLAGS) $(TESTS)
KEYS = 32100C27173EF6E9C4E9A25D3D69F86D37A4F939
CERTS = cert_g10code_test1.der \
plain-large.cms.asc
EXTRA_DIST = $(XTESTS) $(KEYS) $(CERTS) $(TEST_FILES) \
- gpgsm-defs.scm run-tests.scm setup.scm
+ gpgsm-defs.scm run-tests.scm setup.scm all-tests.scm
-CLEANFILES = *.log
+CLEANFILES = *.log report.xml
# We need to depend on a couple of programs so that the tests don't
# start before all programs are built.
--- /dev/null
+;; Copyright (C) 2017 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 <http://www.gnu.org/licenses/>.
+
+(export all-tests
+ ;; Parse the Makefile.am to find all tests.
+
+ (load (with-path "makefile.scm"))
+
+ (define (expander filename port key)
+ (parse-makefile port key))
+
+ (define (parse filename key)
+ (parse-makefile-expand filename expander key))
+
+ (define setup
+ (make-environment-cache
+ (test::scm
+ #f
+ (path-join "tests" "gpgsm" "setup.scm")
+ (in-srcdir "tests" "gpgsm" "setup.scm")
+ "--" "tests" "gpg")))
+
+ (map (lambda (name)
+ (test::scm setup
+ (path-join "tests" "gpgsm" name)
+ (in-srcdir "tests" "gpgsm" name)))
+ (parse-makefile-expand (in-srcdir "tests" "gpgsm" "Makefile.am")
+ (lambda (filename port key) (parse-makefile port key))
+ "XTESTS")))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "gpgsm-defs.scm"))
+(load (in-srcdir "tests" "gpgsm" "gpgsm-defs.scm"))
(setup-gpgsm-environment)
(for-each-p
"Checking decryption of supplied files."
(lambda (name)
(tr:do
- (tr:open (in-srcdir (string-append name ".cms.asc")))
+ (tr:open (in-srcdir "tests" "gpgsm" (string-append name ".cms.asc")))
(tr:gpgsm "" '(--decrypt))
(tr:assert-identity name)))
plain-files)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "gpgsm-defs.scm"))
+(load (in-srcdir "tests" "gpgsm" "gpgsm-defs.scm"))
(setup-gpgsm-environment)
(for-each-p
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "gpgsm-defs.scm"))
+(load (in-srcdir "tests" "gpgsm" "gpgsm-defs.scm"))
(setup-gpgsm-environment)
(for-each-p'
(lambda (cert)
(lettmp (exported)
(call-check `(,@gpgsm --output ,exported --export ,cert::uid::CN))
- (with-ephemeral-home-directory
+ (with-ephemeral-home-directory setup-gpgsm-environment
(call-check `(,@gpgsm --import ,exported))
(assert (sm-have-public-key? cert)))))
(lambda (cert) cert::uid::CN)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
;; This is the list of certificates that we install in the test
;; environment.
(equal? key::fpr (:fpr l))))
(gpgsm-with-colons `(--list-secret-keys ,key::fpr))))))
-(define (create-file name . lines)
- (letfd ((fd (open name (logior O_WRONLY O_CREAT O_BINARY) #o600)))
- (let ((port (fdopen fd "wb")))
- (for-each (lambda (line) (display line port) (newline port))
- lines))))
-
(define (create-gpgsmhome)
(create-file "gpgsm.conf"
"disable-crl-checks"
(log "Storing private keys")
(for-each
(lambda (name)
- (file-copy (in-srcdir name)
+ (file-copy (in-srcdir "tests" "gpgsm" name)
(path-join "private-keys-v1.d"
(string-append name ".key"))))
'("32100C27173EF6E9C4E9A25D3D69F86D37A4F939"))
(log "Importing public demo and test keys")
- (call-check `(,@gpgsm --import ,(in-srcdir "cert_g10code_test1.der")))
+ (call-check `(,@gpgsm --import ,(in-srcdir "tests" "gpgsm" "cert_g10code_test1.der")))
(create-sample-files)
(stop-agent))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "gpgsm-defs.scm"))
+(load (in-srcdir "tests" "gpgsm" "gpgsm-defs.scm"))
(setup-gpgsm-environment)
(define certs-for-import
"Checking certificate import."
(lambda (test)
(assert (not (sm-have-public-key? (:cert test))))
- (call-check `(,@gpgsm --import ,(in-srcdir (:name test))))
+ (call-check `(,@gpgsm --import ,(in-srcdir "tests" "gpgsm" (:name test))))
(assert (sm-have-public-key? (:cert test))))
(lambda (test) (:name test))
certs-for-import)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(if (string=? "" (getenv "srcdir"))
+(if (string=? "" (getenv "abs_top_srcdir"))
(begin
- (echo "Environment variable 'srcdir' not set. Please point it to"
+ (echo "Environment variable 'abs_top_srcdir' not set. Please point it to"
"tests/gpgsm.")
(exit 2)))
-(let* ((tests (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*))
- (setup (make-environment-cache (test::scm #f "setup.scm" "setup.scm")))
- (runner (if (and (member "--parallel" *args*)
- (> (length tests) 1))
- run-tests-parallel
- run-tests-sequential)))
- (runner (map (lambda (t) (test::scm setup t t)) tests)))
+(define tests (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*))
+
+(define setup
+ (make-environment-cache (test::scm
+ #f
+ (path-join "tests" "gpgsm" "setup.scm")
+ (in-srcdir "tests" "gpgsm" "setup.scm"))))
+
+(run-tests (if (null? tests)
+ (load-tests "tests" "gpgsm")
+ (map (lambda (name)
+ (test::scm setup
+ (path-join "tests" "gpgsm" name)
+ (in-srcdir "tests" "gpgsm" name))) tests)))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "gpgsm-defs.scm"))
+(load (in-srcdir "tests" "gpgsm" "gpgsm-defs.scm"))
(define tarball (flag "--create-tarball" *args*))
(unless (and tarball (not (null? tarball)))
(error "Usage: setup.scm --create-tarball <file> ..."))
-(with-ephemeral-home-directory
- (chdir (getenv "GNUPGHOME"))
- (create-gpgsmhome)
- (stop-agent)
- (call-check `(,(tool 'gpgtar) --create --output ,(car tarball) ".")))
+(setenv "GNUPGHOME" (getcwd) #t)
+(create-gpgsmhome)
+(call-check `(,(tool 'gpgtar) --create --output ,(car tarball) "."))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "gpgsm-defs.scm"))
+(load (in-srcdir "tests" "gpgsm" "gpgsm-defs.scm"))
(setup-gpgsm-environment)
;; This is not a test, but can be used to inspect the test
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "gpgsm-defs.scm"))
+(load (in-srcdir "tests" "gpgsm" "gpgsm-defs.scm"))
(setup-gpgsm-environment)
(for-each-p
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "gpgsm-defs.scm"))
+(load (in-srcdir "tests" "gpgsm" "gpgsm-defs.scm"))
(setup-gpgsm-environment)
;;
echo gnupg-test-directory > testdir.stamp
-# Create the private key directy if it does not exists and copy
+# Create the private key directly if it does not exists and copy
# the sample keys.
[ -d private-keys-v1.d ] || mkdir private-keys-v1.d
-for i in ${private_keys}; do
+for i in ${private_keys}; do
cat ${srcdir}/samplekeys/$i.key >private-keys-v1.d/$i.key
done
# Make sure that the sample certs are available but ignore errors here
# because we are not a test script.
-for i in ${sample_certs}; do
+for i in ${sample_certs}; do
$GPGSM --import ${srcdir}/samplekeys/$i || true
done
TESTS_ENVIRONMENT = GPG_AGENT_INFO= LC_ALL=C \
EXEEXT=$(EXEEXT) \
PATH=../gpgscm:$(PATH) \
- srcdir=$(abs_srcdir) \
+ abs_top_srcdir=$(abs_top_srcdir) \
objdir=$(abs_top_builddir) \
- GPGSCM_PATH=$(abs_top_srcdir)/tests/gpgscm:$(abs_top_srcdir)/tests/migrations
+ GPGSCM_PATH=$(abs_top_srcdir)/tests/gpgscm
XTESTS = from-classic.scm \
extended-pkf.scm \
.PHONY: xcheck
xcheck:
$(TESTS_ENVIRONMENT) $(abs_top_builddir)/tests/gpgscm/gpgscm \
- run-tests.scm $(TESTFLAGS) $(XTESTS)
+ $(abs_srcdir)/run-tests.scm $(TESTFLAGS) $(TESTS)
-EXTRA_DIST = common.scm run-tests.scm setup.scm $(XTESTS) $(TEST_FILES)
+EXTRA_DIST = common.scm run-tests.scm setup.scm all-tests.scm \
+ $(XTESTS) $(TEST_FILES)
-CLEANFILES = *.log
+CLEANFILES = *.log report.xml
# We need to depend on a couple of programs so that the tests don't
# start before all programs are built.
--- /dev/null
+;; Copyright (C) 2017 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 <http://www.gnu.org/licenses/>.
+
+(export all-tests
+ ;; Parse the Makefile.am to find all tests.
+
+ (load (with-path "makefile.scm"))
+
+ (define (expander filename port key)
+ (parse-makefile port key))
+
+ (define (parse filename key)
+ (parse-makefile-expand filename expander key))
+
+ (map (lambda (name)
+ (test::scm #f
+ (path-join "tests" "migrations" name)
+ (in-srcdir "tests" "migrations" name)))
+ (parse-makefile-expand (in-srcdir "tests" "migrations" "Makefile.am")
+ (lambda (filename port key) (parse-makefile port key))
+ "XTESTS")))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(if (string=? "" (getenv "srcdir"))
+(if (string=? "" (getenv "abs_top_srcdir"))
(error "not called from make"))
(let ((verbose (string->number (getenv "verbose"))))
(define GPGTAR (path-join (getenv "objdir") "tools" (qualify "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=. -))))
+ (with-ephemeral-home-directory (lambda ())
+ (pipe:do
+ (pipe:open source-name (logior O_RDONLY O_BINARY))
+ (pipe:spawn `(,@GPG --dearmor))
+ (pipe:spawn `(,GPGTAR --extract --directory=. -)))))
(define (run-test message src-tarball test)
(catch (skip "gpgtar not built")
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "common.scm"))
+(load (in-srcdir "tests" "migrations" "common.scm"))
(catch (skip "gpgtar not built")
(call-check `(,GPGTAR --help)))
(run-test
"Testing the extended private key format ..."
- (in-srcdir "extended-pkf.tar.asc")
+ (in-srcdir "tests" "migrations" "extended-pkf.tar.asc")
(lambda (gpghome)
(assert-keys-usable)))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "common.scm"))
+(load (in-srcdir "tests" "migrations" "common.scm"))
(catch (skip "gpgtar not built")
(call-check `(,GPGTAR --help)))
(run-test
"Testing a clean migration ..."
- (in-srcdir "from-classic.tar.asc")
+ (in-srcdir "tests" "migrations" "from-classic.tar.asc")
(lambda (gpghome)
(trigger-migration)
(assert-migrated)))
(run-test
"Testing a migration with existing private-keys-v1.d ..."
- (in-srcdir "from-classic.tar.asc")
+ (in-srcdir "tests" "migrations" "from-classic.tar.asc")
(lambda (gpghome)
(mkdir "private-keys-v1.d" "-rwx")
(trigger-migration)
(run-test
"Testing a migration with existing but weird private-keys-v1.d ..."
- (in-srcdir "from-classic.tar.asc")
+ (in-srcdir "tests" "migrations" "from-classic.tar.asc")
(lambda (gpghome)
(mkdir "private-keys-v1.d" "")
(trigger-migration)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "common.scm"))
+(load (in-srcdir "tests" "migrations" "common.scm"))
(run-test
"Checking migration with legacy key (issue2276)..."
;; This tarball contains a keyring with a legacy key.
- (in-srcdir "issue2276.tar.asc")
+ (in-srcdir "tests" "migrations" "issue2276.tar.asc")
(lambda (gpghome)
;; GnuPG up to 2.1.14 failed to skip the legacy key when updating
;; the trust database and thereby rebuilding the keyring cache.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(let* ((tests (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*))
- (runner (if (and (member "--parallel" *args*)
- (> (length tests) 1))
- run-tests-parallel
- run-tests-sequential)))
- (runner (map (lambda (t) (test::scm #f t t)) tests)))
+(define tests (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*))
+
+(run-tests (if (null? tests)
+ (load-tests "tests" "migrations")
+ (map (lambda (name)
+ (test::scm #f
+ (path-join "tests" "migrations" name)
+ (in-srcdir "tests" "migrations" name))) tests)))
;; 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"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
-(if (= 0 (call `(,@GPG --list-packets ,(in-srcdir "4gb-packet.asc"))))
- (info "Can parse 4GB packets.")
- (fail "Failed to parse 4GB packet."))
+(unless (have-compression-algo? "BZIP2")
+ (skip "BZIP2 support not compiled in."))
+
+(call-check `(,@GPG --list-packets ,(in-srcdir "tests" "openpgp" "4gb-packet.asc")))
TESTS_ENVIRONMENT = LC_ALL=C \
EXEEXT=$(EXEEXT) \
PATH=../gpgscm:$(PATH) \
- srcdir=$(abs_srcdir) \
+ abs_top_srcdir=$(abs_top_srcdir) \
objdir=$(abs_top_builddir) \
- GPGSCM_PATH=$(abs_top_srcdir)/tests/gpgscm:$(abs_top_srcdir)/tests/openpgp
+ GPGSCM_PATH=$(abs_top_srcdir)/tests/gpgscm
XTESTS = \
version.scm \
.PHONY: xcheck
xcheck:
$(TESTS_ENVIRONMENT) $(abs_top_builddir)/tests/gpgscm/gpgscm \
- run-tests.scm $(TESTFLAGS) $(XTESTS)
+ $(abs_srcdir)/run-tests.scm $(TESTFLAGS) $(TESTS)
TEST_FILES = pubring.asc secring.asc plain-1o.asc plain-2o.asc plain-3o.asc \
plain-1.asc plain-2.asc plain-3.asc plain-1-pgp.asc \
plain-largeo.asc plain-large.asc \
pubring.pkr.asc secring.skr.asc secdemo.asc pubdemo.asc \
- gpg.conf.tmpl gpg-agent.conf.tmpl \
bug537-test.data.asc bug894-test.asc \
bug1223-good.asc bug1223-bogus.asc 4gb-packet.asc \
tofu/conflicting/1C005AF3.gpg \
EXTRA_DIST = defs.scm $(XTESTS) $(TEST_FILES) \
mkdemodirs signdemokey $(priv_keys) $(sample_keys) \
$(sample_msgs) ChangeLog-2011 run-tests.scm \
- setup.scm shell.scm
+ setup.scm shell.scm all-tests.scm
CLEANFILES = prepared.stamp x y yy z out err $(data_files) \
plain-1 plain-2 plain-3 trustdb.gpg *.lock .\#lk* \
pubring.gpg pubring.gpg~ pubring.kbx pubring.kbx~ \
secring.gpg pubring.pkr secring.skr \
gnupg-test.stop random_seed gpg-agent.log tofu.db \
- passphrases sshcontrol S.gpg-agent.ssh
+ passphrases sshcontrol S.gpg-agent.ssh report.xml
clean-local:
-rm -rf private-keys-v1.d openpgp-revocs.d tofu.d gpgtar.d
to run all tests or
- obj $ make -C tests/openpgp check XTESTS=your-test.scm
+ obj $ make -C tests/openpgp check TESTS=your-test.scm
to run a specific test (or any number of tests separated by spaces).
Say you are working on a new test called 'your-test.scm', you can run
it on its own using
- obj $ make -C tests/openpgp check XTESTS=your-test.scm
+ obj $ make -C tests/openpgp check TESTS=your-test.scm
but something isn't working as expected. There are several little
gadgets that might help. The first one is 'trace', a function that
--- /dev/null
+;; Copyright (C) 2017 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 <http://www.gnu.org/licenses/>.
+
+(export all-tests
+ ;; Parse the Makefile.am to find all tests.
+
+ (load (with-path "makefile.scm"))
+
+ (define (expander filename port key)
+ (parse-makefile port key))
+
+ (define (parse filename key)
+ (parse-makefile-expand filename expander key))
+
+ (define setup
+ (make-environment-cache
+ (test::scm
+ #f
+ (path-join "tests" "openpgp" "setup.scm")
+ (in-srcdir "tests" "openpgp" "setup.scm"))))
+
+ (define setup-use-keyring
+ (make-environment-cache
+ (test::scm
+ #f
+ (string-append "<use-keyring>" (path-join "tests" "openpgp" "setup.scm"))
+ (in-srcdir "tests" "openpgp" "setup.scm")
+ "--use-keyring")))
+
+ (define all-tests
+ (parse-makefile-expand (in-srcdir "tests" "openpgp" "Makefile.am")
+ (lambda (filename port key) (parse-makefile port key))
+ "XTESTS"))
+ (append
+ (map (lambda (name)
+ (test::scm setup
+ (path-join "tests" "openpgp" name)
+ (in-srcdir "tests" "openpgp" name))) all-tests)
+ (map (lambda (name)
+ (test::scm setup-use-keyring
+ (string-append "<use-keyring>"
+ (path-join "tests" "openpgp" name))
+ (in-srcdir "tests" "openpgp" name)
+ "--use-keyring")) all-tests)))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
--output ,tmp ,source ) usrpass1)
(pipe:do
(pipe:open source (logior O_RDONLY O_BINARY))
- (pipe:spawn `(,@GPG --yes ,tmp)))))
+ (pipe:spawn `(,@GPG --yes --verify ,tmp -)))))
(append plain-files data-files))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define files (append plain-files data-files))
(pipe:open file (logior O_RDONLY O_BINARY))
(pipe:splice sink)))
files)))
- (pipe:spawn `(,@GPG --yes ,tmp))))
+ (pipe:spawn `(,@GPG --yes --verify ,tmp -))))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:do
(tr:open source)
(tr:gpg usrpass1 `(--yes --passphrase-fd "0" -ea --recipient ,usrname2))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
(append plain-files data-files))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:open source)
(tr:pipe-do
(pipe:gpg `(--yes -ea --recipient ,usrname2))
- (pipe:gpg '(--yes)))
+ (pipe:gpg '(--yes --decrypt)))
(tr:assert-identity source)))
(append plain-files data-files))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define armored_key_8192 "-----BEGIN PGP PUBLIC KEY BLOCK-----
(tr:do
(tr:pipe-do
(pipe:echo nopad_armored_msg)
- (pipe:gpg '())))
+ (pipe:gpg '(--decrypt))))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:do
(tr:open source)
(tr:gpg usrpass1 `(--yes --passphrase-fd "0" -sea --recipient ,usrname2))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
(append plain-files data-files))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:do
(tr:open source)
(tr:gpg usrpass1 `(--yes --passphrase-fd "0" -sa --recipient ,usrname2))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
(append plain-files data-files))
This is a binary (gzip compressed) file which exhibits a problem with
-the zlib decryptor. See encr-data.c:decrypt_data for a decription of
+the zlib decryptor. See encr-data.c:decrypt_data for a description of
the problem we solved with 1.9.92 (1.4.6). It is not easy to produce
such files, but this one works. The source file is also in the BTS
under the name check-data-410-1.data. The result of the decryption
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define (check-signing args input)
(lettmp (signed)
(call-popen `(,@GPG --output ,signed --yes
,@args ,source) input)
- (call-popen `(,@GPG --output ,sink --yes ,signed) ""))))
+ (call-popen `(,@GPG --output ,sink --yes --verify ,signed) ""))))
(for-each-p
"Checking signing and verifying plain text messages"
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:open source)
(tr:gpg "" `(--yes --encrypt --recipient ,usrname2
--compress-algo ,compression))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
(append plain-files data-files)))
(force all-compression-algos))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define s2k '--s2k-count=65536)
(tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k
--force-mdc -c
--cipher-algo ,algo))
- (tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k))
+ (tr:gpg passphrase `(--yes --passphrase-fd "0" --decrypt ,s2k))
(tr:assert-identity source)))
'("plain-1" "data-80000")))
(force all-cipher-algos))
(tr:do
(tr:open source)
(tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k -cs))
- (tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k))
+ (tr:gpg passphrase `(--yes --passphrase-fd "0" --decrypt ,s2k))
(tr:assert-identity source)))
(append plain-files data-files))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define s2k '--s2k-count=65536)
(tr:do
(tr:open source)
(tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k -c))
- (tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k))
+ (tr:gpg passphrase `(--yes --passphrase-fd "0" --decrypt ,s2k))
(tr:assert-identity source)))
'("plain-2" "data-32000"))
(tr:open source)
(tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k -c
--cipher-algo ,algo))
- (tr:gpg passphrase `(--yes --passphrase-fd "0" ,s2k))
+ (tr:gpg passphrase `(--yes --passphrase-fd "0" --decrypt ,s2k))
(tr:assert-identity source)))
'("plain-1" "data-80000")))
(force all-cipher-algos))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(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:open (in-srcdir "tests" "openpgp" (string-append name "-pgp.asc")))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity name)))
(list (car plain-files)))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(info "Checking decryption of supplied files using --multifile.")
;; First, copy the files so that GnuPG writes the decrypted files here
;; and not into the source directory.
(for-each (lambda (name)
- (file-copy (in-srcdir name) name))
+ (file-copy (in-srcdir "tests" "openpgp" name) name))
encrypted-files)
;; Now decrypt all files.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define (get-session-key filename)
(for-each-p
"Checking decryption of supplied files using the session key."
(lambda (name)
- (let* ((source (in-srcdir (string-append name ".asc")))
+ (let* ((source (in-srcdir "tests" "openpgp" (string-append name ".asc")))
(key (get-session-key source)))
- (with-ephemeral-home-directory
+ (with-ephemeral-home-directory setup-environment
(tr:do
(tr:open source)
(tr:gpg "" `(--yes --decrypt --override-session-key ,key))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(lettmp (steve's-key)
;; First, unwrap the encrypted message using Steve's secret key.
(lettmp (unwrapped)
(tr:do
- (tr:open (in-srcdir "samplemsgs" (string-append name ".asc")))
+ (tr:open (in-srcdir "tests" "openpgp" "samplemsgs" (string-append name ".asc")))
(tr:gpg "" `(--yes --decrypt --unwrap))
(tr:write-to unwrapped))
;; Then, verify the signature with a clean working directory
;; containing only Steve's public key.
- (with-ephemeral-home-directory
+ (with-ephemeral-home-directory setup-environment
(call-check `(,@gpg --import ,steve's-key))
(call-check `(,@gpg --verify ,unwrapped)))))
'("encsig-2-keys-3" "encsig-2-keys-4")))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
"Checking decryption of supplied files"
(lambda (name)
(tr:do
- (tr:open (in-srcdir (string-append name ".asc")))
- (tr:gpg "" '(--yes))
+ (tr:open (in-srcdir "tests" "openpgp" (string-append name ".asc")))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity name)))
plain-files)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
;; Import the sample key
(info "Importing public key.")
(call-check
`(,(tool 'gpg) --import
- ,(in-srcdir "samplekeys/E657FB607BB4F21C90BB6651BC067AF28BC90111.asc")))
+ ,(in-srcdir "tests" "openpgp" "samplekeys/E657FB607BB4F21C90BB6651BC067AF28BC90111.asc")))
;; By default, the most recent, valid signing subkey (1EA97479).
(for-each-p
(define have-opt-always-trust
(catch #f
- (call-check `(,(tool 'gpg) --gpgconf-test --always-trust))
+ (with-ephemeral-home-directory (lambda ())
+ (call-check `(,(tool 'gpg) --gpgconf-test --always-trust)))
#t))
(define GPG `(,(tool 'gpg) --no-permission-warning
(not (not (member x (force all-hash-algos)))))
(define (have-cipher-algo? x)
(not (not (member x (force all-cipher-algos)))))
+(define (have-compression-algo? x)
+ (not (not (member x (force all-compression-algos)))))
(define (gpg-pipe args0 args1 errfd)
(lambda (source sink)
;; GnuPG helper.
;;
-;; Evaluate a sequence of expressions with the given home directory.
-(define-macro (with-home-directory gnupghome . expressions)
- (let ((original-home-directory (gensym)))
- `(let ((,original-home-directory (getenv "GNUPGHOME")))
- (dynamic-wind
- (lambda () (setenv "GNUPGHOME" ,gnupghome #t))
- (lambda () ,@expressions)
- (lambda () (setenv "GNUPGHOME" ,original-home-directory #t))))))
-
-;; Evaluate a sequence of expressions with an ephemeral home
-;; directory.
-(define-macro (with-ephemeral-home-directory . expressions)
- (let ((original-home-directory (gensym))
- (ephemeral-home-directory (gensym)))
- `(let ((,original-home-directory (getenv "GNUPGHOME"))
- (,ephemeral-home-directory (mkdtemp)))
- (finally (unlink-recursively ,ephemeral-home-directory)
- (dynamic-wind
- (lambda () (setenv "GNUPGHOME" ,ephemeral-home-directory #t))
- (lambda () ,@expressions)
- (lambda () (setenv "GNUPGHOME" ,original-home-directory #t)))))))
-
;; Call GPG to obtain the hash sums. Either specify an input file in
;; ARGS, or an string in INPUT. Returns a list of (<algo>
;; "<hashsum>") lists.
(pipe:spawn `(,@GPG --dearmor))
(pipe:write-to sink-name (logior O_WRONLY O_CREAT O_BINARY) #o600)))
+(define (gpg-dump-packets source-name sink-name)
+ (pipe:do
+ (pipe:open source-name (logior O_RDONLY O_BINARY))
+ (pipe:spawn `(,@GPG --list-packets))
+ (pipe:write-to sink-name (logior O_WRONLY O_CREAT O_BINARY) #o600)))
+
;;
;; Support for test environment creation and teardown.
;;
(lambda (port)
(display (make-random-string size) port))))
+(define (create-file name . lines)
+ (letfd ((fd (open name (logior O_WRONLY O_CREAT O_BINARY) #o600)))
+ (let ((port (fdopen fd "wb")))
+ (for-each (lambda (line) (display line port) (newline port))
+ lines))))
+
(define (create-gpghome)
(log "Creating test environment...")
(make-test-data "random_seed" 600)
(log "Creating configuration files")
- (for-each
- (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")))
+
+ (if (flag "--use-keyring" *args*)
+ (create-file "pubring.gpg"))
+
+ (create-file "gpg.conf"
+ "no-greeting"
+ "no-secmem-warning"
+ "no-permission-warning"
+ "batch"
+ "allow-weak-digest-algos"
+ (if have-opt-always-trust
+ "no-auto-check-trustdb" "#no-auto-check-trustdb")
+ (string-append "agent-program "
+ (tool 'gpg-agent)
+ "|--debug-quick-random\n")
+ )
+ (create-file "gpg-agent.conf"
+ "allow-preset-passphrase"
+ "no-grab"
+ "enable-ssh-support"
+ (string-append "pinentry-program " (tool 'pinentry))
+ ))
;; Initialize the test environment, install appropriate configuration
;; and start the agent, without any keys.
(log "Unpacking samples")
(for-each
(lambda (name)
- (dearmor (in-srcdir ".." "openpgp" (string-append name "o.asc")) name))
+ (dearmor (in-srcdir "tests" "openpgp" (string-append name "o.asc")) name))
plain-files))
(define (create-legacy-gpghome)
(log "Storing private keys")
(for-each
(lambda (name)
- (dearmor (in-srcdir (string-append "/privkeys/" name ".asc"))
+ (dearmor (in-srcdir "tests" "openpgp" "privkeys" (string-append name ".asc"))
(string-append "private-keys-v1.d/" name ".key")))
'("50B2D4FA4122C212611048BC5FC31BD44393626E"
"7E201E28B6FEB2927B321F443205F4724EBE637E"
(log "Importing public demo and test keys")
(for-each
(lambda (file)
- (call-check `(,@GPG --yes --import ,(in-srcdir file))))
+ (call-check `(,@GPG --yes --import ,(in-srcdir "tests" "openpgp" file))))
(list "pubdemo.asc" "pubring.asc" key-file1))
(pipe:do
- (pipe:open (in-srcdir "pubring.pkr.asc") (logior O_RDONLY O_BINARY))
+ (pipe:open (in-srcdir "tests" "openpgp" "pubring.pkr.asc") (logior O_RDONLY O_BINARY))
(pipe:spawn `(,@GPG --dearmor))
(pipe:spawn `(,@GPG --yes --import))))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(let* ((key keys::alfa)
(call-check `(,@gpg --delete-secret-keys ,subkey::fpr))
(assert (have-public-key? key))
(assert (have-public-key? subkey))
- ;; JW: Deleting the secret subkey also deletes the secret key.
+ ;; JW: Deleting the secret subkey also deletes the secret key. This
+ ;; is a deliberate design choice, and currently there is no way to
+ ;; delete the subkey without using --edit-key.
;; XXX (assert (have-secret-key? key))
;; XXX (assert (have-secret-key-file? key))
(assert (not (have-secret-key? subkey)))
(assert (not (have-secret-key-file? subkey)))
;; Then, delete the secret key.
+ ;; JW: We already deleted the key. See above.
;; XXX (call-check `(,@gpg --delete-secret-keys ,key::fpr))
(assert (have-public-key? key))
(assert (have-public-key? subkey))
;; Now, delete the public subkey.
(call-check `(,@gpg --delete-keys ,subkey::fpr))
- ;; JW: Deleting the subkey also deletes the key.
+ ;; JW: Deleting the subkey also deletes the key. This
+ ;; is a deliberate design choice, and currently there is no way to
+ ;; delete the subkey without using --edit-key.
;; XXX (assert (have-public-key? key))
(assert (not (have-public-key? subkey)))
;; Now, delete the public key.
+ ;; JW: We already deleted the key. See above.
;; XXX (call-check `(,@gpg --delete-keys ,key::fpr))
(assert (not (have-public-key? key)))
(assert (not (have-public-key? subkey))))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
--output ,tmp ,source ) usrpass1)
(pipe:do
(pipe:open source (logior O_RDONLY O_BINARY))
- (pipe:spawn `(,@GPG --yes ,tmp)))))
+ (pipe:spawn `(,@GPG --yes --verify ,tmp -)))))
(append plain-files data-files))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define files (append plain-files data-files))
(pipe:open file (logior O_RDONLY O_BINARY))
(pipe:splice sink)))
files)))
- (pipe:spawn `(,@GPG --yes ,tmp))))
+ (pipe:spawn `(,@GPG --yes --verify ,tmp -))))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define keygrips '("8E06A180EFFE4C65B812150CAF19BF30C0689A4C"
(for-each
(lambda (n)
(call-check `(,(tool 'gpg) --import
- ,(in-srcdir (string-append
+ ,(in-srcdir "tests" "openpgp" (string-append
"samplekeys/ecc-sample-"
(number->string n)
"-pub.asc")))))
(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))
+ (call-check `(,(tool 'gpg) --output ,y --verify ,x))
(unless (file=? y z) (fail "mismatch"))))
'(msg_opaque_signed_256 msg_opaque_signed_384 msg_opaque_signed_521)))
(lambda (n)
(call-check `(,(tool 'gpg) --import
,@(if (> n 1) '(--allow-non-selfsigned-uid) '())
- ,(in-srcdir (string-append
+ ,(in-srcdir "tests" "openpgp" (string-append
"samplekeys/ecc-sample-"
(number->string n)
"-sec.asc")))))
(lettmp (x y)
(call-with-output-file
x (lambda (p) (display (eval test (current-environment)) p)))
- (call-check `(,@GPG --yes --output ,y ,x))
+ (call-check `(,@GPG --yes --output ,y --decrypt ,x))
(unless (file=? y z) (fail "mismatch"))))
'(msg_encrypted_256 msg_encrypted_384 msg_encrypted_521)))
(tr:do
(tr:open source)
(tr:gpg "" `(--yes --encrypt --recipient ,keyid))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
mainkeyids))
(append plain-files data-files))
(tr:do
(tr:open source)
(tr:gpg "" `(--yes --sign --local-user ,keyid))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
mainkeyids))
(append plain-files data-files))
(lambda (n)
(call-check `(,(tool 'gpg) --import
,@(if (> n 1) '(--allow-non-selfsigned-uid) '())
- ,(in-srcdir (string-append
+ ,(in-srcdir "tests" "openpgp" (string-append
"samplekeys/ecc-sample-"
(number->string n)
"-sec.asc")))))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:do
(tr:open source)
(tr:gpg "" `(--yes --encrypt --recipient ,dsa-usrname2))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
(append plain-files data-files))
(tr:open source)
(tr:gpg "" `(--yes --encrypt --recipient ,dsa-usrname2
--cipher-algo ,cipher))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
(append plain-files data-files)))
(force all-cipher-algos))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define files (append plain-files data-files))
(lambda (source)
(tr:do
(tr:open (string-append source ".gpg"))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
files)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:do
(tr:open source)
(tr:gpg "" `(--yes --encrypt --recipient ,usrname2))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
(append plain-files data-files))
(tr:open source)
(tr:gpg "" `(--yes --encrypt --recipient ,usrname2
--cipher-algo ,cipher))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
(append plain-files data-files)))
(force all-cipher-algos))
(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))
+ --recipient-file ,(in-srcdir "tests" "openpgp" key-file1)
+ --hidden-recipient-file ,(in-srcdir "tests" "openpgp" key-file2)))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
plain-files)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:open source)
(tr:pipe-do
(pipe:gpg `(--yes --encrypt --recipient ,usrname2))
- (pipe:gpg '(--yes)))
+ (pipe:gpg '(--yes --decrypt)))
(tr:assert-identity source)))
(append plain-files data-files))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define (check-for predicate lines message)
fname, fname_new, strerror (errno));
exit (1);
}
+
+ free (fname_new);
return passphrase;
}
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
(define (genkey config)
+++ /dev/null
-allow-preset-passphrase
-no-grab
-enable-ssh-support
+++ /dev/null
-no-greeting
-no-secmem-warning
-no-permission-warning
-batch
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
(for-each-p'
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(catch (skip "gpgtar not built")
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define msg_signed_asc "
(catch '()
(pipe:do
(pipe:echo (eval armored-file (current-environment)))
- (pipe:spawn `(,@GPGV --keyring ,(in-srcdir "forged-keyring.gpg"))))
+ (pipe:spawn `(,@GPGV --keyring ,(in-srcdir "tests" "openpgp" "forged-keyring.gpg"))))
(fail "verification succeeded but should not")))
'(msg_signed_asc))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
;; XXX because of --always-trust, the trustdb is not created.
(define gpg `(,(tool 'gpg) --no-permission-warning))
(info "Checking key revocation.")
-(call-check `(,@gpg --import ,(in-srcdir "samplemsgs"
+(call-check `(,@gpg --import ,(in-srcdir "tests" "openpgp" "samplemsgs"
"revoke-2D727CC768697734.asc")))
(let loop ((output (gpg-with-colons '(--list-secret-keys "2D727CC768697734"))))
(unless (null? output)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
(info "Checking bug 894: segv importing certain keys.")
-(call-check `(,(tool 'gpg) --import ,(in-srcdir "bug894-test.asc")))
+(call-check `(,(tool 'gpg) --import ,(in-srcdir "tests" "openpgp" "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")))
+(call `(,(tool 'gpg) --import ,(in-srcdir "tests" "openpgp" "bug1223-bogus.asc")))
+(call `(,(tool 'gpg) --import ,(in-srcdir "tests" "openpgp" "bug1223-good.asc")))
(tr:do
(tr:pipe-do
(pipe:gpg `(--list-keys --with-colons ,keyid)))
(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")))
+(call `(,(tool 'gpg) --import ,(in-srcdir "tests" "openpgp" "samplekeys/dda252ebb8ebe1af-1.asc")))
+(call `(,(tool 'gpg) --import ,(in-srcdir "tests" "openpgp" "samplekeys/dda252ebb8ebe1af-2.asc")))
(tr:do
(tr:pipe-do
(pipe:gpg `(--list-keys --with-colons ,fpr1 ,fpr2)))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
(info "Checking passphrase cache (issue2015)...")
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
-(define key (in-srcdir "samplekeys/issue2346.gpg"))
+(define key (in-srcdir "tests" "openpgp" "samplekeys/issue2346.gpg"))
(info "Checking import statistics (issue2346)...")
(let ((status (call-popen `(,@GPG --status-fd=1 --import ,key) "")))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
-(define keyfile (in-srcdir "samplekeys" "rsa-rsa-sample-1.asc"))
+(define keyfile (in-srcdir "tests" "openpgp" "samplekeys" "rsa-rsa-sample-1.asc"))
(define (touch file-name)
(close (open file-name (logior O_WRONLY O_BINARY O_CREAT) #o600)))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
(info "Checking iobuf_peek corner case (issue2419)...")
(lettmp
(onebyte)
- (dearmor (in-srcdir "samplemsgs/issue2419.asc") onebyte)
+ (dearmor (in-srcdir "tests" "openpgp" "samplemsgs/issue2419.asc") onebyte)
(catch (assert (string-contains? (car *error*) "invalid packet"))
(call-popen `(,@GPG --list-packets ,onebyte) "")
(fail "Expected an error but got none")))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
(catch (skip "Tofu not supported")
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define (check-failure options)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
;; This test assumes a fixed time of 2004-01-01.
(define :comment cadr)
(define :number caddr)
(define (:filename key)
- (in-srcdir "key-selection"
+ (in-srcdir "tests" "openpgp" "key-selection"
(string-append (number->string (:number key)) ".asc")))
(define (delete-keys which)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
(define empty-string-hashes
;; 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"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define sig-1ls1ls-valid "
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(load (with-path "time.scm"))
(setup-environment)
;; XXX I don't know how to verify this. The keylisting does not seem
;; to indicate the primary UID.
-(info "Checking that we get an error making non-existant user ID the primary one.")
+(info "Checking that we get an error making non-existent user ID the primary one.")
(catch '()
(call-check `(,@GPG --quick-set-primary-uid ,(exact alpha) ,charlie))
(error "Expected an error, but get none."))
(info "Checking that we can revoke a user ID...")
(call-check `(,@GPG --quick-revoke-uid ,(exact bravo) ,alpha))
-(info "Checking that we get an error revoking a non-existant user ID.")
+(info "Checking that we get an error revoking a non-existent user ID.")
(catch '()
(call-check `(,@GPG --quick-revoke-uid ,(exact bravo) ,charlie))
(error "Expected an error, but get none."))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(if (string=? "" (getenv "srcdir"))
+(if (string=? "" (getenv "abs_top_srcdir"))
(begin
- (echo "Environment variable 'srcdir' not set. Please point it to"
+ (echo "Environment variable 'abs_top_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)
-(let* ((tests (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*))
- (setup (make-environment-cache (test::scm #f "setup.scm" "setup.scm")))
- (runner (if (and (member "--parallel" *args*)
- (> (length tests) 1))
- run-tests-parallel
- run-tests-sequential)))
- (runner (map (lambda (t) (test::scm setup t t)) tests))))
+(define setup
+ (make-environment-cache (test::scm
+ #f
+ (path-join "tests" "openpgp" "setup.scm")
+ (in-srcdir "tests" "openpgp" "setup.scm"))))
+
+(define tests (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*))
+
+(run-tests (if (null? tests)
+ (load-tests "tests" "openpgp")
+ (map (lambda (name)
+ (test::scm setup
+ (path-join "tests" "openpgp" name)
+ (in-srcdir "tests" "openpgp" name))) tests)))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:do
(tr:open source)
(tr:gpg usrpass1 '(--yes -seat -r two@example.com --passphrase-fd "0"))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-weak-identity source)))
plain-files)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
-(unless (member "--create-tarball" *args*)
- (fail "Usage: setup.scm --create-tarball <file>"))
+(define cache (flag "--create-tarball" *args*))
+(unless (and cache (= 1 (length cache)))
+ (fail "Usage: setup.scm --create-tarball <file> [--use-keyring]"))
(when (> (*verbose*) 0)
(define (pad symbol length)
'(gpgconf gpg gpg-agent scdaemon gpgsm dirmngr gpg-connect-agent
gpg-preset-passphrase gpgtar pinentry)))
-(with-ephemeral-home-directory
- (chdir (getenv "GNUPGHOME"))
- (create-gpghome)
- (start-agent)
- (create-legacy-gpghome)
- (stop-agent)
- (call-check `(,(tool 'gpgtar) --create --output ,(cadr *args*) ".")))
+(setenv "GNUPGHOME" (getcwd) #t)
+(create-gpghome)
+(start-agent)
+(create-legacy-gpghome)
+(stop-agent)
+(call-check `(,(tool 'gpgtar) --create --output ,(car cache) "."))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
;; This is not a test, but can be used to inspect the test
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:gpg usrpass1 `(--yes --passphrase-fd "0" -se
-u ,dsa-usrname1
--recipient ,dsa-usrname2))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
(append plain-files data-files))
-u ,dsa-usrname1
--recipient ,dsa-usrname2
--digest-algo ,hash))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity (car plain-files))))
algos)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:do
(tr:open source)
(tr:gpg usrpass1 `(--yes --passphrase-fd "0" -se --recipient ,usrname2))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(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"))
+ --output ,tmp --decrypt ,(in-srcdir "tests" "openpgp"
+ "bug537-test.data.asc"))
usrpass1)
(if (not (string=? "4336AE2A528FAE091E73E59E325B588FEE795F9B"
(cadar (gpg-hash-string `(--print-md SHA1 ,tmp) ""))))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:do
(tr:open source)
(tr:gpg "" `(--yes --sign --user ,dsa-usrname1))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
(append plain-files data-files))
(tr:do
(tr:open (car plain-files))
(tr:gpg "" `(--yes --sign --user ,dsa-usrname1 --digest-algo ,hash))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity (car plain-files))))
algos)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(for-each-p
(tr:do
(tr:open source)
(tr:gpg "" '(--yes --sign))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity source)))
(append plain-files data-files))
(tr:do
(tr:open (car plain-files))
(tr:gpg "" `(--yes --sign --user ,usrname3 --digest-algo ,hash))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity (car plain-files))))
(if (not (equal? "MD5" hash))
;; Using the DSA sig key - only 160 bit or larger hashes
(tr:open (car plain-files))
(tr:gpg usrpass1
`(--yes --sign --passphrase-fd "0" --digest-algo ,hash))
- (tr:gpg "" '(--yes))
+ (tr:gpg "" '(--yes --decrypt))
(tr:assert-identity (car plain-files)))))
(force all-hash-algos))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
(define key
- `(,(in-srcdir "samplekeys" "authenticate-only.sec.asc")
+ `(,(in-srcdir "tests" "openpgp" "samplekeys" "authenticate-only.sec.asc")
"927EF377FD1A1B6F795E40C02A87917D8FFBA49F"
"72360FDB6380212D5DAF2FA9E51185A9253C496D"
"ssh-rsa"))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
(setenv "SSH_AUTH_SOCK"
(for-each-p'
"Importing ssh keys..."
(lambda (key)
- (let ((file (path-join (in-srcdir "samplekeys")
+ (let ((file (path-join (in-srcdir "tests" "openpgp" "samplekeys")
(string-append "ssh-" (car key) ".key")))
(hash (cadr key)))
;; We pipe the key to ssh-add so that it won't complain about
(info "Checking for issue2316...")
(unlink (path-join GNUPGHOME "sshcontrol"))
(pipe:do
- (pipe:open (path-join (in-srcdir "samplekeys")
+ (pipe:open (path-join (in-srcdir "tests" "openpgp" "samplekeys")
(string-append "ssh-rsa.key"))
(logior O_RDONLY O_BINARY))
(pipe:spawn `(,SSH-ADD -)))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(load (with-path "time.scm"))
(setup-environment)
;; Import the test keys.
(for-each (lambda (keyid)
(call-check `(,@GPG --import
- ,(in-srcdir "tofu/conflicting/"
+ ,(in-srcdir "tests" "openpgp" "tofu" "conflicting"
(string-append keyid ".gpg"))))
(catch (fail "Missing key" keyid)
(call-check `(,@GPG --list-keys ,keyid))))
;; Verify a message. There should be no conflict and the trust
;; policy should be set to auto.
-(call-check `(,@GPG --verify ,(in-srcdir "tofu/conflicting/1C005AF3-1.txt")))
+(call-check `(,@GPG --verify ,(in-srcdir "tests" "openpgp" "tofu" "conflicting" "1C005AF3-1.txt")))
(checkpolicy "1C005AF3" "auto")
;; Check default trust.
;; auto), but not affect 1C005AF3's policy.
(setpolicy "BE04EB2B" "auto")
(checkpolicy "BE04EB2B" "ask")
-(call-check `(,@GPG --verify ,(in-srcdir "tofu/conflicting/B662E42F-1.txt")))
+(call-check `(,@GPG --verify ,(in-srcdir "tests" "openpgp" "tofu" "conflicting" "B662E42F-1.txt")))
(checkpolicy "BE04EB2B" "ask")
(checkpolicy "1C005AF3" "bad")
(checkpolicy "B662E42F" "ask")
(check-counts "B662E42F" 0 0 0 0)
;; Verify a message. The signature count should increase by 1.
-(call-check `(,@GPG --verify ,(in-srcdir "tofu/conflicting/1C005AF3-1.txt")))
+(call-check `(,@GPG --verify ,(in-srcdir "tests" "openpgp" "tofu" "conflicting" "1C005AF3-1.txt")))
(check-counts "1C005AF3" 1 1 0 0)
;; Verify the same message. The signature count should remain the
;; same.
-(call-check `(,@GPG --verify ,(in-srcdir "tofu/conflicting/1C005AF3-1.txt")))
+(call-check `(,@GPG --verify ,(in-srcdir "tests" "openpgp" "tofu" "conflicting" "1C005AF3-1.txt")))
(check-counts "1C005AF3" 1 1 0 0)
;; Verify another message.
-(call-check `(,@GPG --verify ,(in-srcdir "tofu/conflicting/1C005AF3-2.txt")))
+(call-check `(,@GPG --verify ,(in-srcdir "tests" "openpgp" "tofu" "conflicting" "1C005AF3-2.txt")))
(check-counts "1C005AF3" 2 1 0 0)
;; Verify another message.
-(call-check `(,@GPG --verify ,(in-srcdir "tofu/conflicting/1C005AF3-3.txt")))
+(call-check `(,@GPG --verify ,(in-srcdir "tests" "openpgp" "tofu" "conflicting" "1C005AF3-3.txt")))
(check-counts "1C005AF3" 3 1 0 0)
;; Verify a message from a different sender. The signature count
;; should increase by 1 for that key.
-(call-check `(,@GPG --verify ,(in-srcdir "tofu/conflicting/BE04EB2B-1.txt")))
+(call-check `(,@GPG --verify ,(in-srcdir "tests" "openpgp" "tofu" "conflicting" "BE04EB2B-1.txt")))
(check-counts "1C005AF3" 3 1 0 0)
(check-counts "BE04EB2B" 1 1 0 0)
(check-counts "B662E42F" 0 0 0 0)
;; when the message was first verified, not when the signer claimed
;; that it was signed.)
(call-check `(,@GPG ,(faketime (days->seconds 2))
- --verify ,(in-srcdir "tofu/conflicting/1C005AF3-4.txt")))
+ --verify ,(in-srcdir "tests" "openpgp" "tofu" "conflicting" "1C005AF3-4.txt")))
(check-counts "1C005AF3" 4 2 0 0)
(check-counts "BE04EB2B" 1 1 0 0)
(check-counts "B662E42F" 0 0 0 0)
;; And another.
(call-check `(,@GPG ,(faketime (days->seconds 2))
- --verify ,(in-srcdir "tofu/conflicting/1C005AF3-5.txt")))
+ --verify ,(in-srcdir "tests" "openpgp" "tofu" "conflicting" "1C005AF3-5.txt")))
(check-counts "1C005AF3" 5 2 0 0)
(check-counts "BE04EB2B" 1 1 0 0)
(check-counts "B662E42F" 0 0 0 0)
;; Another, but for a different key.
(call-check `(,@GPG ,(faketime (days->seconds 2))
- --verify ,(in-srcdir "tofu/conflicting/BE04EB2B-2.txt")))
+ --verify ,(in-srcdir "tests" "openpgp" "tofu" "conflicting" "BE04EB2B-2.txt")))
(check-counts "1C005AF3" 5 2 0 0)
(check-counts "BE04EB2B" 2 2 0 0)
(check-counts "B662E42F" 0 0 0 0)
;; And add a third day.
(call-check `(,@GPG ,(faketime (days->seconds 4))
- --verify ,(in-srcdir "tofu/conflicting/BE04EB2B-3.txt")))
+ --verify ,(in-srcdir "tests" "openpgp" "tofu" "conflicting" "BE04EB2B-3.txt")))
(check-counts "1C005AF3" 5 2 0 0)
(check-counts "BE04EB2B" 3 3 0 0)
(check-counts "B662E42F" 0 0 0 0)
(call-check `(,@GPG ,(faketime (days->seconds 4))
- --verify ,(in-srcdir "tofu/conflicting/BE04EB2B-4.txt")))
+ --verify ,(in-srcdir "tests" "openpgp" "tofu" "conflicting" "BE04EB2B-4.txt")))
(check-counts "1C005AF3" 5 2 0 0)
(check-counts "BE04EB2B" 4 3 0 0)
(check-counts "B662E42F" 0 0 0 0)
(lambda (key)
(for-each
(lambda (i)
- (let ((fn (in-srcdir DIR (string-append key "-" i ".txt"))))
+ (let ((fn (in-srcdir "tests" "openpgp" DIR (string-append key "-" i ".txt"))))
(call-check `(,@GPG --verify ,fn))))
(list "1" "2")))
(list KEYIDA KEYIDB)))
;; Import the public keys.
(display " > Two keys. ")
-(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDA "-1.gpg"))))
-(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-1.gpg"))))
+(call-check `(,@GPG --import ,(in-srcdir "tests" "openpgp" DIR (string-append KEYIDA "-1.gpg"))))
+(call-check `(,@GPG --import ,(in-srcdir "tests" "openpgp" DIR (string-append KEYIDB "-1.gpg"))))
;; Make sure the tofu engine registers the keys.
(verify-messages)
(display "<\n")
;; Import the cross sigs.
(display " > Adding cross signatures. ")
-(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDA "-2.gpg"))))
-(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-2.gpg"))))
+(call-check `(,@GPG --import ,(in-srcdir "tests" "openpgp" DIR (string-append KEYIDA "-2.gpg"))))
+(call-check `(,@GPG --import ,(in-srcdir "tests" "openpgp" DIR (string-append KEYIDB "-2.gpg"))))
(verify-messages)
(display "<\n")
;; Import the conflicting user id.
(display " > Adding conflicting user id. ")
-(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-3.gpg"))))
+(call-check `(,@GPG --import ,(in-srcdir "tests" "openpgp" DIR (string-append KEYIDB "-3.gpg"))))
(verify-messages)
(display "<\n")
;; Import Alice's signature on the conflicting user id. Since there
;; is now a cross signature, we should revert to the default policy.
(display " > Adding cross signature on user id. ")
-(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-4.gpg"))))
+(call-check `(,@GPG --import ,(in-srcdir "tests" "openpgp" DIR (string-append KEYIDB "-4.gpg"))))
(verify-messages)
(display "<\n")
(lambda (key)
(for-each
(lambda (i)
- (let ((fn (in-srcdir DIR (string-append key "-" i ".txt"))))
+ (let ((fn (in-srcdir "tests" "openpgp" DIR (string-append key "-" i ".txt"))))
(call-check `(,@GPG --verify ,fn))))
(list "1" "2")))
(list KEYIDA KEYIDB)))
;; Import the public keys.
(display " > Two keys. ")
-(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDA "-1.gpg"))))
-(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-1.gpg"))))
+(call-check `(,@GPG --import ,(in-srcdir "tests" "openpgp" DIR (string-append KEYIDA "-1.gpg"))))
+(call-check `(,@GPG --import ,(in-srcdir "tests" "openpgp" DIR (string-append KEYIDB "-1.gpg"))))
(display "<\n")
(checkpolicy KEYA "auto")
;; Import the cross sigs.
(display " > Adding cross signatures. ")
-(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDA "-2.gpg"))))
-(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-2.gpg"))))
+(call-check `(,@GPG --import ,(in-srcdir "tests" "openpgp" DIR (string-append KEYIDA "-2.gpg"))))
+(call-check `(,@GPG --import ,(in-srcdir "tests" "openpgp" DIR (string-append KEYIDB "-2.gpg"))))
(display "<\n")
(checkpolicy KEYA "auto")
;; Import the conflicting user id.
(display " > Adding conflicting user id. ")
-(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-3.gpg"))))
+(call-check `(,@GPG --import ,(in-srcdir "tests" "openpgp" DIR (string-append KEYIDB "-3.gpg"))))
(verify-messages)
(display "<\n")
;; Import Alice's signature on the conflicting user id.
(display " > Adding cross signature on user id. ")
-(call-check `(,@GPG --import ,(in-srcdir DIR (string-append KEYIDB "-4.gpg"))))
+(call-check `(,@GPG --import ,(in-srcdir "tests" "openpgp" DIR (string-append KEYIDB "-4.gpg"))))
(verify-messages)
(display "<\n")
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
;; Import the sample key
(info "Importing public key.")
(call-check
`(,(tool 'gpg) --import
- ,(in-srcdir "samplekeys/E657FB607BB4F21C90BB6651BC067AF28BC90111.asc")))
+ ,(in-srcdir "tests" "openpgp" "samplekeys/E657FB607BB4F21C90BB6651BC067AF28BC90111.asc")))
;; By default, the most recent, valid signing subkey (1EA97479).
(for-each-p
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
(define files '("clearsig-1-key-1.asc" "signed-1-key-1.asc"))
(let* ((status
(call-popen
`(,@gpg --verify --multifile --status-fd=1
- ,@(map (lambda (name) (in-srcdir "samplemsgs" name)) files))
+ ,@(map (lambda (name) (in-srcdir "tests" "openpgp" "samplemsgs" name)) files))
""))
(lines (map (lambda (l)
(assert (string-prefix? l "[GNUPG:] "))
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-legacy-environment)
;;
;;; Need to import the ed25519 sample key used for
;;; the next two tests.
-(call-check `(,@GPG --quiet --yes --import ,(in-srcdir key-file2)))
+(call-check `(,@GPG --quiet --yes --import ,(in-srcdir "tests" "openpgp" key-file2)))
(for-each-p
"Checking that a valid Ed25519 signature is verified as such"
(lambda (armored-file)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
-(load (with-path "defs.scm"))
+(load (in-srcdir "tests" "openpgp" "defs.scm"))
(setup-environment)
(info "Printing the GPG version")
EXTRA_DIST = inittests runtest common.sh $(testscripts) ChangeLog-2011 \
import-all-certs.data
-TESTS = $(testscripts)
+TESTS =
CLEANFILES = inittests.stamp scratch.*.tmp x y z out err *.lock .\#lk* *.log
README - this file.
PKITS_data.tar.bz2 - the original ZIP file, repackaged as a tarball.
Makefile.am - Part of our build system.
-import-all-certs - Run a simple import test on all certifcates
+import-all-certs - Run a simple import test on all certificates
validate-all-certs - Run an import and validate test on all certificates
signature-verification - PKITS test 4.1
validity-periods - PKITS test 4.2
exit 1
fi
-if [ -f PKITS_data.tar.bz2 ]; then
+if [ -f "$srcdir/PKITS_data.tar.bz2" ]; then
:
else
if [ "$pgmname" = "import-all-certs" ]; then
exit 1
fi
-if test -f PKITS_data.tar.bz2; then
- if ! bunzip2 -c PKITS_data.tar.bz2 | tar xf - ; then
+if test -f "$srcdir/PKITS_data.tar.bz2"; then
+ if ! bunzip2 -c "$srcdir/PKITS_data.tar.bz2" | tar xf - ; then
echo "inittests: failed to untar the test data" >&2
exit 1
fi
--- /dev/null
+#!/usr/bin/env gpgscm
+
+;; Copyright (C) 2017 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 <http://www.gnu.org/licenses/>.
+
+(info "Running all tests...")
+
+(define (load-tests-with-log . path)
+ (map (lambda (test)
+ (test:::set! 'log-file-name
+ (apply path-join `(,@path
+ ,(string-append (basename test::name)
+ ".log")))))
+ (apply load-tests path)))
+
+(let ((prefix (flag "--prefix" *args*))
+ (all-tests (append
+ (load-tests-with-log "common")
+ (load-tests-with-log "g10")
+ (load-tests-with-log "g13")
+ (load-tests-with-log "agent")
+ (load-tests-with-log "tests" "openpgp")
+ (load-tests-with-log "tests" "migrations")
+ (load-tests-with-log "tests" "gpgsm")
+ (load-tests-with-log "tests" "gpgme"))))
+ (run-tests (if prefix
+ (filter
+ (lambda (t) (string-prefix? t::name (apply path-join prefix)))
+ all-tests)
+ all-tests)))
}
-/* Show all inquiry defintions. */
+/* Show all inquiry definitions. */
static void
show_definq (void)
{
{
if (!opt.autostart
&& (gpg_err_code (err)
- == opt.use_dirmngr? GPG_ERR_NO_DIRMNGR : GPG_ERR_NO_AGENT))
+ == (opt.use_dirmngr? GPG_ERR_NO_DIRMNGR : GPG_ERR_NO_AGENT)))
{
/* In the no-autostart case we don't make gpg-connect-agent
fail on a missing server. */
\f
/* More or less Robust version of dgettext. It has the side effect of
switching the codeset to utf-8 because this is what we want to
- output. In theory it is posible to keep the original code set and
+ output. In theory it is possible to keep the original code set and
switch back for regular disgnostic output (redefine "_(" for that)
but given the natur of this tool, being something invoked from
other pograms, it does not make much sense. */
goto leave;
}
- /* Note that the parser uses the first occurance of a matching
+ /* Note that the parser uses the first occurrence of a matching
* values and ignores possible duplicated values. */
maxlen = 2048; /* Set limit. */
#ifdef HAVE_ZIP
# include <zlib.h>
#endif
-#ifdef HAVE_BZIP2
-# include <bzlib.h>
-#endif /* HAVE_BZIP2 */
#if defined(__riscos__) && defined(USE_ZLIBRISCOS)
# include "zlib-riscos.h"
#endif
#include "../common/util.h"
#include "../common/openpgpdefs.h"
+#ifdef HAVE_BZIP2
+# include <bzlib.h>
+#endif /* HAVE_BZIP2 */
+
static int opt_verbose;
static const char *opt_prefix = "";
static int opt_uncompress;
# WITHOUT ANY WARRANTY, to the extent permitted by law; without even the
# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-# FIXME: Use only valid email addreses, extract only given keys
+# FIXME: Use only valid email addresses, extract only given keys
dryrun=0
if [ "$1" = "--dry-run" ]; then
#ifndef HAVE_STPCPY
static char *
-stpcpy (char *a,const char *b)
+my_stpcpy (char *a,const char *b)
{
while (*b)
*a++ = *b++;
return (char*)a;
}
+#define stpcpy my_stpcpy
#endif
/* Get a passphrase in secure storage (if possible). If AGAIN is
true, then this is a repeated attempt. If CANCELED is not a null
pointer, it will be set to true or false, depending on if the user
- canceled the operation or not. On error (including cancelation), a
+ canceled the operation or not. On error (including cancellation), a
null pointer is returned. The passphrase must be deallocated with
confucius_drop_pass. CACHEID is the ID to be used for passphrase
caching and can be NULL to disable caching. */
client_t client;
/* Usually we don't have that many connections, thus it is okay
- to set them allways from scratch and don't maintain an active
+ to set them always from scratch and don't maintain an active
fd_set. */
FD_ZERO (&rfds);
max_fd = -1;
-/* wks-utils.c - Common helper fucntions for wks tools
+/* wks-utils.c - Common helper functions for wks tools
* Copyright (C) 2016 g10 Code GmbH
*
* This file is part of GnuPG.
projects / platform / upstream / gpg2.git / commitdiff