diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 6a7f4629..1c002c17 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -10,7 +10,7 @@ on: jobs: build: strategy: - fail-fast: false + fail-fast: true matrix: os: - macos-latest @@ -25,6 +25,8 @@ jobs: steps: - name: Checkout code uses: actions/checkout@v2 + with: + submodules: recursive - name: Use OCaml ${{ matrix.ocaml-compiler }} uses: ocaml/setup-ocaml@v2 @@ -34,7 +36,7 @@ jobs: - run: opam install . --deps-only --with-test - - run: opam exec -- dune build @install + - run: opam exec -- dune build @install -p tiny_httpd,tiny_httpd_camlzip,curly - - run: opam exec -- dune runtest + - run: opam exec -- dune build @src/runtest @examples/runtest if: ${{ matrix.os == 'ubuntu-latest' }} diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 00000000..f5f716b3 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "vendor/curly"] + path = vendor/curly + url = https://github.com/rgrinberg/curly.git diff --git a/README.md b/README.md index 81a8bf07..27e8968d 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,8 @@ # Tiny_httpd [![build](https://github.com/c-cube/tiny_httpd/workflows/build/badge.svg)](https://github.com/c-cube/tiny_httpd/actions) Minimal HTTP server using good old threads, with stream abstractions, -simple routing, URL encoding/decoding, and optional compression with camlzip. +simple routing, URL encoding/decoding, static asset serving, +and optional compression with camlzip. It also supports [server-sent events](https://developer.mozilla.org/en-US/docs/Web/API/Server-sent_events/Using_server-sent_events) ([w3c](https://html.spec.whatwg.org/multipage/server-sent-events.html#event-stream-interpretation)) @@ -67,6 +68,43 @@ $ curl -X GET http://localhost:8080 ``` +## Static assets and files + +The program `http_of_dir` relies on the module `Tiny_httpd_dir`, which +can serve directories, as well as _virtual file systems_. + +In 'examples/dune', we produce an OCaml module `vfs.ml` using +the program `tiny-httpd-vfs-pack`. This module contains a VFS (virtual file +system) which can be served as if it were an actual directory. + +The dune rule: + +```lisp +(rule + (targets vfs.ml) + (deps (source_tree files) (:out test_output.txt.expected)) + (enabled_if (= %{system} "linux")) + (action (run ../src/bin/vfs_pack.exe -o %{targets} + --mirror=files/ + --file=test_out.txt,%{out} + --url=example_dot_com,http://example.com))) +``` + +The code to serve the VFS from `vfs.ml` is as follows: + +```ocaml + … + Tiny_httpd_dir.add_vfs server + ~config:(Tiny_httpd_dir.config ~download:true + ~dir_behavior:Tiny_httpd_dir.Index_or_lists ()) + ~vfs:Vfs.vfs ~prefix:"vfs"; + … +``` + +it allows downloading the files, and listing directories. +If a directory contains `index.html` then this will be served +instead of listing the content. + ## Socket activation Since version 0.10, socket activation is supported indirectly, by allowing a diff --git a/examples/dune b/examples/dune index 83b0aa84..92c22b90 100644 --- a/examples/dune +++ b/examples/dune @@ -12,7 +12,7 @@ (executable (name echo) (flags :standard -warn-error -a+8) - (modules echo) + (modules echo vfs) (libraries tiny_httpd tiny_httpd_camlzip)) (rule @@ -30,3 +30,23 @@ (deps test_output.txt) (action (diff test_output.txt.expected test_output.txt))) + +; produce an embedded FS +(rule + (targets vfs.ml) + (deps (source_tree files) (:out test_output.txt.expected)) + (enabled_if (= %{system} "linux")) + (action (run ../src/bin/vfs_pack.exe -o %{targets} + --mirror=files/ + --file=test_out.txt,%{out} + --url=example_dot_com,http://example.com))) + +(rule + (targets vfs.ml) + (enabled_if (<> %{system} "linux")) + (action + (with-stdout-to + %{targets} + (progn + (echo "let embedded_fs = Tiny_httpd_dir.Embedded_fs.create ~mtime:0. ()") + (echo "let vfs = Tiny_httpd_dir.Embedded_fs.to_vfs embedded_fs"))))) diff --git a/examples/echo.ml b/examples/echo.ml index f77bbe72..d2ae7b16 100644 --- a/examples/echo.ml +++ b/examples/echo.ml @@ -107,16 +107,23 @@ let () = S.Response.make_string @@ Ok stats ); + (* VFS *) + Tiny_httpd_dir.add_vfs server + ~config:(Tiny_httpd_dir.config ~download:true + ~dir_behavior:Tiny_httpd_dir.Index_or_lists ()) + ~vfs:Vfs.vfs ~prefix:"vfs"; + (* main page *) S.add_route_handler server S.Route.(return) (fun _req -> let s = "\n\

