From 085bd8d0564bcc334439b75fd955d1b75e9984a5 Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Wed, 3 Feb 2010 10:14:57 +0000 Subject: [PATCH] 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 --- lib/irc/picoirc.tcl | 77 +++++++++++++++++++++++++++++++++----------- lib/irc/pkgIndex.tcl | 2 +- 2 files changed, 59 insertions(+), 20 deletions(-) diff --git a/lib/irc/picoirc.tcl b/lib/irc/picoirc.tcl index e0f33b5..06aba9f 100644 --- 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 [ '!' ] [ '@' ] +# Doesn't exclude @ in (only specifies ) +# 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 df54b66..c16c58d 100644 --- 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]] -- 2.23.0