guile: Add bindings for 'gnutls_server_name_set'.

This adds the 'set-session-server-name!' procedure and the
'server-name-type' enum type.

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)