dcdot.tcl

   1 #!/usr/bin/tclsh
   2 # $Id: dcdot.tcl,v 1.4 2000/12/11 17:11:03 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 \r\n\r\n $URL($url,buf)]
  66         if {$n > 1} {
  67             puts "string first match n = $n"
  68             set code 0
  69             set version {}
  70             set headbuf [string range $URL($url,buf) 0 $n]
  71             incr n 4
  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]) [string trim $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                         application/pdf {
  95                             puts "ok preceeed with this thingy"
  96                             fileevent $sock readable [list RobotReadContent $url $sock]
  97                         }
  98                         default {
  99                             close $sock
 100                             Robot200 $url
 101                             RobotRestart
 102                         }
 103                     }
 104                 }
 105                 default {
 106                     close $sock
 107                     RobotRestart
 108                 }
 109             }
 110         }
 111     }
 112 }
 113
 114 proc RobotConnect {url sock} {
 115     global URL agent
 116
 117     fconfigure $sock -translation {lf crlf} -blocking 0
 118     fileevent $sock readable [list RobotReadHeader $url $sock]
 119     puts $sock "GET $URL($url,path) HTTP/1.0"
 120     puts $sock "Host: $URL($url,host)"
 121     puts $sock "User-Agent: $agent"
 122     puts $sock ""
 123     flush $sock
 124 }
 125
 126 proc RobotGetUrl {url phost} {
 127     global URL
 128     if {![regexp {([^:]+)://([^/]+)([^ ]*)} $url x method hostport path]} {
 129         return -1
 130     }
 131     if {![regexp {([^:]+):([0-9]+)} $hostport x host port]} {
 132         set port 80
 133         set host $hostport
 134     }
 135     set URL($url,method) $method
 136     set URL($url,host) $host
 137     set URL($url,port) $port
 138     set URL($url,path) $path
 139     set URL($url,state) head
 140     set URL($url,buf) {}
 141     if [catch {set sock [socket -async $host $port]}] {
 142         return -1
 143     }
 144     RobotConnect $url $sock
 145
 146     return 0
 147 }
 148
 149 set agent "dcdot.tcl/0.0"
 150 if {![catch {set os [exec uname -s -r]}]} {
 151     set agent "$agent ($os)"
 152 }
 153
 154 proc RobotGetDCDOT {url} {
 155     global robotMoreWork 1
 156
 157     set robotMoreWork 1
 158     if [RobotGetUrl $url {}] {
 159         set robotMoreWork 0
 160     }
 161
 162     while {$robotMoreWork} {
 163         vwait robotMoreWork
 164     }
 165 }
 166
 167 if {$argc == 1} {
 168     set url [lindex $argv 0]
 169     RobotGetDCDOT $url
 170     set mask {,meta}
 171     if {[info exist URL($url,meta)]} {
 172         foreach m $URL($url,meta) {
 173             puts $m
 174         }
 175     }
 176     foreach v [array names URL $url,head,*] {
 177         puts "$v = $URL($v)"
 178     }
 179     puts "Buffer length is [string length $URL($url,buf)]"
 180     set f [open out.pdf w]
 181     puts -nonewline $f $URL($url,buf)
 182     close $f
 183 }