Here's the deal. I grabbed diggtitles from egghelp, set it up to work channels where needed but then I noticed it doesn't handle httpS urls. I don't know how to script, the link and irc server found in script doesn't exist anymore so I can't go there and ask for help.
So I popped here. The scripts purpose is to announce given url's title to the chan.
Here's the script:
Code: Select all
#############################################################################
# #
# diggtitles.tcl #
# #
# Coded by: dragon (dragon@uberdragon.net) #
# Version: 1.0 #
# Released: April 4th, 2009 #
# #
# Description: Used to automatically retrieve digg.com's new short url #
# as well as the title of URLs pasted into channels. #
# #
# Available Commands: #
# - DCC: .chanset <chan> +diggtitles :enables auto digg/titles in a channel #
# #
# History: #
# - 1.0: First public release - Digg starts service April 2 2009 #
# - based on urltitles.tcl by perplexa #
# #
# Report bugs/suggestion to dragon@uberdragon.net #
# or visit /server irc.uberdragon.net and join #uberdragon #
# #
# This program is free software; you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation; either version 2 of the License, or #
# (at your option) any later version. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with this program; if not, write to the Free Software #
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA #
# #
#############################################################################
############################################################################
package require http 2.3
namespace eval url {
variable version "1.0";
variable agent "Mozilla/5.0 (X11; U; Linux i686; en-GB; rv:1.8.1) Gecko/2006101023 Firefox/2.0";
# 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 [censored]..)
variable readlimit 32768;
variable fds;
if {![info exists fds]} {
set fds 0;
}
setudef flag diggtitles;
bind pubm -|- "*" [namespace current]::check;
}
proc url::check {nick host hand chan text} {
global turl
if {[channel get $chan diggtitles]} {
set text [stripcodes uacgbr $text];
foreach item [split $text] {
if {[string match -nocase "*http://?*" $item] || [string match -nocase "*https://?*" $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 turl [diggurl "http://$url/$get"]
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];
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;}
} error]} {
destroy $token;
return $error;
}
after [expr 20*1000] [list [namespace current]::destroy $token];
return $token;
}
proc url::handledata {token nick chan} {
global turl
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;
regsub -all -- {<!--.*?-->} $static(data) "" static(data);
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":""}];
set turl
putquick "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 [string trimleft "\1" "0"]]} content;
regsub -all -- {&#x([[:xdigit:]]{1,4});} $content {[format %c [scan "\1" %x]]} content;
regsub -all -- {&#?[[:alnum:]]{2,7};} $content "?" content;
return [subst $content];
}
proc url::diggurl {url} {
set agent "Mozilla/5.0 (X11; U; Linux i686; en-GB; rv:1.8.1) Gecko/2006101023 Firefox/2.0";
http::config -useragent $agent;
if {[catch {http::geturl "http://services.digg.com/url/short/create?url=$url" -query [http::formatQuery "url" $url] -timeout 20000} token]} {
return $url;
}
set data [http::data $token];
http::cleanup $token;
set diggurl "";
regexp -nocase -- {short_url="(.*?)"} $data -> diggurl;
return [expr {($diggurl=="")?$url:$diggurl}];
}
putlog "Script loaded: digg url and title fetcher v$url::version by dragon on irc.uberdragon.net";
part to row 63. I have no clue if that is even close how it should be fixed, but it doesn't work nonetheless.[string match -nocase "*https://?*" $item]
Could some kind soul give me a hint or try to fix that script to work with https?
) so nvm about those. 
