dcdot.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: dcdot.tcl,v 1.1 2000/12/07 20:16:11 adam Exp $
   3 #
   4
   5 proc RobotRestart {} {
   6     global robotMoreWork
   7
   8     set robotMoreWork 0
   9 }
  10
  11 proc RobotTextHtml {url} {
  12     global URL
  13
  14     set head 0
  15     htmlSwitch $URL($url,buf) \
  16         title {
  17             set URL($url,title) $body
  18         } -nonest meta {
  19             set scheme {}
  20             if {[info exist parm(scheme)]} {
  21                 set scheme $parm(scheme)
  22                 unset parm(scheme)
  23             }
  24             if {[info exist parm(name)]} {
  25                 if {[info exist parm(content)]} {
  26                     set URL($url,meta,$parm(name),$scheme) $parm(content)
  27                     unset parm(content)
  28                 }
  29                 unset parm(name)
  30             }
  31         } a {
  32             if {[info exists parm(href)]} {
  33                 lappend URL($url,links) $parm(href)
  34             }
  35         }
  36 }
  37
  38 proc Robot200 {url} {
  39     global URL domains
  40
  41     # puts "Parsing $url"
  42     switch $URL($url,head,content-type) {
  43         text/html {
  44             RobotTextHtml $url
  45         }
  46     }
  47     # puts "Parsing done"
  48 }
  49
  50 proc RobotReadContent {url sock} {
  51     global URL
  52
  53     set buffer [read $sock 16384]
  54     set readCount [string length $buffer]
  55
  56     if {$readCount <= 0} {
  57         close $sock
  58         Robot200 $url
  59         RobotRestart
  60     } else {
  61         # puts "Got $readCount bytes"
  62         set URL($url,buf) $URL($url,buf)$buffer
  63     }
  64 }
  65
  66 proc RobotReadHeader {url sock} {
  67     global URL
  68
  69     set buffer [read $sock 2148]
  70     set readCount [string length $buffer]
  71
  72     if {$readCount <= 0} {
  73         close $sock
  74         RobotRestart
  75     } else {
  76         # puts "Got $readCount bytes"
  77         set URL($url,buf) $URL($url,buf)$buffer
  78
  79         set n [string first \n\n $URL($url,buf)]
  80         if {$n > 1} {
  81             set code 0
  82             set version {}
  83             set headbuf [string range $URL($url,buf) 0 $n]
  84             incr n
  85             incr n
  86             set URL($url,buf) [string range $URL($url,buf) $n end]
  87
  88             regexp {^HTTP/([0-9.]+)[ ]+([0-9]+)} $headbuf x version code
  89             set lines [split $headbuf \n]
  90             foreach line $lines {
  91                 if {[regexp {^([^:]+):[ ]+(.*)} $line x name value]} {
  92                     set URL($url,head,[string tolower $name]) $value
  93                 }
  94             }
  95             set URL($url,state) skip
  96             switch $code {
  97                 200 {
  98                     if {![info exists URL($url,head,content-type)]} {
  99                         set URL($url,head,content-type) {}
 100                     }
 101                     switch $URL($url,head,content-type) {
 102                         text/html {
 103                             fileevent $sock readable [list RobotReadContent $url $sock]
 104                         }
 105                         text/plain {
 106                             fileevent $sock readable [list RobotReadContent $url $sock]
 107                         }
 108                         default {
 109                             close $sock
 110                             Robot200 $url
 111                             RobotRestart
 112                         }
 113                     }
 114                 }
 115                 default {
 116                     Robot404 $url
 117                     close $sock
 118                     RobotRestart
 119                 }
 120             }
 121         }
 122     }
 123 }
 124
 125 proc RobotConnect {url sock} {
 126     global URL agent
 127
 128     fconfigure $sock -translation {auto crlf} -blocking 0
 129     fileevent $sock readable [list RobotReadHeader $url $sock]
 130     puts $sock "GET $URL($url,path) HTTP/1.0"
 131     puts $sock "Host: $URL($url,host)"
 132     puts $sock "User-Agent: $agent"
 133     puts $sock ""
 134     flush $sock
 135 }
 136
 137 proc RobotGetUrl {url phost} {
 138     global URL
 139     if {![regexp {([^:]+)://([^/]+)([^ ]*)} $url x method hostport path]} {
 140         return -1
 141     }
 142     if {![regexp {([^:]+):([0-9]+)} $hostport x host port]} {
 143         set port 80
 144         set host $hostport
 145     }
 146     set URL($url,method) $method
 147     set URL($url,host) $host
 148     set URL($url,port) $port
 149     set URL($url,path) $path
 150     set URL($url,state) head
 151     set URL($url,buf) {}
 152     if [catch {set sock [socket -async $host $port]}] {
 153         return -1
 154     }
 155     RobotConnect $url $sock
 156
 157     return 0
 158 }
 159
 160 if {![llength [info commands htmlSwitch]]} {
 161     set e [info sharedlibextension]
 162     if {[catch {load ./tclrobot$e}]} {
 163         load tclrobot$e
 164     }
 165 }
 166
 167 set agent "zmbot/0.0"
 168 if {![catch {set os [exec uname -s -r]}]} {
 169     set agent "$agent ($os)"
 170 }
 171
 172 proc RobotGetDCDOT {url} {
 173     global robotMoreWork 1
 174
 175     set robotMoreWork 1
 176     if [RobotGetUrl $url {}] {
 177         set robotMoreWork 0
 178     }
 179
 180     while {$robotMoreWork} {
 181         vwait robotMoreWork
 182     }
 183 }
 184
 185 if {$argc == 1} {
 186     set url [lindex $argv 0]
 187     RobotGetDCDOT $url
 188     set mask {,meta,[Dd][Cc]\.*}
 189     foreach a [array names URL $url$mask] {
 190         puts "URL($a) = $URL($a)"
 191     }
 192 }