welcome!\n

endpoints are:\n

" in S.Response.make_string ~headers:["content-type", "text/html"] @@ Ok s); diff --git a/examples/files/a.txt b/examples/files/a.txt new file mode 100644 index 00000000..94954abd --- /dev/null +++ b/examples/files/a.txt @@ -0,0 +1,2 @@ +hello +world diff --git a/examples/files/foo.html b/examples/files/foo.html new file mode 100644 index 00000000..2f00ada8 --- /dev/null +++ b/examples/files/foo.html @@ -0,0 +1,18 @@ + + + + + + +

hello!

+ + + escape from this file + + + diff --git a/examples/files/sub/b.txt b/examples/files/sub/b.txt new file mode 100644 index 00000000..8493a14a --- /dev/null +++ b/examples/files/sub/b.txt @@ -0,0 +1 @@ +lorem ipsum etc. diff --git a/examples/files/sub/yolo.html b/examples/files/sub/yolo.html new file mode 100644 index 00000000..c7ecbf5e --- /dev/null +++ b/examples/files/sub/yolo.html @@ -0,0 +1,18 @@ + + + + + + +

funky:

+ + + + diff --git a/src/Tiny_httpd_dir.ml b/src/Tiny_httpd_dir.ml index 3aadfdc6..6fe9a6ac 100644 --- a/src/Tiny_httpd_dir.ml +++ b/src/Tiny_httpd_dir.ml @@ -5,22 +5,36 @@ module Pf = Printf type dir_behavior = | Index | Lists | Index_or_lists | Forbidden +type hidden = unit type config = { mutable download: bool; mutable dir_behavior: dir_behavior; mutable delete: bool; mutable upload: bool; mutable max_upload_size: int; + _rest: hidden } -let default_config () : config = +let default_config_ : config = { download=true; dir_behavior=Forbidden; delete=false; upload=false; max_upload_size = 10 * 1024 * 1024; + _rest=(); } +let default_config () = default_config_ +let config + ?(download=default_config_.download) + ?(dir_behavior=default_config_.dir_behavior) + ?(delete=default_config_.delete) + ?(upload=default_config_.upload) + ?(max_upload_size=default_config_.max_upload_size) + () : config = + { download; dir_behavior; delete; upload; max_upload_size; + _rest=()} + let contains_dot_dot s = try String.iteri @@ -45,20 +59,59 @@ let _decode_path s = match U.percent_decode s with Some s->s | None -> s let is_hidden s = String.length s>0 && s.[0] = '.' -let html_list_dir ~top ~parent d : string = - let entries = Sys.readdir @@ (top // d) in +module type VFS = sig + val descr : string + val is_directory : string -> bool + val contains : string -> bool + val list_dir : string -> string array + val delete : string -> unit + val create : string -> (bytes -> int -> int -> unit) * (unit -> unit) + val read_file_content : string -> Tiny_httpd.Byte_stream.t + val file_size : string -> int option + val file_mtime : string -> float option +end + +type vfs = (module VFS) + +let vfs_of_dir (top:string) : vfs = + let module M = struct + let descr = top + let (//) = Filename.concat + let is_directory f = Sys.is_directory (top // f) + let contains f = Sys.file_exists (top // f) + let list_dir f = Sys.readdir (top // f) + let read_file_content f = + let ic = open_in_bin (top // f) in + S.Byte_stream.of_chan ic + let create f = + let oc = open_out_bin (top // f) in + let write = output oc in + let close() = close_out oc in + write, close + let delete f = Sys.remove (top // f) + let file_size f = + try Some (Unix.stat (top // f)).Unix.st_size + with _ -> None + let file_mtime f = + try Some (Unix.stat (top // f)).Unix.st_mtime + with _ -> None + end in + (module M) + +let html_list_dir (module VFS:VFS) ~prefix ~parent d : string = + let entries = VFS.list_dir d in Array.sort compare entries; let body = Buffer.create 256 in (* TODO: breadcrumbs for the path, each element a link to the given ancestor dir *) - Printf.bprintf body {| http_of_dir %S + Printf.bprintf body {| list directory %S

Index of %S

- |} top d; + |} VFS.descr d; begin match parent with | None -> () | Some p -> Printf.bprintf body " (parent directory) \n" - (encode_path p); + (encode_path (prefix // p)); end; Printf.bprintf body "