dcdot.tcl

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