robot.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: robot.tcl,v 1.19 2001/06/29 21:47:31 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 {?} $href] >= 0} {
 271         return 0
 272     }
 273     if {[string first {?} $url] >= 0 && [string first {?} $href] >= 0} {
 274         return 0
 275     }
 276     # get method (if any)
 277     if {![regexp {^([^/:]+):(.*)} $href x method hpath]} {
 278         set hpath $href
 279         set method http
 280     } else {
 281         if {[string compare $method http]} {
 282             return 0
 283         }
 284     }
 285     # get host (if any)
 286     if {[regexp {^//([^/]+)([^\#]*)} $hpath x host surl]} {
 287         if {![string length $surl]} {
 288             set surl /
 289         }
 290         if {[info exist domains]} {
 291             set ok 0
 292             foreach domain $domains {
 293                 if {[string match $domain $host]} {
 294                     set ok 1
 295                     break
 296                  }
 297             }
 298             if {!$ok} {
 299                 return 0
 300             }
 301         }
 302     } else {
 303         regexp {^([^\#]*)} $hpath x surl
 304         set host $URL($url,hostport)
 305     }
 306     if {![string length $surl]} {
 307         return 0
 308     }
 309     if {[string first / $surl]} {
 310         # relative path
 311         regexp {^([^\#?]*)} $URL($url,path) x dpart
 312         set l [string last / $dpart]
 313         if {[expr $l >= 0]} {
 314             set surl [string range $dpart 0 $l]$surl
 315         } else {
 316             set surl $dpart/$surl
 317         }
 318     }
 319     set surllist [split $surl /]
 320     catch {unset path}
 321     set pathl 0
 322     foreach c $surllist {
 323         switch -- $c {
 324             .. {
 325                 if {$pathl > 0} {
 326                     incr pathl -1
 327                     set path [lrange $path 0 $pathl]
 328                 }
 329             }
 330             . {
 331
 332             }
 333             default {
 334                 incr pathl
 335                 lappend path $c
 336             }
 337         }
 338     }
 339     if {$pathl} {
 340         set path [join $path /]
 341     } else {
 342         set path ""
 343     }
 344     regsub -all {~} $path {%7E} path
 345     set href "$method://$host$path"
 346     puts "Ref href = $href"
 347     return 1
 348 }
 349
 350 proc RobotError {url code} {
 351     global URL
 352
 353     puts "Bad URL $url, $code"
 354     set fromurl {}
 355     set distance -1
 356     if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} {
 357         set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r]
 358         RobotReadRecord $inf fromurl distance
 359         RobotFileClose $inf
 360     }
 361     RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path)
 362     if {![RobotFileExist bad $URL($url,hostport) $URL($url,path)]} {
 363         set outf [RobotFileOpen bad $URL($url,hostport) $URL($url,path)]
 364         RobotWriteRecord $outf $fromurl $distance
 365         RobotFileClose $outf
 366     }
 367 }
 368
 369 proc RobotRedirect {url tourl code} {
 370     global URL
 371
 372     puts "Redirecting from $url to $tourl"
 373
 374     set distance {}
 375     set fromurl {}
 376     if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} {
 377         set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r]
 378         RobotReadRecord $inf fromurl distance
 379         RobotFileClose $inf
 380     }
 381     if {![RobotFileExist bad $URL($url,hostport) $URL($url,path)]} {
 382         set outf [RobotFileOpen bad $URL($url,hostport) $URL($url,path)]
 383         RobotWriteRecord $outf $fromurl $distance
 384         RobotFileClose $outf
 385     }
 386     if {[RobotHref $url tourl host path]} {
 387         if {![RobotFileExist visited $host $path]} {
 388             if {![RobotFileExist unvisited $host $path]} {
 389                 set outf [RobotFileOpen unvisited $host $path]
 390                 RobotWriteRecord $outf $fromurl $distance
 391                 RobotFileClose $outf
 392             }
 393         } else {
 394             set olddistance {}
 395             set inf [RobotFileOpen visited $host $path r]
 396             RobotReadRecord $inf oldurl olddistance
 397             RobotFileClose $inf
 398             if {[string length $olddistance] == 0} {
 399                 set olddistance 1000
 400             }
 401             if {[string length $distance] == 0} {
 402                 set distance 1000
 403             }
 404             puts "distance=$distance olddistance=$olddistance"
 405             if {[expr $distance < $olddistance]} {
 406                 set outf [RobotFileOpen unvisited $host $path]
 407                 RobotWriteRecord $outf $tourl $distance
 408                 RobotFileClose $outf
 409             }
 410         }
 411     }
 412     if {[catch {RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path)}]} {
 413         puts "unlink failed"
 414         exit 1
 415     }
 416 }
 417
 418 proc RobotTextHtml {url out} {
 419     global URL maxDistance
 420
 421     set distance 0
 422     if {$maxDistance < 1000 && [info exists URL($url,dist)]} {
 423         set distance [expr $URL($url,dist) + 1]
 424     }
 425     htmlSwitch $URL($url,buf) \
 426         title {
 427             puts $out "<title>$body</title>"
 428         } -nonest meta {
 429             puts -nonewline $out "<meta"
 430             foreach a [array names parm] {
 431                 puts -nonewline $out " $a"
 432                 puts -nonewline $out {="}
 433                 puts -nonewline $out $parm($a)
 434                 puts -nonewline $out {"}
 435             }
 436             puts $out {></meta>}
 437         } body {
 438             regsub -all -nocase {<script([^<]|(<!.*>))*</script>} $body {} abody
 439             regsub -all {<[^\>]+>} $abody {} nbody
 440             puts $out "<documentcontent>"
 441             puts $out $nbody
 442             puts $out "</documentcontent>"
 443         } -nonest a {
 444             if {![info exists parm(href)]} {
 445                 puts "no href"
 446                 continue
 447             }
 448             if {[expr $distance <= $maxDistance]} {
 449                 set href [string trim $parm(href)]
 450                 if {![RobotHref $url href host path]} continue
 451
 452                 puts $out "<cr>"
 453                 puts $out "<identifier>$href</identifier>"
 454                 puts $out "<description>$body</description>"
 455                 puts $out "</cr>"
 456
 457                 if {![RobotFileExist visited $host $path]} {
 458                     set olddistance 1000
 459                     if {![RobotFileExist bad $host $path]} {
 460                         if {[RobotFileExist unvisited $host $path]} {
 461                             set inf [RobotFileOpen unvisited $host $path r]
 462                             RobotReadRecord $inf oldurl olddistance
 463                             RobotFileClose $inf
 464                         }
 465                     } else {
 466                         set olddistance 0
 467                     }
 468                     if {[string length $olddistance] == 0} {
 469                         set olddistance 1000
 470                     }
 471                     if {[expr $distance < $olddistance]} {
 472                         set outf [RobotFileOpen unvisited $host $path]
 473                         RobotWriteRecord $outf $url $distance
 474                         RobotFileClose $outf
 475                     }
 476                 } elseif {[string compare $href $url]} {
 477                     set inf [RobotFileOpen visited $host $path r]
 478                     RobotReadRecord $inf xurl olddistance
 479                     close $inf
 480                     if {[string length $olddistance] == 0} {
 481                         set olddistance 1000
 482                     }
 483                     if {[expr $distance < $olddistance]} {
 484                         puts "OK remarking url=$url href=$href"
 485                         puts "olddistance = $olddistance"
 486                         puts "newdistance = $distance"
 487                         set outf [RobotFileOpen unvisited $host $path]
 488                         RobotWriteRecord $outf $url $distance
 489                         RobotFileClose $outf
 490                     }
 491                 }
 492             }
 493         } -nonest area {
 494             if {![info exists parm(href)]} {
 495                 puts "no href"
 496                 continue
 497             }
 498             if {[expr $distance <= $maxDistance]} {
 499                 set href [string trim $parm(href)]
 500                 if {![RobotHref $url href host path]} continue
 501
 502                 puts $out "<cr>"
 503                 puts $out "<identifier>$href</identifier>"
 504                 puts $out "<description></description>"
 505                 puts $out "</cr>"
 506
 507                 if {![RobotFileExist visited $host $path]} {
 508                     set olddistance 1000
 509                     if {![RobotFileExist bad $host $path]} {
 510                         if {[RobotFileExist unvisited $host $path]} {
 511                             set inf [RobotFileOpen unvisited $host $path r]
 512                             RobotReadRecord $inf oldurl olddistance
 513                             RobotFileClose $inf
 514                         }
 515                     } else {
 516                         set olddistance 0
 517                     }
 518                     if {[string length $olddistance] == 0} {
 519                         set olddistance 1000
 520                     }
 521                     if {[expr $distance < $olddistance]} {
 522                         set outf [RobotFileOpen unvisited $host $path]
 523                         RobotWriteRecord $outf $url $distance
 524                         RobotFileClose $outf
 525                     }
 526                 } elseif {[string compare $href $url]} {
 527                     set inf [RobotFileOpen visited $host $path r]
 528                     RobotReadRecord $inf xurl olddistance
 529                     close $inf
 530                     if {[string length $olddistance] == 0} {
 531                         set olddistance 1000
 532                     }
 533                     if {[expr $distance < $olddistance]} {
 534                         puts "OK remarking url=$url href=$href"
 535                         puts "olddistance = $olddistance"
 536                         puts "newdistance = $distance"
 537                         set outf [RobotFileOpen unvisited $host $path]
 538                         RobotWriteRecord $outf $url $distance
 539                         RobotFileClose $outf
 540                     }
 541                 }
 542             }
 543         }
 544 }
 545
 546 proc RobotsTxt {url} {
 547     global agent URL
 548
 549     RobotsTxt0 URL(URL($url,hostport),robots) $URL($url,buf)
 550 }
 551
 552 proc RobotsTxt0 {v buf} {
 553     global URL agent
 554     set section 0
 555     foreach l [split $buf \n] {
 556         if {[regexp {([-A-Za-z]+):[ ]*([^\# ]+)} $l match cmd arg]} {
 557             puts "cmd=$cmd arg=$arg"
 558             switch -- [string tolower $cmd] {
 559                 user-agent {
 560                     if {$section} break
 561                     set pat [string tolower $arg]*
 562                     set section [string match $pat $agent]
 563                 }
 564                 disallow {
 565                     if {$section} {
 566                         puts "rule [list 0 $arg]"
 567                         lappend $v [list 0 $arg]
 568                     }
 569                 }
 570                 allow {
 571                     if {$section} {
 572                         puts "rule [list 1 $arg]"
 573                         lappend $v [list 1 $arg]
 574                     }
 575                 }
 576             }
 577         }
 578     }
 579 }
 580
 581 proc RobotTextPlain {url out} {
 582     global URL
 583
 584     puts $out "<documentcontent>"
 585     regsub -all {<} $URL($url,buf) {\&lt;} content
 586     puts $out $content
 587     puts $out "</documentcontent>"
 588
 589     if {![string compare $URL($url,path) /robots.txt]} {
 590         RobotsTxt $url
 591     }
 592 }
 593
 594 proc Robot200 {url} {
 595     global URL domains
 596
 597     set out [RobotFileOpen raw $URL($url,hostport) $URL($url,path)]
 598     puts -nonewline $out $URL($url,buf)
 599     RobotFileClose $out
 600
 601     set out [RobotFileOpen visited $URL($url,hostport) $URL($url,path)]
 602     puts $out "<zmbot>"
 603
 604     set distance 1000
 605     if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} {
 606         set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r]
 607         RobotReadRecord $inf fromurl distance
 608         RobotFileClose $inf
 609     }
 610     set URL($url,dist) $distance
 611     puts $out "<distance>"
 612     puts $out "  $distance"
 613     puts $out "</distance>"
 614     headSave $url $out
 615     puts "Parsing $url distance=$distance"
 616     switch $URL($url,head,content-type) {
 617         text/html {
 618             if {[string length $distance]} {
 619                 RobotTextHtml $url $out
 620             }
 621         }
 622         text/plain {
 623             RobotTextPlain $url $out
 624         }
 625         application/pdf {
 626             set pdff [open test.pdf w]
 627             puts -nonewline $pdff $URL($url,buf)
 628             close $pdff
 629         }
 630     }
 631     puts $out "</zmbot>"
 632     RobotFileClose $out
 633     # puts "Parsing done"
 634     RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path)
 635 }
 636
 637 proc RobotReadContent {url sock binary} {
 638     global URL
 639
 640     puts "RobotReadContent $url"
 641     set buffer [read $sock 16384]
 642     set readCount [string length $buffer]
 643
 644     if {$readCount <= 0} {
 645         Robot200 $url
 646         RobotRestart $url $sock
 647     } elseif {!$binary && [string first \0 $buffer] >= 0} {
 648         Robot200 $url
 649         RobotRestart $url $sock
 650     } else {
 651         # puts "Got $readCount bytes"
 652         set URL($url,buf) $URL($url,buf)$buffer
 653     }
 654 }
 655
 656 proc RobotReadHeader {url sock} {
 657     global URL
 658
 659     puts "RobotReadHeader $url"
 660     if {[catch {set buffer [read $sock 2148]}]} {
 661         RobotError $url 404
 662         RobotRestart $url $sock
 663     }
 664     set readCount [string length $buffer]
 665
 666     if {$readCount <= 0} {
 667         RobotError $url 404
 668         RobotRestart $url $sock
 669     } else {
 670         # puts "Got $readCount bytes"
 671         set URL($url,buf) $URL($url,buf)$buffer
 672
 673         set n [string first \r\n\r\n $URL($url,buf)]
 674         if {$n > 1} {
 675             set code 0
 676             set version {}
 677             set headbuf [string range $URL($url,buf) 0 $n]
 678             incr n 4
 679             set URL($url,buf) [string range $URL($url,buf) $n end]
 680
 681             regexp {^HTTP/([0-9.]+)[ ]+([0-9]+)} $headbuf x version code
 682             set lines [split $headbuf \n]
 683             foreach line $lines {
 684                 if {[regexp {^([^:]+):[ ]+([^;]*)} $line x name value]} {
 685                     set URL($url,head,[string tolower $name]) [string trim $value]
 686                 }
 687             }
 688             puts "code = $code"
 689             set URL($url,state) skip
 690             switch $code {
 691                 301 {
 692                     RobotRedirect $url $URL($url,head,location) 301
 693                     RobotRestart $url $sock
 694                 }
 695                 302 {
 696                     RobotRedirect $url $URL($url,head,location) 302
 697                     RobotRestart $url $sock
 698                 }
 699                 200 {
 700                     if {![info exists URL($url,head,content-type)]} {
 701                         set URL($url,head,content-type) {}
 702                     }
 703                     set binary 0
 704                     switch $URL($url,head,content-type) {
 705                         application/pdf {
 706                             set binary 1
 707                         }
 708                     }
 709                     fileevent $sock readable [list RobotReadContent $url $sock $binary]
 710                 }
 711                 default {
 712                     RobotError $url $code
 713                     RobotRestart $url $sock
 714                 }
 715             }
 716         }
 717     }
 718 }
 719
 720 proc RobotSockCancel {url sock} {
 721
 722     puts "RobotSockCancel sock=$sock url=$url"
 723     RobotError $url 401
 724     RobotRestart $url $sock
 725 }
 726
 727 proc RobotConnect {url sock} {
 728     global URL agent acceptLanguage
 729
 730     fconfigure $sock -translation {lf crlf} -blocking 0
 731     fileevent $sock readable [list RobotReadHeader $url $sock]
 732     puts $sock "GET $URL($url,path) HTTP/1.0"
 733     puts $sock "Host: $URL($url,host)"
 734     puts $sock "User-Agent: $agent"
 735     if {[string length $acceptLanguage]} {
 736         puts $sock "Accept-Language: $acceptLanguage"
 737     }
 738     puts $sock ""
 739     flush $sock
 740     set URL($sock,cancel) [after 30000 [list RobotSockCancel $url $sock]]
 741 }
 742
 743 proc RobotNop {} {
 744
 745 }
 746
 747 proc RobotGetUrl {url phost} {
 748     global URL robotsRunning
 749     flush stdout
 750     puts "RobotGetUrl --------- robotsRunning=$robotsRunning url=$url"
 751     if {![regexp {([^:]+)://([^/]+)(.*)} $url x method hostport path]} {
 752         return -1
 753     }
 754     if {![regexp {([^:]+):([0-9]+)} $hostport x host port]} {
 755         set port 80
 756         set host $hostport
 757     }
 758     set URL($url,method) $method
 759     set URL($url,host) $host
 760     set URL($url,hostport) $hostport
 761     set URL($url,path) $path
 762     set URL($url,state) head
 763     set URL($url,buf) {}
 764
 765     if {[string compare $path /robots.txt]} {
 766         set ok 1
 767         if {![info exists URL($hostport,robots)]} {
 768             puts "READING robots.txt for host $hostport"
 769             if {[RobotFileExist visited $hostport /robots.txt]} {
 770                 set inf [RobotFileOpen visited $hostport /robots.txt r]
 771                 set buf [read $inf 32768]
 772                 close $inf
 773             } else {
 774                 set buf "User-agent: *\nAllow: /\n"
 775             }
 776             RobotsTxt0 URL($hostport,robots) $buf
 777         }
 778         if {[info exists URL($hostport,robots)]} {
 779             foreach l $URL($hostport,robots) {
 780                 if {[string first [lindex $l 1] $path] == 0} {
 781                     set ok [lindex $l 0]
 782                     break
 783                 }
 784             }
 785         }
 786         if {!$ok} {
 787             puts "skipped due to robots.txt"
 788             return -1
 789         }
 790     }
 791     if [catch {set sock [socket -async $host $port]}] {
 792         return -1
 793     }
 794     RobotConnect $url $sock
 795
 796     return 0
 797 }
 798
 799 if {![llength [info commands htmlSwitch]]} {
 800     set e [info sharedlibextension]
 801     if {[catch {load ./tclrobot$e}]} {
 802         load tclrobot$e
 803     }
 804 }
 805
 806 set agent "zmbot/0.0"
 807 if {![catch {set os [exec uname -s -r]}]} {
 808     set agent "$agent ($os)"
 809 }
 810
 811 puts "agent: $agent"
 812
 813 proc bgerror {m} {
 814     global errorInfo
 815     puts "BGERROR $m"
 816     puts $errorInfo
 817 }
 818
 819 set robotsRunning 0
 820 set robotSeq 0
 821 set workdir [pwd]
 822 set idleTime 60000
 823 set acceptLanguage {}
 824
 825 set i 0
 826 set l [llength $argv]
 827
 828 # For testing only
 829 if {0} {
 830     set url "http://www.sportsfiskeren.dk/sportsfiskeren/corner/index.htm"
 831     set href "../../data/../../data2/newsovs.asp?Mode=5"
 832
 833     set URL($url,path) /sportsfiskeren/corner/index.htm
 834     set URL($url,hostport) www.sportsfiskeren.dk
 835     RobotHref $url href host path
 836     exit 0
 837 }
 838
 839 if {$l < 2} {
 840     puts {tclrobot: usage [-j jobs] [-i idle] [-c count] [-d domain] [url ..]}
 841     puts " Example: -c 3 -d '*.dk' http://www.indexdata.dk/"
 842     exit 1
 843 }
 844
 845 while  {$i < $l} {
 846     set arg [lindex $argv $i]
 847     switch -glob -- $arg {
 848         -j* {
 849             set robotsMax [string range $arg 2 end]
 850             if {![string length $robotsMax]} {
 851                 set robotsMax [lindex $argv [incr i]]
 852             }
 853         }
 854         -c* {
 855             set maxDistance [string range $arg 2 end]
 856             if {![string length $maxDistance]} {
 857                 set maxDistance [lindex $argv [incr i]]
 858             }
 859         }
 860         -d* {
 861             set dom [string range $arg 2 end]
 862             if {![string length $dom]} {
 863                 set dom [lindex $argv [incr i]]
 864             }
 865             lappend domains $dom
 866         }
 867         -i* {
 868             set idleTime [string range $arg 2 end]
 869             if {![string length $idleTime]} {
 870                 set idleTime [lindex $argv [incr i]]
 871             }
 872         }
 873         -l* {
 874             set acceptLanguage [string range $arg 2 end]
 875             if {![string length $acceptLanguage]} {
 876                 set acceptLanguage [lindex $argv [incr i]]
 877             }
 878         }
 879         default {
 880             set href $arg
 881             if {[RobotHref http://www.indexdata.dk/ href host path]} {
 882                 if {![RobotFileExist visited $host $path]} {
 883                     set outf [RobotFileOpen unvisited $host $path]
 884                     RobotWriteRecord $outf href 0
 885                     RobotFileClose $outf
 886                 }
 887             }
 888         }
 889     }
 890     incr i
 891 }
 892
 893 if {![info exist domains]} {
 894     set domains {*}
 895 }
 896 if {![info exist maxDistance]} {
 897     set maxDistance 50
 898 }
 899 if {![info exist robotsMax]} {
 900     set robotsMax 5
 901 }
 902
 903 puts "domains=$domains"
 904 puts "max distance=$maxDistance"
 905 puts "max jobs=$robotsMax"
 906
 907 RobotStart
 908
 909 while {$robotsRunning} {
 910     vwait robotsRunning
 911 }