Code: Select all
#######################################################
### PIC-Check-SCRIPT ###################################
######################################################
proc url:check {nick host hand chan arg} {
if {[lsearch -exact [channel info $chan] +urlcheck] < 0} { return }
if {[string match "*www.*.jpg*" [strlwr $arg]] || [string match "*www.*.gif*" [strlwr $arg]] || [string match "*http://*.jpg*" [strlwr $arg]] || [string match "*http://*.gif*" [strlwr $arg]]} {
url:check:geturl $nick $chan $arg
}
}
proc url:check:geturl {nick chan arg} {
foreach word [split $arg " "] {
if {[string match "*www.*.jpg*" [strlwr $word]] || [string match "*www.*.gif*" [strlwr $word]] || [string match "*http://*.jpg*" [strlwr $word]] || [string match "*http://*.gif*" [strlwr $word]]} {
putlog "Checke $word von $nick in $chan"
url:check:imgscan $nick $chan $word
}
}
}
proc url:check:imgscan {nick chan arg} {
global image
set script 0
regsub -all "http://" $arg {} url
set server [lindex [split $url /] 0]
set url [string replace $url 0 [string first / $url]]
set query "http://$server/$url"
set agent "Mozilla/4.0 (compatible; MSIE 5.0; Windows 98)"
http::config -useragent $agent
set token [http::geturl $query -timeout 10000]
upvar #0 $token state
array set meta $state(meta)
set htmlcode [http::code $token ]
set htmlmeta [join $state(meta)]
http::cleanup $token
if {[string match "HTTP/1.*" $htmlcode] && [string match "*200 OK*" $htmlcode]} {
set success 1
} elseif {[string match "HTTP/1.*" $htmlcode] && [string match "*404*" $htmlcode]} {
url:saytext $nick $chan $server $url "Error 404: Datei $server/$url nicht gefunden!"
return
} elseif {[string match "HTTP/1.*" $htmlcode] && [string match "*401*" $htmlcode]} {
url:saytext $nick $chan $server $url "Error 401: Access to $url denied on $server"
return
} elseif {[string match "HTTP/1.*" $htmlcode] && [string match "*302*" $htmlcode]} {
set moved 1
} elseif {[string match "HTTP/1*" $htmlcode]} {
url:saytext $nick $chan $server $url "Server returned code"
}
if {[string match "*Location *" $htmlmeta] && [info exists moved]} {
url:saytext $nick $chan $server $url "Server reports URL to you of $nick one shifted! New URL: [lindex $htmlmeta [expr [lsearch $htmlmeta "Location"] + 1]]"
return
}
if {[string match "*Content-Type text/html*" $htmlmeta] && [info exists success]} {
url:saytext $nick $chan $server $url "Server reports that the URL from Statuscode \"200 OK\" from $nick's URL, but HTML does not report an image. Possible Virus!"
return
}
if {[string match "*Content-Type image/*" $htmlmeta] && [info exists success]} {
set image($chan) 1
}
if {[string match "*<script*" $htmlmeta] && [info exists image]} {
set script 1
url:saytext $nick $chan $server $url "Server reports web page from $nick with Scripts. Possible Virus!"
}
url:end $nick $chan $server $url $script
}
proc url:end {nick chan server url script} {
global image
if {[info exists image($chan)] && $script == 0} {
url:saytext $nick $chan $server $url "URL from $nick is safe (No Danger!)"
unset image($chan)
}
}
proc url:saytext {nick chan server url text} {
set chanifo [getchanmode $chan]
set chanifo1 [string first c $chanifo]
set line [url:getskin $chan $text]
if {[onchan $::botnick $chan] && [validchan $chan]} {
if {$chanifo1 < 0} {
puthelp "PRIVMSG $chan :$line"
} elseif {$chanifo1 >= 0 && [string first "" $line] < 0} {
puthelp "PRIVMSG $chan :$line"
} else {
puthelp "PRIVMSG $chan :» URL-Check »» $text «"
}
} else {
putlog "\[url:saytext\] With $chan tunes which not!"
}
}
proc url:getskin {chan text} {
set skin($chan) [channel get $chan fun_style]
if {$skin($chan) == ""} {
channel set $chan fun_style 1
set skin($chan) 1
}
set getskin ""
if {$skin($chan) == 1} {
set getskin "1,0 » 2URL-Check1 »» $text « "
} elseif {$skin($chan) == "own"} {
set getskin [channel get $chan fun_style_own]
}
if {$getskin == ""} {
channel set $chan fun_style 1
set getskin "1,0 » 2URL-Check1 »» $text « "
}
regsub -all {:text:} $getskin "$text" getskin
return [join $getskin]
}
this error [23:01] Checke http://www.xs4all.nl/~rschippe/oops.jpg von BB4E^WhiteShark in #trivia.nl
[23:01] Tcl error [url:check]: Unknown channel setting
