diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-06-07 11:06:18 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-06-12 22:27:00 +0200 |
commit | d762aa6b6d90c473366fc45ae08518a56af69b93 (patch) | |
tree | 5006e1b8c306347ef2de606ebd6f2258fcbaeaec /guile | |
parent | bc8f21b30b9320d4e4bd97d034e9635777389445 (diff) | |
download | gnutls-d762aa6b6d90c473366fc45ae08518a56af69b93.tar.gz |
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>
Diffstat (limited to 'guile')
-rw-r--r-- | guile/modules/gnutls.in | 2 | ||||
-rw-r--r-- | guile/src/errors.c | 12 | ||||
-rw-r--r-- | guile/tests/errors.scm | 26 |
3 files changed, 28 insertions, 12 deletions
diff --git a/guile/modules/gnutls.in b/guile/modules/gnutls.in index 98eda3fdc9..e935d96270 100644 --- 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 102be5180b..a78f2ffef8 100644 --- 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 + void diff --git a/guile/tests/errors.scm b/guile/tests/errors.scm index 4d4d958f85..b8d46234ab 100644 --- 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 |