Common channel is stopped when one participant leaves

bob-test.fs

@@ -29,7 +29,7 @@ init-client
     ." Bob revoked: " pkc $20 85type  cr
     replace-me
     ." Bob replaced: " pkc $20 85type  cr
-    do-disconnect ;
+    disconnect-me ;
 
 strict-keys off
 c:bob server-loop

client-tests.fs

@@ -55,7 +55,7 @@ Variable connect-nick  "test" connect-nick $!
 
 : c:dht ( n -- )  $8 $8 connect-nick $@ ins-ip c:connect 0 ?DO
 	c:add-tag "anonymous" c:fetch-tag \ c:fetch-tags
-    LOOP do-disconnect ;
+    LOOP  disconnect-me ;
 
 : std-block ( -- ) $10 blocksize! $A blockalign! ;
 

n2o.fs

@@ -83,7 +83,8 @@ Variable chat-key
 : wait-chat ( addr u -- )
     ." press key to connect to " 2dup type nick>pk keysize umin chat-key $!
     [: chat-key $@ pubkey $@ str= IF  bl unkey  THEN ;] is do-connect
-    key drop  ['] noop IS do-connect ;
+    key drop  ['] noop IS do-connect
+    [: 0 to connection #cr unkey ;] is do-disconnect ;
 
 
 \ commands for the command line user interface
@@ -232,7 +233,8 @@ get-current net2o-cmds definitions
 	2dup wait-chat
 	2dup search-connect ?dup-IF  >o 2drop rdrop
 	ELSE  $A $A nick-connect  THEN
-	ret+beacon do-chat ret-beacon c:disconnect  THEN ;
+	ret+beacon do-chat
+	connection  IF  ret-beacon c:disconnect  THEN  THEN ;
 
 \ script mode
 

net2o-connected.fs

@@ -24,7 +24,9 @@ reply-table $@ inherit-table context-table
 \g ### connection commands ###
 \g 
 $20 net2o: disconnect ( -- ) \g close connection
-    o 0= ?EXIT n2o:dispose-context un-cmd ;
+    o 0= ?EXIT
+    wait-task @ IF  <event o elit, ->disconnect wait-task @ event>
+    ELSE  n2o:dispose-context  THEN  un-cmd ;
 +net2o: set-ip ( $:string -- ) \g set address information
     $> setip-xt perform ;
 +net2o: get-ip ( -- ) \g request address information

net2o-dht.fs

@@ -358,7 +358,7 @@ previous
     net2o-code   expect-reply replace-me, cookie+request  end-code|
     -setip n2o:send-revoke ;
 
-: do-disconnect ( -- )
+: disconnect-me ( -- )
     net2o-code log .time s" Disconnect" $, type cr endwith
       close-all disconnect  end-code msg( ." disconnected" F cr )
     n2o:dispose-context msg( ." Disposed context" F cr ) ;
@@ -368,7 +368,7 @@ previous
     [: over >r insert-address r> free throw
       n2o:new-context $6 $6 n2o:connect msg( ." beacon: connected" F cr )
       replace-me msg( ." beacon: replaced" F cr )
-      do-disconnect ;] 3 net2o-task drop ;
+      disconnect-me ;] 3 net2o-task drop ;
 
 \ beacon handling
 

net2o-msg.fs

@@ -99,7 +99,7 @@ previous
 
 : do-chat ( -- )
     -timeout  BEGIN  key?  WHILE  key drop  REPEAT
-    BEGIN  get-input dup WHILE
+    BEGIN  get-input dup connection 0<> and  WHILE
 	    pad swap 2dup +resend-cmd send-text -timeout .chat
     REPEAT
     drop ;

net2o.fs

@@ -1018,10 +1018,13 @@ Variable context-table
 
 : dbg-connect ( -- )
     ." connected from: " pubkey $@ 85type cr ;
+: dbg-disconnect ( -- )
+    ." disconnecting: " pubkey $@ 85type cr ;
 
-Defer do-connect  ' dbg-connect IS do-connect
+Defer do-connect     ' dbg-connect IS do-connect
+Defer do-disconnect  ' dbg-disconnect IS do-disconnect
 
-event: ->connect ( connection -- ) .do-connect ;
+event: ->connect    ( connection -- ) .do-connect ;
 
 \ check for valid destination
 
@@ -2247,6 +2250,8 @@ $20 Constant signed-val
 	dispose  0 to connection
 	cmd( ." disposed" cr ) ;] file-sema c-section ;
 
+event: ->disconnect ( connection -- ) .do-disconnect n2o:dispose-context ;
+
 \ loops for server and client
 
 8 cells 1- Constant maxrequest#
@@ -2465,7 +2470,7 @@ require net2o-msg.fs
     [: .time ." Connected, o=" o hex. cr ;] $err ;
 
 : c:disconnect ( -- ) [: ." Disconnecting..." cr ;] $err
-    do-disconnect [: .packets profile( .times ) ;] $err ;
+    disconnect-me [: .packets profile( .times ) ;] $err ;
 
 : c:fetch-id ( pubkey u -- )
     net2o-code
@@ -2482,7 +2487,7 @@ require net2o-msg.fs
 Variable dhtnick "net2o-dhtroot" dhtnick $!
 
 : announce-me ( -- )
-    $8 $8 dhtnick $@ ins-ip dup add-beacon c:connect replace-me do-disconnect ;
+    $8 $8 dhtnick $@ ins-ip dup add-beacon c:connect replace-me disconnect-me ;
 
 : nick-lookup ( addr u -- )
     $A $E dhtnick $@ ins-ip c:connect
@@ -2492,7 +2497,7 @@ Variable dhtnick "net2o-dhtroot" dhtnick $!
 	over c@ '!' =  WHILE
 	    replace-key o> >o ke-pk $@ ." replace key: " 2dup 85type cr
 	    o o> >r 2dup c:fetch-id r> >o
-    REPEAT  o> 2drop do-disconnect ;
+    REPEAT  o> 2drop disconnect-me ;
 : insert-host ( o addr u -- o )
     2 pick >o ." check host: " 2dup .host cr
     host>$ o> IF