Check-in [94988e190b]
Not logged in

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

Overview
Comment:Locked down chat works
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 94988e190bafedce1c902440fcabe51f83846576
User & Date: bernd 2019-07-13 00:01:13
Context
2019-07-13
11:02
Fix your-0key problem check-in: e332493556 user: bernd tags: trunk
00:01
Locked down chat works check-in: 94988e190b user: bernd tags: trunk
2019-07-11
17:52
Bump version number check-in: 77e7c31c60 user: bernd tags: trunk, 0.9.0-20190711
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to classes.fs.

   133    133   end-class msging-class
   134    134   
   135    135   
   136    136   cmd-class class{ msg
   137    137       $10 +field dummy
   138    138       $value: name$ \ group name
   139    139       $value: id$
          140  +    $value: msg$  \ decrypted message
   140    141       field: peers[]
   141    142       field: keys[]
   142    143       field: log[]
   143    144       field: mode
   144    145       \ mode bits:
   145    146       1 4 bits: otr# redate# lock# visible#
   146    147       : bit-ops: ( bit -- )

Changes to msg.fs.

    70     70   		    1+
    71     71   		THEN
    72     72   	REPEAT  drop ;] msglog-sema c-section ;
    73     73   
    74     74   : serialize-log ( addr u -- $addr )
    75     75       [: bounds ?DO
    76     76   	    I $@ check-date 0= IF  net2o-base:$, net2o-base:nestsig
    77         -	    ELSE   2drop  THEN
           77  +	    ELSE   msg( ." removed entry " dump )else( 2drop )  THEN
    78     78         cell +LOOP ;]
    79     79       gen-cmd ;
    80     80   
    81     81   Variable saved-msg$
    82     82   64Variable saved-msg-ticks
    83     83   
    84     84   : save-msgs ( group-o -- ) to msg-group-o
................................................................................
   457    457       <info> utf8emit <default> ; msg-class is msg:like
   458    458   :noname ( addr u -- )
   459    459       0 .v-dec$ dup IF
   460    460   	msg-key!  msg-group-o .msg:+lock
   461    461   	<info> ." chat is locked" <default>
   462    462       ELSE  2drop
   463    463   	<err> ." locked out of chat" <default>
   464         -    THEN ;   msg-class is msg:lock
          464  +    THEN ; msg-class is msg:lock
   465    465   :noname ( -- )  msg-group-o .msg:-lock
   466    466       <info> ." chat is free for all" <default> ; msg-class is msg:unlock
   467    467   ' drop msg-class is msg:away
   468    468   :noname ( addr u type -- )
   469    469       space <warn> case
   470    470   	msg:image#     of  ." img["      85type  endof
   471    471   	msg:thumbnail# of  ." thumb["    85type  endof
