robot.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: robot.tcl,v 1.5 1999/12/27 11:49:31 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         if {[file isdirectory $n]} {
  19             set sb [RobotFileNext $n]
  20             if {[string length $sb]} {
  21                 return $sb
  22             }
  23         }
  24     }
  25     return {}
  26 }
  27
  28 proc RobotFileExist {area host path} {
  29     set comp [split $area/$host$path /]
  30     set l [llength $comp]
  31     incr l -1
  32     if {![string length [lindex $comp $l]]} {
  33         set comp [split $area/$host$path:.html /]
  34     } elseif {[file exists [join $comp /]]} {
  35         return 1
  36     } else {
  37         set comp [split $area/$host$path/:.html /]
  38     }
  39     return [file exists [join $comp /]]
  40 }
  41
  42 proc RobotFileUnlink {area host path} {
  43     set comp [split $area/$host$path /]
  44     set l [llength $comp]
  45     incr l -1
  46     if {![string length [lindex $comp $l]]} {
  47         set comp [split $area/$host$path:.html /]
  48     }
  49     if {[catch {exec rm [join $comp /]}]} return
  50     incr l -1
  51     for {set i $l} {$i > 0} {incr i -1} {
  52         set path [join [lrange $comp 0 $i] /]
  53         if {![catch {glob $path/*}]} return
  54         exec rmdir ./$path
  55     }
  56 }
  57
  58 proc RobotFileOpen {area host path} {
  59     set orgPwd [pwd]
  60     global workdir
  61
  62     #puts "RobotFileOpen orgPwd=$orgPwd area=$area host=$host path=$path"
  63     if {[string compare $orgPwd $workdir]} {
  64         puts "workdir = $workdir"
  65         puts "pwd = $orgPwd"
  66         exit 1
  67     }
  68     set comp [split $area/$host$path /]
  69     set len [llength $comp]
  70     incr len -1
  71     for {set i 0} {$i < $len} {incr i} {
  72         set d [lindex $comp $i]
  73         if {[catch {cd ./$d}]} {
  74             exec mkdir $d
  75             cd ./$d
  76         }
  77     }
  78     set d [lindex $comp $len]
  79     if {[string length $d]} {
  80         set out [open $d w]
  81     } else {
  82         set out [open :.html w]
  83     }
  84     cd $orgPwd
  85     #puts "RobotFileStop"
  86     return $out
  87 }
  88
  89 proc RobotRestart {} {
  90     global URL
  91
  92     while {1} {
  93         set url [RobotFileNext unvisited]
  94         if {![string length $url]} {
  95             puts "No more unvisited"
  96             break
  97         }
  98         set r [RobotGetUrl $url {}]
  99         if {!$r} {
 100             puts "RobotGetUrl returned 0 on url=$url"
 101             return
 102         } else {
 103             RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 104         }
 105     }
 106     exit 0
 107 }
 108
 109 proc headSave {url out title} {
 110     global URL
 111
 112     puts $out {<meta>}
 113     puts $out "<title>$title</title>"
 114     if {[info exists URL($url,head,last-modified)]} {
 115         puts $out "<lastmodified>$URL($url,head,last-modified)</lastmodified>"
 116     }
 117     puts $out {<si>}
 118     if {[info exists URL($url,head,date)]} {
 119         puts $out " <date>$URL($url,head,date)</date>"
 120     }
 121     if {[info exists URL($url,head,content-length)]} {
 122         puts $out " <by>$URL($url,head,content-length)</by>"
 123     }
 124     if {[info exists URL($url,head,server)]} {
 125         puts $out " <format>$URL($url,head,server)</format>"
 126     }
 127     puts $out {</si>}
 128     puts $out {<publisher>}
 129     puts $out " <identifier>$url</identifier>"
 130     if {[info exists URL($url,head,content-type)]} {
 131         puts $out " <type>$URL($url,head,content-type)</type>"
 132     }
 133     puts $out {</publisher>}
 134 }
 135
 136 proc RobotHref {url hrefx hostx pathx} {
 137     global URL domains
 138     upvar $hrefx href
 139     upvar $hostx host
 140     upvar $pathx path
 141
 142     # puts "Ref url = $url href=$href"
 143     # get method (if any)
 144     if {![regexp {^([^/:]+):(.*)} $href x method hpath]} {
 145         set hpath $href
 146         set method http
 147     } else {
 148         if {[string compare $method http]} {
 149             return 0
 150         }
 151     }
 152     # get host (if any)
 153     if {![regexp {^//([^/]+)(.*)} $hpath x host epath]} {
 154         set epath $hpath
 155         set host $URL($url,host)
 156     } else {
 157         if {![string length $epath]} {
 158             set epath /
 159         }
 160         set ok 0
 161         foreach domain $domains {
 162             if {[string match $domain $host]} {
 163                 set ok 1
 164                 break
 165             }
 166         }
 167         if {!$ok} {
 168             return 0
 169         }
 170     }
 171     if {[regexp {^(\#|\?)} $epath]} {
 172         # within page
 173         return 0
 174     } elseif {![regexp {^([/][^\#?]*)} $epath x path]} {
 175         # relative path
 176         set ext [file extension $URL($url,path)]
 177         if {[string compare $ext {}]} {
 178             set dpart [file dirname $URL($url,path)]
 179         } else {
 180             set dpart $URL($url,path)
 181         }
 182         regexp {^([^\#?]+)} $epath x path
 183         set path [string trimright $dpart /]/$path
 184     }
 185     set c [split $path /]
 186     set i [llength $c]
 187     incr i -1
 188     set path [lindex $c $i]
 189     incr i -1
 190     while {$i >= 0} {
 191         switch -- [lindex $c $i] {
 192             .. {
 193                 incr i -2
 194             }
 195             . {
 196                 incr i -1
 197             }
 198             default {
 199                 set path [lindex $c $i]/$path
 200                 incr i -1
 201             }
 202         }
 203     }
 204     set href "$method://$host$path"
 205     # puts "Ref href = $href"
 206     return 1
 207 }
 208
 209 proc Robot401 {url} {
 210     global URL
 211
 212     puts "Bad link $url"
 213     RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 214     if {![RobotFileExist forbidden $URL($url,host) $URL($url,path)]} {
 215         set outf [RobotFileOpen forbidden $URL($url,host) $URL($url,path)]
 216         close $outf
 217     }
 218 }
 219
 220 proc Robot404 {url} {
 221     global URL
 222
 223     puts "Bad link $url"
 224     RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 225     if {![RobotFileExist bad $URL($url,host) $URL($url,path)]} {
 226         set outf [RobotFileOpen bad $URL($url,host) $URL($url,path)]
 227         close $outf
 228     }
 229 }
 230
 231 proc Robot301 {url tourl} {
 232     global URL
 233
 234     puts "Redirecting from $url to $tourl"
 235     RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 236     if {[RobotHref $url tourl host path]} {
 237         if {![RobotFileExist unvisited $host $path]} {
 238             set outf [RobotFileOpen unvisited $host $path]
 239             close $outf
 240         }
 241     }
 242 }
 243
 244 proc Robot200 {url} {
 245     global URL domains
 246
 247     # puts "Parsing $url"
 248     set out [RobotFileOpen visited $URL($url,host) $URL($url,path)]
 249     set ti 0
 250     if {[info exists URL($url,buf)]} {
 251         set htmlContent $URL($url,buf)
 252
 253         htmlSwitch $htmlContent \
 254         title {
 255             if {!$ti} {
 256                 headSave $url $out $body
 257                 set ti 1
 258             }
 259         } body {
 260             regsub -all -nocase {<script.*</script>} $body {} abody
 261             regsub -all {<[^\>]+>} $abody {} nbody
 262             puts $out "<documentcontent>"
 263             puts $out $nbody
 264             puts $out "</documentcontent>"
 265         } a {
 266             if {![info exists parm(href)]} {
 267                 puts "no href"
 268                 continue
 269             }
 270             if {!$ti} {
 271                 headSave $url $out "untitled"
 272                 set ti 1
 273             }
 274             if {1} {
 275                 set href $parm(href)
 276                 if {![RobotHref $url href host path]} continue
 277
 278                 puts $out "<cr>"
 279                 puts $out "<identifier>$href</identifier>"
 280                 puts $out "<description>$body</description>"
 281                 puts $out "</cr>"
 282
 283                 if {![RobotFileExist visited $host $path]} {
 284                     if {[catch {set outf [RobotFileOpen unvisited $host $path]} msg]} {
 285                         puts "--- Error $msg"
 286                         exit 1
 287                     }
 288                     close $outf
 289                 }
 290             }
 291         }
 292     }
 293     if {!$ti} {
 294         headSave $url $out "untitled"
 295         set ti 1
 296     }
 297     puts $out "</meta>"
 298     close $out
 299     # puts "Parsing done"
 300     RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 301 }
 302
 303 proc RobotReadBody {url sock} {
 304     global URL
 305
 306     set buffer [read $sock 16384]
 307     set readCount [string length $buffer]
 308
 309     if {$readCount <= 0} {
 310         close $sock
 311         Robot200 $url
 312         RobotRestart
 313     } else {
 314         # puts "Got $readCount bytes"
 315         set URL($url,buf) $URL($url,buf)$buffer
 316     }
 317 }
 318
 319 proc RobotReadHead {url sock} {
 320     global URL
 321
 322     set buffer [read $sock 8192]
 323     set readCount [string length $buffer]
 324
 325     if {$readCount <= 0} {
 326         Robot404 $url
 327         close $sock
 328         RobotRestart
 329     } else {
 330         # puts "Got $readCount bytes"
 331         set URL($url,buf) $URL($url,buf)$buffer
 332
 333         set n [string first \n\n $URL($url,buf)]
 334         if {$n > 1} {
 335             set code 0
 336             set version {}
 337             set headbuf [string range $URL($url,buf) 0 $n]
 338             incr n
 339             incr n
 340             set URL($url,buf) [string range $URL($url,buf) $n end]
 341
 342             regexp {^HTTP/([0-9.]+)[ ]+([0-9]+)} $headbuf x version code
 343             set lines [split $headbuf \n]
 344             foreach line $lines {
 345                 if {[regexp {^([^:]+):[ ]+(.*)} $line x name value]} {
 346                     set URL($url,head,[string tolower $name]) $value
 347                 }
 348             }
 349             puts "code = $code"
 350             set URL($url,state) skip
 351             switch $code {
 352                 301 {
 353                     Robot301 $url $URL($url,head,location)
 354                     close $sock
 355                     RobotRestart
 356                 }
 357                 302 {
 358                     Robot301 $url $URL($url,head,location)
 359                     close $sock
 360                     RobotRestart
 361                 }
 362                 404 {
 363                     Robot404 $url
 364                     close $sock
 365                     RobotRestart
 366                 }
 367                 401 {
 368                     Robot401 $url
 369                     close $sock
 370                     RobotRestart
 371                 }
 372                 200 {
 373                     if {[info exists URL($url,head,content-type)]} {
 374                         if {![string compare $URL($url,head,content-type) text/html]} {
 375                             set URL($url,state) html
 376                         }
 377                     }
 378                     if {[string compare $URL($url,state) html]} {
 379                         close $sock
 380                         Robot200 $url
 381                         RobotRestart
 382                     } else {
 383                         fileevent $sock readable [list RobotReadBody $url $sock]
 384                     }
 385                 }
 386                 default {
 387                     Robot404 $url
 388                     close $sock
 389                     RobotRestart
 390                 }
 391             }
 392         }
 393     }
 394 }
 395
 396 proc RobotConnect {url sock} {
 397     global URL
 398
 399     fconfigure $sock -translation {auto crlf} -blocking 0
 400     puts "Reading $url"
 401     fileevent $sock readable [list RobotReadHead $url $sock]
 402     puts $sock "GET $URL($url,path) HTTP/1.0"
 403     puts $sock "Host: $URL($url,host)"
 404     puts $sock ""
 405     flush $sock
 406 }
 407
 408 proc RobotNop {} {
 409
 410 }
 411
 412 proc RobotGetUrl {url phost} {
 413     global URL
 414     puts "---------"
 415     puts $url
 416     if {![regexp {([^:]+)://([^/]+)([^ ]*)} $url x method hostport path]} {
 417         return -1
 418     }
 419     if {![regexp {([^:]+):([0-9]+)} $hostport x host port]} {
 420         set port 80
 421         set host $hostport
 422     }
 423     set URL($url,method) $method
 424     set URL($url,host) $host
 425     set URL($url,port) $port
 426     set URL($url,path) $path
 427     set URL($url,state) head
 428     set URL($url,buf) {}
 429     if [catch {set sock [socket -async $host $port]}] {
 430         return -1
 431     }
 432     RobotConnect $url $sock
 433
 434     return 0
 435 }
 436
 437 if {![llength [info commands htmlSwitch]]} {
 438     set e [info sharedlibextension]
 439     if {[catch {load ./tclrobot$e}]} {
 440         load tclrobot$e
 441     }
 442 }
 443
 444 if {[llength $argv] < 2} {
 445     puts "Tclrobot: usage <domain> <start>"
 446     puts " Example: '*.dk' www.indexdata.dk"
 447     exit 1
 448 }
 449
 450 set workdir [pwd]
 451
 452 set domains [lindex $argv 0]
 453 set site [lindex $argv 1]
 454 if {[string length $site]} {
 455     set x [RobotFileOpen unvisited $site /]
 456     close $x
 457 }
 458
 459
 460 RobotRestart
 461 vwait forever