robot.tcl

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