X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=robot.tcl;h=bfe875f339e32169de55f564fdd4aec58d213643;hb=bd463f7d1f1610a3c7a3d9e678f5c4ff27f9d546;hp=4934b9270ce83b8e3d74da1a3fb79c229cac618c;hpb=563c2ed58045d7cd4c977af162f13d1fa308b4a5;p=tclrobot.git diff --git a/robot.tcl b/robot.tcl index 4934b92..bfe875f 100755 --- a/robot.tcl +++ b/robot.tcl @@ -1,24 +1,23 @@ #!/usr/bin/tclsh -# $Id: robot.tcl,v 1.8 2000/12/10 22:27:48 adam Exp $ +# $Id: robot.tcl,v 1.32 2002/03/25 16:11:08 adam Exp $ # -proc RobotFileNext1 {area} { +proc RobotFileNext1 {area lead} { + # puts "RobotFileNext1 area=$area lead=$lead" if {[catch {set ns [glob ${area}/*]}]} { return {} } - set off [string first / $area] - incr off - foreach n $ns { if {[file isfile $n]} { - if {[string first :.html $n] > 0} { - return http://[string range $area/ $off end] - } - return http://[string range $n $off end] + set off [string last / $n] + incr off 2 + return $lead/[string range $n $off end] } } foreach n $ns { if {[file isdirectory $n]} { - set sb [RobotFileNext1 $n] + set off [string last / $n] + incr off 2 + set sb [RobotFileNext1 $n $lead/[string range $n $off end]] if {[string length $sb]} { return $sb } @@ -27,73 +26,112 @@ proc RobotFileNext1 {area} { return {} } -proc RobotFileWait {} { - global robotSeq - set robotSeq 0 +proc RobotWriteRecord {outf fromurl distance} { + puts $outf "" + puts $outf "" + puts $outf $distance + puts $outf "" + puts $outf "" + puts $outf $fromurl + puts $outf "" + puts $outf "" +} + +proc RobotReadRecord {inf fromurlx distancex} { + upvar $fromurlx fromurl + upvar $distancex distance + gets $inf + gets $inf + set distance [string trim [gets $inf]] + # puts "got distance = $distance" + gets $inf + gets $inf + set fromurl [string trim [gets $inf]] } proc RobotFileNext {area} { global robotSeq - if {[catch {set ns [glob ${area}/*]}]} { - return {} + global idletime ns + global status + + # puts "RobotFileNext robotSeq=$robotSeq" + if {$robotSeq < 0} { + return {} + } + if {$robotSeq == 0} { + if {[catch {set ns [glob ${area}/*]}]} { + return {} + } } set off [string length $area] incr off - set n [lindex $ns $robotSeq] if {![string length $n]} { - puts "------------ N E X T R O U N D --------" set robotSeq -1 - after 30000 RobotFileWait - vwait robotSeq - - set n [lindex $ns $robotSeq] - if {![string length $n]} { - return {} - } + flush stdout + set statusfile [open status w] + puts $statusfile "$status(unvisited) $status(bad) $status(visited)" + close $statusfile + return wait } incr robotSeq - if {[file isfile $n/robots.txt]} { + if {[file isfile $n/frobots.txt]} { puts "ok returning http://[string range $n $off end]/robots.txt" return http://[string range $n $off end]/robots.txt } elseif {[file isdirectory $n]} { - set sb [RobotFileNext1 $n] + set sb [RobotFileNext1 $n http://[string range $n $off end]] if {[string length $sb]} { return $sb } } + puts "no more work at end of RobotFileNext n=$n" + puts "ns=$ns" return {} } proc RobotFileExist {area host path} { - set comp [split $area/$host$path /] - set l [llength $comp] + global debuglevel + + if {$debuglevel > 3} { + puts "RobotFileExist begin area=$area host=$host path=$path" + } + set lpath [split $path /] + set l [llength $lpath] incr l -1 - if {![string length [lindex $comp $l]]} { - set comp [split $area/$host$path:.html /] - } elseif {[file exists [join $comp /]]} { - return 1 - } else { - set comp [split $area/$host$path/:.html /] + set t [lindex $lpath $l] + incr l -1 + set npath $area/$host[join [lrange $lpath 0 $l] /d]/f$t + if {$debuglevel > 3} { + puts "RobotFileExist end npath=$npath" } - return [file exists [join $comp /]] + return [file exists $npath] } proc RobotFileUnlink {area host path} { - set comp [split $area/$host$path /] - set l [llength $comp] + global status + # puts "RobotFileUnlink begin" + # puts "area=$area host=$host path=$path" + set lpath [split $path /] + set l [llength $lpath] incr l -1 - if {![string length [lindex $comp $l]]} { - set comp [split $area/$host$path:.html /] - } + set t [lindex $lpath $l] + incr l -1 + set npath $area/$host[join [lrange $lpath 0 $l] /d]/f$t + # puts "npath=$npath" + set comp [split $npath /] if {[catch {exec rm [join $comp /]}]} return + + set l [llength $comp] incr l -1 + incr l -1 + incr status($area) -1 for {set i $l} {$i > 0} {incr i -1} { set path [join [lrange $comp 0 $i] /] if {![catch {glob $path/*}]} return exec rmdir ./$path } + # puts "RobotFileUnlink end" } proc RobotFileClose {out} { @@ -105,11 +143,15 @@ proc RobotFileClose {out} { proc RobotFileOpen {area host path {mode w}} { set orgPwd [pwd] global workdir + global status + global debuglevel if {![info exists workdir]} { return stdout } - puts "RobotFileOpen orgPwd=$orgPwd area=$area host=$host path=$path mode=$mode" + if {$debuglevel > 3} { + puts "RobotFileOpen orgPwd=$orgPwd area=$area host=$host path=$path mode=$mode" + } if {[string compare $orgPwd $workdir]} { puts "ooops. RobotFileOpen failed" puts "workdir = $workdir" @@ -120,57 +162,94 @@ proc RobotFileOpen {area host path {mode w}} { set len [llength $comp] incr len -1 for {set i 0} {$i < $len} {incr i} { - set d [lindex $comp $i] + if {$i > 1} { + set d "d[lindex $comp $i]" + } else { + set d [lindex $comp $i] + } if {[catch {cd ./$d}]} { exec mkdir $d cd ./$d if {![string compare $area unvisited] && $i == 1 && $mode == "w"} { - set out [open robots.txt w] - puts "creating robots.txt in $d" - close $out + if {[string compare $path /robots.txt]} { + set out [open frobots.txt w] + puts "creating robots.txt in $d" + close $out + incr status(unvisited) + } } } } set d [lindex $comp $len] if {[string length $d]} { - if {[file isdirectory $d]} { - set out [open $d/:.html $mode] - } else { - set out [open $d $mode] - } + set out [open f$d $mode] } else { - set out [open :.html $mode] + set out [open f $mode] + } + if {$mode == "w"} { + incr status($area) } cd $orgPwd - #puts "RobotFileStop" return $out } -proc RobotRestart {sock} { - global URL - global robotMoreWork - +proc RobotRR {} { + global robotSeq robotsRunning + + incr robotsRunning -1 + while {$robotsRunning} { + vwait robotsRunning + } + set robotSeq 0 + RobotStart +} + +proc RobotRestart {url sock} { + global URL robotsRunning + close $sock after cancel $URL($sock,cancel) - while {1} { + + foreach v [array names URL $url,*] { + unset URL($v) + } + + incr robotsRunning -1 + RobotStart +} + +proc RobotStart {} { + global URL + global robotsRunning robotsMax idletime + + # puts "RobotStart" + while {1} { set url [RobotFileNext unvisited] if {![string length $url]} { - break + return + } + incr robotsRunning + if {[string compare $url wait] == 0} { + after $idletime RobotRR + return } set r [RobotGetUrl $url {}] if {!$r} { - return + if {$robotsRunning >= $robotsMax} return } else { - RobotFileUnlink unvisited $URL($url,host) $URL($url,path) - } + incr robotsRunning -1 + if {![RobotFileExist bad $URL($url,hostport) $URL($url,path)]} { + set outf [RobotFileOpen bad $URL($url,hostport) $URL($url,path)] + RobotFileClose $outf + } + RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path) + } } - incr robotMoreWork -1 } proc headSave {url out} { global URL - puts $out {} if {[info exists URL($url,head,last-modified)]} { puts $out "$URL($url,head,last-modified)" } @@ -194,12 +273,27 @@ proc headSave {url out} { } proc RobotHref {url hrefx hostx pathx} { - global URL domains + global URL domains debuglevel upvar $hrefx href upvar $hostx host upvar $pathx path - puts "Ref url = $url href=$href" + if {$debuglevel > 1} { + puts "Ref input url = $url href=$href" + } + + if {[string first { } $href] >= 0} { + return 0 + } + if {[string length $href] > 256} { + return 0 + } +# if {[string first {?} $href] >= 0} { +# return 0 +# } +# if {[string first {?} $url] >= 0 && [string first {?} $href] >= 0} { +# return 0 +# } # get method (if any) if {![regexp {^([^/:]+):(.*)} $href x method hpath]} { set hpath $href @@ -214,26 +308,32 @@ proc RobotHref {url hrefx hostx pathx} { if {![string length $surl]} { set surl / } - set ok 0 - foreach domain $domains { - if {[string match $domain $host]} { - set ok 1 - break + if {[info exist domains]} { + set ok 0 + foreach domain $domains { + if {[string match $domain $host]} { + set ok 1 + break + } } - } - if {!$ok} { - return 0 - } + if {!$ok} { + return 0 + } + } } else { regexp {^([^\#]*)} $hpath x surl - set host $URL($url,host) + set host $URL($url,hostport) } if {![string length $surl]} { return 0 } if {[string first / $surl]} { # relative path - regexp {^([^\#?]*)} $URL($url,path) x dpart + set curpath $URL($url,path) + if {[info exists URL($url,bpath)]} { + set curpath $URL($url,bpath) + } + regexp {^([^\#?]*)} $curpath x dpart set l [string last / $dpart] if {[expr $l >= 0]} { set surl [string range $dpart 0 $l]$surl @@ -241,55 +341,58 @@ proc RobotHref {url hrefx hostx pathx} { set surl $dpart/$surl } } - set c [split $surl /] - set i [llength $c] - incr i -1 - set path [lindex $c $i] - incr i -1 - while {$i >= 0} { - switch -- [lindex $c $i] { + set surllist [split $surl /] + catch {unset path} + set pathl 0 + foreach c $surllist { + switch -- $c { .. { - incr i -2 - } - . { - incr i -1 + if {$pathl > 1} { + incr pathl -2 + set path [lrange $path 0 $pathl] + incr pathl + } } - default { - set path [lindex $c $i]/$path - incr i -1 + . { + + } + default { + incr pathl + lappend path $c } } } - regsub -all {~} $path {%7E} path - set ok 1 - if {[info exists URL($host,robots)]} { - foreach l $URL($host,robots) { - if {[string first [lindex $l 1] $path] == 0} { - set ok [lindex $l 0] - break - } - } + if {$debuglevel > 4} { + puts "pathl=$pathl output path=$path" + } + set path [join $path /] + if {![string length $path]} { + set path / } + regsub -all {~} $path {%7E} path set href "$method://$host$path" - puts "Ref href = $href, ok=$ok" - return $ok + + if {$debuglevel > 1} { + puts "Ref result = $href" + } + return [checkrule url $href] } proc RobotError {url code} { global URL - puts "Bad URL $url, $code" + puts "Bad URL $url (code $code)" set fromurl {} - if {[RobotFileExist unvisited $URL($url,host) $URL($url,path)]} { - set inf [RobotFileOpen unvisited $URL($url,host) $URL($url,path) r] - set fromurl [gets $inf] - close $inf - } - RobotFileUnlink unvisited $URL($url,host) $URL($url,path) - if {![RobotFileExist bad $URL($url,host) $URL($url,path)]} { - set outf [RobotFileOpen bad $URL($url,host) $URL($url,path)] - puts $outf "URL=$url $code" - puts $outf "Reference $fromurl" + set distance -1 + if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} { + set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r] + RobotReadRecord $inf fromurl distance + RobotFileClose $inf + } + RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path) + if {![RobotFileExist bad $URL($url,hostport) $URL($url,path)]} { + set outf [RobotFileOpen bad $URL($url,hostport) $URL($url,path)] + RobotWriteRecord $outf $fromurl $distance RobotFileClose $outf } } @@ -299,118 +402,214 @@ proc RobotRedirect {url tourl code} { puts "Redirecting from $url to $tourl" + set distance {} set fromurl {} - catch { - set inf [RobotFileOpen unvisited $URL($url,host) $URL($url,path) r] - set fromurl [gets $inf] + if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} { + set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r] + RobotReadRecord $inf fromurl distance RobotFileClose $inf } - RobotFileUnlink unvisited $URL($url,host) $URL($url,path) - if {![RobotFileExist bad $URL($url,host) $URL($url,path)]} { - set outf [RobotFileOpen bad $URL($url,host) $URL($url,path)] - puts $outf "URL=$url to $tourl $code" - puts $outf "Reference $fromurl" + if {![RobotFileExist bad $URL($url,hostport) $URL($url,path)]} { + set outf [RobotFileOpen bad $URL($url,hostport) $URL($url,path)] + RobotWriteRecord $outf $fromurl $distance RobotFileClose $outf } if {[RobotHref $url tourl host path]} { - if {![RobotFileExist unvisited $host $path]} { - puts "Mark as unvisited" - set outf [RobotFileOpen unvisited $host $path] - puts $outf $code - RobotFileClose $outf + if {![RobotFileExist visited $host $path]} { + if {![RobotFileExist unvisited $host $path]} { + set outf [RobotFileOpen unvisited $host $path] + RobotWriteRecord $outf $fromurl $distance + RobotFileClose $outf + } + } else { + set olddistance {} + set inf [RobotFileOpen visited $host $path r] + RobotReadRecord $inf oldurl olddistance + RobotFileClose $inf + if {[string length $olddistance] == 0} { + set olddistance 1000 + } + if {[string length $distance] == 0} { + set distance 1000 + } + puts "distance=$distance olddistance=$olddistance" + if {[expr $distance < $olddistance]} { + set outf [RobotFileOpen unvisited $host $path] + RobotWriteRecord $outf $tourl $distance + RobotFileClose $outf + } } } + if {[catch {RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path)}]} { + puts "unlink failed" + exit 1 + } +} + +proc link {url out href body distance} { + global URL maxdistance + if {[expr $distance > $maxdistance]} return + + if {![RobotHref $url href host path]} return + + puts $out "" + puts $out "$href" + puts $out "$body" + puts $out "" + + if {![RobotFileExist visited $host $path]} { + set olddistance 1000 + if {![RobotFileExist bad $host $path]} { + if {[RobotFileExist unvisited $host $path]} { + set inf [RobotFileOpen unvisited $host $path r] + RobotReadRecord $inf oldurl olddistance + RobotFileClose $inf + } + } else { + set olddistance 0 + } + if {[string length $olddistance] == 0} { + set olddistance 1000 + } + if {[expr $distance < $olddistance]} { + set outf [RobotFileOpen unvisited $host $path] + RobotWriteRecord $outf $url $distance + RobotFileClose $outf + } + } elseif {[string compare $href $url]} { + set inf [RobotFileOpen visited $host $path r] + RobotReadRecord $inf xurl olddistance + close $inf + if {[string length $olddistance] == 0} { + set olddistance 1000 + } + if {[expr $distance < $olddistance]} { + puts "OK remarking url=$url href=$href" + puts "olddistance = $olddistance" + puts "newdistance = $distance" + set outf [RobotFileOpen unvisited $host $path] + RobotWriteRecord $outf $url $distance + RobotFileClose $outf + } + } } proc RobotTextHtml {url out} { - global URL + global URL maxdistance + + # set title so we can emit it for the body + set title {} + # if true, nothing will be indexed + set noindex 0 + # if true, nothing will be followed + set nofollow 0 - set head 0 + set distance 0 + set fdistance 0 + if {$maxdistance < 1000 && [info exists URL($url,dist)]} { + set fdistance $URL($url,dist) + set distance [expr $fdistance + 1] + } htmlSwitch $URL($url,buf) \ title { - if {!$head} { - headSave $url $out - set head 1 - } - puts $out "$body" + set title $body } -nonest meta { - if {!$head} { - headSave $url $out - set head 1 - } + # collect metadata and save NAME= CONTENT=.. + set metaname {} + set metacontent {} puts -nonewline $out "" + # go through robots directives (af any) + if {![string compare $metaname robots]} { + set direcs [split [string tolower $metacontent] ,] + if {[lsearch $direcs noindex] >= 0} { + set noindex 1 + } + if {[lsearch $direcs nofollow] >= 0} { + set nofollow 1 + } } - puts $out {>} } body { - regsub -all -nocase {} $body {} abody - regsub -all {<[^\>]+>} $abody {} nbody - puts $out "" - puts $out $nbody - puts $out "" + # don't print title of document content if noindex is used + if {!$noindex} { + puts $out "$title" + regsub -all {} $body { } abody + regsub -all -nocase {} $abody {} bbody + regsub -all {<[^\>]+>} $bbody {} nbody + puts $out "" + puts $out $nbody + puts $out "" + } + } -nonest base { + # + if {![info exists parm(href)]} { + continue + } + set href [string trim $parm(href)] + if {![RobotHref $url href host path]} continue + set URL($url,bpath) $path } a { + # .. + # we're not using nonest - otherwise body isn't set + if {$nofollow} continue if {![info exists parm(href)]} { - puts "no href" continue } - if {!$head} { - headSave $url $out - set head 1 + link $url $out [string trim $parm(href)] $body $distance + } -nonest area { + if {$nofollow} continue + if {![info exists parm(href)]} { + continue } - if {1} { - set href $parm(href) - if {![RobotHref $url href host path]} continue - - puts $out "" - puts $out "$href" - puts $out "$body" - puts $out "" - - if {![RobotFileExist visited $host $path]} { - if {![RobotFileExist bad $host $path]} { - if {[catch {set outf [RobotFileOpen unvisited $host $path]} msg]} { - puts "--- Error $msg" - exit 1 - } - puts $outf $url - RobotFileClose $outf - } - } - } + link $url $out [string trim $parm(href)] $body $distance + } -nonest frame { + if {![info exists parm(src)]} { + continue + } + link $url $out [string trim $parm(src)] $body $fdistance } - if {!$head} { - headSave $url $out - set head 1 - } - puts $out "" } proc RobotsTxt {url} { global agent URL - set v URL($URL($url,host),robots) + RobotsTxt0 URL(URL($url,hostport),robots) $URL($url,buf) +} + +proc RobotsTxt0 {v buf} { + global URL agent set section 0 - foreach l [split $URL($url,buf) \n] { - puts $l - if {[regexp {([-A-Za-z]+):[ \t]*([^\#]+)} $l match cmd arg]} { + foreach l [split $buf \n] { + if {[regexp {([-A-Za-z]+):[ ]*([^\# ]+)} $l match cmd arg]} { puts "cmd=$cmd arg=$arg" - switch $cmd { - User-Agent { + switch -- [string tolower $cmd] { + user-agent { if {$section} break set pat [string tolower $arg]* set section [string match $pat $agent] } - Disallow { + disallow { if {$section} { puts "rule [list 0 $arg]" lappend $v [list 0 $arg] } } - Allow { + allow { if {$section} { puts "rule [list 1 $arg]" lappend $v [list 1 $arg] @@ -424,40 +623,61 @@ proc RobotsTxt {url} { proc RobotTextPlain {url out} { global URL - headSave $url $out puts $out "" - puts $out $URL($url,buf) + regsub -all {<} $URL($url,buf) {\<} content + puts $out $content puts $out "" - puts $out "" if {![string compare $URL($url,path) /robots.txt]} { RobotsTxt $url } } -proc Robot200 {url} { +proc RobotWriteMetadata {url out} { global URL domains - - puts "Parsing $url" - set out [RobotFileOpen visited $URL($url,host) $URL($url,path)] + + puts $out "" + + set distance 1000 + if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} { + set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r] + RobotReadRecord $inf fromurl distance + RobotFileClose $inf + } + set URL($url,dist) $distance + puts $out "" + puts $out " $distance" + puts $out "" + headSave $url $out + puts "Parsing $url distance=$distance" switch $URL($url,head,content-type) { - text/html { - RobotTextHtml $url $out - } - text/plain { - RobotTextPlain $url $out - } - default { - headSave $url $out - puts $out "" - } + text/html { + if {[string length $distance]} { + RobotTextHtml $url $out + } + } + text/plain { + RobotTextPlain $url $out + } } + puts $out "" +} + +proc Robot200 {url} { + global URL domains + + set out [RobotFileOpen raw $URL($url,hostport) $URL($url,path)] + puts -nonewline $out $URL($url,buf) + RobotFileClose $out + + set out [RobotFileOpen visited $URL($url,hostport) $URL($url,path)] + RobotWriteMetadata $url $out RobotFileClose $out - # puts "Parsing done" - RobotFileUnlink unvisited $URL($url,host) $URL($url,path) + + RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path) } -proc RobotReadContent {url sock} { +proc RobotReadContent {url sock binary} { global URL set buffer [read $sock 16384] @@ -465,10 +685,10 @@ proc RobotReadContent {url sock} { if {$readCount <= 0} { Robot200 $url - RobotRestart $sock - } elseif {[string first \0 $buffer] >= 0} { + RobotRestart $url $sock + } elseif {!$binary && [string first \0 $buffer] >= 0} { Robot200 $url - RobotRestart $sock + RobotRestart $url $sock } else { # puts "Got $readCount bytes" set URL($url,buf) $URL($url,buf)$buffer @@ -476,100 +696,100 @@ proc RobotReadContent {url sock} { } proc RobotReadHeader {url sock} { - global URL + global URL debuglevel + if {$debuglevel > 1} { + puts "HTTP head $url" + } if {[catch {set buffer [read $sock 2148]}]} { RobotError $url 404 - RobotRestart $sock + RobotRestart $url $sock + return } set readCount [string length $buffer] if {$readCount <= 0} { RobotError $url 404 - RobotRestart $sock + RobotRestart $url $sock } else { # puts "Got $readCount bytes" set URL($url,buf) $URL($url,buf)$buffer - set n [string first \n\n $URL($url,buf)] + set n [string first \r\n\r\n $URL($url,buf)] if {$n > 1} { set code 0 set version {} set headbuf [string range $URL($url,buf) 0 $n] - incr n - incr n + incr n 4 set URL($url,buf) [string range $URL($url,buf) $n end] regexp {^HTTP/([0-9.]+)[ ]+([0-9]+)} $headbuf x version code set lines [split $headbuf \n] foreach line $lines { - if {[regexp {^([^:]+):[ ]+(.*)} $line x name value]} { - set URL($url,head,[string tolower $name]) $value + if {[regexp {^([^:]+):[ ]+([^;]*)} $line x name value]} { + set URL($url,head,[string tolower $name]) [string trim $value] } } - puts "code = $code" + puts "HTTP CODE $code" set URL($url,state) skip switch $code { 301 { RobotRedirect $url $URL($url,head,location) 301 - RobotRestart $sock + RobotRestart $url $sock } 302 { RobotRedirect $url $URL($url,head,location) 302 - RobotRestart $sock - } - 404 { - RobotError $url 404 - RobotRestart $sock - } - 401 { - RobotError $url 401 - RobotRestart $sock + RobotRestart $url $sock } 200 { if {![info exists URL($url,head,content-type)]} { set URL($url,head,content-type) {} } - switch $URL($url,head,content-type) { - text/html { - fileevent $sock readable [list RobotReadContent $url $sock] - } - text/plain { - fileevent $sock readable [list RobotReadContent $url $sock] - } - default { - Robot200 $url - RobotRestart $sock + set binary 1 + switch -glob -- $URL($url,head,content-type) { + text/* { + set binary 0 } } + if {![regexp {/robots.txt$} $url]} { + if {![checkrule mime $URL($url,head,content-type)]} { + RobotError $url mimedeny + RobotRestart $url $sock + return + } + } + fileevent $sock readable [list RobotReadContent $url $sock $binary] } default { - RobotError $url 404 - RobotRestart $sock + RobotError $url $code + RobotRestart $url $sock } } } } } -proc RobotSockCancel {sock url} { +proc RobotSockCancel {url sock} { puts "RobotSockCancel sock=$sock url=$url" RobotError $url 401 - RobotRestart $sock + RobotRestart $url $sock } proc RobotConnect {url sock} { - global URL agent + global URL agent acceptLanguage - fconfigure $sock -translation {auto crlf} -blocking 0 + fconfigure $sock -translation {lf crlf} -blocking 0 fileevent $sock readable [list RobotReadHeader $url $sock] puts $sock "GET $URL($url,path) HTTP/1.0" puts $sock "Host: $URL($url,host)" puts $sock "User-Agent: $agent" + if {[string length $acceptLanguage]} { + puts $sock "Accept-Language: $acceptLanguage" + } puts $sock "" flush $sock - set URL($sock,cancel) [after 60000 [list RobotSockCancel $sock $url]] + set URL($sock,cancel) [after 30000 [list RobotSockCancel $url $sock]] } proc RobotNop {} { @@ -577,10 +797,10 @@ proc RobotNop {} { } proc RobotGetUrl {url phost} { - global URL - puts "---------" - puts $url - if {![regexp {([^:]+)://([^/]+)([^ ]*)} $url x method hostport path]} { + global URL robotsRunning + flush stdout + puts "Retrieve $robotsRunning url=$url" + if {![regexp {([^:]+)://([^/]+)(.*)} $url x method hostport path]} { return -1 } if {![regexp {([^:]+):([0-9]+)} $hostport x host port]} { @@ -589,10 +809,37 @@ proc RobotGetUrl {url phost} { } set URL($url,method) $method set URL($url,host) $host - set URL($url,port) $port + set URL($url,hostport) $hostport set URL($url,path) $path set URL($url,state) head set URL($url,buf) {} + + if {[string compare $path /robots.txt]} { + set ok 1 + if {![info exists URL($hostport,robots)]} { + puts "READING robots.txt for host $hostport" + if {[RobotFileExist visited $hostport /robots.txt]} { + set inf [RobotFileOpen visited $hostport /robots.txt r] + set buf [read $inf 32768] + close $inf + } else { + set buf "User-agent: *\nAllow: /\n" + } + RobotsTxt0 URL($hostport,robots) $buf + } + if {[info exists URL($hostport,robots)]} { + foreach l $URL($hostport,robots) { + if {[string first [lindex $l 1] $path] == 0} { + set ok [lindex $l 0] + break + } + } + } + if {!$ok} { + puts "skipped due to robots.txt" + return -1 + } + } if [catch {set sock [socket -async $host $port]}] { return -1 } @@ -608,37 +855,207 @@ if {![llength [info commands htmlSwitch]]} { } } -set agent "zmbot/0.0" +set agent "zmbot/0.1" if {![catch {set os [exec uname -s -r]}]} { set agent "$agent ($os)" - puts "agent: $agent" } +puts "agent: $agent" + proc bgerror {m} { global errorInfo puts "BGERROR $m" puts $errorInfo } -set robotMoreWork 0 +set robotsRunning 0 set robotSeq 0 set workdir [pwd] +set idletime 60000 +set acceptLanguage {} +set debuglevel 0 +set status(unvisited) 0 +set status(visited) 0 +set status(bad) 0 +set status(raw) 0 -if {[llength $argv] < 2} { - puts "Tclrobot: usage " - puts " Example: '*.indexdata.dk' http://www.indexdata.dk/" - exit 1 + +# Rules: allow, deny, url + +proc checkrule {type this} { + global alrules + global debuglevel + + if {$debuglevel > 3} { + puts "CHECKRULE $type $this" + } + if {[info exist alrules]} { + foreach l $alrules { + if {$debuglevel > 3} { + puts "consider $l" + } + # consider type + if {[lindex $l 1] != $type} continue + # consider mask (! negates) + set masks [lindex $l 2] + set ok 0 + foreach mask $masks { + if {$debuglevel > 4} { + puts "consider single mask $mask" + } + if {[string index $mask 0] == "!"} { + set mask [string range $mask 1 end] + if {[string match $mask $this]} continue + } else { + if {![string match $mask $this]} continue + } + set ok 1 + } + if {$debuglevel > 4} { + puts "ok = $ok" + } + if {!$ok} continue + # OK, we have a match + if {[lindex $l 0] == "allow"} { + if {$debuglevel > 3} { + puts "CHECKRULE MATCH OK" + } + return 1 + } else { + if {$debuglevel > 3} { + puts "CHECKFULE MATCH FAIL" + } + return 0 + } + } + } + if {$debuglevel > 3} { + puts "CHECKRULE MATCH OK" + } + return 1 } -set domains [lindex $argv 0] -foreach site [lindex $argv 1] { - incr robotMoreWork - if [RobotGetUrl $site {}] { - incr robotMoreWork -1 - puts "Couldn't process $site" + +proc url {href} { + global debuglevel + + if {[RobotHref http://www.indexdata.dk/ href host path]} { + if {![RobotFileExist visited $host $path]} { + set outf [RobotFileOpen unvisited $host $path] + RobotWriteRecord $outf href 0 + RobotFileClose $outf + } } } -while {$robotMoreWork} { - vwait robotMoreWork +proc deny {type stuff} { + global alrules + + lappend alrules [list deny $type $stuff] +} + +proc allow {type stuff} { + global alrules + + lappend alrules [list allow $type $stuff] +} + +proc debug {level} { + global debuglevel + + set debuglevel $level } + +# Parse options + +set i 0 +set l [llength $argv] + +if {$l < 2} { + puts {tclrobot: usage:} + puts {tclrobot [-j jobs] [-i idle] [-c count] [-d domain] [-r rules] [url ..]} + puts " Example: -c 3 -d '*.dk' http://www.indexdata.dk/" + + exit 1 +} +while {$i < $l} { + set arg [lindex $argv $i] + switch -glob -- $arg { + -j* { + set robotsMax [string range $arg 2 end] + if {![string length $robotsMax]} { + set robotsMax [lindex $argv [incr i]] + } + } + -c* { + set maxdistance [string range $arg 2 end] + if {![string length $maxdistance]} { + set maxdistance [lindex $argv [incr i]] + } + } + -d* { + set dom [string range $arg 2 end] + if {![string length $dom]} { + set dom [lindex $argv [incr i]] + } + lappend domains $dom + } + -i* { + set idletime [string range $arg 2 end] + if {![string length $idletime]} { + set idletime [lindex $argv [incr i]] + } + } + -l* { + set acceptLanguage [string range $arg 2 end] + if {![string length $acceptLanguage]} { + set acceptLanguage [lindex $argv [incr i]] + } + } + -r* { + set rfile [string range $arg 2 end] + if {![string length $rfile]} { + set rfile [lindex $argv [incr i]] + } + source $rfile + } + default { + set href $arg + if {[RobotHref http://www.indexdata.dk/ href host path]} { + if {![RobotFileExist visited $host $path]} { + set outf [RobotFileOpen unvisited $host $path] + RobotWriteRecord $outf href 0 + RobotFileClose $outf + } + } + } + } + incr i +} + +if {![info exist domains]} { + set domains {*} +} +if {![info exist maxdistance]} { + set maxdistance 50 +} +if {![info exist robotsMax]} { + set robotsMax 5 +} + +puts "domains=$domains" +puts "max distance=$maxdistance" +puts "max jobs=$robotsMax" + + +RobotStart + + +while {$robotsRunning} { + vwait robotsRunning +} + +set statusfile [open status w] +puts $statusfile "$status(unvisited) $status(bad) $status(visited)" +close $statusfile +