File: test_pgp.tcl

package info (click to toggle)
tkrat 1%3A2.2cvs20100105-true-dfsg-6.1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 10,340 kB
  • ctags: 9,259
  • sloc: ansic: 96,057; tcl: 25,667; makefile: 1,638; sh: 282
file content (361 lines) | stat: -rw-r--r-- 9,024 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
puts "$HEAD Test pgp"

namespace eval test_pgp {
    variable tmpfn [pwd]/folder.[pid]-tmp
    variable tmpdef [list Test file {} $tmpfn]

    set fh [open $tmpfn w]
    puts $fh $hdr
    close $fh

    variable error_msg
}

proc test_pgp::send_msg {role msg} {
    global vFolderDef vFolderOutgoing folderExists tickle option
    variable error_msg

    proc RatSendFailed {msg errmsg} {
	global test_pgp::error_msg
	
	set test_pgp::error_msg $errmsg
    }

    smtp_server::start
    set error_msg NONE
    set option(cache_conn) 0
    set option($role,from) maf@test.domain
    set option($role,sendprot) smtp
    set option($role,smtp_hosts) "localhost:[smtp_server::get_port]"
    set option($role,smtp_user) ""
    set option($role,smtp_passwd) ""
    set fh [RatOpenFolder $vFolderDef($vFolderOutgoing)]
    $fh insert $msg
    RatNudgeSender

    # Wait for send to complete
    for {set i 0} {$i < 600} {incr i} {
	# Force event loop
	after 100 "set tickle 1"
	vwait tickle
	if {0 == $folderExists($fh)} {
	    break
	}
    }
    if {"NONE" != $error_msg} {
	puts "Err: $error_msg"
    }
    set sent [lindex [smtp_server::get_received] 1]
    smtp_server::stop
    return $sent
}

proc test_pgp::test_signing {} {
    global option hdr smsgs
    variable tmpfn
    variable tmpdef

    set role $option(default_role)

    # Loop over test messages.
    #foreach mt [list [lindex $smsgs 1]]     
    foreach mt $smsgs  {
	StartTest "Signing [lindex $mt 0]"
	# Create message
	set msg [RatCreateMessage $role [lindex $mt 1]]

	# Sign it
	if {[catch {$msg pgp true false $role test_key@tkrat.org {}} err]} {
	    ReportError "Failed to sign: $err"
	    continue
	}

	# Send it
	set sent_list [send_msg $role $msg]
	set sent_msg [join $sent_list "\n"]

	# Check signature with gpg
	set boundary [string range [lindex $sent_list end] 2 end-2]
	set mfile "msg.[pid]"
	set sfile "sig.[pid]"
	for {set i 0} {"[lindex $sent_list $i]" != "--$boundary"} {incr i} {
	}
	set fd [open $mfile w]
	fconfigure $fd -translation crlf
	set first 1
	for {incr i} {"[lindex $sent_list $i]" != "--$boundary"} {incr i} {
	    if {$first} {
		set first 0
	    } else {
		puts -nonewline $fd "\n"
	    }
	    puts -nonewline $fd [lindex $sent_list $i]
	}
	close $fd
	set fd [open $sfile w]
	for {incr i} {"[lindex $sent_list $i]" != "--$boundary--"} {incr i} {
	    puts $fd [lindex $sent_list $i]
	}
	close $fd
	if {[catch "exec gpg $option(pgp_args) --verify $sfile $mfile 2>errout" err]} {
	    set fh [open errout r]
	    while {-1 != [gets $fh line]} {
		puts $line
	    }
	    close $fh
	    puts "File: [pwd]/$mfile"
	    puts "Sig:  [pwd]/$sfile"
	    ReportError "External signature verification failed"
	    continue
	}

	# Check signature with tkrat (ok expected)
	set fh [open $tmpfn w]
	puts $fh $hdr
	puts $fh "From maf@tkrat.org Tue Sep  5 18:02:22 2000 +0100"
	puts $fh $sent_msg
	close $fh
	set fh [RatOpenFolder $tmpdef]
	set msg [$fh get 0]
	set body [$msg body]
	$body checksig
	if {"pgp_good" != [$body sigstatus]} {
	    ReportError "Signature check in TkRat failed [$body sigstatus]"
	    continue
	}
	$fh close 1

	# Check signature with tkrat (failure expected)
	set fh [open $tmpfn w]
	puts $fh $hdr
	puts $fh "From maf@tkrat.org Tue Sep  5 18:02:22 2000 +0100"
	# Add a trailing blank to each bodypart
	regsub -all -- "--$boundary" $sent_msg "\n--$boundary" broken
	puts $fh $broken
	close $fh
	set fh [RatOpenFolder $tmpdef]
	set msg [$fh get 0]
	set body [$msg body]
	$body checksig
	if {"pgp_bad" != [$body sigstatus]} {
	    ReportError "Signature check of bad message in TkRat failed [$body sigstatus]"
	    continue
	}
	$fh close 1
    }
}

