robot.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: robot.tcl,v 1.27 2001/11/09 13:26:50 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 "Round robin"
  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 debuglevel
 258     upvar $hrefx href
 259     upvar $hostx host
 260     upvar $pathx path
 261
 262     if {$debuglevel > 1} {
 263         puts "Ref input url = $url href=$href"
 264     }
 265
 266     if {[string first { } $href] >= 0} {
 267         return 0
 268     }
 269     if {[string length $href] > 256} {
 270         return 0
 271     }
 272     if {[string first {?} $href] >= 0} {
 273         return 0
 274     }
 275     if {[string first {?} $url] >= 0 && [string first {?} $href] >= 0} {
 276         return 0
 277     }
 278     # get method (if any)
 279     if {![regexp {^([^/:]+):(.*)} $href x method hpath]} {
 280         set hpath $href
 281         set method http
 282     } else {
 283         if {[string compare $method http]} {
 284             return 0
 285         }
 286     }
 287     # get host (if any)
 288     if {[regexp {^//([^/]+)([^\#]*)} $hpath x host surl]} {
 289         if {![string length $surl]} {
 290             set surl /
 291         }
 292         if {[info exist domains]} {
 293             set ok 0
 294             foreach domain $domains {
 295                 if {[string match $domain $host]} {
 296                     set ok 1
 297                     break
 298                  }
 299             }
 300             if {!$ok} {
 301                 return 0
 302             }
 303         }
 304     } else {
 305         regexp {^([^\#]*)} $hpath x surl
 306         set host $URL($url,hostport)
 307     }
 308     if {![string length $surl]} {
 309         return 0
 310     }
 311     if {[string first / $surl]} {
 312         # relative path
 313         regexp {^([^\#?]*)} $URL($url,path) x dpart
 314         set l [string last / $dpart]
 315         if {[expr $l >= 0]} {
 316             set surl [string range $dpart 0 $l]$surl
 317         } else {
 318             set surl $dpart/$surl
 319         }
 320     }
 321     set surllist [split $surl /]
 322     catch {unset path}
 323     set pathl 0
 324     foreach c $surllist {
 325         switch -- $c {
 326             .. {
 327                 if {$pathl > 1} {
 328                     incr pathl -2
 329                     set path [lrange $path 0 $pathl]
 330                     incr pathl
 331                 }
 332             }
 333             . {
 334
 335             }
 336             default {
 337                 incr pathl
 338                 lappend path $c
 339             }
 340         }
 341     }
 342     if {$debuglevel > 4} {
 343         puts "pathl=$pathl output path=$path"
 344     }
 345     set path [join $path /]
 346     if {![string length $path]} {
 347         set path /
 348     }
 349     regsub -all {~} $path {%7E} path
 350     set href "$method://$host$path"
 351
 352     if {$debuglevel > 1} {
 353         puts "Ref result = $href"
 354     }
 355     return [checkrule url $href]
 356 }
 357
 358 proc RobotError {url code} {
 359     global URL
 360
 361     puts "Bad URL $url (code $code)"
 362     set fromurl {}
 363     set distance -1
 364     if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} {
 365         set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r]
 366         RobotReadRecord $inf fromurl distance
 367         RobotFileClose $inf
 368     }
 369     RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path)
 370     if {![RobotFileExist bad $URL($url,hostport) $URL($url,path)]} {
 371         set outf [RobotFileOpen bad $URL($url,hostport) $URL($url,path)]
 372         RobotWriteRecord $outf $fromurl $distance
 373         RobotFileClose $outf
 374     }
 375 }
 376
 377 proc RobotRedirect {url tourl code} {
 378     global URL
 379
 380     puts "Redirecting from $url to $tourl"
 381
 382     set distance {}
 383     set fromurl {}
 384     if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} {
 385         set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r]
 386         RobotReadRecord $inf fromurl distance
 387         RobotFileClose $inf
 388     }
 389     if {![RobotFileExist bad $URL($url,hostport) $URL($url,path)]} {
 390         set outf [RobotFileOpen bad $URL($url,hostport) $URL($url,path)]
 391         RobotWriteRecord $outf $fromurl $distance
 392         RobotFileClose $outf
 393     }
 394     if {[RobotHref $url tourl host path]} {
 395         if {![RobotFileExist visited $host $path]} {
 396             if {![RobotFileExist unvisited $host $path]} {
 397                 set outf [RobotFileOpen unvisited $host $path]
 398                 RobotWriteRecord $outf $fromurl $distance
 399                 RobotFileClose $outf
 400             }
 401         } else {
 402             set olddistance {}
 403             set inf [RobotFileOpen visited $host $path r]
 404             RobotReadRecord $inf oldurl olddistance
 405             RobotFileClose $inf
 406             if {[string length $olddistance] == 0} {
 407                 set olddistance 1000
 408             }
 409             if {[string length $distance] == 0} {
 410                 set distance 1000
 411             }
 412             puts "distance=$distance olddistance=$olddistance"
 413             if {[expr $distance < $olddistance]} {
 414                 set outf [RobotFileOpen unvisited $host $path]
 415                 RobotWriteRecord $outf $tourl $distance
 416                 RobotFileClose $outf
 417             }
 418         }
 419     }
 420     if {[catch {RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path)}]} {
 421         puts "unlink failed"
 422         exit 1
 423     }
 424 }
 425
 426 proc RobotTextHtml {url out} {
 427     global URL maxdistance
 428
 429     set distance 0
 430     if {$maxdistance < 1000 && [info exists URL($url,dist)]} {
 431         set distance [expr $URL($url,dist) + 1]
 432     }
 433     htmlSwitch $URL($url,buf) \
 434         title {
 435             puts $out "<title>$body</title>"
 436         } -nonest meta {
 437             puts -nonewline $out "<meta"
 438             foreach a [array names parm] {
 439                 puts -nonewline $out " $a"
 440                 puts -nonewline $out {="}
 441                 puts -nonewline $out $parm($a)
 442                 puts -nonewline $out {"}
 443             }
 444             puts $out {></meta>}
 445         } body {
 446             regsub -all {<!--[^-]*->} $body { } abody
 447             regsub -all -nocase {<script[^<]*</script>} $abody {} bbody
 448             regsub -all {<[^\>]+>} $bbody {} nbody
 449             puts $out "<documentcontent>"
 450             puts $out $nbody
 451             puts $out "</documentcontent>"
 452         } -nonest a {
 453             if {![info exists parm(href)]} {
 454                 puts "no href"
 455                 continue
 456             }
 457             if {[expr $distance <= $maxdistance]} {
 458                 set href [string trim $parm(href)]
 459                 if {![RobotHref $url href host path]} continue
 460
 461                 puts $out "<cr>"
 462                 puts $out "<identifier>$href</identifier>"
 463                 puts $out "<description>$body</description>"
 464                 puts $out "</cr>"
 465
 466                 if {![RobotFileExist visited $host $path]} {
 467                     set olddistance 1000
 468                     if {![RobotFileExist bad $host $path]} {
 469                         if {[RobotFileExist unvisited $host $path]} {
 470                             set inf [RobotFileOpen unvisited $host $path r]
 471                             RobotReadRecord $inf oldurl olddistance
 472                             RobotFileClose $inf
 473                         }
 474                     } else {
 475                         set olddistance 0
 476                     }
 477                     if {[string length $olddistance] == 0} {
 478                         set olddistance 1000
 479                     }
 480                     if {[expr $distance < $olddistance]} {
 481                         set outf [RobotFileOpen unvisited $host $path]
 482                         RobotWriteRecord $outf $url $distance
 483                         RobotFileClose $outf
 484                     }
 485                 } elseif {[string compare $href $url]} {
 486                     set inf [RobotFileOpen visited $host $path r]
 487                     RobotReadRecord $inf xurl olddistance
 488                     close $inf
 489                     if {[string length $olddistance] == 0} {
 490                         set olddistance 1000
 491                     }
 492                     if {[expr $distance < $olddistance]} {
 493                         puts "OK remarking url=$url href=$href"
 494                         puts "olddistance = $olddistance"
 495                         puts "newdistance = $distance"
 496                         set outf [RobotFileOpen unvisited $host $path]
 497                         RobotWriteRecord $outf $url $distance
 498                         RobotFileClose $outf
 499                     }
 500                 }
 501             }
 502         } -nonest area {
 503             if {![info exists parm(href)]} {
 504                 puts "no href"
 505                 continue
 506             }
 507             if {[expr $distance <= $maxdistance]} {
 508                 set href [string trim $parm(href)]
 509                 if {![RobotHref $url href host path]} continue
 510
 511                 puts $out "<cr>"
 512                 puts $out "<identifier>$href</identifier>"
 513                 puts $out "<description></description>"
 514                 puts $out "</cr>"
 515
 516                 if {![RobotFileExist visited $host $path]} {
 517                     set olddistance 1000
 518                     if {![RobotFileExist bad $host $path]} {
 519                         if {[RobotFileExist unvisited $host $path]} {
 520                             set inf [RobotFileOpen unvisited $host $path r]
 521                             RobotReadRecord $inf oldurl olddistance
 522                             RobotFileClose $inf
 523                         }
 524                     } else {
 525                         set olddistance 0
 526                     }
 527                     if {[string length $olddistance] == 0} {
 528                         set olddistance 1000
 529                     }
 530                     if {[expr $distance < $olddistance]} {
 531                         set outf [RobotFileOpen unvisited $host $path]
 532                         RobotWriteRecord $outf $url $distance
 533                         RobotFileClose $outf
 534                     }
 535                 } elseif {[string compare $href $url]} {
 536                     set inf [RobotFileOpen visited $host $path r]
 537                     RobotReadRecord $inf xurl olddistance
 538                     close $inf
 539                     if {[string length $olddistance] == 0} {
 540                         set olddistance 1000
 541                     }
 542                     if {[expr $distance < $olddistance]} {
 543                         puts "OK remarking url=$url href=$href"
 544                         puts "olddistance = $olddistance"
 545                         puts "newdistance = $distance"
 546                         set outf [RobotFileOpen unvisited $host $path]
 547                         RobotWriteRecord $outf $url $distance
 548                         RobotFileClose $outf
 549                     }
 550                 }
 551             }
 552         } -nonest frame {
 553             if {![info exists parm(src)]} {
 554                 puts "no src"
 555                 continue
 556             }
 557             if {[expr $distance <= $maxdistance]} {
 558                 set href [string trim $parm(src)]
 559                 if {![RobotHref $url href host path]} continue
 560
 561                 puts $out "<cr>"
 562                 puts $out "<identifier>$href</identifier>"
 563                 puts $out "<description></description>"
 564                 puts $out "</cr>"
 565
 566                 if {![RobotFileExist visited $host $path]} {
 567                     set olddistance 1000
 568                     if {![RobotFileExist bad $host $path]} {
 569                         if {[RobotFileExist unvisited $host $path]} {
 570                             set inf [RobotFileOpen unvisited $host $path r]
 571                             RobotReadRecord $inf oldurl olddistance
 572                             RobotFileClose $inf
 573                         }
 574                     } else {
 575                         set olddistance 0
 576                     }
 577                     if {[string length $olddistance] == 0} {
 578                         set olddistance 1000
 579                     }
 580                     if {[expr $distance < $olddistance]} {
 581                         set outf [RobotFileOpen unvisited $host $path]
 582                         RobotWriteRecord $outf $url $distance
 583                         RobotFileClose $outf
 584                     }
 585                 } elseif {[string compare $href $url]} {
 586                     set inf [RobotFileOpen visited $host $path r]
 587                     RobotReadRecord $inf xurl olddistance
 588                     close $inf
 589                     if {[string length $olddistance] == 0} {
 590                         set olddistance 1000
 591                     }
 592                     if {[expr $distance < $olddistance]} {
 593                         puts "OK remarking url=$url href=$href"
 594                         puts "olddistance = $olddistance"
 595                         puts "newdistance = $distance"
 596                         set outf [RobotFileOpen unvisited $host $path]
 597                         RobotWriteRecord $outf $url $distance
 598                         RobotFileClose $outf
 599                     }
 600                 }
 601             }
 602         }
 603 }
 604
 605 proc RobotsTxt {url} {
 606     global agent URL
 607
 608     RobotsTxt0 URL(URL($url,hostport),robots) $URL($url,buf)
 609 }
 610
 611 proc RobotsTxt0 {v buf} {
 612     global URL agent
 613     set section 0
 614     foreach l [split $buf \n] {
 615         if {[regexp {([-A-Za-z]+):[ ]*([^\# ]+)} $l match cmd arg]} {
 616             puts "cmd=$cmd arg=$arg"
 617             switch -- [string tolower $cmd] {
 618                 user-agent {
 619                     if {$section} break
 620                     set pat [string tolower $arg]*
 621                     set section [string match $pat $agent]
 622                 }
 623                 disallow {
 624                     if {$section} {
 625                         puts "rule [list 0 $arg]"
 626                         lappend $v [list 0 $arg]
 627                     }
 628                 }
 629                 allow {
 630                     if {$section} {
 631                         puts "rule [list 1 $arg]"
 632                         lappend $v [list 1 $arg]
 633                     }
 634                 }
 635             }
 636         }
 637     }
 638 }
 639
 640 proc RobotTextPlain {url out} {
 641     global URL
 642
 643     puts $out "<documentcontent>"
 644     regsub -all {<} $URL($url,buf) {\&lt;} content
 645     puts $out $content
 646     puts $out "</documentcontent>"
 647
 648     if {![string compare $URL($url,path) /robots.txt]} {
 649         RobotsTxt $url
 650     }
 651 }
 652
 653 proc RobotWriteMetadata {url out} {
 654     global URL domains
 655
 656     puts $out "<zmbot>"
 657
 658     set distance 1000
 659     if {[RobotFileExist unvisited $URL($url,hostport) $URL($url,path)]} {
 660         set inf [RobotFileOpen unvisited $URL($url,hostport) $URL($url,path) r]
 661         RobotReadRecord $inf fromurl distance
 662         RobotFileClose $inf
 663     }
 664     set URL($url,dist) $distance
 665     puts $out "<distance>"
 666     puts $out "  $distance"
 667     puts $out "</distance>"
 668     headSave $url $out
 669     puts "Parsing $url distance=$distance"
 670     switch $URL($url,head,content-type) {
 671         text/html {
 672             if {[string length $distance]} {
 673                 RobotTextHtml $url $out
 674             }
 675         }
 676         text/plain {
 677             RobotTextPlain $url $out
 678         }
 679         application/pdf {
 680             set pdff [open test.pdf w]
 681             puts -nonewline $pdff $URL($url,buf)
 682             close $pdff
 683         }
 684     }
 685     puts $out "</zmbot>"
 686 }
 687
 688 proc Robot200 {url} {
 689     global URL domains
 690
 691     set out [RobotFileOpen raw $URL($url,hostport) $URL($url,path)]
 692     puts -nonewline $out $URL($url,buf)
 693     RobotFileClose $out
 694
 695     if {![checkrule mime $URL($url,head,content-type)]} {
 696         RobotError $url mimedeny
 697         return
 698     }
 699     set out [RobotFileOpen visited $URL($url,hostport) $URL($url,path)]
 700     RobotWriteMetadata $url $out
 701     RobotFileClose $out
 702
 703     RobotFileUnlink unvisited $URL($url,hostport) $URL($url,path)
 704 }
 705
 706 proc RobotReadContent {url sock binary} {
 707     global URL
 708
 709     set buffer [read $sock 16384]
 710     set readCount [string length $buffer]
 711
 712     if {$readCount <= 0} {
 713         Robot200 $url
 714         RobotRestart $url $sock
 715     } elseif {!$binary && [string first \0 $buffer] >= 0} {
 716         Robot200 $url
 717         RobotRestart $url $sock
 718     } else {
 719         # puts "Got $readCount bytes"
 720         set URL($url,buf) $URL($url,buf)$buffer
 721     }
 722 }
 723
 724 proc RobotReadHeader {url sock} {
 725     global URL debuglevel
 726
 727     if {$debuglevel > 1} {
 728         puts "HTTP head $url"
 729     }
 730     if {[catch {set buffer [read $sock 2148]}]} {
 731         RobotError $url 404
 732         RobotRestart $url $sock
 733     }
 734     set readCount [string length $buffer]
 735
 736     if {$readCount <= 0} {
 737         RobotError $url 404
 738         RobotRestart $url $sock
 739     } else {
 740         # puts "Got $readCount bytes"
 741         set URL($url,buf) $URL($url,buf)$buffer
 742
 743         set n [string first \r\n\r\n $URL($url,buf)]
 744         if {$n > 1} {
 745             set code 0
 746             set version {}
 747             set headbuf [string range $URL($url,buf) 0 $n]
 748             incr n 4
 749             set URL($url,buf) [string range $URL($url,buf) $n end]
 750
 751             regexp {^HTTP/([0-9.]+)[ ]+([0-9]+)} $headbuf x version code
 752             set lines [split $headbuf \n]
 753             foreach line $lines {
 754                 if {[regexp {^([^:]+):[ ]+([^;]*)} $line x name value]} {
 755                     set URL($url,head,[string tolower $name]) [string trim $value]
 756                 }
 757             }
 758             puts "HTTP CODE $code"
 759             set URL($url,state) skip
 760             switch $code {
 761                 301 {
 762                     RobotRedirect $url $URL($url,head,location) 301
 763                     RobotRestart $url $sock
 764                 }
 765                 302 {
 766                     RobotRedirect $url $URL($url,head,location) 302
 767                     RobotRestart $url $sock
 768                 }
 769                 200 {
 770                     if {![info exists URL($url,head,content-type)]} {
 771                         set URL($url,head,content-type) {}
 772                     }
 773                     set binary 0
 774                     switch $URL($url,head,content-type) {
 775                         application/pdf {
 776                             set binary 1
 777                         }
 778                     }
 779                     fileevent $sock readable [list RobotReadContent $url $sock $binary]
 780                 }
 781                 default {
 782                     RobotError $url $code
 783                     RobotRestart $url $sock
 784                 }
 785             }
 786         }
 787     }
 788 }
 789
 790 proc RobotSockCancel {url sock} {
 791
 792     puts "RobotSockCancel sock=$sock url=$url"
 793     RobotError $url 401
 794     RobotRestart $url $sock
 795 }
 796
 797 proc RobotConnect {url sock} {
 798     global URL agent acceptLanguage
 799
 800     fconfigure $sock -translation {lf crlf} -blocking 0
 801     fileevent $sock readable [list RobotReadHeader $url $sock]
 802     puts $sock "GET $URL($url,path) HTTP/1.0"
 803     puts $sock "Host: $URL($url,host)"
 804     puts $sock "User-Agent: $agent"
 805     if {[string length $acceptLanguage]} {
 806         puts $sock "Accept-Language: $acceptLanguage"
 807     }
 808     puts $sock ""
 809     flush $sock
 810     set URL($sock,cancel) [after 30000 [list RobotSockCancel $url $sock]]
 811 }
 812
 813 proc RobotNop {} {
 814
 815 }
 816
 817 proc RobotGetUrl {url phost} {
 818     global URL robotsRunning
 819     flush stdout
 820     puts "Retrieve $robotsRunning url=$url"
 821     if {![regexp {([^:]+)://([^/]+)(.*)} $url x method hostport path]} {
 822         return -1
 823     }
 824     if {![regexp {([^:]+):([0-9]+)} $hostport x host port]} {
 825         set port 80
 826         set host $hostport
 827     }
 828     set URL($url,method) $method
 829     set URL($url,host) $host
 830     set URL($url,hostport) $hostport
 831     set URL($url,path) $path
 832     set URL($url,state) head
 833     set URL($url,buf) {}
 834
 835     if {[string compare $path /robots.txt]} {
 836         set ok 1
 837         if {![info exists URL($hostport,robots)]} {
 838             puts "READING robots.txt for host $hostport"
 839             if {[RobotFileExist visited $hostport /robots.txt]} {
 840                 set inf [RobotFileOpen visited $hostport /robots.txt r]
 841                 set buf [read $inf 32768]
 842                 close $inf
 843             } else {
 844                 set buf "User-agent: *\nAllow: /\n"
 845             }
 846             RobotsTxt0 URL($hostport,robots) $buf
 847         }
 848         if {[info exists URL($hostport,robots)]} {
 849             foreach l $URL($hostport,robots) {
 850                 if {[string first [lindex $l 1] $path] == 0} {
 851                     set ok [lindex $l 0]
 852                     break
 853                 }
 854             }
 855         }
 856         if {!$ok} {
 857             puts "skipped due to robots.txt"
 858             return -1
 859         }
 860     }
 861     if [catch {set sock [socket -async $host $port]}] {
 862         return -1
 863     }
 864     RobotConnect $url $sock
 865
 866     return 0
 867 }
 868
 869 if {![llength [info commands htmlSwitch]]} {
 870     set e [info sharedlibextension]
 871     if {[catch {load ./tclrobot$e}]} {
 872         load tclrobot$e
 873     }
 874 }
 875
 876 set agent "zmbot/0.1"
 877 if {![catch {set os [exec uname -s -r]}]} {
 878     set agent "$agent ($os)"
 879 }
 880
 881 puts "agent: $agent"
 882
 883 proc bgerror {m} {
 884     global errorInfo
 885     puts "BGERROR $m"
 886     puts $errorInfo
 887 }
 888
 889 set robotsRunning 0
 890 set robotSeq 0
 891 set workdir [pwd]
 892 set idletime 60000
 893 set acceptLanguage {}
 894 set debuglevel 0
 895
 896
 897 # Rules: allow, deny, url
 898
 899 proc checkrule {type this} {
 900     global alrules
 901     global debuglevel
 902
 903     if {$debuglevel > 3} {
 904         puts "CHECKRULE $type $this"
 905     }
 906     if {[info exist alrules]} {
 907         foreach l $alrules {
 908             if {$debuglevel > 3} {
 909                 puts "consider $l"
 910             }
 911             # consider type
 912             if {[lindex $l 1] != $type} continue
 913             # consider mask (! negates)
 914             set masks [lindex $l 2]
 915             set ok 0
 916             foreach mask $masks {
 917                 if {$debuglevel > 4} {
 918                     puts "consider single mask $mask"
 919                 }
 920                 if {[string index $mask 0] == "!"} {
 921                     set mask [string range $mask 1 end]
 922                     if {[string match $mask $this]}  continue
 923                 } else {
 924                     if {![string match $mask $this]} continue
 925                 }
 926                 set ok 1
 927             }
 928             if {$debuglevel > 4} {
 929                 puts "ok = $ok"
 930             }
 931             if {!$ok} continue
 932             # OK, we have a match
 933             if {[lindex $l 0] == "allow"} {
 934                 if {$debuglevel > 3} {
 935                     puts "CHECKRULE MATCH OK"
 936                 }
 937                 return 1
 938             } else {
 939                 if {$debuglevel > 3} {
 940                     puts "CHECKFULE MATCH FAIL"
 941                 }
 942                 return 0
 943             }
 944         }
 945     }
 946     if {$debuglevel > 3} {
 947         puts "CHECKRULE MATCH OK"
 948     }
 949     return 1
 950 }
 951
 952
 953 proc url {href} {
 954     global debuglevel
 955
 956     if {[RobotHref http://www.indexdata.dk/ href host path]} {
 957         if {![RobotFileExist visited $host $path]} {
 958             set outf [RobotFileOpen unvisited $host $path]
 959             RobotWriteRecord $outf href 0
 960             RobotFileClose $outf
 961         }
 962     }
 963 }
 964
 965 proc deny {type stuff} {
 966     global alrules
 967
 968     lappend alrules [list deny $type $stuff]
 969 }
 970
 971 proc allow {type stuff} {
 972     global alrules
 973
 974     lappend alrules [list allow $type $stuff]
 975 }
 976
 977 proc debug {level} {
 978     global debuglevel
 979
 980     set debuglevel $level
 981 }
 982
 983 # Parse options
 984
 985 set i 0
 986 set l [llength $argv]
 987
 988 if {$l < 2} {
 989     puts {tclrobot: usage:}
 990     puts {tclrobot [-j jobs] [-i idle] [-c count] [-d domain] [-r rules] [url ..]}
 991     puts " Example: -c 3 -d '*.dk' http://www.indexdata.dk/"
 992
 993     exit 1
 994 }
 995 while  {$i < $l} {
 996     set arg [lindex $argv $i]
 997     switch -glob -- $arg {
 998         -j* {
 999             set robotsMax [string range $arg 2 end]
1000             if {![string length $robotsMax]} {
1001                 set robotsMax [lindex $argv [incr i]]
1002             }
1003         }
1004         -c* {
1005             set maxdistance [string range $arg 2 end]
1006             if {![string length $maxdistance]} {
1007                 set maxdistance [lindex $argv [incr i]]
1008             }
1009         }
1010         -d* {
1011             set dom [string range $arg 2 end]
1012             if {![string length $dom]} {
1013                 set dom [lindex $argv [incr i]]
1014             }
1015             lappend domains $dom
1016         }
1017         -i* {
1018             set idletime [string range $arg 2 end]
1019             if {![string length $idletime]} {
1020                 set idletime [lindex $argv [incr i]]
1021             }
1022         }
1023         -l* {
1024             set acceptLanguage [string range $arg 2 end]
1025             if {![string length $acceptLanguage]} {
1026                 set acceptLanguage [lindex $argv [incr i]]
1027             }
1028         }
1029         -r* {
1030             set rfile [string range $arg 2 end]
1031             if {![string length $rfile]} {
1032                 set rfile [lindex $argv [incr i]]
1033             }
1034             source $rfile
1035         }
1036         default {
1037             set href $arg
1038             if {[RobotHref http://www.indexdata.dk/ href host path]} {
1039                 if {![RobotFileExist visited $host $path]} {
1040                     set outf [RobotFileOpen unvisited $host $path]
1041                     RobotWriteRecord $outf href 0
1042                     RobotFileClose $outf
1043                 }
1044             }
1045         }
1046     }
1047     incr i
1048 }
1049
1050 if {![info exist domains]} {
1051     set domains {*}
1052 }
1053 if {![info exist maxdistance]} {
1054     set maxdistance 50
1055 }
1056 if {![info exist robotsMax]} {
1057     set robotsMax 5
1058 }
1059
1060 puts "domains=$domains"
1061 puts "max distance=$maxdistance"
1062 puts "max jobs=$robotsMax"
1063
1064 RobotStart
1065
1066
1067 while {$robotsRunning} {
1068     vwait robotsRunning
1069 }