dcdot.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: dcdot.tcl,v 1.2 2000/12/08 08:55:35 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                     Robot404 $url
 103                     close $sock
 104                     RobotRestart
 105                 }
 106             }
 107         }
 108     }
 109 }
 110
 111 proc RobotConnect {url sock} {
 112     global URL agent
 113
 114     fconfigure $sock -translation {auto crlf} -blocking 0
 115     fileevent $sock readable [list RobotReadHeader $url $sock]
 116     puts $sock "GET $URL($url,path) HTTP/1.0"
 117     puts $sock "Host: $URL($url,host)"
 118     puts $sock "User-Agent: $agent"
 119     puts $sock ""
 120     flush $sock
 121 }
 122
 123 proc RobotGetUrl {url phost} {
 124     global URL
 125     if {![regexp {([^:]+)://([^/]+)([^ ]*)} $url x method hostport path]} {
 126         return -1
 127     }
 128     if {![regexp {([^:]+):([0-9]+)} $hostport x host port]} {
 129         set port 80
 130         set host $hostport
 131     }
 132     set URL($url,method) $method
 133     set URL($url,host) $host
 134     set URL($url,port) $port
 135     set URL($url,path) $path
 136     set URL($url,state) head
 137     set URL($url,buf) {}
 138     if [catch {set sock [socket -async $host $port]}] {
 139         return -1
 140     }
 141     RobotConnect $url $sock
 142
 143     return 0
 144 }
 145
 146 set agent "dcdot.tcl/0.0"
 147 if {![catch {set os [exec uname -s -r]}]} {
 148     set agent "$agent ($os)"
 149 }
 150
 151 proc RobotGetDCDOT {url} {
 152     global robotMoreWork 1
 153
 154     set robotMoreWork 1
 155     if [RobotGetUrl $url {}] {
 156         set robotMoreWork 0
 157     }
 158
 159     while {$robotMoreWork} {
 160         vwait robotMoreWork
 161     }
 162 }
 163
 164 if {$argc == 1} {
 165     set url [lindex $argv 0]
 166     RobotGetDCDOT $url
 167     set mask {,meta}
 168     if {[info exist URL($url,meta)]} {
 169         foreach m $URL($url,meta) {
 170             puts $m
 171         }
 172     }
 173 }