Check-in [9a4250484f]
Not logged in

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

Changes to cmd.fs.

   691    691   
   692    692   : cmd> ( -- addr u )
   693    693       +zero16 \ add space for checksum
   694    694       cmd-resolve> ;
   695    695   
   696    696   : cmd>nest ( -- addr u ) cmd> 2dup mykey-encrypt$ ;
   697    697   : cmd>tmpnest ( -- addr u )
   698         -    cmd> 2dup tmpkey@ keysize umin
          698  +    cmd> 2dup tmpkey@ key|
   699    699       key( ." tmpnest key: " 2dup 85type forth:cr ) encrypt$ ;
   700    700   : cmd>encnest ( -- addr u )
   701    701       cmd> 2dup tmpkey@
   702    702       key( ." tmpnest key: " 2dup 85type forth:cr ) encrypt$ ;
   703    703   
   704    704   : cmdnest ( addr u -- )  mykey-decrypt$
   705    705       IF  own-crypt-val do-nest  ELSE

Changes to ed25519-donna.fs.

    50     50       $30 uvar sct2
    51     51       $30 uvar sct3
    52     52       $C0 uvar get0
    53     53       $C0 uvar get1
    54     54       $40 uvar hashtmp
    55     55       $40 uvar sigtmp
    56     56       $20 uvar pktmp
           57  +    $20 uvar sktmp
    57     58       keccak# uvar hstatetmp
    58     59       cell uvar task-id
    59     60   end-class edbuf-c
    60     61   
    61     62   : init-ed25519
    62     63       edbuf @ IF  task-id @ up@ = ?EXIT  THEN
    63     64       [: edbuf-c new edbuf ! ;] crypto-a with-allocater
................................................................................
   116    117       pk sigbuf $20 + $20 move
   117    118       sigbuf $40 >hash             \ z=hash(r,pk,message)
   118    119       sct1 hashtmp 64b>sc25519     \ sct1 is z
   119    120       sct2 sk raw>sc25519          \ sct2 is sk
   120    121       sct1 sct1 sct2 sc25519*
   121    122       sct1 sct1 sct3 sc25519+      \ s=z*sk+k
   122    123       sigbuf $20 + sct1 sc25519>32b
          124  +    hstatetmp c:key@ c:key# move \ restore state
   123    125       clean-ed25519 sigbuf $40 ;   \ r,s
   124    126   
   125    127   UValue no-ed-check?
   126    128   0 to no-ed-check?
   127    129   
   128    130   : ed-check? { sig pk -- flag }
   129    131       \G check a message: the keccak state contains the hash of the message.
   130    132       \G The unpacked pk is in get0, so this word can be used for batch checking.
   131    133       \G sig and pk need to be aligned properly, ed-verify does that alignment
   132    134       no-ed-check? IF  true  EXIT  THEN
          135  +    c:key@ hstatetmp c:key# move   \ we need this to be preserved
   133    136       sig hashtmp $20 move  pk hashtmp $20 + $20 move
   134    137       hashtmp $40 c:shorthash hashtmp $40 c:hash@ \ z=hash(r+pk+message)
   135    138       sct2 hashtmp 64b>sc25519       \ sct2 is z
   136    139       sct3 sig $20 + raw>sc25519     \ sct3 is s
   137    140       get1 get0 sct2 sct3 ge25519*+  \ base*s-pk*z
   138    141       sigbuf $40 + get1 ge25519-pack \ =r
          142  +    hstatetmp c:key@ c:key# move   \ restore state again
   139    143       sig sigbuf $40 + 32b= ;
   140    144   
   141         -: ed-verify ( sig pk -- flag ) \ message digest is in keccak state
          145  +: sig>align ( sig pk -- )
   142    146       pktmp $20 move  sigtmp $40 move \ align inputs
          147  +    $0F sigtmp $3F + andc! ;
          148  +
          149  +: ed-verify ( sig pk -- flag ) \ message digest is in keccak state
          150  +    sig>align
   143    151       get0 pktmp ge25519-unpack- 0=  IF  false EXIT  THEN \ bad pubkey
   144    152       sigtmp pktmp ed-check? ;
   145    153   
   146    154   : ed-quickcheck? { skh sk sig pk -- flag }
   147    155       \G quick check a message signed by ourself: the keccak state
   148    156       \G contains the hash of the message.
   149    157       c:key@ hstatetmp c:key# move \ we need this twice - move away
