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