Commit 4b4c6bae authored by bernd's avatar bernd

Use new way to store keys

parent 2910c20c
No preview for this file type
\ Keccak: Forth version derived from "readable keccak" by Bernd Paysan
\ Keccak: Forth version by Bernd Paysan
\ derived from "readable keccak"
\ 19-Nov-11 Markku-Juhani O. Saarinen <mjos@iki.fi>
\ A baseline Keccak (3rd round) implementation.
......@@ -10,27 +11,36 @@
: array Create DOES> swap cells + @ ;
array keccakf-rndc
$0000000000000001 , $0000000000008082 , $800000000000808a ,
$8000000080008000 , $000000000000808b , $0000000080000001 ,
$8000000080008081 , $8000000000008009 , $000000000000008a ,
$0000000000000088 , $0000000080008009 , $000000008000000a ,
$000000008000808b , $800000000000008b , $8000000000008089 ,
$8000000000008003 , $8000000000008002 , $8000000000000080 ,
$000000000000800a , $800000008000000a , $8000000080008081 ,
$8000000000008080 , $0000000080000001 , $8000000080008008 ,
$0000000000000001 , $0000000000008082 ,
$800000000000808a , $8000000080008000 ,
$000000000000808b , $0000000080000001 ,
$8000000080008081 , $8000000000008009 ,
$000000000000008a , $0000000000000088 ,
$0000000080008009 , $000000008000000a ,
$000000008000808b , $800000000000008b ,
$8000000000008089 , $8000000000008003 ,
$8000000000008002 , $8000000000000080 ,
$000000000000800a , $800000008000000a ,
$8000000080008081 , $8000000000008080 ,
$0000000080000001 , $8000000080008008 ,
carray keccakf-rotc
1 c, 3 c, 6 c, 10 c, 15 c, 21 c, 28 c, 36 c, 45 c, 55 c, 2 c, 14 c,
27 c, 41 c, 56 c, 8 c, 25 c, 43 c, 62 c, 18 c, 39 c, 61 c, 20 c, 44 c,
1 c, 3 c, 6 c, 10 c, 15 c, 21 c,
28 c, 36 c, 45 c, 55 c, 2 c, 14 c,
27 c, 41 c, 56 c, 8 c, 25 c, 43 c,
62 c, 18 c, 39 c, 61 c, 20 c, 44 c,
: cc, cells c, ;
carray keccakf-piln
10 cc, 7 cc, 11 cc, 17 cc, 18 cc, 3 cc, 5 cc, 16 cc, 8 cc, 21 cc, 24 cc, 4 cc,
15 cc, 23 cc, 19 cc, 13 cc, 12 cc, 2 cc, 20 cc, 14 cc, 22 cc, 9 cc, 6 cc, 1 cc,
10 cc, 7 cc, 11 cc, 17 cc, 18 cc, 3 cc,
5 cc, 16 cc, 8 cc, 21 cc, 24 cc, 4 cc,
15 cc, 23 cc, 19 cc, 13 cc, 12 cc, 2 cc,
20 cc, 14 cc, 22 cc, 9 cc, 6 cc, 1 cc,
carray mod5
0 cc, 1 cc, 2 cc, 3 cc, 4 cc, 0 cc, 1 cc, 2 cc, 3 cc, 4 cc,
0 cc, 1 cc, 2 cc, 3 cc, 4 cc,
0 cc, 1 cc, 2 cc, 3 cc, 4 cc,
\ update the state with given number of rounds
......@@ -38,12 +48,14 @@ kcol# buffer: bc
kkey# buffer: st
: lrot1 ( x1 -- x2 ) dup 2* swap 0< - ;
: lrot ( x1 n -- x2 ) 2dup lshift >r 64 swap - rshift r> or ;
: lrot ( x1 n -- x2 ) 2dup lshift >r
64 swap - rshift r> or ;
: xor! ( x addr -- ) dup >r @ xor r> ! ;
: theta1 ( -- )
5 0 DO
0 st i cells + kkey# bounds DO I @ xor kcol# +LOOP
0 st i cells + kkey# bounds DO
I @ xor kcol# +LOOP
bc i cells + !
LOOP ;
......@@ -51,7 +63,8 @@ kkey# buffer: st
5 0 DO
bc I 4 + mod5 + @
bc I 1 + mod5 + @ lrot1 xor
st i cells + kkey# bounds DO dup I xor! kcol# +LOOP
st i cells + kkey# bounds DO
dup I xor! kcol# +LOOP
drop
LOOP ;
......@@ -67,7 +80,8 @@ kkey# buffer: st
st kkey# bounds DO
I bc kcol# move
5 0 DO
bc I 1+ mod5 + @ invert bc I 2 + mod5 + @ and
bc I 1+ mod5 + @ invert
bc I 2 + mod5 + @ and
J I cells + xor!
LOOP
kcol# +LOOP ;
......@@ -85,15 +99,21 @@ kkey# buffer: st
: >sponge ( addr u -- )
\ fill in sponge function
st swap bounds DO dup @ I xor! cell+ cell +LOOP drop ;
st swap bounds DO
dup @ I xor! cell+
cell +LOOP drop ;
: >duplex ( addr u -- )
\ duplex in sponge function: encrypt
st swap bounds DO dup @ I @ xor dup I ! over ! cell+ cell +LOOP drop ;
st swap bounds DO
dup @ I @ xor dup I ! over ! cell+
cell +LOOP drop ;
: duplex> ( addr u -- )
\ duplex out sponge function: decrypt
st swap bounds DO dup @ I @ xor over @ I ! over ! cell+ cell +LOOP drop ;
st swap bounds DO
dup @ I @ xor over @ I ! over ! cell+
cell +LOOP drop ;
\ for test, we pad with Keccak's padding function
......@@ -116,4 +136,4 @@ kkey# buffer: st
keccakf st @ $6EAAAE36BE8E36D3 = and
keccakf st @ $1B4AEC08DA6A8BA6 = and
[IF] ." succeeded" [ELSE] ." failed" [THEN] cr
[THEN]
[THEN]
\ No newline at end of file
\ key handling
require mkdir.fs
\ hashed key data base
object class
field: ke-sk
field: ke-nick
field: ke-name
field: ke-sigs
64field: ke-created
64field: ke-expires
end-class key-entry
key-entry @ buffer: sample-key
Variable key-table
Variable this-key
Variable this-keyid
sample-key this-key ! \ dummy
: current-key ( addr u -- )
key-table #@ drop dup this-key ! >o rdrop ;
: make-thiskey ( addr -- )
dup $@ drop this-keyid ! cell+ $@ drop dup this-key ! >o rdrop ;
: new-key ( addr u -- )
\ addr u is the public key
sample-key key-entry @ 2dup erase
2over key-table #! current-key ;
: (digits>$) ( addr u -- addr' u' ) save-mem
>r dup dup r> bounds ?DO
I 2 s>number drop over c! char+
2 +LOOP over - ;
: hex>$ ( addr u -- addr' u' )
['] (digits>$) $10 base-execute ;
: x" ( "hexstring" -- addr u )
'"' parse hex>$ ;
comp: execute postpone SLiteral ;
Vocabulary key-parser
: ^key ( -- fstart ) this-key @ ;
also key-parser definitions
: id: ( "id" -- ) 0 parse hex>$ new-key ;
: sk: ( "sk" -- ) 0 parse hex>$ ke-sk $! ;
: nick: ( "sk" -- ) 0 parse ke-nick $! ;
: name: ( "sk" -- ) 0 parse ke-name $! ;
: created: ( "number" -- ) parse-name s>number d>64 ke-created 64! ;
: expires: ( "number" -- ) parse-name s>number d>64 ke-expires 64! ;
previous definitions
: .key ( addr -- ) dup @ 0= IF drop EXIT THEN
." id: " dup $@ xtype cr cell+ $@ drop >o
ke-sk @ IF ." sk: " ke-sk $@ xtype cr THEN
ke-nick @ IF ." nick: " ke-nick $@ type cr THEN
ke-name @ IF ." name: " ke-name $@ type cr THEN
ke-created 64@ 64dup 64-0= IF 64drop
ELSE ." created: " 64>d d. cr THEN
ke-expires 64@ 64dup 64-0= IF 64drop
ELSE ." expires: " 64>d d. cr THEN
o> cr ;
: .skey ( addr -- ) dup cell+ $@ drop @ IF .key ELSE drop THEN ;
: .pkey ( addr -- ) dup cell+ $@ drop @ 0= IF .key ELSE drop THEN ;
: dump-skeys ( fd -- )
[: key-table ['] .skey #map ;] swap outfile-execute ;
: dump-pkeys ( fd -- )
[: key-table ['] .pkey #map ;] swap outfile-execute ;
: ?.net2o ( -- )
s" ~/.net2o" r/o open-file nip IF
s" ~/.net2o" $1C0 mkdir-parents throw
THEN ;
: dump-keys ( -- ) ?.net2o
s" ~/.net2o/seckeys.n2o" r/w open-file throw
dup >r dump-skeys r> close-file throw
s" ~/.net2o/pubkeys.n2o" r/w open-file throw
dup >r dump-pkeys r> close-file throw ;
: scan-keys ( fd -- ) 0 >o get-order n>r
only previous key-parser include-file nr> set-order o> ;
: ?scan-keys ( addr u -- )
r/w open-file 0= IF scan-keys ELSE drop THEN ;
: read-keys ( -- )
s" default.n2o" ?scan-keys
s" ~/.net2o/seckeys.n2o" ?scan-keys
s" ~/.net2o/pubkeys.n2o" ?scan-keys ;
\ search for keys by name and nick
\ !!FIXME!! 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 ;
: name-key ( addr u -- ) \ search for key name and make current
key-table
[: dup >r cell+ $@ drop >o ke-name $@ o> 2over str= IF
r@ make-thiskey
THEN rdrop ;] #map ;
\ 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 '*' emit THEN
THEN
REPEAT drop nip r> swap - ;
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 rounds-setkey
message state# 8 * 2dup accept* dup >r safe/string erase
r> IF
source-init wurst-key hash-init
message roundsh# rounds-encrypt
passphrase-diffuse# 0 ?DO c:diffuse LOOP \ just to waste time ;-)
wurst-state passskc keysize xors
wurst-state keysize + passskc keysize xors
THEN passskc ;
: 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!! ;
: decrypt-skc ( -- )
testskc check-key? ?EXIT
passphrase-retry# 0 ?DO
cr ." Passphrase: "
testskc get-passphrase check-key? IF unloop EXIT THEN
LOOP !!nokey!! ;
: >key ( addr u -- )
key-table @ 0= IF read-keys THEN
nick-key
this-keyid @ pkc keysize move
ke-sk $@ testskc swap move decrypt-skc ;
This diff is collapsed.
\ 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 ;
: name-key ( addr u -- ) \ search for key name and make current
key-table
[: dup >r cell+ $@ drop >o ke-name $@ o> 2over str= IF
r@ make-thiskey
THEN rdrop ;] #map ;
\ 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-keys ( -- )
0. ?key-fd reposition-file throw
BEGIN
keypack keypack-all# ?key-fd read-file throw
keypack-all# = WHILE try-decrypt do-key
REPEAT ;
\ revert
previous definitions
\ No newline at end of file
......@@ -1162,7 +1162,7 @@ file-state-struct buffer: new-file-state
LOOP ;
require net2o-crypt.fs
require net2o-keys.fs
\ require net2o-keys.fs
\ cookie stuff
......@@ -1839,7 +1839,7 @@ con-cookie @ buffer: cookie-adder
\ load net2o commands
require net2o-cmd.fs
require net2o-keys1.fs
require net2o-keys.fs
0 [IF]
Local Variables:
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment