summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/posix.c25
-rw-r--r--test-suite/tests/posix.test19
2 files changed, 39 insertions, 5 deletions
diff --git a/libguile/posix.c b/libguile/posix.c
index 497896b0e..b35dfbd80 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-2014,2016,2018
+/* Copyright 1995-2014,2016-2018
Free Software Foundation, Inc.
This file is part of Guile.
@@ -1936,26 +1936,43 @@ SCM_DEFINE (scm_crypt, "crypt", 2, 0, 0,
"crypt(3) library call.")
#define FUNC_NAME s_scm_crypt
{
+ int err;
SCM ret;
char *c_key, *c_salt, *c_ret;
scm_dynwind_begin (0);
- scm_i_dynwind_pthread_mutex_lock (&scm_i_misc_mutex);
c_key = scm_to_locale_string (key);
scm_dynwind_free (c_key);
c_salt = scm_to_locale_string (salt);
scm_dynwind_free (c_salt);
+ /* Take the lock because 'crypt' uses a static buffer. */
+ scm_i_dynwind_pthread_mutex_lock (&scm_i_misc_mutex);
+
/* The Linux crypt(3) man page says crypt will return NULL and set errno
on error. (Eg. ENOSYS if legal restrictions mean it cannot be
implemented). */
c_ret = crypt (c_key, c_salt);
+
if (c_ret == NULL)
- SCM_SYSERROR;
+ /* Note: Do not throw until we've released 'scm_i_misc_mutex' since
+ this would cause a deadlock down the path. */
+ err = errno;
+ else
+ {
+ err = 0;
+ ret = scm_from_locale_string (c_ret);
+ }
- ret = scm_from_locale_string (c_ret);
scm_dynwind_end ();
+
+ if (err != 0)
+ {
+ errno = err;
+ SCM_SYSERROR;
+ }
+
return ret;
}
#undef FUNC_NAME
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index f57001a24..4dadd7784 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -1,7 +1,7 @@
;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*-
;;;;
;;;; Copyright 2003, 2004, 2006, 2007, 2010, 2012,
-;;;; 2015 Free Software Foundation, Inc.
+;;;; 2015, 2017 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -222,3 +222,20 @@
(let ((me (getpid)))
(and (not (zero? (system* "something-that-does-not-exist")))
(= me (getpid))))))
+
+;;
+;; crypt
+;;
+
+(with-test-prefix "crypt"
+
+ (pass-if "basic usage"
+ (string? (crypt "pass" "abcdefg")))
+
+ (pass-if-exception "glibc EINVAL" exception:system-error
+ ;; This used to deadlock while trying to throw to 'system-error'.
+ ;; This test uses the special interpretation of the salt that glibc
+ ;; does; specifically, we pass a syntactically invalid salt here.
+ (if (string-contains %host-type "-gnu")
+ (crypt "pass" "$X$abc") ;EINVAL
+ (throw 'unresolved))))