Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Add code to hide messages in open chat log |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
9a4250484fc93e10543ea1fa3643ddea |
| User & Date: | bernd 2019-06-10 21:41:00 |
Context
|
2019-06-12
| ||
| 21:37 | Some more work on locking down chats check-in: 2d8a974f37 user: bernd tags: trunk | |
|
2019-06-10
| ||
| 21:41 | Add code to hide messages in open chat log check-in: 9a4250484f user: bernd tags: trunk | |
|
2019-06-06
| ||
| 19:03 | Fix group command headline check-in: 5a3a4a866b user: bernd tags: trunk | |
Changes
Changes to cmd.fs.
691 691 692 692 : cmd> ( -- addr u ) 693 693 +zero16 \ add space for checksum 694 694 cmd-resolve> ; 695 695 696 696 : cmd>nest ( -- addr u ) cmd> 2dup mykey-encrypt$ ; 697 697 : cmd>tmpnest ( -- addr u ) 698 - cmd> 2dup tmpkey@ keysize umin 698 + cmd> 2dup tmpkey@ key| 699 699 key( ." tmpnest key: " 2dup 85type forth:cr ) encrypt$ ; 700 700 : cmd>encnest ( -- addr u ) 701 701 cmd> 2dup tmpkey@ 702 702 key( ." tmpnest key: " 2dup 85type forth:cr ) encrypt$ ; 703 703 704 704 : cmdnest ( addr u -- ) mykey-decrypt$ 705 705 IF own-crypt-val do-nest ELSE
Changes to ed25519-donna.fs.
50 50 $30 uvar sct2 51 51 $30 uvar sct3 52 52 $C0 uvar get0 53 53 $C0 uvar get1 54 54 $40 uvar hashtmp 55 55 $40 uvar sigtmp 56 56 $20 uvar pktmp 57 + $20 uvar sktmp 57 58 keccak# uvar hstatetmp 58 59 cell uvar task-id 59 60 end-class edbuf-c 60 61 61 62 : init-ed25519 62 63 edbuf @ IF task-id @ up@ = ?EXIT THEN 63 64 [: edbuf-c new edbuf ! ;] crypto-a with-allocater ................................................................................ 116 117 pk sigbuf $20 + $20 move 117 118 sigbuf $40 >hash \ z=hash(r,pk,message) 118 119 sct1 hashtmp 64b>sc25519 \ sct1 is z 119 120 sct2 sk raw>sc25519 \ sct2 is sk 120 121 sct1 sct1 sct2 sc25519* 121 122 sct1 sct1 sct3 sc25519+ \ s=z*sk+k 122 123 sigbuf $20 + sct1 sc25519>32b 124 + hstatetmp c:key@ c:key# move \ restore state 123 125 clean-ed25519 sigbuf $40 ; \ r,s 124 126 125 127 UValue no-ed-check? 126 128 0 to no-ed-check? 127 129 128 130 : ed-check? { sig pk -- flag } 129 131 \G check a message: the keccak state contains the hash of the message. 130 132 \G The unpacked pk is in get0, so this word can be used for batch checking. 131 133 \G sig and pk need to be aligned properly, ed-verify does that alignment 132 134 no-ed-check? IF true EXIT THEN 135 + c:key@ hstatetmp c:key# move \ we need this to be preserved 133 136 sig hashtmp $20 move pk hashtmp $20 + $20 move 134 137 hashtmp $40 c:shorthash hashtmp $40 c:hash@ \ z=hash(r+pk+message) 135 138 sct2 hashtmp 64b>sc25519 \ sct2 is z 136 139 sct3 sig $20 + raw>sc25519 \ sct3 is s 137 140 get1 get0 sct2 sct3 ge25519*+ \ base*s-pk*z 138 141 sigbuf $40 + get1 ge25519-pack \ =r 142 + hstatetmp c:key@ c:key# move \ restore state again 139 143 sig sigbuf $40 + 32b= ; 140 144 141 -: ed-verify ( sig pk -- flag ) \ message digest is in keccak state 145 +: sig>align ( sig pk -- ) 142 146 pktmp $20 move sigtmp $40 move \ align inputs 147 + $0F sigtmp $3F + andc! ; 148 + 149 +: ed-verify ( sig pk -- flag ) \ message digest is in keccak state 150 + sig>align 143 151 get0 pktmp ge25519-unpack- 0= IF false EXIT THEN \ bad pubkey 144 152 sigtmp pktmp ed-check? ; 145 153 146 154 : ed-quickcheck? { skh sk sig pk -- flag } 147 155 \G quick check a message signed by ourself: the keccak state 148 156 \G contains the hash of the message. 149 157 c:key@ hstatetmp c:key# move \ we need this twice - move away ................................................................................ 161 169 \ quick check failed, do slow check 162 170 \ old signatures had a different skh 163 171 sct3 sig $20 + raw>sc25519 \ sct3 is s 164 172 get1 get0 sct2 sct3 ge25519*+ \ base*s-pk*z 165 173 sigbuf $40 + get1 ge25519-pack \ =r 166 174 sig sigbuf $40 + 32b= 167 175 THEN 176 + hstatetmp c:key@ c:key# move \ restore state again 168 177 clean-ed25519 ; 169 178 170 179 : ed-quick-verify ( skh sk sig pk -- flag ) \ message digest is in keccak state 171 - pktmp $20 move sigtmp $40 move \ align inputs 180 + sig>align 172 181 get0 pktmp ge25519-unpack- 0= IF false EXIT THEN \ bad pubkey 173 182 sigtmp pktmp ed-quickcheck? ; 174 183 175 184 : ed-dh { sk pk dest -- secret len } 176 185 pk pktmp $20 move 177 186 get0 pktmp ge25519-unpack- 0= !!no-ed-key!! 178 187 sct2 sk raw>sc25519
Changes to msg.fs.
656 656 657 657 net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest 658 658 $> nest-sig ?dup-0=-IF 659 659 handle-msg 660 660 ELSE replay-mode @ IF drop 2drop 661 661 ELSE !!sig!! THEN \ balk on all wrong signatures 662 662 THEN ; 663 -+net2o: msg-nestencsig ( $:enc[cmd]+sig -- ) \g decrypt, chech sig+nest 664 - $> dec-nest-sig ?dup-0=-IF 665 - handle-msg 666 - ELSE replay-mode @ IF drop 2drop 667 - ELSE !!sig!! THEN \ balk on all wrong signatures 668 - THEN ; 669 663 670 664 : msg-sig? ( addr u -- addr u' flag ) 671 665 skip-sig? @ IF quicksig( pk-quick-sig? )else( pk-date? ) 672 666 ELSE pk-sig? THEN ; 673 -' msg-sig? ' message 2dup 674 -msging-class to start-req 675 -msging-class to nest-sig 676 -msg-class to start-req 677 -msg-class to nest-sig 678 667 668 +\ encrypt+sign 669 +\ features: signature verification only when key is known 670 +\ identity only revealed when correctly decrypted 671 + 672 +: modkey> ( dest -- ) 673 + get0 over ge25519-unpack- 0= !!no-ed-key!! 674 + voutkey keysize c:hash@ 675 + sct0 voutkey 32b>sc25519 676 + get1 get0 sct0 ge25519* 677 + dup get1 ge25519-pack 678 + $80 swap $1F + xorc! ; 679 679 : msg-dec-sig? ( addr u -- addr' u' flag ) 680 - msg-sig? dup IF drop 681 - 2dup + pktmp keysize move \ move the pk to pktmp 682 - get0 pktmp ge25519-unpack- 0= !!no-ed-key!! 683 - msg-keys[] $@ bounds U+DO 684 - 2dup I $@ crypt-key-init $>align 685 - 2dup 0 c:decrypt+auth IF 686 - voutkey keysize c:hash@ 687 - sct0 voutkey 32b>sc25519 688 - get1 get0 sct0 ge25519* 689 - tf-out get1 ge25519-pack 690 - $80 tf-out $1F + xorc! 691 - 2nip true unloop EXIT THEN 692 - 2drop 693 - cell +LOOP 694 - false 695 - THEN ; 680 + sigpksize# - 681 + msg-keys[] $@ bounds U+DO 682 + 2dup I $@ decrypt$ IF 683 + 2over + sigpksize# over date-sig? nip nip IF 684 + 2dup + >r 2swap + r> sigpksize# move 685 + 2dup + modkey> sigpksize# + 686 + true unloop EXIT THEN THEN 687 + 2drop 688 + cell +LOOP 689 + sigpksize# + false ; 690 + 691 +\ generate an encryt+sign packet 692 + 693 +: >modkey ( dstsk dstpk sk -- ) 694 + voutkey keysize c:hash@ 695 + sct0 voutkey 32b>sc25519 696 + sct1 sct0 sc25519/ 697 + sct0 swap raw>sc25519 698 + sct2 sct0 sct1 sc25519* 699 + get0 sct2 ge25519*base 700 + get0 ge25519-pack 701 + sct2 sc25519>32b ; 702 + 703 +: ]encpksig ( -- ) 704 + +zero16 nest$ msg-keys[] dup $[]# 1- swap $[]@ encrypt$ 705 + sigdate +date 706 + sktmp pktmp sk@ drop >modkey 707 + [: pktmp keysize forth:type sigdate datesize# forth:type 708 + sig-params 2drop sktmp pktmp ed-sign forth:type 709 + keysize forth:emit ;] ']sign ; 710 + 711 +\ nest-sig for msg/msging classes 712 + 713 +:noname ( addr u -- ) 714 + 2dup + 2 - c@ $F0 and 715 + case $80 of msg-dec-sig? endof 716 + drop msg-sig? 717 + 0 endcase ; ' message 2dup 718 +msging-class is start-req 719 +msging-class is nest-sig 720 +msg-class is start-req 721 +msg-class is nest-sig 696 722 697 723 ' context-table is gen-table 698 724 699 725 also }scope 700 726 701 727 msging-table $save 702 728 ................................................................................ 870 896 fs-inbuf $@len IF 871 897 msg( ." Closing file " fs-path $@ .chat-file forth:cr ) 872 898 fs-flush 873 899 THEN 874 900 ; msgfs-class is fs-close 875 901 :noname ( perm -- ) 876 902 perm%msg and 0= !!msg-perm!! 877 -; msgfs-class to fs-perm? 903 +; msgfs-class is fs-perm? 878 904 :noname ( -- date perm ) 879 905 64#0 0 ; msgfs-class is fs-get-stat 880 906 :noname ( date perm -- ) 881 907 drop 64drop ; msgfs-class is fs-set-stat 882 908 ' file-start-req msgfs-class is start-req 883 909 884 910 \ message composer 885 911 886 912 : group, ( addr u -- ) 887 913 $, msg-group ; 888 -: <msg ( -- ) 889 - \G start a msg block 890 - msg-group$ $@ group, message sign[ msg-start ; 891 914 : msg> ( -- ) 892 915 \G end a message block by adding a signature 893 916 ]pksign ; 894 917 : msg-otr> ( -- ) 895 918 \G end a message block by adding a short-time signature 896 919 now>otr ]pksign ; 897 920 : msg-log, ( -- addr u ) ................................................................................ 1275 1298 \U away [<action>] send string or "away from keyboard" as action 1276 1299 \G away: send string or "away from keyboard" as action 1277 1300 dup 0= IF 2drop 1278 1301 away? IF "I'm back" ELSE "Away from keyboard" THEN 1279 1302 away? 0= to away? 1280 1303 THEN 1281 1304 [: $, msg-action ;] send-avalanche ; 1305 +synonym /back /away 1282 1306 1283 1307 : /otr ( addr u -- ) 1284 1308 \U otr on|off|message turn otr mode on/off (or one-shot) 1285 1309 2dup s" on" str= >r 1286 1310 2dup s" off" str= r@ or IF 2drop r> otr-mode ! 1287 1311 <info> ." === " otr-mode @ IF ." enter" ELSE ." leave" THEN 1288 1312 ." otr mode ===" <default> forth:cr