Commit 7892eae5 authored by bernd's avatar bernd

checksums now covers all header bits, including flow control (ignored for cookie)

parent b8731073
......@@ -48,7 +48,7 @@ UValue test# 0 to test#
: c:add-tag ( -- ) +addme
net2o-code
expect-reply
s" DHT test" $, type cr get-ip
log s" DHT test" $, type cr endwith get-ip
pkc keysize 2* $, dht-id
forever "test:tag" pkc keysize 2* gen-tag-del $, dht-tags-
forever "test:tag" pkc keysize 2* gen-tag $, dht-tags+
......
......@@ -44,16 +44,16 @@ object class
\G Encrypt message in buffer addr u
umethod c:decrypt ( addr u -- )
\G Decrypt message in buffer addr u
umethod c:encrypt+auth ( addr u -- )
umethod c:encrypt+auth ( addr u tag -- )
\G Encrypt message in buffer addr u
umethod c:decrypt+auth ( addr u -- flag )
umethod c:decrypt+auth ( addr u tag -- flag )
\G Decrypt message in buffer addr u
umethod c:hash ( addr u -- )
\G Hash message in buffer addr u
umethod c:prng ( addr u -- )
\G Fill buffer addr u with PRNG sequence
umethod c:checksum ( -- xd )
umethod c:checksum ( tag -- xd )
\G compute a 128 bit checksum
umethod c:cookie ( -- x )
\G compute a different checksum
\G compute a different 64 bit checksum
end-class crypto
......@@ -54,7 +54,7 @@ end-c-library
25 8 * Constant keccak#
128 Constant keccak#max
24 Constant keccak#cks
128 Constant keccak#cks
UValue @keccak
......@@ -114,21 +114,23 @@ keccak-init
\ BEGIN @keccak KeccakF 2dup keccak#max umin tuck -keccak
\ /string dup 0= UNTIL 2drop
; to c:decrypt ( addr u -- )
:noname ( addr u -- )
:noname ( addr u tag -- )
\G Encrypt message in buffer addr u with auth
\ BEGIN @keccak KeccakF 2dup keccak#max umin tuck +keccak
\ /string dup 0= UNTIL drop
@keccak -rot KeccakEncryptLoop
{ tag } @keccak -rot KeccakEncryptLoop
@keccak KeccakF
>r keccak-checksums keccak#cks keccak> keccak-checksums 128@ r> 128!
>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 -- )
:noname ( addr u tag -- )
\G Decrypt message in buffer addr u, with auth check
\ BEGIN @keccak KeccakF 2dup keccak#max umin tuck -keccak
\ /string dup 0= UNTIL drop
@keccak -rot KeccakDecryptLoop
{ tag } @keccak -rot KeccakDecryptLoop
@keccak KeccakF
128@ keccak-checksums keccak#cks keccak> keccak-checksums 128@ 128=
128@ keccak-checksums keccak#cks keccak>
keccak-checksums tag 7 and 4 lshift + 128@ 128=
; to c:decrypt+auth ( addr u -- flag )
:noname ( addr u -- )
\G Hash message in buffer addr u
......@@ -145,10 +147,13 @@ keccak-init
; to c:prng
\G Fill buffer addr u with PRNG sequence
:noname @keccak KeccakF
keccak-checksums keccak#cks keccak> keccak-checksums 128@ ; to c:checksum ( -- xd )
keccak-checksums keccak#cks keccak>
7 and 4 lshift keccak-checksums + 128@ ; to c:checksum ( tag -- xd )
\G compute a 128 bit checksum
:noname keccak-checksums keccak#cks keccak> keccak-checksums $10 + 64@ ; to c:cookie ( -- x )
\G obtain a different 64 bit checksum part
:noname keccak-checksums keccak#cks keccak>
64#0 keccak-checksums keccak#cks bounds ?DO
I 64@ 64xor 8 +LOOP ; to c:cookie ( -- x )
\G obtain a 64 bit checksum
keccak ' new static-a with-allocater Constant keccak-o
......
......@@ -557,6 +557,7 @@ $20 net2o: tmpnest ( $:string -- ) \ nested (temporary encrypted) command
ELSE ." don't store key: o=" o hex. .nnb F cr THEN ;
+net2o: map-request ( addrs ucode udata -- ) \ request mapping
knocked? 0= IF 64drop 64drop 64drop un-cmd EXIT THEN
2*64>n
nest[
?new-mykey ticker 64@ lit, set-cookie
......@@ -636,15 +637,18 @@ net2o-base
update-key all-ivs ;
+net2o: gen-reply ( -- ) \ generate a key request reply reply
own-crypt? 0= ?EXIT
own-crypt? knocked? or 0= ?EXIT
[: crypt( ." Reply key: " tmpkey@ .nnb F cr )
reply-key, cookie+request time-offset! ]tmpnest
push-cmd ;] IS expect-reply? ;
+net2o: gen-punch-reply ( -- ) o? \ generate a key request reply reply
knocked? 0= ?EXIT
[: crypt( ." Reply key: " tmpkey@ .nnb F cr )
reply-key, gen-punchload gen-punch time-offset! ]tmpnest
push-cmd ;] IS expect-reply? ;
+net2o: knock ( $:challenge -- ) $> net2o:knock knock-val and validated or! ;
gen-table $freeze
\ everything that follows here can assume to have a connection context
......
......@@ -127,10 +127,10 @@ User last-ivskey
2>r over >r rng@ rng@ r> 128! 2r> crypt-key-init ;
: encrypt$ ( addr u1 key u2 -- )
crypt-key-setup 2 64s - c:encrypt+auth ;
crypt-key-setup 2 64s - 0 c:encrypt+auth ;
: decrypt$ ( addr u1 key u2 -- addr' u' flag )
crypt-key-init 2 64s - 2dup c:decrypt+auth ;
crypt-key-init 2 64s - 2dup 0 c:decrypt+auth ;
\ passphraese encryption needs to diffuse a lot after mergin in the salt
......@@ -145,10 +145,10 @@ User last-ivskey
drop c@ $F and 2* $100 swap lshift ;
: encrypt-pw$ ( addr u1 key u2 n -- )
crypt-pw-setup pw-diffuse 2 64s - c:encrypt+auth ;
crypt-pw-setup pw-diffuse 2 64s - 0 c:encrypt+auth ;
: decrypt-pw$ ( addr u1 key u2 -- addr' u' flag ) 2over pw-setup >r
crypt-key-init r> pw-diffuse 2 64s - 2dup c:decrypt+auth ;
crypt-key-init r> pw-diffuse 2 64s - 2dup 0 c:decrypt+auth ;
\ encrypt with own key
......@@ -160,10 +160,12 @@ User last-ivskey
$>align oldmykey state# decrypt$ +enc ;
: outbuf-encrypt ( map -- ) +calc
crypt-buf-init outbuf packet-data +cryptsu c:encrypt+auth +enc ;
crypt-buf-init outbuf packet-data +cryptsu
outbuf 1+ c@ c:encrypt+auth +enc ;
: inbuf-decrypt ( map -- flag2 ) +calc
crypt-buf-init inbuf packet-data +cryptsu c:decrypt+auth +enc ;
crypt-buf-init inbuf packet-data +cryptsu
inbuf 1+ c@ c:decrypt+auth +enc ;
\ IVS
......@@ -322,6 +324,14 @@ Defer search-key \ search if that is one of our pubkeys
THEN
2drop ;
\ port knocking
Variable knocks
: net2o:knock ( addr u -- flag )
0 -rot knocks [: 2over 2swap decrypt$ nip nip -rot 2>r or 2r>
;] $[]map 2drop ;
0 [IF]
Local Variables:
forth-local-words:
......
......@@ -324,7 +324,8 @@ User ip6:#
: check-ip4 ( ip4addr -- my-ip4addr 4 ) noipv4( 0 EXIT )
[: sockaddr_in6 %size alen !
sockaddr ipv4! query-sock sockaddr sock-rest connect ?ior
sockaddr ipv4! query-sock sockaddr sock-rest connect
IF errno 101 = IF drop "\0\0\0\0" ELSE true ?ior THEN THEN
query-sock sockaddr1 alen getsockname dup 0< errno 101 = and
IF drop s" " \ 0 is an invalid result
ELSE ?ior
......@@ -2240,19 +2241,21 @@ $02 Constant own-crypt-val
$04 Constant login-val
$08 Constant cookie-val
$10 Constant tmp-crypt-val
$20 Constant knock-val
: crypt? ( -- flag ) validated @ crypt-val and ;
: own-crypt? ( -- flag ) validated @ own-crypt-val and ;
: login? ( -- flag ) validated @ login-val and ;
: cookie? ( -- flag ) validated @ cookie-val and ;
: tmp-crypt? ( -- flag ) validated @ tmp-crypt-val and ;
: knocked? ( -- flag ) validated @ knock-val and ;
: handle-cmd0 ( -- ) \ handle packet to address 0
cmd0( .time ." handle cmd0 " sockaddr alen @ .address cr )
0 >o rdrop \ address 0 has no job context!
0 inbuf-decrypt 0= IF
." invalid packet to 0" drop cr EXIT THEN
validated off \ packets to address 0 are not really validated
knocks $@len 0= knock-val and validated ! \ packets to address 0 are not really validated
inbuf packet-data queue-command ;
: handle-data ( addr -- ) parent @ >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