robot.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: robot.tcl,v 1.2 1998/10/15 12:31:03 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
 122     set out [RobotFileOpen visited $URL($url,host) $URL($url,path)]
 123     set ti 0
 124     if {[info exists URL($url,line)]} {
 125         set htmlContent [join $URL($url,line) \n]
 126
 127         htmlSwitch $htmlContent \
 128         title {
 129             if {!$ti} {
 130                 headSave $url $out $body
 131                 set ti 1
 132             }
 133         } body {
 134             regsub -all -nocase {<script.*</script>} $body {} abody
 135             regsub -all {<[^\>]+>} $abody {} nbody
 136             puts $out "<body>"
 137             puts $out $nbody
 138             puts $out "</body>"
 139         } a {
 140             if {![info exists parm(href)]} {
 141                 puts "no href"
 142                 continue
 143             }
 144             if {!$ti} {
 145                 headSave $url $out "untitled"
 146                 set ti 1
 147             }
 148
 149             if {[regexp {^\#} $parm(href)]} {
 150                 continue
 151             } elseif {[regexp {^([^:]+):([^#]+)} $parm(href) x method hpath]} {
 152                 if {![string compare $method http]} {
 153                     if {![regexp {^//([^/]+)(.*)} $hpath x host path]} {
 154                         set host $URL($url,host)
 155                         set path $hpath
 156                     }
 157                     if {![regexp {\.indexdata\.dk$} $host]} continue
 158                 } else {
 159                     continue
 160                 }
 161             } elseif {[regexp {^([/~][^#]*)} $parm(href) x path]} {
 162                 set host $URL($url,host)
 163                 set method http
 164             } else {
 165                 set ext [file extension $URL($url,path)]
 166                 if {[string compare $ext {}]} {
 167                     set dpart [file dirname $URL($url,path)]
 168                 } else {
 169                     set dpart $URL($url,path)
 170                 }
 171                 regexp {^([^#]+)} $parm(href) x path
 172                 set host $URL($url,host)
 173                 set path [string trimright $dpart /]/$path
 174                 set method http
 175             }
 176             set ext [file extension $path]
 177             if {![string length $ext]} {
 178                 set path [string trimright $path /]/
 179             } else {
 180                 set path [string trimright $path /]
 181             }
 182             set c [split $path /]
 183             set i [llength $c]
 184             incr i -1
 185             set path [lindex $c $i]
 186             incr i -1
 187             while {$i >= 0} {
 188                 switch -- [lindex $c $i] {
 189                     .. {
 190                         incr i -2
 191                     }
 192                     . {
 193                         incr i -1
 194                     }
 195                     default {
 196                         set path [lindex $c $i]/$path
 197                         incr i -1
 198                     }
 199                 }
 200             }
 201             set href "$method://$host$path"
 202
 203             puts $out "<cr>"
 204             puts $out "<li> $href"
 205             puts $out "<cp> $body"
 206             puts $out "</cr>"
 207
 208             if {![regexp {/.*bin/} $href)]} {
 209                 if {![RobotFileExist visited $host $path]} {
 210                     set outf [RobotFileOpen unvisited $host $path]
 211                     close $outf
 212                 }
 213             }
 214         }
 215     }
 216     if {!$ti} {
 217         headSave $url $out "untitled"
 218         set ti 1
 219     }
 220     puts $out "</nwi>"
 221     close $out
 222     RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 223 }
 224
 225 proc RobotRead {url sock} {
 226     global URL
 227
 228     set readCount [gets $sock line]
 229     if {$readCount < 0} {
 230         if [eof $sock] {
 231             close $sock
 232             RobotSave $url
 233             RobotRestart
 234         }
 235     } elseif {$readCount > 0} {
 236         switch $URL($url,state) {
 237             head {
 238                 puts "head: $line"
 239                 if {[regexp {([^:]+):[ ]+(.*)} $line x name value]} {
 240                     set URL($url,head,$name) $value
 241                 }
 242             }
 243             html {
 244                 lappend URL($url,line) $line
 245 #                puts "body: $line"
 246             }
 247             skip {
 248                 close $sock
 249                 RobotSave $url
 250                 RobotRestart
 251             }
 252         }
 253     } else {
 254         set URL($url,state) html
 255         if {[info exists URL($url,head,Content-type)]} {
 256             if {![string compare $URL($url,head,Content-type) text/html]} {
 257                 set URL($url,state) html
 258             }
 259         }
 260     }
 261 }
 262
 263 proc RobotConnect {url sock} {
 264     global URL
 265
 266     fileevent $sock readable [list RobotRead $url $sock]
 267     puts $sock "GET $URL($url,path) HTTP/1.0"
 268     puts $sock ""
 269     flush $sock
 270 }
 271
 272 proc RobotNop {} {
 273
 274 }
 275
 276 proc RobotGetUrl {url phost} {
 277     global URL
 278     set port 80
 279     puts "---------"
 280     puts $url
 281     if {[regexp {([^:]+)://([^/]+)([^ ?]*)} $url x method host path]} {
 282         puts "method=$method host=$host path=$path"
 283     } else {
 284         return -1
 285     }
 286     set URL($url,method) $method
 287     set URL($url,host) $host
 288     set URL($url,port) $port
 289     set URL($url,path) $path
 290     set URL($url,state) head
 291     if [catch {set sock [socket -async $host $port]}] {
 292         return -1
 293     }
 294     fconfigure $sock -translation {auto crlf}
 295     RobotConnect $url $sock
 296
 297     return 0
 298 }
 299
 300 if {![llength [info commands htmlSwitch]]} {
 301     set e [info sharedlibextension]
 302     if {[catch {load ./tclrobot$e}]} {
 303         load tclrobot$e
 304     }
 305 }
 306
 307 if {![llength $argv]} {
 308     puts "Tclrobot: specify one or more sites."
 309     exit 1
 310 }
 311 foreach site $argv {
 312     set x [RobotFileOpen unvisited $site /]
 313     close $x
 314 }
 315 RobotRestart
 316 vwait forever
 317