Redirect fileserver towards https

- Add `location` to `Http.Request.Hdr`
- Add `response_redirect` method to `http-svr`
- When `GET` is received by the fileserver and `website-https-only` is true:
    - if `host` is filled in the request, redirect towards the same URI but in HTTPS
    - if `host` is not present, reply with a forbidden as before

Solves xapi-project#4856

Signed-off-by: BenjiReis <benjamin.reis@vates.fr>

ocaml/libs/http-svr/http.ml

@@ -122,6 +122,8 @@ module Hdr = struct
   let content_disposition = "content-disposition"
 
   let accept = "accept"
+
+  let location = "location"
 end
 
 let output_http fd headers =

ocaml/libs/http-svr/http.mli

@@ -225,6 +225,8 @@ module Hdr : sig
   val content_disposition : string
 
   val accept : string
+
+  val location : string
 end
 
 val output_http : Unix.file_descr -> string list -> unit

ocaml/libs/http-svr/http_svr.ml

@@ -210,6 +210,15 @@ let response_method_not_implemented ?req s =
   in
   response_error_html ?version s "501" "Method not implemented" [] body
 
+let response_redirect ?req s dest =
+  let version = Option.fold ~none:"1.1" ~some:get_return_version req in
+  let location = (Http.Hdr.location, dest) in
+  let res =
+    Http.Response.make ~version ~headers:[location] ~body:"" "301"
+      "Moved Permanently"
+  in
+  Unixext.really_write_string s (Http.Response.to_wire_string res)
+
 let response_file ?mime_content_type s file =
   let size = (Unix.LargeFile.stat file).Unix.LargeFile.st_size in
   let mime_header =

ocaml/libs/http-svr/http_svr.mli

@@ -119,6 +119,8 @@ val response_internal_error :
 val response_method_not_implemented :
   ?req:Http.Request.t -> Unix.file_descr -> unit
 
+val response_redirect : ?req:Http.Request.t -> Unix.file_descr -> string -> unit
+
 val response_file :
   ?mime_content_type:string -> Unix.file_descr -> string -> unit
 

ocaml/xapi/fileserver.ml

@@ -90,7 +90,14 @@ let send_file (uri_base : string) (dir : string) (req : Request.t)
   let s = Buf_io.fd_of bio in
   Buf_io.assert_buffer_empty bio ;
   if access_forbidden req s then
-    Http_svr.response_forbidden ~req s
+    match req.Request.host with
+    | Some host ->
+        (* Redirect towards HTTPS *)
+        let path = String.concat "" [uri_base; req.Request.uri] in
+        let dest = Uri.make ~scheme:"https" ~host ~path () |> Uri.to_string in
+        Http_svr.response_redirect ~req s dest
+    | None ->
+        Http_svr.response_forbidden ~req s
   else
     let uri = req.Request.uri in
     try