diff options
-rw-r--r-- | libguile/posix.c | 25 | ||||
-rw-r--r-- | test-suite/tests/posix.test | 19 |
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)))) |