Artifact b7c3372db90ecd46cfd296831a8fd6d2d2f6dac5:

• File net2o-keys.fs — part of check-in [ee03a4c103] at 2013-09-09 22:21:27 on branch trunk — Use new way to store keys (user: bernd size: 5762)

\ net2o key storage

require mkdir.fs

Vocabulary new-keys

also new-keys definitions

\ accept for password entry

: 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  '⬤' xemit  THEN
	    THEN
    REPEAT  drop  nip r> swap - ;

\ hashed key data base

object class
    field: ke-sk
    field: ke-pk
    field: ke-nick
    field: ke-prof
    field: ke-sigs
    field: ke-type
    64field: ke-first
    64field: ke-last
end-class key-entry

0 Constant key#anon
1 Constant key#user
2 Constant key#group

key-entry @ buffer: sample-key

Variable key-table
Variable this-key
Variable this-keyid
2Variable addsig
sample-key this-key ! \ dummy

: current-key ( addr u -- )
    2dup key-table #@ drop dup this-key ! >o rdrop ke-pk $! ;
: make-thiskey ( addr -- )
    dup $@ drop this-keyid !  cell+ $@ drop dup this-key ! >o rdrop ;

: key:new ( addr u -- )
    \ addr u is the public key
    sample-key key-entry @ 2dup erase
    2over key-table #! current-key ;

\ search for keys - not optimized

: nick-key ( addr u -- ) \ search for key nickname and make current
    key-table 
    [: dup >r cell+ $@ drop >o ke-nick $@ o> 2over str= IF
	r@ make-thiskey
    THEN  rdrop ;] #map 2drop ;

\ get passphrase

3 Value passphrase-retry#
$100 Value passphrase-diffuse#
$100 Constant max-passphrase# \ 256 characters should be enough...
max-passphrase# buffer: passphrase

: passphrase-in ( -- addr u )
    passphrase dup max-passphrase# accept* ;

: >passphrase ( addr u -- addr u )
    >r passphrase r@ max-passphrase# umin move
    passphrase max-passphrase# r> safe/string erase
    wurst-key >c:key
    passphrase max-passphrase# c:hash
    passphrase-diffuse# 0 ?DO  c:diffuse  LOOP \ just to waste time ;-)
    c:key@ $40 save-mem ;

: get-passphrase ( -- addr u )
    passphrase-in >passphrase ;

Variable keys "" keys $!
2Variable key+len \ current key + len

: +key ( addr u -- ) key+len 2! key+len 2 cells keys $+! ;
: +passphrase ( -- )  get-passphrase +key ;
: ">passphrase ( addr u -- ) >passphrase +key ;
: +seckey ( -- )
    keypad ke-sk $@ drop ke-pk $@ drop crypto_scalarmult keypad keysize +key ;

"" ">passphrase \ following the encrypt-everything paradigm,
\ no password is the empty string!  It's still encrypted!

\ a secret key just needs a nick and a type.
\ Secret keys can be persons and groups.

\ a public key needs more: nick, type, profile.
\ The profile is a structured document, i.e. pointed to by a hash.

\ a signature contains a pubkey, a checkbox bitmask,
\ a date, an expiration date, the signer's pubkey and the signature itself
\ (r+s).  There is an optional signing protocol document (hash).

\ we store each item in a 256 bytes encrypted string, i.e. with a 16
\ byte salt and a 16 byte checksum.

\ Keys are passwords and private keys (self-keyed, i.e. private*public key)

$100 Constant keypack#

keypack# mykey-salt# + $10 + Constant keypack-all#

keypack-all# buffer: keypack
keypack-all# buffer: keypack-d

also net2o-base definitions

100 net2o: newkey ( addr u -- ) key:new ;
101 net2o: privkey ( addr u -- ) ke-sk $! +seckey ;
102 net2o: keytype ( n -- ) 64>n ke-type ! ; \ default: anonymous
103 net2o: keynick ( addr u -- )  ke-nick $! ;
104 net2o: keyprofile ( addr u -- ) ke-prof $! ;
105 net2o: newkeysig ( addr u -- ) save-mem addsig 2!
    addsig 2 cells ke-sigs $+! ;
106 net2o: keymask ( x -- ) 64drop ;
107 net2o: keyfirst ( date-ns -- ) ke-first 64! ;
108 net2o: keylast ( date-ns -- ) ke-last 64! ;

previous definitions

: key:code ( -- )
    net2o-code0 keypack keypack-all# erase
    keypack mykey-salt# + cmd0source ! ;
comp: :, also net2o-base ;

also net2o-base definitions

: end:key ( -- )
    end-cmd previous
    keypack keypack-all#
    key+len 2@ encrypt$
    cmdlock unlock ;
comp: :, previous ;

previous definitions

0 Value key-fd

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

: ?key-fd ( -- fd ) key-fd dup ?EXIT drop
    ?.net2o
    "~/.net2o/keyfile.n2o" r/w open-file dup -514 = IF
	2drop "~/.net2o/keyfile.n2o" r/w create-file
    THEN  throw
    dup to key-fd ;

: append-file ( addr u fd -- ) >r
    r@ file-size throw  r@ reposition-file throw
    r@ write-file throw  r> flush-file throw ;

: key>file ( -- )
    keypack keypack-all# ?key-fd append-file ;

: rnd>file ( -- )
    ( keypack keypack-all# >rng$ ) key>file ;

: >keys ( -- )
    keypad skc pkc crypto_scalarmult keypad keysize +key ;

: +keypair ( type nick u -- )
    +passphrase gen-keys
    key:code
        pkc keysize $, newkey skc keysize $, privkey
        $, keynick lit, keytype ticks lit, keyfirst
    end:key key>file >keys ;

\ read key file

: try-decrypt ( -- addr u / 0 0 )
    keys $@ bounds ?DO
	keypack keypack-d keypack-all# move
	keypack-d keypack-all# I 2@
	decrypt$ IF  unloop  EXIT  THEN
	2drop
    2 cells +LOOP  0 0 ;

: do-key ( addr u / 0 0  -- )
    dup 0= IF  2drop  EXIT  THEN
    ( 2dup n2o:see ) do-cmd-loop ;

: read-key-loop ( -- )
    BEGIN
	keypack keypack-all# ?key-fd read-file throw
	keypack-all# = WHILE  try-decrypt do-key
    REPEAT ;

: read-keys ( -- )
    key-fd 0= IF  "default.n2o" r/o open-file throw to key-fd
	read-key-loop  key-fd close-file throw  0 to key-fd  THEN
    0. ?key-fd reposition-file throw  read-key-loop ;

\ revert

previous definitions

also new-keys

: >key ( addr u -- )
    key-table @ 0= IF  read-keys  THEN
    nick-key  this-keyid @ 0= ?EXIT
    this-keyid @ pkc keysize move
    ke-sk $@ skc swap move ;

previous