Check-in [271f857838]
Not logged in

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

Overview
Comment:Check connected status in dhtroot
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 271f857838b9c0281aaf40ff1633cf688378d193
User & Date: bernd 2019-04-18 21:17:32
Context
2019-04-18
21:30
Use new online? check check-in: 7ad73e33fe user: bernd tags: trunk
21:17
Check connected status in dhtroot check-in: 271f857838 user: bernd tags: trunk
2019-04-11
21:25
More catastrophies in presentation check-in: 772fa80a01 user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to dht.fs.

436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
: disconnect-me ( -- )
    connection >o  data-rmap 0= IF  o> EXIT  THEN
    max-timeouts 4 umin to max-timeouts \ be impatient with disconnects
    +resend -flow-control
    net2o-code expect-reply
      connect( log .time s" Disconnect" $, type cr end-with )
      close-all ack rewind end-with disconnect
    end-code| msg( ." disconnected" forth:cr )
    net2o:dispose-context msg( ." Disposed context" forth:cr ) o> ;

\\\
Local Variables:
forth-local-words:
    (
     (("net2o:" "+net2o:") definition-starter (font-lock-keyword-face . 1)







|







436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
: disconnect-me ( -- )
    connection >o  data-rmap 0= IF  o> EXIT  THEN
    max-timeouts 4 umin to max-timeouts \ be impatient with disconnects
    +resend -flow-control
    net2o-code expect-reply
      connect( log .time s" Disconnect" $, type cr end-with )
      close-all ack rewind end-with disconnect
    end-code| msg( ." dht: disconnected" forth:cr )
    net2o:dispose-context msg( ." Disposed context" forth:cr ) o> ;

\\\
Local Variables:
forth-local-words:
    (
     (("net2o:" "+net2o:") definition-starter (font-lock-keyword-face . 1)

Changes to dvcs.fs.

940
941
942
943
944
945
946

947
948
949
950
951
952
953
...
984
985
986
987
988
989
990

991
992
993
994
995
996
997
998

999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010

1011

1012
1013
1014
1015
1016
1017
1018
: dvcs-connect ( addr u -- )
    dvcs-bufs# chat#-connect? IF  2 dvcs-request# !  dvcs-greet  THEN ;

: dvcs-connect-key ( addr u -- )
    key>group ?load-msgn
    dup 0= IF  2drop "" msg-group$ $@ msg-groups #!  THEN
    2dup search-connect ?dup-IF  >o +group rdrop 2drop  EXIT  THEN

    2dup pk-peek?  IF  dvcs-connect  ELSE  2drop  THEN ;

: dvcs-connects? ( -- flag )
    chat-keys ['] dvcs-connect-key $[]map dvcs-request# @ 0> ;

: wait-dvcs-request ( -- )
    BEGIN  dvcs-request# @  WHILE  stop  REPEAT ;
................................................................................
    /sync-reqs +LOOP ;

: dvcs-data-sync ( -- )
    sync-file-list[] $[]off  branches[] $[]off
    msg-group$ $@ ?msg-log
    dvcs:commits @ .chat>branches-loop
    dvcs:commits @ .dvcs-needed-files

    sync-file-list[] connection .get-needed-files ;

: dvcs-ref-sync ( -- )
    search-last-rev id>branches
    dvcs:new-dvcs-refs >o
    branches>dvcs
    dvcs:refs[] $[]# 0 ?DO
	." ref: " I dvcs:refs[] $[]@ 85type cr  LOOP

    dvcs:refs[] connection .get-needed-files
    dvcs:dispose-dvcs-refs o> ;

: handle-fetch ( -- )  ?.net2o/objects
    dvcs:new-dvcs >o  pull-readin
    msg( ." === syncing metadata ===" forth:cr )
    0 >o dvcs-connects? IF  +dvcs-sync-done  wait-dvcs-request  THEN o>
    msg( ." === syncing data ===" forth:cr )
    dvcs-data-sync
    msg( ." === data sync done ===" forth:cr )
    dvcs-ref-sync
    msg( ." === ref sync done ===" forth:cr )

    connection .data-rmap IF  msg-group$ $@ >group last# silent-leave-chat  THEN

    dvcs:dispose-dvcs o> ;

: handle-clone ( -- )
    0 chat-keys !@ { w^ clone-keys }
    clone-keys [: >dir  2dup chat-keys $+[]!
	[: @/ 2swap
	    '#' $split dup 0= IF  2drop  ELSE  2nip  THEN







>







 







>
|







>
|











>
|
>







940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
...
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
: dvcs-connect ( addr u -- )
    dvcs-bufs# chat#-connect? IF  2 dvcs-request# !  dvcs-greet  THEN ;

: dvcs-connect-key ( addr u -- )
    key>group ?load-msgn
    dup 0= IF  2drop "" msg-group$ $@ msg-groups #!  THEN
    2dup search-connect ?dup-IF  >o +group rdrop 2drop  EXIT  THEN
    \ check for disconnected here or in pk-peek?
    2dup pk-peek?  IF  dvcs-connect  ELSE  2drop  THEN ;

: dvcs-connects? ( -- flag )
    chat-keys ['] dvcs-connect-key $[]map dvcs-request# @ 0> ;

: wait-dvcs-request ( -- )
    BEGIN  dvcs-request# @  WHILE  stop  REPEAT ;
................................................................................
    /sync-reqs +LOOP ;

: dvcs-data-sync ( -- )
    sync-file-list[] $[]off  branches[] $[]off
    msg-group$ $@ ?msg-log
    dvcs:commits @ .chat>branches-loop
    dvcs:commits @ .dvcs-needed-files
    sync-file-list[] $[]# 0> connection and
    IF    sync-file-list[] connection .get-needed-files  THEN ;

: dvcs-ref-sync ( -- )
    search-last-rev id>branches
    dvcs:new-dvcs-refs >o
    branches>dvcs
    dvcs:refs[] $[]# 0 ?DO
	." ref: " I dvcs:refs[] $[]@ 85type cr  LOOP
    dvcs:refs[] $[]# 0> connection and
    IF  dvcs:refs[] connection .get-needed-files  THEN
    dvcs:dispose-dvcs-refs o> ;

: handle-fetch ( -- )  ?.net2o/objects
    dvcs:new-dvcs >o  pull-readin
    msg( ." === syncing metadata ===" forth:cr )
    0 >o dvcs-connects? IF  +dvcs-sync-done  wait-dvcs-request  THEN o>
    msg( ." === syncing data ===" forth:cr )
    dvcs-data-sync
    msg( ." === data sync done ===" forth:cr )
    dvcs-ref-sync
    msg( ." === ref sync done ===" forth:cr )
    connection ?dup-IF
	.data-rmap IF  msg-group$ $@ >group last# silent-leave-chat  THEN
    THEN
    dvcs:dispose-dvcs o> ;

: handle-clone ( -- )
    0 chat-keys !@ { w^ clone-keys }
    clone-keys [: >dir  2dup chat-keys $+[]!
	[: @/ 2swap
	    '#' $split dup 0= IF  2drop  ELSE  2nip  THEN

Changes to gui.fs.

396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
...
954
955
956
957
958
959
960


961
962
963
964
965
966
967
....
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
$88FF88FF color: my-signal
$CCFFCCFF color: other-signal
$CC00CCFF color: my-signal-otr
$880088FF color: other-signal-otr
$4444CCFF text-color: link-blue
$44CC44FF text-color: re-green
$CC4444FF text-color: obj-red
$BBDDDDFF text-color: msg-bg
$00BFFFFF text-color: light-blue
$44FF44FF text-color: greenish
$33883366 color: day-color
$88333366 color: hour-color
$FFFFFFFF text-color: realwhite

: nick[] ( box o:nick -- box )
................................................................................
' wmsg-display wmsg-class to msg:display

#128 Value gui-msgs# \ display last 128 messages
0 Value chat-edit    \ chat edit field

: (gui-msgs) ( gaddr u -- )
    reset-time


    msgs-box .dispose-childs
    glue*lll }}glue msgs-box .child+
    2dup load-msg ?msg-log
    last# msg-log@ 2dup { log u }
    dup gui-msgs# cells - 0 max /string bounds ?DO
	I $@ { d: msgt }
	msgt ['] wmsg-display wmsg-o .catch IF
................................................................................
\ top box

box-actor class
end-class net2o-actor

:noname ( ekey -- )
    case
	k-f5 of  color-theme 0<> IF  anim-end 0.25e o
		[: 1e fswap f- fdup f>s to color-theme 0.5e f+ ColorMode! +sync +vpsync ;]
		>animate  THEN   endof
	k-f6 of  color-theme 0=  IF  anim-end 0.25e o
		[:             fdup f>s to color-theme 0.5e f+ ColorMode! +sync +vpsync ;]
		>animate  THEN   endof
	[ box-actor :: ekeyed ]  EXIT
    endcase ; net2o-actor to ekeyed

: net2o[] ( o -- o )
    >o net2o-actor new !act o o> ;








<







 







>
>







 







|
|

|
|







396
397
398
399
400
401
402

403
404
405
406
407
408
409
...
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
....
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
$88FF88FF color: my-signal
$CCFFCCFF color: other-signal
$CC00CCFF color: my-signal-otr
$880088FF color: other-signal-otr
$4444CCFF text-color: link-blue
$44CC44FF text-color: re-green
$CC4444FF text-color: obj-red

$00BFFFFF text-color: light-blue
$44FF44FF text-color: greenish
$33883366 color: day-color
$88333366 color: hour-color
$FFFFFFFF text-color: realwhite

: nick[] ( box o:nick -- box )
................................................................................
' wmsg-display wmsg-class to msg:display

#128 Value gui-msgs# \ display last 128 messages
0 Value chat-edit    \ chat edit field

: (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
    last# msg-log@ 2dup { log u }
    dup gui-msgs# cells - 0 max /string bounds ?DO
	I $@ { d: msgt }
	msgt ['] wmsg-display wmsg-o .catch IF
................................................................................
\ top box

box-actor class
end-class net2o-actor

:noname ( ekey -- )
    case
	k-f5 of  color-theme 0=  IF  anim-end 0.25e o
		[:             fdup f>s to color-theme 0.5e f+ ColorMode! +sync +vpsync ;]
		>animate  THEN   endof
	k-f6 of  color-theme 0<> IF  anim-end 0.25e o
		[: 1e fswap f- fdup f>s to color-theme 0.5e f+ ColorMode! +sync +vpsync ;]
		>animate  THEN   endof
	[ box-actor :: ekeyed ]  EXIT
    endcase ; net2o-actor to ekeyed

: net2o[] ( o -- o )
    >o net2o-actor new !act o o> ;

Changes to helper.fs.

29
30
31
32
33
34
35


36
37
38
39


40

41

42
43
44
45
46

47
48
49
50
51
52
53
...
137
138
139
140
141
142
143

144
145
146
147
148
149
150
	>host dhtnick $@ nick>pk drop date-sig? 0= IF
	    sigsize# -  new-addr dup dhtroot-addr !
	    EXIT  THEN  THEN
    2drop 0 ;

: !0key ( -- )
    dest-0key< @ IF


	ind-addr @ 0= IF  dest-0key< sec@ lastaddr# cell+ $!  THEN
	dest-0key> @ IF  dest-0key< sec@ dest-0key> @ sec!  THEN
    THEN ;



: dhtroot ( -- )

    dhtroot-addr@ ?dup-IF  0 swap

	[: dup ?EXIT
	  check-addr1 IF  insert-address nip
	  ELSE  2drop  THEN ;] addr>sock
    ELSE  net2o-host $@ net2o-port insert-ip
    THEN  return-addr dup $10 erase be!

    ind-addr off  !0key ;

: dhtroot-off ( --- )
    dhtroot-addr$ $off
    dhtroot-addr @ ?dup-IF  net2o:dispose-addr  THEN ;

: ins-ip ( -- net2oaddr )
................................................................................
[IFDEF] android     require android/net.fs  [ELSE]
    [IFDEF] PF_NETLINK  require linux/net.fs    [THEN]
[THEN]

\ announce and renat

: announce-me ( -- )

    dht-connect replace-me -other  announced on ;

: renat-all ( -- ) beacon( ." remove all beacons" cr )
    [IFDEF] renat-complete [: [THEN]
	0 .!my-addr dht-disconnect \ old DHT may be stale
	announce-me \ if we succeed here, we can try the rest
	beacons# #frees







>
>
|



>
>

>
|
>

|
|


>







 







>







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
	>host dhtnick $@ nick>pk drop date-sig? 0= IF
	    sigsize# -  new-addr dup dhtroot-addr !
	    EXIT  THEN  THEN
    2drop 0 ;

: !0key ( -- )
    dest-0key< @ IF
	\ check for disconnected state
	ind-addr @ 0= lastaddr# and IF
	    dest-0key< sec@ lastaddr# cell+ $!  THEN
	dest-0key> @ IF  dest-0key< sec@ dest-0key> @ sec!  THEN
    THEN ;

0 value online?

: dhtroot ( -- )
    0 to lastaddr#
    dhtroot-addr@ ?dup-IF
	0 swap
	[: dup ?EXIT
	    check-addr1 IF  insert-address nip
	    ELSE  2drop  THEN ;] addr>sock
    ELSE  net2o-host $@ net2o-port insert-ip
    THEN  return-addr dup $10 erase be!
    lastaddr# 0<> to online?
    ind-addr off  !0key ;

: dhtroot-off ( --- )
    dhtroot-addr$ $off
    dhtroot-addr @ ?dup-IF  net2o:dispose-addr  THEN ;

: ins-ip ( -- net2oaddr )
................................................................................
[IFDEF] android     require android/net.fs  [ELSE]
    [IFDEF] PF_NETLINK  require linux/net.fs    [THEN]
[THEN]

\ announce and renat

: announce-me ( -- )
    \ Check for disconnected state
    dht-connect replace-me -other  announced on ;

: renat-all ( -- ) beacon( ." remove all beacons" cr )
    [IFDEF] renat-complete [: [THEN]
	0 .!my-addr dht-disconnect \ old DHT may be stale
	announce-me \ if we succeed here, we can try the rest
	beacons# #frees