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