allow getting peer in tcp

spl/http.spl

@@ -7,6 +7,10 @@ construct net:http namespace {
     Request
     Response
     help
+    ;
+    register { | with name this ;
+        name "net:http" register-field
+    }
 }
 
 construct net:http:Request {

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

spl/net.spl

@@ -4,6 +4,6 @@
 construct net namespace {
     ;
     register { | with name this ;
-        name "net" this register-field
+        name "net" register-field
     }
 }

spl/std.spl

@@ -36,70 +36,13 @@ construct _str_ext {
     }
     to-bytes { [int] | str-to-bytes }
     split { str | with splitter this ;
-        splitter:to-bytes =splitter
+        splitter:to-bytes this:to-bytes:split:map<{ | bytes-to-str }>
-        def bytes this:to-bytes =bytes
-        def i 0 =i
-        [ [ while { i bytes:len lt } {
-            def match 0 =match
-            while { match i + bytes:len lt match splitter:len lt and } {
-                i match + bytes:get (match splitter:get) eq dup if {
-                    match ++ =match
-                } not if {
-                    0 =match
-                    3 stop
-                }
-            }
-            i bytes:get
-            match splitter:len eq if {
-                pop ] _str [
-                i match + 1 - =i
-            }
-            i ++ =i
-        } ] _str ]
     }
     replace { str | with replacee replacement this ;
-        replacee:to-bytes =replacee
+        replacee:to-bytes replacement:to-bytes this:to-bytes:replace:to-str
-        def bytes this:to-bytes =bytes
-        def i 0 =i
-        [ while { i bytes:len lt } {
-            def match 0 =match
-            while { match i + bytes:len lt match replacee:len lt and } {
-                i match + bytes:get (match replacee:get) eq dup if {
-                    match ++ =match
-                } not if {
-                    0 =match
-                    3 stop
-                }
-            }
-            i bytes:get
-            match replacee:len eq if {
-                pop replacement:to-bytes:to-stack
-                i match + 1 - =i
-            }
-            i ++ =i
-        } ] _str
     }
     find { idx | with search this ;
-        search:to-bytes =search
+        search _array this _array :find
-        def bytes this:to-bytes =bytes
-        def i 0 =i
-        while { i bytes:len lt } {
-            def match 0 =match
-            while { match i + bytes:len lt match search:len lt and } {
-                i match + bytes:get (match search:get) eq dup if {
-                    match ++ =match
-                } not if {
-                    0 =match
-                    3 stop
-                }
-            }
-            match search:len eq if {
-                i
-                4 stop
-            }
-            i ++ =i
-        }
-        null
     }
     starts-with { bool | with beginning this ;
         beginning:to-bytes this:to-bytes:starts-with
@@ -107,6 +50,28 @@ construct _str_ext {
     _char { int | with this ; 
         0 (this _array):get
     }
+    readf { [str] | with pat this ;
+        !!- pat this str-readf
+    }
+    readf1 { str | with pat this ;
+        !!- pat this:readf 0:get
+    }
+    uppercase { str | with this ;
+        this _array :cmap<{ | with chr ; 
+            chr 
+            chr "a" :_char lt not chr "z" :_char gt not and if {
+                pop (chr "a" :_char -) "A" :_char +
+            }
+        }> _str
+    }
+    lowercase { str | with this ;
+        this _array :cmap<{ | with chr ; 
+            chr 
+            chr "A" :_char lt not chr "Z" :_char gt not and if {
+                pop (chr "A" :_char -) "a" :_char +
+            }
+        }> _str
+    }
 } include _str_ext in str
 
 construct _mega-ext {
@@ -151,10 +116,81 @@ construct _array-ext {
         def i 0 =i
         while { i this:len lt } { i this:get callable call i ++ =i }
     }
+    map { | with callable this ; 
+        def i 0 =i
+        while { i this:len lt } { i this:get callable call i this:set; i ++ =i }
+        this
+    }
+    cmap { | with callable this ; 
+        this clone =this
+        def i 0 =i
+        while { i this:len lt } { i this:get callable call i this:set; i ++ =i }
+        this
+    }
     to-str { str | bytes-to-str }
     sub { [any] | with begin end this ;
         this (end begin - anew) begin 0 (end begin -) acopy
     }
+    split { arr | with splitter this ;
+        def i 0 =i
+        [ [ while { i this:len lt } {
+            def match 0 =match
+            while { match i + this:len lt match splitter:len lt and } {
+                i match + this:get (match splitter:get) eq dup if {
+                    match ++ =match
+                } not if {
+                    0 =match
+                    3 stop
+                }
+            }
+            i this:get
+            match splitter:len eq if {
+                pop ] [
+                i match + 1 - =i
+            }
+            i ++ =i
+        } ] ]
+    }
+    replace { arr | with replacee replacement this ;
+        def i 0 =i
+        [ while { i this:len lt } {
+            def match 0 =match
+            while { match i + this:len lt match replacee:len lt and } {
+                i match + this:get (match replacee:get) eq dup if {
+                    match ++ =match
+                } not if {
+                    0 =match
+                    3 stop
+                }
+            }
+            i this:get
+            match replacee:len eq if {
+                pop replacement:to-stack
+                i match + 1 - =i
+            }
+            i ++ =i
+        } ]
+    }
+    find { idx | with search this ;
+        def i 0 =i
+        while { i this:len lt } {
+            def match 0 =match
+            while { match i + this:len lt match search:len lt and } {
+                i match + this:get (match search:get) eq dup if {
+                    match ++ =match
+                } not if {
+                    0 =match
+                    3 stop
+                }
+            }
+            match search:len eq if {
+                i
+                4 stop
+            }
+            i ++ =i
+        }
+        null
+    }
     starts-with { bool | with beginning this ;
         this:len beginning:len lt if {
             0
@@ -577,8 +613,21 @@ func update-types { |
 update-types
 
 "Adds a field to a namespace and initially sets it to the field's name.";
-func register-field { | with field-name namespace-name namespace ;
+func register-field { | with field-name namespace-name ;
-    field-name namespace-name dyn-def-field;
+    def namespace-path
-    namespace namespace-name settype ("=" namespace-name concat) dyn-call
+    def iter
-}
 
+    namespace-name:split<":"> =namespace-path;
+
+    namespace-path:iter =iter
+    field-name namespace-name dyn-def-field;               "adds the desired field to the namespace construct";
+    (
+        iter:next dyn-call
+        iter:foreach<&dyn-objcall>
+    ) namespace-name settype                               "updates and gets the namespace object";
+    
+    ("=" namespace-path:last concat) namespace-path:=last;
+    namespace-path:iter =iter
+    iter:next dyn-call
+    iter:foreach<&dyn-objcall>
+}

spl/stream.spl

@@ -16,13 +16,13 @@ construct Stream {
     }
     read-one { mega | with this ;
         def buf 1 anew =buf
-        while { buf this:id read-stream not } { }
+        while { buf this:id read-stream pop not } { }
         0 buf:get _mega
     }
     "the buffer is written to in-place.";
     read { mega [int] | with buf this ;
         buf gettype "mega" eq if { buf anew =buf }
-        buf this:id read-stream buf
+        buf this:id read-stream
     }
     "the buffer is written to in-place.";
     read-exact { [int] | with buf this ;
@@ -50,6 +50,9 @@ construct Stream {
     close { | with this ;
         this:id close-stream
     }
+    get-peer { ip:str port:int | with this ;
+        this:id get-stream-peer
+    }
 }
 
 construct StreamType {

src/runtime.rs

@@ -798,6 +798,10 @@ impl PartialOrd for Value {
     fn partial_cmp(&self, other: &Self) -> Option<std::cmp::Ordering> {
         match (self, other) {
             (Value::Mega(a), Value::Mega(b)) => a.partial_cmp(b),
+            (Value::Long(a), Value::Long(b)) => a.partial_cmp(b),
+            (Value::Int(a), Value::Int(b)) => a.partial_cmp(b),
+            (Value::Double(a), Value::Double(b)) => a.partial_cmp(b),
+            (Value::Float(a), Value::Float(b)) => a.partial_cmp(b),
             _ => panic!(),
         }
     }

src/std_fns.rs

@@ -11,6 +11,8 @@ use std::{
     time::{Duration, SystemTime},
 };
 
+use readformat::readf;
+
 use crate::{dyn_fns, mutex::Mut, runtime::*, sasm::sasm_write, *};
 
 #[macro_export]
@@ -877,9 +879,20 @@ pub fn time(stack: &mut Stack) -> OError {
     Ok(())
 }
 
+pub fn str_readf(stack: &mut Stack) -> OError {
+    require_on_stack!(string, Str, stack, "str-readf");
+    require_on_stack!(pat, Str, stack, "str-readf");
+    let Some(result) = readf(&pat, &string) else {
+        stack.push(Value::Null.spl());
+        return Ok(());
+    };
+    stack.push(Value::Array(result.into_iter().map(<String as SPL>::spl).collect()).spl());
+    Ok(())
+}
+
 pub fn register(r: &mut Stack, o: Arc<Frame>) {
     type Fn = fn(&mut Stack) -> OError;
-    let fns: [(&str, Fn, u32); 56] = [
+    let fns: [(&str, Fn, u32); 57] = [
         ("pop", pop, 0),
         ("dup", dup, 2),
         ("dup2", dup2, 3),
@@ -936,6 +949,7 @@ pub fn register(r: &mut Stack, o: Arc<Frame>) {
         ("write-file-sasm", write_file_sasm, 1),
         ("fork", fork, 0),
         ("sleeptime", time, 0),
+        ("str-readf", str_readf, 1),
     ];
     for f in fns {
         r.define_func(

src/stdlib.rs

@@ -13,6 +13,7 @@ pub const REPL: &str = include_str!("../spl/repl.spl");
 pub const PURE: &str = include_str!("../spl/pure.spl");
 pub const TIME: &str = include_str!("../spl/time.spl");
 pub const SERVER: &str = include_str!("../spl/server.spl");
+pub const HTTP_SERVER: &str = include_str!("../spl/http/server.spl");
 pub const NOP: &str = "";
 
 pub fn register(runtime: &mut Runtime) {
@@ -30,6 +31,7 @@ pub fn register(runtime: &mut Runtime) {
         insert("pure.spl", PURE);
         insert("time.spl", TIME);
         insert("server.spl", SERVER);
+        insert("http/server.spl", HTTP_SERVER);
         insert("nop.spl", NOP);
     }
 }

src/stream/mod.rs

@@ -9,6 +9,11 @@ use crate::{mutex::Mut, runtime::*};
 
 static IS_INITIALIZED: LazyLock<Arc<Mut<bool>>> = LazyLock::new(|| Arc::new(Mut::new(false)));
 
+#[derive(Default)]
+pub struct StreamExtraData {
+    peer: Option<(String, u16)>,
+}
+
 pub fn register(r: &mut Stack, o: Arc<Frame>) {
     if !*IS_INITIALIZED.lock_ro() {
         register_stream_type("file", stream_file);
@@ -20,7 +25,7 @@ pub fn register(r: &mut Stack, o: Arc<Frame>) {
     }
 
     type Fn = fn(&mut Stack) -> OError;
-    let fns: [(&str, Fn, u32); 10] = [
+    let fns: [(&str, Fn, u32); 11] = [
         ("new-stream", new_stream, 1),
         ("write-stream", write_stream, 1),
         ("write-all-stream", write_all_stream, 0),
@@ -31,6 +36,7 @@ pub fn register(r: &mut Stack, o: Arc<Frame>) {
         ("new-server-stream", new_server_stream, 1),
         ("accept-server-stream", accept_server_stream, 1),
         ("close-server-stream", close_server_stream, 0),
+        ("get-stream-peer", get_stream_peer, 2),
     ];
     for f in fns {
         r.define_func(

src/stream/rw.rs

@@ -11,6 +11,7 @@ use crate::*;
 
 use fs::OpenOptions;
 use mutex::Mut;
+use stream::StreamExtraData;
 
 static STREAM_TYPES: LazyLock<Arc<Mut<HashMap<String, StreamType>>>> =
     LazyLock::new(|| Arc::new(Mut::new(HashMap::new())));
@@ -47,6 +48,7 @@ pub struct Stream {
     pub(super) reader: Box<dyn Read + Send + Sync + 'static>,
     pub(super) _writer_storage: Option<Box<dyn Write + Send + Sync + 'static>>,
     pub(super) writer: &'static mut (dyn Write + Send + Sync + 'static),
+    pub extra: StreamExtraData,
 }
 
 impl Stream {
@@ -60,6 +62,7 @@ impl Stream {
             },
             _writer_storage: None,
             reader: rw,
+            extra: StreamExtraData::default(),
         }
     }
     pub fn new_split(
@@ -75,8 +78,14 @@ impl Stream {
                     .unwrap()
             },
             _writer_storage: Some(bx),
+            extra: StreamExtraData::default(),
         }
     }
+
+    pub fn append_extra(mut self, f: impl Fn(&mut StreamExtraData)) -> Stream {
+        f(&mut self.extra);
+        self
+    }
 }
 
 impl Read for Stream {
@@ -340,3 +349,24 @@ pub(super) fn stream_cmd(stack: &mut Stack) -> Result<Stream, Error> {
         command.stdin.take().unwrap(),
     ))
 }
+
+pub(super) fn get_stream_peer(stack: &mut Stack) -> OError {
+    require_on_stack!(id, Mega, stack, "get-stream-peer");
+    let Some((addr, port)) = runtime(|rt| -> Result<_, Error> {
+        Ok(rt
+            .get_stream(id as u128)
+            .ok_or(stack.error(ErrorKind::VariableNotFound(format!("__stream-{id}"))))?
+            .lock_ro()
+            .extra
+            .peer
+            .clone())
+    })?
+    else {
+        stack.push(Value::Null.spl());
+        stack.push(Value::Null.spl());
+        return Ok(());
+    };
+    stack.push(addr.spl());
+    stack.push((port as i32).spl());
+    Ok(())
+}

src/stream/server.rs

@@ -99,7 +99,8 @@ pub(crate) fn server_stream_tcp(stack: &mut Stack) -> Result<ServerStream, Error
         let socket = tcp
             .accept()
             .map_err(|e| stack.error(ErrorKind::IO(format!("{e:?}"))))?;
-        Ok(Stream::new(socket.0))
+        Ok(Stream::new(socket.0)
+            .append_extra(move |d| d.peer = Some((socket.1.ip().to_string(), socket.1.port()))))
     });
     Ok(stream)
 }

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