diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-06-12 11:37:39 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-06-12 22:27:00 +0200 |
commit | 64e4ad8a8b71e829d86bad55bc3d9b0f3a0fe745 (patch) | |
tree | 2da5c4f08fc994801c3d039981ad81248d80df02 | |
parent | a229bb36c9592b151f6feb277238c41ab39f40a9 (diff) | |
download | gnutls-64e4ad8a8b71e829d86bad55bc3d9b0f3a0fe745.tar.gz |
guile: Add support for post-handshake reauthentication.
* guile/modules/gnutls/build/enums.scm (%connection-flag-enum): New
variable.
(%gnutls-enums): Add it.
* guile/modules/gnutls.in: Export 'reauthenticate',
'connection-flag->string', and all the 'connection-flag/' bindings.
* guile/src/core.c (scm_gnutls_make_session): Add rest arguments FLAGS
and honor it.
(scm_gnutls_reauthenticate): New function.
* guile/tests/reauth.scm: New file.
* guile/Makefile.am (TESTS): Add it.
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
-rw-r--r-- | guile/Makefile.am | 3 | ||||
-rw-r--r-- | guile/modules/gnutls.in | 24 | ||||
-rw-r--r-- | guile/modules/gnutls/build/enums.scm | 27 | ||||
-rw-r--r-- | guile/src/core.c | 33 | ||||
-rw-r--r-- | guile/tests/reauth.scm | 121 |
5 files changed, 199 insertions, 9 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 e935d96270..eed0ffcf8e 100644 --- a/guile/modules/gnutls.in +++ b/guile/modules/gnutls.in @@ -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 diff --git a/guile/modules/gnutls/build/enums.scm b/guile/modules/gnutls/build/enums.scm index 7bfb5d2533..6554099f06 100644 --- a/guile/modules/gnutls/build/enums.scm +++ b/guile/modules/gnutls/build/enums.scm @@ -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) @@ -681,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 a3b3e9f740..dc6611a4d7 100644 --- a/guile/src/core.c +++ b/guile/src/core.c @@ -129,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); @@ -209,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, 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)))))) |