diff options
| -rw-r--r-- | guile/modules/gnutls.in | 6 | ||||
| -rw-r--r-- | guile/modules/gnutls/build/enums.scm | 9 | ||||
| -rw-r--r-- | guile/src/core.c | 34 | ||||
| -rw-r--r-- | guile/tests/anonymous-auth.scm | 3 |
4 files changed, 46 insertions, 6 deletions
diff --git a/guile/modules/gnutls.in b/guile/modules/gnutls.in index 383a9bac25..a70630e2f6 100644 --- a/guile/modules/gnutls.in +++ b/guile/modules/gnutls.in @@ -1,5 +1,5 @@ ;;; GnuTLS --- Guile bindings for GnuTLS. -;;; Copyright (C) 2007-2012 Free Software Foundation, Inc. +;;; Copyright (C) 2007-2012, 2014 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 @@ -34,6 +34,7 @@ session-peer-certificate-chain session-our-certificate-chain set-session-transport-fd! set-session-transport-port! set-session-credentials! set-server-session-certificate-request! + set-session-server-name! ;; anonymous credentials anonymous-client-credentials? anonymous-server-credentials? @@ -120,7 +121,7 @@ x509-subject-alternative-name->string pk-algorithm->string sign-algorithm->string psk-key-format->string key-usage->string certificate-verify->string error->string - cipher-suite->string + cipher-suite->string server-name-type->string ;; enum values cipher/null @@ -257,6 +258,7 @@ certificate-verify/allow-any-x509-v1-ca-certificate certificate-verify/allow-sign-rsa-md2 certificate-verify/allow-sign-rsa-md5 + server-name-type/dns ;; FIXME: Automate this: ;; grep '^#define GNUTLS_E_' ../../lib/includes/gnutls/gnutls.h.in | \ diff --git a/guile/modules/gnutls/build/enums.scm b/guile/modules/gnutls/build/enums.scm index 1d7915d26a..1ef46b77a5 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 Free Software Foundation, Inc. +;;; Copyright (C) 2007-2012, 2014 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 @@ -608,6 +608,11 @@ application-error-min #f "GNUTLS_OPENPGP_FMT_")) +(define %server-name-type-enum + (make-enum-type 'server-name-type "gnutls_server_name_type_t" + '(dns) + #f + "GNUTLS_NAME_")) (define %gnutls-enums ;; All enums. @@ -617,7 +622,7 @@ application-error-min %certificate-status-enum %certificate-request-enum %close-request-enum %protocol-enum %certificate-type-enum %x509-certificate-format-enum %x509-subject-alternative-name-enum - %pk-algorithm-enum %sign-algorithm-enum + %pk-algorithm-enum %sign-algorithm-enum %server-name-type-enum %psk-key-format-enum %key-usage-enum %certificate-verify-enum %error-enum diff --git a/guile/src/core.c b/guile/src/core.c index b40e93e608..b2f0869030 100644 --- a/guile/src/core.c +++ b/guile/src/core.c @@ -1,5 +1,5 @@ /* GnuTLS --- Guile bindings for GnuTLS. - Copyright (C) 2007-2013 Free Software Foundation, Inc. + Copyright (C) 2007-2014 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 @@ -695,6 +695,38 @@ SCM_DEFINE (scm_gnutls_set_session_credentials_x, "set-session-credentials!", } #undef FUNC_NAME + +SCM_DEFINE (scm_gnutls_set_session_server_name_x, "set-session-server-name!", + 3, 0, 0, + (SCM session, SCM type, SCM name), + "For a client, this procedure provides a way to inform " + "the server that it is known under @var{name}, @i{via} the " + "@code{SERVER NAME} TLS extension. @var{type} must be " + "a @code{server-name-type} value, @var{server-name-type/dns} " + "for DNS names.") +#define FUNC_NAME s_scm_gnutls_set_session_server_name_x +{ + int err; + gnutls_session_t c_session; + gnutls_server_name_type_t c_type; + char *c_name; + + c_session = scm_to_gnutls_session (session, 1, FUNC_NAME); + c_type = scm_to_gnutls_server_name_type (type, 2, FUNC_NAME); + SCM_VALIDATE_STRING (3, name); + + c_name = scm_to_locale_string (name); + + err = gnutls_server_name_set (c_session, c_type, c_name, + strlen (c_name) + 1); + free (c_name); + + if (EXPECT_FALSE (err != GNUTLS_E_SUCCESS)) + scm_gnutls_error (err, FUNC_NAME); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME /* Record layer. */ diff --git a/guile/tests/anonymous-auth.scm b/guile/tests/anonymous-auth.scm index ded0c63c0b..585b3a5cca 100644 --- a/guile/tests/anonymous-auth.scm +++ b/guile/tests/anonymous-auth.scm @@ -60,7 +60,8 @@ (let ((client (make-session connection-end/client))) ;; client-side (child process) (set-session-priorities! client priorities) - + (set-session-server-name! client + server-name-type/dns (gethostname)) (set-session-transport-fd! client (port->fdes (car socket-pair))) (set-session-credentials! client (make-anonymous-client-credentials)) (set-session-dh-prime-bits! client 1024) |