tests/openpgp/key-selection.scm

   1 #!/usr/bin/env gpgscm
   2
   3 ;; Copyright (C) 2016 g10 Code GmbH
   4 ;;
   5 ;; This file is part of GnuPG.
   6 ;;
   7 ;; GnuPG is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 3 of the License, or
  10 ;; (at your option) any later version.
  11 ;;
  12 ;; GnuPG is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program; if not, see <http://www.gnu.org/licenses/>.
  19
  20 (load (with-path "defs.scm"))
  21 (setup-legacy-environment)
  22
  23 ;; This test assumes a fixed time of 2004-01-01.
  24
  25  ;; Redefine gpg with a fixed time.
  26 (define gpg `(,@gpg --faked-system-time=1072911600))
  27
  28 ;; We have a number of keys for Mr. Acejlnu Acdipr <acdipr@example.org>.
  29 (define mailbox "acdipr@example.org")
  30
  31 ;; The keys are sorted, from the least relevant to the most relevant
  32 ;; key.
  33 (define keys
  34   '(("ED087E9D3394340738E20A244892A3CF8F65EBAC"
  35      "no encryption-capable subkey, created: 2003-11-30, expires: 2006-11-29"
  36      4)
  37     ("D7388651A1B7466D03B538428178E04B0BAA385B"
  38      "encryption-capable subkey, created: 2000-12-31, expired: 2001-12-31"
  39      0)
  40     ("DDEF1BEC66C8BAC8D69CED2AEABED840EC98B024"
  41      "encryption-capable subkey, created: 2001-12-31, expires: 2006-12-30"
  42      1)
  43     ("03FCFEDE014027DD897AD2F23D32670A96A9C2BF"
  44      "encryption-capable subkey, created: 2002-12-31, expires: 2005-12-30"
  45      2)
  46     ("B95BD6175CB6339244355BA160B8117E6119CED6"
  47      "encryption-capable subkeys, last created: 2003-05-31, expires: 2005-05-30"
  48      3)))
  49
  50 ;; Accessors for the elements of KEYS.
  51 (define :fpr car)
  52 (define :comment cadr)
  53 (define :number caddr)
  54 (define (:filename key)
  55   (in-srcdir "key-selection"
  56              (string-append (number->string (:number key)) ".asc")))
  57
  58 (define (delete-keys which)
  59   (call-check `(,@gpg --delete-keys ,@(map :fpr which))))
  60
  61 (define (import-keys which)
  62   (call-check `(,@gpg --import ,@(map :filename which))))
  63
  64 (for-each-p'
  65  "Checking key selection"
  66  (lambda (set)
  67    (import-keys set)
  68    (let ((fpr (list-ref (assoc "fpr"
  69                                (gpg-with-colons `(--locate-key ,mailbox)))
  70                         9))
  71          (expected (:fpr (last set))))
  72      (unless (equal? fpr expected)
  73              (display "Given keys ")
  74              (apply echo (map :fpr set))
  75              (echo "This is what --locate-key says:")
  76              (display (call-popen `(,@gpg --locate-key ,mailbox) ""))
  77              (echo "This is the key we expected:")
  78              (display (call-popen `(,@gpg --list-keys ,expected) ""))
  79              (fail "Expected" expected "but got" fpr)))
  80    (delete-keys set))
  81  (lambda (set)
  82    (length set))
  83  (filter (lambda (x) (not (null? x))) (powerset keys)))