Check-in [f5b4744608]
Not logged in

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

Overview
Comment:More on locked chat
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: f5b4744608fb1579f1c876da8f6536d6e26212ae
User & Date: bernd 2019-07-09 21:32:45
Context
2019-07-09
22:22
More on locked chat check-in: 604bb8e573 user: bernd tags: trunk
21:32
More on locked chat check-in: f5b4744608 user: bernd tags: trunk
2019-07-08
18:32
Fix problem with insert-address check-in: 856357a817 user: bernd tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to msg.fs.

   454    454   :noname ( addr u -- ) $utf8>
   455    455       <warn> forth:type <default> ; msg-class is msg:url
   456    456   :noname ( xchar -- )
   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         -    ELSE  2drop  THEN
   462         -    <info> ." chat is locked" <default> ;   msg-class is msg:lock
          461  +	<info> ." chat is locked" <default>
          462  +    ELSE  2drop
          463  +	<err> ." locked out of chat" <default>
          464  +    THEN ;   msg-class is msg:lock
   463    465   :noname ( -- )  msg-group-o .msg:-lock
   464    466       <info> ." chat is free for all" <default> ; msg-class is msg:unlock
   465    467   ' drop msg-class is msg:away
   466    468   :noname ( addr u type -- )
   467    469       space <warn> case
   468    470   	msg:image#     of  ." img["      85type  endof
   469    471   	msg:thumbnail# of  ." thumb["    85type  endof
................................................................................
   720    722       sct1 sct0 sc25519/
   721    723       sct0 swap raw>sc25519
   722    724       sct2 sct0 sct1 sc25519*
   723    725       get0 sct2 ge25519*base
   724    726       get0 ge25519-pack
   725    727       sct2 sc25519>32b ;
   726    728   
   727         -: ]encpksig ( -- )
          729  +: ]encpksign ( -- )
   728    730       +zero16 nest$ msg-keys[] dup $[]# 1- swap $[]@ encrypt$
   729    731       sigdate +date
   730    732       sktmp pktmp sk@ drop >modkey
   731    733       [:  pktmp keysize forth:type  sigdate datesize# forth:type
   732         -	sig-params 2drop sktmp pktmp ed-sign forth:type
          734  +	sig-params 2drop sktmp pktmp ed-sign
          735  +	2dup + 1- $80 swap orc! forth:type
   733    736   	keysize forth:emit ;] ']sign ;
   734    737   
   735    738   \ nest-sig for msg/msging classes
   736    739   
   737    740   :noname ( addr u -- )
   738    741       2dup + 2 - c@ $F0 and
   739    742       case $80 of msg-dec-sig? endof
................................................................................
   931    934       drop 64drop ; msgfs-class is fs-set-stat
   932    935   ' file-start-req msgfs-class is start-req
   933    936   
   934    937   \ message composer
   935    938   
   936    939   : group, ( addr u -- )
   937    940       $, msg-group ;
          941  +: <msg ( -- )
          942  +    sign[ msg-group-o .msg:?lock IF  +zero16  THEN ;
          943  +
   938    944   : msg> ( -- )
   939    945       \G end a message block by adding a signature
   940         -    ]pksign ;
          946  +     msg-group-o .msg:?lock IF  ]encpksign  ELSE  ]pksign  THEN ;
   941    947   : msg-otr> ( -- )
   942    948       \G end a message block by adding a short-time signature
   943         -    now>otr ]pksign ;
          949  +    now>otr msg> ;
   944    950   : msg-log, ( -- addr u )
   945    951       last-signed 2@ >msg-log ;
   946    952   
   947    953   previous
   948    954   
   949    955   : ?destpk ( addr u -- addr' u' )
   950    956       2dup connection .pubkey $@ key| str= IF  2drop pk@ key|  THEN ;
