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: |
f5b4744608fb1579f1c876da8f6536d6 |
| 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
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