tests/openpgp/setup.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
  22 (echo "Creating test environment...")
  23
  24 (letfd ((fd (open "random_seed" (logior O_WRONLY O_CREAT O_BINARY) #o600)))
  25   (call-with-fds (list (tool 'mktdata) "600") CLOSED_FD fd STDERR_FILENO))
  26
  27 (for-each-p
  28  "Creating configuration files"
  29  (lambda (name)
  30    (file-copy (in-srcdir (string-append name ".tmpl")) name)
  31    (let ((p (open-input-output-file name)))
  32      (cond
  33       ((string=? "gpg.conf" name)
  34        (if have-opt-always-trust
  35            (display "no-auto-check-trustdb\n" p))
  36        (display (string-append "agent-program "
  37                                (tool 'gpg-agent)
  38                                "|--debug-quick-random\n") p)
  39        (display "allow-weak-digest-algos\n" p))
  40       ((string=? "gpg-agent.conf" name)
  41        (display (string-append "pinentry-program " PINENTRY "\n") p)))))
  42  '("gpg.conf" "gpg-agent.conf"))
  43
  44 (echo "Starting gpg-agent...")
  45 (call-check `(,(tool 'gpg-connect-agent) --verbose
  46               ,(string-append "--agent-program=" (tool 'gpg-agent)
  47                               "|--debug-quick-random")
  48               /bye))
  49
  50 (for-each-p "Creating sample data files"
  51   (lambda (size)
  52     (letfd ((fd (open (string-append "data-" (number->string size))
  53                       (logior O_WRONLY O_CREAT O_BINARY) #o600)))
  54       (call-with-fds (list (tool 'mktdata) (number->string size))
  55                      CLOSED_FD fd STDERR_FILENO)))
  56   '(500 9000 32000 80000))
  57
  58 (define (dearmor source-name sink-name)
  59   (pipe:do
  60    (pipe:open source-name (logior O_RDONLY O_BINARY))
  61    (pipe:spawn `(,@GPG --dearmor))
  62    (pipe:write-to sink-name
  63                   (logior O_WRONLY O_CREAT O_BINARY)
  64                   #o600)))
  65
  66 (for-each-p "Unpacking samples"
  67   (lambda (name)
  68     (dearmor (in-srcdir (string-append name "o.asc")) name))
  69   '("plain-1" "plain-2" "plain-3" "plain-large"))
  70
  71 ;; XXX implement cleanup
  72 (catch '()
  73        (mkdir "private-keys-v1.d" "-rwx"))
  74
  75 (define counter (make-counter))
  76 (for-each-p' "Storing private keys"
  77   (lambda (name)
  78     (dearmor (in-srcdir (string-append "/privkeys/" name ".asc"))
  79              (string-append "private-keys-v1.d/" name ".key")))
  80   (lambda (name) (counter))
  81   '("50B2D4FA4122C212611048BC5FC31BD44393626E"
  82     "7E201E28B6FEB2927B321F443205F4724EBE637E"
  83     "13FDB8809B17C5547779F9D205C45F47CE0217CE"
  84     "343D8AF79796EE107D645A2787A9D9252F924E6F"
  85     "8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34"
  86     "0D6F6AD4C4C803B25470F9104E9F4E6A4CA64255"
  87     "FD692BD59D6640A84C8422573D469F84F3B98E53"
  88     "76F7E2B35832976B50A27A282D9B87E44577EB66"
  89     "A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD"
  90     "00FE67F28A52A8AA08FFAED20AF832DA916D1985"
  91     "1DF48228FEFF3EC2481B106E0ACA8C465C662CC5"
  92     "A2832820DC9F40751BDCD375BB0945BA33EC6B4C"
  93     "ADE710D74409777B7729A7653373D820F67892E0"
  94     "CEFC51AF91F68A2904FBFF62C4F075A4785B803F"
  95     "1E28F20E41B54C2D1234D896096495FF57E08D18"
  96     "EB33B687EB8581AB64D04852A54453E85F3DF62D"
  97     "C6A6390E9388CDBAD71EAEA698233FE5E04F001E"
  98     "D69102E0F5AC6B6DB8E4D16DA8E18CF46D88CAE3"))
  99
 100 (info "Importing public demo and test keys")
 101 (call-check `(,@GPG --yes --import
 102                     ,(in-srcdir "pubdemo.asc")
 103                     ,(in-srcdir "pubring.asc")
 104                     ,(in-srcdir key-file1)))
 105 ;; (letfd ((source (open (in-srcdir "pubring.pkr.asc") O_RDONLY)))
 106 ;;        ((gpg-pipe '(--dearmor) '(--yes --import) STDERR_FILENO)
 107 ;;      source CLOSED_FD))
 108 (pipe:do
 109  (pipe:open (in-srcdir "pubring.pkr.asc") (logior O_RDONLY O_BINARY))
 110  (pipe:spawn `(,@GPG --dearmor))
 111  (pipe:spawn `(,@GPG --yes --import)))
 112
 113 (info "Preset passphrases")
 114 ;; one@example.com
 115 (call-check `(,(tool 'gpg-preset-passphrase)
 116               --preset --passphrase def
 117               "50B2D4FA4122C212611048BC5FC31BD44393626E"))
 118 (call-check `(,(tool 'gpg-preset-passphrase)
 119               --preset --passphrase def
 120               "7E201E28B6FEB2927B321F443205F4724EBE637E"))
 121 ;; alpha@example.net
 122 (call-check `(,(tool 'gpg-preset-passphrase)
 123               --preset --passphrase abc
 124               "76F7E2B35832976B50A27A282D9B87E44577EB66"))
 125 (call-check `(,(tool 'gpg-preset-passphrase)
 126               --preset --passphrase abc
 127               "A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD"))
 128
 129 (echo "All set up.")