Check-in [9a4250484f]
Not logged in
Home Timeline Files Branches Tags Tickets Wiki Login Impressum Datenschutzerklärung

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: 9a4250484fc93e10543ea1fa3643ddea4589e9aa
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
Side-by-Side Diff Ignore Whitespace Patch
Changes to cmd.fs.
︙
691
692
693
694
695
696
697
698

699
700
701
702
703
704
705

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@ 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$ ;

: 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

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
141

142




143
144
145
146
147
148
149

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= ;

: 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
    \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
171

172
173
174
175
176
177
178

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
    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
    get0 pktmp ge25519-unpack- 0= !!no-ed-key!!
    sct2 sk raw>sc25519
︙
Changes to msg.fs.
︙
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

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 ;
+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
\ encrypt+sign
\ features: signature verification only when key is known
\           identity only revealed when correctly decrypted
msg-class to nest-sig

: 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
    sigpksize# -
	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 ;
    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
877

878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897

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

\ message composer

: group, ( addr u -- )
    $, msg-group ;
: <msg ( -- )
    \G start a msg block
    msg-group$ $@ group, message sign[ msg-start ;
: 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

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
︙
Fossil 2.26 [611144ddd9] 2025-05-16 13:52:48