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.523 |
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 692 693 694 695 696 697 | : cmd> ( -- addr u ) +zero16 \ add space for checksum cmd-resolve> ; : cmd>nest ( -- addr u ) cmd> 2dup mykey-encrypt$ ; : cmd>tmpnest ( -- addr u ) | | | 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 | : cmd> ( -- addr u ) +zero16 \ add space for checksum cmd-resolve> ; : cmd>nest ( -- addr u ) cmd> 2dup mykey-encrypt$ ; : cmd>tmpnest ( -- addr u ) 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$ ; : cmdnest ( addr u -- ) mykey-decrypt$ IF own-crypt-val do-nest ELSE |
︙ | ︙ |
Changes to ed25519-donna.fs.
︙ | ︙ | |||
50 51 52 53 54 55 56 57 58 59 60 61 62 63 | $30 uvar sct2 $30 uvar sct3 $C0 uvar get0 $C0 uvar get1 $40 uvar hashtmp $40 uvar sigtmp $20 uvar pktmp keccak# uvar hstatetmp cell uvar task-id end-class edbuf-c : init-ed25519 edbuf @ IF task-id @ up@ = ?EXIT THEN [: edbuf-c new edbuf ! ;] crypto-a with-allocater | > | 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | $30 uvar sct2 $30 uvar sct3 $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 edbuf @ IF task-id @ up@ = ?EXIT THEN [: edbuf-c new edbuf ! ;] crypto-a with-allocater |
︙ | ︙ | |||
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 | pk sigbuf $20 + $20 move sigbuf $40 >hash \ z=hash(r,pk,message) 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 clean-ed25519 sigbuf $40 ; \ r,s UValue no-ed-check? 0 to no-ed-check? : 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 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 sig sigbuf $40 + 32b= ; | > > > | > > > > | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | pk sigbuf $20 + $20 move sigbuf $40 >hash \ z=hash(r,pk,message) 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? : 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= ; : 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 \G contains the hash of the message. c:key@ hstatetmp c:key# move \ we need this twice - move away |
︙ | ︙ | |||
161 162 163 164 165 166 167 168 169 170 | \ quick check failed, do slow check \ old signatures had a different skh 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 clean-ed25519 ; : ed-quick-verify ( skh sk sig pk -- flag ) \ message digest is in keccak state | > | | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 | \ quick check failed, do slow check \ old signatures had a different skh 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 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 get0 pktmp ge25519-unpack- 0= !!no-ed-key!! sct2 sk raw>sc25519 |
︙ | ︙ |
Changes to msg.fs.
︙ | ︙ | |||
656 657 658 659 660 661 662 | net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest $> nest-sig ?dup-0=-IF handle-msg ELSE replay-mode @ IF drop 2drop ELSE !!sig!! THEN \ balk on all wrong signatures THEN ; | < < < < < < | < | > | < > > > > > > > | < < | | > > > > > > > | > > > | | > > > | | > | > > | | > > > | > | > > > > | > > > > | 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 | net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest $> 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 ; \ 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 ) 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 msging-table $save |
︙ | ︙ | |||
870 871 872 873 874 875 876 | fs-inbuf $@len IF msg( ." Closing file " fs-path $@ .chat-file forth:cr ) fs-flush THEN ; msgfs-class is fs-close :noname ( perm -- ) perm%msg and 0= !!msg-perm!! | | < < < | 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 | fs-inbuf $@len IF msg( ." Closing file " fs-path $@ .chat-file forth:cr ) fs-flush THEN ; msgfs-class is fs-close :noname ( perm -- ) perm%msg and 0= !!msg-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 \ message composer : group, ( addr u -- ) $, msg-group ; : msg> ( -- ) \G end a message block by adding a signature ]pksign ; : msg-otr> ( -- ) \G end a message block by adding a short-time signature now>otr ]pksign ; : msg-log, ( -- addr u ) |
︙ | ︙ | |||
1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 | \U away [<action>] send string or "away from keyboard" as action \G away: send string or "away from keyboard" as action dup 0= IF 2drop away? IF "I'm back" ELSE "Away from keyboard" THEN away? 0= to away? THEN [: $, msg-action ;] send-avalanche ; : /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 ! <info> ." === " otr-mode @ IF ." enter" ELSE ." leave" THEN ." otr mode ===" <default> forth:cr | > | 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 | \U away [<action>] send string or "away from keyboard" as action \G away: send string or "away from keyboard" as action 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 ! <info> ." === " otr-mode @ IF ." enter" ELSE ." leave" THEN ." otr mode ===" <default> forth:cr |
︙ | ︙ |