diff options
Diffstat (limited to 'guile/tests/openpgp-auth.scm')
| -rw-r--r-- | guile/tests/openpgp-auth.scm | 92 |
1 files changed, 45 insertions, 47 deletions
diff --git a/guile/tests/openpgp-auth.scm b/guile/tests/openpgp-auth.scm index a60f8856ae..49b4817435 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-2014 Free Software Foundation, Inc. +;;; Copyright (C) 2007-2014, 2016 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 @@ -56,51 +56,49 @@ ;; (format #t "[~a|~a] ~a" (getpid) level str))) (run-test - (lambda () - (let ((socket-pair (socketpair PF_UNIX SOCK_STREAM 0)) - (pub (import-key import-openpgp-certificate - "openpgp-pub.asc")) - (sec (import-key import-openpgp-private-key - "openpgp-sec.asc"))) - (let ((pid (primitive-fork))) - (if (= 0 pid) - - (let ((client (make-session connection-end/client)) - (cred (make-certificate-credentials))) - ;; client-side (child process) - (set-session-priorities! client priorities) - - (set-certificate-credentials-openpgp-keys! cred pub sec) - (set-session-credentials! client cred) - (set-session-dh-prime-bits! client 1024) - - (set-session-transport-fd! client (port->fdes (car socket-pair))) - - (handshake client) - (write %message (session-record-port client)) - (bye client close-request/rdwr) - - (primitive-exit)) - - (let ((server (make-session connection-end/server)) - (dh (import-dh-params "dh-parameters.pem"))) - ;; server-side - (set-session-priorities! server priorities) - (set-server-session-certificate-request! server - certificate-request/require) - - (set-session-transport-fd! server (port->fdes (cdr socket-pair))) - (let ((cred (make-certificate-credentials))) - (set-certificate-credentials-dh-parameters! cred dh) - (set-certificate-credentials-openpgp-keys! cred pub sec) - (set-session-credentials! server cred)) - (set-session-dh-prime-bits! server 1024) - - (handshake server) - (let ((msg (read (session-record-port server))) - (auth-type (session-authentication-type server))) - (bye server close-request/rdwr) - (and (eq? auth-type credentials/certificate) - (equal? msg %message))))))))) + (lambda () + (let ((socket-pair (socketpair PF_UNIX SOCK_STREAM 0)) + (pub (import-key import-openpgp-certificate + "openpgp-pub.asc")) + (sec (import-key import-openpgp-private-key + "openpgp-sec.asc"))) + (with-child-process pid + ;; server-side + (let ((server (make-session connection-end/server)) + (dh (import-dh-params "dh-parameters.pem"))) + (set-session-priorities! server priorities) + (set-server-session-certificate-request! server + certificate-request/require) + + (set-session-transport-fd! server (port->fdes (cdr socket-pair))) + (let ((cred (make-certificate-credentials))) + (set-certificate-credentials-dh-parameters! cred dh) + (set-certificate-credentials-openpgp-keys! cred pub sec) + (set-session-credentials! server cred)) + (set-session-dh-prime-bits! server 1024) + + (handshake server) + (let ((msg (read (session-record-port server))) + (auth-type (session-authentication-type server))) + (bye server close-request/rdwr) + (and (eq? auth-type credentials/certificate) + (equal? msg %message)))) + + ;; client-side (child process) + (let ((client (make-session connection-end/client)) + (cred (make-certificate-credentials))) + (set-session-priorities! client priorities) + + (set-certificate-credentials-openpgp-keys! cred pub sec) + (set-session-credentials! client cred) + (set-session-dh-prime-bits! client 1024) + + (set-session-transport-fd! client (port->fdes (car socket-pair))) + + (handshake client) + (write %message (session-record-port client)) + (bye client close-request/rdwr) + + (primitive-exit)))))) ;;; arch-tag: 1a973ed5-f45d-45a4-8160-900b6a8c27ff |