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

461

462
463
464
465
466
467
468
469
: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

    ELSE  2drop  THEN

    <info> ." chat is locked" <default> ;   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







>
|
>
|







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
727
728
729
730
731
732

733
734
735
736
737
738
739
    sct1 sct0 sc25519/
    sct0 swap raw>sc25519
    sct2 sct0 sct1 sc25519*
    get0 sct2 ge25519*base
    get0 ge25519-pack
    sct2 sc25519>32b ;

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

	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







|




|
>







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
940
941
942
943
944
945
946
947
948
949
950
    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
    ]pksign ;
: msg-otr> ( -- )
    \G end a message block by adding a short-time signature
    now>otr ]pksign ;
: 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 ;







>
>
>


|


|







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
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
    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,] ;

: 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,] ;

: silent-leave, ( -- )
    ['] msg-leave [msg,] ;

: left, ( addr u -- )
    key| $, msg-signal "left (timeout)" $, msg-action ;
previous







|







|







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
1174
1175
1176
1177
1178
1179
1180
1181
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>
      +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 ;








|







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
1499

1500
1501
1502
1503
1504
1505
1506
	[: 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[] $+[]!
    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








>



|
>







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
1583
1584
1585
1586
1587
1588
1589
1590
1591
    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 ;







|
|







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
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
    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>
	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>
	.reconnect, ;] [msg,]
    end-code| ;
previous

: send-reconnect-xt ( o:group xt -- ) { xt: xt }
    msg:peers[] $@
    case







|






|







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