KaszpiR o 19:22, 10 sie 2006

2006-08-10T19:22:14Z

KaszpiR o 13:29, 27 cze 2006

2006-06-27T13:29:58Z

Nowa strona

po doaniu do eggdrop.conf trzeba wpisac poprzez dcc (dla danego kanalu)
.chanset #kanal +urltitle

<tcl>
# 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;
bind pubm -|- * [namespace current]::check;
}

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
}
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 -- {<title>([^<]+?)</title>} $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 :$nick'$s URL title: \"[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 &tilde; \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];
}

putlog "Script loaded: URL title fetcher v$url::version by perpleXa";
</tcl>

@@ Linia 1: / Linia 1: @@
-po doaniu do eggdrop.conf trzeba wpisac poprzez dcc (dla danego kanalu)
+po dodaniu do eggdrop.conf trzeba wpisac poprzez dcc (dla danego kanalu)
 .chanset #kanal +urltitle
@@ Linia 177: / Linia 177: @@
 putlog "Script loaded: URL title fetcher v$url::version by perpleXa";
 </tcl>

IRC eggdrop urltitle.tcl - Historia wersji

KaszpiR o 19:22, 10 sie 2006

KaszpiR o 13:29, 27 cze 2006