Index: classes.fs ================================================================== --- classes.fs +++ classes.fs @@ -127,14 +127,13 @@ 64field: time-offset \ make timestamps smaller 64field: lastdeltat end-class ack-class cmd-class class + $value: msging-id$ field: peers[] - field: msg-keys[] field: silent-last# - method dec-nest-sig \ check sig, decrypt and then nest end-class msging-class cmd-class class{ msg $value: id$ method start @@ -149,10 +148,12 @@ method coord method otrify method payment method url method like + method lock + method unlock method away method end method display \ display one message method redisplay \ display full set }class Index: keys.fs ================================================================== --- keys.fs +++ keys.fs @@ -1435,10 +1435,14 @@ case #-56 of .keyinfo true !!no-key-open!! endof #-28 of .keyinfo true !!no-key-open!! endof throw 0 endcase ; + +: args>keylist ( -- ) + [: nick-key ?dup-IF >o ke-pk $@ o> keysize umin key-list $+[]! THEN ;] + @arg-loop ; \\\ Local Variables: forth-local-words: ( Index: msg.fs ================================================================== --- msg.fs +++ msg.fs @@ -38,10 +38,12 @@ Variable group-master Variable msg-logs Variable otr-mode Variable chain-mode Variable redate-mode +Variable lock-mode +Variable msg-keys[] User replay-mode User skip-sig? Sema msglog-sema @@ -326,10 +328,14 @@ 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-keys[] [: rot >r 2over str= r> or ;] $[]map + IF 2drop ELSE msg-keys[] $+[]! THEN ; + \ message commands scope{ net2o-base \g @@ -364,10 +370,14 @@ 8 !!>=order? $> msg:coord ; +net2o: msg-url ( $:url -- ) \g specify message URL $> msg:url ; +net2o: msg-like ( xchar -- ) \g add a like 64>n msg:like ; ++net2o: msg-lock ( $:key -- ) \g lock down communciation + $> msg:lock ; ++net2o: msg-unlock ( -- ) + msg:unlock ; }scope msg-table $save @@ -411,10 +421,12 @@ 2dup [: ." @" .simple-id ;] $tmp notify+ ; msg-notify-class is msg:signal :noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:text :noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:url :noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:action ' drop msg-notify-class is msg:like +' 2drop msg-notify-class is msg:lock +' noop msg-notify-class is msg:unlock ' drop msg-notify-class is msg:away ' 2drop msg-notify-class is msg:coord :noname 2drop 2drop ; msg-notify-class is msg:otrify :noname ( -- ) msg-notify ; msg-notify-class is msg:end :noname ( xchar -- ) ['] xemit $tmp notify+ ; msg-notify-class is msg:like @@ -427,11 +439,11 @@ .key-id ." : " r> to last# ; msg-class is msg:start :noname ( addr u -- ) $utf8> '#' forth:emit .group ; msg-class is msg:tag :noname ( addr u -- ) last# >r - key| 2dup pk@ key| str= + key| 2dup 0 .pk@ key| str= IF THEN ." @" .key-id? r> to last# ; msg-class is msg:signal :noname ( addr u -- ) last# >r last# $@ ?msg-log 2dup sighash? IF ELSE THEN @@ -445,10 +457,17 @@ :noname ( addr u -- ) $utf8> forth:type ; msg-class is msg:text :noname ( addr u -- ) $utf8> forth:type ; msg-class is msg:url :noname ( xchar -- ) utf8emit ; msg-class is msg:like +:noname ( addr u -- ) + 0 .v-dec$ dup IF + msg-key! lock-mode on + ELSE 2drop THEN + ." chat is locked" ; msg-class is msg:lock +:noname ( -- ) lock-mode off + ." chat is free for all" ; msg-class is msg:unlock ' drop msg-class is msg:away :noname ( addr u type -- ) space case msg:image# of ." img[" 85type endof msg:thumbnail# of ." thumb[" 85type endof @@ -649,12 +668,10 @@ $> $make chat-reconnect parent .wait-task @ ?query-task over select event> ; +net2o: msg-last? ( start end n -- ) 64>n msg:last? ; +net2o: msg-last ( $:[tick0,msgs,..tickn] n -- ) 64>n msg:last ; -+net2o: msg-key ( $:key -- ) - $> v-dec$ dup IF msg-keys[] $+[]! ELSE 2drop THEN ; net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest $> nest-sig ?dup-0=-IF handle-msg ELSE replay-mode @ IF drop 2drop @@ -1443,10 +1460,22 @@ drop do-otrify 2r> REPEAT THEN 2drop 2r> 2drop ;] (send-avalanche) drop .chat save-msgs& ;] !wrapper ; +: /lock ( addr u -- ) + \U lock {@nick} lock down + \G lock: lock down communication to list of nicks + word-args ['] args>keylist execute-parsing + [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche + vkey keysize msg-keys[] ~~ $+[]! + lock-mode on ; +: /unlock ( addr u -- ) + \U unlock stop lock down + \G unlock: stop lock down + 2drop lock-mode off ; + : /bye ( addr u -- ) \U bye \G bye: leaves the current chat 2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ; }scope Index: n2o.fs ================================================================== --- n2o.fs +++ n2o.fs @@ -17,22 +17,18 @@ require net2o.fs Variable key-readin -: out-nicks ( -- ) - [: nick-key ?dup-IF out-key THEN ;] @arg-loop ; - : qr-me ( -- ) pk@ qr:ownkey# .keyqr ; : qr-nicks ( -- ) [: nick-key ?dup-IF >o ke-pk $@ qr:ownkey# qr:key# ke-sk sec@ nip select o> .keyqr THEN ;] @arg-loop ; -: args>keylist ( -- ) - [: nick-key ?dup-IF >o ke-pk $@ o> keysize umin key-list $+[]! THEN ;] - @arg-loop ; +: out-nicks ( -- ) + [: nick-key ?dup-IF out-key THEN ;] @arg-loop ; $20 value hash-size# : hash-file ( addr u -- hash u' ) c:0key slurp-file 2dup c:hash drop free throw pad c:key>