................................................................................
   637    637       groups>sort[]
   638    638       group-list[] $@ bounds ?DO  I @ .chatgroup  cell +LOOP ;
   639    639   
   640    640   : ?pkgroup ( addr u -- addr u )
   641    641       \ if no group has been selected, use the pubkey as group
   642    642       last# 0= IF  2dup + sigpksize# - keysize >group  THEN ;
   643    643   
   644         -: handle-msg ( addr u -- )
   645         -    ?pkgroup >msg-log
   646         -    2dup d0<> \ do something if it is new
   647         -    IF  replay-mode @ 0= IF
   648         -	    2dup show-msg
   649         -	    2dup parent .push-msg
   650         -	THEN
   651         -    THEN  2drop ;
          644  +: handle-msg ( addr-o u-o addr-dec u-dec -- )
          645  +    ?pkgroup 2swap >msg-log
          646  +    2dup d0<> replay-mode @ 0= and \ do something if it is new
          647  +    IF
          648  +	2over show-msg
          649  +	2dup parent .push-msg
          650  +    THEN  2drop 2drop ;
   652    651   
   653    652   \g 
   654    653   \g ### messaging commands ###
   655    654   \g 
   656    655   
   657    656   scope{ net2o-base
   658    657   
................................................................................
   677    676       $> $make
   678    677       <event last-msg 2@ e$, elit, o elit, msg-group-o elit, :>chat-reconnect
   679    678       parent .wait-task @ ?query-task over select event> ;
   680    679   +net2o: msg-last? ( start end n -- ) 64>n msg:last? ;
   681    680   +net2o: msg-last ( $:[tick0,msgs,..tickn] n -- ) 64>n msg:last ;
   682    681   
   683    682   net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
   684         -    $> nest-sig ?dup-0=-IF
          683  +    $> 2dup nest-sig ?dup-0=-IF
   685    684   	handle-msg
   686         -   ELSE  replay-mode @ IF  drop 2drop
          685  +    ELSE  replay-mode @ IF  drop 2drop 2drop
   687    686   	ELSE  !!sig!!  THEN \ balk on all wrong signatures
   688    687       THEN ;
   689    688   
   690    689   : msg-sig? ( addr u -- addr u' flag )
   691    690       skip-sig? @ IF   quicksig( pk-quick-sig? )else( pk-date? )
   692    691       ELSE  pk-sig?  THEN ;
   693    692   
................................................................................
   699    698       sigpksize# - 2dup + { pksig }
   700    699       msg-group-o .msg:keys[] $@ bounds U+DO
   701    700   	I $@ 2over pksig decrypt-sig?
   702    701   	dup -5 <> IF
   703    702   	    >r 2nip r> unloop  EXIT
   704    703   	THEN  drop 2drop
   705    704       cell +LOOP
   706         -    sigpksize# +  -5 ;
          705  +    sigpksize# +  -5  replay-mode @ 0= and ;
   707    706   
   708    707   : msg-dec?-sig? ( addr u -- addr' u' flag )
   709    708       2dup 2 - + c@ $80 and IF  msg-dec-sig?  ELSE  msg-sig?  THEN ;
   710    709   
   711    710   \ generate an encryt+sign packet
   712    711   
   713    712   : ]encpksign ( -- )
................................................................................
  1006   1005   	THEN  <info>  THEN
  1007   1006       sigpksize# - 2dup + sigpksize# >$  c-state off
  1008   1007       nest-cmd-loop msg:end ;
  1009   1008   ' msg-tdisplay msg-class is msg:display
  1010   1009   ' msg-tdisplay msg-notify-class is msg:display
  1011   1010   : msg-tredisplay ( n -- )
  1012   1011       reset-time
  1013         -    msg-group-o .msg:mode dup @ msg:otr# invert and swap
         1012  +    msg-group-o >o msg:?otr msg:-otr o> >r
  1014   1013       [:  cells >r msg-log@ 2dup { log u }
  1015   1014   	dup r> - 0 max /string bounds ?DO
  1016   1015   	    I log - cell/ to log#
  1017   1016   	    I $@ { d: msgt }
  1018   1017   	    msgt ['] msg:display catch IF  ." invalid entry" cr
  1019   1018   		2drop  THEN
  1020   1019   	cell +LOOP
  1021         -	log free throw ;] !wrapper ;
         1020  +	log free throw ;] catch
         1021  +    r> IF  msg-group-o .msg:+otr  THEN  throw ;
  1022   1022   ' msg-tredisplay msg-class is msg:redisplay
  1023   1023   
  1024   1024   msg-class class
  1025   1025   end-class textmsg-class
  1026   1026   
  1027   1027   ' 2drop textmsg-class is msg:start
  1028   1028   :noname '#' emit type ; textmsg-class is msg:tag
................................................................................
  1353   1353       \G otrify: turn an older message of yours into an OTR message
  1354   1354   umethod /lock ( addr u -- )
  1355   1355       \U lock {@nick}         lock down
  1356   1356       \G lock: lock down communication to list of nicks
  1357   1357   umethod /unlock ( addr u -- )
  1358   1358       \U unlock               stop lock down
  1359   1359       \G unlock: stop lock down
         1360  +umethod /lock? ( addr u -- )
         1361  +    \U lock?                check lock status
         1362  +    \G lock?: report lock status
  1360   1363   umethod /bye ( addr u -- )
  1361   1364       \U bye
  1362   1365       \G bye: leaves the current chat
  1363   1366   umethod /chat ( addr u -- )
  1364   1367       \U chat [group][@user]  switch/connect chat
  1365   1368       \G chat: switch to chat with user or group
  1366   1369   umethod /split ( addr u -- )
................................................................................
  1482   1485       word-args ['] args>keylist execute-parsing
  1483   1486       [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche
  1484   1487       vkey keysize $make msg-group-o .msg:keys[] >back
  1485   1488       msg-group-o .msg:+lock
  1486   1489   ; is /lock
  1487   1490   :noname ( addr u -- )
  1488   1491       2drop msg-group-o .msg:-lock ; is /unlock
         1492  +:noname ( addr u -- )
         1493  +    2drop msg-group-o .msg:?lock 0= IF  ." un"  THEN  ." locked" forth:cr
         1494  +; is /lock?
  1489   1495   
  1490   1496   :noname ( addr u -- )
  1491   1497       2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ; is /bye
  1492   1498   }scope
  1493   1499   
  1494   1500   : ?slash ( addr u -- addr u flag )
  1495   1501       over c@ dup '/' = swap '\' = or ;

Changes to rng.fs.

    50     50       \G legacy version of read-rnd
    51     51       s" /dev/urandom" r/o open-file throw >r
    52     52       tuck r@ read-file r> close-file throw
    53     53       throw <> !!insuff-rnd!! ;
    54     54   
    55     55   : read-rnd ( addr u -- )
    56     56       \G read in entropy bytes from the systems entropy source
    57         -    [ [defined] getentropy [defined] linux and [IF]
    58         -	"getentropy" "libc.so.6" open-lib lib-sym 0<>
           57  +    [ [defined] getrandom [defined] linux and [IF]
           58  +	"getrandom" "libc.so.6" open-lib lib-sym 0<>
    59     59       [ELSE] false [THEN] ]
    60     60       [IF]
    61         -	bounds U+DO \ getentropy reads $100 bytes at maximum
    62         -	    I I' over - $100 umin getentropy
           61  +	bounds U+DO \ getrandom reads $100 bytes at maximum
           62  +	    I I' over - $100 umin 0 getrandom
    63     63   	    dup -1 = IF  errno #38 = IF  drop
    64     64   		    \ oops, we don't have getentropy in the kernel
    65     65   		    I I' over - $100 umin read-urnd
    66     66   		ELSE  BUT  THEN \ resolve the other IF
    67     67   		?ior  THEN
    68     68   	$100 +LOOP
    69     69       [ELSE]