proc test_pgp::test_encrypting {} {
    global option hdr smsgs
    variable tmpfn
    variable tmpdef

    set role $option(default_role)

    # Loop over test messages.
    foreach mt $smsgs  {
	StartTest "Encrypting [lindex $mt 0]"
	# Create message
	set msg [RatCreateMessage $role [lindex $mt 1]]

	# Encrypt & sign it
	if {[catch {$msg pgp true true $role test_key@tkrat.org test_key@tkrat.org} err]} {
	    ReportError "Failed to encrypt: $err"
	    continue
	}

	# Send it
	set sent_list [send_msg $role $msg]
	set sent_msg [join $sent_list "\n"]

	# Check encryption & signature with gpg
	set mfile "msg.[pid]"
	set fd [open $mfile w]
	fconfigure $fd -translation crlf
	regexp -- {-----BEGIN PGP MESSAGE.*END PGP MESSAGE-----} $sent_msg enc
	puts $fd $enc
	close $fd
	set ea "--status-fd 2 --decrypt $mfile 2>status.[pid]"
	if {[catch "exec gpg $option(pgp_args) $ea" output]} {
	    set err 1
	} else {
	    set err 0
	}
	catch {unset gpgout}
	set status ""
	set fh [open "status.[pid]" r]
	while {-1 != [gets $fh line]} {
	    set status "$status$line\n"
	    if {{[GNUPG:]} == "[lindex $line 0]"} {
		set gpgout([lindex $line 1]) [lrange $line 2 end]
	    }
	}
	if {1 == $err || ![info exists gpgout(GOODSIG)] \
		|| ![info exists gpgout(DECRYPTION_OKAY)]} {
	    ReportError "External verification failed\n$status"
	    continue
	}
	set expected_list {}
	set expected_body_list {}
	set in_header 1
	set in_content 0
	foreach l [lindex $mt 2] {
	    if {$in_header} {
		if {[regexp "^Content-" $l]} {
		    lappend expected_list $l
		    set in_content 1
		} elseif {$in_content && (" " == [string index $l 0]
					 || "\t" == [string index $l 0])} {
		    lappend expected_list $l
		} elseif {"" == $l} {
		    lappend expected_list $l
		    set in_header 0
		    set in_content 0
		} else {
		    set in_content 0
		}
	    } else {
		lappend expected_list $l
		lappend expected_body_list $l
	    }
	}
	set expected [join [lrange $expected_list 0 end-1] "\n"]
	if {"$output" != "$expected"} {
	    puts "******** Expected"
	    puts $expected
	    puts "******** Output"
	    puts $output
	    ReportError "Externally decrypted text does not match expected text"
	    continue
	}

	# Check decryption with tkrat
	set fh [open $tmpfn w]
	puts $fh $hdr
	puts $fh "From maf@tkrat.org Tue Sep  5 18:02:22 2000 +0100"
	puts $fh $sent_msg
	close $fh
	set fh [RatOpenFolder $tmpdef]
	set msg [$fh get 0]
	set body [$msg body]
	$body checksig
	if {"pgp_good" != [$body sigstatus]} {
	    ReportError "Decryption check in TkRat failed signature part"
	    continue
	}
	set expected_body [join [lrange $expected_body_list 0 end-1] "\n"]
	if {"[$body data true]" != "$expected_body"} {
	    ReportError "Internally decrypted text does not match expected text"
	    puts "******** Expected"
	    puts $expected_body_list
	    puts "******** Output"
	    puts [$body data true]
	    continue
	}
	$fh close 1
    }
}

