111 lines
4.1 KiB
OCaml
111 lines
4.1 KiB
OCaml
open Drame
|
|
open Lang
|
|
|
|
let get_img =
|
|
let forbidden_characters =
|
|
let tbl = Hashtbl.create 16 in
|
|
Array.iter (fun c -> Hashtbl.replace tbl c ()) [| '.'; '/'; '\\' |];
|
|
tbl
|
|
in
|
|
let allowed_extensions =
|
|
let tbl = Hashtbl.create 16 in
|
|
Array.iter (fun e -> Hashtbl.replace tbl e ()) [| ".jpeg"; ".png"; ".gif" |];
|
|
tbl
|
|
in
|
|
fun ~fname request ->
|
|
let without_extension, extension = Fpath.split_ext fname in
|
|
if
|
|
String.exists
|
|
(Hashtbl.mem forbidden_characters)
|
|
(Fpath.to_string without_extension)
|
|
|| (not @@ Hashtbl.mem allowed_extensions extension)
|
|
then
|
|
let fr = Fmt.str "Nom de fichier invalide: %a." Fpath.pp fname in
|
|
let en = Fmt.str "Invalid filename: %a." Fpath.pp fname in
|
|
let h1 = { en = "Bad request"; fr = "Requête invalid" } in
|
|
let doc = Template.render request ~h1 (Lang.txt request ~en ~fr) in
|
|
Error (Status.Bad_request, doc)
|
|
else
|
|
let path = Fpath.(App.path_to_images // fname) in
|
|
match Bos.OS.File.read path with
|
|
| Error (`Msg e) ->
|
|
let h1 = { en = e; fr = e } in
|
|
let doc = Template.render request ~h1 (Lang.txt_anylang e) in
|
|
Error (Status.Internal_server_error, doc)
|
|
| Ok content ->
|
|
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 (Fpath.to_string filename) with
|
|
| None ->
|
|
let fr = Fmt.str "Nom de fichier invalide: %a." Fpath.pp filename in
|
|
let en = Fmt.str "Invalid filename: %a." Fpath.pp filename in
|
|
let h1 = { fr = "Requête invalide"; en = "Bad request" } in
|
|
let doc = Template.render request ~h1 (Lang.txt request ~en ~fr) in
|
|
Error (Status.Bad_request, doc)
|
|
| Some content -> (
|
|
let extension = Fpath.get_ext 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 content =
|
|
Lang.txt request ~en:"The favicon is not where you think it is!"
|
|
~fr:"La favicon n'est pas là où vous croyez !"
|
|
in
|
|
let h1 = { fr = "Favicon"; en = "Favicon" } in
|
|
let doc = Template.render request ~h1 content in
|
|
Error (Status.Moved_permanently Sitemap.favicon, doc)
|
|
|
|
let handler = function
|
|
| [||] -> Home.get
|
|
| [| "assets"; "css"; fname |] -> (
|
|
fun request ->
|
|
match Fpath.of_string fname with
|
|
| Error (`Msg e) ->
|
|
let h1 = { en = e; fr = e } in
|
|
let doc = Template.render request ~h1 (Lang.txt_anylang e) in
|
|
Error (Status.Internal_server_error, doc)
|
|
| Ok fname -> get_asset request ~filename:Fpath.(v "css" // fname) )
|
|
| [| "assets"; "fonts"; fname |] -> (
|
|
fun request ->
|
|
match Fpath.of_string fname with
|
|
| Error (`Msg e) ->
|
|
let h1 = { en = e; fr = e } in
|
|
let doc = Template.render request ~h1 (Lang.txt_anylang e) in
|
|
Error (Status.Internal_server_error, doc)
|
|
| Ok fname -> get_asset request ~filename:Fpath.(v "fonts" // fname) )
|
|
| [| "assets"; "img"; fname |] -> (
|
|
fun request ->
|
|
match Fpath.of_string fname with
|
|
| Error (`Msg e) ->
|
|
let h1 = { en = e; fr = e } in
|
|
let doc = Template.render request ~h1 (Lang.txt_anylang e) in
|
|
Error (Status.Internal_server_error, doc)
|
|
| Ok fname -> get_img request ~fname )
|
|
| [| "favicon.ico" |] -> get_favicon
|
|
| [| "about" |] -> About.get
|
|
| [| "contact" |] -> Contact.get
|
|
| [| "lang"; "fr" |] -> Set_lang.to_french
|
|
| [| "lang"; "en" |] -> Set_lang.to_english
|
|
| [| "projects" |] -> Projects.get
|
|
| [| "projects"; id |] -> Projects.get_one ~id
|
|
| [| "services" |] -> Services.get
|
|
| _ ->
|
|
fun request ->
|
|
let h1 = { en = "Not found"; fr = "Page inexistante" } in
|
|
let content = txt request ~en:"Not found" ~fr:"Page inexistante" in
|
|
let doc = Template.render request ~h1 content in
|
|
Error (Status.Not_found, doc)
|
|
|
|
let () = App.run ~handler
|