................................................................................
   161    169   	\ quick check failed, do slow check
   162    170   	\ old signatures had a different skh
   163    171   	sct3 sig $20 + raw>sc25519     \ sct3 is s
   164    172   	get1 get0 sct2 sct3 ge25519*+  \ base*s-pk*z
   165    173   	sigbuf $40 + get1 ge25519-pack \ =r
   166    174   	sig sigbuf $40 + 32b=
   167    175       THEN
          176  +    hstatetmp c:key@ c:key# move \ restore state again
   168    177       clean-ed25519 ;
   169    178   
   170    179   : ed-quick-verify ( skh sk sig pk -- flag ) \ message digest is in keccak state
   171         -    pktmp $20 move  sigtmp $40 move \ align inputs
          180  +    sig>align
   172    181       get0 pktmp ge25519-unpack- 0=  IF  false EXIT  THEN \ bad pubkey
   173    182       sigtmp pktmp ed-quickcheck? ;
   174    183   
   175    184   : ed-dh { sk pk dest -- secret len }
   176    185       pk pktmp $20 move
   177    186       get0 pktmp ge25519-unpack- 0= !!no-ed-key!!
   178    187       sct2 sk raw>sc25519

Changes to msg.fs.

   656    656   
   657    657   net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
   658    658       $> nest-sig ?dup-0=-IF
   659    659   	handle-msg
   660    660      ELSE  replay-mode @ IF  drop 2drop
   661    661   	ELSE  !!sig!!  THEN \ balk on all wrong signatures
   662    662       THEN ;
   663         -+net2o: msg-nestencsig ( $:enc[cmd]+sig -- ) \g decrypt, chech sig+nest
   664         -    $> dec-nest-sig ?dup-0=-IF
   665         -	handle-msg
   666         -   ELSE  replay-mode @ IF  drop 2drop
   667         -	ELSE  !!sig!!  THEN \ balk on all wrong signatures
   668         -    THEN ;
   669    663   
   670    664   : msg-sig? ( addr u -- addr u' flag )
   671    665       skip-sig? @ IF   quicksig( pk-quick-sig? )else( pk-date? )
   672    666       ELSE  pk-sig?  THEN ;
   673         -' msg-sig? ' message  2dup
   674         -msging-class to start-req
   675         -msging-class to nest-sig
   676         -msg-class to start-req
   677         -msg-class to nest-sig
   678    667   
          668  +\ encrypt+sign
          669  +\ features: signature verification only when key is known
          670  +\           identity only revealed when correctly decrypted
          671  +
          672  +: modkey> ( dest -- )
          673  +    get0 over ge25519-unpack- 0= !!no-ed-key!!
          674  +    voutkey keysize c:hash@
          675  +    sct0 voutkey 32b>sc25519
          676  +    get1 get0 sct0 ge25519*
          677  +    dup get1 ge25519-pack
          678  +    $80 swap $1F + xorc! ;
   679    679   : msg-dec-sig? ( addr u -- addr' u' flag )
   680         -    msg-sig? dup  IF  drop
   681         -	2dup + pktmp keysize move \ move the pk to pktmp
   682         -	get0 pktmp ge25519-unpack- 0= !!no-ed-key!!
   683         -	msg-keys[] $@ bounds U+DO
   684         -	    2dup I $@ crypt-key-init $>align
   685         -	    2dup 0 c:decrypt+auth IF
   686         -		voutkey keysize c:hash@
   687         -		sct0 voutkey 32b>sc25519
   688         -		get1 get0 sct0 ge25519*
   689         -		tf-out get1 ge25519-pack
   690         -		$80 tf-out $1F + xorc!
   691         -		2nip true unloop  EXIT  THEN
   692         -	    2drop
   693         -	cell +LOOP
   694         -	false
   695         -    THEN ;
          680  +    sigpksize# -
          681  +    msg-keys[] $@ bounds U+DO
          682  +	2dup I $@ decrypt$  IF
          683  +	    2over + sigpksize# over date-sig? nip nip  IF
          684  +		2dup + >r 2swap + r> sigpksize# move
          685  +		2dup + modkey>  sigpksize# +
          686  +		true unloop  EXIT  THEN  THEN
          687  +	2drop
          688  +    cell +LOOP
          689  +    sigpksize# +  false ;
          690  +
          691  +\ generate an encryt+sign packet
          692  +
          693  +: >modkey ( dstsk dstpk sk -- )
          694  +    voutkey keysize c:hash@
          695  +    sct0 voutkey 32b>sc25519
          696  +    sct1 sct0 sc25519/
          697  +    sct0 swap raw>sc25519
          698  +    sct2 sct0 sct1 sc25519*
          699  +    get0 sct2 ge25519*base
          700  +    get0 ge25519-pack
          701  +    sct2 sc25519>32b ;
          702  +
          703  +: ]encpksig ( -- )
          704  +    +zero16 nest$ msg-keys[] dup $[]# 1- swap $[]@ encrypt$
          705  +    sigdate +date
          706  +    sktmp pktmp sk@ drop >modkey
          707  +    [:  pktmp keysize forth:type  sigdate datesize# forth:type
          708  +	sig-params 2drop sktmp pktmp ed-sign forth:type
          709  +	keysize forth:emit ;] ']sign ;
          710  +
          711  +\ nest-sig for msg/msging classes
          712  +
          713  +:noname ( addr u -- )
          714  +    2dup + 2 - c@ $F0 and
          715  +    case $80 of msg-dec-sig? endof
          716  +	drop  msg-sig?
          717  +	0 endcase ; ' message  2dup
          718  +msging-class is start-req
          719  +msging-class is nest-sig
          720  +msg-class is start-req
          721  +msg-class is nest-sig
   696    722   
   697    723   ' context-table is gen-table
   698    724   
   699    725   also }scope
   700    726   
   701    727   msging-table $save
   702    728   
