hunter2

#! /usr/bin/env tclsh

# Copyright (c) 2016, Roy Keene
# All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#         1. Redistributions of source code must retain the above copyright
#            notice, this list of conditions and the following disclaimer.
# 
#         2. Redistributions in binary form must reproduce the above
#            copyright notice, this list of conditions and the following
#            disclaimer in the documentation and/or other materials
#            provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 
# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 
# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
# HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 
# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 
# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 
# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

set passwordFile [lindex $argv 0]
set action [lindex $argv 1]

set validCommands [list "listLocalKeys" "listPasswords" "listAvailablePasswords" "listUsers" "addUser" "addPassword" "authorizeUser" "authorizeUsers" "deauthorizeUser" "deauthorizeUsers" "getPassword" "updatePassword" "deletePassword" "help"]

proc _argDescription {command argName} {
	switch -- $argName {
		"passwordName" {
			return "$argName - Name of the password entry"
		}
		"key" {
			return "$argName - Public key of the user"
		}
		"password" {
			return "$argName - A plain-text password"
		}
		"userName" {
			return "$argName - A user name"
		}
		"action" {
			return "$argName - An action name for help with"
		}
		"args" {
			return "userList - A list of usernames"
		}
	}

	return "<UNKNOWN>"
}

proc _printHelp {channel command} {
	if {$command == ""} {
		puts $channel "Usage: hunter2 <passwordFile> <action> \[<actionArgs...>\]"
		puts $channel ""
		puts $channel "Actions:"
		puts $channel "    [join $::validCommands {, }]"
		puts $channel ""
		puts $channel "    hunter2 <file> help <action>    for help with an action"
	} else {
		set args [info args $command]
		set printArgs [list]
		foreach arg $args {
			if {$arg == "args"} {
				set arg "userList"
			}
			lappend printArgs "<$arg>"
		}

		puts $channel "Usage: hunter2 <passwordFile> $command [join $printArgs]"

		if {[llength $args] > 0} {
			puts $channel ""
			puts $channel "Arguments:"
			foreach arg $args {
				puts $channel "    [_argDescription $command $arg]"
			}
		}
	}
}

if {[llength $argv] < 2} {
	_printHelp stderr ""

	exit 1
}

set argv [lrange $argv 2 end]

package require sqlite3
package require platform

lappend ::auto_path [file join [file dirname [info script]] lib [platform::identify]]
lappend ::auto_path [file join [file dirname [info script]] lib [platform::generic]]
lappend ::auto_path [file join [file dirname [info script]] lib]

package require pki
package require pki::pkcs11
package require aes

# Backports for older versions of "pki"
proc ::pki::pkcs::parse_public_key {key {password ""}} {
        array set parsed_key [::pki::_parse_pem $key "-----BEGIN PUBLIC KEY-----" "-----END PUBLIC KEY-----" $password]

        set key_seq $parsed_key(data)

        ::asn::asnGetSequence key_seq pubkeyinfo
                ::asn::asnGetSequence pubkeyinfo pubkey_algoid
                        ::asn::asnGetObjectIdentifier pubkey_algoid oid
                ::asn::asnGetBitString pubkeyinfo pubkey
        set ret(pubkey_algo) [::pki::_oid_number_to_name $oid]

        switch -- $ret(pubkey_algo) {
                "rsaEncryption" {
                        set pubkey [binary format B* $pubkey]

                        ::asn::asnGetSequence pubkey pubkey_parts
                                ::asn::asnGetBigInteger pubkey_parts ret(n)
                                ::asn::asnGetBigInteger pubkey_parts ret(e)

                        set ret(n) [::math::bignum::tostr $ret(n)]
                        set ret(e) [::math::bignum::tostr $ret(e)]
                        set ret(l) [expr {int([::pki::_bits $ret(n)] / 8.0000 + 0.5) * 8}]
                        set ret(type) rsa
                }
                default {
                        error "Unknown algorithm"
                }
        }

        return [array get ret]
}

proc ::pki::rsa::serialize_public_key {keylist} {
        array set key $keylist

        foreach entry [list n e] {
                if {![info exists key($entry)]} {
                        return -code error "Key does not contain an element $entry"
                }
        }

        set pubkey [::asn::asnSequence \
                [::asn::asnBigInteger [::math::bignum::fromstr $key(n)]] \
                [::asn::asnBigInteger [::math::bignum::fromstr $key(e)]] \
                ]  
        set pubkey_algo_params [::asn::asnNull]

        binary scan $pubkey B* pubkey_bitstring

        set ret [::asn::asnSequence \
                [::asn::asnSequence \
                                [::asn::asnObjectIdentifier [::pki::_oid_name_to_number rsaEncryption]] \
                                $pubkey_algo_params \
                        ] \
                        [::asn::asnBitString $pubkey_bitstring] \
                        ]

        return [list data $ret begin "-----BEGIN PUBLIC KEY-----" end "-----END PUBLIC KEY-----"]
}
# End backports

