Merge branch 'tar'

builder-web.opam

@@ -49,6 +49,7 @@ depends: [
   "omd"
   "modulectomy"
   "opam-graph"
+  "tar"
 ]
 
 synopsis: "Web interface for builder"

lib/builder_web.ml

@@ -338,6 +338,23 @@ let add_routes datadir =
     Views.failed_builds ~start ~count builds |> string_of_html |> Dream.html |> Lwt_result.ok
   in
 
+  let job_build_tar req =
+    let datadir = Dream.global datadir_global req in
+    let _job_name = Dream.param "job" req
+    and build = Dream.param "build" req in
+    get_uuid build >>= fun build ->
+    Dream.sql req (Model.build build)
+    |> if_error "Error getting build" >>= fun (build_id, build) ->
+    Dream.sql req (Model.build_artifacts build_id)
+    |> if_error "Error getting artifacts" >>= fun artifacts ->
+    Ptime.diff build.finish Ptime.epoch |> Ptime.Span.to_int_s
+    |> Option.to_result ~none:(`Msg "bad finish time") |> Result.map Int64.of_int
+    |> Lwt.return |> if_error "Internal server error" >>= fun finish ->
+    Dream.stream ~headers:["Content-Type", "application/x-tar"]
+      (Dream_tar.tar_response datadir finish artifacts)
+    |> Lwt_result.ok
+  in
+
   let upload req =
     let* body = Dream.body req in
     Builder.Asn.exec_of_cs (Cstruct.of_string body) |> Lwt.return
@@ -476,6 +493,7 @@ let add_routes datadir =
     Dream.get "/job/:job/build/:build/script" (w (job_build_static_file `Script));
     Dream.get "/job/:job/build/:build/console" (w (job_build_static_file `Console));
     Dream.get "/failed-builds/" (w failed_builds);
+    Dream.get "/job/:job/build/:build/all.tar" (w job_build_tar);
     Dream.get "/hash" (w hash);
     Dream.get "/compare/:build_left/:build_right/" (w compare_builds);
     Dream.post "/upload" (Authorization.authenticate (w upload));

lib/dream_tar.ml

@@ -0,0 +1,43 @@
+open Lwt.Infix
+
+module Writer = struct
+  type out_channel = Dream.response
+  type 'a t = 'a Lwt.t
+  let really_write response cs =
+    Dream.write response (Cstruct.to_string cs)
+end
+
+module HW = Tar.HeaderWriter(Lwt)(Writer)
+
+let write_block (header : Tar.Header.t) lpath response =
+  HW.write ~level:Tar.Header.Ustar header response >>= fun () ->
+  Lwt_io.open_file ~mode:Lwt_io.Input (Fpath.to_string lpath) >>= fun ic ->
+  let buf_len = 4 * 1024 * 1024 in
+  let buf = Bytes.create buf_len in
+  let rec loop () =
+    Lwt_io.read_into ic buf 0 buf_len >>= fun r ->
+    if r = 0 then
+      Lwt.return_unit
+    else
+      Dream.write response (Bytes.sub_string buf 0 r) >>= fun () ->
+      loop ()
+  in
+  loop () >>= fun () ->
+  Dream.write_buffer response (Cstruct.to_bigarray (Tar.Header.zero_padding header))
+
+let header_of_file mod_time (file : Builder_db.file) =
+  let file_mode = if Fpath.is_prefix Fpath.(v "bin/") file.filepath then
+      0o755
+    else
+      0o644
+  in
+  Tar.Header.make ~file_mode ~mod_time (Fpath.to_string file.filepath) (Int64.of_int file.size)
+
+let tar_response datadir finish (files : Builder_db.file list) (response : Dream.response) =
+  Lwt_list.iter_s (fun file ->
+      let hdr = header_of_file finish file in
+      write_block hdr Fpath.(datadir // file.localpath) response)
+    files >>= fun () ->
+  Writer.really_write response Tar.Header.zero_block >>= fun () ->
+  Writer.really_write response Tar.Header.zero_block >>= fun () ->
+  Dream.close_stream response

lib/dune

@@ -3,10 +3,9 @@
  (libraries
   builder builder_db
   dream tyxml bos duration hex caqti-lwt
-  opamdiff ptime.clock.os omd
+  opamdiff ptime.clock.os omd tar
   modulectomy
   opam-graph
   )
  (flags (:standard))
  )
-