permit reconnection of a given picoirc context

This adds a reconnect command to picoirc to get an existing context to
reconnect. This is useful for accidental disconnects from wifi lines or
proxy timeouts.

Rearranged the main read event handler to ensure we test for eof after
reading properly.

Signed-off-by: Pat Thoyts <patthoyts@users.sourceforge.net>

diff --git a/lib/irc/picoirc.tcl b/lib/irc/picoirc.tcl
index 06aba9f3fdb829914e4a99134cb32341d9b5cbdc..c6429aac98dc9a981e0cacc6e2242a256a3453d3 100644 (file)
--- a/lib/irc/picoirc.tcl
+++ b/lib/irc/picoirc.tcl
@@ -22,6 +22,7 @@ namespace eval ::picoirc {
     variable defaults {
         server   "irc.freenode.net"
         port     6667
+        proxy    direct
         channel  ""
         callback ""
         motd     {}
@@ -59,7 +60,6 @@ proc ::picoirc::connect {callback nick args} {
     if {[info exists passwd] && $passwd ne ""} {set irc(passwd) $passwd}
     set irc(callback) $callback
     set irc(nick) $nick
-    Callback $context init
 
     if {[info exists ::env(SOCKS_SERVER)] 
         && $::env(SOCKS_SERVER) ne "" 
@@ -67,12 +67,32 @@ proc ::picoirc::connect {callback nick args} {
     } then {
         foreach {socks_host socks_port} [split $::env(SOCKS_SERVER) :] break
         if {$socks_port eq {}} {set socks_port 1080}
-        set irc(socket) [socket -async $socks_host $socks_port]
-        fileevent $irc(socket) writable [list [namespace origin SocksConnect] $context]
-    } else {
-        set irc(socket) [socket -async $irc(server) $irc(port)]
-        fileevent $irc(socket) writable [list [namespace origin Write] $context]
+        set irc(proxy) [list socks5 $socks_host $socks_port]
+    }
+    
+    Callback $context init
+    reconnect $context
+    return $context
+}
+
+proc ::picoirc::reconnect {context} {
+    upvar #0 $context irc
+    switch -exact -- [set type [lindex $irc(proxy) 0]] {
+        socks5 {
+            lassign $irc(proxy) type host port
+            set irc(socket) [socket -async $host $port]
+            set handler [list [namespace origin SocksConnect] $context]
+        }
+        direct {
+            set irc(socket) [socket -async $irc(server) $irc(port)]
+            set handler [list [namespace origin Write] $context]
+        }
+        default {
+            return -code error "unknown proxy type \"$type\":\
+                must be direct or socks5"
+        }
     }
+    fileevent $irc(socket) writable $handler
     return $context
 }
 
@@ -109,8 +129,7 @@ proc ::picoirc::SocksConnected {context token status} {
         Write $context
     } else {
         Callback $context close $status
-        close $irc(socket)
-        unset irc
+        catch {close $irc(socket)}
     }
     return
 }
@@ -120,8 +139,7 @@ proc ::picoirc::Write {context} {
     fileevent $irc(socket) writable {}
     if {[set err [fconfigure $irc(socket) -error]] ne ""} {
         Callback $context close $err
-        close $irc(socket)
-        unset irc
+        catch {close $irc(socket)}
         return
     }
     fconfigure $irc(socket) -blocking 0 -buffering line -translation crlf -encoding utf-8
@@ -157,107 +175,127 @@ proc ::picoirc::Splitirc {s} {
 
 proc ::picoirc::Read {context} {
     upvar #0 $context irc
-    if {[eof $irc(socket)]} {
+    if {[catch {gets $irc(socket) line} status]} {
+        Callback $context close $status
+        catch {close $irc(socket)}
+    } elseif {[eof $irc(socket)]} {
         fileevent $irc(socket) readable {}
         Callback $context close
         close $irc(socket)
-        unset irc
+    } elseif {$status == -1} {
+        # incomplete line
+    } else {
+        Receive $context $line
+    }
+}
+
+proc ::picoirc::Recv2 {context line} {
+    upvar #0 $context irc
+
+    set a [string first " " $line]
+    foreach {nick flag user host} [Splitirc [string range $line 0 $a-1]] break
+    set b [string first " " $line $a+1]
+    set code [string range $line $a+1 $b-1]
+    set line [string range $line $b+1 end]
+    
+    return [list $nick $flag $user $host $code]
+}
+
+proc ::picoirc::Receive {context line} {
+    upvar #0 $context irc
+    # the callback can return -code break to prevent processing the read
+    if {[catch {Callback $context debug read $line}] == 3} {
         return
     }
-    if {[gets $irc(socket) line] != -1} {
-        if {[string match "PING*" $line]} {
-            send $context "PONG [info hostname] [lindex [split $line] 1]"
-            return
-        }
-        # the callback can return -code break to prevent processing the read
-        if {[catch {Callback $context debug read $line}] == 3} {
-            return
-        }
-        if {[regexp {:([^!]*)![^ ].* +PRIVMSG ([^ :]+) +:(.*)} $line -> \
-                 nick target msg]} {
-            set type ""
-            if {[regexp {\001(\S+)(.*)?\001} $msg -> ctcp data]} {
-                switch -- $ctcp {
-                    ACTION { set type ACTION ; set msg $data }
-                    VERSION {
-                        send $context "NOTICE $nick :\001VERSION [Version $context]\001"
-                        return 
-                    }
-                    PING {
-                        send $context "NOTICE $nick :\001PING [lindex $data 0]\001"
-                        return
-                    }
-                    TIME {
-                        set time [clock format [clock seconds] \
-                                      -format {%a %b %d %H:%M:%S %Y %Z}]
-                        send $context "NOTICE $nick :\001TIME $time\001"
-                        return
-                    }
-                    default {
-                        set err [string map [list \001 ""] $msg]
-                        send $context "NOTICE $nick :\001ERRMSG $err : unknown query\001"
-                        return
-                    }
-                }
-            }
-            Callback $context chat $target $nick $msg $type
-        } elseif {[regexp {^:((?:([^ ]+) +){1,}?):(.*)$} $line -> parts junk rest]} {
-            foreach {server code target fourth fifth} [split $parts] break
-            switch -- $code {
-                001 - 002 - 003 - 004 - 005 - 250 - 251 - 252 - 
-                254 - 255 - 265 - 266 { return }
-                433 {
-                    variable nickid ; if {![info exists nickid]} {set nickid 0}
-                    set seqlen [string length [incr nickid]]
-                    set irc(nick) [string range $irc(nick) 0 [expr 8-$seqlen]]$nickid
-                    send $context "NICK $irc(nick)"
-                }
-                353 { set irc(users) [concat $irc(users) $rest]; return }
-                366 {
-                    Callback $context userlist $fourth $irc(users)
-                    set irc(users) {}
-                    return
-                }
-                332 { Callback $context topic $fourth $rest; return }
-                333 { return }
-                375 { set irc(motd) {} ; return }
-                372 { append irc(motd) $rest "\n"; return}
-                376 { return }
-                311 {
-                    foreach {server code target nick name host x} [split $parts] break
-                    set irc(whois,$nick) [list name $name host $host userinfo $rest]
-                    return
+    if {[string match "PING*" $line]} {
+        send $context "PONG [info hostname] [lindex [split $line] 1]"
+        return
+    }
+
+    if {[regexp {:([^!]*)![^ ].* +PRIVMSG ([^ :]+) +:(.*)} $line -> \
+             nick target msg]} {
+        set type ""
+        if {[regexp {\001(\S+)(.*)?\001} $msg -> ctcp data]} {
+            switch -- $ctcp {
+                ACTION { set type ACTION ; set msg $data }
+                VERSION {
+                    send $context "NOTICE $nick :\001VERSION [Version $context]\001"
+                    return 
                 }
-                301 - 312 - 317 - 320 - 330 { return }
-                319 { lappend irc(whois,$fourth) channels $rest; return }
-                318 {
-                    if {[info exists irc(whois,$fourth)]} {
-                        Callback $context userinfo $fourth $irc(whois,$fourth)
-                        #unset irc(whois,$fourth)
-                    }
+                PING {
+                    send $context "NOTICE $nick :\001PING [lindex $data 0]\001"
                     return
                 }
-                JOIN {
-                    foreach {n f u h} [Splitirc $server] break
-                    Callback $context traffic entered $rest $n
+                TIME {
+                    set time [clock format [clock seconds] \
+                                  -format {%a %b %d %H:%M:%S %Y %Z}]
+                    send $context "NOTICE $nick :\001TIME $time\001"
                     return
                 }
-                NICK {
-                    foreach {n f u h} [Splitirc $server] break
-                    Callback $context traffic nickchange {} $n $rest
+                default {
+                    set err [string map [list \001 ""] $msg]
+                    send $context "NOTICE $nick :\001ERRMSG $err : unknown query\001"
                     return
                 }
-                QUIT - PART {
-                    foreach {n f u h} [Splitirc $server] break
-                    Callback $context traffic left $target $n
-                    return
+            }
+        }
+        Callback $context chat $target $nick $msg $type
+    } elseif {[regexp {^:((?:([^ ]+) +){1,}?):(.*)$} $line -> parts junk rest]} {
+        foreach {server code target fourth fifth} [split $parts] break
+        switch -- $code {
+            001 - 002 - 003 - 004 - 005 - 250 - 251 - 252 - 
+            254 - 255 - 265 - 266 { return }
+            433 {
+                variable nickid ; if {![info exists nickid]} {set nickid 0}
+                set seqlen [string length [incr nickid]]
+                set irc(nick) [string range $irc(nick) 0 [expr 8-$seqlen]]$nickid
+                send $context "NICK $irc(nick)"
+            }
+            353 { set irc(users) [concat $irc(users) $rest]; return }
+            366 {
+                Callback $context userlist $fourth $irc(users)
+                set irc(users) {}
+                return
+            }
+            332 { Callback $context topic $fourth $rest; return }
+            333 { return }
+            375 { set irc(motd) {} ; return }
+            372 { append irc(motd) $rest "\n"; return}
+            376 { return }
+            311 {
+                foreach {server code target nick name host x} [split $parts] break
+                set irc(whois,$nick) [list name $name host $host userinfo $rest]
+                return
+            }
+            301 - 312 - 317 - 320 - 330 { return }
+            319 { lappend irc(whois,$fourth) channels $rest; return }
+            318 {
+                if {[info exists irc(whois,$fourth)]} {
+                    Callback $context userinfo $fourth $irc(whois,$fourth)
+                    unset irc(whois,$fourth)
                 }
+                return
+            }
+            JOIN {
+                foreach {n f u h} [Splitirc $server] break
+                Callback $context traffic entered $rest $n
+                return
+            }
+            NICK {
+                foreach {n f u h} [Splitirc $server] break
+                Callback $context traffic nickchange {} $n $rest
+                return
+            }
+            QUIT - PART {
+                foreach {n f u h} [Splitirc $server] break
+                Callback $context traffic left $target $n
+                return
             }
-            set n [string first " " $line]
-            Callback $context system "" [string range $line [incr n] end]
-        } else {
-            Callback $context system "" $line
         }
+        set n [string first " " $line]
+        Callback $context system "" [string range $line [incr n] end]
+    } else {
+        Callback $context system "" $line
     }
 }