[SCM] GNU gnutls branch, master, updated. gnutls_2_11_6-249-gff30c8e

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU gnutls".

http://git.savannah.gnu.org/cgit/gnutls.git/commit/?id=ff30c8e72faa2aa4a75630ec9fcea9cac9b4cdce

The branch, master has been updated
       via  ff30c8e72faa2aa4a75630ec9fcea9cac9b4cdce (commit)
      from  f5c363dcaeb9ad068725c6c3c6e6b24266241ee4 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit ff30c8e72faa2aa4a75630ec9fcea9cac9b4cdce
Author: Ludovic Courtès <address@hidden>
Date:   Sun Feb 27 19:51:57 2011 +0100

    guile: Wrap `gnutls_priority_set_direct'; deprecate the old method.

-----------------------------------------------------------------------

Summary of changes:
 guile/modules/gnutls.scm                  |    7 ++-
 guile/modules/gnutls/build/enums.scm      |    1 +
 guile/modules/gnutls/build/priorities.scm |    5 ++-
 guile/src/core.c                          |   44 ++++++++++++++++-
 guile/src/errors.c                        |   13 ++++-
 guile/src/errors.h                        |   14 +++---
 guile/tests/Makefile.am                   |   11 ++--
 guile/tests/priorities.scm                |   76 +++++++++++++++++++++++++++++
 8 files changed, 152 insertions(+), 19 deletions(-)
 create mode 100644 guile/tests/priorities.scm

diff --git a/guile/modules/gnutls.scm b/guile/modules/gnutls.scm
index ed5efd8..0f4aa62 100644
--- a/guile/modules/gnutls.scm
+++ b/guile/modules/gnutls.scm
@@ -1,5 +1,5 @@
 ;;; GnuTLS --- Guile bindings for GnuTLS.
-;;; Copyright (C) 2007, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2007, 2010, 2011 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
@@ -70,7 +70,10 @@
            set-psk-server-credentials-file!
            server-session-psk-username
 
-           ;; priority functions
+           ;; priorities
+           set-session-priorities!
+
+           ;; priority functions (deprecated)
            set-session-cipher-priority! set-session-mac-priority!
            set-session-compression-method-priority!
            set-session-kx-priority! set-session-protocol-priority!
diff --git a/guile/modules/gnutls/build/enums.scm 
b/guile/modules/gnutls/build/enums.scm
index 91b6161..8f53d8e 100644
--- a/guile/modules/gnutls/build/enums.scm
+++ b/guile/modules/gnutls/build/enums.scm
@@ -485,6 +485,7 @@ insufficient-credentials
 insuficient-credentials
 insufficient-cred
 insuficient-cred
+invalid-request
 hash-failed
 base64-decoding-error
 mpi-print-failed
diff --git a/guile/modules/gnutls/build/priorities.scm 
b/guile/modules/gnutls/build/priorities.scm
index 3cd733a..479e601 100644
--- a/guile/modules/gnutls/build/priorities.scm
+++ b/guile/modules/gnutls/build/priorities.scm
@@ -1,5 +1,5 @@
 ;;; GnuTLS --- Guile bindings for GnuTLS.
-;;; Copyright (C) 2007, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2007, 2010, 2011 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
@@ -64,6 +64,9 @@
     (format port "  ~a *c_items;~%"
             (enum-type-c-type enum))
     (format port "  long int c_len, i;~%")
+    (format port "  scm_c_issue_deprecation_warning \
+(\"`set-session-~a-priority!'is deprecated, \
+use `set-session-priorities!' instead\");~%" (enum-type-subsystem enum))
     (format port "  c_session = scm_to_gnutls_session (session, 1, 
FUNC_NAME);~%")
     (format port "  SCM_VALIDATE_LIST_COPYLEN (2, items, c_len);~%")
     (format port "  c_items = (~a *) alloca (sizeof (* c_items) * c_len);~%"
diff --git a/guile/src/core.c b/guile/src/core.c
index dfe0fc3..e0b264b 100644
--- a/guile/src/core.c
+++ b/guile/src/core.c
@@ -1,5 +1,5 @@
 /* GnuTLS --- Guile bindings for GnuTLS.
-   Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+   Copyright (C) 2007, 2008, 2009, 2010, 2011 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
@@ -532,7 +532,49 @@ SCM_DEFINE (scm_gnutls_set_default_export_priority_x,
 
   return SCM_UNSPECIFIED;
 }
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gnutls_set_session_priorities_x,
+           "set-session-priorities!", 2, 0, 0,
+           (SCM session, SCM priorities),
+           "Have @var{session} use the given @var{priorities} for "
+           "the ciphers, key exchange methods, MACs and compression "
+           "methods.  @var{priorities} must be a string; see the "
+           "manual for the syntax.  When @var{priorities} cannot be "
+           "parsed, an @code{error/invalid-request} error is raised, "
+           "with an extra argument indication the position of the "
+           "error.\n")
+#define FUNC_NAME s_scm_gnutls_set_session_priorities_x
+{
+  int err;
+  char *c_priorities;
+  const char *err_pos;
+  gnutls_session_t c_session;
+
+  c_session = scm_to_gnutls_session (session, 1, FUNC_NAME);
+  c_priorities = scm_to_locale_string (priorities); /* XXX: to_latin1_string */
 
+  err = gnutls_priority_set_direct (c_session, c_priorities, &err_pos);
+  free (c_priorities);
+
+  switch (err)
+    {
+    case GNUTLS_E_SUCCESS:
+      break;
+    case GNUTLS_E_INVALID_REQUEST:
+      {
+       size_t pos;
+       pos = err_pos - c_priorities;
+       scm_gnutls_error_with_args (err, FUNC_NAME,
+                                   scm_list_1 (scm_from_size_t (pos)));
+       break;
+      }
+    default:
+      scm_gnutls_error (err, FUNC_NAME);
+    }
+
+  return SCM_UNSPECIFIED;
+}
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_gnutls_cipher_suite_to_string, "cipher-suite->string",
diff --git a/guile/src/errors.c b/guile/src/errors.c
index b2bbd8f..987dd42 100644
--- a/guile/src/errors.c
+++ b/guile/src/errors.c
@@ -1,5 +1,5 @@
 /* GnuTLS --- Guile bindings for GnuTLS.
-   Copyright (C) 2007, 2009, 2010 Free Software Foundation, Inc.
+   Copyright (C) 2007, 2009, 2010, 2011 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
@@ -30,7 +30,7 @@
 SCM_SYMBOL (gnutls_error_key, "gnutls-error");
 
 void
-scm_gnutls_error (int c_err, const char *c_func)
+scm_gnutls_error_with_args (int c_err, const char *c_func, SCM args)
 {
   SCM err, func;
 
@@ -38,13 +38,20 @@ scm_gnutls_error (int c_err, const char *c_func)
   err = scm_from_gnutls_error (c_err);
   func = scm_from_locale_symbol (c_func);
 
-  (void) scm_throw (gnutls_error_key, scm_list_2 (err, func));
+  (void) scm_throw (gnutls_error_key, scm_cons2 (err, func, args));
 
   /* XXX: This is actually never reached, but since the Guile headers don't
      declare `scm_throw ()' as `noreturn', we must add this to avoid GCC's
      complaints.  */
   abort ();
 }
