robot.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: robot.tcl,v 1.4 1999/02/04 20:37:25 perhans 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 {<meta>}
  96     puts $out "<title>$title</title>"
  97     if {[info exists URL($url,head,last-modified)]} {
  98         puts $out "<lastmodified>$URL($url,head,last-modified)</lastmodified>"
  99     }
 100     puts $out {<si>}
 101     if {[info exists URL($url,head,date)]} {
 102         puts $out " <date>$URL($url,head,date)</date>"
 103     }
 104     if {[info exists URL($url,head,content-length)]} {
 105         puts $out " <by>$URL($url,head,content-length)</by>"
 106     }
 107     if {[info exists URL($url,head,server)]} {
 108         puts $out " <format>$URL($url,head,server)</format>"
 109     }
 110     puts $out {</si>}
 111     puts $out {<publisher>}
 112     puts $out " <identifier>$url</identifier>"
 113     if {[info exists URL($url,head,content-type)]} {
 114         puts $out " <type>$URL($url,head,content-type)</type>"
 115     }
 116     puts $out {</publisher>}
 117 }
 118
 119 proc RobotSave {url} {
 120     global URL domains
 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 "<documentcontent>"
 137             puts $out $nbody
 138             puts $out "</documentcontent>"
 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                 set ok 0
 153                 if {![string compare $method http]} {
 154                     if {![regexp {^//([^/]+)(.*)} $hpath x host path]} {
 155                         set host $URL($url,host)
 156                         set path $hpath
 157                     }
 158                     foreach domain $domains {
 159                         if {[string match $domain $host]} {
 160                             set ok 1
 161                             break
 162                         }
 163                     }
 164                 }
 165                 if {!$ok} continue
 166             } elseif {[regexp {^([/~][^#]*)} $parm(href) x path]} {
 167                 set host $URL($url,host)
 168                 set method http
 169             } else {
 170                 set ext [file extension $URL($url,path)]
 171                 if {[string compare $ext {}]} {
 172                     set dpart [file dirname $URL($url,path)]
 173                 } else {
 174                     set dpart $URL($url,path)
 175                 }
 176                 regexp {^([^#]+)} $parm(href) x path
 177                 set host $URL($url,host)
 178                 set path [string trimright $dpart /]/$path
 179                 set method http
 180             }
 181             set ext [file extension $path]
 182             if {![string length $ext]} {
 183                 set path [string trimright $path /]/
 184             } else {
 185                 set path [string trimright $path /]
 186             }
 187             set c [split $path /]
 188             set i [llength $c]
 189             incr i -1
 190             set path [lindex $c $i]
 191             incr i -1
 192             while {$i >= 0} {
 193                 switch -- [lindex $c $i] {
 194                 .. {
 195                     incr i -2
 196                 }
 197                 . {
 198                     incr i -1
 199                 }
 200                 default {
 201                     set path [lindex $c $i]/$path
 202                     incr i -1
 203                 }
 204             }
 205         }
 206         set href "$method://$host$path"
 207
 208         puts $out "<cr>"
 209             puts $out "<identifier>$href</identifier>"
 210             puts $out "<description>$body</description>"
 211             puts $out "</cr>"
 212
 213             if {![regexp {/.*bin/} $href)]} {
 214                 if {![RobotFileExist visited $host $path]} {
 215                     set outf [RobotFileOpen unvisited $host $path]
 216                     close $outf
 217                 }
 218             }
 219         }
 220     }
 221     if {!$ti} {
 222         headSave $url $out "untitled"
 223         set ti 1
 224     }
 225     puts $out "</meta>"
 226     close $out
 227     RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
 228 }
 229
 230 proc RobotRead {url sock} {
 231     global URL
 232
 233     set readCount [gets $sock line]
 234     if {$readCount < 0} {
 235         if [eof $sock] {
 236             close $sock
 237             RobotSave $url
 238             RobotRestart
 239         }
 240     } elseif {$readCount > 0} {
 241         switch $URL($url,state) {
 242             head {
 243                 puts "head: $line"
 244                 if {[regexp {([^:]+):[ ]+(.*)} $line x name value]} {
 245                     set URL($url,head,[string tolower $name]) $value
 246                 }
 247             }
 248             html {
 249                 lappend URL($url,line) $line
 250             }
 251             skip {
 252                 close $sock
 253                 RobotSave $url
 254                 RobotRestart
 255             }
 256         }
 257     } else {
 258         set URL($url,state) html
 259         if {[info exists URL($url,head,content-type)]} {
 260             if {![string compare $URL($url,head,content-type) text/html]} {
 261                 set URL($url,state) html
 262             }
 263         }
 264     }
 265 }
 266
 267 proc RobotConnect {url sock} {
 268     global URL
 269
 270     fileevent $sock readable [list RobotRead $url $sock]
 271     puts $sock "GET $URL($url,path) HTTP/1.0"
 272     puts $sock ""
 273     flush $sock
 274 }
 275
 276 proc RobotNop {} {
 277
 278 }
 279
 280 proc RobotGetUrl {url phost} {
 281     global URL
 282     set port 80
 283     puts "---------"
 284     puts $url
 285     if {[regexp {([^:]+)://([^/]+)([^ ]*)} $url x method host path]} {
 286         puts "method=$method host=$host path=$path"
 287     } else {
 288         return -1
 289     }
 290     set URL($url,method) $method
 291     set URL($url,host) $host
 292     set URL($url,port) $port
 293     set URL($url,path) $path
 294     set URL($url,state) head
 295     if [catch {set sock [socket -async $host $port]}] {
 296         return -1
 297     }
 298     fconfigure $sock -translation {auto crlf}
 299     RobotConnect $url $sock
 300
 301     return 0
 302 }
 303
 304 if {![llength [info commands htmlSwitch]]} {
 305     set e [info sharedlibextension]
 306     if {[catch {load ./tclrobot$e}]} {
 307                 load tclrobot$e
 308     }
 309 }
 310
 311 if {[llength $argv] < 2} {
 312     puts "Tclrobot: usage <domain> <start>"
 313     puts " Example: '*.dk' www.indexdata.dk"
 314     exit 1
 315 }
 316 set domains [lindex $argv 0]
 317 set site [lindex $argv 1]
 318 if {[string length $site]} {
 319     set x [RobotFileOpen unvisited $site /]
 320     close $x
 321 }
 322
 323 RobotRestart
 324 vwait forever