init

src/app.ml

@@ -0,0 +1,14 @@
+module App_id = struct
+  let qualifier = "org"
+
+  let organization = "TODO"
+
+  let application = "drame_template"
+end
+
+include Drame.Server.Make (App_id)
+
+let path_to_images =
+  match Scfg.Query.get_dir "path_to_images" config with
+  | None -> failwith "missing path_to_images in configuration"
+  | Some dir -> Scfg.Query.get_param_exn 0 dir

src/assets/css/style.css

@@ -0,0 +1,15 @@
+:root {
+  --bg: #FFFFFF;
+  --fg: #000000;
+}
+
+html {
+  background-color: var(--bg);
+  color: var(--fg);
+}
+
+body {
+}
+
+nav {
+}

src/dune

@@ -0,0 +1,22 @@
+(executable
+ (public_name web_template)
+ (name main)
+ (libraries drame htmlit))
+
+(rule
+ (target assets.ml)
+ (deps
+  (source_tree assets))
+ (action
+  (with-stdout-to
+   %{null}
+   (run ocaml-crunch -m plain assets -o %{target}))))
+
+(rule
+ (target data.ml)
+ (deps
+  (source_tree data))
+ (action
+  (with-stdout-to
+   %{null}
+   (run ocaml-crunch -m plain data -o %{target}))))

src/home.ml

@@ -0,0 +1,8 @@
+open Htmlit
+
+let get request =
+  let title = "Home" in
+  let h1 = El.h1 [ El.txt title ] in
+  let txt = El.txt "Welcome to my home page" in
+  let doc = Template.render request ~styles:[] ~title [ h1; txt ] in
+  Ok (Drame.Content.Html doc)

src/main.ml

@@ -0,0 +1,79 @@
+open Drame
+
+let get_img =
+  let forbidden_characters =
+    let tbl = Hashtbl.create 16 in
+    Array.iter (fun c -> Hashtbl.add tbl c ()) [| '.'; '/'; '\\' |];
+    tbl
+  in
+  let allowed_extensions =
+    let tbl = Hashtbl.create 16 in
+    Array.iter (fun e -> Hashtbl.add tbl e ()) [| ".jpeg"; ".png"; ".gif" |];
+    tbl
+  in
+  fun ~filename request ->
+    let extension = Filename.extension filename in
+    let without_extension = Filename.chop_extension filename in
+    if
+      String.exists (Hashtbl.mem forbidden_characters) without_extension
+      || (not @@ Hashtbl.mem allowed_extensions extension)
+    then
+      let title = Format.sprintf "Invalid filename: %s." filename in
+      let doc = Template.render request ~title [] in
+      Error (Status.Bad_request, doc)
+    else
+      let path = Filename.concat App.path_to_images filename in
+      let chan = open_in_bin path in
+      let len = in_channel_length chan in
+      let s = Bytes.create len in
+      Fun.protect
+        ~finally:(fun () -> close_in chan)
+        (fun () ->
+          assert (len <= Sys.max_string_length);
+          really_input chan s 0 len );
+      let content = Bytes.unsafe_to_string s in
+      let mimetype =
+        match extension with
+        | ".jpeg" -> Mimetype.Image_jpeg
+        | ".png" -> Mimetype.Image_png
+        | ".gif" -> Mimetype.Image_gif
+        | _ -> assert false
+      in
+      Ok (Content.Unsafe { content; mimetype })
+
+let get_asset ~filename request =
+  match Assets.read filename with
+  | None ->
+    let title = Format.sprintf "Invalid filename: %s." filename in
+    let doc = Template.render request ~title [] in
+    Error (Status.Bad_request, doc)
+  | Some content -> (
+    let extension = Filename.extension filename in
+    match extension with
+    | ".css" -> Ok (Content.Unsafe { mimetype = Mimetype.Text_css; content })
+    | ".ttf" -> Ok (Content.Unsafe { mimetype = Mimetype.Font_ttf; content })
+    | _ -> assert false )
+
+let get_favicon request =
+  let title = "The favicon is not where you think it is!" in
+  let h1 = Htmlit.El.h1 [ Htmlit.El.txt title ] in
+  let doc = Template.render request ~title [ h1 ] in
+  Error (Status.Moved_permanently Sitemap.favicon, doc)
+
+let not_found request =
+  let title = "Not found" in
+  let h1 = Htmlit.El.h1 [ Htmlit.El.txt title ] in
+  let doc = Template.render request ~title [ h1 ] in
+  Error (Status.Not_found, doc)
+
+let handler = function
+  | [| "assets"; "css"; filename |] ->
+    get_asset ~filename:(Format.sprintf "css/%s" filename)
+  | [| "assets"; "fonts"; filename |] ->
+    get_asset ~filename:(Format.sprintf "fonts/%s" filename)
+  | [| "assets"; "img"; filename |] -> get_img ~filename
+  | [| "favicon.ico" |] -> get_favicon
+  | [||] -> Home.get
+  | _ -> not_found
+
+let () = App.run ~handler

src/sitemap.ml

@@ -0,0 +1,9 @@
+let img name = Format.sprintf "/assets/img/%s" name
+
+let script name = Format.sprintf "/assets/js/%s" name
+
+let style name = Format.sprintf "/assets/css/%s" name
+
+let favicon = img "favicon.png"
+
+let home = "/"

src/template.ml

@@ -0,0 +1,18 @@
+open Htmlit
+
+let render _request ?(scripts = []) ?(styles = []) ~title content =
+  let favicon = El.link ~at:[ At.rel "icon"; At.href Sitemap.favicon ] () in
+  let meta_desc =
+    El.meta ~at:[ At.name "description"; At.content "TODO site desciption" ] ()
+  in
+  let meta_keys =
+    El.meta ~at:[ At.name "keywords"; At.content "TODO site desciption" ] ()
+  in
+  let more_head = El.splice [ favicon; meta_desc; meta_keys ] in
+  let header = El.header [ El.nav [] ] in
+  let main = El.main content in
+  let footer = El.footer [] in
+  let body = El.body [ header; main; footer ] in
+  let page = El.page ~lang:"en" ~styles ~scripts ~more_head ~title body in
+  let doc = El.to_string ~doctype:true page in
+  Drame.Content.Unsafe_doc doc