+
+void
+scm_gnutls_error (int c_err, const char *c_func)
+{
+  scm_gnutls_error_with_args (c_err, c_func, SCM_EOL);
+}
+
 
 
 void
diff --git a/guile/src/errors.h b/guile/src/errors.h
index 337cdb6..341807d 100644
--- a/guile/src/errors.h
+++ b/guile/src/errors.h
@@ -1,5 +1,5 @@
 /* GnuTLS --- Guile bindings for GnuTLS.
-   Copyright (C) 2007, 2010 Free Software Foundation, Inc.
+   Copyright (C) 2007, 2010, 2011 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
@@ -22,12 +22,12 @@
 
 #include "utils.h"
 
-SCM_API void
-scm_gnutls_error (int, const char *)
+SCM_API void scm_gnutls_error_with_args (int, const char *, SCM)
   NO_RETURN;
-     SCM_API void scm_init_gnutls_error (void);
 
-#endif
+SCM_API void scm_gnutls_error (int, const char *)
+  NO_RETURN;
 
-/* arch-tag: e7a92e44-b399-4c85-99d4-2dd3564600f7
- */
+SCM_API void scm_init_gnutls_error (void);
+
+#endif
diff --git a/guile/tests/Makefile.am b/guile/tests/Makefile.am
index 0832b1e..49aaf54 100644
--- a/guile/tests/Makefile.am
+++ b/guile/tests/Makefile.am
@@ -1,5 +1,5 @@
 #  GnuTLS --- Guile bindings for GnuTLS.
