c9424188c1012b87267c83ec4d63a0da7f64cf7b
[tclrobot.git] / robot.tcl
1 #!/usr/bin/tclsh 
2 # $Id: robot.tcl,v 1.2 1998/10/15 12:31:03 adam Exp $
3 #
4 proc RobotFileNext {area} {
5     if {[catch {set ns [glob ${area}/*]}]} {
6         return {}
7     }
8     set off [string first / $area]
9     incr off
10     foreach n $ns {
11         if {[file isfile $n]} {
12             if {[string first :.html $n] > 0} {
13                 return http://[string range $area/ $off end]
14             }
15             return http://[string range $n $off end]
16         }
17         if {[file isdirectory $n]} {
18             set sb [RobotFileNext $n]
19             if {[string length $sb]} {
20                 return $sb
21             }
22         }
23     }
24     return {}
25 }
26
27 proc RobotFileExist {area host path} {
28     set comp [split $area/$host$path /]
29     set l [llength $comp]
30     incr l -1
31     if {![string length [lindex $comp $l]]} {
32         set comp [split $area/$host$path:.html /]
33     }
34     return [file exists [join $comp /]]
35 }
36
37 proc RobotFileUnlink {area host path} {
38     set comp [split $area/$host$path /]
39     set l [llength $comp]
40     incr l -1
41     if {![string length [lindex $comp $l]]} {
42         set comp [split $area/$host$path:.html /]
43     }
44     if {[catch {exec rm [join $comp /]}]} return
45     incr l -1
46     for {set i $l} {$i > 0} {incr i -1} {
47         set path [join [lrange $comp 0 $i] /]
48         if {![catch {glob $path/*}]} return
49         exec rmdir ./$path
50     }
51 }
52
53 proc RobotFileOpen {area host path} {
54     set orgPwd [pwd]
55
56     set comp [split $area/$host$path /]
57     set len [llength $comp]
58     incr len -1
59     for {set i 0} {$i < $len} {incr i} {
60         set d [lindex $comp $i]
61         if {[catch {cd ./$d}]} {
62             exec mkdir $d
63             cd ./$d
64         }
65     }
66     set d [lindex $comp $len]
67     if {[string length $d]} {
68         set out [open $d w]
69     } else {
70         set out [open :.html w]
71     }
72     cd $orgPwd
73     return $out
74 }
75
76 proc RobotRestart {} {
77     global URL
78
79     while {1} {    
80         set url [RobotFileNext unvisited]
81         if {![string length $url]} break
82         set r [RobotGetUrl $url {}]
83         if {!$r} {
84             return
85         } else {
86             RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
87         }
88     }
89     exit 0
90 }
91
92 proc headSave {url out title} {
93     global URL
94
95     puts $out {<nwi>}
96     puts $out "<ti> $title"
97     if {[info exists URL($url,head,Last-modified)]} {
98         puts $out "<dm> $URL($url,head,Last-modified)"
99     }
100     puts $out {<si>}
101     if {[info exists URL($url,head,Date)]} {
102         puts $out " <lc> $URL($url,head,Date)"
103     }
104     if {[info exists URL($url,head,Content-length)]} {
105         puts $out " <by> $URL($url,head,Content-length)"
106     }
107     if {[info exists URL($url,head,Server)]} {
108         puts $out " <srvr> $URL($url,head,Server)"
109     }
110     puts $out {</si>}
111     puts $out {<av>}
112     puts $out " <avli> $url"
113     if {[info exists URL($url,head,Content-type)]} {
114         puts $out " <ty> $URL($url,head,Content-type)"
115     }
116     puts $out {</av>}
117 }
118
119 proc RobotSave {url} {
120     global URL
121     
122     set out [RobotFileOpen visited $URL($url,host) $URL($url,path)]
123     set ti 0
124     if {[info exists URL($url,line)]} {
125         set htmlContent [join $URL($url,line) \n]
126         
127         htmlSwitch $htmlContent \
128         title {
129             if {!$ti} {
130                 headSave $url $out $body
131                 set ti 1
132             }
133         } body {
134             regsub -all -nocase {<script.*</script>} $body {} abody
135             regsub -all {<[^\>]+>} $abody {} nbody
136             puts $out "<body>"
137             puts $out $nbody
138             puts $out "</body>"
139         } a {
140             if {![info exists parm(href)]} {
141                 puts "no href"
142                 continue
143             }
144             if {!$ti} {
145                 headSave $url $out "untitled"
146                 set ti 1
147             }
148             
149             if {[regexp {^\#} $parm(href)]} {
150                 continue
151             } elseif {[regexp {^([^:]+):([^#]+)} $parm(href) x method hpath]} {
152                 if {![string compare $method http]} {
153                     if {![regexp {^//([^/]+)(.*)} $hpath x host path]} {
154                         set host $URL($url,host)
155                         set path $hpath
156                     } 
157                     if {![regexp {\.indexdata\.dk$} $host]} continue
158                 } else {
159                     continue
160                 }
161             } elseif {[regexp {^([/~][^#]*)} $parm(href) x path]} {
162                 set host $URL($url,host)
163                 set method http
164             } else {
165                 set ext [file extension $URL($url,path)] 
166                 if {[string compare $ext {}]} {
167                     set dpart [file dirname $URL($url,path)]
168                 } else {
169                     set dpart $URL($url,path)
170                 }
171                 regexp {^([^#]+)} $parm(href) x path
172                 set host $URL($url,host)
173                 set path [string trimright $dpart /]/$path
174                 set method http
175             }
176             set ext [file extension $path]
177             if {![string length $ext]} {
178                 set path [string trimright $path /]/
179             } else {
180                 set path [string trimright $path /]
181             }
182             set c [split $path /]
183             set i [llength $c]
184             incr i -1
185             set path [lindex $c $i]
186             incr i -1
187             while {$i >= 0} {
188                 switch -- [lindex $c $i] {
189                     .. {
190                         incr i -2
191                     }
192                     . {
193                         incr i -1
194                     }
195                     default {
196                         set path [lindex $c $i]/$path
197                         incr i -1
198                     }
199                 }
200             }
201             set href "$method://$host$path"
202
203             puts $out "<cr>"
204             puts $out "<li> $href"
205             puts $out "<cp> $body"
206             puts $out "</cr>"
207             
208             if {![regexp {/.*bin/} $href)]} {
209                 if {![RobotFileExist visited $host $path]} {
210                     set outf [RobotFileOpen unvisited $host $path]
211                     close $outf
212                 }
213             }
214         }
215     }
216     if {!$ti} {
217         headSave $url $out "untitled"
218         set ti 1
219     }
220     puts $out "</nwi>"
221     close $out
222     RobotFileUnlink unvisited $URL($url,host) $URL($url,path)
223 }
224
225 proc RobotRead {url sock} {
226     global URL
227
228     set readCount [gets $sock line]
229     if {$readCount < 0} {
230         if [eof $sock] {
231             close $sock
232             RobotSave $url
233             RobotRestart
234         }
235     } elseif {$readCount > 0} {
236         switch $URL($url,state) {
237             head {
238                 puts "head: $line" 
239                 if {[regexp {([^:]+):[ ]+(.*)} $line x name value]} {
240                     set URL($url,head,$name) $value
241                 }
242             }
243             html { 
244                 lappend URL($url,line) $line 
245 #                puts "body: $line"
246             }
247             skip {
248                 close $sock
249                 RobotSave $url
250                 RobotRestart
251             }
252         }
253     } else {
254         set URL($url,state) html
255         if {[info exists URL($url,head,Content-type)]} {
256             if {![string compare $URL($url,head,Content-type) text/html]} {
257                 set URL($url,state) html
258             }
259         }
260     }
261 }
262
263 proc RobotConnect {url sock} {
264     global URL
265
266     fileevent $sock readable [list RobotRead $url $sock]
267     puts $sock "GET $URL($url,path) HTTP/1.0"
268     puts $sock ""
269     flush $sock
270 }
271
272 proc RobotNop {} {
273
274 }
275
276 proc RobotGetUrl {url phost} {
277     global URL
278     set port 80
279     puts "---------"
280     puts $url
281     if {[regexp {([^:]+)://([^/]+)([^ ?]*)} $url x method host path]} {
282         puts "method=$method host=$host path=$path"
283     } else {
284         return -1
285     }
286     set URL($url,method) $method
287     set URL($url,host) $host
288     set URL($url,port) $port
289     set URL($url,path) $path
290     set URL($url,state) head
291     if [catch {set sock [socket -async $host $port]}] {
292         return -1
293     }
294     fconfigure $sock -translation {auto crlf}
295     RobotConnect $url $sock
296
297     return 0
298 }
299
300 if {![llength [info commands htmlSwitch]]} {
301     set e [info sharedlibextension]
302     if {[catch {load ./tclrobot$e}]} {
303         load tclrobot$e
304     }
305 }
306
307 if {![llength $argv]} {
308     puts "Tclrobot: specify one or more sites."
309     exit 1
310 }
311 foreach site $argv {
312     set x [RobotFileOpen unvisited $site /]
313     close $x
314 }
315 RobotRestart
316 vwait forever
317