test: Extend TOFU tests to also check the days with signatures.
[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 keys
39   (package
40    (define (new fpr grip uids subkeys)
41      (package))
42    (define (subkey fpr grip)
43      (package))
44    (define alfa (new "A0FF4590BB6122EDEF6E3C542D727CC768697734"
45                      "76F7E2B35832976B50A27A282D9B87E44577EB66"
46                      '("alfa@example.net" "alpha@example.net")
47                      (list
48                       (subkey "3B3FBC948FE59301ED629EFB6AE6D7EE46A871F8"
49                               "A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD"))))
50    (define one (new "289B0EF1D105E124B6F626020EF77096D74C5F22"
51                     "50B2D4FA4122C212611048BC5FC31BD44393626E"
52                     '("one@example.com")
53                     (list
54                      (subkey "EB467DCA4AD7676A6A62B2ABABAB28A247BE2775"
55                              "7E201E28B6FEB2927B321F443205F4724EBE637E"))))
56    (define two (new "C1DEBB34EA8B71009EAFA474973D50E1C40FDECF"
57                     "343D8AF79796EE107D645A2787A9D9252F924E6F"
58                     '("two@example.com")
59                     (list
60                      (subkey "CD3D0F5701CBFCACB2A4907305A37887B27907AA"
61                              "8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34"))))))
62
63 (define key-file1 "samplekeys/rsa-rsa-sample-1.asc")
64 (define key-file2 "samplekeys/ed25519-cv25519-sample-1.asc")
65
66 (define plain-files '("plain-1" "plain-2" "plain-3"))
67 (define data-files '("data-500" "data-9000" "data-32000" "data-80000"))
68 (define exp-files '())
69
70 (let ((verbose (string->number (getenv "verbose"))))
71   (if (number? verbose)
72       (*set-verbose!* verbose)))
73
74 (define (qualify executable)
75   (string-append executable (getenv "EXEEXT")))
76
77 (define (getenv' key default)
78   (let ((value (getenv key)))
79     (if (string=? "" value)
80         default
81         value)))
82
83 (define tools
84   '((gpgv "GPGV" "g10/gpgv")
85     (gpg-connect-agent "GPG_CONNECT_AGENT" "tools/gpg-connect-agent")
86     (gpgconf "GPGCONF" "tools/gpgconf")
87     (gpg-preset-passphrase "GPG_PRESET_PASSPHRASE"
88                            "agent/gpg-preset-passphrase")
89     (gpgtar "GPGTAR" "tools/gpgtar")
90     (gpg-zip "GPGZIP" "tools/gpg-zip")
91     (pinentry "PINENTRY" "tests/openpgp/fake-pinentry")))
92
93 (define (tool-hardcoded which)
94   (let ((t (assoc which tools))
95         (prefix (getenv "BIN_PREFIX")))
96     (getenv' (cadr t)
97              (qualify (if (string=? prefix "")
98                           (string-append (getenv "objdir") "/" (caddr t))
99                           (string-append prefix "/" (basename (caddr t))))))))
100
101 (define (gpg-conf . args)
102   (let ((s (call-popen `(,(tool-hardcoded 'gpgconf) ,@args) "")))
103     (map (lambda (line) (string-split line #\:))
104          (string-split-newlines s))))
105 (define :gc:c:name car)
106 (define :gc:c:description cadr)
107 (define :gc:c:pgmname caddr)
108
109 (setenv "GNUPG_BUILDDIR" (getenv "objdir") #t)
110 (define gpg-components (gpg-conf '--build-prefix (getenv "objdir")
111                                  '--list-components))
112
113 (define (tool which)
114   (case which
115     ((gpg gpg-agent scdaemon gpgsm dirmngr)
116      (:gc:c:pgmname (assoc (symbol->string which) gpg-components)))
117     (else
118      (tool-hardcoded which))))
119
120 (define (gpg-has-option? option)
121   (string-contains? (call-popen `(,(tool 'gpg) --dump-options) "")
122                     option))
123
124 (define have-opt-always-trust
125   (catch #f
126          (call-check `(,(tool 'gpg) --gpgconf-test --always-trust))
127          #t))
128
129 (define GPG `(,(tool 'gpg) --no-permission-warning
130               ,@(if have-opt-always-trust '(--always-trust) '())))
131 (define GPGV `(,(tool 'gpgv)))
132 (define PINENTRY (tool 'pinentry))
133
134 (define (tr:gpg input args)
135   (tr:spawn input `(,@GPG --output **out** ,@args **in**)))
136
137 (define (pipe:gpg args)
138   (pipe:spawn `(,@GPG --output - ,@args -)))
139
140 (define (gpg-with-colons args)
141   (let ((s (call-popen `(,@GPG --with-colons ,@args) "")))
142     (map (lambda (line) (string-split line #\:))
143          (string-split-newlines s))))
144
145 ;; Convenient accessors for the colon output.
146 (define (:type x)   (string->symbol (list-ref x 0)))
147 (define (:length x) (string->number (list-ref x 2)))
148 (define (:alg x) (string->number (list-ref x 3)))
149 (define (:expire x) (list-ref x 6))
150 (define (:fpr x) (list-ref x 9))
151 (define (:cap x) (list-ref x 11))
152
153 (define (have-public-key? key)
154   (catch #f
155          (pair? (filter (lambda (l) (and (equal? 'fpr (:type l))
156                                          (equal? key::fpr (:fpr l))))
157                         (gpg-with-colons `(--list-keys ,key::fpr))))))
158
159 (define (have-secret-key? key)
160   (catch #f
161          (pair? (filter (lambda (l) (and (equal? 'fpr (:type l))
162                                          (equal? key::fpr (:fpr l))))
163                         (gpg-with-colons `(--list-secret-keys ,key::fpr))))))
164
165 (define (have-secret-key-file? key)
166   (file-exists? (path-join (getenv "GNUPGHOME") "private-keys-v1.d"
167                            (string-append key::grip ".key"))))
168
169 (define (get-config what)
170   (string-split (caddar (gpg-with-colons `(--list-config ,what))) #\;))
171
172 (define all-pubkey-algos (delay (get-config "pubkeyname")))
173 (define all-hash-algos (delay (get-config "digestname")))
174 (define all-cipher-algos (delay (get-config "ciphername")))
175 (define all-compression-algos (delay (get-config "compressname")))
176
177 (define (have-pubkey-algo? x)
178   (not (not (member x (force all-pubkey-algos)))))
179 (define (have-hash-algo? x)
180   (not (not (member x (force all-hash-algos)))))
181 (define (have-cipher-algo? x)
182   (not (not (member x (force all-cipher-algos)))))
183
184 (define (gpg-pipe args0 args1 errfd)
185   (lambda (source sink)
186     (let* ((p (pipe))
187            (task0 (spawn-process-fd `(,@GPG ,@args0)
188                    source (:write-end p) errfd))
189            (_ (close (:write-end p)))
190            (task1 (spawn-process-fd `(,@GPG ,@args1)
191                    (:read-end p) sink errfd)))
192       (close (:read-end p))
193       (wait-processes (list GPG GPG) (list task0 task1) #t))))
194
195 (setenv "GPG_AGENT_INFO" "" #t)
196 (setenv "GNUPGHOME" (getcwd) #t)
197
198 ;;
199 ;; GnuPG helper.
200 ;;
201
202 ;; Call GPG to obtain the hash sums.  Either specify an input file in
203 ;; ARGS, or an string in INPUT.  Returns a list of (<algo>
204 ;; "<hashsum>") lists.
205 (define (gpg-hash-string args input)
206   (map
207    (lambda (line)
208      (let ((p (string-split line #\:)))
209        (list (string->number (cadr p)) (caddr p))))
210    (string-split-newlines
211     (call-popen `(,@GPG --with-colons ,@args) input))))
212
213 ;; Dearmor a file.
214 (define (dearmor source-name sink-name)
215   (pipe:do
216    (pipe:open source-name (logior O_RDONLY O_BINARY))
217    (pipe:spawn `(,@GPG --dearmor))
218    (pipe:write-to sink-name (logior O_WRONLY O_CREAT O_BINARY) #o600)))
219
220 ;;
221 ;; Support for test environment creation and teardown.
222 ;;
223
224 (define (make-test-data filename size)
225   (call-with-binary-output-file
226    filename
227    (lambda (port)
228      (display (make-random-string size) port))))
229
230 (define (create-gpghome)
231   (log "Creating test environment...")
232
233   (srandom (getpid))
234   (make-test-data "random_seed" 600)
235
236   (log "Creating configuration files")
237   (for-each
238    (lambda (name)
239      (file-copy (in-srcdir (string-append name ".tmpl")) name)
240      (let ((p (open-input-output-file name)))
241        (cond
242         ((string=? "gpg.conf" name)
243          (if have-opt-always-trust
244              (display "no-auto-check-trustdb\n" p))
245          (display (string-append "agent-program "
246                                  (tool 'gpg-agent)
247                                  "|--debug-quick-random\n") p)
248          (display "allow-weak-digest-algos\n" p))
249         ((string=? "gpg-agent.conf" name)
250          (display (string-append "pinentry-program " PINENTRY "\n") p)))))
251    '("gpg.conf" "gpg-agent.conf")))
252
253 ;; Initialize the test environment, install appropriate configuration
254 ;; and start the agent, without any keys.
255 (define (setup-environment)
256   (create-gpghome)
257   (start-agent))
258
259 (define (create-legacy-gpghome)
260   (log "Creating sample data files")
261   (for-each
262    (lambda (size)
263      (make-test-data (string-append "data-" (number->string size))
264                      size))
265    '(500 9000 32000 80000))
266
267   (log "Unpacking samples")
268   (for-each
269    (lambda (name)
270      (dearmor (in-srcdir (string-append name "o.asc")) name))
271    '("plain-1" "plain-2" "plain-3" "plain-large"))
272
273   (mkdir "private-keys-v1.d" "-rwx")
274
275   (log "Storing private keys")
276   (for-each
277    (lambda (name)
278      (dearmor (in-srcdir (string-append "/privkeys/" name ".asc"))
279               (string-append "private-keys-v1.d/" name ".key")))
280    '("50B2D4FA4122C212611048BC5FC31BD44393626E"
281      "7E201E28B6FEB2927B321F443205F4724EBE637E"
282      "13FDB8809B17C5547779F9D205C45F47CE0217CE"
283      "343D8AF79796EE107D645A2787A9D9252F924E6F"
284      "8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34"
285      "0D6F6AD4C4C803B25470F9104E9F4E6A4CA64255"
286      "FD692BD59D6640A84C8422573D469F84F3B98E53"
287      "76F7E2B35832976B50A27A282D9B87E44577EB66"
288      "A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD"
289      "00FE67F28A52A8AA08FFAED20AF832DA916D1985"
290      "1DF48228FEFF3EC2481B106E0ACA8C465C662CC5"
291      "A2832820DC9F40751BDCD375BB0945BA33EC6B4C"
292      "ADE710D74409777B7729A7653373D820F67892E0"
293      "CEFC51AF91F68A2904FBFF62C4F075A4785B803F"
294      "1E28F20E41B54C2D1234D896096495FF57E08D18"
295      "EB33B687EB8581AB64D04852A54453E85F3DF62D"
296      "C6A6390E9388CDBAD71EAEA698233FE5E04F001E"
297      "D69102E0F5AC6B6DB8E4D16DA8E18CF46D88CAE3"))
298
299   (log "Importing public demo and test keys")
300   (for-each
301    (lambda (file)
302      (call-check `(,@GPG --yes --import ,(in-srcdir file))))
303    (list "pubdemo.asc" "pubring.asc" key-file1))
304
305   (pipe:do
306    (pipe:open (in-srcdir "pubring.pkr.asc") (logior O_RDONLY O_BINARY))
307    (pipe:spawn `(,@GPG --dearmor))
308    (pipe:spawn `(,@GPG --yes --import))))
309
310 (define (preset-passphrases)
311   (log "Presetting passphrases")
312   ;; one@example.com
313   (call-check `(,(tool 'gpg-preset-passphrase)
314                 --preset --passphrase def
315                 "50B2D4FA4122C212611048BC5FC31BD44393626E"))
316   (call-check `(,(tool 'gpg-preset-passphrase)
317                 --preset --passphrase def
318                 "7E201E28B6FEB2927B321F443205F4724EBE637E"))
319   ;; alpha@example.net
320   (call-check `(,(tool 'gpg-preset-passphrase)
321                 --preset --passphrase abc
322                 "76F7E2B35832976B50A27A282D9B87E44577EB66"))
323   (call-check `(,(tool 'gpg-preset-passphrase)
324                 --preset --passphrase abc
325                 "A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD")))
326
327 ;; Initialize the test environment, install appropriate configuration
328 ;; and start the agent, with the keys from the legacy test suite.
329 (define (setup-legacy-environment)
330   (create-gpghome)
331   (if (member "--unpack-tarball" *args*)
332       (begin
333         (call-check `(,(tool 'gpgtar) --extract --directory=. ,(cadr *args*)))
334         (start-agent))
335       (begin
336         (start-agent)
337         (create-legacy-gpghome)))
338   (preset-passphrases))
339
340 ;; Create the socket dir and start the agent.
341 (define (start-agent)
342   (log "Starting gpg-agent...")
343   (atexit stop-agent)
344   (catch (log "Warning: Creating socket directory failed:" (car *error*))
345          (call-popen `(,(tool 'gpgconf) --create-socketdir) ""))
346   (call-check `(,(tool 'gpg-connect-agent) --verbose
347                 ,(string-append "--agent-program=" (tool 'gpg-agent)
348                                 "|--debug-quick-random")
349                 /bye)))
350
351 ;; Stop the agent and remove the socket dir.
352 (define (stop-agent)
353   (log "Stopping gpg-agent...")
354   (catch (log "Warning: Removing socket directory failed.")
355          (call-popen `(,(tool 'gpgconf) --remove-socketdir) ""))
356   (call-check `(,(tool 'gpg-connect-agent) --verbose --no-autostart
357                 killagent /bye)))