-#  Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+#  Copyright (C) 2007, 2008, 2009, 2010, 2011 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
@@ -15,10 +15,11 @@
 #  License along with GnuTLS; if not, write to the Free Software
 #  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  
USA
 
-TESTS = anonymous-auth.scm session-record-port.scm             \
-        pkcs-import-export.scm                                 \
-        errors.scm                                             \
-       x509-certificates.scm x509-auth.scm
+TESTS = anonymous-auth.scm session-record-port.scm     \
+        pkcs-import-export.scm                         \
+        errors.scm                                     \
+       x509-certificates.scm x509-auth.scm             \
+       priorities.scm
 
 if ENABLE_OPENPGP
 TESTS += openpgp-keys.scm openpgp-keyring.scm openpgp-auth.scm
diff --git a/guile/tests/priorities.scm b/guile/tests/priorities.scm
new file mode 100644
index 0000000..1ee072b
--- /dev/null
+++ b/guile/tests/priorities.scm
@@ -0,0 +1,76 @@
+;;; GnuTLS --- Guile bindings for GnuTLS
+;;; Copyright (C) 2011 Free Software Foundation, Inc.
+;;;
+;;; GnuTLS is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GnuTLS-EXTRA; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+;;; Written by Ludovic Courtès <address@hidden>.
+
+
+;;;
+;;; Exercise the priority API of GnuTLS.
+;;;
+
+(use-modules (gnutls)
+             (srfi srfi-26))
+
+(define %valid-priority-strings
+  ;; Valid priority strings (from the manual).
+  '("NONE:+VERS-TLS-ALL:+MAC-ALL:+RSA:+AES-128-CBC:+SIGN-ALL:+COMP-NULL"
+    "NORMAL:-ARCFOUR-128"
+    "SECURE:-VERS-SSL3.0:+COMP-DEFLATE"
+    "NONE:+VERS-TLS-ALL:+AES-128-CBC:+RSA:+SHA1:+COMP-NULL:+SIGN-RSA-SHA1"))
+
+(define %invalid-priority-strings
+  ;; Invalid strings: the prefix and the suffix that leads to a parse error.
+  '(("" . "THIS-DOES-NOT-WORK")
+    ("NORMAL:" . "FAIL-HERE")
+    ("SECURE:-VERS-SSL3.0:" . "+FAIL-HERE")
+    ("NONE:+VERS-TLS-ALL:+AES-128-CBC:"
+     . "+FAIL-HERE:+SHA1:+COMP-NULL:+SIGN-RSA-SHA1")))
+
+(dynamic-wind
+
+    (lambda ()
+      #t)
+
+    (lambda ()
+      (let ((s (make-session connection-end/client)))
+        ;; We shouldn't have any exception with the valid priority strings.
+        (for-each (cut set-session-priorities! s <>)
+                  %valid-priority-strings)
+
+        (for-each (lambda (prefix+suffix)
+                    (let* ((prefix (car prefix+suffix))
+                           (suffix (cdr prefix+suffix))
+                           (pos    (string-length prefix))
+                           (string (string-append prefix suffix)))
+                      (catch 'gnutls-error
+                        (lambda ()
+                          (let ((s (make-session connection-end/client)))
+                            (set-session-priorities! s string)))
+                        (lambda (key err function error-location . unused)
+                          (or (and (eq? key 'gnutls-error)
+                                   (eq? err error/invalid-request)
+                                   (eq? function 'set-session-priorities!)
+                                   (= error-location pos))
+                              (exit 1))))))
+                  %invalid-priority-strings)
+
+        (exit 0)))
+
+    (lambda ()
+      ;; failure
+      (exit 1)))


hooks/post-receive
-- 
GNU gnutls