Index: cmd.fs ================================================================== --- cmd.fs +++ cmd.fs @@ -693,11 +693,11 @@ +zero16 \ add space for checksum cmd-resolve> ; : cmd>nest ( -- addr u ) cmd> 2dup mykey-encrypt$ ; : cmd>tmpnest ( -- addr u ) - cmd> 2dup tmpkey@ keysize umin + cmd> 2dup tmpkey@ key| key( ." tmpnest key: " 2dup 85type forth:cr ) encrypt$ ; : cmd>encnest ( -- addr u ) cmd> 2dup tmpkey@ key( ." tmpnest key: " 2dup 85type forth:cr ) encrypt$ ; Index: ed25519-donna.fs ================================================================== --- ed25519-donna.fs +++ ed25519-donna.fs @@ -52,10 +52,11 @@ $C0 uvar get0 $C0 uvar get1 $40 uvar hashtmp $40 uvar sigtmp $20 uvar pktmp + $20 uvar sktmp keccak# uvar hstatetmp cell uvar task-id end-class edbuf-c : init-ed25519 @@ -118,10 +119,11 @@ sct1 hashtmp 64b>sc25519 \ sct1 is z sct2 sk raw>sc25519 \ sct2 is sk sct1 sct1 sct2 sc25519* sct1 sct1 sct3 sc25519+ \ s=z*sk+k sigbuf $20 + sct1 sc25519>32b + hstatetmp c:key@ c:key# move \ restore state clean-ed25519 sigbuf $40 ; \ r,s UValue no-ed-check? 0 to no-ed-check? @@ -128,20 +130,26 @@ : ed-check? { sig pk -- flag } \G check a message: the keccak state contains the hash of the message. \G The unpacked pk is in get0, so this word can be used for batch checking. \G sig and pk need to be aligned properly, ed-verify does that alignment no-ed-check? IF true EXIT THEN + c:key@ hstatetmp c:key# move \ we need this to be preserved sig hashtmp $20 move pk hashtmp $20 + $20 move hashtmp $40 c:shorthash hashtmp $40 c:hash@ \ z=hash(r+pk+message) sct2 hashtmp 64b>sc25519 \ sct2 is z sct3 sig $20 + raw>sc25519 \ sct3 is s get1 get0 sct2 sct3 ge25519*+ \ base*s-pk*z sigbuf $40 + get1 ge25519-pack \ =r + hstatetmp c:key@ c:key# move \ restore state again sig sigbuf $40 + 32b= ; -: ed-verify ( sig pk -- flag ) \ message digest is in keccak state +: sig>align ( sig pk -- ) pktmp $20 move sigtmp $40 move \ align inputs + $0F sigtmp $3F + andc! ; + +: ed-verify ( sig pk -- flag ) \ message digest is in keccak state + sig>align get0 pktmp ge25519-unpack- 0= IF false EXIT THEN \ bad pubkey sigtmp pktmp ed-check? ; : ed-quickcheck? { skh sk sig pk -- flag } \G quick check a message signed by ourself: the keccak state @@ -163,14 +171,15 @@ sct3 sig $20 + raw>sc25519 \ sct3 is s get1 get0 sct2 sct3 ge25519*+ \ base*s-pk*z sigbuf $40 + get1 ge25519-pack \ =r sig sigbuf $40 + 32b= THEN + hstatetmp c:key@ c:key# move \ restore state again clean-ed25519 ; : ed-quick-verify ( skh sk sig pk -- flag ) \ message digest is in keccak state - pktmp $20 move sigtmp $40 move \ align inputs + sig>align get0 pktmp ge25519-unpack- 0= IF false EXIT THEN \ bad pubkey sigtmp pktmp ed-quickcheck? ; : ed-dh { sk pk dest -- secret len } pk pktmp $20 move Index: msg.fs ================================================================== --- msg.fs +++ msg.fs @@ -658,43 +658,69 @@ $> nest-sig ?dup-0=-IF handle-msg ELSE replay-mode @ IF drop 2drop ELSE !!sig!! THEN \ balk on all wrong signatures THEN ; -+net2o: msg-nestencsig ( $:enc[cmd]+sig -- ) \g decrypt, chech sig+nest - $> dec-nest-sig ?dup-0=-IF - handle-msg - ELSE replay-mode @ IF drop 2drop - ELSE !!sig!! THEN \ balk on all wrong signatures - THEN ; : msg-sig? ( addr u -- addr u' flag ) skip-sig? @ IF quicksig( pk-quick-sig? )else( pk-date? ) ELSE pk-sig? THEN ; -' msg-sig? ' message 2dup -msging-class to start-req -msging-class to nest-sig -msg-class to start-req -msg-class to nest-sig +\ encrypt+sign +\ features: signature verification only when key is known +\ identity only revealed when correctly decrypted + +: modkey> ( dest -- ) + get0 over ge25519-unpack- 0= !!no-ed-key!! + voutkey keysize c:hash@ + sct0 voutkey 32b>sc25519 + get1 get0 sct0 ge25519* + dup get1 ge25519-pack + $80 swap $1F + xorc! ; : msg-dec-sig? ( addr u -- addr' u' flag ) - msg-sig? dup IF drop - 2dup + pktmp keysize move \ move the pk to pktmp - get0 pktmp ge25519-unpack- 0= !!no-ed-key!! - msg-keys[] $@ bounds U+DO - 2dup I $@ crypt-key-init $>align - 2dup 0 c:decrypt+auth IF - voutkey keysize c:hash@ - sct0 voutkey 32b>sc25519 - get1 get0 sct0 ge25519* - tf-out get1 ge25519-pack - $80 tf-out $1F + xorc! - 2nip true unloop EXIT THEN - 2drop - cell +LOOP - false - THEN ; + sigpksize# - + msg-keys[] $@ bounds U+DO + 2dup I $@ decrypt$ IF + 2over + sigpksize# over date-sig? nip nip IF + 2dup + >r 2swap + r> sigpksize# move + 2dup + modkey> sigpksize# + + true unloop EXIT THEN THEN + 2drop + cell +LOOP + sigpksize# + false ; + +\ generate an encryt+sign packet + +: >modkey ( dstsk dstpk sk -- ) + voutkey keysize c:hash@ + sct0 voutkey 32b>sc25519 + sct1 sct0 sc25519/ + sct0 swap raw>sc25519 + sct2 sct0 sct1 sc25519* + get0 sct2 ge25519*base + get0 ge25519-pack + sct2 sc25519>32b ; + +: ]encpksig ( -- ) + +zero16 nest$ msg-keys[] dup $[]# 1- swap $[]@ encrypt$ + sigdate +date + sktmp pktmp sk@ drop >modkey + [: pktmp keysize forth:type sigdate datesize# forth:type + sig-params 2drop sktmp pktmp ed-sign forth:type + keysize forth:emit ;] ']sign ; + +\ nest-sig for msg/msging classes + +:noname ( addr u -- ) + 2dup + 2 - c@ $F0 and + case $80 of msg-dec-sig? endof + drop msg-sig? + 0 endcase ; ' message 2dup +msging-class is start-req +msging-class is nest-sig +msg-class is start-req +msg-class is nest-sig ' context-table is gen-table also }scope @@ -872,11 +898,11 @@ fs-flush THEN ; msgfs-class is fs-close :noname ( perm -- ) perm%msg and 0= !!msg-perm!! -; msgfs-class to fs-perm? +; msgfs-class is fs-perm? :noname ( -- date perm ) 64#0 0 ; msgfs-class is fs-get-stat :noname ( date perm -- ) drop 64drop ; msgfs-class is fs-set-stat ' file-start-req msgfs-class is start-req @@ -883,13 +909,10 @@ \ message composer : group, ( addr u -- ) $, msg-group ; -: ( -- ) \G end a message block by adding a signature ]pksign ; : msg-otr> ( -- ) \G end a message block by adding a short-time signature @@ -1277,10 +1300,11 @@ dup 0= IF 2drop away? IF "I'm back" ELSE "Away from keyboard" THEN away? 0= to away? THEN [: $, msg-action ;] send-avalanche ; +synonym /back /away : /otr ( addr u -- ) \U otr on|off|message turn otr mode on/off (or one-shot) 2dup s" on" str= >r 2dup s" off" str= r@ or IF 2drop r> otr-mode !