tests: Fix environment setup.
[gnupg.git] / tests / openpgp / defs.scm
1 ;; Common definitions for the OpenPGP test scripts.
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 ;;
21 ;; Constants.
22 ;;
23
24 (define usrname1 "one@example.com")
25 (define usrpass1 "def")
26 (define usrname2 "two@example.com")
27 (define usrpass2 "")
28 (define usrname3 "three@example.com")
29 (define usrpass3 "")
30
31 (define dsa-usrname1 "pgp5")
32 ;; we use the sub key because we do not yet have the logic to to derive
33 ;; the first encryption key from a keyblock (I guess) (Well of course
34 ;; we have this by now and the notation below will lookup the primary
35 ;; first and then search for the encryption subkey.)
36 (define dsa-usrname2 "0xCB879DE9")
37
38 (define key-file1 "samplekeys/rsa-rsa-sample-1.asc")
39 (define key-file2 "samplekeys/ed25519-cv25519-sample-1.asc")
40
41 (define plain-files '("plain-1" "plain-2" "plain-3"))
42 (define data-files '("data-500" "data-9000" "data-32000" "data-80000"))
43 (define exp-files '())
44
45 (define (qualify executable)
46   (string-append executable (getenv "EXEEXT")))
47
48 (define (getenv' key default)
49   (let ((value (getenv key)))
50     (if (string=? "" value)
51         default
52         value)))
53
54 (define tools
55   '((gpg "GPG" "g10/gpg")
56     (gpgv "GPGV" "g10/gpgv")
57     (gpg-agent "GPG_AGENT" "agent/gpg-agent")
58     (gpg-connect-agent "GPG_CONNECT_AGENT" "tools/gpg-connect-agent")
59     (gpgconf "GPGCONF" "tools/gpgconf")
60     (gpg-preset-passphrase "GPG_PRESET_PASSPHRASE"
61                            "agent/gpg-preset-passphrase")
62     (gpgtar "GPGTAR" "tools/gpgtar")
63     (gpg-zip "GPGZIP" "tools/gpg-zip")
64     (pinentry "PINENTRY" "tests/openpgp/fake-pinentry")))
65
66 (define (tool which)
67   (let ((t (assoc which tools))
68         (prefix (getenv "BIN_PREFIX")))
69     (getenv' (cadr t)
70              (qualify (if (string=? prefix "")
71                           (string-append (getenv "objdir") "/" (caddr t))
72                           (string-append prefix "/" (basename (caddr t))))))))
73
74
75 (define have-opt-always-trust
76   (string-contains? (call-popen `(,(tool 'gpg) --dump-options) "")
77                         "--always-trust"))
78
79 (define GPG `(,(tool 'gpg) --no-permission-warning
80               ,@(if have-opt-always-trust '(--always-trust) '())))
81 (define GPGV `(,(tool 'gpgv)))
82 (define PINENTRY (tool 'pinentry))
83
84 (define (tr:gpg input args)
85   (tr:spawn input `(,@GPG --output **out** ,@args **in**)))
86
87 (define (pipe:gpg args)
88   (pipe:spawn `(,@GPG --output - ,@args -)))
89
90 (define (gpg-with-colons args)
91   (let ((s (call-popen `(,@GPG --with-colons ,@args) "")))
92     (map (lambda (line) (string-split line #\:))
93          (string-split-newlines s))))
94
95 (define (get-config what)
96   (string-split (caddar (gpg-with-colons `(--list-config ,what))) #\;))
97
98 (define all-pubkey-algos (get-config "pubkeyname"))
99 (define all-hash-algos (get-config "digestname"))
100 (define all-cipher-algos (get-config "ciphername"))
101
102 (define (have-pubkey-algo? x)
103   (not (not (member x all-pubkey-algos))))
104 (define (have-hash-algo? x)
105   (not (not (member x all-hash-algos))))
106 (define (have-cipher-algo? x)
107   (not (not (member x all-cipher-algos))))
108
109 (define (gpg-pipe args0 args1 errfd)
110   (lambda (source sink)
111     (let* ((p (pipe))
112            (task0 (spawn-process-fd `(,@GPG ,@args0)
113                    source (:write-end p) errfd))
114            (_ (close (:write-end p)))
115            (task1 (spawn-process-fd `(,@GPG ,@args1)
116                    (:read-end p) sink errfd)))
117       (close (:read-end p))
118       (wait-processes (list GPG GPG) (list task0 task1) #t))))
119
120 (setenv "GPG_AGENT_INFO" "" #t)
121 (setenv "GNUPGHOME" (getcwd) #t)
122
123 ;;
124 ;; GnuPG helper.
125 ;;
126
127 ;; Call GPG to obtain the hash sums.  Either specify an input file in
128 ;; ARGS, or an string in INPUT.  Returns a list of (<algo>
129 ;; "<hashsum>") lists.
130 (define (gpg-hash-string args input)
131   (map
132    (lambda (line)
133      (let ((p (string-split line #\:)))
134        (list (string->number (cadr p)) (caddr p))))
135    (string-split-newlines
136     (call-popen `(,@GPG --with-colons ,@args) input))))
137
138 ;; Dearmor a file.
139 (define (dearmor source-name sink-name)
140   (pipe:do
141    (pipe:open source-name (logior O_RDONLY O_BINARY))
142    (pipe:spawn `(,@GPG --dearmor))
143    (pipe:write-to sink-name (logior O_WRONLY O_CREAT O_BINARY) #o600)))
144
145 (let ((verbose (string->number (getenv "verbose"))))
146   (if (number? verbose)
147       (*set-verbose!* verbose)))
148
149 ;;
150 ;; Support for test environment creation and teardown.
151 ;;
152
153 (define (make-test-data filename size)
154   (call-with-binary-output-file
155    filename
156    (lambda (port)
157      (display (make-random-string size) port))))
158
159 (define (create-gpghome)
160   (log "Creating test environment...")
161
162   (srandom (getpid))
163   (make-test-data "random_seed" 600)
164
165   (log "Creating configuration files")
166   (for-each
167    (lambda (name)
168      (file-copy (in-srcdir (string-append name ".tmpl")) name)
169      (let ((p (open-input-output-file name)))
170        (cond
171         ((string=? "gpg.conf" name)
172          (if have-opt-always-trust
173              (display "no-auto-check-trustdb\n" p))
174          (display (string-append "agent-program "
175                                  (tool 'gpg-agent)
176                                  "|--debug-quick-random\n") p)
177          (display "allow-weak-digest-algos\n" p))
178         ((string=? "gpg-agent.conf" name)
179          (display (string-append "pinentry-program " PINENTRY "\n") p)))))
180    '("gpg.conf" "gpg-agent.conf")))
181
182 ;; Initialize the test environment, install appropriate configuration
183 ;; and start the agent, without any keys.
184 (define (setup-environment)
185   (create-gpghome)
186   (start-agent))
187
188 (define (create-legacy-gpghome)
189   (log "Creating sample data files")
190   (for-each
191    (lambda (size)
192      (make-test-data (string-append "data-" (number->string size))
193                      size))
194    '(500 9000 32000 80000))
195
196   (log "Unpacking samples")
197   (for-each
198    (lambda (name)
199      (dearmor (in-srcdir (string-append name "o.asc")) name))
200    '("plain-1" "plain-2" "plain-3" "plain-large"))
201
202   (mkdir "private-keys-v1.d" "-rwx")
203
204   (log "Storing private keys")
205   (for-each
206    (lambda (name)
207      (dearmor (in-srcdir (string-append "/privkeys/" name ".asc"))
208               (string-append "private-keys-v1.d/" name ".key")))
209    '("50B2D4FA4122C212611048BC5FC31BD44393626E"
210      "7E201E28B6FEB2927B321F443205F4724EBE637E"
211      "13FDB8809B17C5547779F9D205C45F47CE0217CE"
212      "343D8AF79796EE107D645A2787A9D9252F924E6F"
213      "8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34"
214      "0D6F6AD4C4C803B25470F9104E9F4E6A4CA64255"
215      "FD692BD59D6640A84C8422573D469F84F3B98E53"
216      "76F7E2B35832976B50A27A282D9B87E44577EB66"
217      "A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD"
218      "00FE67F28A52A8AA08FFAED20AF832DA916D1985"
219      "1DF48228FEFF3EC2481B106E0ACA8C465C662CC5"
220      "A2832820DC9F40751BDCD375BB0945BA33EC6B4C"
221      "ADE710D74409777B7729A7653373D820F67892E0"
222      "CEFC51AF91F68A2904FBFF62C4F075A4785B803F"
223      "1E28F20E41B54C2D1234D896096495FF57E08D18"
224      "EB33B687EB8581AB64D04852A54453E85F3DF62D"
225      "C6A6390E9388CDBAD71EAEA698233FE5E04F001E"
226      "D69102E0F5AC6B6DB8E4D16DA8E18CF46D88CAE3"))
227
228   (log "Importing public demo and test keys")
229   (for-each
230    (lambda (file)
231      (call-check `(,@GPG --yes --import ,(in-srcdir file))))
232    (list "pubdemo.asc" "pubring.asc" key-file1))
233
234   (pipe:do
235    (pipe:open (in-srcdir "pubring.pkr.asc") (logior O_RDONLY O_BINARY))
236    (pipe:spawn `(,@GPG --dearmor))
237    (pipe:spawn `(,@GPG --yes --import))))
238
239 (define (preset-passphrases)
240   (log "Presetting passphrases")
241   ;; one@example.com
242   (call-check `(,(tool 'gpg-preset-passphrase)
243                 --preset --passphrase def
244                 "50B2D4FA4122C212611048BC5FC31BD44393626E"))
245   (call-check `(,(tool 'gpg-preset-passphrase)
246                 --preset --passphrase def
247                 "7E201E28B6FEB2927B321F443205F4724EBE637E"))
248   ;; alpha@example.net
249   (call-check `(,(tool 'gpg-preset-passphrase)
250                 --preset --passphrase abc
251                 "76F7E2B35832976B50A27A282D9B87E44577EB66"))
252   (call-check `(,(tool 'gpg-preset-passphrase)
253                 --preset --passphrase abc
254                 "A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD")))
255
256 ;; Initialize the test environment, install appropriate configuration
257 ;; and start the agent, with the keys from the legacy test suite.
258 (define (setup-legacy-environment)
259   (create-gpghome)
260   (if (member "--unpack-tarball" *args*)
261       (begin
262         (call-check `(,(tool 'gpgtar) --extract --directory=. ,(cadr *args*)))
263         (start-agent))
264       (begin
265         (start-agent)
266         (create-legacy-gpghome)))
267   (preset-passphrases))
268
269 ;; Create the socket dir and start the agent.
270 (define (start-agent)
271   (log "Starting gpg-agent...")
272   (atexit stop-agent)
273   (catch (log "Warning: Creating socket directory failed:" (car *error*))
274          (call-popen `(,(tool 'gpgconf) --create-socketdir) ""))
275   (call-check `(,(tool 'gpg-connect-agent) --verbose
276                 ,(string-append "--agent-program=" (tool 'gpg-agent)
277                                 "|--debug-quick-random")
278                 /bye)))
279
280 ;; Stop the agent and remove the socket dir.
281 (define (stop-agent)
282   (log "Stopping gpg-agent...")
283   (catch (log "Warning: Removing socket directory failed.")
284          (call-popen `(,(tool 'gpgconf) --remove-socketdir) ""))
285   (call-check `(,(tool 'gpg-connect-agent) --verbose --no-autostart
286                 killagent /bye)))