← Back to branch summary

~ubuntu-branches/ubuntu/utopic/mailcrypt/utopic

« back to all changes in this revision

Viewing changes to tests/test-gpg.el

  • Committer: Bazaar Package Importer
  • Author(s): Davide G. M. Salvetti
  • Date: 2004-02-28 12:11:35 UTC
  • Revision ID: james.westby@ubuntu.com-20040228121135-m0b6y3bqbvhtcdot
Tags: upstream-3.5.8
Import upstream version 3.5.8

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/test-gpg.el
 
1
 
 
2
(setq load-path (append '("..") load-path))
 
3
(load-library "mailcrypt")
 
4
(load-library "mc-toplev")
 
5
(load-library "mc-gpg")
 
6
(setq mc-gpg-extra-args '("--homedir" "gpg-keys/exported"))
 
7
(setq mc-test-testcasedir "gpg-testcases")
 
8
(setq mc-gpg-always-fetch 'never)
 
9
 
 
10
(defvar mc-test-verbose nil)
 
11
 
 
12
(defun mc-test-generate-plaintext (long)
 
13
  (if long
 
14
      "This is a test message."
 
15
    "This is a long test message."
 
16
    ))
 
17
 
 
18
(defun mc-test-encrypt ()
 
19
  (let ((b (get-buffer-create "mc plaintext"))
 
20
        (recipients '("owner1"))
 
21
        (mc-default-scheme 'mc-scheme-gpg)
 
22
        (mc-pgp-always-sign 'never)
 
23
        )
 
24
    (set-buffer b)
 
25
    (erase-buffer)
 
26
    (insert (mc-test-generate-plaintext nil))
 
27
    (mc-gpg-encrypt-region recipients (point-min-marker) (point-max-marker))
 
28
    )
 
29
  )
 
30
 
 
31
;; this one replaces the normal version when testing. mc-activate-passwd-count
 
32
;; must be set to 0 by the enclosing function. mc-activate-passwd-alist must
 
33
;; be set to an alist of user ids and passphrases.
 
34
(defun mc-activate-passwd (id &optional prompt)
 
35
  (let (pw)
 
36
    (setq mc-activate-passwd-count (+ mc-activate-passwd-count 1))
 
37
    (if (> mc-activate-passwd-count 5)
 
38
        (error "mc-activate-passwd looping forever, id '%s'" id))
 
39
    (if mc-test-verbose
 
40
        (message "activate-passwd id'%s' prompt'%s'" id prompt))
 
41
    (setq pw (assoc id mc-test-passwd-alist))
 
42
    (if pw
 
43
        (cdr pw)
 
44
      (message "don't know passphrase, using 'unknown'. alist is %s"
 
45
               mc-test-passwd-alist)
 
46
      "unknown"
 
47
      )
 
48
    ))
 
49
  
 
50
;; this one replaces the normal verion. mc-message-sigstatus-text should
 
51
;; be defined in the enclosing function.
 
52
(defun mc-message-sigstatus (id &optional attention)
 
53
  (setq mc-message-sigstatus-text id))
 
54
 
 
55
;; test cases are perl-generated elisp alists. The keys are:
 
56
;;  name: the name of this test case
 
57
;;  crypttext: a string with the multi-line encrypted message
 
58
;;
 
59
;;  encryption_id: a string with the user-id that mailcrypt ought to ask for
 
60
;;                 This must be the exact text.
 
61
;;  passphrase: the passphrase for that key, nil if harness should use 'bogus'
 
62
;;
 
63
;;  error: a string with the error mailcrypt is supposed to emit
 
64
;;  plaintext: the string it is supposed to decrypt to, or 'nil' for error
 
65
;;  signature_status: mailcrypt should emit this status message
 
66
 
 
67
(defun mc-test-load-testcase (file)
 
68
  (let (testcase)
 
69
    (setq testcase
 
70
          (with-temp-buffer
 
71
            (insert-file-contents file)
 
72
            (goto-char (point-min))
 
73
            (read (current-buffer))
 
74
            ))
 
75
    (if mc-test-verbose
 
76
        (message "testcase name is %s" (cdr (assoc 'name testcase))))
 
77
    testcase)
 
78
  )
 
79
 
 
80
 
 
81
(defun mc-test-error (fmt &rest args)
 
82
  (apply 'message fmt args))
 
83
 
 
84
(defun mc-test-decrypt-test (file)
 
85
  (let (
 
86
        (mc-activate-passwd-func 'mc-test-activate-passwd)
 
87
        (mc-activate-passwd-count 0)
 
88
        (mc-test-passwd-queries '())
 
89
        (mc-message-func 'mc-test-message)
 
90
        (mc-test-messages '())
 
91
        (mc-message-sigstatus-text nil)
 
92
        (testcase-file (expand-file-name file mc-test-testcasedir))
 
93
        b testcase mc-test-passwd-alist errortext sigstatus rc
 
94
        expected-error expected-plaintext expected-sigstatus)
 
95
 
 
96
    (setq b (get-buffer-create "mc crypttext"))
 
97
    (message "Testing %s ..." file)
 
98
    (if mc-test-verbose
 
99
        (message "testing with case %s" testcase-file))
 
100
    (setq testcase (mc-test-load-testcase testcase-file))
 
101
 
 
102
 
 
103
    (setq mc-test-passwd-alist 
 
104
          (list 
 
105
           (cons (cdr (assoc 'encryption_id testcase))
 
106
                 (cdr (assoc 'passphrase testcase))
 
107
                 )))
 
108
         
 
109
    (set-buffer b)
 
110
    (erase-buffer)
 
111
    (insert (cdr (assoc 'crypttext testcase))) ; insert crypttext
 
112
 
 
113
    ;; attempt decryption. If a passphrase is requested, it will use the one
 
114
    ;; from the testcase file.
 
115
 
 
116
    (condition-case err
 
117
        ;; protected form
 
118
        (setq rc
 
119
              (mc-gpg-decrypt-region (point-min-marker) (point-max-marker)))
 
120
      ;; error handler
 
121
      (error
 
122
       (setq errortext (error-message-string err))
 
123
       )
 
124
      )
 
125
 
 
126
    ; check assorted status stuff
 
127
    (if mc-test-verbose
 
128
        (message "errortext was '%s'" errortext))
 
129
    (if mc-test-verbose
 
130
        (message "rc was '%s'" rc))
 
131
    (if mc-message-sigstatus-text
 
132
        (setq sigstatus mc-message-sigstatus-text))
 
133
 
 
134
    ;; did we expect an error?
 
135
    (setq expected-error (cdr (assoc 'error testcase)))
 
136
    (if expected-error
 
137
        (if (not (equal errortext expected-error))
 
138
            (error "errortext did not match: expected '%s', got '%s'"
 
139
                   expected-error errortext)
 
140
          )
 
141
      (if errortext
 
142
          (error "got unexpected error '%s'" errortext))
 
143
      )
 
144
 
 
145
 
 
146
    ; was the decryption supposed to be successful?
 
147
    (setq expected-plaintext (cdr (assoc 'plaintext testcase)))
 
148
    (if expected-plaintext
 
149
        (if (not (equal expected-plaintext (buffer-string)))
 
150
            (error "plaintext did not match: expected '%s', got '%s'"
 
151
                   expected-plaintext (buffer-string))
 
152
          )
 
153
      )
 
154
 
 
155
    (setq expected-sigstatus (cdr (assoc 'signature_status testcase)))
 
156
    (if expected-sigstatus
 
157
        (if (not (equal expected-sigstatus sigstatus))
 
158
            (error "sigstatus did not match: expected '%s', got '%s'"
 
159
                   expected-sigstatus sigstatus)
 
160
          )
 
161
      (if sigstatus
 
162
          (error "unexpected signature status '%s'" sigstatus))
 
163
      )
 
164
 
 
165
    (message " test %s passed" file)
 
166
))
 
167
 
 
168
; error works liks this:
 
169
;(defun error (&rest args)
 
170
;    (signal 'error (list (apply 'format args)))))
 
171
 
 
172
(defun run-one-test ()
 
173
  ; it would be nice to take the test name from argv. see (command-line-args)
 
174
  (setq mc-test-verbose t)
 
175
  (mc-test-decrypt-test "SE")
 
176
)
 
177
 
 
178
(defun run-all-tests ()
 
179
  (let (cases)
 
180
        
 
181
    (setq cases (append cases '("E.e1r" "E.e2r" "E.e3" "E.e4")))
 
182
    (setq cases (append cases '("ES.e1r.s1v" "ES.e1r.s2v" "ES.e1r.s3v"
 
183
                                "ES.e1r.s4" "ES.e3.s1v" "ES.e4.s1v")
 
184
                       ))
 
185
    (setq cases (append cases '("S.s1v" "S.s2v" "S.s3v" "S.s4")))
 
186
    (setq cases (append cases '("CS.s1v" "CS.s2v" "CS.s3v" "CS.s4")))
 
187
    (setq cases (append cases '("SE")))
 
188
    (dolist (onecase cases)
 
189
      (mc-test-decrypt-test onecase))
 
190
))