Author: ludo
Date: Thu Apr 28 20:57:54 2011
New Revision: 27039
URL: https://svn.nixos.org/websvn/nix/?rev=27039&sc=1
Log:
GnuTLS 2.12.3.
Added:
nixpkgs/trunk/pkgs/development/libraries/gnutls/fix-guile-tests.patch
Deleted:
nixpkgs/trunk/pkgs/development/libraries/gnutls/no-libgcrypt.patch
Modified:
nixpkgs/trunk/pkgs/development/libraries/gnutls/default.nix
Modified: nixpkgs/trunk/pkgs/development/libraries/gnutls/default.nix
==============================================================================
--- nixpkgs/trunk/pkgs/development/libraries/gnutls/default.nix Thu Apr 28
20:57:48 2011 (r27038)
+++ nixpkgs/trunk/pkgs/development/libraries/gnutls/default.nix Thu Apr 28
20:57:54 2011 (r27039)
@@ -5,14 +5,14 @@
stdenv.mkDerivation rec {
- name = "gnutls-2.12.2";
+ name = "gnutls-2.12.3";
src = fetchurl {
url = "mirror://gnu/gnutls/${name}.tar.bz2";
- sha256 = "0hvymf1q3d63hbi3hia876alaq7asprgwzhy49192i2h2gjlx5nc";
+ sha256 = "1lrr4mkv6ygi4r8gqfgv528wc9lhqfs60wnlgj0w59iz1nhxpcwz";
};
- patches = [ ./no-libgcrypt.patch ];
+ patches = [ ./fix-guile-tests.patch ];
configurePhase = ''
./configure --prefix="$out" \
Added: nixpkgs/trunk/pkgs/development/libraries/gnutls/fix-guile-tests.patch
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ nixpkgs/trunk/pkgs/development/libraries/gnutls/fix-guile-tests.patch
Thu Apr 28 20:57:54 2011 (r27039)
@@ -0,0 +1,632 @@
+From ccbd77f6dc0b8440e7d80bddce2c8f950674eb46 Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <[email protected]>
+Date: Thu, 28 Apr 2011 19:41:08 +0200
+Subject: [PATCH] guile: Fix tests to match the `exit' behavior introduced in
Guile 2.0.1.
+
+This fix makes tests behave correctly wrt. to the Guile bug fix at
+<http://git.sv.gnu.org/cgit/guile.git/commit/?id=e309f3bf9ee910c4772353ca3ff95f6f4ef466b5>.
+---
+ guile/modules/Makefile.am | 3 +-
+ guile/modules/gnutls/build/tests.scm | 41 ++++++++++++++++++++++++++++++++++
+ guile/tests/anonymous-auth.scm | 18 +++++----------
+ guile/tests/errors.scm | 22 ++++++-----------
+ guile/tests/openpgp-auth.scm | 18 +++++----------
+ guile/tests/openpgp-keyring.scm | 24 ++++++-------------
+ guile/tests/openpgp-keys.scm | 35 +++++++++++-----------------
+ guile/tests/pkcs-import-export.scm | 32 ++++++++++----------------
+ guile/tests/session-record-port.scm | 26 ++++++++-------------
+ guile/tests/srp-base64.scm | 15 +++++++-----
+ guile/tests/x509-auth.scm | 18 +++++----------
+ guile/tests/x509-certificates.scm | 41 ++++++++++++++-------------------
+ 12 files changed, 139 insertions(+), 154 deletions(-)
+ create mode 100644 guile/modules/gnutls/build/tests.scm
+
+diff --git a/guile/modules/Makefile.am b/guile/modules/Makefile.am
+index c1829ed..d1b1cac 100644
+--- a/guile/modules/Makefile.am
++++ b/guile/modules/Makefile.am
+@@ -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
+@@ -25,4 +25,5 @@ documentation_modules = system/documentation/README
\
+
+ EXTRA_DIST = gnutls/build/enums.scm gnutls/build/smobs.scm \
+ gnutls/build/utils.scm gnutls/build/priorities.scm \
++ gnutls/build/tests.scm \
+ $(documentation_modules)
+diff --git a/guile/modules/gnutls/build/tests.scm
b/guile/modules/gnutls/build/tests.scm
+new file mode 100644
+index 0000000..ca3985f
+--- /dev/null
++++ b/guile/modules/gnutls/build/tests.scm
+@@ -0,0 +1,41 @@
++;;; 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 Lesser General Public
++;;; License as published by the Free Software Foundation; either
++;;; version 2.1 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
++;;; Lesser General Public License for more details.
++;;;
++;;; You should have received a copy of the GNU Lesser General Public
++;;; License along with GnuTLS; if not, write to the Free Software
++;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
++
++;;; Written by Ludovic Courtès <[email protected]>.
++
++(define-module (gnutls build tests)
++ #:export (run-test))
++
++(define (run-test thunk)
++ "Call `(exit (THUNK))'. If THUNK raises an exception, then call `(exit 1)'
and
++display a backtrace. Otherwise, return THUNK's return value."
++ (exit
++ (catch #t
++ thunk
++ (lambda (key . args)
++ ;; Never reached.
++ (exit 1))
++ (lambda (key . args)
++ (dynamic-wind ;; to be on the safe side
++ (lambda () #t)
++ (lambda ()
++ (format (current-error-port)
++ "~%throw to `~a' with args ~s~%" key args)
++ (display-backtrace (make-stack #t) (current-output-port)))
++ (lambda ()
++ (exit 1)))
++ (exit 1)))))
+diff --git a/guile/tests/anonymous-auth.scm b/guile/tests/anonymous-auth.scm
+index 17f5e80..63616a6 100644
+--- a/guile/tests/anonymous-auth.scm
++++ b/guile/tests/anonymous-auth.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
+@@ -24,6 +24,7 @@
+ ;;;
+
+ (use-modules (gnutls)
++ (gnutls build tests)
+ (srfi srfi-4))
+
+
+@@ -54,10 +55,7 @@
+ ;; (set-log-procedure! (lambda (level str)
+ ;; (format #t "[~a|~a] ~a" (getpid) level str)))
+
+-(dynamic-wind
+- (lambda ()
+- #t)
+-
++(run-test
+ (lambda ()
+ (let ((socket-pair (socketpair PF_UNIX SOCK_STREAM 0))
+ (pid (primitive-fork)))
+@@ -80,7 +78,7 @@
+ (record-send client %message)
+ (bye client close-request/rdwr)
+
+- (exit))
++ (primitive-exit))
+
+ (let ((server (make-session connection-end/server)))
+ ;; server-side
+@@ -103,11 +101,7 @@
+ (let* ((buf (make-u8vector (u8vector-length %message)))
+ (amount (record-receive! server buf)))
+ (bye server close-request/rdwr)
+- (exit (= amount (u8vector-length %message))
+- (equal? buf %message)))))))
+-
+- (lambda ()
+- ;; failure
+- (exit 1)))
++ (and (= amount (u8vector-length %message))
++ (equal? buf %message))))))))
+
+ ;;; arch-tag: 8c98de24-0a53-4290-974e-4b071ad162a0
+diff --git a/guile/tests/errors.scm b/guile/tests/errors.scm
+index cec6491..65b4ae9 100644
+--- a/guile/tests/errors.scm
++++ b/guile/tests/errors.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
+@@ -22,25 +22,19 @@
+ ;;; Test the error/exception mechanism.
+ ;;;
+
+-(use-modules (gnutls))
+-
+-(dynamic-wind
+- (lambda ()
+- #t)
++(use-modules (gnutls)
++ (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)
+- (exit (and (eq? key 'gnutls-error)
+- err
+- (string? (error->string err))
+- (eq? function 'handshake)))))))
+-
+- (lambda ()
+- ;; failure
+- (exit 1)))
++ (and (eq? key 'gnutls-error)
++ err
++ (string? (error->string err))
++ (eq? function 'handshake)))))))
+
+ ;;; arch-tag: 73ed6229-378d-4a12-a5c6-4c2586c6e3a2
+diff --git a/guile/tests/openpgp-auth.scm b/guile/tests/openpgp-auth.scm
+index 3db9e42..4b43c90 100644
+--- a/guile/tests/openpgp-auth.scm
++++ b/guile/tests/openpgp-auth.scm
+@@ -1,5 +1,5 @@
+ ;;; GnuTLS-extra --- Guile bindings for GnuTLS-EXTRA.
+-;;; Copyright (C) 2007, 2008, 2010 Free Software Foundation, Inc.
++;;; Copyright (C) 2007, 2008, 2010, 2011 Free Software Foundation, Inc.
+ ;;;
+ ;;; GnuTLS-extra is free software; you can redistribute it and/or modify
+ ;;; it under the terms of the GNU General Public License as published by
+@@ -25,6 +25,7 @@
+
+ (use-modules (gnutls)
+ (gnutls extra)
++ (gnutls build tests)
+ (srfi srfi-4))
+
+
+@@ -63,10 +64,7 @@
+ ;; (set-log-procedure! (lambda (level str)
+ ;; (format #t "[~a|~a] ~a" (getpid) level str)))
+
+-(dynamic-wind
+- (lambda ()
+- #t)
+-
++(run-test
+ (lambda ()
+ (let ((socket-pair (socketpair PF_UNIX SOCK_STREAM 0))
+ (pub (import-key import-openpgp-certificate
+@@ -96,7 +94,7 @@
+ (write %message (session-record-port client))
+ (bye client close-request/rdwr)
+
+- (exit))
++ (primitive-exit))
+
+ (let ((server (make-session connection-end/server))
+ (rsa (import-rsa-params "rsa-parameters.pem"))
+@@ -123,11 +121,7 @@
+ (let ((msg (read (session-record-port server)))
+ (auth-type (session-authentication-type server)))
+ (bye server close-request/rdwr)
+- (exit (and (eq? auth-type credentials/certificate)
+- (equal? msg %message)))))))))
+-
+- (lambda ()
+- ;; failure
+- (exit 1)))
++ (and (eq? auth-type credentials/certificate)
++ (equal? msg %message)))))))))
+
+ ;;; arch-tag: 1a973ed5-f45d-45a4-8160-900b6a8c27ff
+diff --git a/guile/tests/openpgp-keyring.scm b/guile/tests/openpgp-keyring.scm
+index e5cffc5..576a9db 100644
+--- a/guile/tests/openpgp-keyring.scm
++++ b/guile/tests/openpgp-keyring.scm
+@@ -1,5 +1,5 @@
+ ;;; GnuTLS-extra --- Guile bindings for GnuTLS-EXTRA.
+-;;; Copyright (C) 2007, 2010 Free Software Foundation, Inc.
++;;; Copyright (C) 2007, 2010, 2011 Free Software Foundation, Inc.
+ ;;;
+ ;;; GnuTLS-extra is free software; you can redistribute it and/or modify
+ ;;; it under the terms of the GNU General Public License as published by
+@@ -24,6 +24,7 @@
+ ;;;
+
+ (use-modules (gnutls extra) (gnutls)
++ (gnutls build tests)
+ (srfi srfi-1)
+ (srfi srfi-4))
+
+@@ -59,21 +60,12 @@
+ (openpgp-keyring-contains-key-id? keyring id))
+ %ids-in-keyring)))))
+
+-(dynamic-wind
+-
+- (lambda ()
+- #t)
+-
+- (lambda ()
+- (exit
+- (every valid-keyring?
+- (list %raw-keyring-file
+- %ascii-keyring-file)
+- (list openpgp-certificate-format/raw
+- openpgp-certificate-format/base64))))
+-
++(run-test
+ (lambda ()
+- ;; failure
+- (exit 1)))
++ (every valid-keyring?
++ (list %raw-keyring-file
++ %ascii-keyring-file)
++ (list openpgp-certificate-format/raw
++ openpgp-certificate-format/base64))))
+
+ ;;; arch-tag: 516bf608-5c8b-4787-abe9-5f7b6e6d660b
+diff --git a/guile/tests/openpgp-keys.scm b/guile/tests/openpgp-keys.scm
+index 6049984..2ded32d 100644
+--- a/guile/tests/openpgp-keys.scm
++++ b/guile/tests/openpgp-keys.scm
+@@ -1,5 +1,5 @@
+ ;;; GnuTLS-extra --- Guile bindings for GnuTLS-EXTRA.
+-;;; Copyright (C) 2007, 2010 Free Software Foundation, Inc.
++;;; Copyright (C) 2007, 2010, 2011 Free Software Foundation, Inc.
+ ;;;
+ ;;; GnuTLS-extra is free software; you can redistribute it and/or modify
+ ;;; it under the terms of the GNU General Public License as published by
+@@ -25,6 +25,7 @@
+
+ (use-modules (gnutls)
+ (gnutls extra)
++ (gnutls build tests)
+ (srfi srfi-1)
+ (srfi srfi-4)
+ (srfi srfi-11))
+@@ -43,11 +44,7 @@
+ (stat:size (stat file)))
+
+
+-(dynamic-wind
+-
+- (lambda ()
+- #t)
+-
++(run-test
+ (lambda ()
+ (let ((raw-pubkey (make-u8vector (file-size %certificate-file)))
+ (raw-privkey (make-u8vector (file-size %private-key-file))))
+@@ -60,20 +57,16 @@
+ (sec (import-openpgp-private-key raw-privkey
+
openpgp-certificate-format/base64)))
+
+- (exit (and (openpgp-certificate? pub)
+- (openpgp-private-key? sec)
+- (equal? (openpgp-certificate-id pub) %key-id)
+- (u8vector? (openpgp-certificate-fingerprint pub))
+- (every string? (openpgp-certificate-names pub))
+- (member (openpgp-certificate-version pub) '(3 4))
+- (list? (openpgp-certificate-usage pub))
+- (let-values (((pk bits)
+- (openpgp-certificate-algorithm pub)))
+- (and (string? (pk-algorithm->string pk))
+- (number? bits))))))))
+-
+- (lambda ()
+- ;; failure
+- (exit 1)))
++ (and (openpgp-certificate? pub)
++ (openpgp-private-key? sec)
++ (equal? (openpgp-certificate-id pub) %key-id)
++ (u8vector? (openpgp-certificate-fingerprint pub))
++ (every string? (openpgp-certificate-names pub))
++ (member (openpgp-certificate-version pub) '(3 4))
++ (list? (openpgp-certificate-usage pub))
++ (let-values (((pk bits)
++ (openpgp-certificate-algorithm pub)))
++ (and (string? (pk-algorithm->string pk))
++ (number? bits))))))))
+
+ ;;; arch-tag: 2ee2a377-7f4d-4031-92a8-275090e4f83d
+diff --git a/guile/tests/pkcs-import-export.scm
b/guile/tests/pkcs-import-export.scm
+index 8900f15..4121b18 100644
+--- a/guile/tests/pkcs-import-export.scm
++++ b/guile/tests/pkcs-import-export.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
+@@ -23,6 +23,7 @@
+ ;;;
+
+ (use-modules (gnutls)
++ (gnutls build tests)
+ (srfi srfi-4))
+
+ (define (import-something import-proc file fmt)
+@@ -36,25 +37,16 @@
+ (import-something pkcs3-import-dh-parameters file
+ x509-certificate-format/pem))
+
+-(dynamic-wind
+-
+- (lambda ()
+- #t)
+-
+- (lambda ()
+- (exit
+- (let* ((dh-params (import-dh-params "dh-parameters.pem"))
+- (export
+- (pkcs3-export-dh-parameters dh-params
+- x509-certificate-format/pem)))
+- (and (u8vector? export)
+- (let ((import
+- (pkcs3-import-dh-parameters export
+-
x509-certificate-format/pem)))
+- (dh-parameters? import))))))
+-
++(run-test
+ (lambda ()
+- ;; failure
+- (exit 1)))
++ (let* ((dh-params (import-dh-params "dh-parameters.pem"))
++ (export
++ (pkcs3-export-dh-parameters dh-params
++ x509-certificate-format/pem)))
++ (and (u8vector? export)
++ (let ((import
++ (pkcs3-import-dh-parameters export
++ x509-certificate-format/pem)))
++ (dh-parameters? import))))))
+
+ ;;; arch-tag: adff0f07-479e-421e-b47f-8956e06b9902
+diff --git a/guile/tests/session-record-port.scm
b/guile/tests/session-record-port.scm
+index a41ea2c..1d53d9b 100644
+--- a/guile/tests/session-record-port.scm
++++ b/guile/tests/session-record-port.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
+@@ -24,6 +24,7 @@
+ ;;;
+
+ (use-modules (gnutls)
++ (gnutls build tests)
+ (srfi srfi-4))
+
+
+@@ -54,10 +55,7 @@
+ ;; (set-log-procedure! (lambda (level str)
+ ;; (format #t "[~a|~a] ~a" (getpid) level str)))
+
+-(dynamic-wind
+- (lambda ()
+- #t)
+-
++(run-test
+ (lambda ()
+ ;; Stress the GC. In 0.0, this triggered an abort due to
+ ;; "scm_unprotect_object called during GC".
+@@ -104,7 +102,7 @@
+ (uniform-vector-write %message (session-record-port client))
+ (bye client close-request/rdwr)
+
+- (exit))
++ (primitive-exit))
+
+ (let ((server (make-session connection-end/server)))
+ ;; server-side
+@@ -130,15 +128,11 @@
+ (bye server close-request/rdwr)
+
+ ;; Make sure we got everything right.
+- (exit (eq? (session-record-port server)
+- (session-record-port server))
+- (= amount (u8vector-length %message))
+- (equal? buf %message)
+- (eof-object?
+- (read-char (session-record-port server)))))))))
+-
+- (lambda ()
+- ;; failure
+- (exit 1)))
++ (and (eq? (session-record-port server)
++ (session-record-port server))
++ (= amount (u8vector-length %message))
++ (equal? buf %message)
++ (eof-object?
++ (read-char (session-record-port server))))))))))
+
+ ;;; arch-tag: e873226a-d0b6-4a93-87ec-a1b5ad2ae8a2
+diff --git a/guile/tests/srp-base64.scm b/guile/tests/srp-base64.scm
+index c928f25..484288a 100644
+--- a/guile/tests/srp-base64.scm
++++ b/guile/tests/srp-base64.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
+@@ -22,7 +22,8 @@
+ ;;; Test SRP base64 encoding and decoding.
+ ;;;
+
+-(use-modules (gnutls))
++(use-modules (gnutls)
++ (gnutls build tests))
+
+ (define %message
+ "GnuTLS is free software; you can redistribute it and/or
+@@ -30,10 +31,12 @@ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.")
+
+-(exit (let ((encoded (srp-base64-encode %message)))
+- (and (string? encoded)
+- (string=? (srp-base64-decode encoded)
+- %message))))
++(run-test
++ (lambda ()
++ (let ((encoded (srp-base64-encode %message)))
++ (and (string? encoded)
++ (string=? (srp-base64-decode encoded)
++ %message)))))
+
+
+ ;;; arch-tag: ea1534a5-d513-4208-9a75-54bd4710f915
+diff --git a/guile/tests/x509-auth.scm b/guile/tests/x509-auth.scm
+index 83cf423..e5c3437 100644
+--- a/guile/tests/x509-auth.scm
++++ b/guile/tests/x509-auth.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
+@@ -24,6 +24,7 @@
+ ;;;
+
+ (use-modules (gnutls)
++ (gnutls build tests)
+ (srfi srfi-4))
+
+
+@@ -62,10 +63,7 @@
+ ;; (set-log-procedure! (lambda (level str)
+ ;; (format #t "[~a|~a] ~a" (getpid) level str)))
+
+-(dynamic-wind
+- (lambda ()
+- #t)
+-
++(run-test
+ (lambda ()
+ (let ((socket-pair (socketpair PF_UNIX SOCK_STREAM 0))
+ (pub (import-key import-x509-certificate
+@@ -95,7 +93,7 @@
+ (write %message (session-record-port client))
+ (bye client close-request/rdwr)
+
+- (exit))
++ (primitive-exit))
+
+ (let ((server (make-session connection-end/server))
+ (rsa (import-rsa-params "rsa-parameters.pem"))
+@@ -128,11 +126,7 @@
+ (let ((msg (read (session-record-port server)))
+ (auth-type (session-authentication-type server)))
+ (bye server close-request/rdwr)
+- (exit (and (eq? auth-type credentials/certificate)
+- (equal? msg %message)))))))))
+-
+- (lambda ()
+- ;; failure
+- (exit 1)))
++ (and (eq? auth-type credentials/certificate)
++ (equal? msg %message)))))))))
+
+ ;;; arch-tag: 1f88f835-a5c8-4fd6-94b6-5a13571ba03d
+diff --git a/guile/tests/x509-certificates.scm
b/guile/tests/x509-certificates.scm
+index fda227b..67c1885 100644
+--- a/guile/tests/x509-certificates.scm
++++ b/guile/tests/x509-certificates.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
+@@ -23,6 +23,7 @@
+ ;;;
+
+ (use-modules (gnutls)
++ (gnutls build tests)
+ (srfi srfi-4)
+ (srfi srfi-11))
+
+@@ -45,11 +46,7 @@
+ (stat:size (stat file)))
+
+
+-(dynamic-wind
+-
+- (lambda ()
+- #t)
+-
++(run-test
+ (lambda ()
+ (let ((raw-certificate (make-u8vector (file-size %certificate-file)))
+ (raw-privkey (make-u8vector (file-size %private-key-file))))
+@@ -64,23 +61,19 @@
+ (sec (import-x509-private-key raw-privkey
+ x509-certificate-format/pem)))
+
+- (exit (and (x509-certificate? cert)
+- (x509-private-key? sec)
+- (string? (x509-certificate-dn cert))
+- (string? (x509-certificate-issuer-dn cert))
+- (string=? (x509-certificate-dn-oid cert 0) %first-oid)
+- (eq? (x509-certificate-signature-algorithm cert)
+- %signature-algorithm)
+- (x509-certificate-matches-hostname? cert "localhost")
+- (let-values (((type name)
+- (x509-certificate-subject-alternative-name
+- cert 0)))
+- (and (string? name)
+- (string?
+- (x509-subject-alternative-name->string
type)))))))))
+-
+- (lambda ()
+- ;; failure
+- (exit 1)))
++ (and (x509-certificate? cert)
++ (x509-private-key? sec)
++ (string? (x509-certificate-dn cert))
++ (string? (x509-certificate-issuer-dn cert))
++ (string=? (x509-certificate-dn-oid cert 0) %first-oid)
++ (eq? (x509-certificate-signature-algorithm cert)
++ %signature-algorithm)
++ (x509-certificate-matches-hostname? cert "localhost")
++ (let-values (((type name)
++ (x509-certificate-subject-alternative-name
++ cert 0)))
++ (and (string? name)
++ (string?
++ (x509-subject-alternative-name->string type)))))))))
+
+ ;;; arch-tag: eef09b52-30e8-472a-8b93-cb636434f6eb
+--
+1.7.4.1
+
_______________________________________________
nix-commits mailing list
[email protected]
http://mail.cs.uu.nl/mailman/listinfo/nix-commits
