Check-in [ff117dd91d]
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:Lock/unlock of chat looks good now
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ff117dd91dddf3916976d920ce93e0119b629c52
User & Date: bernd 2019-07-14 21:15:24
Context
2019-07-15
21:37
Add chat permission settings check-in: 77cdb0b452 user: bernd tags: trunk
2019-07-14
21:15
Lock/unlock of chat looks good now check-in: ff117dd91d user: bernd tags: trunk
2019-07-13
11:03
Fix your-0key problem check-in: 429120512d user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to connect.fs. 

260
261
262
263
264
265
266

267
268
269
270
271
272
273

;
+net2o: request-qr-invitation ( -- )
    \g ask for an invitation as second stage of invitation handshake
    own-crypt? IF  qr-invite-me  THEN ;
+net2o: tmp-secret, ( -- )
    nest[ sec-cookie, ]nest ;
+net2o: qr-challenge ( $:challenge $:respose -- )

    $> $> c:0key qr-key $8 >keyed-hash qr-hash $40 c:hash@
    qr-hash over $10 umax str= dup invit:qr# and ulit, <invite-result>
    \ challenge will fail if less than 16 bytes
    IF  msg( ." challenge accepted" forth:cr )
	qr-tmp-val validated or!
    ELSE
	msg( ." challenge failed: " qr-hash $40 85type








>








260
261
262
263
264
265
266
267
268
269
270
271
272
273
274

;
+net2o: request-qr-invitation ( -- )
    \g ask for an invitation as second stage of invitation handshake
    own-crypt? IF  qr-invite-me  THEN ;
+net2o: tmp-secret, ( -- )
    nest[ sec-cookie, ]nest ;
+net2o: qr-challenge ( $:challenge $:respose -- )
    \ !!FIXME!! the qr-challenge should include pubkey+sig into the hash
    $> $> c:0key qr-key $8 >keyed-hash qr-hash $40 c:hash@
    qr-hash over $10 umax str= dup invit:qr# and ulit, <invite-result>
    \ challenge will fail if less than 16 bytes
    IF  msg( ." challenge accepted" forth:cr )
	qr-tmp-val validated or!
    ELSE
	msg( ." challenge failed: " qr-hash $40 85type

Changes to gui.fs. 

409
410
411
412
413
414
415


416
417
418
419
420
421
422
...
890
891
892
893
894
895
896


















897
898
899
900
901
902
903
...
995
996
997
998
999
1000
1001
1002

1003
1004
1005
1006
1007
1008
1009
1010

$FFFFFFFF new-color: edit-bg
$80FF80FF new-color: send-color
$00FF0020 new-color: pet-color
$FFFF80FF new-color, fvalue users-color#
$FFCCCCFF new-color, fvalue gps-color#
$000077FF new-color, fvalue chain-color#
$FF000000 $FF0000FF fade-color: show-error-color



: nick[] ( box o:nick -- box )
    [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ;

Hash: avatar#

glue new Constant glue*avatar
................................................................................
    string ['] utf8-sanitize $tmp }}text _underline_ 25%bv
    text-color!
    [: data >o text$ o> open-url ;]
    over click[]
    click( ." url: " dup ..parents cr )
    "url" name! msg-box .child+
; wmsg-class is msg:url


















:noname { d: string -- o }
    {{
	glue*l gps-color# slide-frame dup .button1
	string [: ."  GPS: " .coords ;] $tmp }}text 25%b
    }}z "gps" name! msg-box .child+
; wmsg-class is msg:coord
:noname { d: string -- o }
................................................................................
: (gui-msgs) ( gaddr u -- )
    reset-time
    64#0 to last-tick  last-bubble-pk $free
    0 to msg-par  0 to msg-box
    msgs-box .dispose-childs
    glue*lll }}glue msgs-box .child+
    2dup load-msg
    msg-log@ 2dup { log u }

    dup gui-msgs# cells - 0 max /string bounds ?DO
	I $@ { d: msgt }
	msgt ['] wmsg-display wmsg-o .catch IF
	    <err> ." invalid entry" <default> 2drop
	THEN
    cell +LOOP
    log free throw  msgs-box >o resized vp-bottom o>
    chat-edit engage ;








>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
>
|








409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
...
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
....
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031

$FFFFFFFF new-color: edit-bg
$80FF80FF new-color: send-color
$00FF0020 new-color: pet-color
$FFFF80FF new-color, fvalue users-color#
$FFCCCCFF new-color, fvalue gps-color#
$000077FF new-color, fvalue chain-color#
$FF000000 $FF0000FF fade-color: show-error-color
$338833FF text-color: lock-color
$883333FF text-color: lockout-color

: nick[] ( box o:nick -- box )
    [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ;

Hash: avatar#

glue new Constant glue*avatar
................................................................................
    string ['] utf8-sanitize $tmp }}text _underline_ 25%bv
    text-color!
    [: data >o text$ o> open-url ;]
    over click[]
    click( ." url: " dup ..parents cr )
    "url" name! msg-box .child+
; wmsg-class is msg:url
:noname ( d: string -- o )
    0 .v-dec$ dup IF
	msg-key!  msg-group-o .msg:+lock
	{{
	    glue*l lock-color x-color slide-frame dup .button1
	    greenish l" chat is locked" }}text' 25%bv
	}}z
    ELSE  2drop
	{{
	    glue*l lockout-color x-color slide-frame dup .button1
	    show-error-color 1e +to x-color l" locked out of chat" }}text' 25%bv
	}}z
    THEN "lock" name! msg-box .child+ ; wmsg-class is msg:lock
