feat: add tiny-httpd-vfs-pack program

this program takes some directories, files, URLs, and produces an OCaml
module with a virtual file system containing the content of these.
This VFS can be served using Tiny_httpd_dir.

src/bin/dune

@@ -3,5 +3,14 @@
   (name http_of_dir)
   (public_name http_of_dir)
   (package tiny_httpd)
+  (modules http_of_dir)
   (flags :standard -warn-error -3)
   (libraries tiny_httpd))
+
+(executable
+  (name vfs_pack)
+  (public_name tiny-httpd-vfs-pack)
+  (package tiny_httpd)
+  (modules vfs_pack)
+  (libraries curly unix)
+  (flags :standard -warn-error -3))

src/bin/vfs_pack.ml

@@ -0,0 +1,160 @@
+
+let spf = Printf.sprintf
+let fpf = Printf.fprintf
+let now_ = Unix.gettimeofday()
+let verbose = ref false
+
+type entry =
+  | File of string * string
+  | Url of string * string
+  | Mirror of string * string
+  | Source_file of string
+
+let read_file filename =
+  let ic = open_in_bin filename in
+  let buf = Buffer.create 32 in
+  let b = Bytes.create 1024 in
+  while
+    let n=input ic b 0 (Bytes.length b) in
+    Buffer.add_subbytes buf b 0 n;
+    n > 0
+  do () done;
+  close_in ic;
+  Buffer.contents buf
+
+let split_comma s = Scanf.sscanf s "%s@,%s" (fun x y -> x,y)
+
+let is_url s =
+  let is_prefix pre s =
+    String.length s > String.length pre &&
+    String.sub s 0 (String.length pre) = pre
+  in
+  is_prefix "http://" s || is_prefix "https://" s
+
+let emit oc (l:entry list) : unit =
+  fpf oc "let embedded_fs = Tiny_httpd_dir.Embedded_fs.create ~mtime:%f ()\n" now_;
+
+  let add_vfs ~mtime vfs_path content =
+    fpf oc
+      "let () = Tiny_httpd_dir.Embedded_fs.add_file embedded_fs \n  \
+       ~mtime:%h ~path:%S\n  \
+       %S\n"
+      mtime vfs_path content
+  in
+
+  let rec add_entry = function
+    | File (vfs_path, actual_path) ->
+      if !verbose then Printf.eprintf "add file %S = %S\n%!" vfs_path actual_path;
+
+      let content = read_file actual_path in
+      let mtime = (Unix.stat actual_path).Unix.st_mtime in
+      add_vfs ~mtime vfs_path content
+
+    | Url (vfs_path, url) ->
+      if !verbose then Printf.eprintf "add url %S = %S\n%!" vfs_path url;
+
+      begin match Curly.get url with
+        | Ok b ->
+          let code = b.Curly.Response.code in
+          if code >= 200 && code < 300 then (
+            add_vfs ~mtime:now_ vfs_path b.Curly.Response.body
+          ) else (
+            failwith (Printf.sprintf "download of %S failed with code: %d" url code)
+          )
+        | Error err ->
+          failwith (Format.asprintf "download of %S failed: %a" url Curly.Error.pp err)
+      end
+
+    | Mirror (vfs_path, dir) ->
+      if !verbose then Printf.eprintf "mirror directory %S as %S\n%!" dir vfs_path;
+
+      let rec traverse rpath =
+        let real_path = Filename.concat dir rpath in
+        if Sys.is_directory real_path then (
+          let arr = Sys.readdir real_path in
+          Array.iter (fun e -> traverse (Filename.concat rpath e)) arr
+        ) else (
+          add_entry (File (Filename.concat vfs_path rpath, real_path))
+        )
+      in
+      traverse "."
+
+    | Source_file f ->
+      if !verbose then Printf.eprintf "read source file %S\n%!" f;
+
+      let lines =
+        read_file f |> String.split_on_char '\n'
+        |> List.map String.trim
+        |> List.filter ((<>) "")
+      in
+
+      let process_line line =
+        let vfs_path, path = split_comma line in
+        if is_url path then add_entry (Url(vfs_path, path))
+        else add_entry (File (vfs_path, path))
+      in
+
+      List.iter process_line lines
+  in
+  List.iter add_entry l;
+
+  fpf oc "let vfs = Tiny_httpd_dir.Embedded_fs.to_vfs embedded_fs\n";
+  ()
+
+
+let help = {|vfs-pack [opt]+
+
+Builds an OCaml module containing a `Tiny_httpd_dir.Embedded_fs.t`
+virtual file system. This is useful to pack assets into an OCaml binary,
+for example.
+
+Each entry in the VFS can be added from the command line using:
+
+--file=foo/bar,actual/path/to/file to add an entry foo/bar in the VFS
+  with the content of actual/path/to/file. The mtime of the file is preserved.
+
+--url=foo/bar,https://something.com/ to add an entry foo/bar in the VFS
+  with the content of the URL (downloaded using curl).
+
+-F=file reads lines from file. Each line is a pair vfs_path,actual_path
+and is processed as previously. If actual_path looks like an http(s) URL
+it is treated as such.
+|}
+
+
+let () =
+  let entries = ref [] in
+  let out = ref "" in
+
+  let add_entry e = entries := e :: !entries in
+
+  let add_file s =
+    let vfs_path, path = split_comma s in
+    add_entry (File (vfs_path, path))
+  and add_mirror s =
+    let vfs_path, path = split_comma s in
+    let vfs_path, path = if path="" then "", vfs_path else vfs_path, path in
+    add_entry (Mirror (vfs_path, path))
+  and add_url s =
+    let vfs_path, path = split_comma s in
+    if is_url path then add_entry (Url(vfs_path, path))
+    else invalid_arg (spf "--url: invalid URL %S" path)
+  in
+
+  let opts = [
+    "-v", Arg.Set verbose, " verbose mode";
+    "-o", Arg.Set_string out, " set output file";
+    "--file", Arg.String add_file, " <name,file> adds name=file to the VFS";
+    "--url", Arg.String add_url, " <name,url> adds name=url to the VFS";
+    "--mirror", Arg.String add_mirror, " <prefix,dir> copies directory dir into the VFS under prefix";
+  ] |> Arg.align in
+  Arg.parse opts (fun _ -> raise (Arg.Help "no positional arg")) help;
+
+  let out, close =
+    if !out="" then stdout,ignore
+    else open_out !out, close_out
+  in
+  emit out !entries;
+  close out;
+  exit 0
+