From 08922922cd2226dd6e26a2f283806ecc0a10164e Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Mon, 8 Feb 2010 19:19:40 +0000 Subject: [PATCH] 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 --- lib/irc/picoirc.tcl | 230 ++++++++++++++++++++++++++------------------ 1 file changed, 134 insertions(+), 96 deletions(-) diff --git a/lib/irc/picoirc.tcl b/lib/irc/picoirc.tcl index 06aba9f..c6429aa 100644 --- 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 } } -- 2.23.0