tkl-web-harvester

   1 #!/usr/bin/tclsh
   2 # $Id: tkl-web-harvester,v 1.1 2003/08/14 08:02:10 marc Exp $
   3 #
   4 set loghandle stdout
   5 set robotsRunning 0
   6 set workdir [pwd]
   7 set idletime 15000
   8 set acceptLanguage {}
   9 set debuglevel 1
  10 set libdir ""
  11
  12
  13 proc logmsg {msg} {
  14     global loghandle
  15
  16     puts $loghandle $msg
  17     flush $loghandle
  18 }
  19
  20 #proc dbgmsg {level msg} {
  21 #    global debuglevel
  22 #    if {[expr $debuglevel >= $level]} {
  23 #        logmsg $msg
  24 #    }
  25 #}
  26 proc dbgmsg {msg} {
  27     global debuglevel
  28     if {[expr $debuglevel >= 0]} {
  29         logmsg $msg
  30     }
  31 }
  32 # dbgmsg is always called with just one string!
  33
  34
  35 proc fnameEncode {fname} {
  36     regsub -all {&} $fname {%38} fname
  37     regsub -all {<} $fname {%3C} fname
  38     regsub -all {>} $fname {%3E} fname
  39     regsub -all {\?} $fname {%3F} fname
  40     regsub -all {\*} $fname {%2A} fname
  41     return $fname
  42 }
  43
  44 proc fnameDecode {fname} {
  45     regsub -all {%38} $fname {&} fname
  46     regsub -all {%3C} $fname {<} fname
  47     regsub -all {%3E} $fname {>} fname
  48     regsub -all {%3F} $fname {?} fname
  49     regsub -all {%2A} $fname {*} fname
  50     return $fname
  51 }
  52
  53 proc RobotFileNext1 {area lead} {
  54     # dbgmsg "RobotFileNext1 area=$area lead=$lead"
  55     if {[catch {set ns [glob ${area}/*]}]} {
  56         return {}
  57     }
  58     foreach n $ns {
  59         if {[file isfile $n]} {
  60             set off [string last / $n]
  61             # skip /
  62             incr off
  63             set end [string length $n]
  64             # skip _.tkl
  65             incr end -6
  66             return $lead/[string range $n $off $end]
  67         }
  68     }
  69     foreach n $ns {
  70         if {[file isdirectory $n]} {
  71             set off [string last / $n]
  72             # skip /
  73             incr off
  74             set sb [RobotFileNext1 $n $lead/[string range $n $off end]]
  75             if {[string length $sb]} {
  76                 return $sb
  77             }
  78         }
  79     }
  80     return {}
  81 }
  82
  83 proc RobotWriteRecord {outf fromurl distance} {
  84     puts $outf {<?xml version="1.0" encoding="ISO-8859-1" standalone="yes"?>}
  85     puts $outf "<zmbot>"
  86     puts $outf "<distance>"
  87     puts $outf $distance
  88     puts $outf "</distance>"
  89     puts $outf "<fromurl>"
  90     puts $outf $fromurl
  91     puts $outf "</fromurl>"
  92     puts $outf "</zmbot>"
  93 }
  94
  95 proc RobotReadRecord {inf fromurlx distancex} {
  96     upvar $fromurlx fromurl
  97     upvar $distancex distance
  98     gets $inf
  99     gets $inf
 100     gets $inf
 101     set distance [string trim [gets $inf]]
 102     # dbgmsg "got distance = $distance"
 103     gets $inf
 104     gets $inf
 105     set fromurl [string trim [gets $inf]]
 106 }
 107
 108 proc RobotFileNext {task area} {
 109     global control
 110     global idletime ns
 111     global status
 112
 113     # dbgmsg "RobotFileNext seq=$control($task,seq)"
 114     if {$control($task,seq) < 0} {
 115         return {}
 116     }
 117     set target $control($task,target)
 118     if {$control($task,seq) == 0} {
 119         if {[catch {set ns($task) [glob $target/$area/*]}]} {
 120             puts "----------- DONE-------- target=$target"
 121             return done
 122         }
 123     }
 124     # dbgmsg "ns=$ns($task)"
 125     set off [string length $target/$area]
 126     incr off
 127     set n [lindex $ns($task) $control($task,seq)]
 128     # dbgmsg "n=$n"
 129     if {![string length $n]} {
 130         set control($task,seq) -1
 131         set statusfile [open $target/status w]
 132         puts $statusfile "$status($task,unvisited) $status($task,bad) $status($task,visited)"
 133         close $statusfile
 134         return wait
 135     }
 136     incr control($task,seq)
 137     if {[file isfile $n/robots.txt_.tkl]} {
 138         # dbgmsg "ok returning http://[string range $n $off end]/robots.txt"
 139         return [fnameDecode http://[string range $n $off end]/robots.txt]
 140     } elseif {[file isdirectory $n]} {
 141         set sb [RobotFileNext1 $n http://[string range $n $off end]]
 142         if {[string length $sb]} {
 143             return [fnameDecode $sb]
 144         }
 145     }
 146     dbgmsg "no more work at end of RobotFileNext n=$n"
 147     dbgmsg "ns=$ns($task)"
 148     return {}
 149 }
 150
 151
 152 proc RobotFileExist {task area host path} {
 153     global debuglevel control
 154
 155     if {$debuglevel > 3} {
 156         dbgmsg "RobotFileExist begin area=$area host=$host path=$path"
 157     }
 158     set target $control($task,target)
 159     return [file exists [fnameEncode $target/$area/$host${path}_.tkl]]
 160 }
 161
 162 proc RobotFileUnlink {task area host path} {
 163     global status control
 164
 165     set target $control($task,target)
 166     # dbgmsg "RobotFileUnlink begin"
 167     # dbgmsg "area=$area host=$host path=$path"
 168     set npath [fnameEncode $target/$area/$host${path}_.tkl]
 169     # dbgmsg "npath=$npath"
 170     set comp [split $npath /]
 171     if {[catch {exec rm $npath}]} return
 172
 173     set l [llength $comp]
 174     incr l -2
 175     incr status($task,$area) -1
 176     for {set i $l} {$i > 0} {incr i -1} {
 177         set path [join [lrange $comp 0 $i] /]
 178         if {![catch {glob $path/*}]} return
 179         exec rmdir $path
 180     }
 181     # dbgmsg "RobotFileUnlink end"
 182 }
 183
 184 proc RobotFileClose {out} {
 185     if [string compare $out stdout] {
 186         close $out
 187     }
 188 }
 189
 190 proc RobotFileOpen {task area host path {mode w}} {
 191     set orgPwd [pwd]
 192     global workdir status debuglevel control
 193
 194     # dbgmsg "RobotFileOpen task=$task path=$path"
 195
 196     set target $control($task,target)
 197     set path [fnameEncode $path]
 198
 199     if {![info exists workdir]} {
 200         return stdout
 201     }
 202     if {$debuglevel > 3} {
 203         dbgmsg "RobotFileOpen orgPwd=$orgPwd area=$area host=$host path=$path mode=$mode"
 204     }
 205     if {[string compare $orgPwd $workdir]} {
 206         dbgmsg "ooops. RobotFileOpen failed"
 207         dbgmsg "workdir = $workdir"
 208         dbgmsg "pwd = $orgPwd"
 209         exit 1
 210     }
 211
 212     set comp [split $target/$area/$host /]
 213     set len [llength $comp]
 214     incr len -1
 215
 216     # dbgmsg "1 comp=$comp"
 217
 218     for {set i 0} {$i <= $len} {incr i} {
 219         set d [lindex $comp $i]
 220         if {[string length $d] == 0} {
 221             cd /
 222         } elseif {[catch {cd $d}]} {
 223             exec mkdir $d
 224             cd ./$d
 225             if {![string compare $area unvisited] && $i == $len && $mode == "w"} {
 226                 if {[string compare $path /robots.txt]} {
 227                     set out [open robots.txt_.tkl w]
 228                     dbgmsg "creating robots.txt in $d"
 229                     close $out
 230                     incr status($task,unvisited)
 231                 }
 232             }
 233         }
 234     }
 235
 236     set comp [split $path /]
 237     set len [llength $comp]
 238     incr len -1
 239
 240     # dbgmsg "2 path=$path comp=$comp"
 241
 242     for {set i 0} {$i < $len} {incr i} {
 243         set d [lindex $comp $i]
 244         if {[string length $d] > 0} {
 245             if {[catch {cd $d}]} {
 246                 exec mkdir $d
 247                 cd ./$d
 248             }
 249         }
 250     }
 251     set d [lindex $comp $len]
 252     set out [open ${d}_.tkl $mode]
 253     if {$mode == "w"} {
 254         incr status($task,$area)
 255     }
 256     cd $orgPwd
 257     return $out
 258 }
 259
 260 proc RobotStartJob {root task} {
 261     global control
 262
 263     set fname "$root$task"
 264     set f [open $fname r]
 265     set xml [read $f]
 266     dbgmsg "Reading $fname"
 267     close $f
 268     # task type must be 2
 269     if {![regexp {<tasktype>([^<]*)</tasktype>} $xml x tasktype]} {
 270         return
 271     }
 272     set tasktype [string trim $tasktype]
 273     if {![string match 2 $tasktype]} {
 274         return
 275     }
 276     # status must not be finished or error
 277     if {![regexp {<status>([^<]*)</status>} $xml x status]} {
 278         return
 279     }
 280     if {$status == "finished"} {
 281         dbgmsg "already finished"
 282         return
 283     }
 284     if {$status == "error"} {
 285         dbgmsg "already finished due to error"
 286         return
 287     }
 288     # ignore if task has already been processed
 289     dbgmsg "status = $status"
 290     if {![CreateTask $task]} {
 291         return
 292     }
 293     set control($task,taskfname) $fname
 294     dbgmsg "Reading $fname stage 2"
 295     htmlSwitch $xml \
 296         url {
 297             lappend starturls $body
 298         } filter {
 299             set type $parm(type)
 300             set action $parm(action)
 301             if {$type == "domain"} {
 302                 $action url http://$body/*
 303             }
 304             if {$type == "url"} {
 305                 $action url $body
 306             }
 307             if {$type == "mime"} {
 308                 $action mime $body
 309             }
 310         } target {
 311             set ex [file rootname [file tail $task]]
 312             #set control($task,target) "$root$body/$ex"
 313             set control($task,target) "$control(tmpdir)/$ex"
 314             set control($task,output) "$root$body"
 315         } distance {
 316             set control($task,distance) $body
 317         } status {
 318             set control($task,filestatus) $body
 319         } tasktype {
 320             set control($task,tasktype) $body
 321         }
 322
 323     if {[info exists starturls]} {
 324         foreach url $starturls {
 325             puts "marking start urls $url"
 326             url $url
 327         }
 328     }
 329
 330     if {$status == "pending"} {
 331         regsub {<status>[^<]*</status>} $xml {<status>running</status>} xml2
 332         set f [open $fname w]
 333         puts -nonewline $f $xml2
 334         close $f
 335     }
 336 }
 337
 338 proc RobotDoneJob {task} {
 339     global daemon_dir control
 340
 341     if {![info exists daemon_dir]} {
 342         return
 343     }
 344     set fname $control($task,taskfname)
 345     set f [open $fname r]
 346     set xml [read $f]
 347     dbgmsg "Reading $fname"
 348     regexp {<status>([^<]*)</status>} $xml x status
 349     dbgmsg "------"
 350     dbgmsg "status = $status"
 351     close $f
 352
 353     regsub {<status>[^<]*</status>} $xml {<status>finished</status>} xml2
 354     set f [open $fname w]
 355     puts -nonewline $f $xml2
 356     close $f
 357 }
 358
 359 proc RobotScanDir {} {
 360     global daemon_dir
 361
 362     if {![info exists daemon_dir]} {
 363         return
 364     }
 365     foreach d $daemon_dir {
 366         if {[catch {set files [glob $d/*.spl]}]} {
 367             return
 368         }
 369         foreach fname $files {
 370             if {[file isfile $fname] && [file readable $fname]} {
 371                 set jobfile [open $fname]
 372                 gets $jobfile portalroot
 373                 gets $jobfile portaltask
 374                 close $jobfile
 375
 376                 RobotStartJob $portalroot $portaltask
 377             }
 378         }
 379     }
 380 }
 381
 382 proc RobotRR {task} {
 383     global control robotsRunning tasks robotsMax status
 384
 385     dbgmsg "RobotRR -- running=$robotsRunning max=$robotsMax---------------"
 386     incr robotsRunning -1
 387
 388     # only one task gets through...
 389     if {[string compare [lindex $tasks 0] $task]} {
 390         return
 391     }
 392     dbgmsg "RobotRR. task = $task"
 393     while {$robotsRunning} {
 394         vwait robotsRunning
 395     }
 396     dbgmsg "Scan"
 397     if {[catch {RobotScanDir} msg]} {
 398         logmsg "RobotScanDir failed"
 399         logmsg $msg
 400     }
 401     foreach t $tasks {
 402         set target $control($t,target)
 403         set statusfile [open $target/status w]
 404         puts $statusfile "$status($t,unvisited) $status($t,bad) $status($t,visited)"
 405         close $statusfile
 406         set control($t,seq) 0
 407         RobotStart $t
 408     }
 409 }
 410
 411 proc RobotDaemonSig {} {
 412     global daemon_cnt
 413
 414     incr daemon_cnt
 415 }
 416
 417 proc RobotDaemonLoop {} {
 418     global daemon_cnt tasks robotsRunning status
 419
 420     set daemon_cnt 0
 421     while 1 {
 422         logmsg $daemon_cnt
 423         RobotScanDir
 424
 425         if {[info exists tasks]} {
 426             logmsg "daemon loop tasks $tasks"
 427             foreach t $tasks {
 428                 set control($t,seq) 0
 429                 RobotStart $t
 430             }
 431             while {$robotsRunning} {
 432                 vwait robotsRunning
 433             }
 434         }
 435         after 30000 RobotDaemonSig
 436         vwait daemon_cnt
 437     }
 438 }
 439
 440 proc RobotRestart {task url sock} {
 441     global URL robotsRunning
 442
 443     close $sock
 444     after cancel $URL($sock,cancel)
 445
 446     foreach v [array names URL $task,$url,*] {
 447         unset URL($v)
 448     }
 449
 450     incr robotsRunning -1
 451     RobotStart $task
 452 }
 453
 454 proc RobotStart {task} {
 455     global URL
 456     global robotsRunning robotsMax idletime status tasks
 457
 458     # dbgmsg "RobotStart $task running=$robotsRunning"
 459     while {1} {
 460         set url [RobotFileNext $task unvisited]
 461         if {[string compare $url done] == 0} {
 462             dbgmsg "In RobotStart task $task done"
 463
 464             catch {unset ntasks}
 465             foreach t $tasks {
 466                 if {[string compare $t $task]} {
 467                     lappend ntasks $t
 468                 } else {
 469                     dbgmsg "task $t done"
 470                 }
 471             }
 472             if {![info exists ntasks]} {
 473                 unset tasks
 474                 dbgmsg "all done"
 475             } else {
 476                 set tasks $ntasks
 477             }
 478             RobotDoneJob $task
 479             return
 480         }
 481         if {![string length $url]} {
 482             return
 483         }
 484         incr robotsRunning
 485         if {[string compare $url wait] == 0} {
 486             after $idletime [list RobotRR $task]
 487             return
 488         }
 489         set r [RobotGetUrl $task $url {}]
 490         if {!$r} {
 491             if {$robotsRunning >= $robotsMax} return
 492         } else {
 493             incr robotsRunning -1
 494             if {![RobotFileExist $task bad $URL($task,$url,hostport) $URL($task,$url,path)]} {
 495                 set outf [RobotFileOpen $task bad $URL($task,$url,hostport) $URL($task,$url,path)]
 496                 RobotFileClose $outf
 497             }
 498             RobotFileUnlink $task unvisited $URL($task,$url,hostport) $URL($task,$url,path)
 499         }
 500     }
 501 }
 502
 503 proc headSave {task url out} {
 504     global URL
 505
 506     if {[info exists URL($task,$url,head,last-modified)]} {
 507         puts $out "<lastmodified>$URL($task,$url,head,last-modified)</lastmodified>"
 508     }
 509     puts $out {<si>}
 510     if {[info exists URL($task,$url,head,date)]} {
 511         puts $out " <date>$URL($task,$url,head,date)</date>"
 512     }
 513     if {[info exists URL($task,$url,head,content-length)]} {
 514         puts $out " <by>$URL($task,$url,head,content-length)</by>"
 515     }
 516     if {[info exists URL($task,$url,head,server)]} {
 517         puts $out " <format>$URL($task,$url,head,server)</format>"
 518     }
 519     puts $out {</si>}
 520     puts $out {<publisher>}
 521     puts $out " <identifier>$url</identifier>"
 522     if {[info exists URL($task,$url,head,content-type)]} {
 523         puts $out " <type>$URL($task,$url,head,content-type)</type>"
 524     }
 525     puts $out {</publisher>}
 526 }
 527
 528 proc RobotHref {task url hrefx hostx pathx} {
 529     global URL control debuglevel
 530     upvar $hrefx href
 531     upvar $hostx host
 532     upvar $pathx path
 533
 534     if {$debuglevel > 1} {
 535         dbgmsg "Ref input url = $url href=$href"
 536     }
 537
 538     if {[string first { } $href] >= 0} {
 539         return 0
 540     }
 541     if {[string length $href] > 256} {
 542         return 0
 543     }
 544
 545 #   Skip pages that have ? in them
 546 #    if {[string first {?} $url] >= 0 && [string first {?} $href] >= 0} {
 547 #       return 0
 548 #    }
 549     # get method (if any)
 550     if {![regexp {^([^/:]+):(.*)} $href x method hpath]} {
 551         set hpath $href
 552         set method http
 553     } else {
 554         if {[string compare $method http]} {
 555             return 0
 556         }
 557     }
 558     # get host (if any)
 559     if {[regexp {^//([^/]+)([^\#]*)} $hpath x host surl]} {
 560         if {![string length $surl]} {
 561             set surl /
 562         }
 563         if {[info exist control($task,domains)]} {
 564             set ok 0
 565             foreach domain $control($task,domains) {
 566                 if {[string match $domain $host]} {
 567                     set ok 1
 568                     break
 569                 }
 570             }
 571             if {!$ok} {
 572                 return 0
 573             }
 574         }
 575     } else {
 576         regexp {^([^\#]*)} $hpath x surl
 577         set host $URL($task,$url,hostport)
 578     }
 579     if {![string length $surl]} {
 580         return 0
 581     }
 582     if {[string first / $surl]} {
 583         # relative path
 584         set curpath $URL($task,$url,path)
 585         if {[info exists URL($task,$url,bpath)]} {
 586             set curpath $URL($task,$url,bpath)
 587         }
 588         regexp {^([^\#?]*)} $curpath x dpart
 589         set l [string last / $dpart]
 590         if {[expr $l >= 0]} {
 591             set surl [string range $dpart 0 $l]$surl
 592         } else {
 593             set surl $dpart/$surl
 594         }
 595     }
 596     set surllist [split $surl /]
 597     catch {unset path}
 598     set pathl 0
 599     foreach c $surllist {
 600         switch -- $c {
 601             .. {
 602                 if {$pathl > 1} {
 603                     incr pathl -2
 604                     set path [lrange $path 0 $pathl]
 605                     incr pathl
 606                 }
 607             }
 608             . {
 609
 610             }
 611             default {
 612                 incr pathl
 613                 lappend path $c
 614             }
 615         }
 616     }
 617     if {$debuglevel > 4} {
 618         dbgmsg "pathl=$pathl output path=$path"
 619     }
 620     set path [join $path /]
 621     if {![string length $path]} {
 622         set path /
 623     }
 624     regsub -all {~} $path {%7E} path
 625     set href "$method://$host$path"
 626
 627     if {$debuglevel > 1} {
 628         dbgmsg "Ref result = $href"
 629     }
 630     return [checkrule $task url $href]
 631 }
 632
 633 proc RobotError {task url code} {
 634     global URL
 635
 636     dbgmsg "Bad URL $url (code $code)"
 637     set fromurl {}
 638     set distance -1
 639     if {[RobotFileExist $task unvisited $URL($task,$url,hostport) $URL($task,$url,path)]} {
 640         set inf [RobotFileOpen $task unvisited $URL($task,$url,hostport) $URL($task,$url,path) r]
 641         RobotReadRecord $inf fromurl distance
 642         RobotFileClose $inf
 643     }
 644     RobotFileUnlink $task unvisited $URL($task,$url,hostport) $URL($task,$url,path)
 645     if {![RobotFileExist $task bad $URL($task,$url,hostport) $URL($task,$url,path)]} {
 646         set outf [RobotFileOpen $task bad $URL($task,$url,hostport) $URL($task,$url,path)]
 647         RobotWriteRecord $outf $fromurl $distance
 648         RobotFileClose $outf
 649     }
 650 }
 651
 652 proc RobotRedirect {task url tourl code} {
 653     global URL
 654
 655     dbgmsg "Redirecting from $url to $tourl"
 656
 657     set distance {}
 658     set fromurl {}
 659     if {[RobotFileExist $task unvisited $URL($task,$url,hostport) $URL($task,$url,path)]} {
 660         set inf [RobotFileOpen $task unvisited $URL($task,$url,hostport) $URL($task,$url,path) r]
 661         RobotReadRecord $inf fromurl distance
 662         RobotFileClose $inf
 663     }
 664     if {![RobotFileExist $task bad $URL($task,$url,hostport) $URL($task,$url,path)]} {
 665         set outf [RobotFileOpen $task bad $URL($task,$url,hostport) $URL($task,$url,path)]
 666         RobotWriteRecord $outf $fromurl $distance
 667         RobotFileClose $outf
 668     }
 669     if {[RobotHref $task $url tourl host path]} {
 670         if {![RobotFileExist $task visited $host $path]} {
 671             if {![RobotFileExist $task unvisited $host $path]} {
 672                 set outf [RobotFileOpen $task unvisited $host $path]
 673                 RobotWriteRecord $outf $fromurl $distance
 674                 RobotFileClose $outf
 675             }
 676         } else {
 677             set olddistance {}
 678             set inf [RobotFileOpen $task visited $host $path r]
 679             RobotReadRecord $inf oldurl olddistance
 680             RobotFileClose $inf
 681             if {[string length $olddistance] == 0} {
 682                 set olddistance 1000
 683             }
 684             if {[string length $distance] == 0} {
 685                 set distance 1000
 686             }
 687             dbgmsg "distance=$distance olddistance=$olddistance"
 688             if {[expr $distance < $olddistance]} {
 689                 set outf [RobotFileOpen $task unvisited $host $path]
 690                 RobotWriteRecord $outf $tourl $distance
 691                 RobotFileClose $outf
 692             }
 693         }
 694     }
 695     if {[catch {RobotFileUnlink $task unvisited $URL($task,$url,hostport) $URL($task,$url,path)}]} {
 696         dbgmsg "unlink failed"
 697         exit 1
 698     }
 699 }
 700
 701 proc wellform {body} {
 702     regsub -all {<!--[^-]*-->} $body { } abody
 703     regsub -all -nocase {<script[^<]*</script>} $abody {} body
 704     regsub -all {<[^\>]+>} $body {} abody
 705     regsub -all {&nbsp;} $abody { } body
 706     regsub -all {&} $body {&amp;} abody
 707     return $abody
 708 }
 709
 710 proc link {task url out href body distance} {
 711     global URL control
 712     if {[expr $distance > $control($task,distance)]} return
 713
 714     if {![RobotHref $task $url href host path]} return
 715
 716     if ($control($task,cr)) {
 717         puts $out "<cr>"
 718         puts $out "<identifier>$href</identifier>"
 719         set abody [wellform $body]
 720         puts $out "<description>$abody</description>"
 721         puts $out "</cr>"
 722     }
 723
 724     if {![RobotFileExist $task visited $host $path]} {
 725         set olddistance 1000
 726         if {![RobotFileExist $task bad $host $path]} {
 727             if {[RobotFileExist $task unvisited $host $path]} {
 728                 set inf [RobotFileOpen $task unvisited $host $path r]
 729                 RobotReadRecord $inf oldurl olddistance
 730                 RobotFileClose $inf
 731             }
 732         } else {
 733             set olddistance 0
 734         }
 735         if {[string length $olddistance] == 0} {
 736             set olddistance 1000
 737         }
 738         if {[expr $distance < $olddistance]} {
 739             set outf [RobotFileOpen $task unvisited $host $path]
 740             RobotWriteRecord $outf $url $distance
 741             RobotFileClose $outf
 742         }
 743     } elseif {[string compare $href $url]} {
 744         set inf [RobotFileOpen $task visited $host $path r]
 745         RobotReadRecord $inf xurl olddistance
 746         close $inf
 747         if {[string length $olddistance] == 0} {
 748             set olddistance 1000
 749         }
 750         if {[expr $distance < $olddistance]} {
 751             dbgmsg "OK remarking url=$url href=$href"
 752             dbgmsg "olddistance = $olddistance"
 753             dbgmsg "newdistance = $distance"
 754             set outf [RobotFileOpen $task unvisited $host $path]
 755             RobotWriteRecord $outf $url $distance
 756             RobotFileClose $outf
 757         }
 758     }
 759 }
 760
 761 proc RobotTextTkl {task url out} {
 762     global URL control
 763
 764     # set title so we can emit it for the body
 765     set title {}
 766     # if true, nothing will be indexed
 767     set noindex 0
 768     # if true, nothing will be followed
 769     set nofollow 0
 770
 771     puts $control($task,output)
 772
 773     set out stdout
 774     set distance distance
 775
 776     htmlSwitch $URL($task,$url,buf) \
 777         title {
 778             # når title tag er hittet, er body set til indholdet af tagget
 779             set title $body
 780         } -nonest meta {
 781             #puts -nonewline $out "<meta"
 782             # al er list med attribut navne som fandtes ind i parm hash
 783             set al [array names parm]
 784             # løkke igennem attributer
 785             foreach a $al {
 786                 set al [string tolower $a]
 787                 #puts -nonewline $out " $al"
 788                 #puts -nonewline $out {="}
 789                 #puts -nonewline $out $parm($a)
 790                 #puts -nonewline $out {"}
 791                 unset parm($al)
 792             }
 793             #puts $out "></meta>"
 794         } body {
 795             # don't print title of document content if noindex is used
 796             if {!$noindex} {
 797                 #puts $out "<title>$title</title>"
 798                 # xml compilancy added
 799                 set bbody [wellform $body]
 800                 #puts $out "<documentcontent>"
 801                 #puts $out $bbody
 802                 #puts $out "</documentcontent>"
 803             }
 804         } -nonest base {
 805             # <base href=.. >
 806             if {![info exists parm(href)]} {
 807                 continue
 808             }
 809             set href [string trim $parm(href)]
 810         } a {
 811             # <a href="...."> .. </a>
 812             # we're not using nonest - otherwise body isn't set
 813             if {$nofollow} continue
 814             if {![info exists parm(href)]} {
 815                 continue
 816             }
 817             #puts "link $task $url $out [string trim $parm(href)] $body $distance"
 818         } -nonest area {
 819             if {$nofollow} continue
 820             if {![info exists parm(href)]} {
 821                 continue
 822             }
 823             #puts "link $task $url $out [string trim $parm(href)] $body $distance"
 824         } -nonest frame {
 825             if {![info exists parm(src)]} {
 826                 continue
 827             }
 828             #puts "link $task $url $out [string trim $parm(src)] $body $fdistance"
 829         }
 830 }
 831
 832 proc RobotTextHtml {task url out} {
 833     global URL control
 834
 835     # set title so we can emit it for the body
 836     set title {}
 837     # if true, nothing will be indexed
 838     set noindex 0
 839     # if true, nothing will be followed
 840     set nofollow 0
 841
 842     set distance 0
 843     set fdistance 0
 844     if {$control($task,distance) < 1000 && [info exists URL($task,$url,dist)]} {
 845         set fdistance $URL($task,$url,dist)
 846         set distance [expr $fdistance + 1]
 847     }
 848     htmlSwitch $URL($task,$url,buf) \
 849         title {
 850             set title $body
 851         } -nonest meta {
 852             # collect metadata and save NAME= CONTENT=..
 853             set metaname {}
 854             set metacontent {}
 855             puts -nonewline $out "<meta"
 856             set al [array names parm]
 857             foreach a $al {
 858                 set al [string tolower $a]
 859                 puts -nonewline $out " $al"
 860                 puts -nonewline $out {="}
 861                 puts -nonewline $out $parm($a)
 862                 puts -nonewline $out {"}
 863                 switch -- $al {
 864                     "name" {
 865                         set metaname [string tolower $parm($a)]
 866                     }
 867                     "content" {
 868                         set metacontent $parm($a)
 869                     }
 870                 }
 871                 unset parm($al)
 872             }
 873             puts $out "></meta>"
 874             # go through robots directives (af any)
 875             if {![string compare $metaname robots]} {
 876                 set direcs [split [string tolower $metacontent] ,]
 877                 if {[lsearch $direcs noindex] >= 0} {
 878                     set noindex 1
 879                 }
 880                 if {[lsearch $direcs nofollow] >= 0} {
 881                     set nofollow 1
 882                 }
 883             }
 884         } body {
 885             # don't print title of document content if noindex is used
 886             if {!$noindex} {
 887                 puts $out "<title>$title</title>"
 888                 set bbody [wellform $body]
 889                 puts $out "<documentcontent>"
 890                 puts $out $bbody
 891                 puts $out "</documentcontent>"
 892             }
 893         } -nonest base {
 894             # <base href=.. >
 895             if {![info exists parm(href)]} {
 896                 continue
 897             }
 898             set href [string trim $parm(href)]
 899             if {![RobotHref $task $url href host path]} continue
 900             set URL($task,$url,bpath) $path
 901         } a {
 902             # <a href="...."> .. </a>
 903             # we're not using nonest - otherwise body isn't set
 904             if {$nofollow} continue
 905             if {![info exists parm(href)]} {
 906                 continue
 907             }
 908             link $task $url $out [string trim $parm(href)] $body $distance
 909         } -nonest area {
 910             if {$nofollow} continue
 911             if {![info exists parm(href)]} {
 912                 continue
 913             }
 914             link $task $url $out [string trim $parm(href)] $body $distance
 915         } -nonest frame {
 916             if {![info exists parm(src)]} {
 917                 continue
 918             }
 919             link $task $url $out [string trim $parm(src)] $body $fdistance
 920         }
 921 }
 922
 923 proc RobotsTxt {task url} {
 924     global agent URL
 925
 926     RobotsTxt0 $task URL(URL($task,$url,hostport),robots) $URL($task,$url,buf)
 927 }
 928
 929 proc RobotsTxt0 {task v buf} {
 930     global URL agent
 931     set section 0
 932     foreach l [split $buf \n] {
 933         if {[regexp {([-A-Za-z]+):[ ]*([^\# ]+)} $l match cmd arg]} {
 934             set arg [string trim $arg]
 935             dbgmsg "cmd=$cmd arg=$arg"
 936             switch -- [string tolower $cmd] {
 937                 user-agent {
 938                     if {$section} break
 939                     set pat [string tolower $arg]*
 940                     set section [string match $pat $agent]
 941                 }
 942                 disallow {
 943                     if {$section} {
 944                         dbgmsg "rule [list 0 $arg]"
 945                         lappend $v [list 0 $arg]
 946                     }
 947                 }
 948                 allow {
 949                     if {$section} {
 950                         dbgmsg "rule [list 1 $arg]"
 951                         lappend $v [list 1 $arg]
 952                     }
 953                 }
 954             }
 955         }
 956     }
 957 }
 958
 959 proc RobotTextPlain {task url out} {
 960     global URL
 961
 962     puts $out "<documentcontent>"
 963     regsub -all {<} $URL($task,$url,buf) {\&lt;} content
 964     puts $out $content
 965     puts $out "</documentcontent>"
 966
 967     if {![string compare $URL($task,$url,path) /robots.txt]} {
 968         RobotsTxt $task $url
 969     }
 970 }
 971
 972 proc RobotWriteMetadata {task url out} {
 973     global URL
 974
 975     set charset $URL($task,$url,charset)
 976     puts $out "<?xml version=\"1.0\" encoding=\"$charset\" standalone=\"yes\"?>"
 977     puts $out "<zmbot>"
 978
 979     set distance 1000
 980     if {[RobotFileExist $task unvisited $URL($task,$url,hostport) $URL($task,$url,path)]} {
 981         set inf [RobotFileOpen $task unvisited $URL($task,$url,hostport) $URL($task,$url,path) r]
 982         RobotReadRecord $inf fromurl distance
 983         RobotFileClose $inf
 984     }
 985     set URL($task,$url,dist) $distance
 986     puts $out "<distance>"
 987     puts $out "  $distance"
 988     puts $out "</distance>"
 989     headSave $task $url $out
 990     logmsg "Parsing $url distance=$distance"
 991     switch $URL($task,$url,head,content-type) {
 992         text/html {
 993             if {[string length $distance]} {
 994                 RobotTextHtml $task $url $out
 995                 RobotTextTkl $task $url $out
 996             }
 997         }
 998         text/plain {
 999             RobotTextPlain $task $url $out
1000         }
1001     }
1002     puts $out "</zmbot>"
1003 }
1004
1005 proc Robot200 {task url} {
1006     global URL
1007
1008     set out [RobotFileOpen $task raw $URL($task,$url,hostport) $URL($task,$url,path)]
1009     puts -nonewline $out $URL($task,$url,buf)
1010     RobotFileClose $out
1011
1012     set out [RobotFileOpen $task visited $URL($task,$url,hostport) $URL($task,$url,path)]
1013     RobotWriteMetadata $task $url $out
1014     RobotFileClose $out
1015
1016     RobotFileUnlink $task unvisited $URL($task,$url,hostport) $URL($task,$url,path)
1017 }
1018
1019 proc RobotReadContent {task url sock binary} {
1020     global URL
1021
1022     set buffer [read $sock 16384]
1023     set readCount [string length $buffer]
1024
1025     if {$readCount <= 0} {
1026         Robot200 $task $url
1027         RobotRestart $task $url $sock
1028     } elseif {!$binary && [string first \0 $buffer] >= 0} {
1029         Robot200 $task $url
1030         RobotRestart $task $url $sock
1031     } else {
1032         # dbgmsg "Got $readCount bytes"
1033         set URL($task,$url,buf) $URL($task,$url,buf)$buffer
1034     }
1035 }
1036
1037 proc RobotReadHeader {task url sock} {
1038     global URL debuglevel
1039
1040     if {$debuglevel > 1} {
1041         dbgmsg "HTTP head $url"
1042     }
1043     if {[catch {set buffer [read $sock 2148]}]} {
1044         RobotError $task $url 404
1045         RobotRestart $task $url $sock
1046         return
1047     }
1048     set readCount [string length $buffer]
1049
1050     if {$readCount <= 0} {
1051         RobotError $task $url 404
1052         RobotRestart $task $url $sock
1053     } else {
1054         # dbgmsg "Got $readCount bytes"
1055         set URL($task,$url,buf) $URL($task,$url,buf)$buffer
1056
1057         set n [string first \r\n\r\n $URL($task,$url,buf)]
1058         if {$n > 1} {
1059             set code 0
1060             set version {}
1061             set headbuf [string range $URL($task,$url,buf) 0 $n]
1062             incr n 4
1063             set URL($task,$url,charset) ISO-8859-1
1064             set URL($task,$url,buf) [string range $URL($task,$url,buf) $n end]
1065
1066             regexp {^HTTP/([0-9.]+)[ ]+([0-9]+)} $headbuf x version code
1067             set lines [split $headbuf \n]
1068             foreach line $lines {
1069                 if {[regexp {^([^:]+):[ ]+([^;]*)} $line x name value]} {
1070                     set URL($task,$url,head,[string tolower $name]) [string trim $value]
1071                 }
1072                 regexp {^Content-Type:.*charset=([A-Za-z0-9_-]*)} $line x URL($task,$url,charset)
1073             }
1074             dbgmsg "HTTP CODE $code"
1075             set URL($task,$url,state) skip
1076             switch $code {
1077                 301 {
1078                     RobotRedirect $task $url $URL($task,$url,head,location) 301
1079                     RobotRestart $task $url $sock
1080                 }
1081                 302 {
1082                     RobotRedirect $task $url $URL($task,$url,head,location) 302
1083                     RobotRestart $task $url $sock
1084                 }
1085                 200 {
1086                     if {![info exists URL($task,$url,head,content-type)]} {
1087                         set URL($task,$url,head,content-type) {}
1088                     }
1089                     set binary 1
1090                     switch -glob -- $URL($task,$url,head,content-type) {
1091                         text/* {
1092                             set binary 0
1093                         }
1094                     }
1095                     if {![regexp {/robots.txt$} $url]} {
1096                         if {![checkrule $task mime $URL($task,$url,head,content-type)]} {
1097                             RobotError $task $url mimedeny
1098                             RobotRestart $task $url $sock
1099                             return
1100                         }
1101                     }
1102                     fileevent $sock readable [list RobotReadContent $task $url $sock $binary]
1103                 }
1104                 default {
1105                     RobotError $task $url $code
1106                     RobotRestart $task $url $sock
1107                 }
1108             }
1109         }
1110     }
1111 }
1112
1113 proc RobotSockCancel {task url sock} {
1114
1115     logmsg "RobotSockCancel sock=$sock url=$url"
1116     RobotError $task $url 401
1117     RobotRestart $task $url $sock
1118 }
1119
1120 proc RobotConnect {task url sock} {
1121     global URL agent acceptLanguage
1122
1123     fconfigure $sock -translation {lf crlf} -blocking 0
1124     fileevent $sock readable [list RobotReadHeader $task $url $sock]
1125     puts $sock "GET $URL($task,$url,path) HTTP/1.0"
1126     puts $sock "Host: $URL($task,$url,host)"
1127     puts $sock "User-Agent: $agent"
1128     if {[string length $acceptLanguage]} {
1129         puts $sock "Accept-Language: $acceptLanguage"
1130     }
1131     puts $sock ""
1132     set URL($sock,cancel) [after 30000 [list RobotSockCancel $task $url $sock]]
1133     if {[catch {flush $sock}]} {
1134         RobotError $task $url 404
1135         RobotRestart $task $url $sock
1136     }
1137 }
1138
1139 proc RobotNop {} {
1140
1141 }
1142
1143 proc RobotGetUrl {task url phost} {
1144     global URL robotsRunning
1145     flush stdout
1146     dbgmsg "Retrieve running=$robotsRunning url=$url task=$task"
1147     if {![regexp {([^:]+)://([^/]+)(.*)} $url x method hostport path]} {
1148         return -1
1149     }
1150     if {![regexp {([^:]+):([0-9]+)} $hostport x host port]} {
1151         set port 80
1152         set host $hostport
1153     }
1154     set URL($task,$url,method) $method
1155     set URL($task,$url,host) $host
1156     set URL($task,$url,hostport) $hostport
1157     set URL($task,$url,path) $path
1158     set URL($task,$url,state) head
1159     set URL($task,$url,buf) {}
1160
1161     if {[string compare $path /robots.txt]} {
1162         set ok 1
1163         if {![info exists URL($hostport,robots)]} {
1164             dbgmsg "READING robots.txt for host $hostport"
1165             if {[RobotFileExist $task visited $hostport /robots.txt]} {
1166                 set inf [RobotFileOpen $task visited $hostport /robots.txt r]
1167                 set buf [read $inf 32768]
1168                 close $inf
1169             } else {
1170                 set buf "User-agent: *\nAllow: /\n"
1171             }
1172             RobotsTxt0 $task URL($hostport,robots) $buf
1173         }
1174         if {[info exists URL($hostport,robots)]} {
1175             foreach l $URL($hostport,robots) {
1176                 if {[string first [lindex $l 1] $path] == 0} {
1177                     set ok [lindex $l 0]
1178                     break
1179                 }
1180             }
1181         }
1182         if {!$ok} {
1183             dbgmsg "skipped due to robots.txt"
1184             return -1
1185         }
1186     }
1187     if [catch {set sock [socket -async $host $port]}] {
1188         return -1
1189     }
1190     RobotConnect $task $url $sock
1191
1192     return 0
1193 }
1194
1195 proc loadlib {} {
1196     global libdir
1197
1198     if {![llength [info commands htmlSwitch]]} {
1199         if {[info exists env(tclrobot_lib)]} {
1200             set d $env(tclrobot_lib)
1201         } else {
1202             if { $libdir > "" } {
1203                 set d $libdir
1204             } else {
1205                 set d .
1206             }
1207         }
1208         set e [info sharedlibextension]
1209         dbgmsg "About to load $d/tclrobot$e"
1210         if {[catch {load $d/tclrobot$e}]} {
1211             dbgmsg "Didn't get at $d, trying directly"
1212             load tclrobot$e
1213         }
1214         dbgmsg "Loaded tclrobot$e all right"
1215     }
1216 }
1217
1218 set agent "zmbot/0.2"
1219 if {![catch {set os [exec uname -s -r]}]} {
1220     set agent "$agent ($os)"
1221 }
1222
1223 dbgmsg "agent: $agent"
1224
1225 proc bgerror {m} {
1226     global errorInfo
1227     dbgmsg "BGERROR $m"
1228     dbgmsg $errorInfo
1229 }
1230
1231 # Rules: allow, deny, url
1232
1233 proc checkrule {task type this} {
1234     global control
1235     global debuglevel
1236
1237     set default_ret 1
1238
1239     if {$debuglevel > 3} {
1240         dbgmsg "CHECKRULE $type $this"
1241     }
1242     if {[info exist control($task,alrules)]} {
1243         foreach l $control($task,alrules) {
1244             if {$debuglevel > 3} {
1245                 dbgmsg "consider $l"
1246             }
1247             # consider type
1248             if {[lindex $l 1] != $type} continue
1249             # consider mask (! negates)
1250             set masks [lindex $l 2]
1251             set ok 0
1252             set default_ret 0
1253             foreach mask $masks {
1254                 if {$debuglevel > 4} {
1255                     dbgmsg "consider single mask $mask"
1256                 }
1257                 if {[string index $mask 0] == "!"} {
1258                     set mask [string range $mask 1 end]
1259                     if {[string match $mask $this]}  continue
1260                 } else {
1261                     if {![string match $mask $this]} continue
1262                 }
1263                 set ok 1
1264             }
1265             if {$debuglevel > 4} {
1266                 dbgmsg "ok = $ok"
1267             }
1268             if {!$ok} continue
1269             # OK, we have a match
1270             if {[lindex $l 0] == "allow"} {
1271                 if {$debuglevel > 3} {
1272                     dbgmsg "CHECKRULE MATCH OK"
1273                 }
1274                 return 1
1275             } else {
1276                 if {$debuglevel > 3} {
1277                     dbgmsg "CHECKFULE MATCH FAIL"
1278                 }
1279                 return 0
1280             }
1281         }
1282     }
1283     if {$debuglevel > 3} {
1284         dbgmsg "CHECKRULE MATCH DEFAULT $default_ret"
1285     }
1286     return $default_ret
1287 }
1288
1289
1290 proc url {href} {
1291     global debuglevel task
1292
1293     if {[RobotHref $task http://www.indexdata.dk/ href host path]} {
1294         if {![RobotFileExist $task visited $host $path]} {
1295             set outf [RobotFileOpen $task unvisited $host $path]
1296             RobotWriteRecord $outf href 0
1297             RobotFileClose $outf
1298         }
1299     }
1300 }
1301
1302 proc deny {type stuff} {
1303     global control task
1304
1305     lappend control($task,alrules) [list deny $type $stuff]
1306 }
1307
1308 proc allow {type stuff} {
1309     global control task
1310
1311     lappend control($task,alrules) [list allow $type $stuff]
1312 }
1313
1314 proc debug {level} {
1315     global debuglevel
1316
1317     set debuglevel $level
1318 }
1319
1320 proc CreateTask {t} {
1321     global tasks task status control
1322
1323     set task $t
1324
1325     if {[info exists tasks]} {
1326         if {[lsearch -exact $tasks $t] >= 0} {
1327             return 0
1328         }
1329     }
1330
1331     lappend tasks $t
1332     set status($t,unvisited) 0
1333     set status($t,visited) 0
1334     set status($t,bad) 0
1335     set status($t,raw) 0
1336     set status($t,active) 1
1337     set control($t,seq) 0
1338     set control($t,distance) 10
1339     set control($t,target) tmp
1340     set control($t,output) output
1341     set control($t,cr) 0
1342     return 1
1343 }
1344
1345 # Little utility that ensures that at least one task is present (main).
1346 proc CreateMainTask {} {
1347     global tasks
1348     if {![info exist tasks]} {
1349         CreateTask main
1350     }
1351 }
1352
1353 # Parse options
1354
1355 set i 0
1356 set l [llength $argv]
1357
1358 if {$l < 1} {
1359     puts {tclrobot: usage:}
1360     puts {tclrobot [-j jobs] [-p pid] [-T tmpdir] [-o logfile] [-i idle] [-c
1361     count] [-d domain] [-D spooldir] [-r rules] [-L libdir] [url ..]}
1362     logmsg " Example: -c 3 -d '*.dk' http://www.indexdata.dk/"
1363
1364     exit 1
1365 }
1366
1367
1368 while  {$i < $l} {
1369     set arg [lindex $argv $i]
1370     switch -glob -- $arg {
1371         -o* {
1372             set fname [string range $arg 2 end]
1373             if {![string length $fname]} {
1374                 set fname [lindex $argv [incr i]]
1375             }
1376             set loghandle [open $fname a]
1377             #dbgmsg "agent: $agent"
1378             #dbgmsg "-o $fname"
1379         }
1380         -p* {
1381             set pidfname [string range $arg 2 end]
1382             if {![string length $pidfname]} {
1383                 set pidfname [lindex $argv [incr i]]
1384             }
1385             #dbgmsg "-p $pidfname"
1386             if {[file exists $pidfname]} {
1387                 set pf [open $pidfname]
1388                 gets $pf oldpid
1389                 close $pf
1390                 logmsg "File $pidfname already exist. pid=$oldpid"
1391                 if {[file isdirectory /proc/$oldpid]} {
1392                     logmsg "And it's apparently running. Exiting."
1393                     exit 1
1394                 }
1395             }
1396             set pf [open $pidfname w]
1397             puts $pf [pid]
1398             close $pf
1399         }
1400         -T* {
1401             set tmpdir [string range $arg 2 end]
1402             if {![string length $tmpdir]} {
1403                 set tmpdir [lindex $argv [incr i]]
1404             }
1405             set control(tmpdir) $tmpdir
1406         }
1407         -L* {
1408             set libdir [string range $arg 2 end]
1409             if {![string length $libdir]} {
1410                 set libdir [lindex $argv [incr i]]
1411             }
1412         }
1413         -t* {
1414             set t [string range $arg 2 end]
1415             if {![string length $t]} {
1416                 set t [lindex $argv [incr i]]
1417             }
1418             CreateTask $t
1419         }
1420         -D* {
1421             set dir [string range $arg 2 end]
1422             if {![string length $dir]} {
1423                 set dir [lindex $argv [incr i]]
1424             }
1425             lappend daemon_dir $dir
1426         }
1427         -j* {
1428             set robotsMax [string range $arg 2 end]
1429             if {![string length $robotsMax]} {
1430                 set robotsMax [lindex $argv [incr i]]
1431             }
1432         }
1433         -c* {
1434             CreateMainTask
1435             set control($task,distance) [string range $arg 2 end]
1436             if {![string length $control($task,distance)]} {
1437                 set control($task,distance) [lindex $argv [incr i]]
1438             }
1439         }
1440         -d* {
1441             CreateMainTask
1442             set dom [string range $arg 2 end]
1443             if {![string length $dom]} {
1444                 set dom [lindex $argv [incr i]]
1445             }
1446             lappend control($task,domains) $dom
1447         }
1448         -i* {
1449             set idletime [string range $arg 2 end]
1450             if {![string length $idletime]} {
1451                 set idletime [lindex $argv [incr i]]
1452             }
1453         }
1454         -l* {
1455             CreateMainTask
1456             set acceptLanguage [string range $arg 2 end]
1457             if {![string length $acceptLanguage]} {
1458                 set acceptLanguage [lindex $argv [incr i]]
1459             }
1460         }
1461         -r* {
1462             CreateMainTask
1463             set rfile [string range $arg 2 end]
1464             if {![string length $rfile]} {
1465                 set rfile [lindex $argv [incr i]]
1466             }
1467             catch {unset maxdistance}
1468             source $rfile
1469             if {[info exists maxdistance]} {
1470                 set control($task,distance) $maxdistance
1471             }
1472         }
1473         default {
1474             CreateMainTask
1475             set href $arg
1476             #dbgmsg "in default: arg= $arg !!!"
1477         loadlib
1478             if {[RobotHref $task http://www.indexdata.dk/ href host path]} {
1479                 if {![RobotFileExist $task visited $host $path]} {
1480                     set outf [RobotFileOpen $task unvisited $host $path]
1481                     RobotWriteRecord $outf href 0
1482                     RobotFileClose $outf
1483                 }
1484             }
1485         }
1486     }
1487     incr i
1488 }
1489
1490
1491 dbgmsg "Parsed args, now loading"
1492 loadlib
1493
1494 if {![info exist robotsMax]} {
1495     set robotsMax 5
1496 }
1497
1498 if {[info exist daemon_dir]} {
1499     logmsg "Daemon mode"
1500     RobotDaemonLoop
1501 } else {
1502     foreach t $tasks {
1503         logmsg "task $t"
1504         logmsg "max distance=$control($t,distance)"
1505         if {[info exists control($t,domains)]} {
1506             logmsg "domains=$control($t,domains)"
1507         }
1508     }
1509     logmsg "max jobs=$robotsMax"
1510
1511     foreach t $tasks {
1512         RobotStart $t
1513     }
1514
1515     while {$robotsRunning} {
1516         vwait robotsRunning
1517     }
1518
1519     if {[info exists tasks]} {
1520         foreach t $tasks {
1521             set statusfile [open $t/status w]
1522             puts $statusfile "$status($t,unvisited) $status($t,bad) $status($t,visited)"
1523             close $statusfile
1524         }
1525     }
1526 }
1527