# Start internal functions
proc _listCertificates {} {
	if {![info exists ::env(PKCS11MODULE)]} {
		return [list]
	}

	set ::env(CACKEY_NO_EXTRA_CERTS) 1

	set handle [::pki::pkcs11::loadmodule $::env(PKCS11MODULE)]

	set slotInfo [list]
	foreach slot [::pki::pkcs11::listslots $handle] {
		set slotID [lindex $slot 0]
		set slotLabel [lindex $slot 1]
		set slotFlags [lindex $slot 2]

		if {"TOKEN_PRESENT" ni $slotFlags} {
			continue
		}

		if {"TOKEN_INITIALIZED" ni $slotFlags} {
			continue
		}

		set slotPromptForPIN false
		if {"PROTECTED_AUTHENTICATION_PATH" ni $slotFlags} {
			if {"LOGIN_REQUIRED" in $slotFlags} {
				set slotPromptForPIN true
			}
		}

		foreach cert [::pki::pkcs11::listcerts $handle $slotID] {
			set pubkey [binary encode base64 [dict get [::pki::rsa::serialize_public_key $cert] data]]

			lappend slotInfo [list handle $handle id $slotID prompt $slotPromptForPIN cert $cert pubkey $pubkey]
		}
	}

	return $slotInfo
}

proc _addPassword {name password publicKeys} {
	set fd [open "/dev/urandom" r]
	fconfigure $fd -translation binary

	db eval {DELETE FROM passwords WHERE name = $name;}

	foreach publicKey $publicKeys {
		set key [read $fd 16]
		if {[string length $key] != 16} {
			close $fd

			return -code error "ERROR: Short read from random device"
		}

		set publicKeyItem [::pki::pkcs::parse_public_key [binary decode base64 $publicKey]]

		set encryptedKey [binary encode base64 [::pki::encrypt -pub -binary -- $key $publicKeyItem]]

		set encryptedPass [binary encode base64 [::aes::aes -dir encrypt -key $key -- $password]]

		db eval {INSERT INTO passwords (name, encryptedPass, encryptedKey, publicKey) VALUES ($name, @encryptedPass, @encryptedKey, @publicKey);}
	}

	close $fd
}

proc _prompt {prompt} {
	puts -nonewline $prompt
	flush stdout

	puts -nonewline [exec stty -echo]
	flush stdout

	set password [gets stdin]

	puts -nonewline [exec stty echo]
	puts ""
	flush stdout

	return $password
}

proc _getPassword {name} {
	set exists [db eval {SELECT 1 FROM passwords WHERE name = $name LIMIT 1;}]
	if {$exists != "1"} {
		return -code error "Password \"$name\" does not exists."
	}

	foreach slotInfoDict [_listCertificates] {
		unset -nocomplain slotInfo
		array set slotInfo $slotInfoDict

		set pubkey $slotInfo(pubkey)
		set prompt $slotInfo(prompt)

		if {[info exists prompted($slotInfo(id))]} {
			set prompt false
		}

		if {$prompt} {
			set PIN [_prompt "Please enter the PIN for [dict get $slotInfo(cert) subject]: "]

			if {![::pki::pkcs11::login $slotInfo(handle) $slotInfo(id) $PIN]} {
				return -code error "Unable to authenticate"
			}

			set prompted($slotInfo(id)) 1
		}

		db eval {SELECT encryptedPass, encryptedKey FROM passwords WHERE name = $name AND publicKey = $pubkey;} row {
			set key [::pki::decrypt -binary -priv -- [binary decode base64 $row(encryptedKey)] $slotInfo(cert)]
			set password [::aes::aes -dir decrypt -key $key -- [binary decode base64 $row(encryptedPass)]]

			return $password
		}
	}

	return -code error "No valid keys"
}

proc _modifyPublicKeys {passwordName userNames sql} {
	set exists [db eval {SELECT 1 FROM passwords WHERE name = $passwordName LIMIT 1;}]
	if {$exists != "1"} {
		return -code error "Password \"$passwordName\" does not exists."
	}

	set publicKeys [list]

	db eval {SELECT publicKey FROM passwords WHERE name = $passwordName;} row {
		lappend publicKeys $row(publicKey)
	}

	set changeRequired 0
	foreach user $userNames {
		unset -nocomplain row
		db eval {SELECT publicKey FROM users WHERE name = $user;} row $sql
	}

	if {!$changeRequired} {
		return
	}

	set password [_getPassword $passwordName]

	_addPassword $passwordName $password $publicKeys
}

proc _getUsersForPassword {passwordNames} {
	set userNames [list]

	foreach passwordName $passwordNames {
		db eval {SELECT publicKey FROM passwords WHERE name = $passwordName;} passwordRow {
			db eval {SELECT name FROM users WHERE publicKey = $passwordRow(publicKey)} userRow {
				if {$userRow(name) in $userNames} {
					continue
				}

				lappend userNames $userRow(name)
			}
		}
	}

	return $userNames
}

