tests: Add test for issue 2959.
[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 (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 revoke a user ID...")
77 (call-check `(,@GPG --quick-revoke-uid ,(exact bravo) ,alpha))
78
79 (info "Checking that we get an error revoking a non-existant user ID.")
80 (catch '()
81        (call-check `(,@GPG --quick-revoke-uid ,(exact bravo) ,charlie))
82        (error "Expected an error, but get none."))
83
84 (info "Checking that we get an error revoking the last valid user ID.")
85 (catch '()
86        (call-check `(,@GPG --quick-revoke-uid ,(exact bravo) ,bravo))
87        (error "Expected an error, but get none."))
88
89 (assert (= 1 (count-uids-of-secret-key bravo)))
90
91 (info "Checking that we can change the expiration time.")
92
93 (define (expiration-time id)
94   (:expire (assoc "pub" (gpg-with-colons `(-k ,id)))))
95
96 ;; Remove the expiration date.
97 (call-check `(,@gpg --quick-set-expire ,fpr "0"))
98 (assert (equal? "" (expiration-time fpr)))
99
100 ;; Make the key expire in one year.
101 (call-check `(,@gpg --quick-set-expire ,fpr "1y"))
102 (assert (time-matches? (+ (get-time) (years->seconds 1))
103                        (string->number (expiration-time fpr))
104                        (minutes->seconds 5)))
105
106
107 ;;
108 ;; Check --quick-addkey
109 ;;
110
111 ;; Get the subkeys.
112 (define (get-subkeys)
113   (filter (lambda (x) (equal? "sub" (car x)))
114           (gpg-with-colons `(-k ,fpr))))
115
116 ;; This keeps track of the number of subkeys.
117 (define count (length (get-subkeys)))
118
119 (for-each-p
120  "Checking that we can add subkeys..."
121  (lambda (args check)
122    (set! count (+ 1 count))
123    (call-check `(,@gpg --quick-add-key ,fpr ,@args))
124    (let ((subkeys (get-subkeys)))
125      (assert (= count (length subkeys)))
126      (if check (check (last subkeys)))))
127  ;; A bunch of arguments...
128  '(()
129    (- - -)
130    (default default never)
131    (rsa "sign auth encr" "seconds=600") ;; GPGME uses this
132    (rsa "auth,encr" "2") ;; "without a letter, days is assumed"
133    ;; Sadly, the timestamp is truncated by the use of time_t on
134    ;; systems where time_t is a signed 32 bit value.
135    (rsa "sign" "2038-01-01")      ;; unix millennium
136    (rsa "sign" "20380101T115500") ;; unix millennium
137    ;; Once fixed, we can use later timestamps:
138    ;; (rsa "sign" "2105-01-01")      ;; "last year GnuPG can represent is 2105"
139    ;; (rsa "sign" "21050101T115500") ;; "last year GnuPG can represent is 2105"
140    (rsa sign "2d")
141    (rsa1024 sign "2w")
142    (rsa2048 encr "2m")
143    (rsa4096 sign,auth "2y")
144    (future-default))
145  ;; ... with functions to check that the created key matches the
146  ;; expectations (or #f for no tests).
147  (list
148   #f
149   #f
150   (lambda (subkey)
151     (assert (equal? "" (:expire subkey))))
152   (lambda (subkey)
153     (assert (= 1 (:alg subkey)))
154     (assert (string-contains? (:cap subkey) "s"))
155     (assert (string-contains? (:cap subkey) "a"))
156     (assert (string-contains? (:cap subkey) "e"))
157     (assert (time-matches? (+ (get-time) 600)
158                            (string->number (:expire subkey))
159                            (minutes->seconds 5))))
160   (lambda (subkey)
161     (assert (= 1 (:alg subkey)))
162     (assert (string-contains? (:cap subkey) "a"))
163     (assert (string-contains? (:cap subkey) "e"))
164     (assert (time-matches? (+ (get-time) (days->seconds 2))
165                            (string->number (:expire subkey))
166                            (minutes->seconds 5))))
167   (lambda (subkey)
168     (assert (= 1 (:alg subkey)))
169     (assert (string-contains? (:cap subkey) "s"))
170     (assert (time-matches? 2145916800    ;; 2038-01-01
171                            ;; 4260207600 ;; 2105-01-01
172                            (string->number (:expire subkey))
173                            ;; This is off by 12h, but I guess it just
174                            ;; choses the middle of the day.
175                            (days->seconds 1))))
176   (lambda (subkey)
177     (assert (= 1 (:alg subkey)))
178     (assert (string-contains? (:cap subkey) "s"))
179     (assert (time-matches? 2145959700    ;; UTC 2038-01-01 11:55:00
180                            ;; 4260254100 ;; UTC 2105-01-01 11:55:00
181                            (string->number (:expire subkey))
182                            (minutes->seconds 5))))
183   (lambda (subkey)
184     (assert (= 1 (:alg subkey)))
185     (assert (string-contains? (:cap subkey) "s"))
186     (assert (time-matches? (+ (get-time) (days->seconds 2))
187                            (string->number (:expire subkey))
188                            (minutes->seconds 5))))
189   (lambda (subkey)
190     (assert (= 1 (:alg subkey)))
191     (assert (= 1024 (:length subkey)))
192     (assert (string-contains? (:cap subkey) "s"))
193     (assert (time-matches? (+ (get-time) (weeks->seconds 2))
194                            (string->number (:expire subkey))
195                            (minutes->seconds 5))))
196   (lambda (subkey)
197     (assert (= 1 (:alg subkey)))
198     (assert (= 2048 (:length subkey)))
199     (assert (string-contains? (:cap subkey) "e"))
200     (assert (time-matches? (+ (get-time) (months->seconds 2))
201                            (string->number (:expire subkey))
202                            (minutes->seconds 5))))
203   (lambda (subkey)
204     (assert (= 1 (:alg subkey)))
205     (assert (= 4096 (:length subkey)))
206     (assert (string-contains? (:cap subkey) "s"))
207     (assert (string-contains? (:cap subkey) "a"))
208     (assert (time-matches? (+ (get-time) (years->seconds 2))
209                            (string->number (:expire subkey))
210                            (minutes->seconds 5))))
211   #f))