robot.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: robot.tcl,v 1.3 1998/10/15 13:27:19 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     foreach n $ns {
  11         if {[file isfile $n]} {
  12             if {[string first :.html $n] > 0} {
  13                 return http://[string range $area/ $off end]
  14             }
  15             return http://[string range $n $off end]
  16         }
  17         if {[file isdirectory $n]} {
  18             set sb [RobotFileNext $n]
  19             if {[string length $sb]} {
  20                 return $sb
  21             }
  22         }
  23     }
  24     return {}
  25 }
  26
  27 proc RobotFileExist {area host path} {
  28     set comp [split $area/$host$path /]
  29     set l [llength $comp]
  30     incr l -1
  31     if {![string length [lindex $comp $l]]} {
  32         set comp [split $area/$host$path:.html /]
  33     }
  34     return [file exists [join $comp /]]
  35 }
  36
  37 proc RobotFileUnlink {area host path} {
  38     set comp [split $area/$host$path /]
  39     set l [llength $comp]
  40     incr l -1
  41     if {![string length [lindex $comp $l]]} {
  42         set comp [split $area/$host$path:.html /]
  43     }
  44     if {[catch {exec rm [join $comp /]}]} return
  45     incr l -1
  46     for {set i $l} {$i > 0} {incr i -1} {
  47         set path [join [lrange $comp 0 $i] /]
  48         if {![catch {glob $path/*}]} return
  49         exec rmdir ./$path
  50     }
  51 }
  52
  53 proc RobotFileOpen {area host path} {
  54     set orgPwd [pwd]
  55
  56     set comp [split $area/$host$path /]
  57     set len [llength $comp]
  58     incr len -1
  59     for {set i 0} {$i < $len} {incr i} {
  60         set d [lindex $comp $i]
  61         if {[catch {cd ./$d}]} {
  62             exec mkdir $d
  63             cd ./$d
  64         }
  65     }
  66     set d [lindex $comp $len]
  67     if {[string length $d]} {
  68         set out [open $d w]
  69     } else {
  70         set out [open :.html w]
  71     }
  72     cd $orgPwd
  73     return $out
  74 }
  75
  76 proc RobotRestart {} {
  77     global URL
  78
  79     while {1} {
  80         set url [RobotFileNext unvisited]
  81         if {![string length $url]} break
  82         set r [RobotGetUrl $url {}]
  83         if {!$r} {
  84             return
  85         } else {
  86             RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
  87         }
  88     }
  89     exit 0
  90 }
  91
  92 proc headSave {url out title} {
  93     global URL
  94
  95     puts $out {<nwi>}
  96     puts $out "<ti> $title"
  97     if {[info exists URL($url,head,Last-modified)]} {
  98         puts $out "<dm> $URL($url,head,Last-modified)"
  99     }
 100     puts $out {<si>}
 101     if {[info exists URL($url,head,Date)]} {
 102         puts $out " <lc> $URL($url,head,Date)"
 103     }
 104     if {[info exists URL($url,head,Content-length)]} {
 105         puts $out " <by> $URL($url,head,Content-length)"
 106     }
 107     if {[info exists URL($url,head,Server)]} {
 108         puts $out " <srvr> $URL($url,head,Server)"
 109     }
 110     puts $out {</si>}
 111     puts $out {<av>}
 112     puts $out " <avli> $url"
 113     if {[info exists URL($url,head,Content-type)]} {
 114         puts $out " <ty> $URL($url,head,Content-type)"
 115     }
 116     puts $out {</av>}
 117 }
 118
 119 proc RobotSave {url} {
 120     global URL
 121     global domains
 122
 123     set out [RobotFileOpen visited $URL($url,host) $URL($url,path)]
 124     set ti 0
 125     if {[info exists URL($url,line)]} {
 126         set htmlContent [join $URL($url,line) \n]
 127
 128         htmlSwitch $htmlContent \
 129         title {
 130             if {!$ti} {
 131                 headSave $url $out $body
 132                 set ti 1
 133             }
 134         } body {
 135             regsub -all -nocase {<script.*</script>} $body {} abody
 136             regsub -all {<[^\>]+>} $abody {} nbody
 137             puts $out "<body>"
 138             puts $out $nbody
 139             puts $out "</body>"
 140         } a {
 141             if {![info exists parm(href)]} {
 142                 puts "no href"
 143                 continue
 144             }
 145             if {!$ti} {
 146                 headSave $url $out "untitled"
 147                 set ti 1
 148             }
 149
 150             if {[regexp {^\#} $parm(href)]} {
 151                 continue
 152             } elseif {[regexp {^([^:]+):([^#]+)} $parm(href) x method hpath]} {
 153                 set ok 0
 154                 if {![string compare $method http]} {
 155                     if {![regexp {^//([^/]+)(.*)} $hpath x host path]} {
 156                         set host $URL($url,host)
 157                         set path $hpath
 158                     }
 159                     foreach domain $domains {
 160                         if {[string match $domain $host]} {
 161                             set ok 1
 162                             break
 163                         }
 164                     }
 165                 }
 166                 if {!$ok} continue
 167             } elseif {[regexp {^([/~][^#]*)} $parm(href) x path]} {
 168                 set host $URL($url,host)
 169                 set method http
 170             } else {
 171                 set ext [file extension $URL($url,path)]
 172                 if {[string compare $ext {}]} {
 173                     set dpart [file dirname $URL($url,path)]
 174                 } else {
 175                     set dpart $URL($url,path)
 176                 }
 177                 regexp {^([^#]+)} $parm(href) x path
 178                 set host $URL($url,host)
 179                 set path [string trimright $dpart /]/$path
 180                 set method http
 181             }
 182             set ext [file extension $path]
 183             if {![string length $ext]} {
 184                 set path [string trimright $path /]/
 185             } else {
 186                 set path [string trimright $path /]
 187             }
 188             set c [split $path /]
 189             set i [llength $c]
 190             incr i -1
 191             set path [lindex $c $i]
 192             incr i -1
 193             while {$i >= 0} {
 194                 switch -- [lindex $c $i] {
 195                     .. {
 196                         incr i -2
 197                     }
 198                     . {
 199                         incr i -1
 200                     }
 201                     default {
 202                         set path [lindex $c $i]/$path
 203                         incr i -1
 204                     }
 205                 }
 206             }
 207             set href "$method://$host$path"
 208
 209             puts $out "<cr>"
 210             puts $out "<li> $href"
 211             puts $out "<cp> $body"
 212             puts $out "</cr>"
 213
 214             if {![regexp {/.*bin/} $href)]} {
 215                 if {![RobotFileExist visited $host $path]} {
 216                     set outf [RobotFileOpen unvisited $host $path]
 217                     close $outf
 218                 }
 219             }
 220         }
 221     }
 222     if {!$ti} {
 223         headSave $url $out "untitled"
 224         set ti 1
 225     }
 226     puts $out "</nwi>"
 227     close $out
 228     RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 229 }
 230
 231 proc RobotRead {url sock} {
 232     global URL
 233
 234     set readCount [gets $sock line]
 235     if {$readCount < 0} {
 236         if [eof $sock] {
 237             close $sock
 238             RobotSave $url
 239             RobotRestart
 240         }
 241     } elseif {$readCount > 0} {
 242         switch $URL($url,state) {
 243             head {
 244                 puts "head: $line"
 245                 if {[regexp {([^:]+):[ ]+(.*)} $line x name value]} {
 246                     set URL($url,head,$name) $value
 247                 }
 248             }
 249             html {
 250                 lappend URL($url,line) $line
 251 #                puts "body: $line"
 252             }
 253             skip {
 254                 close $sock
 255                 RobotSave $url
 256                 RobotRestart
 257             }
 258         }
 259     } else {
 260         set URL($url,state) html
 261         if {[info exists URL($url,head,Content-type)]} {
 262             if {![string compare $URL($url,head,Content-type) text/html]} {
 263                 set URL($url,state) html
 264             }
 265         }
 266     }
 267 }
 268
 269 proc RobotConnect {url sock} {
 270     global URL
 271
 272     fileevent $sock readable [list RobotRead $url $sock]
 273     puts $sock "GET $URL($url,path) HTTP/1.0"
 274     puts $sock ""
 275     flush $sock
 276 }
 277
 278 proc RobotNop {} {
 279
 280 }
 281
 282 proc RobotGetUrl {url phost} {
 283     global URL
 284     set port 80
 285     puts "---------"
 286     puts $url
 287     if {[regexp {([^:]+)://([^/]+)([^ ]*)} $url x method host path]} {
 288         puts "method=$method host=$host path=$path"
 289     } else {
 290         return -1
 291     }
 292     set URL($url,method) $method
 293     set URL($url,host) $host
 294     set URL($url,port) $port
 295     set URL($url,path) $path
 296     set URL($url,state) head
 297     if [catch {set sock [socket -async $host $port]}] {
 298         return -1
 299     }
 300     fconfigure $sock -translation {auto crlf}
 301     RobotConnect $url $sock
 302
 303     return 0
 304 }
 305
 306 if {![llength [info commands htmlSwitch]]} {
 307     set e [info sharedlibextension]
 308     if {[catch {load ./tclrobot$e}]} {
 309         load tclrobot$e
 310     }
 311 }
 312
 313 if {[llength $argv] < 2} {
 314     puts "Tclrobot: usage <domain> <start>"
 315     exit 1
 316 }
 317 set domains [lindex $argv 0]
 318 set site [lindex $argv 1]
 319 if {[string length $site]} {
 320     set x [RobotFileOpen unvisited $site /]
 321     close $x
 322 }
 323
 324 RobotRestart
 325 vwait forever
 326