Check-in [94988e190b]
Not logged in

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

Overview
Comment:Locked down chat works
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 94988e190bafedce1c902440fcabe51f83846576
User & Date: bernd 2019-07-13 00:01:13
Context
2019-07-13
11:02
Fix your-0key problem check-in: e332493556 user: bernd tags: trunk
00:01
Locked down chat works check-in: 94988e190b user: bernd tags: trunk
2019-07-11
17:52
Bump version number check-in: 77e7c31c60 user: bernd tags: trunk, 0.9.0-20190711
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to classes.fs.

133
134
135
136
137
138
139

140
141
142
143
144
145
146
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:
    1 4 bits: otr# redate# lock# visible#
    : bit-ops: ( bit -- )







>







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
end-class msging-class


cmd-class class{ msg
    $10 +field dummy
    $value: name$ \ group name
    $value: id$
    $value: msg$  \ decrypted message
    field: peers[]
    field: keys[]
    field: log[]
    field: mode
    \ mode bits:
    1 4 bits: otr# redate# lock# visible#
    : bit-ops: ( bit -- )

Changes to msg.fs.

70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
...
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
...
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
...
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
...
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
....
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021

1022
1023
1024
1025
1026
1027
1028
....
1353
1354
1355
1356
1357
1358
1359



1360
1361
1362
1363
1364
1365
1366
....
1482
1483
1484
1485
1486
1487
1488



1489
1490
1491
1492
1493
1494
1495
		    1+
		THEN
	REPEAT  drop ;] msglog-sema c-section ;

: serialize-log ( addr u -- $addr )
    [: bounds ?DO
	    I $@ check-date 0= IF  net2o-base:$, net2o-base:nestsig
	    ELSE   2drop  THEN
      cell +LOOP ;]
    gen-cmd ;

Variable saved-msg$
64Variable saved-msg-ticks

: save-msgs ( group-o -- ) to msg-group-o
................................................................................
    <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
................................................................................
    groups>sort[]
    group-list[] $@ bounds ?DO  I @ .chatgroup  cell +LOOP ;

: ?pkgroup ( addr u -- addr u )
    \ if no group has been selected, use the pubkey as group
    last# 0= IF  2dup + sigpksize# - keysize >group  THEN ;

: handle-msg ( addr u -- )
    ?pkgroup >msg-log
    2dup d0<> \ do something if it is new
    IF  replay-mode @ 0= IF
	    2dup show-msg
	    2dup parent .push-msg
	THEN
    THEN  2drop ;

\g 
\g ### messaging commands ###
\g 

