\ 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