Initial; already done much

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
+    }
+
+}