Check-in [0e3fe94f9a]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Work on locked chat
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:0e3fe94f9a488b9a18ec0014f24c6674b0f05fc7
User & Date: bernd 2019-07-10 23:48:54
Context
2019-07-11
15:21
More work on lock mode check-in: a79788a637 user: bernd tags: trunk
2019-07-10
23:48
Work on locked chat check-in: 0e3fe94f9a user: bernd tags: trunk
2019-07-09
22:22
More on locked chat check-in: 604bb8e573 user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to err.fs.

50
51
52
53
54
55
56

57
58
59
60
61
62
63
s" no key file"                  throwcode !!nokey!!
s" invalid Ed25519 key"          throwcode !!no-ed-key!!
s" wrong key size"               throwcode !!keysize!!
s" no signature appended"        throwcode !!no-sig!!
s" future signature"             throwcode !!new-sig!!
s" expired signature"            throwcode !!old-sig!!
s" invalid signature"            throwcode !!inv-sig!!

s" no temporary key"             throwcode !!no-tmpkey!!
s" generic stack empty"          throwcode !!stack-empty!!
s" String stack full"            throwcode !!string-full!!
s" String stack empty"           throwcode !!string-empty!!
s" Object stack full"            throwcode !!object-full!!
s" Object stack empty"           throwcode !!object-empty!!
s" Unknown crypto function"      throwcode !!unknown-crypt!!







>







50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
s" no key file"                  throwcode !!nokey!!
s" invalid Ed25519 key"          throwcode !!no-ed-key!!
s" wrong key size"               throwcode !!keysize!!
s" no signature appended"        throwcode !!no-sig!!
s" future signature"             throwcode !!new-sig!!
s" expired signature"            throwcode !!old-sig!!
s" invalid signature"            throwcode !!inv-sig!!
s" failed to open message"       throwcode !!msg-locked!!
s" no temporary key"             throwcode !!no-tmpkey!!
s" generic stack empty"          throwcode !!stack-empty!!
s" String stack full"            throwcode !!string-full!!
s" String stack empty"           throwcode !!string-empty!!
s" Object stack full"            throwcode !!object-full!!
s" Object stack empty"           throwcode !!object-empty!!
s" Unknown crypto function"      throwcode !!unknown-crypt!!

Changes to msg.fs.

40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
...
323
324
325
326
327
328
329
330
331

332
333
334
335
336
337
338
...
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
729

730
731
732
733
734
735
736
737
738
739
740
....
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
    \G forward message to all next nodes of that message group
    { d: msgx }
    msg-group-o .msg:peers[] $@
    bounds ?DO  I @ o <> IF  msgx I @ .avalanche-to  THEN
    cell +LOOP ;

Variable msg-group$
Variable msg-keys[]
User replay-mode
User skip-sig?

Sema msglog-sema

: ?msg-context ( -- o )
    msging-context @ dup 0= IF
................................................................................
	c:0key I msg-group-o .msg:log[] $[]@ sigonly@ >hash
	2dup hashtmp over str= IF  2drop true  UNLOOP   EXIT
	ELSE  ( 2dup 85type ."  <> " hashtmp over 85type )  THEN
    LOOP
    2drop false ;

: msg-key! ( addr u -- )
    0 msg-keys[] [: rot >r 2over str= r> or ;] $[]map
    IF  2drop  ELSE  msg-keys[] $+[]!  THEN ;


\ message commands

scope{ net2o-base

\g 
\g ### message commands ###
................................................................................
    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 ;

: msg-dec?-sig? ( addr u -- addr' u' flag )
    2dup 2 - + c@ $80 and IF  msg-dec-sig?  ELSE  msg-sig?  THEN ;

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

: ]encpksign ( -- )
    +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
	2dup + 1- $80 swap orc! forth:type
	keysize forth:emit ;] ']sign ;

................................................................................
	;] (send-avalanche) drop .chat save-msgs&
    ;] !wrapper ; is /otrify

