1 files changed, 121 insertions, 0 deletions

diff --git a/www.tcl b/www.tcl
new file mode 100755
index 0000000..e057844
--- /dev/null
+++ b/www.tcl
@@ -0,0 +1,121 @@
+#!/usr/bin/tclsh
+namespace eval www {
+
+	package require TclOO
+
+	oo::class create server {
+		constructor {{ports 0} {acts {}}} {
+			my variable sock actions
+			set actions $acts
+			foreach port $ports {
+				my bind $port
+			}
+		}
+		# actions of existing clients (where request is ongoing) aren't modified, only actions for new clients
+		method action {uri handler} {
+			my variable actions
+			dict set actions $uri $handler
+		}
+		method bind {{port 0}} {
+			socket -server "[self namespace] accept" $port
+		}
+		method accept {chan addr port} {
+			my variable actions
+			if [dict exists	$actions accept] {
+				[{*}[dict get $actions accept] $chan $addr $port]
+			}
+			client new $chan $actions
+		}
+	}
+
+	oo::class create client {
+		constructor {sock {actions {}}} {
+			my variable sock stage actions
+			set stage headers
+			set chan $sock
+			chan event $chan readable {[self namespace] readable}
+			chan configure $chan -blocking 0
+		}
+		destructor {} {
+			my variable sock
+			close sock
+		}
+		method readable {
+			my variable to_parse chan stage headers arguments uri
+			switch $stage {
+				headers {
+					if {[catch {append to_parse {gets $chan}}] != 0} {
+						my destroy
+					}
+					if {[string first "\n\n" $to_parse] != -1} {
+						set list [split $to_parse ":\n"]
+						
+						set uri [lindex [split [lindex $list 0] " "] 1]
+						set headers [lreplace $list 0 0]
+						
+						set i 0
+						dict map {key value} $headers {
+							if {expr {[incr i] % 2}} {
+								set key [string tolower $key]
+							}
+						}
+						
+						set variables [split [lindex [split $uri "?"] 1] "&=;"]
+
+						set body {}
+						if [dict exists content-length] {
+							set stage body
+							set to_parse {}
+							chan configure $chan -translation {binary auto} -encoding binary -eofchar {{} {}}
+						} else {
+							my request_complete
+						}
+					}
+				}
+				body {
+					if {[catch {append to_parse {gets $chan}}] != 0} {
+						my destroy
+					}
+					if {[string length to_parse] == [dict get $headers content-length]} {
+						my request_complete
+					}
+				}
+			}
+		}
+		method request_complete {
+			my variable actions headers arguments uri body
+			dict for {key value} $actions {
+				if [string match -nocase $key $uri] {
+					return [{*}$value $arguments $headers $body]
+				}
+			}
+			return [my send {content-type text/plain} {404 not found-ni najdeno} {404 not found-ni najdeno}]
+		}
+		# uri is "string match". handler gets parsed array of request variables, request headers and request body
+		method send {headers body code} {
+			my variable to_write chan data
+			# cr is auto translated to crlf for network sockets in tcl
+			set to_write "HTTP/1.0 $code
+			Connection: close
+			"
+			dict for {key value} $headers {
+				append to_write "$key: $value
+				"
+			}
+			set data $body
+			chan event $chan writable {[self namespace] writable}
+		}
+		method writable {} {
+			my variable chan to_write
+			if {[catch {[puts -nonewline $chan $to_write}] != 0} {
+				my destroy
+			}
+			chan configure $chan -translation {binary binary} -encoding binary
+			if {[catch {puts -nonewline $chan $data}] != 0} {
+			}
+			my destroy
+		}
+	}
+	if {$argv0 == www.tcl} {
+	}
+}