diff options
-rw-r--r-- | guile/Makefile.am | 3 | ||||
-rw-r--r-- | guile/modules/gnutls.in | 92 | ||||
-rw-r--r-- | guile/modules/gnutls/build/enums.scm | 95 | ||||
-rw-r--r-- | guile/src/core.c | 88 | ||||
-rw-r--r-- | guile/src/errors.c | 12 | ||||
-rw-r--r-- | guile/tests/errors.scm | 26 | ||||
-rw-r--r-- | guile/tests/reauth.scm | 121 |
7 files changed, 408 insertions, 29 deletions
diff --git a/guile/Makefile.am b/guile/Makefile.am index 13bdeee774..0b19bad90f 100644 --- a/guile/Makefile.am +++ b/guile/Makefile.am @@ -1,5 +1,5 @@ # GnuTLS --- Guile bindings for GnuTLS. -# Copyright (C) 2007-2012, 2016 Free Software Foundation, Inc. +# Copyright (C) 2007-2012, 2016, 2019 Free Software Foundation, Inc. # # GnuTLS is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public @@ -101,6 +101,7 @@ TESTS = \ tests/errors.scm \ tests/x509-certificates.scm \ tests/x509-auth.scm \ + tests/reauth.scm \ tests/priorities.scm if ENABLE_SRP diff --git a/guile/modules/gnutls.in b/guile/modules/gnutls.in index d705a0db42..eed0ffcf8e 100644 --- a/guile/modules/gnutls.in +++ b/guile/modules/gnutls.in @@ -1,5 +1,5 @@ ;;; GnuTLS --- Guile bindings for GnuTLS. -;;; Copyright (C) 2007-2012, 2014, 2015, 2016 Free Software Foundation, Inc. +;;; Copyright (C) 2007-2012, 2014, 2015, 2016, 2019 Free Software Foundation, Inc. ;;; ;;; GnuTLS is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -25,7 +25,7 @@ ;; sessions session? - make-session bye handshake rehandshake + make-session bye handshake rehandshake reauthenticate alert-get alert-send session-cipher session-kx session-mac session-protocol session-compression-method session-certificate-type @@ -101,7 +101,8 @@ ;; enum->string functions cipher->string kx->string params->string credentials->string mac->string digest->string compression-method->string - connection-end->string alert-level->string + connection-end->string connection-flag->string + alert-level->string alert-description->string handshake-description->string certificate-status->string certificate-request->string close-request->string @@ -155,6 +156,25 @@ compression-method/lzo connection-end/server connection-end/client + connection-flag/datagram + connection-flag/nonblock + connection-flag/no-extensions + connection-flag/no-replay-protection + connection-flag/no-signal + connection-flag/allow-id-change + connection-flag/enable-false-start + connection-flag/force-client-cert + connection-flag/no-tickets + connection-flag/key-share-top + connection-flag/key-share-top2 + connection-flag/key-share-top3 + connection-flag/post-handshake-auth + connection-flag/no-auto-rekey + connection-flag/safe-padding-check + connection-flag/enable-early-start + connection-flag/enable-rawpk + connection-flag/auto-reauth + connection-flag/enable-early-data alert-level/warning alert-level/fatal alert-description/close-notify @@ -254,6 +274,7 @@ ;; sed -r -e 's|^#define GNUTLS_E_([^ ]+).*$|error/\1|' | tr A-Z_ a-z- error/success error/unsupported-version-packet + error/tls-packet-decoding-error error/unexpected-packet-length error/invalid-session error/fatal-alert-received @@ -269,6 +290,7 @@ error/expired error/db-error error/srp-pwd-error + error/keyfile-error error/insufficient-credentials error/insuficient-credentials error/insufficient-cred @@ -300,6 +322,8 @@ error/too-many-empty-packets error/unknown-pk-algorithm error/too-many-handshake-packets + error/received-disallowed-name + error/certificate-required error/no-temporary-rsa-params error/no-compression-algorithms error/no-cipher-suites @@ -307,6 +331,7 @@ error/pk-sig-verify-failed error/illegal-srp-username error/srp-pwd-parsing-error + error/keyfile-parsing-error error/no-temporary-dh-params error/asn1-element-not-found error/asn1-identifier-not-found @@ -342,6 +367,7 @@ error/unsafe-renegotiation-denied error/unknown-srp-username error/premature-termination + error/malformed-cidr error/base64-encoding-error error/incompatible-gcrypt-library error/incompatible-crypto-library @@ -352,6 +378,7 @@ error/base64-unexpected-header-error error/openpgp-subkey-error error/crypto-already-registered + error/already-registered error/handshake-too-large error/cryptodev-ioctl-error error/cryptodev-device-error @@ -359,6 +386,10 @@ error/bad-cookie error/openpgp-preferred-key-error error/incompat-dsa-key-with-tls-protocol + error/insufficient-security + error/heartbeat-pong-received + error/heartbeat-ping-received + error/unrecognized-name error/pkcs11-error error/pkcs11-load-error error/parsing-error @@ -385,10 +416,65 @@ error/certificate-list-unsorted error/illegal-parameter error/no-priorities-were-set + error/x509-unsupported-extension + error/session-eof + error/tpm-error + error/tpm-key-password-error + error/tpm-srk-password-error + error/tpm-session-error + error/tpm-key-not-found + error/tpm-uninitialized + error/tpm-no-lib + error/no-certificate-status + error/ocsp-response-error + error/random-device-error + error/auth-error + error/no-application-protocol + error/sockets-init-error + error/key-import-failed + error/inappropriate-fallback + error/certificate-verification-error + error/privkey-verification-error + error/unexpected-extensions-length + error/asn1-embedded-null-in-string + error/self-test-error + error/no-self-test + error/lib-in-error-state + error/pk-generation-error + error/idna-error + error/need-fallback + error/session-user-id-changed + error/handshake-during-false-start + error/unavailable-during-handshake + error/pk-invalid-pubkey + error/pk-invalid-privkey + error/not-yet-activated + error/invalid-utf8-string + error/no-embedded-data + error/invalid-utf8-email + error/invalid-password-string + error/certificate-time-error + error/record-overflow + error/asn1-time-error + error/incompatible-sig-with-key + error/pk-invalid-pubkey-params + error/pk-no-validation-params + error/ocsp-mismatch-with-certs + error/no-common-key-share + error/reauth-request + error/too-many-matches + error/crl-verification-error + error/missing-extension + error/db-entry-exists + error/early-data-rejected error/unimplemented-feature + error/int-ret-0 + error/int-check-again error/application-error-max error/application-error-min + fatal-error? + ;; OpenPGP keys (formerly in GnuTLS-extra) openpgp-certificate? openpgp-private-key? import-openpgp-certificate import-openpgp-private-key diff --git a/guile/modules/gnutls/build/enums.scm b/guile/modules/gnutls/build/enums.scm index 1ef46b77a5..6554099f06 100644 --- a/guile/modules/gnutls/build/enums.scm +++ b/guile/modules/gnutls/build/enums.scm @@ -1,5 +1,5 @@ ;;; GnuTLS --- Guile bindings for GnuTLS. -;;; Copyright (C) 2007-2012, 2014 Free Software Foundation, Inc. +;;; Copyright (C) 2007-2012, 2014, 2019 Free Software Foundation, Inc. ;;; ;;; GnuTLS is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -341,6 +341,30 @@ #f "GNUTLS_")) +(define %connection-flag-enum + (make-enum-type 'connection-flag "gnutls_init_flags_t" + '(datagram + nonblock + no-extensions + no-replay-protection + no-signal + allow-id-change + enable-false-start + force-client-cert + no-tickets + key-share-top + key-share-top2 + key-share-top3 + post-handshake-auth + no-auto-rekey + safe-padding-check + enable-early-start + enable-rawpk + auto-reauth + enable-early-data) + #f + "GNUTLS_")) + (define %alert-level-enum (make-enum-type 'alert-level "gnutls_alert_level_t" '(warning fatal) @@ -459,10 +483,11 @@ unrecognized-name unknown-psk-identity) (make-enum-type 'error "int" '( ;; FIXME: Automate this: -;; grep '^#define GNUTLS_E_' ../../../../includes/gnutls/gnutls.h.in \ +;; grep '^#define GNUTLS_E_' ../../../lib/includes/gnutls/gnutls.h.in \ ;; | sed -r -e 's/^#define GNUTLS_E_([^ ]+).*$/\1/' | tr A-Z_ a-z- success unsupported-version-packet +tls-packet-decoding-error unexpected-packet-length invalid-session fatal-alert-received @@ -478,6 +503,7 @@ again expired db-error srp-pwd-error +keyfile-error insufficient-credentials insuficient-credentials insufficient-cred @@ -509,6 +535,8 @@ file-error too-many-empty-packets unknown-pk-algorithm too-many-handshake-packets +received-disallowed-name +certificate-required no-temporary-rsa-params no-compression-algorithms no-cipher-suites @@ -516,6 +544,7 @@ openpgp-getkey-failed pk-sig-verify-failed illegal-srp-username srp-pwd-parsing-error +keyfile-parsing-error no-temporary-dh-params asn1-element-not-found asn1-identifier-not-found @@ -551,6 +580,7 @@ safe-renegotiation-failed unsafe-renegotiation-denied unknown-srp-username premature-termination +malformed-cidr base64-encoding-error incompatible-gcrypt-library incompatible-crypto-library @@ -561,6 +591,7 @@ random-failed base64-unexpected-header-error openpgp-subkey-error crypto-already-registered +already-registered handshake-too-large cryptodev-ioctl-error cryptodev-device-error @@ -568,6 +599,10 @@ channel-binding-not-available bad-cookie openpgp-preferred-key-error incompat-dsa-key-with-tls-protocol +insufficient-security +heartbeat-pong-received +heartbeat-ping-received +unrecognized-name pkcs11-error pkcs11-load-error parsing-error @@ -594,7 +629,60 @@ pkcs11-requested-object-not-availble certificate-list-unsorted illegal-parameter no-priorities-were-set +x509-unsupported-extension +session-eof +tpm-error +tpm-key-password-error +tpm-srk-password-error +tpm-session-error +tpm-key-not-found +tpm-uninitialized +tpm-no-lib +no-certificate-status +ocsp-response-error +random-device-error +auth-error +no-application-protocol +sockets-init-error +key-import-failed +inappropriate-fallback +certificate-verification-error +privkey-verification-error +unexpected-extensions-length +asn1-embedded-null-in-string +self-test-error +no-self-test +lib-in-error-state +pk-generation-error +idna-error +need-fallback +session-user-id-changed +handshake-during-false-start +unavailable-during-handshake +pk-invalid-pubkey +pk-invalid-privkey +not-yet-activated +invalid-utf8-string +no-embedded-data +invalid-utf8-email +invalid-password-string +certificate-time-error +record-overflow +asn1-time-error +incompatible-sig-with-key +pk-invalid-pubkey-params +pk-no-validation-params +ocsp-mismatch-with-certs +no-common-key-share +reauth-request +too-many-matches +crl-verification-error +missing-extension +db-entry-exists +early-data-rejected unimplemented-feature +int-ret-0 +int-check-again application-error-max application-error-min ) @@ -617,7 +705,8 @@ application-error-min (define %gnutls-enums ;; All enums. (list %cipher-enum %kx-enum %params-enum %credentials-enum %mac-enum - %digest-enum %compression-method-enum %connection-end-enum + %digest-enum %compression-method-enum + %connection-end-enum %connection-flag-enum %alert-level-enum %alert-description-enum %handshake-description-enum %certificate-status-enum %certificate-request-enum %close-request-enum %protocol-enum %certificate-type-enum diff --git a/guile/src/core.c b/guile/src/core.c index 7cb0c32bf1..dc6611a4d7 100644 --- a/guile/src/core.c +++ b/guile/src/core.c @@ -29,6 +29,7 @@ #include <libguile.h> #include <alloca.h> +#include <assert.h> #include "enums.h" #include "smobs.h" @@ -128,21 +129,27 @@ SCM_DEFINE (scm_gnutls_version, "gnutls-version", 0, 0, 0, #undef FUNC_NAME -SCM_DEFINE (scm_gnutls_make_session, "make-session", 1, 0, 0, - (SCM end), +SCM_DEFINE (scm_gnutls_make_session, "make-session", 1, 0, 1, + (SCM end, SCM flags), "Return a new session for connection end @var{end}, either " - "@code{connection-end/server} or @code{connection-end/client}.") + "@code{connection-end/server} or @code{connection-end/client}. " + "The optional @var{flags} arguments are @code{connection-flag} " + "values such as @code{connection-flag/auto-reauth}.") #define FUNC_NAME s_scm_gnutls_make_session { - int err; + int err, i; gnutls_session_t c_session; gnutls_connection_end_t c_end; + gnutls_init_flags_t c_flags = 0; SCM session_data; c_end = scm_to_gnutls_connection_end (end, 1, FUNC_NAME); session_data = SCM_GNUTLS_MAKE_SESSION_DATA (); - err = gnutls_init (&c_session, c_end); + for (i = 2; scm_is_pair (flags); flags = scm_cdr (flags), i++) + c_flags |= scm_to_gnutls_connection_flag (scm_car (flags), i, FUNC_NAME); + + err = gnutls_init (&c_session, c_end | c_flags); if (EXPECT_FALSE (err)) scm_gnutls_error (err, FUNC_NAME); @@ -208,7 +215,24 @@ SCM_DEFINE (scm_gnutls_rehandshake, "rehandshake", 1, 0, 0, return SCM_UNSPECIFIED; } +#undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_reauthenticate, "reauthenticate", 1, 0, 0, + (SCM session), "Perform a re-authentication step for @var{session}.") +#define FUNC_NAME s_scm_gnutls_reauthenticate +{ + int err; + gnutls_session_t c_session; + + c_session = scm_to_gnutls_session (session, 1, FUNC_NAME); + /* FIXME: Allow flags as an argument. */ + err = gnutls_reauth (c_session, 0); + if (EXPECT_FALSE (err)) + scm_gnutls_error (err, FUNC_NAME); + + return SCM_UNSPECIFIED; +} #undef FUNC_NAME SCM_DEFINE (scm_gnutls_alert_get, "alert-get", 1, 0, 0, @@ -881,8 +905,15 @@ do_fill_port (void *data) const fill_port_data_t *args = (fill_port_data_t *) data; c_port = args->c_port; - result = gnutls_record_recv (args->c_session, - c_port->read_buf, c_port->read_buf_size); + + /* We can get GNUTLS_E_AGAIN due to a "short read", which does _not_ + correspond to an actual EAGAIN from read(2) since the underlying file + descriptor is blocking. Thus, we can safely loop right away. */ + do + result = gnutls_record_recv (args->c_session, + c_port->read_buf, c_port->read_buf_size); + while (result == GNUTLS_E_AGAIN || result == GNUTLS_E_INTERRUPTED); + if (EXPECT_TRUE (result > 0)) { c_port->read_pos = c_port->read_buf; @@ -1008,9 +1039,25 @@ read_from_session_record_port (SCM port, SCM dst, size_t start, size_t count) read_buf = (char *) SCM_BYTEVECTOR_CONTENTS (dst) + start; - /* XXX: Leave guile mode when SCM_GNUTLS_SESSION_TRANSPORT_IS_FD is - true? */ - result = gnutls_record_recv (c_session, read_buf, count); + /* We can get GNUTLS_E_AGAIN due to a "short read", which does _not_ + correspond to an actual EAGAIN from read(2) if the underlying file + descriptor is blocking--e.g., from 'get_last_packet', returning + GNUTLS_E_REQUESTED_DATA_NOT_AVAILABLE. + + If SESSION is backed by a file descriptor, return -1 to indicate that + we'd better poll; otherwise loop, which is good enough if the underlying + port is blocking. */ + do + result = gnutls_record_recv (c_session, read_buf, count); + while (result == GNUTLS_E_INTERRUPTED + || (result == GNUTLS_E_AGAIN + && !SCM_GNUTLS_SESSION_TRANSPORT_IS_FD (c_session))); + + if (result == GNUTLS_E_AGAIN + && SCM_GNUTLS_SESSION_TRANSPORT_IS_FD (c_session)) + /* Tell Guile that reading would block. */ + return (size_t) -1; + if (EXPECT_FALSE (result < 0)) /* FIXME: Silently swallowed! */ scm_gnutls_error (result, FUNC_NAME); @@ -1019,6 +1066,22 @@ read_from_session_record_port (SCM port, SCM dst, size_t start, size_t count) } #undef FUNC_NAME +/* Return the file descriptor that backs PORT. This function is called upon a + blocking read--i.e., 'read_from_session_record_port' returned -1. */ +static int +session_record_port_fd (SCM port) +{ + SCM session; + gnutls_session_t c_session; + + session = SCM_GNUTLS_SESSION_RECORD_PORT_SESSION (port); + c_session = scm_to_gnutls_session (session, 1, __func__); + + assert (SCM_GNUTLS_SESSION_TRANSPORT_IS_FD (c_session)); + + return gnutls_transport_get_int (c_session); +} + static size_t write_to_session_record_port (SCM port, SCM src, size_t start, size_t count) #define FUNC_NAME "write_to_session_record_port" @@ -1092,6 +1155,11 @@ scm_init_gnutls_session_record_port_type (void) #endif write_to_session_record_port); +#if !USING_GUILE_BEFORE_2_2 + scm_set_port_read_wait_fd (session_record_port_type, + session_record_port_fd); +#endif + /* Guile >= 1.9.3 doesn't need a custom mark procedure, and doesn't need a finalizer (since memory associated with the port is automatically reclaimed.) */ diff --git a/guile/src/errors.c b/guile/src/errors.c index 102be5180b..a78f2ffef8 100644 --- a/guile/src/errors.c +++ b/guile/src/errors.c @@ -1,5 +1,5 @@ /* GnuTLS --- Guile bindings for GnuTLS. - Copyright (C) 2007-2012 Free Software Foundation, Inc. + Copyright (C) 2007-2012, 2019 Free Software Foundation, Inc. GnuTLS is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -52,6 +52,16 @@ scm_gnutls_error (int c_err, const char *c_func) scm_gnutls_error_with_args (c_err, c_func, SCM_EOL); } +SCM_DEFINE (scm_gnutls_fatal_error_p, "fatal-error?", 1, 0, 0, + (SCM err), + "Return true if @var{error} is fatal.") +#define FUNC_NAME s_scm_gnutls_fatal_error_p +{ + int c_err = scm_to_gnutls_error (err, 1, FUNC_NAME); + return scm_from_bool (gnutls_error_is_fatal (c_err)); +} +#undef FUNC_NAME + void diff --git a/guile/tests/errors.scm b/guile/tests/errors.scm index 4d4d958f85..b8d46234ab 100644 --- a/guile/tests/errors.scm +++ b/guile/tests/errors.scm @@ -1,5 +1,5 @@ ;;; GnuTLS --- Guile bindings for GnuTLS. -;;; Copyright (C) 2007-2012 Free Software Foundation, Inc. +;;; Copyright (C) 2007-2012, 2019 Free Software Foundation, Inc. ;;; ;;; GnuTLS is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -26,15 +26,19 @@ (gnutls build tests)) (run-test - (lambda () - (let ((s (make-session connection-end/server))) - (catch 'gnutls-error - (lambda () - (handshake s)) - (lambda (key err function . currently-unused) - (and (eq? key 'gnutls-error) - err - (string? (error->string err)) - (eq? function 'handshake))))))) + (lambda () + (and (fatal-error? error/hash-failed) + (not (fatal-error? error/reauth-request)) + + (let ((s (make-session connection-end/server))) + (catch 'gnutls-error + (lambda () + (handshake s)) + (lambda (key err function . currently-unused) + (and (eq? key 'gnutls-error) + err + (fatal-error? err) + (string? (error->string err)) + (eq? function 'handshake)))))))) ;;; arch-tag: 73ed6229-378d-4a12-a5c6-4c2586c6e3a2 diff --git a/guile/tests/reauth.scm b/guile/tests/reauth.scm new file mode 100644 index 0000000000..0f768e514e --- /dev/null +++ b/guile/tests/reauth.scm @@ -0,0 +1,121 @@ +;;; GnuTLS --- Guile bindings for GnuTLS. +;;; Copyright (C) 2019 Free Software Foundation, Inc. +;;; +;;; GnuTLS is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public +;;; License as published by the Free Software Foundation; either +;;; version 2.1 of the License, or (at your option) any later version. +;;; +;;; GnuTLS 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 +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with GnuTLS; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Written by Ludovic Courtès <ludo@chbouib.org>. + + +;;; +;;; Test TLS 1.3 re-authentication requests. +;;; + +(use-modules (gnutls) + (gnutls build tests) + (srfi srfi-4)) + + +;; TLS session settings. +(define priorities + "NORMAL:+VERS-TLS1.3") + +;; Message sent by the client. +(define %message + (cons "hello, world!" (iota 4444))) + +(define (import-something import-proc file fmt) + (let* ((path (search-path %load-path file)) + (size (stat:size (stat path))) + (raw (make-u8vector size))) + (uniform-vector-read! raw (open-input-file path)) + (import-proc raw fmt))) + +(define (import-key import-proc file) + (import-something import-proc file x509-certificate-format/pem)) + +(define (import-dh-params file) + (import-something pkcs3-import-dh-parameters file + x509-certificate-format/pem)) + +;; Debugging. +;; (set-log-level! 5) +;; (set-log-procedure! (lambda (level str) +;; (format #t "[~a|~a] ~a" (getpid) level str))) + +(run-test + (lambda () + (let ((socket-pair (socketpair PF_UNIX SOCK_STREAM 0)) + (pub (import-key import-x509-certificate + "x509-certificate.pem")) + (sec (import-key import-x509-private-key + "x509-key.pem"))) + (with-child-process pid + + ;; server-side + (let ((server (make-session connection-end/server + connection-flag/post-handshake-auth)) + (dh (import-dh-params "dh-parameters.pem"))) + (set-session-priorities! server "NORMAL:+VERS-TLS1.3") + (set-session-transport-fd! server (port->fdes (cdr socket-pair))) + (let ((cred (make-certificate-credentials)) + (trust-file (search-path %load-path + "x509-certificate.pem")) + (trust-fmt x509-certificate-format/pem)) + (set-certificate-credentials-dh-parameters! cred dh) + (set-certificate-credentials-x509-keys! cred (list pub) sec) + (set-certificate-credentials-x509-trust-file! cred + trust-file + trust-fmt) + (set-session-credentials! server cred)) + + (handshake server) + (let ((msg (read (session-record-port server))) + (auth-type (session-authentication-type server))) + (set-server-session-certificate-request! server + certificate-request/request) + + ;; Request a post-handshake reauthentication. + (reauthenticate server) + + (write msg (session-record-port server)) + (bye server close-request/rdwr) + (and (zero? (cdr (waitpid pid))) + (eq? auth-type credentials/certificate) + (equal? msg %message)))) + + ;; client-side (child process) + (let ((client (make-session connection-end/client + connection-flag/post-handshake-auth + connection-flag/auto-reauth)) + (cred (make-certificate-credentials))) + (set-session-priorities! client + "NORMAL:-VERS-ALL:+VERS-TLS1.3:+VERS-TLS1.2:+VERS-TLS1.0") + (set-certificate-credentials-x509-keys! cred (list pub) sec) + (set-session-credentials! client cred) + + (set-session-transport-fd! client (port->fdes (car socket-pair))) + + (handshake client) + (write %message (session-record-port client)) + + ;; In the middle of the 'read' call, we receive a post-handshake + ;; reauthentication request that should be automatically handled, + ;; thanks to CONNECTION-FLAG/AUTO-REAUTH. + (let ((msg (read (session-record-port client)))) + (unless (equal? msg %message) + (error "wrong message" msg))) + (bye client close-request/rdwr) + + (primitive-exit)))))) |