:noname ( -- o )
	{{
	    glue*l lock-color x-color slide-frame dup .button1
	    blackish l" chat is unlocked" }}text' 25%bv
	}}z msg-box .child+ ;
:noname { d: string -- o }
    {{
	glue*l gps-color# slide-frame dup .button1
	string [: ."  GPS: " .coords ;] $tmp }}text 25%b
    }}z "gps" name! msg-box .child+
; wmsg-class is msg:coord
:noname { d: string -- o }
................................................................................
: (gui-msgs) ( gaddr u -- )
    reset-time
    64#0 to last-tick  last-bubble-pk $free
    0 to msg-par  0 to msg-box
    msgs-box .dispose-childs
    glue*lll }}glue msgs-box .child+
    2dup load-msg
    gui-msgs# msg-log@
    { log u } u r> - 0 max { u' }  log u' ?search-lock
    log u u' /string bounds ?DO
	I $@ { d: msgt }
	msgt ['] wmsg-display wmsg-o .catch IF
	    <err> ." invalid entry" <default> 2drop
	THEN
    cell +LOOP
    log free throw  msgs-box >o resized vp-bottom o>
    chat-edit engage ;

Changes to helper.fs. 

295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310

    ret0 net2o:new-context >o rdrop dest-pk ;

in net2o : pklookup? ( pkaddr u -- flag )
    2dup keysize2 safe/string hostc$ $! key2| 2dup pkc over str= to ?myself
    2dup >d#id { id }
    id .dht-host $[]# 0= IF  2dup pk-lookup  2dup >d#id to id  THEN
    2dup make-context
    false id dup .dht-host ['] insert-host? $[]map drop nip nip
    lastaddr# IF  lastaddr# cell+ $@ dest-0key sec!  THEN ;
in net2o : pklookup ( pkaddr u -- )
    net2o:pklookup? 0= !!no-address!! ;

: ?nat-done ( n -- )
    nat( ." req done, issue nat request" forth:cr )
    connect-rest +flow-control +resend ?nat ;
: no-nat-done ( n -- )








|
<








295
296
297
298
299
300
301
302

303
304
305
306
307
308
309

    ret0 net2o:new-context >o rdrop dest-pk ;

in net2o : pklookup? ( pkaddr u -- flag )
    2dup keysize2 safe/string hostc$ $! key2| 2dup pkc over str= to ?myself
    2dup >d#id { id }
    id .dht-host $[]# 0= IF  2dup pk-lookup  2dup >d#id to id  THEN
    2dup make-context
    false id dup .dht-host ['] insert-host? $[]map drop nip nip ;

in net2o : pklookup ( pkaddr u -- )
    net2o:pklookup? 0= !!no-address!! ;

: ?nat-done ( n -- )
    nat( ." req done, issue nat request" forth:cr )
    connect-rest +flow-control +resend ?nat ;
: no-nat-done ( n -- )

Changes to keys.fs. 

1293
1294
1295
1296
1297
1298
1299

1300
1301
1302
1303
1304
1305
1306


also net2o-base

: invite-me ( -- )
    [: 0key, nest[ mypk2nick$ $, pubkey $@ key| $, invite cookie+request
      ]tmpnest end-cmd ;] is expect-reply? ;
: qr-challenge, ( -- )

    $10 rng$ 2dup $, qr-key $8
    msg( ." challenge: " 2over 85type space 2dup xtype forth:cr )
    c:0key >keyed-hash
    qr-hash $40 c:hash@ qr-hash $10 $, qr-challenge ;
: qr-invite-me ( -- )
    [: 0key, nest[ qr-challenge,
      mypk2nick$ $, pubkey $@ key| $, invite cookie+request








>








1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307


also net2o-base

: invite-me ( -- )
    [: 0key, nest[ mypk2nick$ $, pubkey $@ key| $, invite cookie+request
      ]tmpnest end-cmd ;] is expect-reply? ;
: qr-challenge, ( -- )
    \ !!FIXME!! the qr-challenge should include pubkey+sig into the hash
    $10 rng$ 2dup $, qr-key $8
    msg( ." challenge: " 2over 85type space 2dup xtype forth:cr )
    c:0key >keyed-hash
    qr-hash $40 c:hash@ qr-hash $10 $, qr-challenge ;
: qr-invite-me ( -- )
    [: 0key, nest[ qr-challenge,
      mypk2nick$ $, pubkey $@ key| $, invite cookie+request

Changes to lang/de. 

9
10
11
12
13
14
15



16
17
18
19

Spitznamen
Öffentlicher Schlüssel
Schlüsselsignaturdatum
Meine Schlüssel
Meine Gruppen
Meine Freunde
Posting




Niemand ist online, speichere weg

Einladungen








>
>
>





9
10
11
12
13
14
15
16
17
18
19
20
21
22

Spitznamen
Öffentlicher Schlüssel
Schlüsselsignaturdatum
Meine Schlüssel
Meine Gruppen
Meine Freunde
Posting




Niemand ist online, speichere weg

Einladungen

Changes to lang/en. 

9
10
11
12
13
14
15



16
17
18
19

Nick+Pet
Pubkey
Key date
My key
My groups
My peers
Post




Nobody is online, saving away

Invitations








>
>
>

|



9
10
11
12
13
14
15
16
17
18
19
20
21
22

Nick+Pet
Pubkey
Key date
My key
My groups
My peers
Post




Nobody is online

Invitations

Changes to lang/zh. 

9
10
11
12
13
14
15



16
17
18
19

昵称
公钥
关键签名日期
我的钥匙
我的集团
我的朋友
贴子




没有人在线，保存了
发送
请帖








>
>
>





9
10
11
12
13
14
15
16
17
18
19
20
21
22

昵称
公钥
关键签名日期
我的钥匙
我的集团
我的朋友
贴子




没有人在线，保存了
发送
请帖

Changes to msg.fs. 

698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
...
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
....
1003
1004
1005
1006
1007
1008
1009






1010
1011
1012
1013

1014
1015
1016
1017
1018
1019
1020
1021
....
1484
1485
1486
1487
1488
1489
1490
1491


1492
1493
1494
1495
1496
1497
1498

    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 ( -- )
    +zero16 nest$
    0 msg-group-o .msg:keys[] $[]@ encrypt$
    ['] .encsign ']nestsig ;

\ nest-sig for msg/msging classes

' msg-dec?-sig? ' message  2dup
msging-class is start-req
msging-class is nest-sig
msg-class is start-req
msg-class is nest-sig

' context-table is gen-table

also }scope

msging-table $save

................................................................................
: 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
................................................................................
    2dup 2 - + c@ $80 and IF  net2o-base:msg-dec-sig? IF
	    2drop <err> ." Undecryptable message" <default> cr  EXIT
	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-group-o .msg:-lock
    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








|













<
|
|
|
|







 







|







 







>
>
>
>
>
>



|
>
|







 







|
>
>








698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718

719
720
721
722
723
724
725
726
727
728
729
...
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
....
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
....
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506

    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 ( -- )
    +zero16 nest$
    0 msg-group-o .msg:keys[] $[]@ encrypt$
    ['] .encsign ']nestsig ;

\ nest-sig for msg/msging classes


' message msging-class is start-req
:noname check-date >r 2dup r> ; msging-class is nest-sig
' message msg-class is start-req
' msg-dec?-sig? msg-class is nest-sig

' context-table is gen-table

also }scope

msging-table $save

................................................................................
: 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
................................................................................
    2dup 2 - + c@ $80 and IF  net2o-base:msg-dec-sig? IF
	    2drop <err> ." Undecryptable message" <default> cr  EXIT
	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
: ?search-lock ( addr u -- )
    BEGIN  dup  WHILE  cell- 2dup + $@ sigpksize# - 1- + c@ $2E = IF
		2dup + $@ ['] msg:display catch IF  2drop  THEN
		msg-group-o .msg:keys[] $[]# IF  drop 0  THEN
	    THEN
    REPEAT  2drop ;
: msg-tredisplay ( n -- )
    reset-time
    msg-group-o >o msg:?otr msg:-otr o> >r
    [:  cells >r msg-log@
	{ log u } u r> - 0 max { u' }  log u' ?search-lock
	log u u' /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-group-o .msg:-lock
    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
    [: net2o-base:msg-unlock ;] send-avalanche
; 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

Fossil 2.10 [a56cb60278] 2019-10-07 17:20:47