From 10037a0b047631a51492455c725337c868748983 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 28 Mar 2026 18:00:05 +0000 Subject: [PATCH] sx-http: escape --- hosts/ocaml/bin/sx_server.ml | 87 +++++++++++++++++++++++++++++++----- 1 file changed, 77 insertions(+), 10 deletions(-) diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index 60e6c028..9e4ab1b6 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -1408,7 +1408,7 @@ let http_response ?(status=200) ?(content_type="text/html; charset=utf-8") body Printf.sprintf "HTTP/1.1 %d %s\r\nContent-Type: %s\r\nContent-Length: %d\r\nConnection: keep-alive\r\n\r\n%s" status status_text content_type (String.length body) body -let _http_redirect url = +let http_redirect url = Printf.sprintf "HTTP/1.1 301 Moved Permanently\r\nLocation: %s\r\nContent-Length: 0\r\nConnection: keep-alive\r\n\r\n" url let parse_http_request data = @@ -1499,7 +1499,9 @@ let http_render_page env path = | [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: body_exprs) in Sx_render.render_to_html_streaming body_expr env with e -> - Printf.eprintf "[http-ssr] failed: %s\n%!" (Printexc.to_string e); "" + Printf.eprintf "[http-ssr] failed: %s\n%!" (Printexc.to_string e); + (* Fallback: minimal layout structure so client can mount *) + "
" in let t3 = Unix.gettimeofday () in (* Phase 3: Shell — render directly to buffer for zero-copy output *) @@ -1570,8 +1572,9 @@ let serve_static_file static_dir url_path = in check 0 in if String.contains rel '\x00' || (String.length rel > 1 && String.sub rel 0 2 = "..") - || has_substring rel ".assets/" - || Filename.check_suffix rel ".map" then + (* Block source maps but allow .wasm files from assets *) + || Filename.check_suffix rel ".map" + || (has_substring rel ".assets/" && not (Filename.check_suffix rel ".wasm")) then http_response ~status:403 "Forbidden" else let file_path = static_dir ^ "/" ^ rel in @@ -1598,7 +1601,7 @@ let read_css_file path = (** Pre-compute shell statics and inject into env as __shell-* vars. *) -let http_inject_shell_statics env static_dir = +let http_inject_shell_statics env static_dir sx_sxc = (* Component definitions for client *) let buf = Buffer.create 65536 in Hashtbl.iter (fun _sym v -> @@ -1617,7 +1620,26 @@ let http_inject_shell_statics env static_dir = i.i_name ps (serialize_value i.i_body)) | _ -> () ) env.bindings; - let component_defs = Buffer.contents buf in + let raw_defs = Buffer.contents buf in + (* Escape scans for (case-insensitive) to + close the tag. Replace Digest.to_hex in (* Compute file hashes for cache busting *) let sx_js_hash = file_hash (static_dir ^ "/scripts/sx-browser.js") in @@ -1629,7 +1651,49 @@ let http_inject_shell_statics env static_dir = let sx_css = basics_css ^ "\n" ^ tw_css in ignore (env_bind env "__shell-component-defs" (String component_defs)); ignore (env_bind env "__shell-component-hash" (String component_hash)); - ignore (env_bind env "__shell-pages-sx" (String "")); + (* Build minimal pages-sx from defpage definitions in loaded .sx files. + Scans all loaded .sx files in the component dirs for (defpage ...) forms. *) + let pages_buf = Buffer.create 4096 in + let scan_defpages dir = + let rec scan d = + if Sys.file_exists d && Sys.is_directory d then + Array.iter (fun f -> + let path = d ^ "/" ^ f in + if Sys.is_directory path then scan path + else if Filename.check_suffix f ".sx" then + try + let src = In_channel.with_open_text path In_channel.input_all in + let exprs = Sx_parser.parse_all src in + List.iter (function + | List (Symbol "defpage" :: Symbol name :: rest) -> + let rec extract_kw key = function + | [] -> None + | Keyword k :: v :: _ when k = key -> Some v + | _ :: rest -> extract_kw key rest + in + let path_val = match extract_kw "path" rest with + | Some (String s) -> s | _ -> "" in + let content_val = match extract_kw "content" rest with + | Some v -> serialize_value v | _ -> "" in + let has_data = match extract_kw "data" rest with + | Some _ -> true | None -> false in + if path_val <> "" then + Buffer.add_string pages_buf + (Printf.sprintf "{:name \"%s\" :path \"%s\" :auth \"public\" :has-data %s :content \"%s\"}\n" + name path_val (if has_data then "true" else "false") + (escape_sx_string content_val)) + | _ -> () + ) exprs + with _ -> () + ) (Sys.readdir d) + in scan dir + in + scan_defpages sx_sxc; + let pages_sx = Buffer.contents pages_buf in + Printf.eprintf "[sx-http] pages-sx: %d bytes (%d lines)\n%!" + (String.length pages_sx) + (List.length (String.split_on_char '\n' pages_sx)); + ignore (env_bind env "__shell-pages-sx" (String pages_sx)); ignore (env_bind env "__shell-sx-css" (String sx_css)); ignore (env_bind env "__shell-sx-css-classes" (String "")); ignore (env_bind env "__shell-asset-url" (String "/static")); @@ -1883,8 +1947,8 @@ let http_mode port = Printf.eprintf "[sx-http] static_dir=%s\n%!" static_dir; (* HTTP mode always expands components — bind once, shared across domains *) ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true))); - (* Inject shell statics with real file hashes and CSS *) - http_inject_shell_statics env static_dir; + (* Inject shell statics with real file hashes, CSS, and pages registry *) + http_inject_shell_statics env static_dir sx_sxc; (* Response cache — path → full HTTP response string. Populated during pre-warm, serves cached responses in <0.1ms. Thread-safe: reads are lock-free (Hashtbl.find_opt is atomic for @@ -1942,7 +2006,10 @@ let http_mode port = http_response ~status:405 "Method Not Allowed" else begin let path = url_decode raw_path in - let is_sx = path = "/" || path = "/sx/" || path = "/sx" + (* Redirect bare / to /sx/ *) + if path = "/" then http_redirect "/sx/" + else + let is_sx = path = "/sx/" || path = "/sx" || (String.length path > 4 && String.sub path 0 4 = "/sx/") in if is_sx then (* Check cache first *)