Check-in [a1b40a439c]
Overview
Comment:Add SHA-512 support (hacked) and a bit of cleanup
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a1b40a439c8fc9effc2cd08a622d0a9145316d91
User & Date: rkeene on 2022-03-13 20:23:23
Other Links: manifest | tags
Context
2022-03-13
20:46
Make Tcl SSH Agent more standalone Leaf check-in: 2d57dd9864 user: rkeene tags: trunk
20:23
Add SHA-512 support (hacked) and a bit of cleanup check-in: a1b40a439c user: rkeene tags: trunk
20:15
Better error logging in Tcl/JS emulation check-in: f69d4ccb30 user: rkeene tags: trunk
Changes

Modified build/tcl/ssh-agent.tcl from [183583332c] to [bf92e80fb2].

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
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

+
+




+
+
+
+




-
+




















+
+
+
+
+
+
+
+
+







#! /usr/bin/env tclsh

set dir [file dirname [info script]]

if {[info exists ::env(SSH_AGENT_LIB_PATH)]} {
	lappend auto_path {*}$::env(SSH_AGENT_LIB_PATH)
}

if {![info exists ::env(SSH_AUTH_SOCK)]} {
	error "Must set SSH_AUTH_SOCK"
}

if {[info exists ::env(SSH_AGENT_PKCS11_MODULE)]} {
	set ::pkcs11ModuleFilename $::env(SSH_AGENT_PKCS11_MODULE)
} else {
	set ::pkcs11ModuleFilename /home/rkeene/tmp/cackey/build/tcl/softokn3-pkcs11.so
	error "Must set SSH_AGENT_PKCS11_MODULE"
}

package require duktape 0.7
package require tuapi
package require pki 0.6
package require pki::pkcs11 0.9.9

## HACK: Fix up older versions of "pki" to include the raw certificate
##       this is needed
apply {{} {
	set procToUpdate ::pki::x509::parse_cert
	if {![string match "*set ret(raw)*" [info body $procToUpdate]]} {
		set body [info body $procToUpdate]
		set body [string map {
			"::asn::asnGetSequence cert_seq wholething"
			"set ret(raw) $cert_seq; binary scan $ret(raw) H* ret(raw); ::asn::asnGetSequence cert_seq wholething"
		} $body]
		proc $procToUpdate [info args $procToUpdate] $body
	}
}}

proc pkcs11ModuleLogin {slot} {
	set pin [exec cackey-askpass]
	if {$pin eq ""} {
		error "No PIN provided"
	}

	::pki::pkcs11::login $::pkcs11ModuleHandle $slot $pin
}

proc pkcs11ModuleHandle {} {
	if {![info exists ::pkcs11ModuleHandle]} {
		set ::pkcs11ModuleHandle [::pki::pkcs11::loadmodule $::pkcs11ModuleFilename]
	}
	return $::pkcs11ModuleHandle
}
80
81
82
83
84
85
86






87
88
89
90
91
92
93
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114







+
+
+
+
+
+







		\}"

		return $retval
	}

	::duktape::tcl-function $jsHandle __crypto_subtle_digest bytearray {hash data} {
		switch -exact -- $hash {
			"SHA-512" {
				set data_b64 [binary encode base64 $data]
				set checksum [exec base64 -d << $data_b64 | sha512sum]
				set checksum [lindex [split $checksum] 0]
				return [binary decode hex $checksum]
			}
			"SHA-256" {
				package require sha256
				return [::sha2::sha256 -- $data]
			}
			"SHA-1" {
				package require sha1
				return [::sha1::sha1 -- $data]
131
132
133
134
135
136
137

138
139
140
141
142
143
144
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166







+







		}
		X509.parseCert = __parseCert;
		delete __parseCert;
	}
}

proc readFile {fileName} {
	set fileName [file join $::dir $fileName]
	if {![info exists ::readFile($fileName)]} {
		catch {
			set fd [open $fileName]
			set ::readFile($fileName) [read $fd]
		}
		catch {
			close $fd
172
173
174
175
176
177
178
179

180
181
182
183
184
185
186
194
195
196
197
198
199
200

201
202
203
204
205
206
207
208







-
+







	}

	::duktape::eval $jsHandle {var goog = {DEBUG: false};}
	::duktape::eval $jsHandle [readFile chrome-emu.js]
	addRSAToJS $jsHandle
	::duktape::eval $jsHandle [readFile ssh-agent-noasync.js]
	::duktape::eval $jsHandle {cackeySSHAgentFeatures.enabled = true;}
	::duktape::eval $jsHandle {cackeySSHAgentFeatures.includeCerts = false;}
	::duktape::eval $jsHandle {cackeySSHAgentFeatures.includeCerts = true;}
	::duktape::eval $jsHandle {cackeySSHAgentFeatures.legacy = false;}
	::duktape::eval $jsHandle {
		function connection(callback) {
			this.sender = {
				id: "pnhechapfaindjhompbnflcldabbghjo"
			};
			this.onMessage = {
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
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
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386

387
388
389
390
391
392
393
394
395
396
397
398







+
-
+
+
+
+
+
+




-
+

-
+
+













+
+
+
+
+













-
+
+
+
+
+







		set certInfo [listCerts $handle $cert]
		if {![dict exists $certInfo pkcs11_slotid]} {
			pkcs11ModuleUnload $handle
			return -code error "Unable to find certificate to sign with"
		}

		set slotId [dict get $certInfo pkcs11_slotid]
		try {
		set data [::pki::sign $message $certInfo raw]
			set data [::pki::sign $message $certInfo raw]
		} on error {} {
			pkcs11ModuleLogin $slotId

			set data [::pki::sign $message $certInfo raw]
		}

		return $data
	}

	::duktape::tcl-function $jsHandle cackeyListCertificatesBare {arraylist bytearray} {} {
	::duktape::tcl-function $jsHandle cackeyListCertificatesBare {array bytearray} {} {
		set handle [pkcs11ModuleHandle]
		return [listCerts $handle]
		set retval [listCerts $handle]
		return $retval
	}

	return $jsHandle
}

proc listCerts {handle {match ""}} {
	set certs [list]

	set slots [::pki::pkcs11::listslots $handle]
	foreach slotInfo $slots {
		set slotId [lindex $slotInfo 0]
		set slotLabel [lindex $slotInfo 1]
		set slotFlags [lindex $slotInfo 2]

		# Skip missing tokens
		if {"TOKEN_PRESENT" ni $slotFlags} {
			continue
		}

		set slotCerts [::pki::pkcs11::listcerts $handle $slotId]
		foreach keyList $slotCerts {
			set cert [dict get $keyList raw]
			set cert [binary decode hex $cert]
			if {$match eq $cert} {
				return $keyList
			}
			lappend certs $cert
		}
	}

	if {$match ne ""} {
		return [list]
		set certs [list]
	}

	if {[llength $certs] == 0} {
		pkcs11ModuleUnload $handle
	}

	return $certs
}

proc handleData {sock jsHandle} {
	if {[catch {
380
381
382
383
384
385
386
387

388
389
418
419
420
421
422
423
424

425
426
427







-
+


		fileevent $sock readable [list handleData $sock $jsHandle]
	}]} {
		puts stderr "ERROR: $::errorInfo"
		close $sock
	}
}

::tuapi::syscall::socket_unix -server incomingConnection "./agent"
::tuapi::syscall::socket_unix -server incomingConnection $::env(SSH_AUTH_SOCK)

vwait forever