robot.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: robot.tcl,v 1.18 2001/06/07 08:17:00 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]+):[ ]*([^\# ]+)} $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     regsub -all {<} $URL($url,buf) {\&lt;} content
 583     puts $out $content
 584     puts $out "</documentcontent>"
 585
 586     if {![string compare $URL($url,path) /robots.txt]} {
 587         RobotsTxt $url
 588     }
 589 }
 590
 591 proc Robot200 {url} {
 592     global URL domains
 593
 594     set out [RobotFileOpen raw $URL($url,hostport) $URL($url,path)]
 595     puts -nonewline $out $URL($url,buf)
 596     RobotFileClose $out
 597
 598     set out [RobotFileOpen visited $URL($url,hostport) $URL($url,path)]
 599     puts $out "<zmbot>"
 600
 601     set distance 1000
 602     if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} {
 603         set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r]
 604         RobotReadRecord $inf fromurl distance
 605         RobotFileClose $inf
 606     }
 607     set URL($url,dist) $distance
 608     puts $out "<distance>"
 609     puts $out "  $distance"
 610     puts $out "</distance>"
 611     headSave $url $out
 612     puts "Parsing $url distance=$distance"
 613     switch $URL($url,head,content-type) {
 614         text/html {
 615             if {[string length $distance]} {
 616                 RobotTextHtml $url $out
 617             }
 618         }
 619         text/plain {
 620             RobotTextPlain $url $out
 621         }
 622         application/pdf {
 623             set pdff [open test.pdf w]
 624             puts -nonewline $pdff $URL($url,buf)
 625             close $pdff
 626         }
 627     }
 628     puts $out "</zmbot>"
 629     RobotFileClose $out
 630     # puts "Parsing done"
 631     RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path)
 632 }
 633
 634 proc RobotReadContent {url sock binary} {
 635     global URL
 636
 637     puts "RobotReadContent $url"
 638     set buffer [read $sock 16384]
 639     set readCount [string length $buffer]
 640
 641     if {$readCount <= 0} {
 642         Robot200 $url
 643         RobotRestart $url $sock
 644     } elseif {!$binary && [string first \0 $buffer] >= 0} {
 645         Robot200 $url
 646         RobotRestart $url $sock
 647     } else {
 648         # puts "Got $readCount bytes"
 649         set URL($url,buf) $URL($url,buf)$buffer
 650     }
 651 }
 652
 653 proc RobotReadHeader {url sock} {
 654     global URL
 655
 656     puts "RobotReadHeader $url"
 657     if {[catch {set buffer [read $sock 2148]}]} {
 658         RobotError $url 404
 659         RobotRestart $url $sock
 660     }
 661     set readCount [string length $buffer]
 662
 663     if {$readCount <= 0} {
 664         RobotError $url 404
 665         RobotRestart $url $sock
 666     } else {
 667         # puts "Got $readCount bytes"
 668         set URL($url,buf) $URL($url,buf)$buffer
 669
 670         set n [string first \r\n\r\n $URL($url,buf)]
 671         if {$n > 1} {
 672             set code 0
 673             set version {}
 674             set headbuf [string range $URL($url,buf) 0 $n]
 675             incr n 4
 676             set URL($url,buf) [string range $URL($url,buf) $n end]
 677
 678             regexp {^HTTP/([0-9.]+)[ ]+([0-9]+)} $headbuf x version code
 679             set lines [split $headbuf \n]
 680             foreach line $lines {
 681                 if {[regexp {^([^:]+):[ ]+([^;]*)} $line x name value]} {
 682                     set URL($url,head,[string tolower $name]) [string trim $value]
 683                 }
 684             }
 685             puts "code = $code"
 686             set URL($url,state) skip
 687             switch $code {
 688                 301 {
 689                     RobotRedirect $url $URL($url,head,location) 301
 690                     RobotRestart $url $sock
 691                 }
 692                 302 {
 693                     RobotRedirect $url $URL($url,head,location) 302
 694                     RobotRestart $url $sock
 695                 }
 696                 200 {
 697                     if {![info exists URL($url,head,content-type)]} {
 698                         set URL($url,head,content-type) {}
 699                     }
 700                     set binary 0
 701                     switch $URL($url,head,content-type) {
 702                         application/pdf {
 703                             set binary 1
 704                         }
 705                     }
 706                     fileevent $sock readable [list RobotReadContent $url $sock $binary]
 707                 }
 708                 default {
 709                     RobotError $url $code
 710                     RobotRestart $url $sock
 711                 }
 712             }
 713         }
 714     }
 715 }
 716
 717 proc RobotSockCancel {url sock} {
 718
 719     puts "RobotSockCancel sock=$sock url=$url"
 720     RobotError $url 401
 721     RobotRestart $url $sock
 722 }
 723
 724 proc RobotConnect {url sock} {
 725     global URL agent
 726
 727     fconfigure $sock -translation {lf crlf} -blocking 0
 728     fileevent $sock readable [list RobotReadHeader $url $sock]
 729     puts $sock "GET $URL($url,path) HTTP/1.0"
 730     puts $sock "Host: $URL($url,host)"
 731     puts $sock "User-Agent: $agent"
 732     puts $sock ""
 733     flush $sock
 734     set URL($sock,cancel) [after 30000 [list RobotSockCancel $url $sock]]
 735 }
 736
 737 proc RobotNop {} {
 738
 739 }
 740
 741 proc RobotGetUrl {url phost} {
 742     global URL robotsRunning
 743     flush stdout
 744     puts "RobotGetUrl --------- robotsRunning=$robotsRunning url=$url"
 745     if {![regexp {([^:]+)://([^/]+)(.*)} $url x method hostport path]} {
 746         return -1
 747     }
 748     if {![regexp {([^:]+):([0-9]+)} $hostport x host port]} {
 749         set port 80
 750         set host $hostport
 751     }
 752     set URL($url,method) $method
 753     set URL($url,host) $host
 754     set URL($url,hostport) $hostport
 755     set URL($url,path) $path
 756     set URL($url,state) head
 757     set URL($url,buf) {}
 758
 759     if {[string compare $path /robots.txt]} {
 760         set ok 1
 761         if {![info exists URL($hostport,robots)]} {
 762             puts "READING robots.txt for host $hostport"
 763             if {[RobotFileExist visited $hostport /robots.txt]} {
 764                 set inf [RobotFileOpen visited $hostport /robots.txt r]
 765                 set buf [read $inf 32768]
 766                 close $inf
 767             } else {
 768                 set buf "User-agent: *\nAllow: /\n"
 769             }
 770             RobotsTxt0 URL($hostport,robots) $buf
 771         }
 772         if {[info exists URL($hostport,robots)]} {
 773             foreach l $URL($hostport,robots) {
 774                 if {[string first [lindex $l 1] $path] == 0} {
 775                     set ok [lindex $l 0]
 776                     break
 777                 }
 778             }
 779         }
 780         if {!$ok} {
 781             puts "skipped due to robots.txt"
 782             return -1
 783         }
 784     }
 785     if [catch {set sock [socket -async $host $port]}] {
 786         return -1
 787     }
 788     RobotConnect $url $sock
 789
 790     return 0
 791 }
 792
 793 if {![llength [info commands htmlSwitch]]} {
 794     set e [info sharedlibextension]
 795     if {[catch {load ./tclrobot$e}]} {
 796         load tclrobot$e
 797     }
 798 }
 799
 800 set agent "zmbot/0.0"
 801 if {![catch {set os [exec uname -s -r]}]} {
 802     set agent "$agent ($os)"
 803 }
 804
 805 puts "agent: $agent"
 806
 807 proc bgerror {m} {
 808     global errorInfo
 809     puts "BGERROR $m"
 810     puts $errorInfo
 811 }
 812
 813 set robotsRunning 0
 814 set robotSeq 0
 815 set workdir [pwd]
 816 set idleTime 60000
 817
 818 set i 0
 819 set l [llength $argv]
 820
 821 # For testing only
 822 if {0} {
 823     set url "http://www.sportsfiskeren.dk/sportsfiskeren/corner/index.htm"
 824     set href "../../data/../../data2/newsovs.asp?Mode=5"
 825
 826     set URL($url,path) /sportsfiskeren/corner/index.htm
 827     set URL($url,hostport) www.sportsfiskeren.dk
 828     RobotHref $url href host path
 829     exit 0
 830 }
 831
 832 if {$l < 2} {
 833     puts {tclrobot: usage [-j jobs] [-i idle] [-c count] [-d domain] [url ..]}
 834     puts " Example: -c 3 -d '*.dk' http://www.indexdata.dk/"
 835     exit 1
 836 }
 837
 838 while  {$i < $l} {
 839     set arg [lindex $argv $i]
 840     switch -glob -- $arg {
 841         -j* {
 842             set robotsMax [string range $arg 2 end]
 843             if {![string length $robotsMax]} {
 844                 set robotsMax [lindex $argv [incr i]]
 845             }
 846         }
 847         -c* {
 848             set maxDistance [string range $arg 2 end]
 849             if {![string length $maxDistance]} {
 850                 set maxDistance [lindex $argv [incr i]]
 851             }
 852         }
 853         -d* {
 854             set dom [string range $arg 2 end]
 855             if {![string length $dom]} {
 856                 set dom [lindex $argv [incr i]]
 857             }
 858             lappend domains $dom
 859         }
 860         -i* {
 861             set idleTime [string range $arg 2 end]
 862             if {![string length $idleTime]} {
 863                 set idleTime [lindex $argv [incr i]]
 864             }
 865         }
 866         default {
 867             set href $arg
 868             if {[RobotHref http://www.indexdata.dk/ href host path]} {
 869                 if {![RobotFileExist visited $host $path]} {
 870                     set outf [RobotFileOpen unvisited $host $path]
 871                     RobotWriteRecord $outf href 0
 872                     RobotFileClose $outf
 873                 }
 874             }
 875         }
 876     }
 877     incr i
 878 }
 879
 880 if {![info exist domains]} {
 881     set domains {*}
 882 }
 883 if {![info exist maxDistance]} {
 884     set maxDistance 50
 885 }
 886 if {![info exist robotsMax]} {
 887     set robotsMax 5
 888 }
 889
 890 puts "domains=$domains"
 891 puts "max distance=$maxDistance"
 892 puts "max jobs=$robotsMax"
 893
 894 RobotStart
 895
 896 while {$robotsRunning} {
 897     vwait robotsRunning
 898 }