Add socks5 support to picoirc and removed freenode specific code.

If a socks5 package is present and the SOCKS_SERVER environment variable
has been set we can connect via a socks proxy. This enables use of the ssh
dynamic tunnels for instance.

The Splitirc function was freenode specific. This should now work for any
network and the updated freenode ircd in particular.

Removed the #tcl bot specific handling - this should be done only in
application code, not by library code.

Fixed accumulation of the motd message and the whois results. Also avoid
conversion of the irc response into a list for default message handling.

/msg processing has been fixed. It sent the wrong variable previously.

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

diff --git a/lib/irc/picoirc.tcl b/lib/irc/picoirc.tcl
index e0f33b53aa84716c7651b56e44e61af04bfeb6ae..06aba9f3fdb829914e4a99134cb32341d9b5cbdc 100644 (file)
--- a/lib/irc/picoirc.tcl
+++ b/lib/irc/picoirc.tcl
@@ -17,7 +17,7 @@
 # $Id: picoirc.tcl,v 1.4 2008/06/24 22:06:56 patthoyts Exp $
 
 namespace eval ::picoirc {
-    variable version 0.5.1
+    variable version 0.5.2
     variable uid; if {![info exists uid]} { set uid 0 }
     variable defaults {
         server   "irc.freenode.net"
@@ -60,9 +60,19 @@ proc ::picoirc::connect {callback nick args} {
     set irc(callback) $callback
     set irc(nick) $nick
     Callback $context init
-    set irc(socket) [socket -async $irc(server) $irc(port)]
-    fileevent $irc(socket) readable [list [namespace origin Read] $context]
-    fileevent $irc(socket) writable [list [namespace origin Write] $context]
+
+    if {[info exists ::env(SOCKS_SERVER)] 
+        && $::env(SOCKS_SERVER) ne "" 
+        && ![catch {package require socks5}]
+    } 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]
+    }
     return $context
 }
 
@@ -84,6 +94,27 @@ proc ::picoirc::Version {context} {
     return $ver
 }
 
+proc ::picoirc::SocksConnect {context} {
+    global tcl_platform
+    upvar #0 $context irc
+    fileevent $irc(socket) writable {}
+    socks5::init $irc(socket) $irc(server) $irc(port) \
+        -username $tcl_platform(user) \
+        -command [list [namespace origin SocksConnected] $context]
+}
+proc ::picoirc::SocksConnected {context token status} {
+    upvar #0 $context irc
+    if {$status eq "ok"} {
+        socks5::free $token
+        Write $context
+    } else {
+        Callback $context close $status
+        close $irc(socket)
+        unset irc
+    }
+    return
+}
+
 proc ::picoirc::Write {context} {
     upvar #0 $context irc
     fileevent $irc(socket) writable {}
@@ -94,6 +125,7 @@ proc ::picoirc::Write {context} {
         return
     }
     fconfigure $irc(socket) -blocking 0 -buffering line -translation crlf -encoding utf-8
+    fileevent $irc(socket) readable [list [namespace origin Read] $context]
     Callback $context connect
     if {[info exists irc(passwd)]} {
         send $context "PASS $irc(passwd)"
@@ -107,9 +139,19 @@ proc ::picoirc::Write {context} {
     return
 }
 
+# RFC1459 specifies prefix as <nick> [ '!' <user> ] [ '@' <host> ]
+#   Doesn't exclude @ in <user> (only specifies <nonwhite>)
+#   Most networks use a ~ prefix on the user name to indicate no IDENT
+#   confirmation from the remote host.
 proc ::picoirc::Splitirc {s} {
     foreach v {nick flags user host} {set $v {}}
-    regexp {^([^!]*)!([^=]*)=([^@]+)@(.*)} $s -> nick flags user host
+    set a [string first ! $s]
+    set nick [string range $s 0 [incr a -1]]
+    set b [string last @ $s]
+    set host [string range $s [incr b] end]
+    set user [string range $s [incr a 2] [incr b -2]]
+    if {[string index $user 0] eq "~"} {set flags "noident"}
+    set user [string trimleft $user ~]
     return [list $nick $flags $user $host]
 }
 
@@ -158,13 +200,6 @@ proc ::picoirc::Read {context} {
                     }
                 }
             }
-            if {[lsearch -exact {ijchain wubchain} $nick] != -1} {
-                if {$type eq "ACTION"} {
-                    regexp {(\S+) (.+)} $msg -> nick msg 
-                } else {
-                    regexp {<([^>]+)> (.+)} $msg -> nick msg
-                }
-            }
             Callback $context chat $target $nick $msg $type
         } elseif {[regexp {^:((?:([^ ]+) +){1,}?):(.*)$} $line -> parts junk rest]} {
             foreach {server code target fourth fifth} [split $parts] break
@@ -186,19 +221,19 @@ proc ::picoirc::Read {context} {
                 332 { Callback $context topic $fourth $rest; return }
                 333 { return }
                 375 { set irc(motd) {} ; return }
-                372 { append irc(motd) $rest ; 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,$fourth) [list name $name host $host userinfo $rest]
+                    set irc(whois,$nick) [list name $name host $host userinfo $rest]
                     return
                 }
-                301 - 312 - 317 - 320 { 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)
+                        #unset irc(whois,$fourth)
                     }
                     return
                 }
@@ -218,7 +253,8 @@ proc ::picoirc::Read {context} {
                     return
                 }
             }
-            Callback $context system "" "[lrange [split $parts] 1 end] $rest"
+            set n [string first " " $line]
+            Callback $context system "" [string range $line [incr n] end]
         } else {
             Callback $context system "" $line
         }
@@ -234,7 +270,10 @@ proc ::picoirc::post {context channel msg} {
            me {set msg "\001ACTION $msg\001";set type ACTION}
            nick {send $context "NICK $msg"; set $irc(nick) $msg}
            quit {send $context "QUIT" }
-            part {send $context "PART $channel" }
+            part {
+                if {$msg eq ""} { set msg $channel }
+                send $context "PART $msg"
+            }
            names {send $context "NAMES $channel"}
             whois {send $context "WHOIS $channel $msg"}
             kick {send $context "KICK $channel $first :$rest"}
@@ -245,7 +284,7 @@ proc ::picoirc::post {context channel msg} {
             version {send $context "PRIVMSG $first :\001VERSION\001"}
            msg {
                if {[regexp {([^ ]+) +(.*)} $msg -> target querymsg]} {
-                   send $context "PRIVMSG $target :$msg"
+                   send $context "PRIVMSG $target :$querymsg"
                    Callback $context chat $target $target $querymsg ""
                }
            }

diff --git a/lib/irc/pkgIndex.tcl b/lib/irc/pkgIndex.tcl
index df54b662ceb180e11c142a8e8eb51c0f4a9b3df1..c16c58d6ecc93f53bc223e2ae55cc504210c7a23 100644 (file)
--- a/lib/irc/pkgIndex.tcl
+++ b/lib/irc/pkgIndex.tcl
@@ -4,5 +4,5 @@ if { ![package vsatisfies [package provide Tcl] 8.3] } {
     # PRAGMA: returnok
     return 
 }
-package ifneeded picoirc 0.5.1 [list source [file join $dir picoirc.tcl]]
 package ifneeded irc     0.6.1 [list source [file join $dir irc.tcl]]
+package ifneeded picoirc 0.5.2 [list source [file join $dir picoirc.tcl]]