robot.tcl

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