#
# eggdrop script to annouce URL titles in selected channels
#
# Tom Wesley <tom@tomaw.net>
#
# License: BSD
#
# Version 1.0.2
#
# http://tomaw.net/eggdrop/
# http://tomaw.net/eggdrop/urltitle.tcl
#
# ChangeLog
# 20070703 v1.0.1: Fix for some urls causing split to add {}s
# 20070704 v1.0.2: Handle hyperion IDENTIFY-MSG, patch by RiverRat
#
# To enable for a channel:  .chanset #channel +urltitle
#

putlog "loaded: urltitle.tcl"
bind pubm - * pubm_urltitle
bind CTCP - ACTION ctcp_action

setudef flag urltitle
package require http 2.3
package require htmlparse
package require tls
package require uri
http::register https 443 ::tls::socket

set agent "w3m/0.5.1+cvs-1.938"

proc pubm_urltitle {nick uhost hand chan text} {
	if {![channel get $chan urltitle]} {
		return 0
	}
	saytitle $text $chan
}

proc ctcp_action {nick uhost hand chan keyword text} {
	if {![channel get $chan urltitle]} {
		return 0
	}
	saytitle $text $chan
}

proc saytitle {text chan} {
	variable line ""
	global agent
	set url ""
	# This handles text string from Freenode when 'CAPAB MSG-IDENTIFY' is enabled
	if {[string index $text 0] == "+" || [string index $text 0] == "-"} {
		set text [string range $text 1 end]
	}
	set text [split $text]
	foreach i $text {
		set i [join [split $i]]
		if {([string match "*https://*" '$i']) || ([string match "*http://*" '$i']) || ([string match "*www.*" '$i']) || ([string match "*http://*" '$i'])} {
			set url [string trim $i]
			regsub {#.*$} $url "" url
			regsub {\\".*$} $url "" url

			set page ""
			::http::config -useragent $agent
			catch {set page [::http::geturl $url -timeout 30000 -validate true]} error
			upvar #0 $page state
			set meta $state(meta)
			set x [lsearch $meta {Content-Length*}]
			if {$x > 0} {
				incr x
				set size [lindex $meta $x]
				if {$size > 1024000} {
					variable channel $chan
					set x [lsearch $meta {Content-Type*}]
					incr x
					set type [lindex $meta $x]
					if {[string match "text/*" $type] } {
						putserv "PRIVMSG $channel :>> Content-Length above limit. ($size bytes)"
					}
					::http::cleanup $page
					return
				}
			}
			::http::config -useragent $agent
			catch {set page [::http::geturl $url -timeout 30000 -blocksize 102400]} error
			upvar #0 $page state
			set meta $state(meta)
			set html [::http::data $page]
			set httpcode [::http::ncode $page]
			set x [lsearch -regexp $meta (?i)^location.*$]
			::http::cleanup $page
			set iter 0
			while {(($httpcode == "301") || $httpcode == "302") && ($x >= 0) && ($iter < 10)} {
				incr x
				set redir [lindex $meta $x]
				incr iter
				set redirSplit [::uri::split $redir]
				set x [lsearch $redirSplit "host"]
				incr x
				set redirHost [lindex $redirSplit $x]
				set newurl $redir
				if {$redirHost == "" } {
					set newurl [::uri::resolve $url $redir]
				} else {
					set newurl $redir
				}
				::http::config -useragent $agent
				catch {set page [::http::geturl $newurl -timeout 30000 -blocksize 102400]} error
				upvar #0 $page state
				set meta $state(meta)
				set x 0
				set html [::http::data $page]
				set httpcode [::http::ncode $page]
				set x [lsearch -regexp $meta (?i)^location.*$]
				::http::cleanup $page
			}
			variable channel $chan
			variable count 0
			set head 0
			proc parseCommand {args} {
				variable count
				if {($count > 2)} { return }
				foreach {tag slash param text} $args {break}
				putloglev d * "$tag $slash $param $text"
				variable channel
				variable head
				variable line
				if {[::string tolower $tag] == "title" && $slash == ""} {
					if { $head == 1} {
						regsub -all {(\n|\r|\0)} $text "" text
						regsub -all {&#\d*;} $text "" text
						regsub -all {\t} $text "" text
						set text [::htmlparse::mapEscapes $text]
						set text [::string trim $text " "]
						if {[::string length $text] > 0} {
							if {[::string length $line] > 0} {
								set line "$line | \[ $text \]"
							} else {
								set line "\[ $text \]"
							}
							incr count
						}
					}
				}
				if {[::string tolower $tag] == "head"} {
					if {$slash == ""} {
						set head "1"
					} else {
						set head "0"
					}
				}
			}
			set html [u2a $html]
			htmlparse::parse -cmd parseCommand $html
		}
	}
	if {[::string length $line] > 0} {
		putserv "PRIVMSG $channel :$line"
	}
}

 proc u2a {s} {
    set res ""
    foreach i [split $s ""] {
        scan $i %c c
        if {$c<128} {append res $i} else {append res \\u[format %04.4X $c]}
    }
    set res
 } ;#RS