~nutznboltz-deactivatedaccount/ubuntu/precise/gnutls26/fix-lp926350

« back to all changes in this revision

Viewing changes to guile/tests/openpgp-auth.scm

  • Committer: Package Import Robot
  • Author(s): Andreas Metzler
  • Date: 2011-10-01 15:28:13 UTC
  • mfrom: (12.1.20 sid)
  • Revision ID: package-import@ubuntu.com-20111001152813-yygm1c4cxonfxhzy
Tags: 2.12.11-1
* New upstream version.
  + Allow CA importing of 0 certificates to succeed. Closes: #640639
* Add libp11-kit-dev to libgnutls-dev dependencies. (see #643811)
* [20_guiledocstring.diff] guile: Fix docstring extraction with CPP 4.5+.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
;;; GnuTLS-extra --- Guile bindings for GnuTLS-EXTRA.
2
 
;;; Copyright (C) 2007, 2008, 2010 Free Software Foundation, Inc.
 
2
;;; Copyright (C) 2007, 2008, 2010, 2011 Free Software Foundation, Inc.
3
3
;;;
4
4
;;; GnuTLS-extra is free software; you can redistribute it and/or modify
5
5
;;; it under the terms of the GNU General Public License as published by
25
25
 
26
26
(use-modules (gnutls)
27
27
             (gnutls extra)
 
28
             (gnutls build tests)
28
29
             (srfi srfi-4))
29
30
 
30
31
 
31
32
;; TLS session settings.
32
33
(define %protos  (list protocol/tls-1.0))
33
34
(define %certs   (list certificate-type/openpgp))
34
 
(define %ciphers (list cipher/null cipher/arcfour cipher/aes-128-cbc
 
35
(define %ciphers (list cipher/arcfour cipher/aes-128-cbc
35
36
                       cipher/aes-256-cbc))
36
 
(define %kx      (list kx/rsa kx/rsa-export kx/dhe-rsa kx/dhe-dss))
 
37
(define %kx      (list kx/dhe-rsa kx/dhe-dss))
37
38
(define %macs    (list mac/sha1 mac/rmd160 mac/md5))
38
39
 
39
40
;; Message sent by the client.
54
55
  (import-something pkcs1-import-rsa-parameters file
55
56
                    x509-certificate-format/pem))
56
57
 
 
58
(define (import-dh-params file)
 
59
  (import-something pkcs3-import-dh-parameters file
 
60
                    x509-certificate-format/pem))
 
61
 
57
62
;; Debugging.
58
63
;; (set-log-level! 3)
59
64
;; (set-log-procedure! (lambda (level str)
60
65
;;                       (format #t "[~a|~a] ~a" (getpid) level str)))
61
66
 
62
 
(dynamic-wind
63
 
    (lambda ()
64
 
      #t)
65
 
 
 
67
(run-test
66
68
    (lambda ()
67
69
      (let ((socket-pair (socketpair PF_UNIX SOCK_STREAM 0))
68
70
            (pub         (import-key import-openpgp-certificate
92
94
                (write %message (session-record-port client))
93
95
                (bye client close-request/rdwr)
94
96
 
95
 
                (exit))
 
97
                (primitive-exit))
96
98
 
97
99
              (let ((server (make-session connection-end/server))
98
100
                    (rsa    (import-rsa-params "rsa-parameters.pem"))
99
 
                    (dh     (make-dh-parameters 1024)))
 
101
                    (dh     (import-dh-params "dh-parameters.pem")))
100
102
                ;; server-side
101
103
                (set-session-default-priority! server)
102
104
                (set-session-certificate-type-priority! server %certs)
119
121
                (let ((msg (read (session-record-port server)))
120
122
                      (auth-type (session-authentication-type server)))
121
123
                  (bye server close-request/rdwr)
122
 
                  (exit (and (eq? auth-type credentials/certificate)
123
 
                             (equal? msg %message)))))))))
124
 
 
125
 
    (lambda ()
126
 
      ;; failure
127
 
      (exit 1)))
 
124
                  (and (eq? auth-type credentials/certificate)
 
125
                       (equal? msg %message)))))))))
128
126
 
129
127
;;; arch-tag: 1a973ed5-f45d-45a4-8160-900b6a8c27ff