Check-in [eb85b0b273]
Not logged in

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

Overview
Comment:More rework on messaging
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: eb85b0b273ab8d04b623f4e5a1b092dfeeb01145
User & Date: bernd 2019-06-20 12:29:56.475
Context
2019-06-20
12:55
Small fix so that joining groups at start works again check-in: cc527aed1c user: bernd tags: trunk
12:29
More rework on messaging check-in: eb85b0b273 user: bernd tags: trunk
2019-06-19
23:24
Cleanup message data structures check-in: fbd7109fed user: bernd tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to classes.fs.
129
130
131
132
133
134
135

136
137
138
139
140
141
142
end-class ack-class

cmd-class class
    field: silent-last#
end-class msging-class

cmd-class class{ msg

    $value: name$ \ group name
    $value: id$
    field: peers[]
    field: keys[]
    field: log[]
    field: mode
    \ mode bits:







>







129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
end-class ack-class

cmd-class class
    field: silent-last#
end-class msging-class

cmd-class class{ msg
    $10 +field dummy
    $value: name$ \ group name
    $value: id$
    field: peers[]
    field: keys[]
    field: log[]
    field: mode
    \ mode bits:
Changes to msg.fs.
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759

also }scope

msging-table $save

: msg-reply ( tag -- )
    ." got reply " hex. pubkey $@ key>nick forth:type forth:cr ;
: expect-msg ( --- )
    reply( ['] msg-reply )else( ['] drop ) expect-reply-xt +chat-control ;

User hashtmp$  hashtmp$ off

: last-msg@ ( -- ticks )
    last# >r
    last# $@ ?msg-log last# cell+ $[]# ?dup-IF







|







745
746
747
748
749
750
751
752
753
754
755
756
757
758
759

also }scope

msging-table $save

: msg-reply ( tag -- )
    ." got reply " hex. pubkey $@ key>nick forth:type forth:cr ;
: expect-msg ( o:connection -- )
    reply( ['] msg-reply )else( ['] drop ) expect-reply-xt +chat-control ;

User hashtmp$  hashtmp$ off

: last-msg@ ( -- ticks )
    last# >r
    last# $@ ?msg-log last# cell+ $[]# ?dup-IF
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
    now>otr ]pksign ;
: msg-log, ( -- addr u )
    last-signed 2@ >msg-log ;

previous

: ?destpk ( addr u -- addr' u' )
    2dup pubkey $@ key| str= IF  2drop pk@ key|  THEN ;

: last-signdate@ ( -- 64date )
    msg-group$ $@ msg-logs #@ dup IF
	+ cell- $@ startdate@ 64#1 64+
    ELSE  2drop 64#-1  THEN ;

also net2o-base







|







940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
    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 ;

: last-signdate@ ( -- 64date )
    msg-group$ $@ msg-logs #@ dup IF
	+ cell- $@ startdate@ 64#1 64+
    ELSE  2drop 64#-1  THEN ;

also net2o-base
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
    ;] !wrapper ;

: /lock ( addr u -- )
    \U lock {@nick}         lock down
    \G lock: lock down communication to list of nicks
    word-args ['] args>keylist execute-parsing
    [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche
    vkey keysize msg-keys[] ~~ $+[]!
    lock-mode on ;
: /unlock ( addr u -- )
    \U unlock               stop lock down
    \G unlock: stop lock down
    2drop lock-mode off ;

: /bye ( addr u -- )







|







1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
    ;] !wrapper ;

: /lock ( addr u -- )
    \U lock {@nick}         lock down
    \G lock: lock down communication to list of nicks
    word-args ['] args>keylist execute-parsing
    [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche
    vkey keysize msg-keys[] $+[]!
    lock-mode on ;
: /unlock ( addr u -- )
    \U unlock               stop lock down
    \G unlock: stop lock down
    2drop lock-mode off ;

: /bye ( addr u -- )
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694

1695





1696
1697
1698
1699
1700
1701
1702
    LOOP  0 punch-addrs $[] @ ;
: reconnect, ( o:connection -- )
    [: punch-addr-ind@ o>addr forth:type
      pubkey $@ key| tuck forth:type forth:emit ;] $tmp
    reconnect( ." send reconnect: " 2dup 2dup + 1- c@ 1+ - .addr$ forth:cr )
    $, msg-reconnect ;

: reconnects, ( group -- )
    cell+ $@ cell safe/string bounds U+DO
	I @ .reconnect,
    cell +LOOP ;

: send-reconnects ( o:group -- )
    net2o-code expect-msg
    [:  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 ( o:group -- )
    msg:peers[] $@
    case
	0    of  2drop  endof
	cell of  @ >o o to connection send-leave o>  endof
	@ to connection  send-reconnects
    0 endcase ;
: send-silent-reconnect ( o:group -- )
    msg:peers[] $@
    case
	0    of  drop  endof
	cell of  @ >o o to connection send-silent-leave o>  endof
	o swap @ .send-reconnects

    0 endcase ;





: disconnect-group ( o:group -- )
    msg:peers[] get-stack 0 ?DO  >o o to connection
	disconnect-me o>
    LOOP ;
: disconnect-all ( o:group -- )
    msg:peers[] get-stack 0 ?DO  >o o to connection
	send-leave  disconnect-me o>







|
|





|












|
<
<
<
<
<
<
<



|
|
>
|
>
>
>
>
>







1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682







1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
    LOOP  0 punch-addrs $[] @ ;
: reconnect, ( o:connection -- )
    [: punch-addr-ind@ o>addr forth:type
      pubkey $@ key| tuck forth:type forth:emit ;] $tmp
    reconnect( ." send reconnect: " 2dup 2dup + 1- c@ 1+ - .addr$ forth:cr )
    $, msg-reconnect ;

: reconnects, ( o:group -- )
    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
	0    of  drop  endof
	cell of  @ >o o to connection xt o>  endof
	drop @ >o o to connection  send-reconnects o>
	0
    endcase ;
: send-reconnect ( o:group -- )
    ['] send-leave send-reconnect-xt ;
: send-silent-reconnect ( o:group -- )
    ['] send-silent-leave send-reconnect-xt ;

: disconnect-group ( o:group -- )
    msg:peers[] get-stack 0 ?DO  >o o to connection
	disconnect-me o>
    LOOP ;
: disconnect-all ( o:group -- )
    msg:peers[] get-stack 0 ?DO  >o o to connection
	send-leave  disconnect-me o>