Check-in [f5b4744608]
Not logged in
Home Timeline Files Branches Tags Tickets Wiki Login Impressum Datenschutzerklärung

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.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
Side-by-Side Diff Ignore Whitespace Patch
Changes to msg.fs.
︙
454
455
456
457
458
459
460

461
462



463
464
465
466
467
468
469

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  THEN
    <info> ." chat is locked" <default> ;   msg-class is msg:lock
    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
727

728
729
730
731
732


733
734
735
736
737
738
739

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 ;

: ]encpksig ( -- )
: ]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 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
940

941
942
943

944
945
946
947
948
949
950

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
    ]pksign ;
     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 ]pksign ;
    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
978

979
980
981
982
983
984
985
986

987
988
989
990
991
992
993

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?,
      sign[ msg-start "joined" $, msg-action msg-otr> ;] [msg,] ;
      <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
      sign[ msg-start "left" $, msg-action msg-otr> ;] [msg,] ;
      <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
1174

1175
1176
1177
1178
1179
1180
1181

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 [: sign[ msg-start execute msg> ;] gen-cmd$ o>
    [: 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
1499


1500
1501
1502
1503
1504
1505
1506

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
    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
1583
1584


1585
1586
1587
1588
1589
1590
1591

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 ;
: 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
1704

1705
1706
1707
1708
1709
1710
1711

1712
1713
1714
1715
1716
1717
1718

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
	sign[ msg-start "left" $, msg-action msg-otr>
	<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
	sign[ msg-start "left" $, msg-action msg-otr>
	<msg msg-start "left" $, msg-action msg-otr>
	.reconnect, ;] [msg,]
    end-code| ;
previous

: send-reconnect-xt ( o:group xt -- ) { xt: xt }
    msg:peers[] $@
    case
︙
Fossil 2.26 [611144ddd9] 2025-05-16 13:52:48