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