diff options
author | Ludovic Courtès <ludo@chbouib.org> | 2007-05-30 00:39:23 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@chbouib.org> | 2007-05-30 00:39:23 +0200 |
commit | d374e7df710477ae0212234d688064876cb7d05f (patch) | |
tree | 9130cc704019c6b89da9eb2b5dd7da59d41b8b31 /guile/tests/x509-certificates.scm | |
parent | 331a51173f748bca0850a275dd9454486948a9da (diff) | |
download | gnutls-d374e7df710477ae0212234d688064876cb7d05f.tar.gz |
Started Guile integration.
Documentation is still missing. A bit rough on the edges, but `make'
and `make check' do work.
Diffstat (limited to 'guile/tests/x509-certificates.scm')
-rw-r--r-- | guile/tests/x509-certificates.scm | 86 |
1 files changed, 86 insertions, 0 deletions
diff --git a/guile/tests/x509-certificates.scm b/guile/tests/x509-certificates.scm new file mode 100644 index 0000000000..3b5629c3a3 --- /dev/null +++ b/guile/tests/x509-certificates.scm @@ -0,0 +1,86 @@ +;;; GNUTLS --- Guile bindings for GnuTLS. +;;; Copyright (C) 2007 Free Software Foundation +;;; +;;; 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 <ludo@chbouib.org>. + + +;;; +;;; Exercise the X.509 certificate API. +;;; + +(use-modules (gnutls) + (srfi srfi-4) + (srfi srfi-11)) + +(define %certificate-file + (search-path %load-path "x509-certificate.pem")) + +(define %private-key-file + (search-path %load-path "x509-key.pem")) + +(define %first-oid + ;; The certificate's first OID. + "2.5.4.6") + +(define %signature-algorithm + ;; The certificate's signature algorithm. + sign-algorithm/rsa-sha1) + + +(define (file-size file) + (stat:size (stat file))) + + +(dynamic-wind + + (lambda () + #t) + + (lambda () + (let ((raw-certificate (make-u8vector (file-size %certificate-file))) + (raw-privkey (make-u8vector (file-size %private-key-file)))) + + (uniform-vector-read! raw-certificate + (open-input-file %certificate-file)) + (uniform-vector-read! raw-privkey + (open-input-file %private-key-file)) + + (let ((cert (import-x509-certificate raw-certificate + x509-certificate-format/pem)) + (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))) + +;;; arch-tag: eef09b52-30e8-472a-8b93-cb636434f6eb |