Artifact [20435b785d]
Not logged in

Artifact 20435b785df7fa15ecf0852710d4b0c7e3247097:


\ key handling

require mkdir.fs

: accept* ( addr u -- u' )
    \ accept-like input, but types * instead of the character
    dup >r
    BEGIN  xkey dup #cr <> WHILE
	    dup #bs = over #del = or IF
		drop dup r@ u< IF
		    over + >r xchar- r> over -
		    1 backspaces space 1 backspaces
		ELSE
		    bell
		THEN
	    ELSE
		-rot xc!+? 0= IF  bell  ELSE  '*' emit  THEN
	    THEN
    REPEAT  drop  nip r> swap - ;

: ?.net2o ( -- )
    s" ~/.net2o" r/o open-file nip IF
	s" ~/.net2o" $1C0 mkdir-parents throw
    THEN ;

: key-in ( dest addr u -- )
    r/o open-file throw { fd }
    keysize fd read-file throw keysize <> !!nokey!!
    fd close-file throw ;

: key-out ( source addr u -- )
    r/w create-file throw { fd }
    keysize fd write-file throw
    fd close-file throw ;

: keys-in ( pkc skc addr u -- )
    r/o open-file throw { fd } swap
    keysize fd read-file throw keysize <> !!nokey!!
    keysize fd read-file throw keysize <> !!nokey!!
    fd close-file throw ;

: keys-out ( pkc skc addr u -- )
    r/w create-file throw { fd } swap
    keysize fd write-file throw
    keysize fd write-file throw
    fd close-file throw ;

keysize buffer: testkey
keysize buffer: testskc
keysize buffer: passskc

: check-key? ( addr -- flag )  >r
    testkey r@ base9 crypto_scalarmult
    testkey keysize pkc over str= IF  r@ skc keysize move  true
    ELSE  false  THEN  rdrop ;

3 Value passphrase-retry#
$100 Value passphrase-diffuse#

: get-passphrase ( addrin -- addrout )
    passskc keysize move   wurst-source !key
    message state# 8 * 2dup accept* dup >r safe/string erase
    r> IF
	source-init wurst-key hash-init
	message roundsh# rounds
	passphrase-diffuse# 0 ?DO  start-diffuse  LOOP \ just to waste time ;-)
	wurst-state passskc keysize xors
	wurst-state keysize + passskc keysize xors
    THEN  passskc ;

Variable keyfile

: >key-name ( addr u -- )
    s" ~/.net2o/" keyfile $! 
    keyfile $+! s" .ecc" keyfile $+! ;

: key-name ( -- )  keyfile @ ?EXIT
    ." ID name: " pad 100 accept pad swap >key-name ;

: read-keys ( -- )  ?.net2o key-name
    pkc testskc keyfile $@ keys-in
    testskc check-key? ?EXIT
    passphrase-retry# 0 ?DO
	cr ." Passphrase: "
	testskc get-passphrase check-key? IF  unloop  EXIT  THEN
    LOOP  !!nokey!! ;

: new-passphrase ( -- )
    passphrase-retry# 0 ?DO
	cr ." Enter Passphrase: "       skc get-passphrase
	testskc keysize move
	cr ." Reenter Passphrase: "     skc get-passphrase
	testskc keysize tuck str= IF  unloop  EXIT  THEN
    LOOP  !!nokey!! ;

: write-keys ( -- )  ?.net2o key-name
    new-passphrase
    pkc testskc keyfile $@ keys-out ;

: ?keypair ( -- )
    ['] read-keys catch IF  nothrow gen-keys write-keys  THEN ;