Commit bae76eee authored by bernd's avatar bernd

Preshared keys for stateless communication

parent 080c9df7
......@@ -40,14 +40,15 @@ $4000 Constant /kregion
32 buffer: zero32
: sec-off ( addr -- ) dup @ dup IF kfree64 off EXIT THEN 2drop ;
: sec! ( addr1 u1 addr2 -- )
over 0= IF sec-off 2drop EXIT THEN
>r r@ kalloc64? dup r> ! swap $40 umin move ;
: sec@ ( addr -- addr1 u1 )
@ dup IF $40 over $20 + $20 zero32 over str= IF 2/ THEN
ELSE 0 THEN ;
: sec+! ( addr1 u1 addr2 -- )
dup @ 0= IF sec! ELSE sec@ dup >r + swap $40 r> - umin move THEN ;
: sec-off ( addr -- ) dup @ dup IF kfree64 off EXIT THEN 2drop ;
: sec+[]! ( addr1 u1 addr2 -- ) >r
0 { w^ sec } sec sec! sec cell r> $+! ;
......
......@@ -121,8 +121,8 @@ keccak-init
@keccak KeccakF
>r keccak-checksums keccak#cks keccak>
keccak-checksums tag 7 and 4 lshift + 128@ r> 128!
; to c:encrypt+auth ( addr u -- )
:noname ( addr u tag -- )
; to c:encrypt+auth ( addr u tag -- )
:noname ( addr u tag -- flag )
\G Decrypt message in buffer addr u, with auth check
\ BEGIN @keccak KeccakF 2dup keccak#max umin tuck -keccak
\ /string dup 0= UNTIL drop
......@@ -130,7 +130,7 @@ keccak-init
@keccak KeccakF
128@ keccak-checksums keccak#cks keccak>
keccak-checksums tag 7 and 4 lshift + 128@ 128=
; to c:decrypt+auth ( addr u -- flag )
; to c:decrypt+auth ( addr u tag -- flag )
:noname ( addr u -- )
\G Hash message in buffer addr u
BEGIN 2dup keccak#max umin tuck
......
......@@ -67,20 +67,18 @@ init-keybuf
: ?new-mykey ( -- )
last-mykey 64@ ticker 64@ 64- 64-0< IF init-mykey THEN ;
: move-rep ( srcaddr u1 destaddr u2 -- )
bounds ?DO
I' I - umin 2dup I swap move
dup +LOOP 2drop ;
: >crypt-key ( addr u -- ) key( dup . )
dup 0= IF 2drop no-key state# THEN
key-assembly state# + state# bounds DO
2dup I swap move
dup +LOOP 2drop
key-assembly state# + state# move-rep
key-assembly key( ." >crypt-key " dup state2# xtype cr )
>c:key ;
: >crypt-source' ( addr -- )
crypt( ." ivs iv: " dup state# .nnb cr )
key-assembly state# move ;
: >crypt-source ( addr u -- )
key-assembly state# bounds DO
2dup I swap move
dup +LOOP 2drop ;
key-assembly state# move-rep ;
\ regenerate ivs is a buffer swapping function:
\ regenerate half of the ivs per time, when you reach the middle of the other half
......@@ -175,24 +173,24 @@ User last-ivskey
: set-0key ( keyaddr u -- )
dup IF
state# min
ivs-assembly state# bounds ?DO
I' I - umin 2dup I swap move
dup +LOOP 2drop
ivs-assembly state# move-rep
ELSE
2drop ivs-assembly state# erase
THEN
." 0key: " ivs-assembly state# 2* 85type cr
\ ." 0key: " ivs-assembly state# 2* 85type cr
ivs-assembly >c:key ;
: try-0decrypt ( addr -- flag ) sec@ set-0key
inbuf packet-data +cryptsu
inbuf 1+ c@ c:decrypt+auth +enc ;
inbuf packet-data tmpbuf swap 2dup 2>r $10 + move
2r> +cryptsu
inbuf 1+ c@ c:decrypt+auth +enc
dup IF tmpbuf inbuf packet-data move THEN ;
: inbuf0-decrypt ( -- flag ) +calc
: inbuf0-decrypt ( -- flag ) +calc
inbuf addr 64@ inbuf flags w@ addr>assembly
my-0key try-0decrypt dup IF EXIT THEN drop
contexts BEGIN @ dup WHILE >o
." inbuf0 context " o hex.
next-context dest-0key try-0decrypt o>
dup IF nip EXIT THEN drop REPEAT ;
......@@ -296,7 +294,7 @@ $60 Constant rndkey#
clear-keys ;
: ivs-strings ( addr u -- )
state# <> !!ivs!! >crypt-source' >crypt-key-ivs ;
dup state# <> !!ivs!! >crypt-source >crypt-key-ivs ;
\ public key encryption
......
......@@ -43,6 +43,7 @@ require hash-table.fs
\ user values
UValue inbuf ( -- addr )
UValue tmpbuf ( -- addr )
UValue outbuf ( -- addr )
UValue cmd0buf ( -- addr )
UValue init0buf ( -- addr )
......@@ -522,7 +523,9 @@ ustack nest-stack
: alloc-io ( -- ) \ allocate IO and reset generic user variables
-other ind-addr off reqmask off
alloc-buf to inbuf alloc-buf to outbuf
alloc-buf to inbuf
alloc-buf to tmpbuf
alloc-buf to outbuf
maxdata allocate throw to cmd0buf
maxdata 2/ mykey-salt# + $10 + allocate throw to init0buf
sockaddr_in %size alloz to sockaddr
......@@ -540,6 +543,7 @@ ustack nest-stack
init0buf maxdata 2/ mykey-salt# + $10 + freez
cmd0buf maxdata freez
inbuf free-buf
tmpbuf free-buf
outbuf free-buf ;
alloc-io
......
......@@ -4,7 +4,7 @@
\ revoke: 58AB8F52F46E73EFAB068F6337F371E14DD589BF0894D2F0AF51AE7EBB858A68
x" A91158F2C560ACCDFEFC05104B922E49C9DD022D0163921DAE08E6C2148A7BEBC83C71FCB345D24400D866C7FD32092C2D1EC056FD17B9537037590BD021EEBF" key:new >o
x" B2578B8766DB3A60F1F4F36B276924FDA6E7F559F629716BC78D95DB1CD8D400" ke-sk sec! +seckey
\ "this test account has a test key" ke-psk sec!
"this test account has a test key" ke-psk sec!
"test" ke-nick $! $1367B086A24E6B10. d>64 ke-first 64! 0 ke-type ! o>
\ revoke: 5843E2DC055E1F8BE14570A37B0F81146040A2CEE1D6C01B97C3BB801CDED864
x" 69D86C471E5FEED89478FB4260C898B6F69026BA4E78A9D815B53EB33CA9013A8E753EC381881FAAFFA66CD9DD47D3F2C0867E1A2B48067CA2188DF400C11074" key:new >o
......
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