add http server

spl/http/server.spl

@@ -0,0 +1,133 @@
+"#http.spl" import
+"#server.spl" import
+
+"Server" net:http:register
+"server" net:http:register
+
+construct net:http:Server {
+	ifaddr
+	port
+	stream
+	;
+	construct { this | with ifaddr port this ;
+		ifaddr this:=ifaddr;
+		port this:=port;
+		ifaddr port net:server:Types:tcp:create this:=stream;
+		this
+	}
+	accept { net:http:server:Request | with this ;
+		this:stream:accept net:http:server:Request:new
+	}
+	close { | with this ; this:stream:close; }
+}
+
+construct net:http:server namespace {
+	Request
+}
+
+construct net:http:server:Request {
+	stream
+	head
+	body
+	method path version
+	headers
+	wrote-body
+	;
+	construct { this | with stream this ;
+		stream this:=stream
+		0 anew this:=head
+		0 anew this:=body
+		this
+	}
+	read-head { this | with this ;
+		def read
+		def buf 1024 anew =buf
+		def found
+		while {
+			buf this:stream:read pop =read
+			"\r\n\r\n" :to-bytes buf:find dup =found not read and
+		} {
+			this:head buf:sub<0 read> aadd this:=head
+		}
+		this:head buf:sub<0 found> aadd:to-str this:=head
+		buf:sub<found 4 + buf:len> this:=body
+		this
+	}
+	parse-head { this | with this ;
+		this:head:split<"\r\n"> this:=head
+		def iter this:head:iter =iter
+		iter:next:readf<"{} {} HTTP/{}"> dup if {
+			dup:to-stack this:=version this:=path this:=method
+		} pop
+		MicroMap:new this:=headers
+		iter:foreach<{ | with header ;
+			header:readf<"{}: {}"> dup if {
+				dup:to-stack swap:lowercase swap this:headers:set;
+			} pop
+		}>
+		this
+	}
+	head-str { str | with this ;
+		this:method
+		" " concat
+		this:path concat
+		" HTTP/" concat
+		this:version concat
+		"\r\n" concat
+		this:headers:foreach<{ | :to-stack ": " swap concat concat concat "\r\n" concat }>
+		"\r\n" concat
+	}
+	read-body { this | with this ;
+		this:headers:get<"content-length"> dup if { _mega with content-length ;
+			def read
+			def buf 1024 anew =buf
+			while {
+				this:body:len content-length lt read and
+			} {
+				this:body buf:sub<0 read> aadd this:=body
+				buf this:stream:read pop =read
+			}
+			null
+		} pop
+		this
+	}
+	full-read { this | with this ;
+		this:read-head:parse-head:read-body
+	}
+	writeln { this | with line this ;
+		line "\r\n" concat :to-bytes this:stream:write-exact;
+		this
+	}
+	write-head { this | with status-code status-string this ;
+		"HTTP/1.0 " status-code _str concat " " concat status-string concat this:writeln
+	}
+	write-ok { this | with this ;
+		200 "OK" this:write-head
+	}
+	write-header { this | with header value this ;
+		header ": " concat value _str concat this:writeln
+	}
+	write-content-type { this | with ct this ;
+		"Content-Type" ct this:write-header
+	}
+	write-str-body { this | with body this ;
+		body:to-bytes this:write-body
+	}
+	write-html-body { this | with body this ;
+		"text/html" this:write-content-type;
+		body:to-bytes this:write-body
+	}
+	write-body { this | with body this ;
+		"Content-Length" body:len this:write-header;
+		"" this:writeln;
+		1 this:=wrote-body;
+		body this:stream:write-exact;
+		this
+	}
+	finish { | with this ;
+		this:wrote-body not if {
+			"" this:write-body;
+		}
+		this:stream:close;
+	}
+}

test.spl

@@ -4,6 +4,7 @@
 "#messaging.spl" import
 "#server.spl" import
 "#time.spl" import
+"#http/server.spl" import
 
 "SPL tester" =program-name
 
@@ -118,8 +119,8 @@ func main { int | with args ;
     { | println } (" " "hello how  are you" :split):foreach
     "" println
 
-    catch {
         use net:http:Request
+    catch {
         "testing http" println;
         def req "data.tudbut.de" 80 "GET" "/spltest" Request:new =req
         req:send:body _str println;
@@ -181,8 +182,6 @@ func main { int | with args ;
     def client "localhost" 4075 StreamTypes:tcp:create =client
     1024 client:read-to-end:to-str println;
     " ^ this should say 'Hello!'" println;
-    "you now have a chance to connect too: localhost:4075 - continuing in 2 seconds..." println;
-    2000 time:sleep;
     
     "" println
     "testing string replace" println;
@@ -206,6 +205,32 @@ func main { int | with args ;
     "abba" "ababba" :find println;
     "^ should be 2" println;
 
+    "" println;
+    "testing readf" println;
+
+    def array
+    "Hello dear {}, {}?" "Hello dear friend, how are you?" (dup println;) :readf =array
+    "Person was " 0 array:get concat println;
+    "Question was " 1 array:get concat println;
+
+    "" println;
+    "testing http server" println;
+
+    def server "0.0.0.0" 4076 net:http:Server:new =server
+    { |
+        while { 1 } {
+            server:accept:full-read 
+                dup:head-str println;
+                :write-ok
+                :write-str-body<"Hello! This was written to HTTP!">
+                :finish
+        }
+    } fork
+    def req "localhost" 4076 "GET" "/spltest" Request:new =req
+    req:send:body _str println;
+    
+    "you now have a chance to connect too: localhost :4075 :4076 - stopping in 5 seconds..." println;
+    5000 time:sleep;
     
     ] dup :len 0 eq not if {
         "" println