................................................................................
   870    896       fs-inbuf $@len IF
   871    897   	msg( ." Closing file " fs-path $@ .chat-file forth:cr )
   872    898   	fs-flush
   873    899       THEN
   874    900   ; msgfs-class is fs-close
   875    901   :noname ( perm -- )
   876    902       perm%msg and 0= !!msg-perm!!
   877         -; msgfs-class to fs-perm?
          903  +; msgfs-class is fs-perm?
   878    904   :noname ( -- date perm )
   879    905       64#0 0 ; msgfs-class is fs-get-stat
   880    906   :noname ( date perm -- )
   881    907       drop 64drop ; msgfs-class is fs-set-stat
   882    908   ' file-start-req msgfs-class is start-req
   883    909   
   884    910   \ message composer
   885    911   
   886    912   : group, ( addr u -- )
   887    913       $, msg-group ;
   888         -: <msg ( -- )
   889         -    \G start a msg block
   890         -    msg-group$ $@ group, message sign[ msg-start ;
   891    914   : msg> ( -- )
   892    915       \G end a message block by adding a signature
   893    916       ]pksign ;
   894    917   : msg-otr> ( -- )
   895    918       \G end a message block by adding a short-time signature
   896    919       now>otr ]pksign ;
   897    920   : msg-log, ( -- addr u )
................................................................................
  1275   1298       \U away [<action>]      send string or "away from keyboard" as action
  1276   1299       \G away: send string or "away from keyboard" as action
  1277   1300       dup 0= IF  2drop
  1278   1301   	away? IF  "I'm back"  ELSE  "Away from keyboard"  THEN
  1279   1302   	away? 0= to away?
  1280   1303       THEN
  1281   1304       [: $, msg-action ;] send-avalanche ;
         1305  +synonym /back /away
  1282   1306   
  1283   1307   : /otr ( addr u -- )
  1284   1308       \U otr on|off|message   turn otr mode on/off (or one-shot)
  1285   1309       2dup s" on" str= >r
  1286   1310       2dup s" off" str= r@ or IF   2drop r> otr-mode !
  1287   1311   	<info> ." === " otr-mode @ IF  ." enter"  ELSE  ." leave"  THEN
  1288   1312   	."  otr mode ===" <default> forth:cr