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
|
| ︙ | ︙ |