................................................................................
   971    977       THEN ;
   972    978   
   973    979   : sync-ahead?, ( -- )
   974    980       last-signdate@ 64#1 64+ lit, 64#-1 lit, ask-last# ulit, msg-last? ;
   975    981   
   976    982   : join, ( -- )
   977    983       [: msg-join sync-ahead?,
   978         -      sign[ msg-start "joined" $, msg-action msg-otr> ;] [msg,] ;
          984  +      <msg msg-start "joined" $, msg-action msg-otr> ;] [msg,] ;
   979    985   
   980    986   : silent-join, ( -- )
   981    987       msg-group$ $@ dup IF  message $, msg-join  end-with
   982    988       ELSE  2drop  THEN ;
   983    989   
   984    990   : leave, ( -- )
   985    991       [: msg-leave
   986         -      sign[ msg-start "left" $, msg-action msg-otr> ;] [msg,] ;
          992  +      <msg msg-start "left" $, msg-action msg-otr> ;] [msg,] ;
   987    993   
   988    994   : silent-leave, ( -- )
   989    995       ['] msg-leave [msg,] ;
   990    996   
   991    997   : left, ( addr u -- )
   992    998       key| $, msg-signal "left (timeout)" $, msg-action ;
   993    999   previous
................................................................................
  1167   1173   also net2o-base
  1168   1174   \ chain messages to one previous message
  1169   1175   : chain, ( msgaddr u -- )
  1170   1176       [: 2dup startdate@ 64#0 { 64^ sd } sd le-64!  sd 1 64s forth:type
  1171   1177   	c:0key sigonly@ >hash hashtmp hash#128 forth:type ;] $tmp $, msg-chain ;
  1172   1178   
  1173   1179   : (send-avalanche) ( xt -- addr u flag )
  1174         -    [: 0 >o [: sign[ msg-start execute msg> ;] gen-cmd$ o>
         1180  +    [: 0 >o [: <msg msg-start execute msg> ;] gen-cmd$ o>
  1175   1181         +last-signed msg-log, ;] [group] ;
  1176   1182   previous
  1177   1183   : send-avalanche ( xt -- )
  1178   1184       msg-group-o .msg:?otr IF  now>otr  ELSE  now>never  THEN
  1179   1185       (send-avalanche)
  1180   1186       >r .chat r> 0= IF  msg-group-o .msg:.nobody  THEN ;
  1181   1187   
................................................................................
  1489   1495   	[: BEGIN  bl $split 2>r dup  WHILE  s>unumber? WHILE
  1490   1496   			drop do-otrify  2r>  REPEAT THEN
  1491   1497   	    2drop 2r> 2drop
  1492   1498   	;] (send-avalanche) drop .chat save-msgs&
  1493   1499       ;] !wrapper ; is /otrify
  1494   1500   
  1495   1501   :noname ( addr u -- )
         1502  +    msg-group-o .msg:-lock
  1496   1503       word-args ['] args>keylist execute-parsing
  1497   1504       [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche
  1498   1505       vkey keysize msg-keys[] $+[]!
  1499         -    msg-group-o .msg:+lock ; is /lock
         1506  +    msg-group-o .msg:+lock
         1507  +; is /lock
  1500   1508   :noname ( addr u -- )
  1501   1509       2drop msg-group-o .msg:-lock ; is /unlock
  1502   1510   
  1503   1511   :noname ( addr u -- )
  1504   1512       2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ; is /bye
  1505   1513   }scope
  1506   1514   
................................................................................
  1576   1584       msg-recognizer to forth-recognizer 2dup evaluate
  1577   1585       last->in IF  + last->in tuck -  THEN  dup IF
  1578   1586   	\ ." text: '" forth:type ''' forth:emit forth:cr
  1579   1587   	$, msg-text
  1580   1588       ELSE  2drop  THEN
  1581   1589       r> to forth-recognizer  r> to last# ;
  1582   1590   
  1583         -: avalanche-text ( addr u -- ) >utf8$
  1584         -    [: parse-text ;] send-avalanche ;
         1591  +: avalanche-text ( addr u -- )
         1592  +    >utf8$ ['] parse-text send-avalanche ;
  1585   1593   
  1586   1594   previous
  1587   1595   
  1588   1596   : load-msgn ( addr u n -- )
  1589   1597       >r load-msg r> display-lastn ;
  1590   1598   
  1591   1599   : +group ( -- ) msg-group$ $@ >group +unique-con ;
................................................................................
  1697   1705       msg-group-o .msg:peers[] $@ cell safe/string bounds U+DO
  1698   1706   	I @ .reconnect,
  1699   1707       cell +LOOP ;
  1700   1708   
  1701   1709   : send-reconnects ( o:group -- )
  1702   1710       net2o-code expect-msg
  1703   1711       [:  msg-group-o .msg:name$ ?destpk $, msg-leave
  1704         -	sign[ msg-start "left" $, msg-action msg-otr>
         1712  +	<msg msg-start "left" $, msg-action msg-otr>
  1705   1713   	reconnects, ;] [msg,]
  1706   1714       end-code| ;
  1707   1715   
  1708   1716   : send-reconnect1 ( o:group -- )
  1709   1717       net2o-code expect-msg
  1710   1718       [:  msg:name$ ?destpk $, msg-leave
  1711         -	sign[ msg-start "left" $, msg-action msg-otr>
         1719  +	<msg msg-start "left" $, msg-action msg-otr>
  1712   1720   	.reconnect, ;] [msg,]
  1713   1721       end-code| ;
  1714   1722   previous
  1715   1723   
  1716   1724   : send-reconnect-xt ( o:group xt -- ) { xt: xt }
  1717   1725       msg:peers[] $@
  1718   1726       case