#! /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
}

		\}"

		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]

		}
		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

	}

	::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 = {

		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 {

		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