robot.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: robot.tcl,v 1.17 2001/06/07 08:10:10 adam Exp $
   3 #
   4 proc RobotFileNext1 {area lead} {
   5     # puts "RobotFileNext1 area=$area lead=$lead"
   6     if {[catch {set ns [glob ${area}/*]}]} {
   7         return {}
   8     }
   9     foreach n $ns {
  10         if {[file isfile $n]} {
  11             set off [string last / $n]
  12             incr off 2
  13             return $lead/[string range $n $off end]
  14         }
  15     }
  16     foreach n $ns {
  17         if {[file isdirectory $n]} {
  18             set off [string last / $n]
  19             incr off 2
  20             set sb [RobotFileNext1 $n $lead/[string range $n $off end]]
  21             if {[string length $sb]} {
  22                 return $sb
  23             }
  24         }
  25     }
  26     return {}
  27 }
  28
  29 proc RobotWriteRecord {outf fromurl distance} {
  30     puts $outf "<zmbot>"
  31     puts $outf "<distance>"
  32     puts $outf $distance
  33     puts $outf "</distance>"
  34     puts $outf "<fromurl>"
  35     puts $outf $fromurl
  36     puts $outf "</fromurl>"
  37     puts $outf "</zmbot>"
  38 }
  39
  40 proc RobotReadRecord {inf fromurlx distancex} {
  41     upvar $fromurlx fromurl
  42     upvar $distancex distance
  43     gets $inf
  44     gets $inf
  45     set distance [string trim [gets $inf]]
  46     # puts "got distance = $distance"
  47     gets $inf
  48     gets $inf
  49     set fromurl [string trim [gets $inf]]
  50 }
  51
  52 proc RobotFileNext {area} {
  53     global robotSeq global idleTime ns
  54
  55     # puts "RobotFileNext robotSeq=$robotSeq"
  56     if {$robotSeq < 0} {
  57         return {}
  58     }
  59     if {$robotSeq == 0} {
  60         if {[catch {set ns [glob ${area}/*]}]} {
  61             return {}
  62         }
  63     }
  64     set off [string length $area]
  65     incr off
  66     set n [lindex $ns $robotSeq]
  67     if {![string length $n]} {
  68         set robotSeq -1
  69         flush stdout
  70         puts "------------ N E X T  R O U N D --------"
  71         return wait
  72     }
  73     incr robotSeq
  74     if {[file isfile $n/frobots.txt]} {
  75         puts "ok returning http://[string range $n $off end]/robots.txt"
  76         return http://[string range $n $off end]/robots.txt
  77     } elseif {[file isdirectory $n]} {
  78         set sb [RobotFileNext1 $n http://[string range $n $off end]]
  79         if {[string length $sb]} {
  80             return $sb
  81         }
  82     }
  83     puts "no more work at end of RobotFileNext n=$n"
  84     puts "ns=$ns"
  85     return {}
  86 }
  87
  88
  89 proc RobotFileExist {area host path} {
  90     # puts "RobotFileExist begin area=$area host=$host path=$path"
  91     set lpath [split $path /]
  92     set l [llength $lpath]
  93     incr l -1
  94     set t [lindex $lpath $l]
  95     incr l -1
  96     set npath $area/$host[join [lrange $lpath 0 $l] /d]/f$t
  97     # puts "RobotFileExist end npath=$npath"
  98     return [file exists $npath]
  99 }
 100
 101 proc RobotFileUnlink {area host path} {
 102     # puts "RobotFileUnlink begin"
 103     # puts "area=$area host=$host path=$path"
 104     set lpath [split $path /]
 105     set l [llength $lpath]
 106     incr l -1
 107     set t [lindex $lpath $l]
 108     incr l -1
 109     set npath $area/$host[join [lrange $lpath 0 $l] /d]/f$t
 110     # puts "npath=$npath"
 111     set comp [split $npath /]
 112     set l [llength $comp]
 113     incr l -1
 114     if {[catch {exec rm [join $comp /]}]} return
 115     incr l -1
 116     for {set i $l} {$i > 0} {incr i -1} {
 117         set path [join [lrange $comp 0 $i] /]
 118         if {![catch {glob $path/*}]} return
 119         exec rmdir ./$path
 120     }
 121     # puts "RobotFileUnlink end"
 122 }
 123
 124 proc RobotFileClose {out} {
 125     if [string compare $out stdout] {
 126         close $out
 127     }
 128 }
 129
 130 proc RobotFileOpen {area host path {mode w}} {
 131     set orgPwd [pwd]
 132     global workdir
 133
 134     if {![info exists workdir]} {
 135         return stdout
 136     }
 137     #puts "RobotFileOpen orgPwd=$orgPwd area=$area host=$host path=$path mode=$mode"
 138     if {[string compare $orgPwd $workdir]} {
 139         puts "ooops. RobotFileOpen failed"
 140         puts "workdir = $workdir"
 141         puts "pwd = $orgPwd"
 142         exit 1
 143     }
 144     set comp [split $area/$host$path /]
 145     set len [llength $comp]
 146     incr len -1
 147     for {set i 0} {$i < $len} {incr i} {
 148         if {$i > 1} {
 149             set d "d[lindex $comp $i]"
 150         } else {
 151             set d [lindex $comp $i]
 152         }
 153         if {[catch {cd ./$d}]} {
 154             exec mkdir $d
 155             cd ./$d
 156             if {![string compare $area unvisited] && $i == 1 && $mode == "w"} {
 157                 set out [open frobots.txt w]
 158                 puts "creating robots.txt in $d"
 159                 close $out
 160             }
 161         }
 162     }
 163     set d [lindex $comp $len]
 164     if {[string length $d]} {
 165         if {[file isdirectory $d]} {
 166             set out [open $d/f $mode]
 167         } else {
 168             set out [open f$d $mode]
 169         }
 170     } else {
 171         set out [open f $mode]
 172     }
 173     cd $orgPwd
 174     return $out
 175 }
 176
 177 proc RobotRR {} {
 178     global robotSeq robotsRunning
 179
 180     incr robotsRunning -1
 181     while {$robotsRunning} {
 182         vwait robotsRunning
 183     }
 184     set robotSeq 0
 185     RobotStart
 186 }
 187
 188 proc RobotRestart {url sock} {
 189     global URL robotsRunning
 190
 191     close $sock
 192     after cancel $URL($sock,cancel)
 193
 194     foreach v [array names URL $url,*] {
 195         unset URL($v)
 196     }
 197
 198     incr robotsRunning -1
 199     RobotStart
 200 }
 201
 202 proc RobotStart {} {
 203     global URL
 204     global robotsRunning robotsMax idleTime
 205
 206     # puts "RobotStart"
 207     while {1} {
 208         set url [RobotFileNext unvisited]
 209         if {![string length $url]} {
 210             return
 211         }
 212         incr robotsRunning
 213         if {[string compare $url wait] == 0} {
 214             after $idleTime RobotRR
 215             return
 216         }
 217         set r [RobotGetUrl $url {}]
 218         if {!$r} {
 219             if {$robotsRunning >= $robotsMax} return
 220         } else {
 221             incr robotsRunning -1
 222             if {![RobotFileExist bad $URL($url,hostport) $URL($url,path)]} {
 223                 set outf [RobotFileOpen bad $URL($url,hostport) $URL($url,path)]
 224                 RobotFileClose $outf
 225             }
 226             RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path)
 227         }
 228     }
 229 }
 230
 231 proc headSave {url out} {
 232     global URL
 233
 234     if {[info exists URL($url,head,last-modified)]} {
 235         puts $out "<lastmodified>$URL($url,head,last-modified)</lastmodified>"
 236     }
 237     puts $out {<si>}
 238     if {[info exists URL($url,head,date)]} {
 239         puts $out " <date>$URL($url,head,date)</date>"
 240     }
 241     if {[info exists URL($url,head,content-length)]} {
 242         puts $out " <by>$URL($url,head,content-length)</by>"
 243     }
 244     if {[info exists URL($url,head,server)]} {
 245         puts $out " <format>$URL($url,head,server)</format>"
 246     }
 247     puts $out {</si>}
 248     puts $out {<publisher>}
 249     puts $out " <identifier>$url</identifier>"
 250     if {[info exists URL($url,head,content-type)]} {
 251         puts $out " <type>$URL($url,head,content-type)</type>"
 252     }
 253     puts $out {</publisher>}
 254 }
 255
 256 proc RobotHref {url hrefx hostx pathx} {
 257     global URL domains
 258     upvar $hrefx href
 259     upvar $hostx host
 260     upvar $pathx path
 261
 262     puts "Ref url = $url href=$href"
 263
 264     if {[string first { } $href] >= 0} {
 265         return 0
 266     }
 267     if {[string length $href] > 256} {
 268         return 0
 269     }
 270     if {[string first {?} $url] >= 0 && [string first {?} $href] >= 0} {
 271         return 0
 272     }
 273     # get method (if any)
 274     if {![regexp {^([^/:]+):(.*)} $href x method hpath]} {
 275         set hpath $href
 276         set method http
 277     } else {
 278         if {[string compare $method http]} {
 279             return 0
 280         }
 281     }
 282     # get host (if any)
 283     if {[regexp {^//([^/]+)([^\#]*)} $hpath x host surl]} {
 284         if {![string length $surl]} {
 285             set surl /
 286         }
 287         if {[info exist domains]} {
 288             set ok 0
 289             foreach domain $domains {
 290                 if {[string match $domain $host]} {
 291                     set ok 1
 292                     break
 293                  }
 294             }
 295             if {!$ok} {
 296                 return 0
 297             }
 298         }
 299     } else {
 300         regexp {^([^\#]*)} $hpath x surl
 301         set host $URL($url,hostport)
 302     }
 303     if {![string length $surl]} {
 304         return 0
 305     }
 306     if {[string first / $surl]} {
 307         # relative path
 308         regexp {^([^\#?]*)} $URL($url,path) x dpart
 309         set l [string last / $dpart]
 310         if {[expr $l >= 0]} {
 311             set surl [string range $dpart 0 $l]$surl
 312         } else {
 313             set surl $dpart/$surl
 314         }
 315     }
 316     set surllist [split $surl /]
 317     catch {unset path}
 318     set pathl 0
 319     foreach c $surllist {
 320         switch -- $c {
 321             .. {
 322                 if {$pathl > 0} {
 323                     incr pathl -1
 324                     set path [lrange $path 0 $pathl]
 325                 }
 326             }
 327             . {
 328
 329             }
 330             default {
 331                 incr pathl
 332                 lappend path $c
 333             }
 334         }
 335     }
 336     if {$pathl} {
 337         set path [join $path /]
 338     } else {
 339         set path ""
 340     }
 341     regsub -all {~} $path {%7E} path
 342     set href "$method://$host$path"
 343     puts "Ref href = $href"
 344     return 1
 345 }
 346
 347 proc RobotError {url code} {
 348     global URL
 349
 350     puts "Bad URL $url, $code"
 351     set fromurl {}
 352     set distance -1
 353     if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} {
 354         set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r]
 355         RobotReadRecord $inf fromurl distance
 356         RobotFileClose $inf
 357     }
 358     RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path)
 359     if {![RobotFileExist bad $URL($url,hostport) $URL($url,path)]} {
 360         set outf [RobotFileOpen bad $URL($url,hostport) $URL($url,path)]
 361         RobotWriteRecord $outf $fromurl $distance
 362         RobotFileClose $outf
 363     }
 364 }
 365
 366 proc RobotRedirect {url tourl code} {
 367     global URL
 368
 369     puts "Redirecting from $url to $tourl"
 370
 371     set distance {}
 372     set fromurl {}
 373     if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} {
 374         set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r]
 375         RobotReadRecord $inf fromurl distance
 376         RobotFileClose $inf
 377     }
 378     if {![RobotFileExist bad $URL($url,hostport) $URL($url,path)]} {
 379         set outf [RobotFileOpen bad $URL($url,hostport) $URL($url,path)]
 380         RobotWriteRecord $outf $fromurl $distance
 381         RobotFileClose $outf
 382     }
 383     if {[RobotHref $url tourl host path]} {
 384         if {![RobotFileExist visited $host $path]} {
 385             if {![RobotFileExist unvisited $host $path]} {
 386                 set outf [RobotFileOpen unvisited $host $path]
 387                 RobotWriteRecord $outf $fromurl $distance
 388                 RobotFileClose $outf
 389             }
 390         } else {
 391             set olddistance {}
 392             set inf [RobotFileOpen visited $host $path r]
 393             RobotReadRecord $inf oldurl olddistance
 394             RobotFileClose $inf
 395             if {[string length $olddistance] == 0} {
 396                 set olddistance 1000
 397             }
 398             if {[string length $distance] == 0} {
 399                 set distance 1000
 400             }
 401             puts "distance=$distance olddistance=$olddistance"
 402             if {[expr $distance < $olddistance]} {
 403                 set outf [RobotFileOpen unvisited $host $path]
 404                 RobotWriteRecord $outf $tourl $distance
 405                 RobotFileClose $outf
 406             }
 407         }
 408     }
 409     if {[catch {RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path)}]} {
 410         puts "unlink failed"
 411         exit 1
 412     }
 413 }
 414
 415 proc RobotTextHtml {url out} {
 416     global URL maxDistance
 417
 418     set distance 0
 419     if {$maxDistance < 1000 && [info exists URL($url,dist)]} {
 420         set distance [expr $URL($url,dist) + 1]
 421     }
 422     htmlSwitch $URL($url,buf) \
 423         title {
 424             puts $out "<title>$body</title>"
 425         } -nonest meta {
 426             puts -nonewline $out "<meta"
 427             foreach a [array names parm] {
 428                 puts -nonewline $out " $a"
 429                 puts -nonewline $out {="}
 430                 puts -nonewline $out $parm($a)
 431                 puts -nonewline $out {"}
 432             }
 433             puts $out {></meta>}
 434         } body {
 435             regsub -all -nocase {<script([^<]|(<!.*>))*</script>} $body {} abody
 436             regsub -all {<[^\>]+>} $abody {} nbody
 437             puts $out "<documentcontent>"
 438             puts $out $nbody
 439             puts $out "</documentcontent>"
 440         } -nonest a {
 441             if {![info exists parm(href)]} {
 442                 puts "no href"
 443                 continue
 444             }
 445             if {[expr $distance <= $maxDistance]} {
 446                 set href [string trim $parm(href)]
 447                 if {![RobotHref $url href host path]} continue
 448
 449                 puts $out "<cr>"
 450                 puts $out "<identifier>$href</identifier>"
 451                 puts $out "<description>$body</description>"
 452                 puts $out "</cr>"
 453
 454                 if {![RobotFileExist visited $host $path]} {
 455                     set olddistance 1000
 456                     if {![RobotFileExist bad $host $path]} {
 457                         if {[RobotFileExist unvisited $host $path]} {
 458                             set inf [RobotFileOpen unvisited $host $path r]
 459                             RobotReadRecord $inf oldurl olddistance
 460                             RobotFileClose $inf
 461                         }
 462                     } else {
 463                         set olddistance 0
 464                     }
 465                     if {[string length $olddistance] == 0} {
 466                         set olddistance 1000
 467                     }
 468                     if {[expr $distance < $olddistance]} {
 469                         set outf [RobotFileOpen unvisited $host $path]
 470                         RobotWriteRecord $outf $url $distance
 471                         RobotFileClose $outf
 472                     }
 473                 } elseif {[string compare $href $url]} {
 474                     set inf [RobotFileOpen visited $host $path r]
 475                     RobotReadRecord $inf xurl olddistance
 476                     close $inf
 477                     if {[string length $olddistance] == 0} {
 478                         set olddistance 1000
 479                     }
 480                     if {[expr $distance < $olddistance]} {
 481                         puts "OK remarking url=$url href=$href"
 482                         puts "olddistance = $olddistance"
 483                         puts "newdistance = $distance"
 484                         set outf [RobotFileOpen unvisited $host $path]
 485                         RobotWriteRecord $outf $url $distance
 486                         RobotFileClose $outf
 487                     }
 488                 }
 489             }
 490         } -nonest area {
 491             if {![info exists parm(href)]} {
 492                 puts "no href"
 493                 continue
 494             }
 495             if {[expr $distance <= $maxDistance]} {
 496                 set href [string trim $parm(href)]
 497                 if {![RobotHref $url href host path]} continue
 498
 499                 puts $out "<cr>"
 500                 puts $out "<identifier>$href</identifier>"
 501                 puts $out "<description></description>"
 502                 puts $out "</cr>"
 503
 504                 if {![RobotFileExist visited $host $path]} {
 505                     set olddistance 1000
 506                     if {![RobotFileExist bad $host $path]} {
 507                         if {[RobotFileExist unvisited $host $path]} {
 508                             set inf [RobotFileOpen unvisited $host $path r]
 509                             RobotReadRecord $inf oldurl olddistance
 510                             RobotFileClose $inf
 511                         }
 512                     } else {
 513                         set olddistance 0
 514                     }
 515                     if {[string length $olddistance] == 0} {
 516                         set olddistance 1000
 517                     }
 518                     if {[expr $distance < $olddistance]} {
 519                         set outf [RobotFileOpen unvisited $host $path]
 520                         RobotWriteRecord $outf $url $distance
 521                         RobotFileClose $outf
 522                     }
 523                 } elseif {[string compare $href $url]} {
 524                     set inf [RobotFileOpen visited $host $path r]
 525                     RobotReadRecord $inf xurl olddistance
 526                     close $inf
 527                     if {[string length $olddistance] == 0} {
 528                         set olddistance 1000
 529                     }
 530                     if {[expr $distance < $olddistance]} {
 531                         puts "OK remarking url=$url href=$href"
 532                         puts "olddistance = $olddistance"
 533                         puts "newdistance = $distance"
 534                         set outf [RobotFileOpen unvisited $host $path]
 535                         RobotWriteRecord $outf $url $distance
 536                         RobotFileClose $outf
 537                     }
 538                 }
 539             }
 540         }
 541 }
 542
 543 proc RobotsTxt {url} {
 544     global agent URL
 545
 546     RobotsTxt0 URL(URL($url,hostport),robots) $URL($url,buf)
 547 }
 548
 549 proc RobotsTxt0 {v buf} {
 550     global URL agent
 551     set section 0
 552     foreach l [split $buf \n] {
 553         if {[regexp {([-A-Za-z]+):[ \t]*([^\#\t ]+)} $l match cmd arg]} {
 554             puts "cmd=$cmd arg=$arg"
 555             switch -- [string tolower $cmd] {
 556                 user-agent {
 557                     if {$section} break
 558                     set pat [string tolower $arg]*
 559                     set section [string match $pat $agent]
 560                 }
 561                 disallow {
 562                     if {$section} {
 563                         puts "rule [list 0 $arg]"
 564                         lappend $v [list 0 $arg]
 565                     }
 566                 }
 567                 allow {
 568                     if {$section} {
 569                         puts "rule [list 1 $arg]"
 570                         lappend $v [list 1 $arg]
 571                     }
 572                 }
 573             }
 574         }
 575     }
 576 }
 577
 578 proc RobotTextPlain {url out} {
 579     global URL
 580
 581     puts $out "<documentcontent>"
 582     puts $out $URL($url,buf)
 583     puts $out "</documentcontent>"
 584
 585     if {![string compare $URL($url,path) /robots.txt]} {
 586         RobotsTxt $url
 587     }
 588 }
 589
 590 proc Robot200 {url} {
 591     global URL domains
 592
 593     set out [RobotFileOpen raw $URL($url,hostport) $URL($url,path)]
 594     puts -nonewline $out $URL($url,buf)
 595     RobotFileClose $out
 596
 597     set out [RobotFileOpen visited $URL($url,hostport) $URL($url,path)]
 598     puts $out "<zmbot>"
 599
 600     set distance 1000
 601     if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} {
 602         set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r]
 603         RobotReadRecord $inf fromurl distance
 604         RobotFileClose $inf
 605     }
 606     set URL($url,dist) $distance
 607     puts $out "<distance>"
 608     puts $out "  $distance"
 609     puts $out "</distance>"
 610     headSave $url $out
 611     puts "Parsing $url distance=$distance"
 612     switch $URL($url,head,content-type) {
 613         text/html {
 614             if {[string length $distance]} {
 615                 RobotTextHtml $url $out
 616             }
 617         }
 618         text/plain {
 619             RobotTextPlain $url $out $outr
 620         }
 621         application/pdf {
 622             set pdff [open test.pdf w]
 623             puts -nonewline $pdff $URL($url,buf)
 624             close $pdff
 625         }
 626     }
 627     puts $out "</zmbot>"
 628     RobotFileClose $out
 629     # puts "Parsing done"
 630     RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path)
 631 }
 632
 633 proc RobotReadContent {url sock binary} {
 634     global URL
 635
 636     puts "RobotReadContent $url"
 637     set buffer [read $sock 16384]
 638     set readCount [string length $buffer]
 639
 640     if {$readCount <= 0} {
 641         Robot200 $url
 642         RobotRestart $url $sock
 643     } elseif {!$binary && [string first \0 $buffer] >= 0} {
 644         Robot200 $url
 645         RobotRestart $url $sock
 646     } else {
 647         # puts "Got $readCount bytes"
 648         set URL($url,buf) $URL($url,buf)$buffer
 649     }
 650 }
 651
 652 proc RobotReadHeader {url sock} {
 653     global URL
 654
 655     puts "RobotReadHeader $url"
 656     if {[catch {set buffer [read $sock 2148]}]} {
 657         RobotError $url 404
 658         RobotRestart $url $sock
 659     }
 660     set readCount [string length $buffer]
 661
 662     if {$readCount <= 0} {
 663         RobotError $url 404
 664         RobotRestart $url $sock
 665     } else {
 666         # puts "Got $readCount bytes"
 667         set URL($url,buf) $URL($url,buf)$buffer
 668
 669         set n [string first \r\n\r\n $URL($url,buf)]
 670         if {$n > 1} {
 671             set code 0
 672             set version {}
 673             set headbuf [string range $URL($url,buf) 0 $n]
 674             incr n 4
 675             set URL($url,buf) [string range $URL($url,buf) $n end]
 676
 677             regexp {^HTTP/([0-9.]+)[ ]+([0-9]+)} $headbuf x version code
 678             set lines [split $headbuf \n]
 679             foreach line $lines {
 680                 if {[regexp {^([^:]+):[ ]+([^;]*)} $line x name value]} {
 681                     set URL($url,head,[string tolower $name]) [string trim $value]
 682                 }
 683             }
 684             puts "code = $code"
 685             set URL($url,state) skip
 686             switch $code {
 687                 301 {
 688                     RobotRedirect $url $URL($url,head,location) 301
 689                     RobotRestart $url $sock
 690                 }
 691                 302 {
 692                     RobotRedirect $url $URL($url,head,location) 302
 693                     RobotRestart $url $sock
 694                 }
 695                 200 {
 696                     if {![info exists URL($url,head,content-type)]} {
 697                         set URL($url,head,content-type) {}
 698                     }
 699                     set binary 0
 700                     switch $URL($url,head,content-type) {
 701                         application/pdf {
 702                             set binary 1
 703                         }
 704                     }
 705                     fileevent $sock readable [list RobotReadContent $url $sock $binary]
 706                 }
 707                 default {
 708                     RobotError $url $code
 709                     RobotRestart $url $sock
 710                 }
 711             }
 712         }
 713     }
 714 }
 715
 716 proc RobotSockCancel {url sock} {
 717
 718     puts "RobotSockCancel sock=$sock url=$url"
 719     RobotError $url 401
 720     RobotRestart $url $sock
 721 }
 722
 723 proc RobotConnect {url sock} {
 724     global URL agent
 725
 726     fconfigure $sock -translation {lf crlf} -blocking 0
 727     fileevent $sock readable [list RobotReadHeader $url $sock]
 728     puts $sock "GET $URL($url,path) HTTP/1.0"
 729     puts $sock "Host: $URL($url,host)"
 730     puts $sock "User-Agent: $agent"
 731     puts $sock ""
 732     flush $sock
 733     set URL($sock,cancel) [after 30000 [list RobotSockCancel $url $sock]]
 734 }
 735
 736 proc RobotNop {} {
 737
 738 }
 739
 740 proc RobotGetUrl {url phost} {
 741     global URL robotsRunning
 742     flush stdout
 743     puts "RobotGetUrl --------- robotsRunning=$robotsRunning url=$url"
 744     if {![regexp {([^:]+)://([^/]+)(.*)} $url x method hostport path]} {
 745         return -1
 746     }
 747     if {![regexp {([^:]+):([0-9]+)} $hostport x host port]} {
 748         set port 80
 749         set host $hostport
 750     }
 751     set URL($url,method) $method
 752     set URL($url,host) $host
 753     set URL($url,hostport) $hostport
 754     set URL($url,path) $path
 755     set URL($url,state) head
 756     set URL($url,buf) {}
 757
 758     if {[string compare $path /robots.txt]} {
 759         set ok 1
 760         if {![info exists URL($hostport,robots)]} {
 761             puts "READING robots.txt for host $hostport"
 762             if {[RobotFileExist visited $hostport /robots.txt]} {
 763                 set inf [RobotFileOpen visited $hostport /robots.txt r]
 764                 set buf [read $inf 32768]
 765                 close $inf
 766             } else {
 767                 set buf "User-agent: *\nAllow: /\n"
 768             }
 769             RobotsTxt0 URL($hostport,robots) $buf
 770         }
 771         if {[info exists URL($hostport,robots)]} {
 772             foreach l $URL($hostport,robots) {
 773                 if {[string first [lindex $l 1] $path] == 0} {
 774                     set ok [lindex $l 0]
 775                     break
 776                 }
 777             }
 778         }
 779         if {!$ok} {
 780             puts "skipped due to robots.txt"
 781             return -1
 782         }
 783     }
 784     if [catch {set sock [socket -async $host $port]}] {
 785         return -1
 786     }
 787     RobotConnect $url $sock
 788
 789     return 0
 790 }
 791
 792 if {![llength [info commands htmlSwitch]]} {
 793     set e [info sharedlibextension]
 794     if {[catch {load ./tclrobot$e}]} {
 795         load tclrobot$e
 796     }
 797 }
 798
 799 set agent "zmbot/0.0"
 800 if {![catch {set os [exec uname -s -r]}]} {
 801     set agent "$agent ($os)"
 802 }
 803
 804 puts "agent: $agent"
 805
 806 proc bgerror {m} {
 807     global errorInfo
 808     puts "BGERROR $m"
 809     puts $errorInfo
 810 }
 811
 812 set robotsRunning 0
 813 set robotSeq 0
 814 set workdir [pwd]
 815 set idleTime 60000
 816
 817 set i 0
 818 set l [llength $argv]
 819
 820 # For testing only
 821 if {0} {
 822     set url "http://www.sportsfiskeren.dk/sportsfiskeren/corner/index.htm"
 823     set href "../../data/../../data2/newsovs.asp?Mode=5"
 824
 825     set URL($url,path) /sportsfiskeren/corner/index.htm
 826     set URL($url,hostport) www.sportsfiskeren.dk
 827     RobotHref $url href host path
 828     exit 0
 829 }
 830
 831 if {$l < 2} {
 832     puts {tclrobot: usage [-j jobs] [-i idle] [-c count] [-d domain] [url ..]}
 833     puts " Example: -c 3 -d '*.dk' http://www.indexdata.dk/"
 834     exit 1
 835 }
 836
 837 while  {$i < $l} {
 838     set arg [lindex $argv $i]
 839     switch -glob -- $arg {
 840         -j* {
 841             set robotsMax [string range $arg 2 end]
 842             if {![string length $robotsMax]} {
 843                 set robotsMax [lindex $argv [incr i]]
 844             }
 845         }
 846         -c* {
 847             set maxDistance [string range $arg 2 end]
 848             if {![string length $maxDistance]} {
 849                 set maxDistance [lindex $argv [incr i]]
 850             }
 851         }
 852         -d* {
 853             set dom [string range $arg 2 end]
 854             if {![string length $dom]} {
 855                 set dom [lindex $argv [incr i]]
 856             }
 857             lappend domains $dom
 858         }
 859         -i* {
 860             set idleTime [string range $arg 2 end]
 861             if {![string length $idleTime]} {
 862                 set idleTime [lindex $argv [incr i]]
 863             }
 864         }
 865         default {
 866             set href $arg
 867             if {[RobotHref http://www.indexdata.dk/ href host path]} {
 868                 if {![RobotFileExist visited $host $path]} {
 869                     set outf [RobotFileOpen unvisited $host $path]
 870                     RobotWriteRecord $outf href 0
 871                     RobotFileClose $outf
 872                 }
 873             }
 874         }
 875     }
 876     incr i
 877 }
 878
 879 if {![info exist domains]} {
 880     set domains {*}
 881 }
 882 if {![info exist maxDistance]} {
 883     set maxDistance 50
 884 }
 885 if {![info exist robotsMax]} {
 886     set robotsMax 5
 887 }
 888
 889 puts "domains=$domains"
 890 puts "max distance=$maxDistance"
 891 puts "max jobs=$robotsMax"
 892
 893 RobotStart
 894
 895 while {$robotsRunning} {
 896     vwait robotsRunning
 897 }