From: Bruno Deferrari <utizoc@gmail.com>
Date: Fri, 17 Apr 2009 00:35:26 +0000 (-0300)
Subject: irc.client: More robust reconnection
X-Git-Tag: 0.94~1526^2~5^2~5
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=34ec9af2ad82d18492c3670b9dad2c0fd5cff0db

irc.client: More robust reconnection
---

diff --git a/extra/irc/client/chats/chats.factor b/extra/irc/client/chats/chats.factor
index 7910afb22a..3f6cf4945d 100644
--- a/extra/irc/client/chats/chats.factor
+++ b/extra/irc/client/chats/chats.factor
@@ -33,7 +33,8 @@ TUPLE: irc-profile server port nickname password ;
 C: <irc-profile> irc-profile
 
 TUPLE: irc-client profile stream in-messages out-messages
-       chats is-running nick connect reconnect-time is-ready
+       chats is-running nick connect is-ready
+       reconnect-time reconnect-attempts
        exceptions ;
 
 : <irc-client> ( profile -- irc-client )
@@ -43,8 +44,9 @@ TUPLE: irc-client profile stream in-messages out-messages
         <mailbox>  >>in-messages
         <mailbox>  >>out-messages
         H{ } clone >>chats
-        15 seconds >>reconnect-time
+        30 seconds >>reconnect-time
+        10         >>reconnect-attempts
         V{ } clone >>exceptions
-        [ <inet> latin1 <client> ] >>connect ;
+        [ <inet> latin1 <client> drop ] >>connect ;
 
 SINGLETONS: irc-chat-end irc-end irc-disconnected irc-connected ;
diff --git a/extra/irc/client/internals/internals.factor b/extra/irc/client/internals/internals.factor
index 79aaf6bd5a..0a4fe11830 100644
--- a/extra/irc/client/internals/internals.factor
+++ b/extra/irc/client/internals/internals.factor
@@ -3,10 +3,17 @@
 USING: accessors assocs arrays concurrency.mailboxes continuations destructors
 hashtables io irc.client.base irc.client.chats irc.messages kernel namespaces
 strings words.symbol irc.messages.base irc.client.participants fry threads
-combinators irc.messages.parser ;
+combinators irc.messages.parser math ;
 EXCLUDE: sequences => join ;
 IN: irc.client.internals
 
+: do-connect ( server port quot: ( host port -- stream ) attempts -- stream/f )
+    dup 0 > [
+        [ drop call( host port -- stream ) ]
+        [ drop 15 sleep 1- do-connect ]
+        recover
+    ] [ 2drop 2drop f ] if ;
+
 : /NICK ( nick -- ) "NICK " prepend irc-print ;
 : /PONG ( text -- ) "PONG " prepend irc-print ;
 
@@ -15,18 +22,27 @@ IN: irc.client.internals
     "USER " prepend " hostname servername :irc.factor" append irc-print ;
 
 : /CONNECT ( server port -- stream )
-    irc> connect>> call( host port -- stream local ) drop ;
+    irc> [ connect>> ] [ reconnect-attempts>> ] bi do-connect ;
 
 : /JOIN ( channel password -- )
     [ " :" swap 3append ] when* "JOIN " prepend irc-print ;
 
+: try-connect ( -- stream/f )
+    irc> profile>> [ server>> ] [ port>> ] bi /CONNECT ;
+
+: (terminate-irc) ( -- )
+    irc> dup is-running>> [
+        f >>is-running
+        [ stream>> dispose ] keep
+        [ in-messages>> ] [ out-messages>> ] bi 2array
+        [ irc-end swap mailbox-put ] each
+    ] [ drop ] if ;
+
 : (connect-irc) ( -- )
-    irc> {
-        [ profile>> [ server>> ] [ port>> ] bi /CONNECT ]
-        [ (>>stream) ]
-        [ t swap (>>is-running) ]
-        [ in-messages>> [ irc-connected ] dip mailbox-put ]
-    } cleave ;
+    try-connect [
+        [ irc> ] dip >>stream t >>is-running
+        in-messages>> [ irc-connected ] dip mailbox-put
+    ] [ (terminate-irc) ] if* ;
 
 : (do-login) ( -- ) irc> nick>> /LOGIN ;
 
@@ -92,9 +108,7 @@ M: irc-message handle-outgoing-irc irc-message>string irc-print t ;
 
 : (handle-disconnect) ( -- )
     irc-disconnected irc> in-messages>> mailbox-put
-    irc> reconnect-time>> sleep
-    (connect-irc)
-    (do-login) ;
+    (connect-irc) (do-login) ;
 
 : handle-disconnect ( error -- ? )
     [ irc> exceptions>> push ] when*
@@ -155,12 +169,4 @@ M: irc-channel-chat remove-chat
     [ part new annotate-message irc-send ]
     [ name>> unregister-chat ] bi ;
 
-: (terminate-irc) ( -- )
-    irc> dup is-running>> [
-        f >>is-running
-        [ stream>> dispose ] keep
-        [ in-messages>> ] [ out-messages>> ] bi 2array
-        [ irc-end swap mailbox-put ] each
-    ] [ drop ] if ;
-
-: (speak) ( message irc-chat -- ) swap annotate-message irc-send ;
\ No newline at end of file
+: (speak) ( message irc-chat -- ) swap annotate-message irc-send ;