proc _getPasswordsForUser {userNames} {
	set passwordNames [list]

	foreach userName $userNames {
		db eval {SELECT publicKey FROM users WHERE name = $userName;} userRow {
			db eval {SELECT name FROM passwords WHERE publicKey = $userRow(publicKey)} passwordRow {
				if {$passwordRow(name) in $passwordNames} {
					continue
				}

				lappend passwordNames $passwordRow(name)
			}
		}
	}

	return $passwordNames
}
# End internal functions

# Start user CLI functions
proc listLocalKeys {} {
	foreach slotInfoDict [_listCertificates] {
		unset -nocomplain slotInfo
		array set slotInfo $slotInfoDict

		set subject [dict get $slotInfo(cert) subject]
		set pubkey  $slotInfo(pubkey)

		lappend publicKeys($subject) $pubkey
	}

	foreach {subject pubkeys} [array get publicKeys] {
		puts "$subject"

		foreach pubkey $pubkeys {
			puts "  |-> $pubkey"
		}
	}
}

proc listAvailablePasswords {} {
	set passwordNames [list]
	foreach slotInfoDict [_listCertificates] {
		unset -nocomplain slotInfo
		array set slotInfo $slotInfoDict

		set pubkey $slotInfo(pubkey)

		unset -nocomplain row
		db eval {SELECT name FROM passwords WHERE publicKey = $pubkey;} row {
			if {$row(name) in $passwordNames} {
				continue
			}

			lappend passwordNames $row(name)
		}
	}


	foreach passwordName $passwordNames {
		puts "$passwordName - [join [_getUsersForPassword [list $passwordName]] {, }]"
	}
}

proc listPasswords {} {
	db eval {SELECT DISTINCT name FROM passwords;} row {
		puts "$row(name) - [join [_getUsersForPassword [list $row(name)]] {, }]"
	}
}

proc listUsers {} {
	db eval {SELECT DISTINCT name FROM users;} row {
		puts "$row(name) - [join [_getPasswordsForUser [list $row(name)]] {, }]"
	}
}

proc addUser {userName key} {
	set keyRaw [binary decode base64 $key]
	set keyVerify [::pki::pkcs::parse_public_key $keyRaw]

	db eval {INSERT INTO users (name, publicKey) VALUES ($userName, @key);}

	# XXX:TODO:Go through and re-authorize if possible
}

proc deleteUser {userName} {
	# XXX:TODO: Go through and de-authorize
}

proc addPassword {passwordName password args} {
	set initialUsers $args

	if {$password eq ""} {
		set password [_prompt "Please enter the new password: "]
	}

	# Verify that this password does not already exist
	set exists [db eval {SELECT 1 FROM passwords WHERE name = $passwordName LIMIT 1;}]
	if {$exists == "1"} {
		return -code error "Password \"$passwordName\" already exists, cannot add."
	}

	# Get keys for initial users
	set publicKeys [list]
	foreach user $initialUsers {
		unset -nocomplain row
		db eval {SELECT publicKey FROM users WHERE name = $user;} row {
			lappend publicKeys $row(publicKey)
		}
	}

	_addPassword $passwordName $password $publicKeys
}

proc getPassword {passwordName} {
	puts [_getPassword $passwordName]
}

proc updatePassword {passwordName password} {
	if {$password eq ""} {
		set password [_prompt "Please enter the new password: "]
	}

	db eval {SELECT publicKey FROM passwords WHERE name = $passwordName;} row {
		lappend publicKeys $row(publicKey)
	}

	_addPassword $passwordName $password $publicKeys
}

proc deletePassword {passwordName} {
	db eval {DELETE FROM passwords WHERE name = $passwordName;}
}

proc authorizeUsers {passwordName args} {
	set users $args

	_modifyPublicKeys $passwordName $users {
		if {$row(publicKey) in $publicKeys} {
			continue
		}

		lappend publicKeys $row(publicKey)

		set changeRequired 1
	}
}

proc authorizeUser {passwordName userName} {
	return [authorizeUsers $passwordName $userName]
}

proc deauthorizeUsers {passwordName args} {
	set users $args

	_modifyPublicKeys $passwordName $users {
		set idx [lsearch -exact $publicKeys $row(publicKey)]
		if {$idx == -1} {
			continue
		}

		set publicKeys [lreplace $publicKeys $idx $idx]

		set changeRequired 1
	}
}

proc deauthorizeUser {passwordName userName} {
	return [deauthorizeUsers $passwordName $userName]
}

proc help {{action ""}} {
	_printHelp stdout $action
}
# End user CLI functions

### MAIN

sqlite3 db $passwordFile

db eval {
	CREATE TABLE IF NOT EXISTS users(name, publicKey BLOB);
	CREATE TABLE IF NOT EXISTS passwords(name, encryptedPass BLOB, encryptedKey BLOB, publicKey BLOB);
}

if {$action in $validCommands} {
	if {[catch {
		$action {*}$argv
	} error]} {
		puts stderr "Error: $error"

		exit 1
	}
} else {
	puts stderr "Invalid action"

	exit 1
}

exit 0