summaryrefslogtreecommitdiff
path: root/http-request_target.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'http-request_target.tcl')
-rwxr-xr-xhttp-request_target.tcl115
1 files changed, 115 insertions, 0 deletions
diff --git a/http-request_target.tcl b/http-request_target.tcl
new file mode 100755
index 0000000..ca567f9
--- /dev/null
+++ b/http-request_target.tcl
@@ -0,0 +1,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
+ }
+
+}