:noname ( addr u -- )
    msg-group-o .msg:-lock
    word-args ['] args>keylist execute-parsing
    [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche
    vkey keysize msg-keys[] $+[]!
    msg-group-o .msg:+lock
; is /lock
:noname ( addr u -- )
    2drop msg-group-o .msg:-lock ; is /unlock

:noname ( addr u -- )
    2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ; is /bye







<







 







|
|
>







 







|
>
|

>



|
>

|
|
>
|
|
<
>
>
|
>
>
>
>
|

>

|







>
>
>

>





|
>



|







 







|







40
41
42
43
44
45
46

47
48
49
50
51
52
53
...
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
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
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
....
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
    \G forward message to all next nodes of that message group
    { d: msgx }
    msg-group-o .msg:peers[] $@
    bounds ?DO  I @ o <> IF  msgx I @ .avalanche-to  THEN
    cell +LOOP ;

Variable msg-group$

User replay-mode
User skip-sig?

Sema msglog-sema

: ?msg-context ( -- o )
    msging-context @ dup 0= IF
................................................................................
	c:0key I msg-group-o .msg:log[] $[]@ sigonly@ >hash
	2dup hashtmp over str= IF  2drop true  UNLOOP   EXIT
	ELSE  ( 2dup 85type ."  <> " hashtmp over 85type )  THEN
    LOOP
    2drop false ;

: msg-key! ( addr u -- )
    0 msg-group-o .msg:keys[] [: rot >r 2over str= r> or ;] $[]map
    IF  2drop  ELSE  ." msg-key+ " 2dup 85type forth:cr
	$make msg-group-o .msg:keys[] >back  THEN ;

\ message commands

scope{ net2o-base

\g 
\g ### message commands ###
................................................................................
    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> ( src dest -- )
    ( over keysize 85type ."  -[" )
    get0 rot ge25519-unpack- 0= !!no-ed-key!!
    voutkey keysize c:hash@
    ( voutkey keysize 85type ." ]> " )
    sct0 voutkey 32b>sc25519
    get1 get0 sct0 ge25519*
    dup get1 ge25519-pack
    $80 swap ( over ) $1F + xorc!
    ( keysize 85type forth:cr ) ;
: msg-dec-sig? ( addr u -- addr' u' flag )
    sigpksize# - 2dup + -5 { pksig err }
    msg-group-o .msg:keys[] $@ bounds U+DO
	2dup $make { w^ msg }
	msg $@ I $@ decrypt$ IF
	    pksig sigpksize# over date-sig? to err

	    pksig pktmp modkey>
	    err 0= IF
		pksig sigpksize# keysize /string
		pktmp keysize
		2rot [: type type type ;] $tmp
		2dup + 2 - $7F swap andc!
		msg $free
		err  unloop  EXIT  THEN  THEN
	2drop
	msg $free
    cell +LOOP
    sigpksize# +  err ;

: msg-dec?-sig? ( addr u -- addr' u' flag )
    2dup 2 - + c@ $80 and IF  msg-dec-sig?  ELSE  msg-sig?  THEN ;

\ generate an encryt+sign packet

: >modkey ( dstsk dstpk sk -- )
    \ dup pad sct0 rot raw>sc25519
    \ get0 sct0 ge25519*base
    \ get0 ge25519-pack pad keysize 85type ."  -["
    voutkey keysize c:hash@
    ( voutkey keysize 85type ." ]> " )
    sct0 voutkey 32b>sc25519
    sct1 sct0 sc25519/
    sct0 swap raw>sc25519
    sct2 sct0 sct1 sc25519*
    get0 sct2 ge25519*base
    ( dup ) get0 ge25519-pack
    ( keysize 85type forth:cr )
    sct2 sc25519>32b ;

: ]encpksign ( -- )
    +zero16 nest$ msg-group-o .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
	2dup + 1- $80 swap orc! forth:type
	keysize forth:emit ;] ']sign ;

................................................................................
	;] (send-avalanche) drop .chat save-msgs&
    ;] !wrapper ; is /otrify

:noname ( addr u -- )
    msg-group-o .msg:-lock
    word-args ['] args>keylist execute-parsing
    [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche
    vkey keysize msg-group-o .msg:keys[] $+[]!
    msg-group-o .msg:+lock
; is /lock
:noname ( addr u -- )
    2drop msg-group-o .msg:-lock ; is /unlock

:noname ( addr u -- )
    2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ; is /bye