Check-in [a79788a637]
Not logged in

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

Overview
Comment:More work on lock mode
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a79788a637fe0dec5a09983289e1544c8b4127c2
User & Date: bernd 2019-07-11 15:21:13.203
Context
2019-07-11
17:52
Bump version number check-in: 77e7c31c60 user: bernd tags: trunk, 0.9.0-20190711
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
Changes
Unified Diff Ignore Whitespace Patch
Changes to cmd.fs.
675
676
677
678
679
680
681
682
683
684
685
686


687
688
689
690
691
692
693

also net2o-base

: +zero16 ( -- ) "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" +cmdbuf ;
: sign[ ( -- ) neststart# @ nest-stack >stack
    string "\x80\x00" +cmdbuf cmdbuf$ nip neststart# ! ;
: nest[ ( -- ) sign[ +zero16 ; \ add space for IV
: ']sign ( xt -- )
    c:0key nest$
\    ." sign: " 2dup xtype forth:cr
    c:hash $tmp +cmdbuf
    cmd-resolve>  >r cmdbuf$ drop - r> last-signed 2!  nestsig ;


: ]sign ( -- ) ['] .sig ']sign ;
: ]pksign ( -- ) [: .pk .sig ;] ']sign ;

previous

: cmd> ( -- addr u )
    +zero16 \ add space for checksum







|
<
<
|

>
>







675
676
677
678
679
680
681
682


683
684
685
686
687
688
689
690
691
692
693

also net2o-base

: +zero16 ( -- ) "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" +cmdbuf ;
: sign[ ( -- ) neststart# @ nest-stack >stack
    string "\x80\x00" +cmdbuf cmdbuf$ nip neststart# ! ;
: nest[ ( -- ) sign[ +zero16 ; \ add space for IV
: ']nestsig ( xt -- )


    $tmp +cmdbuf
    cmd-resolve>  >r cmdbuf$ drop - r> last-signed 2!  nestsig ;
: ']sign ( xt -- )
    c:0key nest$ c:hash ']nestsig ;
: ]sign ( -- ) ['] .sig ']sign ;
: ]pksign ( -- ) [: .pk .sig ;] ']sign ;

previous

: cmd> ( -- addr u )
    +zero16 \ add space for checksum
Changes to crypt.fs.
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
: pk@ ( -- pk u )
    my-key? .ke-pk $@ ;
: sk@ ( -- sk u )
    my-key? .ke-sk sec@ ;
: sksig@ ( -- sksig u )
    my-key? .ke-sksig sec@ ;
: .sig ( -- )
    +sig sigdate +date sigdate datesize# type
    sig-params ed-sign type keysize emit ;
: .pk ( -- )  pk@ key| type ;
: pk-sig ( addr u -- sig u )
    c:0key c:hash [: .pk .sig ;] $tmp ;

: +sig$ ( addr u -- hostaddr host-u ) [: type .sig ;] $tmp ;
: gen-host ( addr u -- addr' u' )







|







604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
: pk@ ( -- pk u )
    my-key? .ke-pk $@ ;
: sk@ ( -- sk u )
    my-key? .ke-sk sec@ ;
: sksig@ ( -- sksig u )
    my-key? .ke-sksig sec@ ;
: .sig ( -- )
    +sig sigdate +date  sigdate datesize# type
    sig-params ed-sign type keysize emit ;
: .pk ( -- )  pk@ key| type ;
: pk-sig ( addr u -- sig u )
    c:0key c:hash [: .pk .sig ;] $tmp ;

: +sig$ ( addr u -- hostaddr host-u ) [: type .sig ;] $tmp ;
: gen-host ( addr u -- addr' u' )
659
660
661
662
663
664
665

















































666
667
668
669
670
671
672
	tf-out keysize type
	tf-key tf_tweak256++
    ;] $[]map ;
: v-enc-gen ( keylist -- )
    vdhe viv vsessionkey v-enc-loop ;
: v-enc$ ( keylist -- addr u )
    ['] v-enc-gen $tmp ;


















































\\\
Local Variables:
forth-local-words:
    (
     (("event:") definition-starter (font-lock-keyword-face . 1)
      "[ \t\n]" t name (font-lock-function-name-face . 3))







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
	tf-out keysize type
	tf-key tf_tweak256++
    ;] $[]map ;
: v-enc-gen ( keylist -- )
    vdhe viv vsessionkey v-enc-loop ;
: v-enc$ ( keylist -- addr u )
    ['] v-enc-gen $tmp ;

\ message encryption

: >modkey ( dstsk dstpk sk -- )
    \ dup pad sct0 rot raw>sc25519
    \ get0 sct0 ge25519*base
    \ get0 ge25519-pack pad keysize 85type ."  -["
    voutkey state2# c:hash@
    ( voutkey $10 + keysize 85type ." ]> " )
    sct0 voutkey $10 + 32b>sc25519 \ don't use first $10 bytes, used by $encrypt
    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 ;

: modkey> ( src dest -- )
    ( over keysize 85type ."  -[" )
    get0 rot ge25519-unpack- 0= !!no-ed-key!!
    voutkey state2# c:hash@
    ( voutkey keysize 85type ." ]> " )
    sct0 voutkey $10 + 32b>sc25519
    get1 get0 sct0 ge25519*
    dup get1 ge25519-pack
    $80 swap ( over ) $1F + xorc!
    ( keysize 85type forth:cr ) ;
: decrypt-sig? ( key u msg u sig -- addr u sigerr )
    { pksig } $make -5 { w^ msg err }
    msg $@ 2swap decrypt$ IF
	pksig sigpksize# over date-sig? to err  2drop
	err 0= IF
	    pksig pktmp modkey>
	    pksig sigpksize# keysize /string
	    pktmp keysize
	    2rot [: type type type ;] $tmp
	    2dup + 2 - $7F swap andc!
	    msg $free
	    err  EXIT  THEN  THEN
    2drop msg $free  0 0 err ;

: .encsign ( -- )
    +sig sigdate +date
    sktmp pktmp sk@ drop >modkey
    pktmp keysize type  sigdate datesize# type
    sig-params 2drop sktmp pktmp ed-sign
    2dup + 1- $80 swap orc! type
    keysize emit ;

\\\
Local Variables:
forth-local-words:
    (
     (("event:") definition-starter (font-lock-keyword-face . 1)
      "[ \t\n]" t name (font-lock-function-name-face . 3))
Changes to msg.fs.
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
	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 







|







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
	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 
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
756
757
758
759
760
761
    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 ;

\ nest-sig for msg/msging classes

' msg-dec?-sig? ' message  2dup
msging-class is start-req
msging-class is nest-sig
msg-class is start-req







<
<
<
<
<
<
<
<
<
<

|

<
|
<
<
|
<
<
<
<
<
|
|
<

|






<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

|
<
<
<
<
<
>
|







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











: msg-dec-sig? ( addr u -- addr' u' flag )
    sigpksize# - 2dup + { pksig }
    msg-group-o .msg:keys[] $@ bounds U+DO

	I $@ 2over pksig decrypt-sig?


	dup -5 <> IF





	    >r 2nip r> unloop  EXIT
	THEN  drop 2drop

    cell +LOOP
    sigpksize# +  -5 ;

: 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
















: ]encpksign ( -- )
    +zero16 nest$





    0 msg-group-o .msg:keys[] $[]@ encrypt$
    ['] .encsign ']nestsig ;

\ nest-sig for msg/msging classes

' msg-dec?-sig? ' message  2dup
msging-class is start-req
msging-class is nest-sig
msg-class is start-req
1035
1036
1037
1038
1039
1040
1041
1042


1043
1044
1045
1046
1047
1048
1049
    [: last# >r o IF  2dup do-msg-nestsig
      ELSE  2dup display-one-msg  THEN  r> to last#
      0 .avalanche-msg ;] [group] drop notify- ;

\ chat message, text only

: msg-tdisplay ( addr u -- )
    2dup 2 - + c@ $80 and IF  net2o-base:msg-dec-sig? drop  THEN


    sigpksize# - 2dup + sigpksize# >$  c-state off
    nest-cmd-loop msg:end ;
' msg-tdisplay msg-class is msg:display
' msg-tdisplay msg-notify-class is msg:display
: msg-tredisplay ( n -- )
    reset-time
    msg-group-o .msg:mode dup @ msg:otr# invert and swap







|
>
>







997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
    [: last# >r o IF  2dup do-msg-nestsig
      ELSE  2dup display-one-msg  THEN  r> to last#
      0 .avalanche-msg ;] [group] drop notify- ;

\ chat message, text only

: msg-tdisplay ( addr u -- )
    2dup 2 - + c@ $80 and IF  net2o-base:msg-dec-sig? IF
	    2drop <err> ." Undecryptable message" <default> cr  EXIT
	THEN  <info>  THEN
    sigpksize# - 2dup + sigpksize# >$  c-state off
    nest-cmd-loop msg:end ;
' msg-tdisplay msg-class is msg:display
' msg-tdisplay msg-notify-class is msg:display
: msg-tredisplay ( n -- )
    reset-time
    msg-group-o .msg:mode dup @ msg:otr# invert and swap
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
	;] (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







|







1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
	;] (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 $make msg-group-o .msg:keys[] >back
    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