tests: Test and document other ways to create keys.
[gnupg.git] / tests / openpgp / quick-key-manipulation.scm
1 #!/usr/bin/env gpgscm
2
3 ;; Copyright (C) 2016-2017 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 (load (with-path "time.scm"))
22 (setup-environment)
23
24  ;; XXX because of --always-trust, the trustdb is not created.
25  ;; Therefore, we redefine GPG without --always-trust.
26 (define GPG `(,(tool 'gpg) --no-permission-warning))
27
28 (define (exact id)
29   (string-append "=" id))
30
31 (define (count-uids-of-secret-key id)
32   (length (filter (lambda (x) (and (string=? "uid" (car x))
33                                    (not (string=? "r" (cadr x)))))
34                   (gpg-with-colons
35                    `(--with-fingerprint
36                      --list-secret-keys ,(exact id))))))
37
38 (define alpha "Alpha <alpha@invalid.example.net>")
39 (define bravo "Bravo <bravo@invalid.example.net>")
40
41 (define (key-data key)
42   (filter (lambda (x) (or (string=? (car x) "pub")
43                           (string=? (car x) "sub")))
44           (gpg-with-colons `(-k ,key))))
45
46 (setenv "PINENTRY_USER_DATA" "test" #t)
47
48 (info "Checking quick key generation...")
49 (call-check `(,@GPG --quick-generate-key ,alpha))
50
51 (define keyinfo (gpg-with-colons `(-k ,(exact alpha))))
52 (define fpr (:fpr (assoc "fpr" keyinfo)))
53
54 (assert (= 1 (count-uids-of-secret-key alpha)))
55 (assert (not (equal? "" (:expire (assoc "pub" keyinfo)))))
56
57 (info "Checking that we can add a user ID...")
58
59 ;; Make sure the key capabilities don't change when we add a user id.
60 ;; (See bug #2697.)
61 (let ((pre (key-data (exact alpha)))
62       (result (call-check `(,@GPG --quick-add-uid ,(exact alpha) ,bravo)))
63       (post (key-data (exact alpha))))
64   (if (not (equal? pre post))
65       (begin
66         (display "Key capabilities changed when adding a user id:")
67         (newline)
68         (display "  Pre: ")
69         (display pre)
70         (newline)
71         (display " Post: ")
72         (display post)
73         (newline)
74         (exit 1))))
75
76 (assert (= 2 (count-uids-of-secret-key alpha)))
77 (assert (= 2 (count-uids-of-secret-key bravo)))
78
79 (info "Checking that we can revoke a user ID...")
80 (call-check `(,@GPG --quick-revoke-uid ,(exact bravo) ,alpha))
81
82 (assert (= 1 (count-uids-of-secret-key bravo)))
83
84 (info "Checking that we can change the expiration time.")
85
86 (define (expiration-time id)
87   (:expire (assoc "pub" (gpg-with-colons `(-k ,id)))))
88
89 ;; Remove the expiration date.
90 (call-check `(,@gpg --quick-set-expire ,fpr "0"))
91 (assert (equal? "" (expiration-time fpr)))
92
93 ;; Make the key expire in one year.
94 (call-check `(,@gpg --quick-set-expire ,fpr "1y"))
95 (assert (time-matches? (+ (get-time) (years->seconds 1))
96                        (string->number (expiration-time fpr))
97                        (minutes->seconds 5)))
98
99
100 ;;
101 ;; Check --quick-addkey
102 ;;
103
104 ;; Get the subkeys.
105 (define (get-subkeys)
106   (filter (lambda (x) (equal? "sub" (car x)))
107           (gpg-with-colons `(-k ,fpr))))
108
109 ;; This keeps track of the number of subkeys.
110 (define count (length (get-subkeys)))
111
112 (for-each-p
113  "Checking that we can add subkeys..."
114  (lambda (args check)
115    (set! count (+ 1 count))
116    (call-check `(,@gpg --quick-add-key ,fpr ,@args))
117    (let ((subkeys (get-subkeys)))
118      (assert (= count (length subkeys)))
119      (if check (check (last subkeys)))))
120  ;; A bunch of arguments...
121  '(()
122    (- - -)
123    (default default never)
124    (rsa "sign auth encr" "seconds=600") ;; GPGME uses this
125    (rsa "auth,encr" "2") ;; "without a letter, days is assumed"
126    (rsa "sign" "2105-01-01") ;; "last year GnuPG can represent is 2105"
127    (rsa "sign" "21050101T115500") ;; "last year GnuPG can represent is 2105"
128    (rsa sign "2d")
129    (rsa1024 sign "2w")
130    (rsa2048 encr "2m")
131    (rsa4096 sign,auth "2y")
132    (future-default))
133  ;; ... with functions to check that the created key matches the
134  ;; expectations (or #f for no tests).
135  (list
136   #f
137   #f
138   (lambda (subkey)
139     (assert (equal? "" (:expire subkey))))
140   (lambda (subkey)
141     (assert (= 1 (:alg subkey)))
142     (assert (string-contains? (:cap subkey) "s"))
143     (assert (string-contains? (:cap subkey) "a"))
144     (assert (string-contains? (:cap subkey) "e"))
145     (assert (time-matches? (+ (get-time) 600)
146                            (string->number (:expire subkey))
147                            (minutes->seconds 5))))
148   (lambda (subkey)
149     (assert (= 1 (:alg subkey)))
150     (assert (string-contains? (:cap subkey) "a"))
151     (assert (string-contains? (:cap subkey) "e"))
152     (assert (time-matches? (+ (get-time) (days->seconds 2))
153                            (string->number (:expire subkey))
154                            (minutes->seconds 5))))
155   (lambda (subkey)
156     (assert (= 1 (:alg subkey)))
157     (assert (string-contains? (:cap subkey) "s"))
158     (assert (time-matches? 4260207600 ;; 2105-01-01
159                            (string->number (:expire subkey))
160                            ;; This is off by 12h, but I guess it just
161                            ;; choses the middle of the day.
162                            (days->seconds 1))))
163   (lambda (subkey)
164     (assert (= 1 (:alg subkey)))
165     (assert (string-contains? (:cap subkey) "s"))
166     (assert (time-matches? 4260254100 ;; UTC 2105-01-01 11:55:00
167                            (string->number (:expire subkey))
168                            (minutes->seconds 5))))
169   (lambda (subkey)
170     (assert (= 1 (:alg subkey)))
171     (assert (string-contains? (:cap subkey) "s"))
172     (assert (time-matches? (+ (get-time) (days->seconds 2))
173                            (string->number (:expire subkey))
174                            (minutes->seconds 5))))
175   (lambda (subkey)
176     (assert (= 1 (:alg subkey)))
177     (assert (= 1024 (:length subkey)))
178     (assert (string-contains? (:cap subkey) "s"))
179     (assert (time-matches? (+ (get-time) (weeks->seconds 2))
180                            (string->number (:expire subkey))
181                            (minutes->seconds 5))))
182   (lambda (subkey)
183     (assert (= 1 (:alg subkey)))
184     (assert (= 2048 (:length subkey)))
185     (assert (string-contains? (:cap subkey) "e"))
186     (assert (time-matches? (+ (get-time) (months->seconds 2))
187                            (string->number (:expire subkey))
188                            (minutes->seconds 5))))
189   (lambda (subkey)
190     (assert (= 1 (:alg subkey)))
191     (assert (= 4096 (:length subkey)))
192     (assert (string-contains? (:cap subkey) "s"))
193     (assert (string-contains? (:cap subkey) "a"))
194     (assert (time-matches? (+ (get-time) (years->seconds 2))
195                            (string->number (:expire subkey))
196                            (minutes->seconds 5))))
197   #f))