add http server

This commit is contained in:
Daniella 2024-09-12 15:17:42 +02:00
parent 6f2777b83a
commit 2446272181
2 changed files with 161 additions and 3 deletions

133
spl/http/server.spl Normal file
View file

@ -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;
}
}

View file

@ -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