Check-in [2d8a974f37]
Not logged in

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

Overview
Comment:Some more work on locking down chats
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 2d8a974f37d968d30d45f00d3a8a73d3b29eee1f
User & Date: bernd 2019-06-12 21:37:39
Context
2019-06-17
23:00
Group context handling changed check-in: 5cb84dae88 user: bernd tags: trunk
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
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to classes.fs.

   125    125       64field: min-slack
   126    126       64field: max-slack
   127    127       64field: time-offset  \ make timestamps smaller
   128    128       64field: lastdeltat
   129    129   end-class ack-class
   130    130   
   131    131   cmd-class class
          132  +    $value: msging-id$
   132    133       field: peers[]
   133         -    field: msg-keys[]
   134    134       field: silent-last#
   135         -    method dec-nest-sig \ check sig, decrypt and then nest
   136    135   end-class msging-class
   137    136   
   138    137   cmd-class class{ msg
   139    138       $value: id$
   140    139       method start
   141    140       method tag
   142    141       method chain
................................................................................
   147    146       method id
   148    147       method action
   149    148       method coord
   150    149       method otrify
   151    150       method payment
   152    151       method url
   153    152       method like
          153  +    method lock
          154  +    method unlock
   154    155       method away
   155    156       method end
   156    157       method display   \ display one message
   157    158       method redisplay \ display full set
   158    159   }class
   159    160   
   160    161   cmd-class class{ pay

Changes to keys.fs.

  1433   1433       \G this version of get-me fails hard if no key is opened
  1434   1434       get-my-key catch
  1435   1435       case
  1436   1436   	#-56 of .keyinfo true !!no-key-open!! endof
  1437   1437   	#-28 of .keyinfo true !!no-key-open!! endof
  1438   1438   	throw  0
  1439   1439       endcase ;
         1440  +
         1441  +: args>keylist ( -- )
         1442  +    [: nick-key ?dup-IF  >o ke-pk $@ o> keysize umin key-list $+[]!  THEN ;]
         1443  +    @arg-loop ;
  1440   1444   
  1441   1445   \\\
  1442   1446   Local Variables:
  1443   1447   forth-local-words:
  1444   1448       (
  1445   1449        (("net2o:" "+net2o:") definition-starter (font-lock-keyword-face . 1)
  1446   1450         "[ \t\n]" t name (font-lock-function-name-face . 3))

Changes to msg.fs.

    36     36   
    37     37   Variable msg-group$
    38     38   Variable group-master
    39     39   Variable msg-logs
    40     40   Variable otr-mode
    41     41   Variable chain-mode
    42     42   Variable redate-mode
           43  +Variable lock-mode
           44  +Variable msg-keys[]
    43     45   User replay-mode
    44     46   User skip-sig?
    45     47   
    46     48   Sema msglog-sema
    47     49   
    48     50   : ?msg-context ( -- o )
    49     51       msging-context @ dup 0= IF
................................................................................
   324    326       r> r> U+DO
   325    327   	c:0key I last# cell+ $[]@ sigonly@ >hash
   326    328   	2dup hashtmp over str= IF  2drop true  UNLOOP   EXIT
   327    329   	ELSE  ( 2dup 85type ."  <> " hashtmp over 85type )  THEN
   328    330       LOOP
   329    331       2drop false ;
   330    332   
          333  +: msg-key! ( addr u -- )
          334  +    0 msg-keys[] [: rot >r 2over str= r> or ;] $[]map
          335  +    IF  2drop  ELSE  msg-keys[] $+[]!  THEN ;
          336  +
   331    337   \ message commands
   332    338   
   333    339   scope{ net2o-base
   334    340   
   335    341   \g 
   336    342   \g ### message commands ###
   337    343   \g 
................................................................................
   362    368       $> $> msg:otrify ;
   363    369   +net2o: msg-coord ( $:gps -- ) \g GPS coordinates
   364    370       8 !!>=order? $> msg:coord ;
   365    371   +net2o: msg-url ( $:url -- ) \g specify message URL
   366    372       $> msg:url ;
   367    373   +net2o: msg-like ( xchar -- ) \g add a like
   368    374       64>n msg:like ;
          375  ++net2o: msg-lock ( $:key -- ) \g lock down communciation
          376  +    $> msg:lock ;
          377  ++net2o: msg-unlock ( -- )
          378  +    msg:unlock ;
   369    379   
   370    380   }scope
   371    381   
   372    382   msg-table $save
   373    383   
   374    384   ' context-table is gen-table
   375    385   
................................................................................
   409    419   ; msg-notify-class is msg:tag
   410    420   :noname ( addr u -- )
   411    421       2dup [: ." @" .simple-id ;] $tmp notify+ ; msg-notify-class is msg:signal
   412    422   :noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:text
   413    423   :noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:url
   414    424   :noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:action
   415    425   ' drop  msg-notify-class is msg:like
          426  +' 2drop  msg-notify-class is msg:lock
          427  +' noop  msg-notify-class is msg:unlock
   416    428   ' drop  msg-notify-class is msg:away
   417    429   ' 2drop msg-notify-class is msg:coord
   418    430   :noname 2drop 2drop ; msg-notify-class is msg:otrify
   419    431   :noname ( -- ) msg-notify ; msg-notify-class is msg:end
   420    432   :noname ( xchar -- ) ['] xemit $tmp notify+ ; msg-notify-class is msg:like
   421    433   
   422    434   :noname ( addr u -- )
................................................................................
   425    437       2dup startdate@ .log-date
   426    438       2dup enddate@ .log-end
   427    439       .key-id ." : " 
   428    440       r> to last# ; msg-class is msg:start
   429    441   :noname ( addr u -- ) $utf8>
   430    442       <warn> '#' forth:emit .group <default> ; msg-class is msg:tag
   431    443   :noname ( addr u -- ) last# >r
   432         -    key| 2dup pk@ key| str=
          444  +    key| 2dup 0 .pk@ key| str=
   433    445       IF   <err>  THEN ." @" .key-id? <default>
   434    446       r> to last# ; msg-class is msg:signal
   435    447   :noname ( addr u -- )
   436    448       last# >r last# $@ ?msg-log
   437    449       2dup sighash? IF  <info>  ELSE  <err>  THEN
   438    450       ."  <" over le-64@ .ticks
   439    451       verbose( dup keysize - /string ." ," 85type )else( 2drop ) <default>
................................................................................
   443    455   :noname ( addr u -- )
   444    456       space <warn> ." [" 85type ." ]:" <default> ; msg-class is msg:id
   445    457   :noname ( addr u -- ) $utf8> forth:type ; msg-class is msg:text
   446    458   :noname ( addr u -- ) $utf8>
   447    459       <warn> forth:type <default> ; msg-class is msg:url
   448    460   :noname ( xchar -- )
   449    461       <info> utf8emit <default> ; msg-class is msg:like
          462  +:noname ( addr u -- )
          463  +    0 .v-dec$ dup IF
          464  +	msg-key!  lock-mode on
          465  +    ELSE  2drop  THEN
          466  +    <info> ." chat is locked" <default> ;   msg-class is msg:lock
          467  +:noname ( -- )  lock-mode off
          468  +    <info> ." chat is free for all" <default> ; msg-class is msg:unlock
   450    469   ' drop msg-class is msg:away
   451    470   :noname ( addr u type -- )
   452    471       space <warn> case
   453    472   	msg:image#     of  ." img["      85type  endof
   454    473   	msg:thumbnail# of  ." thumb["    85type  endof
   455    474   	msg:patch#     of  ." patch["    85type  endof
   456    475   	msg:snapshot#  of  ." snapshot[" 85type  endof
................................................................................
   647    666   	parent last# cell+ del$cell  THEN ;
   648    667   +net2o: msg-reconnect ( $:pubkey+addr -- ) \g rewire distribution tree
   649    668       $> $make
   650    669       <event last-msg 2@ e$, elit, o elit, last# elit, :>chat-reconnect
   651    670       parent .wait-task @ ?query-task over select event> ;
   652    671   +net2o: msg-last? ( start end n -- ) 64>n msg:last? ;
   653    672   +net2o: msg-last ( $:[tick0,msgs,..tickn] n -- ) 64>n msg:last ;
   654         -+net2o: msg-key ( $:key -- )
   655         -    $> v-dec$ dup IF  msg-keys[] $+[]!  ELSE  2drop  THEN ;
   656    673   
   657    674   net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
   658    675       $> nest-sig ?dup-0=-IF
   659    676   	handle-msg
   660    677      ELSE  replay-mode @ IF  drop 2drop
   661    678   	ELSE  !!sig!!  THEN \ balk on all wrong signatures
   662    679       THEN ;
................................................................................
  1441   1458       true otr-mode [: now>otr
  1442   1459   	[: BEGIN  bl $split 2>r dup  WHILE  s>unumber? WHILE
  1443   1460   			drop do-otrify  2r>  REPEAT THEN
  1444   1461   	    2drop 2r> 2drop
  1445   1462   	;] (send-avalanche) drop .chat save-msgs&
  1446   1463       ;] !wrapper ;
  1447   1464   
         1465  +: /lock ( addr u -- )
         1466  +    \U lock {@nick}         lock down
         1467  +    \G lock: lock down communication to list of nicks
         1468  +    word-args ['] args>keylist execute-parsing
         1469  +    [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche
         1470  +    vkey keysize msg-keys[] ~~ $+[]!
         1471  +    lock-mode on ;
         1472  +: /unlock ( addr u -- )
         1473  +    \U unlock               stop lock down
         1474  +    \G unlock: stop lock down
         1475  +    2drop lock-mode off ;
         1476  +
  1448   1477   : /bye ( addr u -- )
  1449   1478       \U bye
  1450   1479       \G bye: leaves the current chat
  1451   1480       2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ;
  1452   1481   }scope
  1453   1482   
  1454   1483   : ?slash ( addr u -- addr u flag )

Changes to n2o.fs.

    15     15   \ You should have received a copy of the GNU Affero General Public License
    16     16   \ along with this program.  If not, see <http://www.gnu.org/licenses/>.
    17     17   
    18     18   require net2o.fs
    19     19   
    20     20   Variable key-readin
    21     21   
    22         -: out-nicks ( -- )
    23         -    [: nick-key ?dup-IF  out-key  THEN ;] @arg-loop ;
    24         -
    25     22   : qr-me ( -- ) pk@ qr:ownkey# .keyqr ;
    26     23   : qr-nicks ( -- )
    27     24       [: nick-key ?dup-IF  >o ke-pk $@
    28     25   	    qr:ownkey# qr:key# ke-sk sec@ nip select o>
    29     26   	    .keyqr  THEN ;] @arg-loop ;
    30     27   
    31         -: args>keylist ( -- )
    32         -    [: nick-key ?dup-IF  >o ke-pk $@ o> keysize umin key-list $+[]!  THEN ;]
    33         -    @arg-loop ;
           28  +: out-nicks ( -- )
           29  +    [: nick-key ?dup-IF  out-key  THEN ;] @arg-loop ;
    34     30   
    35     31   $20 value hash-size#
    36     32   
    37     33   : hash-file ( addr u -- hash u' )
    38     34       c:0key slurp-file 2dup c:hash drop free throw pad c:key>
    39     35       pad hash-size# ;
    40     36