guile/tests/x509-certificates.scm

   1 ;;; GnuTLS --- Guile bindings for GnuTLS.
   2 ;;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
   3 ;;;
   4 ;;; GnuTLS is free software; you can redistribute it and/or
   5 ;;; modify it under the terms of the GNU Lesser General Public
   6 ;;; License as published by the Free Software Foundation; either
   7 ;;; version 2.1 of the License, or (at your option) any later version.
   8 ;;;
   9 ;;; GnuTLS is distributed in the hope that it will be useful,
  10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;;; Lesser General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU Lesser General Public
  15 ;;; License along with GnuTLS; if not, write to the Free Software
  16 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  17
  18 ;;; Written by Ludovic Courtès <ludo@chbouib.org>.
  19
  20
  21 ;;;
  22 ;;; Exercise the X.509 certificate API.
  23 ;;;
  24
  25 (use-modules (gnutls)
  26              (gnutls build tests)
  27              (srfi srfi-4)
  28              (srfi srfi-11))
  29
  30 (define %certificate-file
  31   (search-path %load-path "x509-certificate.pem"))
  32
  33 (define %private-key-file
  34   (search-path %load-path "x509-key.pem"))
  35
  36 (define %first-oid
  37   ;; The certificate's first OID.
  38   "2.5.4.6")
  39
  40 (define %signature-algorithm
  41   ;; The certificate's signature algorithm.
  42   sign-algorithm/rsa-sha1)
  43
  44
  45 (define (file-size file)
  46   (stat:size (stat file)))
  47
  48
  49 (run-test
  50     (lambda ()
  51       (let ((raw-certificate (make-u8vector (file-size %certificate-file)))
  52             (raw-privkey     (make-u8vector (file-size %private-key-file))))
  53
  54         (uniform-vector-read! raw-certificate
  55                               (open-input-file %certificate-file))
  56         (uniform-vector-read! raw-privkey
  57                               (open-input-file %private-key-file))
  58
  59         (let ((cert (import-x509-certificate raw-certificate
  60                                              x509-certificate-format/pem))
  61               (sec  (import-x509-private-key raw-privkey
  62                                              x509-certificate-format/pem)))
  63
  64           (and (x509-certificate? cert)
  65                (x509-private-key? sec)
  66                (string? (x509-certificate-dn cert))
  67                (string? (x509-certificate-issuer-dn cert))
  68                (string=? (x509-certificate-dn-oid cert 0) %first-oid)
  69                (eq? (x509-certificate-signature-algorithm cert)
  70                     %signature-algorithm)
  71                (x509-certificate-matches-hostname? cert "localhost")
  72                (let-values (((type name)
  73                              (x509-certificate-subject-alternative-name
  74                               cert 0)))
  75                  (and (string? name)
  76                       (string?
  77                        (x509-subject-alternative-name->string type)))))))))
  78
  79 ;;; arch-tag: eef09b52-30e8-472a-8b93-cb636434f6eb