doc: Fix description of the field 11.
[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 (in-srcdir "tests" "openpgp" "defs.scm"))
21 (load (with-path "time.scm"))
22 (setup-environment)
23
24 (define (exact id)
25   (string-append "=" id))
26
27 (define (count-uids-of-secret-key id)
28   (length (filter (lambda (x) (and (string=? "uid" (car x))
29                                    (not (string=? "r" (cadr x)))))
30                   (gpg-with-colons
31                    `(--with-fingerprint
32                      --list-secret-keys ,(exact id))))))
33
34 (define alpha "Alpha <alpha@invalid.example.net>")
35 (define bravo "Bravo <bravo@invalid.example.net>")
36 (define charlie "Charlie <charlie@invalid.example.net>")
37
38 (define (key-data key)
39   (filter (lambda (x) (or (string=? (car x) "pub")
40                           (string=? (car x) "sub")))
41           (gpg-with-colons `(-k ,key))))
42
43 (setenv "PINENTRY_USER_DATA" "test" #t)
44
45 (info "Checking quick key generation...")
46 (call-check `(,@GPG --quick-generate-key ,alpha))
47
48 (define keyinfo (gpg-with-colons `(-k ,(exact alpha))))
49 (define fpr (:fpr (assoc "fpr" keyinfo)))
50
51 (assert (= 1 (count-uids-of-secret-key alpha)))
52 (assert (not (equal? "" (:expire (assoc "pub" keyinfo)))))
53
54 (info "Checking that we can add a user ID...")
55
56 ;; Make sure the key capabilities don't change when we add a user id.
57 ;; (See bug #2697.)
58 (let ((pre (key-data (exact alpha)))
59       (result (call-check `(,@GPG --quick-add-uid ,(exact alpha) ,bravo)))
60       (post (key-data (exact alpha))))
61   (if (not (equal? pre post))
62       (begin
63         (display "Key capabilities changed when adding a user id:")
64         (newline)
65         (display "  Pre: ")
66         (display pre)
67         (newline)
68         (display " Post: ")
69         (display post)
70         (newline)
71         (exit 1))))
72
73 (assert (= 2 (count-uids-of-secret-key alpha)))
74 (assert (= 2 (count-uids-of-secret-key bravo)))
75
76 (info "Checking that we can mark an user ID as primary.")
77 (call-check `(,@gpg --quick-set-primary-uid ,(exact alpha) ,alpha))
78 (call-check `(,@gpg --quick-set-primary-uid ,(exact alpha) ,bravo))
79 ;; XXX I don't know how to verify this.  The keylisting does not seem
80 ;; to indicate the primary UID.
81
82 (info "Checking that we get an error making non-existent user ID the primary one.")
83 (catch '()
84        (call-check `(,@GPG --quick-set-primary-uid ,(exact alpha) ,charlie))
85        (error "Expected an error, but get none."))
86
87 (info "Checking that we can revoke a user ID...")
88 (call-check `(,@GPG --quick-revoke-uid ,(exact bravo) ,alpha))
89
90 (info "Checking that we get an error revoking a non-existent user ID.")
91 (catch '()
92        (call-check `(,@GPG --quick-revoke-uid ,(exact bravo) ,charlie))
93        (error "Expected an error, but get none."))
94
95 (info "Checking that we get an error revoking the last valid user ID.")
96 (catch '()
97        (call-check `(,@GPG --quick-revoke-uid ,(exact bravo) ,bravo))
98        (error "Expected an error, but get none."))
99
100 (assert (= 1 (count-uids-of-secret-key bravo)))
101
102 (info "Checking that we can change the expiration time.")
103
104 (define (expiration-time id)
105   (:expire (assoc "pub" (gpg-with-colons `(-k ,id)))))
106
107 ;; Remove the expiration date.
108 (call-check `(,@gpg --quick-set-expire ,fpr "0"))
109 (assert (equal? "" (expiration-time fpr)))
110
111 ;; Make the key expire in one year.
112 (call-check `(,@gpg --quick-set-expire ,fpr "1y"))
113 (assert (time-matches? (+ (get-time) (years->seconds 1))
114                        (string->number (expiration-time fpr))
115                        (minutes->seconds 5)))
116
117
118 ;;
119 ;; Check --quick-addkey
120 ;;
121
122 ;; Get the subkeys.
123 (define (get-subkeys)
124   (filter (lambda (x) (equal? "sub" (car x)))
125           (gpg-with-colons `(-k ,fpr))))
126
127 ;; This keeps track of the number of subkeys.
128 (define count (length (get-subkeys)))
129
130 (for-each-p
131  "Checking that we can add subkeys..."
132  (lambda (args check)
133    (set! count (+ 1 count))
134    (call-check `(,@gpg --quick-add-key ,fpr ,@args))
135    (let ((subkeys (get-subkeys)))
136      (assert (= count (length subkeys)))
137      (if check (check (last subkeys)))))
138  ;; A bunch of arguments...
139  '(()
140    (- - -)
141    (default default never)
142    (rsa "sign auth encr" "seconds=600") ;; GPGME uses this
143    (rsa "auth,encr" "2") ;; "without a letter, days is assumed"
144    ;; Sadly, the timestamp is truncated by the use of time_t on
145    ;; systems where time_t is a signed 32 bit value.
146    (rsa "sign" "2038-01-01")      ;; unix millennium
147    (rsa "sign" "20380101T115500") ;; unix millennium
148    ;; Once fixed, we can use later timestamps:
149    ;; (rsa "sign" "2105-01-01")      ;; "last year GnuPG can represent is 2105"
150    ;; (rsa "sign" "21050101T115500") ;; "last year GnuPG can represent is 2105"
151    (rsa sign "2d")
152    (rsa1024 sign "2w")
153    (rsa2048 encr "2m")
154    (rsa4096 sign,auth "2y")
155    (future-default))
156  ;; ... with functions to check that the created key matches the
157  ;; expectations (or #f for no tests).
158  (list
159   #f
160   #f
161   (lambda (subkey)
162     (assert (equal? "" (:expire subkey))))
163   (lambda (subkey)
164     (assert (= 1 (:alg subkey)))
165     (assert (string-contains? (:cap subkey) "s"))
166     (assert (string-contains? (:cap subkey) "a"))
167     (assert (string-contains? (:cap subkey) "e"))
168     (assert (time-matches? (+ (get-time) 600)
169                            (string->number (:expire subkey))
170                            (minutes->seconds 5))))
171   (lambda (subkey)
172     (assert (= 1 (:alg subkey)))
173     (assert (string-contains? (:cap subkey) "a"))
174     (assert (string-contains? (:cap subkey) "e"))
175     (assert (time-matches? (+ (get-time) (days->seconds 2))
176                            (string->number (:expire subkey))
177                            (minutes->seconds 5))))
178   (lambda (subkey)
179     (assert (= 1 (:alg subkey)))
180     (assert (string-contains? (:cap subkey) "s"))
181     (assert (time-matches? 2145960000    ;; UTC 2038-01-01 12:00:00
182                            ;; 4260254400 ;; UTC 2105-01-01 12:00:00
183                            (string->number (:expire subkey))
184                            ;; GnuPG choses the middle of the day (local time)
185                            ;; when no hh:mm:ss is specified
186                            (days->seconds 1))))
187   (lambda (subkey)
188     (assert (= 1 (:alg subkey)))
189     (assert (string-contains? (:cap subkey) "s"))
190     (assert (time-matches? 2145959700    ;; UTC 2038-01-01 11:55:00
191                            ;; 4260254100 ;; UTC 2105-01-01 11:55:00
192                            (string->number (:expire subkey))
193                            (minutes->seconds 5))))
194   (lambda (subkey)
195     (assert (= 1 (:alg subkey)))
196     (assert (string-contains? (:cap subkey) "s"))
197     (assert (time-matches? (+ (get-time) (days->seconds 2))
198                            (string->number (:expire subkey))
199                            (minutes->seconds 5))))
200   (lambda (subkey)
201     (assert (= 1 (:alg subkey)))
202     (assert (= 1024 (:length subkey)))
203     (assert (string-contains? (:cap subkey) "s"))
204     (assert (time-matches? (+ (get-time) (weeks->seconds 2))
205                            (string->number (:expire subkey))
206                            (minutes->seconds 5))))
207   (lambda (subkey)
208     (assert (= 1 (:alg subkey)))
209     (assert (= 2048 (:length subkey)))
210     (assert (string-contains? (:cap subkey) "e"))
211     (assert (time-matches? (+ (get-time) (months->seconds 2))
212                            (string->number (:expire subkey))
213                            (minutes->seconds 5))))
214   (lambda (subkey)
215     (assert (= 1 (:alg subkey)))
216     (assert (= 4096 (:length subkey)))
217     (assert (string-contains? (:cap subkey) "s"))
218     (assert (string-contains? (:cap subkey) "a"))
219     (assert (time-matches? (+ (get-time) (years->seconds 2))
220                            (string->number (:expire subkey))
221                            (minutes->seconds 5))))
222   #f))