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