robot.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: robot.tcl,v 1.7 2000/12/08 22:46:53 adam Exp $
   3 #
   4 proc RobotFileNext1 {area} {
   5     if {[catch {set ns [glob ${area}/*]}]} {
   6         return {}
   7     }
   8     set off [string first / $area]
   9     incr off
  10
  11     foreach n $ns {
  12         if {[file isfile $n]} {
  13             if {[string first :.html $n] > 0} {
  14                 return http://[string range $area/ $off end]
  15             }
  16             return http://[string range $n $off end]
  17         }
  18     }
  19     foreach n $ns {
  20         if {[file isdirectory $n]} {
  21             set sb [RobotFileNext1 $n]
  22             if {[string length $sb]} {
  23                 return $sb
  24             }
  25         }
  26     }
  27     return {}
  28 }
  29
  30 proc RobotFileWait {} {
  31     global robotSeq
  32     set robotSeq 0
  33 }
  34
  35 proc RobotFileNext {area} {
  36     global robotSeq
  37     if {[catch {set ns [glob ${area}/*]}]} {
  38         return {}
  39     }
  40     set off [string length $area]
  41     incr off
  42
  43     set n [lindex $ns $robotSeq]
  44     if {![string length $n]} {
  45         puts "------------ N E X T  R O U N D --------"
  46         set robotSeq -1
  47         after 2000 RobotFileWait
  48         vwait robotSeq
  49
  50         set n [lindex $ns $robotSeq]
  51         if {![string length $n]} {
  52             return {}
  53         }
  54     }
  55     incr robotSeq
  56     if {[file isfile $n/robots.txt]} {
  57         puts "ok returning http://[string range $n $off end]/robots.txt"
  58         return http://[string range $n $off end]/robots.txt
  59     } elseif {[file isdirectory $n]} {
  60         set sb [RobotFileNext1 $n]
  61         if {[string length $sb]} {
  62             return $sb
  63         }
  64     }
  65     return {}
  66 }
  67
  68
  69 proc RobotFileExist {area host path} {
  70     set comp [split $area/$host$path /]
  71     set l [llength $comp]
  72     incr l -1
  73     if {![string length [lindex $comp $l]]} {
  74         set comp [split $area/$host$path:.html /]
  75     } elseif {[file exists [join $comp /]]} {
  76         return 1
  77     } else {
  78         set comp [split $area/$host$path/:.html /]
  79     }
  80     return [file exists [join $comp /]]
  81 }
  82
  83 proc RobotFileUnlink {area host path} {
  84     set comp [split $area/$host$path /]
  85     set l [llength $comp]
  86     incr l -1
  87     if {![string length [lindex $comp $l]]} {
  88         set comp [split $area/$host$path:.html /]
  89     }
  90     if {[catch {exec rm [join $comp /]}]} return
  91     incr l -1
  92     for {set i $l} {$i > 0} {incr i -1} {
  93         set path [join [lrange $comp 0 $i] /]
  94         if {![catch {glob $path/*}]} return
  95         exec rmdir ./$path
  96     }
  97 }
  98
  99 proc RobotFileClose {out} {
 100     if [string compare $out stdout] {
 101         close $out
 102     }
 103 }
 104
 105 proc RobotFileOpen {area host path {mode w}} {
 106     set orgPwd [pwd]
 107     global workdir
 108
 109     if {![info exists workdir]} {
 110         return stdout
 111     }
 112     puts "RobotFileOpen orgPwd=$orgPwd area=$area host=$host path=$path"
 113     if {[string compare $orgPwd $workdir]} {
 114         puts "workdir = $workdir"
 115         puts "pwd = $orgPwd"
 116         exit 1
 117     }
 118     set comp [split $area/$host$path /]
 119     set len [llength $comp]
 120     incr len -1
 121     for {set i 0} {$i < $len} {incr i} {
 122         set d [lindex $comp $i]
 123         if {[catch {cd ./$d}]} {
 124             exec mkdir $d
 125             cd ./$d
 126             if {![string compare $area unvisited] && $i == 1 && $mode == "w"} {
 127                 set out [open robots.txt w]
 128                 puts "creating robots.txt in $d"
 129                 close $out
 130             }
 131         }
 132     }
 133     set d [lindex $comp $len]
 134     if {[string length $d]} {
 135         if {[file isdirectory $d]} {
 136             set out [open $d/:.html $mode]
 137         } else {
 138             set out [open $d $mode]
 139         }
 140     } else {
 141         set out [open :.html $mode]
 142     }
 143     cd $orgPwd
 144     #puts "RobotFileStop"
 145     return $out
 146 }
 147
 148 proc RobotRestart {} {
 149     global URL
 150     global robotMoreWork
 151
 152     while {1} {
 153         set url [RobotFileNext unvisited]
 154         if {![string length $url]} {
 155             break
 156         }
 157         set r [RobotGetUrl $url {}]
 158         if {!$r} {
 159             puts "RobotGetUrl returned 0 on url=$url"
 160             return
 161         } else {
 162             RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 163         }
 164     }
 165     set robotMoreWork 0
 166 }
 167
 168 proc headSave {url out} {
 169     global URL
 170
 171     puts $out {<zmbot>}
 172     if {[info exists URL($url,head,last-modified)]} {
 173         puts $out "<lastmodified>$URL($url,head,last-modified)</lastmodified>"
 174     }
 175     puts $out {<si>}
 176     if {[info exists URL($url,head,date)]} {
 177         puts $out " <date>$URL($url,head,date)</date>"
 178     }
 179     if {[info exists URL($url,head,content-length)]} {
 180         puts $out " <by>$URL($url,head,content-length)</by>"
 181     }
 182     if {[info exists URL($url,head,server)]} {
 183         puts $out " <format>$URL($url,head,server)</format>"
 184     }
 185     puts $out {</si>}
 186     puts $out {<publisher>}
 187     puts $out " <identifier>$url</identifier>"
 188     if {[info exists URL($url,head,content-type)]} {
 189         puts $out " <type>$URL($url,head,content-type)</type>"
 190     }
 191     puts $out {</publisher>}
 192 }
 193
 194 proc RobotHref {url hrefx hostx pathx} {
 195     global URL domains
 196     upvar $hrefx href
 197     upvar $hostx host
 198     upvar $pathx path
 199
 200     puts "Ref url = $url href=$href"
 201     # get method (if any)
 202     if {![regexp {^([^/:]+):(.*)} $href x method hpath]} {
 203         set hpath $href
 204         set method http
 205     } else {
 206         if {[string compare $method http]} {
 207             return 0
 208         }
 209     }
 210     # get host (if any)
 211     if {[regexp {^//([^/]+)([^\#]*)} $hpath x host surl]} {
 212         if {![string length $surl]} {
 213             set surl /
 214         }
 215         set ok 0
 216         foreach domain $domains {
 217             if {[string match $domain $host]} {
 218                 set ok 1
 219                 break
 220             }
 221         }
 222         if {!$ok} {
 223             return 0
 224         }
 225     } else {
 226         regexp {^([^\#]*)} $hpath x surl
 227         set host $URL($url,host)
 228     }
 229     if {![string length $surl]} {
 230         return 0
 231     }
 232     if {[string first / $surl]} {
 233         # relative path
 234         regexp {^([^\#?]*)} $URL($url,path) x dpart
 235         set l [string last / $dpart]
 236         if {[expr $l >= 0]} {
 237             set surl [string range $dpart 0 $l]$surl
 238         } else {
 239             set surl $dpart/$surl
 240         }
 241     }
 242     set c [split $surl /]
 243     set i [llength $c]
 244     incr i -1
 245     set path [lindex $c $i]
 246     incr i -1
 247     while {$i >= 0} {
 248         switch -- [lindex $c $i] {
 249             .. {
 250                 incr i -2
 251             }
 252             . {
 253                 incr i -1
 254             }
 255             default {
 256                 set path [lindex $c $i]/$path
 257                 incr i -1
 258             }
 259         }
 260     }
 261     set href "$method://$host$path"
 262     puts "Ref href = $href"
 263     return 1
 264 }
 265
 266 proc Robot401 {url} {
 267     global URL
 268
 269     puts "Bad URL $url"
 270     set fromurl {}
 271     catch {
 272         set inf [RobotFileOpen unvisited $URL($url,host) $URL($url,path) r]
 273         set fromurl [gets $inf]
 274         close $inf
 275     }
 276     RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 277     if {![RobotFileExist bad $URL($url,host) $URL($url,path)]} {
 278         set outf [RobotFileOpen bad $URL($url,host) $URL($url,path)]
 279         puts $outf "URL=$url 401"
 280         puts $outf "Reference $fromurl"
 281         RobotFileClose $outf
 282     }
 283 }
 284
 285 proc Robot404 {url} {
 286     global URL
 287
 288     puts "Bad URL $url"
 289     set fromurl {}
 290     catch {
 291         set inf [RobotFileOpen unvisited $URL($url,host) $URL($url,path) r]
 292         set fromurl [gets $inf]
 293         RobotFileClose $inf
 294     }
 295     RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 296     if {![RobotFileExist bad $URL($url,host) $URL($url,path)]} {
 297         set outf [RobotFileOpen bad $URL($url,host) $URL($url,path)]
 298         puts $outf "URL=$url 404"
 299         puts $outf "Reference $fromurl"
 300         RobotFileClose $outf
 301     }
 302  }
 303
 304 proc Robot301 {url tourl} {
 305     global URL
 306
 307     puts "Redirecting from $url to $tourl"
 308
 309     set fromurl {}
 310     catch {
 311         set inf [RobotFileOpen unvisited $URL($url,host) $URL($url,path) r]
 312         set fromurl [gets $inf]
 313         RobotFileClose $inf
 314     }
 315     RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 316     if {![RobotFileExist bad $URL($url,host) $URL($url,path)]} {
 317         set outf [RobotFileOpen bad $URL($url,host) $URL($url,path)]
 318         puts $outf "URL=$url to $tourl 301"
 319         puts $outf "Reference $fromurl"
 320         RobotFileClose $outf
 321     }
 322     if {[RobotHref $url tourl host path]} {
 323         if {![RobotFileExist unvisited $host $path]} {
 324                 puts "Mark as unvisited"
 325             set outf [RobotFileOpen unvisited $host $path]
 326             puts $outf 301
 327             RobotFileClose $outf
 328         }
 329     }
 330 }
 331
 332 proc RobotTextHtml {url out} {
 333     global URL
 334
 335     set head 0
 336     htmlSwitch $URL($url,buf) \
 337         title {
 338             if {!$head} {
 339                 headSave $url $out
 340                 set head 1
 341             }
 342             puts $out "<title>$body</title>"
 343         } -nonest meta {
 344             if {!$head} {
 345                 headSave $url $out
 346                 set head 1
 347             }
 348             puts -nonewline $out "<meta"
 349             foreach a [array names parm] {
 350                 puts -nonewline $out " $a"
 351                 puts -nonewline $out {="}
 352                 puts -nonewline $out $parm($a)
 353                 puts -nonewline $out {"}
 354             }
 355             puts $out {></meta>}
 356         } body {
 357             regsub -all -nocase {<script.*</script>} $body {} abody
 358             regsub -all {<[^\>]+>} $abody {} nbody
 359             puts $out "<documentcontent>"
 360             puts $out $nbody
 361             puts $out "</documentcontent>"
 362         } a {
 363             if {![info exists parm(href)]} {
 364                 puts "no href"
 365                 continue
 366             }
 367             if {!$head} {
 368                 headSave $url $out
 369                 set head 1
 370             }
 371             if {1} {
 372                 set href $parm(href)
 373                 if {![RobotHref $url href host path]} continue
 374
 375                 puts $out "<cr>"
 376                 puts $out "<identifier>$href</identifier>"
 377                 puts $out "<description>$body</description>"
 378                 puts $out "</cr>"
 379
 380                 if {![RobotFileExist visited $host $path]} {
 381                     if {![RobotFileExist bad $host $path]} {
 382                         if {[catch {set outf [RobotFileOpen unvisited $host $path]} msg]} {
 383                             puts "--- Error $msg"
 384                             exit 1
 385                         }
 386                         puts $outf $url
 387                         RobotFileClose $outf
 388                     }
 389                 }
 390             }
 391         }
 392     if {!$head} {
 393         headSave $url $out
 394         set head 1
 395     }
 396     puts $out "</zmbot>"
 397 }
 398
 399 proc RobotTextPlain {url out} {
 400     global URL
 401
 402     headSave $url $out
 403     puts $out "<documentcontent>"
 404     puts $out $URL($url,buf)
 405     puts $out "</documentcontent>"
 406     puts $out "</meta>"
 407 }
 408
 409 proc Robot200 {url} {
 410     global URL domains
 411
 412     puts "Parsing $url"
 413     set out [RobotFileOpen visited $URL($url,host) $URL($url,path)]
 414     switch $URL($url,head,content-type) {
 415         text/html {
 416             RobotTextHtml $url $out
 417         }
 418         text/plain {
 419             RobotTextPlain $url $out
 420         }
 421         default {
 422             headSave $url $out
 423             puts $out "</zmbot>"
 424         }
 425     }
 426     RobotFileClose $out
 427     # puts "Parsing done"
 428     RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 429 }
 430
 431 proc RobotReadContent {url sock} {
 432     global URL
 433
 434     set buffer [read $sock 16384]
 435     set readCount [string length $buffer]
 436
 437     if {$readCount <= 0} {
 438         close $sock
 439         Robot200 $url
 440         RobotRestart
 441     } else {
 442         # puts "Got $readCount bytes"
 443         set URL($url,buf) $URL($url,buf)$buffer
 444     }
 445 }
 446
 447 proc RobotReadHeader {url sock} {
 448     global URL
 449
 450     set buffer [read $sock 2148]
 451     set readCount [string length $buffer]
 452
 453     if {$readCount <= 0} {
 454         Robot404 $url
 455         close $sock
 456         RobotRestart
 457     } else {
 458         # puts "Got $readCount bytes"
 459         set URL($url,buf) $URL($url,buf)$buffer
 460
 461         set n [string first \n\n $URL($url,buf)]
 462         if {$n > 1} {
 463             set code 0
 464             set version {}
 465             set headbuf [string range $URL($url,buf) 0 $n]
 466             incr n
 467             incr n
 468             set URL($url,buf) [string range $URL($url,buf) $n end]
 469
 470             regexp {^HTTP/([0-9.]+)[ ]+([0-9]+)} $headbuf x version code
 471             set lines [split $headbuf \n]
 472             foreach line $lines {
 473                 if {[regexp {^([^:]+):[ ]+(.*)} $line x name value]} {
 474                     set URL($url,head,[string tolower $name]) $value
 475                 }
 476             }
 477             puts "code = $code"
 478             set URL($url,state) skip
 479             switch $code {
 480                 301 {
 481                     Robot301 $url $URL($url,head,location)
 482                     close $sock
 483                     RobotRestart
 484                 }
 485                 302 {
 486                     Robot301 $url $URL($url,head,location)
 487                     close $sock
 488                     RobotRestart
 489                 }
 490                 404 {
 491                     Robot404 $url
 492                     close $sock
 493                     RobotRestart
 494                 }
 495                 401 {
 496                     Robot401 $url
 497                     close $sock
 498                     RobotRestart
 499                 }
 500                 200 {
 501                     if {![info exists URL($url,head,content-type)]} {
 502                         set URL($url,head,content-type) {}
 503                     }
 504                     switch $URL($url,head,content-type) {
 505                         text/html {
 506                             fileevent $sock readable [list RobotReadContent $url $sock]
 507                         }
 508                         text/plain {
 509                             fileevent $sock readable [list RobotReadContent $url $sock]
 510                         }
 511                         default {
 512                             close $sock
 513                             Robot200 $url
 514                             RobotRestart
 515                         }
 516                     }
 517                 }
 518                 default {
 519                     Robot404 $url
 520                     close $sock
 521                     RobotRestart
 522                 }
 523             }
 524         }
 525     }
 526 }
 527
 528 proc RobotConnect {url sock} {
 529     global URL agent
 530
 531     fconfigure $sock -translation {auto crlf} -blocking 0
 532     puts "Reading $url"
 533     fileevent $sock readable [list RobotReadHeader $url $sock]
 534     puts $sock "GET $URL($url,path) HTTP/1.0"
 535     puts $sock "Host: $URL($url,host)"
 536     puts $sock "User-Agent: $agent"
 537     puts $sock ""
 538     flush $sock
 539 }
 540
 541 proc RobotNop {} {
 542
 543 }
 544
 545 proc RobotGetUrl {url phost} {
 546     global URL
 547     puts "---------"
 548     puts $url
 549     if {![regexp {([^:]+)://([^/]+)([^ ]*)} $url x method hostport path]} {
 550         return -1
 551     }
 552     if {![regexp {([^:]+):([0-9]+)} $hostport x host port]} {
 553         set port 80
 554         set host $hostport
 555     }
 556     set URL($url,method) $method
 557     set URL($url,host) $host
 558     set URL($url,port) $port
 559     set URL($url,path) $path
 560     set URL($url,state) head
 561     set URL($url,buf) {}
 562     if [catch {set sock [socket -async $host $port]}] {
 563         return -1
 564     }
 565     RobotConnect $url $sock
 566
 567     return 0
 568 }
 569
 570 if {![llength [info commands htmlSwitch]]} {
 571     set e [info sharedlibextension]
 572     if {[catch {load ./tclrobot$e}]} {
 573         load tclrobot$e
 574     }
 575 }
 576
 577
 578 set agent "zmbot/0.0"
 579 if {![catch {set os [exec uname -s -r]}]} {
 580     set agent "$agent ($os)"
 581         puts "agent: $agent"
 582 }
 583
 584 proc bgerror {m} {
 585     puts "BGERROR $m"
 586 }
 587
 588 set robotMoreWork 0
 589 set robotSeq 0
 590 set workdir [pwd]
 591
 592 if {[llength $argv] < 2} {
 593     puts "Tclrobot: usage <domain> <start>"
 594     puts " Example: '*.indexdata.dk' http://www.indexdata.dk/"
 595     exit 1
 596 }
 597
 598 set domains [lindex $argv 0]
 599 set site [lindex $argv 1]
 600 if {[string length $site]} {
 601     set robotMoreWork 1
 602     if [RobotGetUrl $site {}] {
 603         set robotMoreWork 0
 604         puts "Couldn't process $site"
 605     }
 606 }
 607
 608 while {$robotMoreWork} {
 609     vwait robotMoreWork
 610 }