dcdot.tcl

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