guile/tests/openpgp-keys.scm

   1 ;;; GnuTLS-extra --- Guile bindings for GnuTLS-EXTRA.
   2 ;;; Copyright (C) 2007, 2010, 2011 Free Software Foundation, Inc.
   3 ;;;
   4 ;;; GnuTLS-extra is free software; you can redistribute it and/or modify
   5 ;;; it under the terms of the GNU General Public License as published by
   6 ;;; the Free Software Foundation; either version 3 of the License, or
   7 ;;; (at your option) any later version.
   8 ;;;
   9 ;;; GnuTLS-extra 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
  12 ;;; GNU General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU General Public License
  15 ;;; along with GnuTLS-EXTRA; if not, write to the Free Software
  16 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
  17 ;;; USA.
  18
  19 ;;; Written by Ludovic Courtès <ludo@chbouib.org>.
  20
  21
  22 ;;;
  23 ;;; Exercise the OpenPGP key API part of GnuTLS-extra.
  24 ;;;
  25
  26 (use-modules (gnutls)
  27              (gnutls build tests)
  28              (srfi srfi-1)
  29              (srfi srfi-4)
  30              (srfi srfi-11))
  31
  32 (define %certificate-file
  33   (search-path %load-path "openpgp-elg-pub.asc"))
  34
  35 (define %private-key-file
  36   (search-path %load-path "openpgp-elg-sec.asc"))
  37
  38 (define %key-id
  39   ;; Change me if you change the key files.
  40   '#u8(#xbd #x57 #x2c #xdc #xcc #xc0 #x7c #x35))
  41
  42 (define (file-size file)
  43   (stat:size (stat file)))
  44
  45
  46 (run-test
  47     (lambda ()
  48       (let ((raw-pubkey  (make-u8vector (file-size %certificate-file)))
  49             (raw-privkey (make-u8vector (file-size %private-key-file))))
  50
  51         (uniform-vector-read! raw-pubkey (open-input-file %certificate-file))
  52         (uniform-vector-read! raw-privkey (open-input-file %private-key-file))
  53
  54         (let ((pub (import-openpgp-certificate raw-pubkey
  55                                            openpgp-certificate-format/base64))
  56               (sec (import-openpgp-private-key raw-privkey
  57                                            openpgp-certificate-format/base64)))
  58
  59           (and (openpgp-certificate? pub)
  60                (openpgp-private-key? sec)
  61                (equal? (openpgp-certificate-id pub) %key-id)
  62                (u8vector? (openpgp-certificate-fingerprint pub))
  63                (every string? (openpgp-certificate-names pub))
  64                (member (openpgp-certificate-version pub) '(3 4))
  65                (list? (openpgp-certificate-usage pub))
  66                (let-values (((pk bits)
  67                              (openpgp-certificate-algorithm pub)))
  68                  (and (string? (pk-algorithm->string pk))
  69                       (number? bits))))))))
  70
  71 ;;; arch-tag: 2ee2a377-7f4d-4031-92a8-275090e4f83d