diff --git a/src/assets.ml b/src/assets.ml index 3fff233c..dbc408d2 100644 --- a/src/assets.ml +++ b/src/assets.ml @@ -75,12 +75,6 @@ let supported_lang_arr, supported_ext_arr = let lang_l, ext_l = aux Terms in let lang_l', ext_l' = aux Privacy in let () = - List.iter - (fun path -> - if not @@ Util.is_valid_filename path then - Fmt.failwith "file `%s` has an unsupported extension" - (Fpath.to_string path)) - path_l; if not @@ (List.equal String.equal lang_l lang_l' @@ -94,7 +88,7 @@ let supported_lang_arr, supported_ext_arr = (Array.of_list lang_l, Array.of_list ext_l) let supported_mimetype_arr = - Array.map Util.extension_to_mimetype supported_ext_arr |> Array.map Option.get + Array.map Util.Mimetype.of_extension supported_ext_arr |> Array.map Option.get let is_supported_lang lang = Array.mem lang supported_lang_arr let is_supported_ext ext = Array.mem ext supported_ext_arr @@ -107,7 +101,7 @@ let is_supported_mimetype mime = Array.mem mime supported_mimetype_arr let get_content ~lang ~mime t = let etag = Headers_lib.Etag.to_raw_string (etag t) in let ext = - match Util.mimetype_to_extension mime with + match Util.Mimetype.to_extension mime with | None -> Fmt.failwith "mimetype `%s/%s` unknown" (fst mime) (snd mime) | Some ext -> ext in diff --git a/src/headers.ml b/src/headers.ml index 5ae0c4a7..7c6525f0 100644 --- a/src/headers.ml +++ b/src/headers.ml @@ -10,7 +10,7 @@ let select_mimetype headers = let accept = Vif.Headers.get headers "accept" in Cohttp.Accept.media_ranges accept |> Cohttp.Accept.qsort - |> List.filter_map (fun (_q, (m, _p)) -> Util.media_to_known_mimetype m) + |> List.filter_map (fun (_q, (m, _p)) -> Util.Mimetype.of_cohttp_media m) |> List.find_opt Assets.is_supported_mimetype let select_language headers = diff --git a/src/util.ml b/src/util.ml index d3be0ab5..dc7544c9 100644 --- a/src/util.ml +++ b/src/util.ml @@ -1,33 +1,42 @@ -let mimetype_ext_assoc = - [ - (("text", "plain"), ".txt"); (("text", "markdown"), ".md") - ; (("text", "html"), ".html"); (("text", "html"), ".htm") - ; (("application", "pdf"), ".pdf"); (("image", "jpeg"), ".jpg") - ; (("image", "jpeg"), ".jpeg"); (("image", "png"), ".png") - ; (("image", "gif"), ".gif") - ] +module Protocol_version = struct + (* libtool version format *) + (* todo *) + let current = 0 + let revision = 0 + let age = 0 + let v = Fmt.str "%d:%d:%d" +end -(* <> than the actual set of "supported" extension (which depends on config files) *) -let all_known_mimetypes, all_known_extensions = List.split mimetype_ext_assoc -let is_valid_filename path = Fpath.mem_ext all_known_extensions path +module Mimetype = struct + let mimetype_extension_assoc = + [ + (("text", "plain"), ".txt"); (("text", "markdown"), ".md") + ; (("text", "html"), ".html"); (("text", "html"), ".htm") + ; (("application", "pdf"), ".pdf"); (("image", "jpeg"), ".jpg") + ; (("image", "jpeg"), ".jpeg"); (("image", "png"), ".png") + ; (("image", "gif"), ".gif") + ] -let media_to_known_mimetype = function - | Cohttp.Accept.MediaType (m, m_sub) -> - List.find_opt (( = ) (m, m_sub)) all_known_mimetypes - | AnyMediaSubtype m -> - List.find_opt (fun (m', _) -> String.equal m m') all_known_mimetypes - | AnyMedia -> Some Config.default_mimetype + let mimetype_l, _ = List.split mimetype_extension_assoc -let mimetype_to_extension (m, m_sub) = - assert (m <> "*"); - assert (m_sub <> "*"); - List.assoc_opt (m, m_sub) mimetype_ext_assoc + let of_cohttp_media = function + | Cohttp.Accept.MediaType (m, m_sub) -> + List.find_opt (( = ) (m, m_sub)) mimetype_l + | AnyMediaSubtype m -> + List.find_opt (fun (m', _) -> String.equal m m') mimetype_l + | AnyMedia -> Some Config.default_mimetype -let extension_to_mimetype ext = - List.find_map - (fun (mime, ext') -> - match String.equal ext ext' with false -> None | true -> Some mime) - mimetype_ext_assoc + let to_extension (m, m_sub) = + assert (m <> "*"); + assert (m_sub <> "*"); + List.assoc_opt (m, m_sub) mimetype_extension_assoc + + let of_extension ext = + List.find_map + (fun (mime, ext') -> + match String.equal ext ext' with false -> None | true -> Some mime) + mimetype_extension_assoc +end (* -- pretty printers -- *) let pp_mime fmt mime = Fmt.pf fmt "%s/%s" (fst mime) (snd mime)