guile: Add bindings for 'gnutls_error_is_fatal'.

* guile/src/errors.c (scm_gnutls_fatal_error_p): New function.
* guile/modules/gnutls.in: Export 'fatal-error?'.
* guile/tests/errors.scm: test 'fatal-error?'.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>

diff --git a/guile/modules/gnutls.in b/guile/modules/gnutls.in
index 98eda3fdc99ebb539f3ec448f2adaad52e63602c..e935d962701850b63ec7fd1fa0cc33a2670df24e 100644 (file)
--- a/guile/modules/gnutls.in
+++ b/guile/modules/gnutls.in
@@ -453,6 +453,8 @@
            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/src/errors.c b/guile/src/errors.c
index 102be5180bf8a8057e584ec8683169bab26dcf16..a78f2ffef8054351d3f07045ef29b62f63eb4cab 100644 (file)
--- 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
+
 \f
 
 void

diff --git a/guile/tests/errors.scm b/guile/tests/errors.scm
index 4d4d958f85f9269bddafca0d75994430d64282ae..b8d46234ab4d8bdf954155488fdbb79d2b3f7fc1 100644 (file)
--- 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