blob: ca567f9f37df37cb61abafb53109de2fd9ff8428 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
namespace eval request_target {
# get channel first_line
# Get request_target from the first line
#
# file request_target
# File portion of request_target
#
# query request_target
# Decoded query portion of request_target
#
# encode query
# Encode a query
#
# decode query
# Decode a query
## Gets the request_target from the first client line.
proc get {channel first_line} {
## Reject if first line is not a properly formatted GET request.
## ^GET RWS - HTTP/(Versions) $
if { ![regexp {^(GET ){1}.* HTTP/(0.9|1.0|1.1){1}$} $first_line] } {
::http::respond $channel 400
}
## Return between first and last space.
set request_target [string trim \
[string range $first_line \
[string first " " $first_line] \
[string last " " $first_line]]]
puts "|$request_target|"
## If there are two periods in a request target (trying to access parent files), reject.
if [regexp {\.\./} $request_target] {
respond 400
}
if [regexp {^/.*$} $request_target] {
puts "origin-form"
return $request_target
}
## Turn absolute-form to origin-form
if [regexp {^http(s)?://[[:alpha:].]+/[[:graph:]*]} $request_target] {
set request_target \
[string range $request_target \
[expr [string first / [string range $request_target 8 end]] + 8] \
end]
return $request_target
}
puts "Neither origin-form or absolute-form"
respond 400;
}
#TODO: Will need to improve these functions later.
## Take the file part of the request target.
proc file {request_target} {
set t [string first ? $request_target]
if {$t == -1} {
return [string range $request_target 1 end]
}
else {
return [string range $request_target 1 [expr $t - 1]]
}
}
## Process request_target into a query string.
proc query {request_target} {
set t [string first ? $request_target]
if {$t == -1} {
return {}
}
else {
return [decode [string map {& { } = { }} \
[string range $request_target \
[expr $t + 1] end]]]
}
}
## Create dictionaries for coding and decoding query strings.
variable character2code {};
variable code2character {};
for {set i 0} {$i <= 255} {incr i 1} {
set ch [format %c $i];
if {[expr !( [string is alpha $ch] || [string is digit $ch] )]} {
set co "\%[format %02X $i]";
dict append character2code $ch $co
dict append code2character $co $ch
}
}
proc encode {query} {
variable character2code
for {set i 0} {$i < [llength $query]} {incr i 1} {
lset query $i \
[string map -nocase $character2code [lindex $query $i]]
}
set query [string map -nocase {{ } {%20}} $query]
return $query
}
proc decode {query} {
variable code2character
for {set i 0} {$i < [llength $query]} {incr i 1} {
lset query $i \
[string map -nocase $code2character [lindex $query $i]]
}
set query [string map -nocase {{%20} { }} $query]
return $query
}
}
|
