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
#! /usr/bin/env tclsh



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





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
}

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 pkcs11ModuleHandle {} {
	if {![info exists ::pkcs11ModuleHandle]} {
		set ::pkcs11ModuleHandle [::pki::pkcs11::loadmodule $::pkcs11ModuleFilename]
	}
	return $::pkcs11ModuleHandle
}

>
>




>
>
>
>




|




















>
>
>
>
>
>
>
>
>







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 {
	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
		\}"

		return $retval
	}

	::duktape::tcl-function $jsHandle __crypto_subtle_digest bytearray {hash data} {
		switch -exact -- $hash {






			"SHA-256" {
				package require sha256
				return [::sha2::sha256 -- $data]
			}
			"SHA-1" {
				package require sha1
				return [::sha1::sha1 -- $data]







>
>
>
>
>
>







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
		}
		X509.parseCert = __parseCert;
		delete __parseCert;
	}
}

proc readFile {fileName} {

	if {![info exists ::readFile($fileName)]} {
		catch {
			set fd [open $fileName]
			set ::readFile($fileName) [read $fd]
		}
		catch {
			close $fd







>







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
	}

	::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.legacy = false;}
	::duktape::eval $jsHandle {
		function connection(callback) {
			this.sender = {
				id: "pnhechapfaindjhompbnflcldabbghjo"
			};
			this.onMessage = {







|







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

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






		return $data
	}

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

	}

	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]






		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]




	}

	return $certs
}

proc handleData {sock jsHandle} {
	if {[catch {







>
|
>
>
>
>
>




|

|
>













>
>
>
>
>













|
>
>
>
>







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]
		} on error {} {
			pkcs11ModuleLogin $slotId

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

		return $data
	}

	::duktape::tcl-function $jsHandle cackeyListCertificatesBare {array bytearray} {} {
		set handle [pkcs11ModuleHandle]
		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 ""} {
		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
		fileevent $sock readable [list handleData $sock $jsHandle]
	}]} {
		puts stderr "ERROR: $::errorInfo"
		close $sock
	}
}

::tuapi::syscall::socket_unix -server incomingConnection "./agent"

vwait forever







|


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 $::env(SSH_AUTH_SOCK)

vwait forever