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 Side-by-Side Diffs Ignore Whitespace Patch

Changes to err.fs.

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

Changes to msg.fs.

    40     40       \G forward message to all next nodes of that message group
    41     41       { d: msgx }
    42     42       msg-group-o .msg:peers[] $@
    43     43       bounds ?DO  I @ o <> IF  msgx I @ .avalanche-to  THEN
    44     44       cell +LOOP ;
    45     45   
    46     46   Variable msg-group$
    47         -Variable msg-keys[]
    48     47   User replay-mode
    49     48   User skip-sig?
    50     49   
    51     50   Sema msglog-sema
    52     51   
    53     52   : ?msg-context ( -- o )
    54     53       msging-context @ dup 0= IF
................................................................................
   323    322   	c:0key I msg-group-o .msg:log[] $[]@ sigonly@ >hash
   324    323   	2dup hashtmp over str= IF  2drop true  UNLOOP   EXIT
   325    324   	ELSE  ( 2dup 85type ."  <> " hashtmp over 85type )  THEN
   326    325       LOOP
   327    326       2drop false ;
   328    327   
   329    328   : msg-key! ( addr u -- )
   330         -    0 msg-keys[] [: rot >r 2over str= r> or ;] $[]map
   331         -    IF  2drop  ELSE  msg-keys[] $+[]!  THEN ;
          329  +    0 msg-group-o .msg:keys[] [: rot >r 2over str= r> or ;] $[]map
          330  +    IF  2drop  ELSE  ." msg-key+ " 2dup 85type forth:cr
          331  +	$make msg-group-o .msg:keys[] >back  THEN ;
   332    332   
   333    333   \ message commands
   334    334   
   335    335   scope{ net2o-base
   336    336   
   337    337   \g 
   338    338   \g ### message commands ###
................................................................................
   691    691       skip-sig? @ IF   quicksig( pk-quick-sig? )else( pk-date? )
   692    692       ELSE  pk-sig?  THEN ;
   693    693   
   694    694   \ encrypt+sign
   695    695   \ features: signature verification only when key is known
   696    696   \           identity only revealed when correctly decrypted
   697    697   
   698         -: modkey> ( dest -- )
   699         -    get0 over ge25519-unpack- 0= !!no-ed-key!!
          698  +: modkey> ( src dest -- )
          699  +    ( over keysize 85type ."  -[" )
          700  +    get0 rot ge25519-unpack- 0= !!no-ed-key!!
   700    701       voutkey keysize c:hash@
          702  +    ( voutkey keysize 85type ." ]> " )
   701    703       sct0 voutkey 32b>sc25519
   702    704       get1 get0 sct0 ge25519*
   703    705       dup get1 ge25519-pack
   704         -    $80 swap $1F + xorc! ;
          706  +    $80 swap ( over ) $1F + xorc!
          707  +    ( keysize 85type forth:cr ) ;
   705    708   : msg-dec-sig? ( addr u -- addr' u' flag )
   706         -    sigpksize# -
   707         -    msg-keys[] $@ bounds U+DO
   708         -	2dup I $@ decrypt$  IF
   709         -	    2over + sigpksize# over date-sig? nip nip  IF
   710         -		2dup + >r 2swap + r> sigpksize# move
   711         -		2dup + modkey>  sigpksize# +
   712         -		true unloop  EXIT  THEN  THEN
          709  +    sigpksize# - 2dup + -5 { pksig err }
          710  +    msg-group-o .msg:keys[] $@ bounds U+DO
          711  +	2dup $make { w^ msg }
          712  +	msg $@ I $@ decrypt$ IF
          713  +	    pksig sigpksize# over date-sig? to err
          714  +	    pksig pktmp modkey>
          715  +	    err 0= IF
          716  +		pksig sigpksize# keysize /string
          717  +		pktmp keysize
          718  +		2rot [: type type type ;] $tmp
          719  +		2dup + 2 - $7F swap andc!
          720  +		msg $free
          721  +		err  unloop  EXIT  THEN  THEN
   713    722   	2drop
          723  +	msg $free
   714    724       cell +LOOP
   715         -    sigpksize# +  false ;
          725  +    sigpksize# +  err ;
   716    726   
   717    727   : msg-dec?-sig? ( addr u -- addr' u' flag )
   718    728       2dup 2 - + c@ $80 and IF  msg-dec-sig?  ELSE  msg-sig?  THEN ;
   719    729   
   720    730   \ generate an encryt+sign packet
   721    731   
   722    732   : >modkey ( dstsk dstpk sk -- )
          733  +    \ dup pad sct0 rot raw>sc25519
          734  +    \ get0 sct0 ge25519*base
          735  +    \ get0 ge25519-pack pad keysize 85type ."  -["
   723    736       voutkey keysize c:hash@
          737  +    ( voutkey keysize 85type ." ]> " )
   724    738       sct0 voutkey 32b>sc25519
   725    739       sct1 sct0 sc25519/
   726    740       sct0 swap raw>sc25519
   727    741       sct2 sct0 sct1 sc25519*
   728    742       get0 sct2 ge25519*base
   729         -    get0 ge25519-pack
          743  +    ( dup ) get0 ge25519-pack
          744  +    ( keysize 85type forth:cr )
   730    745       sct2 sc25519>32b ;
   731    746   
   732    747   : ]encpksign ( -- )
   733         -    +zero16 nest$ msg-keys[] dup $[]# 1- swap $[]@ encrypt$
          748  +    +zero16 nest$ msg-group-o .msg:keys[] dup $[]# 1- swap $[]@ encrypt$
   734    749       sigdate +date
   735    750       sktmp pktmp sk@ drop >modkey
   736    751       [:  pktmp keysize forth:type  sigdate datesize# forth:type
   737    752   	sig-params 2drop sktmp pktmp ed-sign
   738    753   	2dup + 1- $80 swap orc! forth:type
   739    754   	keysize forth:emit ;] ']sign ;
   740    755   
................................................................................
  1498   1513   	;] (send-avalanche) drop .chat save-msgs&
  1499   1514       ;] !wrapper ; is /otrify
  1500   1515   
  1501   1516   :noname ( addr u -- )
  1502   1517       msg-group-o .msg:-lock
  1503   1518       word-args ['] args>keylist execute-parsing
  1504   1519       [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche
  1505         -    vkey keysize msg-keys[] $+[]!
         1520  +    vkey keysize msg-group-o .msg:keys[] $+[]!
  1506   1521       msg-group-o .msg:+lock
  1507   1522   ; is /lock
  1508   1523   :noname ( addr u -- )
  1509   1524       2drop msg-group-o .msg:-lock ; is /unlock
  1510   1525   
  1511   1526   :noname ( addr u -- )
  1512   1527       2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ; is /bye