proc test_pgp::compare_key {e o} {
    foreach i {0 2 4 5} {
	if {[lindex $e $i] != [lindex $o $i]} {
	    return "fail"
	}
    }
    foreach i {1 3} {
	set ei [lindex $e $i]
	set oi [lindex $o $i]
	if {[llength $ei] != [llength $oi]} {
	    return "fail"
	}
	for {set j 0} {$j < [llength $ei]} {incr j} {
	    if {[lindex $ei $j] != [lindex $oi $j]} {
		return "fail"
	    }
	}
    }
    return "ok"
}

proc test_pgp::compare_keylist {expected output} {
    if {[lindex $expected 0] != [lindex $output 0]} {
	return "fail"
    }
    set e [lindex $expected 1]
    set o [lindex $output 1]
    if {[llength $e] != [llength $o]} {
	return "fail"
    }
    for {set i 0} {$i < [llength $e]} {incr i} {
	if {"fail" == [compare_key [lindex $e $i] [lindex $o $i]]} {
	    return "fail"
	}
    }
    return "ok"
}

proc test_pgp::test_keylist {} {
    StartTest "Listing keys"

    set publist {
	{Public keyring}
	{
	    {ED6087318702C78A test_key@tkrat.org 
		{pub 1024 DSA (sign only)}
		{{TkRat Test Key (Do not trust this key!!!) <test_key@tkrat.org>}}
		1 0
	    }
	    {36D3FDF09AC2D77E test_key@tkrat.org
		{sub 768 ElGamal (encrypt only)}
		{{TkRat Test Key (Do not trust this key!!!) <test_key@tkrat.org>}}
		0 1}}
    }
    set result [RatPGP listkeys PubRing]
    if {"fail" == [compare_keylist $publist $result]} {
	puts "******** Expected"
	puts $publist
	puts "******** Output"
	puts $result
	ReportError "Public keylist differes from expected"
    }

    set seclist {
	{Secret keyring}
	{
	    {ED6087318702C78A test_key@tkrat.org
		{sec 1024 DSA (sign only)}
		{{TkRat Test Key (Do not trust this key!!!) <test_key@tkrat.org>}}
		1 0}
	    {36D3FDF09AC2D77E test_key@tkrat.org
		{ssb 768 ElGamal (encrypt only)}
		{{TkRat Test Key (Do not trust this key!!!) <test_key@tkrat.org>}}
		0 1}
	}
    }
    set result [RatPGP listkeys SecRing]
    if {"fail" == [compare_keylist $seclist $result]} {
	puts "******** Expected"
	puts $seclist
	puts "******** Output"
	puts $result
	ReportError "Secret keylist differes from expected"
    }

}

proc test_pgp::test_pgp {} {
    global option tmp

    RatLibSetOnlineMode 1
    set option(pgp_version) gpg-1
    set option(pgp_args) "--no-default-keyring --keyring [pwd]/../pgp_pub --secret-keyring [pwd]/../pgp_sec --always-trust --no-options --homedir $tmp"
    #test_signing
    #test_encrypting
    test_keylist
}

proc RatGetPGPPassPhrase {} {
    return [list "ok" ""]
}

test_pgp::test_pgp