# urltitle.tcl # Copyright (C) perpleXa 2004-2006 # # Redistribution, with or without modification, are permitted provided # that redistributions retain the above copyright notice, this condition # and the following disclaimer. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. namespace eval url { variable version "3.1"; variable agent "Opera/8.52 (X11; Linux x86_64; U; en)"; # Bot will read data in chunks of this size, 8KB is just fine. variable readbuf 8192; # Read max. 32KB before the connection gets killed. # (to prevent the bot from downloading large files when someone pastes shit..) variable readlimit 32768; variable fds; if {![info exists fds]} { set fds 0; } setudef flag urltitle; putlog "URLCHECK" } proc url::check {nick host hand chan text} { if {[channel get $chan urltitle]} { set text [stripcodes uacgbr $text]; foreach item [split $text] { if {[string match -nocase "http://?*" $item] || [string match -nocase "www.?*" $item]} { regsub -nocase -- "http://" [string map [list "\\" "/"] $item] "" url; set url [split $url "/"]; set get [join [lrange $url 1 end] "/"]; set url [split [lindex $url 0] ":"]; set host [lindex $url 0]; set port [lindex $url 1]; if {$port == ""} {set port "80";} uconnect $host $port $get $nick $chan; } } } } proc url::uconnect {host port get nick chan} { variable agent; variable fds; variable readbuf; set token [namespace current]::[incr fds]; variable $token; upvar 0 $token static; array set static { data "" body 0 code 0 sock -1 } putlog "$host ! $port ! $get ! $nick ! $chan" if {[catch {set static(sock) [socket -async $host $port]} error]} { destroy $token; return $error; } fconfigure $static(sock) -translation {auto crlf} -buffersize $readbuf; puts $static(sock) "GET /$get HTTP/1.0"; puts $static(sock) "Accept: */*"; if {$port == "80"} { puts $static(sock) "Host: $host"; } else { puts $static(sock) "Host: $host:$port"; } puts $static(sock) "User-agent: $agent"; puts $static(sock) ""; flush $static(sock); fileevent $static(sock) readable [list [namespace current]::handledata $token $nick $chan]; catch {fconfigure $static(sock) -blocking 0;} after [expr 20*1000] [list [namespace current]::destroy $token]; return $token; } proc url::handledata {token nick chan} { variable readbuf; variable readlimit; variable $token; upvar 0 $token static; if {[eof $static(sock)] || [string length $static(data)]>=$readlimit} { destroy $token; return; } set buf [read $static(sock) $readbuf]; append static(data) $buf; foreach line [split $buf "\n"] { if {[string match HTTP* $line] && !$static(body)} { if {![regexp -- {\d{3}} $line static(code)]} { destroy $token; return; } elseif {$static(code)!=200 && $static(code)!=301 && $static(code)!=302} { destroy $token; return; } } elseif {[regexp -nocase -- "^Location:(.+)$" $line -> url] && !($static(code)!=301 && $static(code)!=302)} { check $nick *!*@* * $chan $url; destroy $token; return; } elseif {[regexp -nocase -- "^Content-type:(.+)$" $line -> type]} { if {![string match -nocase text* [string trim $type]]} { destroy $token; return; } } elseif {[regexp -nocase -- "^Content-encoding:(.+)$" $line -> encoding]} { if {[string match -nocase *gzip* $encoding] || [string match -nocase *compress* $encoding]} { destroy $token; return; } } elseif {($line == "") && !$static(body)} { set static(body) 1; } elseif {[regexp -nocase -- {([^<]+?)} $static(data) -> title] && $static(code)==200} { regsub -all -- {(\n|\r|\s|\t)+} $title " " title; set s [expr {[string index $nick end]!="s"?"s":""}]; puthelp "PRIVMSG $chan :\"[decode [string trim $title]]\""; destroy $token; return; } } } proc url::destroy {token} { variable $token upvar 0 $token static; if {[info exists static]} { catch {fileevent $static(sock) readable "";} catch {close $static(sock);} unset static; } } proc url::decode {content} { if {![string match *&* $content]} { return $content; } set escapes {   \x20 " \x22 & \x26 ' \x27 – \x2D < \x3C > \x3E ˜ \x7E € \x80 ¡ \xA1 ¢ \xA2 £ \xA3 ¤ \xA4 ¥ \xA5 ¦ \xA6 § \xA7 ¨ \xA8 © \xA9 ª \xAA « \xAB ¬ \xAC ­ \xAD ® \xAE &hibar; \xAF ° \xB0 ± \xB1 ² \xB2 ³ \xB3 ´ \xB4 µ \xB5 ¶ \xB6 · \xB7 ¸ \xB8 ¹ \xB9 º \xBA » \xBB ¼ \xBC ½ \xBD ¾ \xBE ¿ \xBF À \xC0 Á \xC1 Â \xC2 Ã \xC3 Ä \xC4 Å \xC5 Æ \xC6 Ç \xC7 È \xC8 É \xC9 Ê \xCA Ë \xCB Ì \xCC Í \xCD Î \xCE Ï \xCF Ð \xD0 Ñ \xD1 Ò \xD2 Ó \xD3 Ô \xD4 Õ \xD5 Ö \xD6 × \xD7 Ø \xD8 Ù \xD9 Ú \xDA Û \xDB Ü \xDC Ý \xDD Þ \xDE ß \xDF à \xE0 á \xE1 â \xE2 ã \xE3 ä \xE4 å \xE5 æ \xE6 ç \xE7 è \xE8 é \xE9 ê \xEA ë \xEB ì \xEC í \xED î \xEE ï \xEF ð \xF0 ñ \xF1 ò \xF2 ó \xF3 ô \xF4 õ \xF5 ö \xF6 ÷ \xF7 ø \xF8 ù \xF9 ú \xFA û \xFB ü \xFC ý \xFD þ \xFE ÿ \xFF }; set content [string map $escapes $content]; set content [string map [list "\]" "\\\]" "\[" "\\\[" "\$" "\\\$" "\\" "\\\\"] $content]; regsub -all -- {&#([[:digit:]]{1,5});} $content {[format %c "\1"]} content; regsub -all -- {&#x([[:xdigit:]]{1,4});} $content {[format %c [scan "\1" %x]]} content; regsub -all -- {&#?[[:alnum:]]{2,7};} $content "?" content; return [subst $content]; } bind pubm -|- * ::url::check; bind pubm - * ::url::check putlog "Script loaded: URL title fetcher v$url::version by perpleXa";