tests/openpgp: Fake the system time for the tofu test.
[gnupg.git] / tests / openpgp / tofu.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  ;; Redefine GPG without --always-trust and a fixed time.
23 (define GPG `(,(tool 'gpg) --no-permission-warning
24               --faked-system-time=1466684990))
25 (define GNUPGHOME (getenv "GNUPGHOME"))
26 (if (string=? "" GNUPGHOME)
27     (error "GNUPGHOME not set"))
28
29 (catch (skip "Tofu not supported")
30        (call-check `(,@GPG --trust-model=tofu --list-config)))
31
32 (define KEYS '("2183839A" "BC15C85A" "EE37CF96"))
33
34 ;; Import the test keys.
35 (call-check `(,@GPG --import ,(in-srcdir "tofu-keys.asc")))
36
37 ;; Make sure the keys are imported.
38 (for-each (lambda (keyid)
39             (catch (error "Missing key" keyid)
40                    (call-check `(,@GPG --list-keys ,keyid))))
41           KEYS)
42
43 ;; Get tofu policy for KEYID.  Any remaining arguments are simply
44 ;; passed to GPG.
45 ;;
46 ;; This function only supports keys with a single user id.
47 (define (getpolicy keyid format . args)
48   (let ((policy
49          (list-ref (assoc "uid" (gpg-with-colons
50                                  `(--tofu-db-format ,format
51                                    --trust-model=tofu
52                                    ,@args
53                                    --list-keys ,keyid))) 17)))
54     (unless (member policy '("auto" "good" "unknown" "bad" "ask"))
55             (error "Bad policy:" policy))
56     policy))
57
58 ;; Check that KEYID's tofu policy matches EXPECTED-POLICY.  Any
59 ;; remaining arguments are simply passed to GPG.
60 ;;
61 ;; This function only supports keys with a single user id.
62 (define (checkpolicy keyid format expected-policy . args)
63   (let ((policy (apply getpolicy `(,keyid ,format ,@args))))
64     (unless (string=? policy expected-policy)
65             (error keyid ": Expected policy to be" expected-policy
66                    "but got" policy))))
67
68 ;; Get the trust level for KEYID.  Any remaining arguments are simply
69 ;; passed to GPG.
70 ;;
71 ;; This function only supports keys with a single user id.
72 (define (gettrust keyid format . args)
73   (let ((trust
74          (list-ref (assoc "pub" (gpg-with-colons
75                                  `(--tofu-db-format ,format
76                                    --trust-model=tofu
77                                    ,@args
78                                    --list-keys ,keyid))) 1)))
79     (unless (and (= 1 (string-length trust))
80                  (member (string-ref trust 0) (string->list "oidreqnmfuws-")))
81             (error "Bad trust value:" trust))
82     trust))
83
84 ;; Check that KEYID's trust level matches EXPECTED-TRUST.  Any
85 ;; remaining arguments are simply passed to GPG.
86 ;;
87 ;; This function only supports keys with a single user id.
88 (define (checktrust keyid format expected-trust . args)
89   (let ((trust (apply gettrust `(,keyid ,format ,@args))))
90     (unless (string=? trust expected-trust)
91             (error keyid ": Expected trust to be" expected-trust
92                    "but got" trust))))
93
94 ;; Set key KEYID's policy to POLICY.  Any remaining arguments are
95 ;; passed as options to gpg.
96 (define (setpolicy keyid format policy . args)
97   (call-check `(,@GPG --tofu-db-format ,format
98                       --trust-model=tofu ,@args
99                       --tofu-policy ,policy ,keyid)))
100
101 (for-each-p
102  "Testing tofu db formats"
103  (lambda (format)
104    ;; Carefully remove the TOFU db.
105    (catch '() (unlink (string-append GNUPGHOME "/tofu.db")))
106    (catch '() (unlink-recursively (string-append GNUPGHOME "/tofu.d")))
107
108    ;; Verify a message.  There should be no conflict and the trust
109    ;; policy should be set to auto.
110    (call-check `(,@GPG --tofu-db-format ,format --trust-model=tofu
111                        --verify ,(in-srcdir "tofu-2183839A-1.txt")))
112
113    (checkpolicy "2183839A" format "auto")
114    ;; Check default trust.
115    (checktrust "2183839A" format "m")
116
117    ;; Trust should be derived lazily.  Thus, if the policy is set to
118    ;; auto and we change --tofu-default-policy, then the trust should
119    ;; change as well.  Try it.
120    (checktrust "2183839A" format "f" '--tofu-default-policy=good)
121    (checktrust "2183839A" format "-" '--tofu-default-policy=unknown)
122    (checktrust "2183839A" format "n" '--tofu-default-policy=bad)
123
124    ;; Change the policy to something other than auto and make sure the
125    ;; policy and the trust are correct.
126    (for-each-p
127     ""
128     (lambda (policy)
129       (let ((expected-trust
130              (cond
131               ((string=? "good" policy) "f")
132               ((string=? "unknown" policy) "-")
133               (else "n"))))
134         (setpolicy "2183839A" format policy)
135
136         ;; Since we have a fixed policy, the trust level shouldn't
137         ;; change if we change the default policy.
138         (for-each-p
139          ""
140          (lambda (default-policy)
141            (checkpolicy "2183839A" format policy
142                         '--tofu-default-policy default-policy)
143            (checktrust "2183839A" format expected-trust
144                        '--tofu-default-policy default-policy))
145          '("auto" "good" "unknown" "bad" "ask"))))
146     '("good" "unknown" "bad"))
147
148    ;; BC15C85A conflicts with 2183839A.  On conflict, this will set
149    ;; BC15C85A to ask.  If 2183839A is auto (it's not, it's bad), then
150    ;; it will be set to ask.
151    (call-check `(,@GPG --tofu-db-format ,format --trust-model=tofu
152                        --verify ,(in-srcdir "tofu-BC15C85A-1.txt")))
153    (checkpolicy "BC15C85A" format "ask")
154    (checkpolicy "2183839A" format "bad")
155
156    ;; EE37CF96 conflicts with 2183839A and BC15C85A.  We change
157    ;; BC15C85A's policy to auto and leave 2183839A's policy at bad.
158    ;; This conflict should cause BC15C85A's policy to be changed to
159    ;; ask (since it is auto), but not affect 2183839A's policy.
160    (setpolicy "BC15C85A" format "auto")
161    (checkpolicy "BC15C85A" format "auto")
162    (call-check `(,@GPG --tofu-db-format ,format --trust-model=tofu
163                        --verify ,(in-srcdir "tofu-EE37CF96-1.txt")))
164    (checkpolicy "BC15C85A" format "ask")
165    (checkpolicy "2183839A" format "bad")
166    (checkpolicy "EE37CF96" format "ask"))
167  '("split" "flat"))