scope{ net2o-base

................................................................................
    $> $make
    <event last-msg 2@ e$, elit, o elit, msg-group-o elit, :>chat-reconnect
    parent .wait-task @ ?query-task over select event> ;
+net2o: msg-last? ( start end n -- ) 64>n msg:last? ;
+net2o: msg-last ( $:[tick0,msgs,..tickn] n -- ) 64>n msg:last ;

net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
    $> nest-sig ?dup-0=-IF
	handle-msg
   ELSE  replay-mode @ IF  drop 2drop
	ELSE  !!sig!!  THEN \ balk on all wrong signatures
    THEN ;

: msg-sig? ( addr u -- addr u' flag )
    skip-sig? @ IF   quicksig( pk-quick-sig? )else( pk-date? )
    ELSE  pk-sig?  THEN ;

................................................................................
    sigpksize# - 2dup + { pksig }
    msg-group-o .msg:keys[] $@ bounds U+DO
	I $@ 2over pksig decrypt-sig?
	dup -5 <> IF
	    >r 2nip r> unloop  EXIT
	THEN  drop 2drop
    cell +LOOP
    sigpksize# +  -5 ;

: msg-dec?-sig? ( addr u -- addr' u' flag )
    2dup 2 - + c@ $80 and IF  msg-dec-sig?  ELSE  msg-sig?  THEN ;

\ generate an encryt+sign packet

: ]encpksign ( -- )
................................................................................
	THEN  <info>  THEN
    sigpksize# - 2dup + sigpksize# >$  c-state off
    nest-cmd-loop msg:end ;
' msg-tdisplay msg-class is msg:display
' msg-tdisplay msg-notify-class is msg:display
: msg-tredisplay ( n -- )
    reset-time
    msg-group-o .msg:mode dup @ msg:otr# invert and swap
    [:  cells >r msg-log@ 2dup { log u }
	dup r> - 0 max /string bounds ?DO
	    I log - cell/ to log#
	    I $@ { d: msgt }
	    msgt ['] msg:display catch IF  ." invalid entry" cr
		2drop  THEN
	cell +LOOP
	log free throw ;] !wrapper ;

' msg-tredisplay msg-class is msg:redisplay

msg-class class
end-class textmsg-class

' 2drop textmsg-class is msg:start
:noname '#' emit type ; textmsg-class is msg:tag
................................................................................
    \G otrify: turn an older message of yours into an OTR message
umethod /lock ( addr u -- )
    \U lock {@nick}         lock down
    \G lock: lock down communication to list of nicks
umethod /unlock ( addr u -- )
    \U unlock               stop lock down
    \G unlock: stop lock down



umethod /bye ( addr u -- )
    \U bye
    \G bye: leaves the current chat
umethod /chat ( addr u -- )
    \U chat [group][@user]  switch/connect chat
    \G chat: switch to chat with user or group
umethod /split ( addr u -- )
................................................................................
    word-args ['] args>keylist execute-parsing
    [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche
    vkey keysize $make msg-group-o .msg:keys[] >back
    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

: ?slash ( addr u -- addr u flag )
    over c@ dup '/' = swap '\' = or ;







|







 







|







 







|
|
|
|
|
|
<
|







 







|

|







 







|







 







|







|
>







 







>
>
>







 







>
>
>







70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
...
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
...
637
638
639
640
641
642
643
644
645
646
647
648
649

650
651
652
653
654
655
656
657
...
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
...
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
....
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
....
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
....
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
		    1+
		THEN
	REPEAT  drop ;] msglog-sema c-section ;

: serialize-log ( addr u -- $addr )
    [: bounds ?DO
	    I $@ check-date 0= IF  net2o-base:$, net2o-base:nestsig
	    ELSE   msg( ." removed entry " dump )else( 2drop )  THEN
      cell +LOOP ;]
    gen-cmd ;

Variable saved-msg$
64Variable saved-msg-ticks

: save-msgs ( group-o -- ) to msg-group-o
................................................................................
    <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
................................................................................
    groups>sort[]
    group-list[] $@ bounds ?DO  I @ .chatgroup  cell +LOOP ;

: ?pkgroup ( addr u -- addr u )
    \ if no group has been selected, use the pubkey as group
    last# 0= IF  2dup + sigpksize# - keysize >group  THEN ;

: handle-msg ( addr-o u-o addr-dec u-dec -- )
    ?pkgroup 2swap >msg-log
    2dup d0<> replay-mode @ 0= and \ do something if it is new
    IF
	2over show-msg
	2dup parent .push-msg

    THEN  2drop 2drop ;

\g 
\g ### messaging commands ###
\g 

scope{ net2o-base

................................................................................
    $> $make
    <event last-msg 2@ e$, elit, o elit, msg-group-o elit, :>chat-reconnect
    parent .wait-task @ ?query-task over select event> ;
+net2o: msg-last? ( start end n -- ) 64>n msg:last? ;
+net2o: msg-last ( $:[tick0,msgs,..tickn] n -- ) 64>n msg:last ;

net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
    $> 2dup nest-sig ?dup-0=-IF
	handle-msg
    ELSE  replay-mode @ IF  drop 2drop 2drop
	ELSE  !!sig!!  THEN \ balk on all wrong signatures
    THEN ;

: msg-sig? ( addr u -- addr u' flag )
    skip-sig? @ IF   quicksig( pk-quick-sig? )else( pk-date? )
    ELSE  pk-sig?  THEN ;

................................................................................
    sigpksize# - 2dup + { pksig }
    msg-group-o .msg:keys[] $@ bounds U+DO
	I $@ 2over pksig decrypt-sig?
	dup -5 <> IF
	    >r 2nip r> unloop  EXIT
	THEN  drop 2drop
    cell +LOOP
    sigpksize# +  -5  replay-mode @ 0= and ;

: msg-dec?-sig? ( addr u -- addr' u' flag )
    2dup 2 - + c@ $80 and IF  msg-dec-sig?  ELSE  msg-sig?  THEN ;

\ generate an encryt+sign packet

: ]encpksign ( -- )
................................................................................
	THEN  <info>  THEN
    sigpksize# - 2dup + sigpksize# >$  c-state off
    nest-cmd-loop msg:end ;
' msg-tdisplay msg-class is msg:display
' msg-tdisplay msg-notify-class is msg:display
: msg-tredisplay ( n -- )
    reset-time
    msg-group-o >o msg:?otr msg:-otr o> >r
    [:  cells >r msg-log@ 2dup { log u }
	dup r> - 0 max /string bounds ?DO
	    I log - cell/ to log#
	    I $@ { d: msgt }
	    msgt ['] msg:display catch IF  ." invalid entry" cr
		2drop  THEN
	cell +LOOP
	log free throw ;] catch
    r> IF  msg-group-o .msg:+otr  THEN  throw ;
' msg-tredisplay msg-class is msg:redisplay

msg-class class
end-class textmsg-class

' 2drop textmsg-class is msg:start
:noname '#' emit type ; textmsg-class is msg:tag
................................................................................
    \G otrify: turn an older message of yours into an OTR message
umethod /lock ( addr u -- )
    \U lock {@nick}         lock down
    \G lock: lock down communication to list of nicks
umethod /unlock ( addr u -- )
    \U unlock               stop lock down
    \G unlock: stop lock down
umethod /lock? ( addr u -- )
    \U lock?                check lock status
    \G lock?: report lock status
umethod /bye ( addr u -- )
    \U bye
    \G bye: leaves the current chat
umethod /chat ( addr u -- )
    \U chat [group][@user]  switch/connect chat
    \G chat: switch to chat with user or group
umethod /split ( addr u -- )
................................................................................
    word-args ['] args>keylist execute-parsing
    [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche
    vkey keysize $make msg-group-o .msg:keys[] >back
    msg-group-o .msg:+lock
; is /lock
:noname ( addr u -- )
    2drop msg-group-o .msg:-lock ; is /unlock
:noname ( addr u -- )
    2drop msg-group-o .msg:?lock 0= IF  ." un"  THEN  ." locked" forth:cr
; is /lock?

:noname ( addr u -- )
    2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ; is /bye
}scope

: ?slash ( addr u -- addr u flag )
    over c@ dup '/' = swap '\' = or ;

Changes to rng.fs.

50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    \G legacy version of read-rnd
    s" /dev/urandom" r/o open-file throw >r
    tuck r@ read-file r> close-file throw
    throw <> !!insuff-rnd!! ;

: read-rnd ( addr u -- )
    \G read in entropy bytes from the systems entropy source
    [ [defined] getentropy [defined] linux and [IF]
	"getentropy" "libc.so.6" open-lib lib-sym 0<>
    [ELSE] false [THEN] ]
    [IF]
	bounds U+DO \ getentropy reads $100 bytes at maximum
	    I I' over - $100 umin getentropy
	    dup -1 = IF  errno #38 = IF  drop
		    \ oops, we don't have getentropy in the kernel
		    I I' over - $100 umin read-urnd
		ELSE  BUT  THEN \ resolve the other IF
		?ior  THEN
	$100 +LOOP
    [ELSE]







|
|


|
|







50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    \G legacy version of read-rnd
    s" /dev/urandom" r/o open-file throw >r
    tuck r@ read-file r> close-file throw
    throw <> !!insuff-rnd!! ;

: read-rnd ( addr u -- )
    \G read in entropy bytes from the systems entropy source
    [ [defined] getrandom [defined] linux and [IF]
	"getrandom" "libc.so.6" open-lib lib-sym 0<>
    [ELSE] false [THEN] ]
    [IF]
	bounds U+DO \ getrandom reads $100 bytes at maximum
	    I I' over - $100 umin 0 getrandom
	    dup -1 = IF  errno #38 = IF  drop
		    \ oops, we don't have getentropy in the kernel
		    I I' over - $100 umin read-urnd
		ELSE  BUT  THEN \ resolve the other IF
		?ior  THEN
	$100 +LOOP
    [ELSE]