From 7ad27f3e70b6c2262cda58c62b567bc31f6bcff3 Mon Sep 17 00:00:00 2001
From: Adam Ringwood <adam.ringwood@elastic.co>
Date: Wed, 10 Mar 2021 15:04:35 -0600
Subject: [PATCH 01/14] init commit.

---
 agent/agent.ml | 58 ++++++++++++++++++++++++++++++++++++++++++++------
 agent/dune     |  4 ++--
 makecloud.opam |  2 +-
 3 files changed, 54 insertions(+), 10 deletions(-)

diff --git a/agent/agent.ml b/agent/agent.ml
index 18fb94c..99b8e44 100644
--- a/agent/agent.ml
+++ b/agent/agent.ml
@@ -57,7 +57,16 @@ let run_command ~command =
   let out = Lwt_io.(read_lines (of_fd ~mode:Input lwt_ofd)) in
   let lwt_efd, efd = Lwt_unix.pipe_in () in
   let err = Lwt_io.(read_lines (of_fd ~mode:Input lwt_efd)) in
-  let status = Lwt_process.exec ~env:(Array.append !env additional_env) ~stdout:(`FD_copy ofd) ~stderr:(`FD_copy efd) command in
+  let status = 
+    let result = Lwt_process.exec ~env:(Array.append !env additional_env) ~stdout:(`FD_copy ofd) ~stderr:(`FD_copy efd) command in
+    let parse_result = function
+      | Unix.WEXITED 0 ->
+        Lwt.return true 
+      | Unix.WEXITED _ | WSIGNALED _ | WSTOPPED _ ->
+        Lwt.return false 
+    in
+    Lwt.bind result parse_result
+  in 
   Lwt.return (status, out, err)
 
 let authentication key req =
@@ -68,6 +77,32 @@ let authentication key req =
   | _ ->
       false
 
+module Upload = struct
+  type t = { 
+    src_file : string;
+    dst_url : string; 
+  } [@@deriving of_yojson] 
+
+  let process_body body = 
+    let json = Yojson.Safe.from_string body in
+    of_yojson json |> R.reword_error R.msg
+
+  let process_upload body =
+    let _cmd = process_body body in
+    let out_stream, out_push = Lwt_stream.create () in
+    let err_stream, err_push = Lwt_stream.create () in
+    let promise = 
+      let%lwt f = Lwt_io.open_file ~mode:Input "/tmp/test" in
+      let s = Lwt_io.read_lines f in
+      let _body = Cohttp_lwt.Body.of_stream s in
+      let () = out_push (Some "Upload successfully") in
+      let () = out_push (None) in
+      let () = err_push (None) in
+      Lwt.return true
+    in
+    Lwt.return (promise, out_stream, err_stream)
+end
+
 let http_command _req body =
   let%lwt command = Cohttp_lwt.Body.to_string body in
   let promise =
@@ -78,6 +113,16 @@ let http_command _req body =
   cmds := (id, promise) :: !cmds ;
   Server.respond_string ~status:`Accepted ~body:(string_of_int id) ()
 
+let http_upload _req body =
+  let%lwt raw_body = Cohttp_lwt.Body.to_string body in
+  let promise =
+    Upload.process_upload raw_body
+  in
+  let id = !next_id in
+  next_id := id + 1 ;
+  cmds := (id, promise) :: !cmds ;
+  Server.respond_string ~status:`Accepted ~body:(string_of_int id) ()
+
 (* TOOD: Figure out how to handle this better. Probably should use norest once that gets open sourced.*)
 let get_command req =
   let uri = Cohttp_lwt_unix.Request.uri req in
@@ -137,13 +182,10 @@ let http_check_command req body =
     | Lwt.Return (s) -> (
       let%lwt current_logs = handle_output job_id out err in
       match s with
-      | Unix.WEXITED 0 ->
+      | true ->
           Server.respond_string ~status:`OK ~body:current_logs ()
-      | Unix.WEXITED i ->
-          Server.respond_string ~status:`Unprocessable_entity ~body:(Printf.sprintf "job failed with error code %d, logs:\n%s\n" i current_logs) ()
-      | _ ->
-          Server.respond_string ~status:`Unprocessable_entity
-            ~body:(sprintf "failure to run command. logs are \n%s\n" current_logs) () ) )
+      | false ->
+          Server.respond_string ~status:`Unprocessable_entity ~body:(Printf.sprintf "job failed error, logs:\n%s\n" current_logs) ()))
 
 let http_set_env _req body =
   let%lwt json_body = Cohttp_lwt.Body.to_string body in
@@ -182,6 +224,8 @@ let router req body =
   match Uri.path uri with
   | "/command" ->
       http_command req body
+  | "/upload" ->
+      http_upload req body
   | "/check_command" ->
       http_check_command req body
   | "/set_env" ->
diff --git a/agent/dune b/agent/dune
index 4e5aefd..af6b965 100644
--- a/agent/dune
+++ b/agent/dune
@@ -1,7 +1,7 @@
 (executable
  (name agent)
- (libraries lwt.unix cmdliner cohttp-lwt-unix yojson rresult)
- (preprocess (pps lwt_ppx ocaml-monadic)))
+ (libraries lwt.unix cmdliner cohttp-lwt-unix yojson rresult ppx_deriving_yojson.runtime)
+ (preprocess (pps lwt_ppx ocaml-monadic ppx_deriving_yojson)))
 
 (alias
   (name makecloud-agent)
diff --git a/makecloud.opam b/makecloud.opam
index 174376a..8aacdd0 100644
--- a/makecloud.opam
+++ b/makecloud.opam
@@ -43,4 +43,4 @@ depends: [
   "yojson"
 ]
 synopsis: "A simple build system for complex builds"
-available: [ ocaml-version >= "4.05.0" ]
+available: [ ocaml-version >= "4.08.0" ]

From 392ff94910f278fbb77ba07b3da29c1bf116afa7 Mon Sep 17 00:00:00 2001
From: Adam Ringwood <adam.ringwood@elastic.co>
Date: Thu, 11 Mar 2021 15:38:15 -0600
Subject: [PATCH 02/14] add agent upload/download functions.

---
 agent/agent.ml | 140 ++++++++++++++++++++++++++++++++++++++-----------
 agent/dune     |   2 +-
 2 files changed, 111 insertions(+), 31 deletions(-)

diff --git a/agent/agent.ml b/agent/agent.ml
index 99b8e44..2153444 100644
--- a/agent/agent.ml
+++ b/agent/agent.ml
@@ -77,34 +77,111 @@ let authentication key req =
   | _ ->
       false
 
-module Upload = struct
+module File_transfer = struct
   type t = { 
-    src_file : string;
-    dst_url : string; 
+    src : string;
+    dst : string; 
   } [@@deriving of_yojson] 
 
+	type direction = Upload | Download
+
   let process_body body = 
     let json = Yojson.Safe.from_string body in
     of_yojson json |> R.reword_error R.msg
 
-  let process_upload body =
-    let _cmd = process_body body in
+  let upload cmd out_push err_push () =
+    let (let*) = Lwt.bind in
+		let* f = Lwt_io.open_file ~mode:Input cmd.src in
+		let s = Lwt_io.read_lines f in
+		let body = Cohttp_lwt.Body.of_stream s in
+		let uri = Uri.of_string cmd.dst in
+		let* response, rbody = Cohttp_lwt_unix.Client.put ~chunked:false ~body uri in
+		let* result = match response.status with
+		| #Cohttp.Code.success_status ->
+			let () = out_push (Some "Upload successful.\n") in
+			Lwt.return true
+		| #Cohttp.Code.server_error_status ->
+			let* msg = Cohttp_lwt.Body.to_string rbody in
+			let () = err_push (Some (Fmt.str "Upload failed from server with body:\n %s\n" msg)) in
+			Lwt.return false 
+		| _ as c ->
+			let* msg = Cohttp_lwt.Body.to_string rbody in
+			let code = Cohttp.Code.string_of_status c in
+			let () = err_push (Some (Fmt.str "Upload failed from server with code %s and body:\n %s\n" code msg)) in
+			Lwt.return false 
+		in
+		Lwt.return result
+
+  let download cmd out_push err_push () =
+    let (let*) = Lwt.bind in
+		let uri = Uri.of_string cmd.src in
+		let* response, rbody = Cohttp_lwt_unix.Client.get uri in
+		let* result = match response.status with
+		| #Cohttp.Code.success_status ->
+		  let* f = Lwt_io.open_file ~mode:Output cmd.dst in
+		  let body = Cohttp_lwt.Body.to_stream rbody in
+		  let* () = Lwt_io.write_lines f body in
+			let () = out_push (Some "Download successful.\n") in
+			Lwt.return true
+		| #Cohttp.Code.server_error_status ->
+			let* msg = Cohttp_lwt.Body.to_string rbody in
+			let () = err_push (Some (Fmt.str "Download failed from server with body:\n %s\n" msg)) in
+			Lwt.return false 
+		| _ as c ->
+			let* msg = Cohttp_lwt.Body.to_string rbody in
+			let code = Cohttp.Code.string_of_status c in
+			let () = err_push (Some (Fmt.str "Download failed from server with code %s and body:\n %s\n" code msg)) in
+			Lwt.return false 
+		in
+		Lwt.return result
+
+  let close out_push err_push =
+		out_push (None);
+		err_push (None);
+    ()
+
+  let process direction body =
+    let (let+) = Lwt_result.bind in
+    let (let*) = Lwt.bind in
+    let+ cmd = Lwt.return @@ process_body body in
     let out_stream, out_push = Lwt_stream.create () in
     let err_stream, err_push = Lwt_stream.create () in
-    let promise = 
-      let%lwt f = Lwt_io.open_file ~mode:Input "/tmp/test" in
-      let s = Lwt_io.read_lines f in
-      let _body = Cohttp_lwt.Body.of_stream s in
-      let () = out_push (Some "Upload successfully") in
+    let rec promise n () = 
+      let* result = match direction with
+      | Upload -> upload cmd out_push err_push ()
+      | Download -> download cmd out_push err_push ()
+      in
+      match result with
+      | true -> 
+        let () = close out_push err_push in Lwt.return true
+      | false -> if n <= 1 then let () = close out_push err_push in Lwt.return false else promise (n - 1) ()
+    in 
+    Lwt_result.return (promise 3 (), out_stream, err_stream)
+
+  let handle direction body = 
+    let (let+) = Lwt.bind in
+    let+ result = process direction body in
+    match result with
+    | Ok (p, out, err) -> Lwt.return (p, out, err)
+    | Error `Msg e ->
+      let out_stream, out_push = Lwt_stream.create () in
+      let err_stream, err_push = Lwt_stream.create () in
+      let () = out_push (Some (Fmt.str "Failed to transfer file: %s" e)) in
       let () = out_push (None) in
       let () = err_push (None) in
-      Lwt.return true
-    in
-    Lwt.return (promise, out_stream, err_stream)
+      let promise = Lwt.return false in
+      Lwt.return (promise, out_stream, err_stream)
+
+  let handle_upload body =
+    handle Upload body
+
+  let handle_download body =
+    handle Download body
 end
 
 let http_command _req body =
-  let%lwt command = Cohttp_lwt.Body.to_string body in
+  let (let+) = Lwt.bind in
+  let+ command = Cohttp_lwt.Body.to_string body in
   let promise =
     run_command ~command:(Lwt_process.shell command)
   in
@@ -113,11 +190,10 @@ let http_command _req body =
   cmds := (id, promise) :: !cmds ;
   Server.respond_string ~status:`Accepted ~body:(string_of_int id) ()
 
-let http_upload _req body =
-  let%lwt raw_body = Cohttp_lwt.Body.to_string body in
-  let promise =
-    Upload.process_upload raw_body
-  in
+let http_file_transfer fn _req body =
+  let (let+) = Lwt.bind in
+  let+ raw_body = Cohttp_lwt.Body.to_string body in
+  let promise = fn raw_body in
   let id = !next_id in
   next_id := id + 1 ;
   cmds := (id, promise) :: !cmds ;
@@ -126,22 +202,22 @@ let http_upload _req body =
 (* TOOD: Figure out how to handle this better. Probably should use norest once that gets open sourced.*)
 let get_command req =
   let uri = Cohttp_lwt_unix.Request.uri req in
-  let bind = R.bind in
-  let%bind str_id =
+  let (let+) = R.bind in
+  let+ str_id =
     match Uri.get_query_param uri "id" with
     | None ->
         R.error (`Bad_request, "must supply an id parameter that is a number.")
     | Some i ->
         R.ok i
   in
-  let%bind id =
+  let+ id =
     match int_of_string_opt str_id with
     | None ->
         R.error (`Bad_request, "Your id parameter must be a number.")
     | Some x ->
         R.ok x
   in
-  let%bind promise =
+  let+ promise =
     match List.assoc_opt id !cmds with
     | None ->
         R.error (`Not_found, "No such command.")
@@ -165,22 +241,23 @@ let handle_output job_id out err =
     Lwt.return (String.concat "\n" (lines))
 
 let http_check_command req body =
-  let%lwt () = Cohttp_lwt.Body.drain_body body in
+  let (let+) = Lwt.bind in
+  let+ () = Cohttp_lwt.Body.drain_body body in
   match get_command req with
   | Error (code, msg) ->
       Server.respond_string ~status:code ~body:msg ()
   | Ok (job_id, p) -> (
-    let%lwt status, out, err = p in
+    let+ status, out, err = p in
     match Lwt.state status with
     | Lwt.Sleep ->
-        let%lwt current_logs = handle_output job_id out err in
+        let+ current_logs = handle_output job_id out err in
         Server.respond_string ~status:`Accepted
           ~body:current_logs ()
     | Lwt.Fail e ->
         Server.respond_string ~status:`Internal_server_error
-          ~body:(sprintf "Something went very wrong will running command: %s." (Printexc.to_string e)) ()
+          ~body:(sprintf "Something went wrong while processing command: %s." (Printexc.to_string e)) ()
     | Lwt.Return (s) -> (
-      let%lwt current_logs = handle_output job_id out err in
+      let+ current_logs = handle_output job_id out err in
       match s with
       | true ->
           Server.respond_string ~status:`OK ~body:current_logs ()
@@ -188,7 +265,8 @@ let http_check_command req body =
           Server.respond_string ~status:`Unprocessable_entity ~body:(Printf.sprintf "job failed error, logs:\n%s\n" current_logs) ()))
 
 let http_set_env _req body =
-  let%lwt json_body = Cohttp_lwt.Body.to_string body in
+  let (let+) = Lwt.bind in
+  let+ json_body = Cohttp_lwt.Body.to_string body in
   let json = Yojson.Basic.from_string json_body in
   (* TODO: if this isn't an assoc, this will crash. *)
   let dirty_pairs = Yojson.Basic.Util.to_assoc json in
@@ -225,7 +303,9 @@ let router req body =
   | "/command" ->
       http_command req body
   | "/upload" ->
-      http_upload req body
+      http_file_transfer File_transfer.handle_upload req body
+  | "/download" ->
+      http_file_transfer File_transfer.handle_download req body
   | "/check_command" ->
       http_check_command req body
   | "/set_env" ->
diff --git a/agent/dune b/agent/dune
index af6b965..212d652 100644
--- a/agent/dune
+++ b/agent/dune
@@ -1,7 +1,7 @@
 (executable
  (name agent)
  (libraries lwt.unix cmdliner cohttp-lwt-unix yojson rresult ppx_deriving_yojson.runtime)
- (preprocess (pps lwt_ppx ocaml-monadic ppx_deriving_yojson)))
+ (preprocess (pps ppx_deriving_yojson)))
 
 (alias
   (name makecloud-agent)

From c8a204368d97606375024f6b9d9b6a03ff4a6192 Mon Sep 17 00:00:00 2001
From: Adam Ringwood <adam.ringwood@elastic.co>
Date: Thu, 11 Mar 2021 16:04:59 -0600
Subject: [PATCH 03/14] fix runner.

---
 engine/provider_aws.ml      | 27 +++++++++++++++++----------
 engine/provider_stub.ml     |  2 +-
 engine/provider_template.ml |  3 +--
 engine/runner.ml            | 24 +-----------------------
 4 files changed, 20 insertions(+), 36 deletions(-)

diff --git a/engine/provider_aws.ml b/engine/provider_aws.ml
index 77f9d7c..e147e9a 100644
--- a/engine/provider_aws.ml
+++ b/engine/provider_aws.ml
@@ -184,8 +184,7 @@ module Aws : Provider_template.Provider = struct
         Lwt.return None
 
   (*TODO Please no more string types.*)
-  let send_command box s ~expire_time : (string, [> R.msg] * string) result Lwt.t =
-    let uri = Uri.of_string ("http://" ^ box ^ ":8000/command") in
+  let send_command cmd_uri s ~expire_time : (string, [> R.msg] * string) result Lwt.t =
     let headers = Cohttp.Header.init_with "ApiKey" (Sys.getenv "MC_KEY") in
     let rec repeat_until_ok f c =
       match c with
@@ -209,7 +208,7 @@ module Aws : Provider_template.Provider = struct
     in
     let send_command () =
       let body = Cohttp_lwt.Body.of_string s in
-      let%lwt resp, body = Cohttp_lwt_unix.Client.put uri ~headers ~body in
+      let%lwt resp, body = Cohttp_lwt_unix.Client.put cmd_uri ~headers ~body in
       let%lwt body = Cohttp_lwt.Body.to_string body in
       let process_response x =
         match Cohttp.Response.status x with
@@ -241,7 +240,7 @@ module Aws : Provider_template.Provider = struct
     (*TODO cohttp_retry*)
     let poll_agent () =
       let check_uri =
-        Uri.of_string ("http://" ^ box ^ ":8000/check_command")
+        Uri.with_path cmd_uri ("/check_command")
       in
       let check_uri = Uri.add_query_param' check_uri ("id", body) in
       match%lwt Cohttp_lwt_unix.Client.get check_uri ~headers with
@@ -332,19 +331,27 @@ module Aws : Provider_template.Provider = struct
     let%bind _store_result = store_ami ?profile ~settings ~n ~guid waiting_image in
     Lwt.return_ok waiting_image
 
-  let runcmd transfer t (params : Lib.run_parameters) (settings : Settings.t) (n : Node.real_node) guid (cmd : Command.t) :
+  let make_file_transfer_payload src dst =
+    let json : Yojson.Safe.t = `Assoc [("src", `String src); ("dst", `String dst)] in
+    Yojson.Safe.to_string json
+
+  let runcmd t (params : Lib.run_parameters) (settings : Settings.t) (n : Node.real_node) guid (cmd : Command.t) :
       (string, [> R.msg] * string) result Lwt.t =
     let%lwt () = Node.node_log n (Command.to_string cmd) in
     let expire_time = 12 * Node.rnode_get_expire_time n in
+    let base_uri = Uri.make ~scheme:"http" ~port:8000 ~host:t.ip_address () in
     match cmd with
     | Command.(Run shell_cmd) ->
-      send_command t.ip_address ~expire_time shell_cmd
+      let u = Uri.with_path base_uri "/command" in
+      send_command u ~expire_time shell_cmd
     | Upload (first_arg, second_arg) ->
-      send_command t.ip_address ~expire_time
-        @@ transfer ~first_arg ~second_arg ~verb:`Put
+      let u = Uri.with_path base_uri "/upload" in
+      let payload = make_file_transfer_payload first_arg second_arg in
+      send_command u ~expire_time payload
     | Download (first_arg, second_arg)  ->
-      send_command t.ip_address ~expire_time
-        @@ transfer ~first_arg ~second_arg ~verb:`Get
+      let u = Uri.with_path base_uri "/download" in
+      let payload = make_file_transfer_payload first_arg second_arg in
+      send_command u ~expire_time payload
     | Publish ->
       let%lwt image_id = publish_image ?profile:params.aws_profile ~t ~settings ~n ~guid in
       (match image_id with
diff --git a/engine/provider_stub.ml b/engine/provider_stub.ml
index 8affa2d..259883b 100644
--- a/engine/provider_stub.ml
+++ b/engine/provider_stub.ml
@@ -15,7 +15,7 @@ module Stub : Provider_template.Provider = struct
 
   let set_env _box _n _additional_env = Lwt.return ()
 
-  let runcmd _transfer_fn _params _settings _box (n : Node.real_node) _guid cmd =
+  let runcmd _params _settings _box (n : Node.real_node) _guid cmd =
     let str_cmd = Command.to_string cmd in
     let _ = Lwt_io.printl ("[STUB]" ^ "[" ^ n.name ^ "]" ^ str_cmd) in
     Lwt.return (R.ok "")
diff --git a/engine/provider_template.ml b/engine/provider_template.ml
index 886f6e1..cdd2038 100644
--- a/engine/provider_template.ml
+++ b/engine/provider_template.ml
@@ -11,8 +11,7 @@ module type Provider = sig
   val wait_until_ready : t -> Node.real_node -> unit -> unit option Lwt.t
 
   val runcmd :
-       (first_arg:string -> second_arg:string -> verb:verb -> string)
-    -> t
+    t
     -> Lib.run_parameters
     -> Settings.t
     -> Node.real_node
diff --git a/engine/runner.ml b/engine/runner.ml
index 2ac7e8a..90a42a9 100644
--- a/engine/runner.ml
+++ b/engine/runner.ml
@@ -49,27 +49,6 @@ let parse_configs config_list : (Node.node list, [> R.msg]) result =
   let flattened_roots = List.concat cleaned_roots in
   result_fold Node.make_node [] flattened_roots
 
-(* TODO: this is bad and should be rewritten but I don't have a better design. *)
-(* download s3 local *)
-(* upload local s3 *)
-let transfer_to_shell ~(transfer_fn : string -> [`Get | `Put] -> Uri.t)
-    ~(n : Node.real_node) ~guid =
-  let is_windows = Node.rnode_has_keyword n Windows in
-  let transfer ~first_arg ~second_arg ~(verb : [`Get | `Put]) =
-    let get_url = Uri.to_string (transfer_fn (sprintf "/%s/%s" guid first_arg) verb) in
-    let put_url = Uri.to_string (transfer_fn (sprintf "/%s/%s/%s" guid n.name second_arg) verb) in
-    match verb, is_windows with
-    | `Get, false ->
-        sprintf "curl --retry 5 -X GET \"%s\" -o %s" get_url second_arg
-    | `Get, true ->
-        sprintf {|powershell -command "$ProgressPreference = 'SilentlyContinue'; Invoke-WebRequest '%s' -Method 'GET' -UseBasicParsing -OutFile %s"|} get_url second_arg
-    | `Put, false ->
-        sprintf "curl --retry 5 -X PUT \"%s\" --upload-file %s" put_url first_arg
-    | `Put, true ->
-        sprintf {|powershell -command "$ProgressPreference = 'SilentlyContinue'; Invoke-WebRequest '%s' -Method 'PUT' -UseBasicParsing -Infile %s"|} put_url first_arg
-  in
-  transfer
-
 module Runner (M : Provider_template.Provider) = struct
   let run_node ~(settings : Settings.t) ~params ~n
       ~(transfer_fn : string -> [`Get | `Put] -> Uri.t) ~guid :
@@ -99,7 +78,6 @@ module Runner (M : Provider_template.Provider) = struct
         ; "tar xf /source.tar -C /source" ]
          |> List.map (fun x -> Command.(Run x))
     in
-    let transfer = transfer_to_shell ~transfer_fn ~n ~guid in
     (*TODO: We should handle failure here.*)
     let additional_env = [("GUID", guid)] in
     let%lwt () = M.set_env box n additional_env in
@@ -112,7 +90,7 @@ module Runner (M : Provider_template.Provider) = struct
         (fun a x ->
           match a with
           | Ok logs, old_logs ->
-              let%lwt r = M.runcmd transfer box params settings n guid x in
+              let%lwt r = M.runcmd box params settings n guid x in
               (* TODO: Use Buffer module to accumulate strings *)
               Lwt.return (r, old_logs ^ logs ^ (Command.to_string x) ^ "\n")
           | Error (err, logs), old_logs ->

From f4f326904d30a64642135f285d460f1f6e31d628 Mon Sep 17 00:00:00 2001
From: Adam <adam@nexadmin.com>
Date: Fri, 12 Mar 2021 12:07:47 -0600
Subject: [PATCH 04/14] attempted small fixes.

---
 agent/agent.ml        | 112 +++++++++++++++++++++---------------------
 engine/runner.ml      |  24 ++++-----
 makecloud.opam        |   1 +
 makecloud.opam.locked |  14 ++----
 makecloud.yaml        |   2 +-
 mc_settings.yml       |   2 +-
 6 files changed, 77 insertions(+), 78 deletions(-)

diff --git a/agent/agent.ml b/agent/agent.ml
index 2153444..7a79783 100644
--- a/agent/agent.ml
+++ b/agent/agent.ml
@@ -57,16 +57,16 @@ let run_command ~command =
   let out = Lwt_io.(read_lines (of_fd ~mode:Input lwt_ofd)) in
   let lwt_efd, efd = Lwt_unix.pipe_in () in
   let err = Lwt_io.(read_lines (of_fd ~mode:Input lwt_efd)) in
-  let status = 
+  let status =
     let result = Lwt_process.exec ~env:(Array.append !env additional_env) ~stdout:(`FD_copy ofd) ~stderr:(`FD_copy efd) command in
     let parse_result = function
       | Unix.WEXITED 0 ->
-        Lwt.return true 
+        Lwt.return true
       | Unix.WEXITED _ | WSIGNALED _ | WSTOPPED _ ->
-        Lwt.return false 
+        Lwt.return false
     in
     Lwt.bind result parse_result
-  in 
+  in
   Lwt.return (status, out, err)
 
 let authentication key req =
@@ -78,66 +78,68 @@ let authentication key req =
       false
 
 module File_transfer = struct
-  type t = { 
+  type t = {
     src : string;
-    dst : string; 
-  } [@@deriving of_yojson] 
+    dst : string;
+  } [@@deriving of_yojson]
 
-	type direction = Upload | Download
+  type direction = Upload | Download
 
-  let process_body body = 
+  let process_body body =
     let json = Yojson.Safe.from_string body in
     of_yojson json |> R.reword_error R.msg
 
   let upload cmd out_push err_push () =
     let (let*) = Lwt.bind in
-		let* f = Lwt_io.open_file ~mode:Input cmd.src in
-		let s = Lwt_io.read_lines f in
-		let body = Cohttp_lwt.Body.of_stream s in
-		let uri = Uri.of_string cmd.dst in
-		let* response, rbody = Cohttp_lwt_unix.Client.put ~chunked:false ~body uri in
-		let* result = match response.status with
-		| #Cohttp.Code.success_status ->
-			let () = out_push (Some "Upload successful.\n") in
-			Lwt.return true
-		| #Cohttp.Code.server_error_status ->
-			let* msg = Cohttp_lwt.Body.to_string rbody in
-			let () = err_push (Some (Fmt.str "Upload failed from server with body:\n %s\n" msg)) in
-			Lwt.return false 
-		| _ as c ->
-			let* msg = Cohttp_lwt.Body.to_string rbody in
-			let code = Cohttp.Code.string_of_status c in
-			let () = err_push (Some (Fmt.str "Upload failed from server with code %s and body:\n %s\n" code msg)) in
-			Lwt.return false 
-		in
-		Lwt.return result
+    let* f = Lwt_io.open_file ~mode:Input cmd.src in
+    let s = Lwt_io.read_lines f in
+    let body = Cohttp_lwt.Body.of_stream s in
+    let uri = Uri.of_string cmd.dst in
+    let* response, rbody = Cohttp_lwt_unix.Client.put ~chunked:false ~body uri in
+    let* result = match response.status with
+    | #Cohttp.Code.success_status ->
+      let () = out_push (Some "Upload successful.\n") in
+      Lwt.return true
+    | #Cohttp.Code.server_error_status ->
+      let* msg = Cohttp_lwt.Body.to_string rbody in
+      let () = err_push (Some (Fmt.str "Upload failed from server with body:\n %s\n" msg)) in
+      Lwt.return false
+    | _ as c ->
+      let* msg = Cohttp_lwt.Body.to_string rbody in
+      let code = Cohttp.Code.string_of_status c in
+      let () = err_push (Some (Fmt.str "Upload failed from server with code %s and body:\n %s\n" code msg)) in
+      Lwt.return false
+    in
+    let* () = Lwt_io.close f in
+    Lwt.return result
 
   let download cmd out_push err_push () =
     let (let*) = Lwt.bind in
-		let uri = Uri.of_string cmd.src in
-		let* response, rbody = Cohttp_lwt_unix.Client.get uri in
-		let* result = match response.status with
-		| #Cohttp.Code.success_status ->
-		  let* f = Lwt_io.open_file ~mode:Output cmd.dst in
-		  let body = Cohttp_lwt.Body.to_stream rbody in
-		  let* () = Lwt_io.write_lines f body in
-			let () = out_push (Some "Download successful.\n") in
-			Lwt.return true
-		| #Cohttp.Code.server_error_status ->
-			let* msg = Cohttp_lwt.Body.to_string rbody in
-			let () = err_push (Some (Fmt.str "Download failed from server with body:\n %s\n" msg)) in
-			Lwt.return false 
-		| _ as c ->
-			let* msg = Cohttp_lwt.Body.to_string rbody in
-			let code = Cohttp.Code.string_of_status c in
-			let () = err_push (Some (Fmt.str "Download failed from server with code %s and body:\n %s\n" code msg)) in
-			Lwt.return false 
-		in
-		Lwt.return result
+    let uri = Uri.of_string cmd.src in
+    let* response, rbody = Cohttp_lwt_unix.Client.get uri in
+    let* result = match response.status with
+    | #Cohttp.Code.success_status ->
+      let* f = Lwt_io.open_file ~mode:Output cmd.dst in
+      let body = Cohttp_lwt.Body.to_stream rbody in
+      let* () = Lwt_io.write_lines f body in
+      let* () = Lwt_io.close f in
+      let () = out_push (Some "Download successful.\n") in
+      Lwt.return true
+    | #Cohttp.Code.server_error_status ->
+      let* msg = Cohttp_lwt.Body.to_string rbody in
+      let () = err_push (Some (Fmt.str "Download failed from server with body:\n %s\n" msg)) in
+      Lwt.return false
+    | _ as c ->
+      let* msg = Cohttp_lwt.Body.to_string rbody in
+      let code = Cohttp.Code.string_of_status c in
+      let () = err_push (Some (Fmt.str "Download failed from server with code %s and body:\n %s\n" code msg)) in
+      Lwt.return false
+    in
+    Lwt.return result
 
   let close out_push err_push =
-		out_push (None);
-		err_push (None);
+    out_push (None);
+    err_push (None);
     ()
 
   let process direction body =
@@ -146,19 +148,19 @@ module File_transfer = struct
     let+ cmd = Lwt.return @@ process_body body in
     let out_stream, out_push = Lwt_stream.create () in
     let err_stream, err_push = Lwt_stream.create () in
-    let rec promise n () = 
+    let rec promise n () =
       let* result = match direction with
       | Upload -> upload cmd out_push err_push ()
       | Download -> download cmd out_push err_push ()
       in
       match result with
-      | true -> 
+      | true ->
         let () = close out_push err_push in Lwt.return true
       | false -> if n <= 1 then let () = close out_push err_push in Lwt.return false else promise (n - 1) ()
-    in 
+    in
     Lwt_result.return (promise 3 (), out_stream, err_stream)
 
-  let handle direction body = 
+  let handle direction body =
     let (let+) = Lwt.bind in
     let+ result = process direction body in
     match result with
diff --git a/engine/runner.ml b/engine/runner.ml
index 90a42a9..bcac73b 100644
--- a/engine/runner.ml
+++ b/engine/runner.ml
@@ -65,18 +65,20 @@ module Runner (M : Provider_template.Provider) = struct
     (*TODO: Get put in a blob ppx that loads from a file.*)
     let prep_steps =
       if Node.rnode_has_keyword n Windows then
-        [ sprintf {|powershell -command "$ProgressPreference = 'SilentlyContinue'; Invoke-WebRequest '%s' -OutFile C:\source.tar"|} uri_str
-        ; {|if exist C:\source rd /s /q C:\source|}
-        ; {|powershell -command New-Item C:\source -ItemType "directory"|}
-        ; {|powershell -command dir C:\|}
-        ; {|tar -x -f C:\source.tar -C C:\source|}]
-         |> List.map (fun x -> Command.(Run x))
+        let tl = [ sprintf {|if exist C:\source rd /s /q C:\source|}
+          ; {|powershell -command New-Item C:\source -ItemType "directory"|}
+          ; {|powershell -command dir C:\|}
+          ; {|tar -x -f C:\source.tar -C C:\source|}]
+          |> List.map (fun x -> Command.(Run x))
+        in
+        Command.(Download (uri_str, {|C:\source.tar|})) :: tl
       else
-        [ sprintf {|curl --retry 5 -X GET "%s" -o %s|} uri_str "source.tar"
-        ; "rm -rf /source; mkdir /source"
-        ; "sha256sum source.tar"
-        ; "tar xf /source.tar -C /source" ]
-         |> List.map (fun x -> Command.(Run x))
+        let tl = [ "rm -rf /source; mkdir /source"
+          ; "sha256sum source.tar"
+          ; "tar xf /source.tar -C /source" ]
+          |> List.map (fun x -> Command.(Run x))
+        in
+        Command.(Download (uri_str, "/source.tar")) :: tl
     in
     (*TODO: We should handle failure here.*)
     let additional_env = [("GUID", guid)] in
diff --git a/makecloud.opam b/makecloud.opam
index 8aacdd0..38c5c1b 100644
--- a/makecloud.opam
+++ b/makecloud.opam
@@ -35,6 +35,7 @@ depends: [
   "ppx_protocol_conv"{>="5.0.0"}
   "ppx_protocol_conv_json"
   "ppx_protocol_conv_yaml"
+  "ppx_deriving_yojson"
   "rresult"
   "tls"
   "uucp"
diff --git a/makecloud.opam.locked b/makecloud.opam.locked
index e35c5cb..6725ad3 100644
--- a/makecloud.opam.locked
+++ b/makecloud.opam.locked
@@ -177,6 +177,7 @@ depends: [
   "ppx_defer" {= "0.4.0"}
   "ppx_derivers" {= "1.2.1"}
   "ppx_deriving" {= "5.1"}
+  "ppx_deriving_yojson" {= "3.6.1"}
   "ppx_enumerate" {= "v0.14.0"}
   "ppx_expect" {= "v0.14.0"}
   "ppx_fields_conv" {= "v0.14.1"}
@@ -237,17 +238,10 @@ pin-depends: [
     "git+https://github.com/UnrealAkama/aws-s3.git#cred_fetch"
   ]
   [
-    "aws-lwt.~dev"
-    "git+https://github.com/UnrealAkama/ocaml-aws.git#mainline"
-  ]
-  [
-    "aws-ec2.1.1"
-    "git+https://github.com/UnrealAkama/ocaml-aws.git#mainline"
-  ]
-  [
-    "aws-s3.4.5.1"
-    "git+https://github.com/UnrealAkama/aws-s3.git#cred_fetch"
+    "aws-lwt.~dev" "git+https://github.com/UnrealAkama/ocaml-aws.git#mainline"
   ]
+  ["aws-ec2.1.1" "git+https://github.com/UnrealAkama/ocaml-aws.git#mainline"]
+  ["aws-s3.4.5.1" "git+https://github.com/UnrealAkama/aws-s3.git#cred_fetch"]
   ["aws.1.0.2" "git+https://github.com/UnrealAkama/ocaml-aws.git#mainline"]
   ["uri.4.1.0" "git+https://github.com/UnrealAkama/ocaml-uri.git#mainline"]
 ]
diff --git a/makecloud.yaml b/makecloud.yaml
index a17145d..0c8a9e5 100644
--- a/makecloud.yaml
+++ b/makecloud.yaml
@@ -3,7 +3,7 @@ makecloud:
     - engine/
     - cli/
     - web/
-  base: ami-047a51fa27710816e 
+  base: ami-07a0844029df33d7d
   steps:
     - RUN yum install -y https://dl.fedoraproject.org/pub/epel/epel-release-latest-7.noarch.rpm
     - RUN yum install -y m4 gcc patch bubblewrap git hg darcs pcre-devel gmp-devel gcc-g++ g++
diff --git a/mc_settings.yml b/mc_settings.yml
index 9e66a14..4b519e2 100644
--- a/mc_settings.yml
+++ b/mc_settings.yml
@@ -6,6 +6,6 @@ aws_region: us-east-2
 aws_security_group: sg-03d476f60972fa153
 aws_key_name: makecloud
 aws_subnet_id: subnet-02d2562cff6c764dd
-linux_agent_url: https://makecloud.s3.us-east-2.amazonaws.com/linux_agent_beta
+linux_agent_url: https://makecloud.s3.us-east-2.amazonaws.com/mc-agent-linux-0.4.0
 windows_agent_url: https://makecloud.s3.us-east-2.amazonaws.com/mc_agent
 only_public_ip: true

From 2d9f74cd17e0332b94fdd99d7ec99ebaa5533303 Mon Sep 17 00:00:00 2001
From: Adam <adam@nexadmin.com>
Date: Fri, 12 Mar 2021 13:02:22 -0600
Subject: [PATCH 05/14] fix annoying bug re \n getting inserted.

---
 agent/agent.ml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/agent/agent.ml b/agent/agent.ml
index 7a79783..697ecf5 100644
--- a/agent/agent.ml
+++ b/agent/agent.ml
@@ -121,7 +121,8 @@ module File_transfer = struct
     | #Cohttp.Code.success_status ->
       let* f = Lwt_io.open_file ~mode:Output cmd.dst in
       let body = Cohttp_lwt.Body.to_stream rbody in
-      let* () = Lwt_io.write_lines f body in
+      let safe_write_lines oc lines = Lwt_stream.iter_s (fun line -> Lwt_io.write oc line) lines in
+      let* () = safe_write_lines f body in
       let* () = Lwt_io.close f in
       let () = out_push (Some "Download successful.\n") in
       Lwt.return true

From c6ff4f6b50b79e7046c1cc9fa41b90d81916bca1 Mon Sep 17 00:00:00 2001
From: Adam <adam@nexadmin.com>
Date: Fri, 26 Mar 2021 12:18:31 -0500
Subject: [PATCH 06/14] this should work?

---
 agent/agent.ml              | 17 +++++++++++++----
 engine/provider_aws.ml      | 12 +++++++++---
 engine/provider_stub.ml     |  2 +-
 engine/provider_template.ml |  3 ++-
 engine/runner.ml            |  2 +-
 5 files changed, 26 insertions(+), 10 deletions(-)

diff --git a/agent/agent.ml b/agent/agent.ml
index 697ecf5..8b832e4 100644
--- a/agent/agent.ml
+++ b/agent/agent.ml
@@ -92,8 +92,17 @@ module File_transfer = struct
   let upload cmd out_push err_push () =
     let (let*) = Lwt.bind in
     let* f = Lwt_io.open_file ~mode:Input cmd.src in
-    let s = Lwt_io.read_lines f in
-    let body = Cohttp_lwt.Body.of_stream s in
+    let safe_read ic =
+      let buf = Bytes.create 4096 in
+      let aux () =
+        let* data = Lwt_io.read_into ic buf 0 4096 in
+        match data with
+          | 0 -> Lwt.return None
+          | i -> Lwt.return @@ Some (Bytes.sub_string buf 0 i)
+      in
+      Lwt_stream.from aux
+    in
+    let body = Cohttp_lwt.Body.of_stream (safe_read f) in
     let uri = Uri.of_string cmd.dst in
     let* response, rbody = Cohttp_lwt_unix.Client.put ~chunked:false ~body uri in
     let* result = match response.status with
@@ -121,8 +130,8 @@ module File_transfer = struct
     | #Cohttp.Code.success_status ->
       let* f = Lwt_io.open_file ~mode:Output cmd.dst in
       let body = Cohttp_lwt.Body.to_stream rbody in
-      let safe_write_lines oc lines = Lwt_stream.iter_s (fun line -> Lwt_io.write oc line) lines in
-      let* () = safe_write_lines f body in
+      let safe_write oc lines = Lwt_stream.iter_s (fun line -> Lwt_io.write oc line) lines in
+      let* () = safe_write f body in
       let* () = Lwt_io.close f in
       let () = out_push (Some "Download successful.\n") in
       Lwt.return true
diff --git a/engine/provider_aws.ml b/engine/provider_aws.ml
index e147e9a..7c5b8d6 100644
--- a/engine/provider_aws.ml
+++ b/engine/provider_aws.ml
@@ -335,7 +335,7 @@ module Aws : Provider_template.Provider = struct
     let json : Yojson.Safe.t = `Assoc [("src", `String src); ("dst", `String dst)] in
     Yojson.Safe.to_string json
 
-  let runcmd t (params : Lib.run_parameters) (settings : Settings.t) (n : Node.real_node) guid (cmd : Command.t) :
+  let runcmd transfer_fn t (params : Lib.run_parameters) (settings : Settings.t) (n : Node.real_node) guid (cmd : Command.t) :
       (string, [> R.msg] * string) result Lwt.t =
     let%lwt () = Node.node_log n (Command.to_string cmd) in
     let expire_time = 12 * Node.rnode_get_expire_time n in
@@ -346,11 +346,17 @@ module Aws : Provider_template.Provider = struct
       send_command u ~expire_time shell_cmd
     | Upload (first_arg, second_arg) ->
       let u = Uri.with_path base_uri "/upload" in
-      let payload = make_file_transfer_payload first_arg second_arg in
+      let uri = Uri.to_string (transfer_fn (sprintf "/%s/%s/%s" guid n.name second_arg) `Put) in
+      let payload = make_file_transfer_payload first_arg uri in
       send_command u ~expire_time payload
     | Download (first_arg, second_arg)  ->
       let u = Uri.with_path base_uri "/download" in
-      let payload = make_file_transfer_payload first_arg second_arg in
+      let uri = if Uri.of_string first_arg |> Uri.scheme |> Option.is_none then
+          Uri.to_string (transfer_fn (sprintf "/%s/%s" guid first_arg) `Get)
+        else
+          first_arg
+      in
+      let payload = make_file_transfer_payload uri second_arg in
       send_command u ~expire_time payload
     | Publish ->
       let%lwt image_id = publish_image ?profile:params.aws_profile ~t ~settings ~n ~guid in
diff --git a/engine/provider_stub.ml b/engine/provider_stub.ml
index 259883b..8affa2d 100644
--- a/engine/provider_stub.ml
+++ b/engine/provider_stub.ml
@@ -15,7 +15,7 @@ module Stub : Provider_template.Provider = struct
 
   let set_env _box _n _additional_env = Lwt.return ()
 
-  let runcmd _params _settings _box (n : Node.real_node) _guid cmd =
+  let runcmd _transfer_fn _params _settings _box (n : Node.real_node) _guid cmd =
     let str_cmd = Command.to_string cmd in
     let _ = Lwt_io.printl ("[STUB]" ^ "[" ^ n.name ^ "]" ^ str_cmd) in
     Lwt.return (R.ok "")
diff --git a/engine/provider_template.ml b/engine/provider_template.ml
index cdd2038..056e99a 100644
--- a/engine/provider_template.ml
+++ b/engine/provider_template.ml
@@ -11,7 +11,8 @@ module type Provider = sig
   val wait_until_ready : t -> Node.real_node -> unit -> unit option Lwt.t
 
   val runcmd :
-    t
+    (string -> [`Get | `Put] -> Uri.t)
+    -> t
     -> Lib.run_parameters
     -> Settings.t
     -> Node.real_node
diff --git a/engine/runner.ml b/engine/runner.ml
index bcac73b..d102cb4 100644
--- a/engine/runner.ml
+++ b/engine/runner.ml
@@ -92,7 +92,7 @@ module Runner (M : Provider_template.Provider) = struct
         (fun a x ->
           match a with
           | Ok logs, old_logs ->
-              let%lwt r = M.runcmd box params settings n guid x in
+              let%lwt r = M.runcmd transfer_fn box params settings n guid x in
               (* TODO: Use Buffer module to accumulate strings *)
               Lwt.return (r, old_logs ^ logs ^ (Command.to_string x) ^ "\n")
           | Error (err, logs), old_logs ->

From 69cf7c0bf09b476b86ee63b3641c2a2e60d50f81 Mon Sep 17 00:00:00 2001
From: Adam <adam@nexadmin.com>
Date: Fri, 26 Mar 2021 14:52:08 -0500
Subject: [PATCH 07/14] update mc settings.

---
 makecloud.yaml  | 1 +
 mc_settings.yml | 2 +-
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/makecloud.yaml b/makecloud.yaml
index 0c8a9e5..5e4820e 100644
--- a/makecloud.yaml
+++ b/makecloud.yaml
@@ -3,6 +3,7 @@ makecloud:
     - engine/
     - cli/
     - web/
+    - agent/
   base: ami-07a0844029df33d7d
   steps:
     - RUN yum install -y https://dl.fedoraproject.org/pub/epel/epel-release-latest-7.noarch.rpm
diff --git a/mc_settings.yml b/mc_settings.yml
index 4b519e2..1f5f530 100644
--- a/mc_settings.yml
+++ b/mc_settings.yml
@@ -6,6 +6,6 @@ aws_region: us-east-2
 aws_security_group: sg-03d476f60972fa153
 aws_key_name: makecloud
 aws_subnet_id: subnet-02d2562cff6c764dd
-linux_agent_url: https://makecloud.s3.us-east-2.amazonaws.com/mc-agent-linux-0.4.0
+linux_agent_url: https://makecloud.s3.us-east-2.amazonaws.com/mc-agent-linux-0.4.1
 windows_agent_url: https://makecloud.s3.us-east-2.amazonaws.com/mc_agent
 only_public_ip: true

From 2bdb8596974ec1b402d052ec2062c32cc67d58fe Mon Sep 17 00:00:00 2001
From: "Hezekiah M. Carty" <hezekiah.carty@elastic.co>
Date: Mon, 19 Apr 2021 15:08:33 -0600
Subject: [PATCH 08/14] Wait longer and print more detailed error messages

---
 engine/provider_aws.ml | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/engine/provider_aws.ml b/engine/provider_aws.ml
index 7c5b8d6..ca8a728 100644
--- a/engine/provider_aws.ml
+++ b/engine/provider_aws.ml
@@ -229,13 +229,14 @@ module Aws : Provider_template.Provider = struct
       process_response resp
     in
     let%lwt _resp, body =
-      match%lwt repeat_until_ok send_command 10 with
+      match%lwt repeat_until_ok send_command 60 with
       | Ok (r, b) ->
           Lwt.return (r, b)
-      | Error _ ->
-          failwith
+      | Error (`Msg message, note) ->
+          Lwt.fail_with (Fmt.str
             "Can't talk to an agent, this probably means the agent failed to \
-             install."
+             install. Error: %s - %s"
+             message note)
     in
     (*TODO cohttp_retry*)
     let poll_agent () =

From e8ad6eb2d60b5d7951c0a0eb0117f7d034a03f5c Mon Sep 17 00:00:00 2001
From: "Hezekiah M. Carty" <hezekiah.carty@elastic.co>
Date: Tue, 27 Apr 2021 18:30:51 -0600
Subject: [PATCH 09/14] Fix some warnings, replace ocaml-monadic with
 let-operators

---
 cli/main.ml            |  4 ++--
 engine/dune            |  2 +-
 engine/lib.ml          |  6 ++---
 engine/node.ml         | 52 +++++++++++++++++++++---------------------
 engine/provider_aws.ml | 18 +++++++--------
 engine/runner.ml       | 16 ++++++-------
 engine/settings.ml     |  6 ++---
 makecloud.opam         |  1 -
 makecloud.opam.locked  |  1 -
 web/github.ml          |  2 +-
 10 files changed, 53 insertions(+), 55 deletions(-)

diff --git a/cli/main.ml b/cli/main.ml
index f5bfd0c..069883a 100644
--- a/cli/main.ml
+++ b/cli/main.ml
@@ -5,7 +5,7 @@ open Engine.Lib
 
 let main repo_dir nocache deploy target_nodes dont_delete profile =
   let dont_delete = match dont_delete with | Some x -> [x] | None -> [] in
-  let params = Engine.Lib.make_params ~repo_dir ~nocache ~deploy ~target_nodes ~dont_delete ?aws_profile:profile in
+  let params = Engine.Lib.make_params ~repo_dir ~nocache ~deploy ~target_nodes ~dont_delete ~aws_profile:profile in
   Lwt_main.run (Engine.Runner.main params)
 
 let check repo_dir =
@@ -117,7 +117,7 @@ let show_all_cache profile repo_dir =
      let print_node_cache (n : Engine.Node.real_node) =
        let name = Engine.Node.node_to_string (Engine.Node.Rnode n) in
        let%lwt rstatus =
-         Engine.Runner.AwsRunner.check_cache ?profile ~settings ~cwd:repo_dir ~n
+         Engine.Runner.AwsRunner.check_cache ~profile ~settings ~cwd:repo_dir ~n
        in
        let status = R.is_ok rstatus in
        let%lwt hash = Engine.Node.hash_of_node repo_dir n in
diff --git a/engine/dune b/engine/dune
index b160e78..e49414b 100644
--- a/engine/dune
+++ b/engine/dune
@@ -2,5 +2,5 @@
  (name engine)
  (libraries jingoo lwt.unix cmdliner yaml.unix aws-ec2 aws-lwt aws-s3-lwt rresult uuidm digestif astring ppx_protocol_conv_yaml ppx_protocol_conv irmin-unix )
  (preprocessor_deps "userdata_scripts/linux.txt" "userdata_scripts/windows.txt")
- (preprocess (pps lwt_ppx ppx_defer ocaml-monadic ppx_protocol_conv ppx_deriving.show ppx_deriving.eq ppx_blob ppx_irmin)))
+ (preprocess (pps lwt_ppx ppx_protocol_conv ppx_deriving.show ppx_deriving.eq ppx_blob ppx_irmin)))
 
diff --git a/engine/lib.ml b/engine/lib.ml
index a39545b..e0f8069 100644
--- a/engine/lib.ml
+++ b/engine/lib.ml
@@ -10,7 +10,7 @@ type run_parameters =
   ; aws_profile : string option
   ; guid : Uuidm.t }
 
-let make_params ?aws_profile ~repo_dir ~nocache ~deploy ~target_nodes ~dont_delete =
+let make_params ~aws_profile ~repo_dir ~nocache ~deploy ~target_nodes ~dont_delete =
   let guid = Uuidm.v4_gen (Random.State.make_self_init ()) () in
   { repo_dir; nocache; deploy; target_nodes; guid; dont_delete; aws_profile }
 
@@ -46,8 +46,8 @@ let get_string str =
       R.error (R.msg "not a string")
 
 let get_string_from_attrib_list assoc_list key =
-  let bind = R.bind in
-  let%bind pair = get_value assoc_list key in
+  let ( let* ) = R.bind in
+  let* pair = get_value assoc_list key in
   get_string (snd pair)
 
 let result_fold fn acc input_list =
diff --git a/engine/node.ml b/engine/node.ml
index 28bbef2..740f27b 100644
--- a/engine/node.ml
+++ b/engine/node.ml
@@ -154,20 +154,20 @@ let update_node_dependencies todo_node (can_cache, finished_node) =
 
 let make_snode (yaml_root : string * Yaml.value) :
     (synthetic_node, [> R.msg]) result =
-  let bind = R.bind in
+  let ( let* ) = R.bind in
   let node_name, _ = yaml_root in
-  let%bind attrib_list = get_assoc_list (snd yaml_root) in
-  let%bind deps = get_value attrib_list "dependson" in
-  let%bind deps_list = get_array deps in
-  let%bind deps_list_str = result_fold get_string [] deps_list in
+  let* attrib_list = get_assoc_list (snd yaml_root) in
+  let* deps = get_value attrib_list "dependson" in
+  let* deps_list = get_array deps in
+  let* deps_list_str = result_fold get_string [] deps_list in
   Ok {name= node_name; dependson= deps_list_str}
 
 let make_rnode (yaml_root : string * Yaml.value) :
     (real_node, [> R.msg]) result =
-  let bind = R.bind in
+  let ( let* ) = R.bind in
   let node_name, _ = yaml_root in
-  let%bind attrib_list = get_assoc_list (snd yaml_root) in
-  let%bind file_root =
+  let* attrib_list = get_assoc_list (snd yaml_root) in
+  let* file_root =
     match get_value attrib_list "fileroot" with
     | Error _ ->
       R.error_msg (sprintf "%s needs an attribute fileroot" node_name)
@@ -176,40 +176,40 @@ let make_rnode (yaml_root : string * Yaml.value) :
       | Error _ -> get_string (snd roots) |> R.map (fun x -> [x])
       | Ok roots_list -> result_fold get_string [] roots_list)
   in
-  let%bind base = get_string_from_attrib_list attrib_list "base" in
-  let%bind steps_raw = get_value attrib_list "steps" in
-  let%bind steps_yaml = get_array steps_raw in
-  let%bind rev_steps = result_fold get_string [] steps_yaml in
+  let* base = get_string_from_attrib_list attrib_list "base" in
+  let* steps_raw = get_value attrib_list "steps" in
+  let* steps_yaml = get_array steps_raw in
+  let* rev_steps = result_fold get_string [] steps_yaml in
   let steps = List.rev rev_steps in
-  let%bind steps = Command.parse_commands steps in
-  let%bind dependson =
+  let* steps = Command.parse_commands steps in
+  let* dependson =
     match get_value attrib_list "dependson" with
     | Error _ ->
         Ok []
     | Ok deps ->
-        let%bind deps_list = get_array deps in
+        let* deps_list = get_array deps in
         result_fold get_string [] deps_list
   in
-  let%bind keywords =
+  let* keywords =
     match get_value attrib_list "keywords" with
     | Error _ ->
         Ok []
     | Ok keys ->
-        let%bind keys_list = get_array keys in
-        let%bind strings = result_fold get_string [] keys_list in
+        let* keys_list = get_array keys in
+        let* strings = result_fold get_string [] keys_list in
         result_fold keyword_of_string [] strings
   in
-  let%bind env =
+  let* env =
     match get_value attrib_list "env" with
     | Error _ ->
         Ok []
     | Ok keys ->
-        let%bind keys_list = get_array keys in
+        let* keys_list = get_array keys in
         result_fold
           (fun x ->
-            let%bind key = get_string x in
+            let* key = get_string x in
             let potential_value = Sys.getenv_opt key in
-            let%bind value =
+            let* value =
               R.of_option
                 ~none:(fun () ->
                   R.error_msg (sprintf "Failed to get an env variable: %s" key))
@@ -233,12 +233,12 @@ let make_rnode (yaml_root : string * Yaml.value) :
     ; cache }
 
 let make_node (yaml_root : string * Yaml.value) : (node, [> R.msg]) result =
-  let bind = R.bind in
-  let%bind assoc_list = get_assoc_list (snd yaml_root) in
+  let ( let* ) = R.bind in
+  let* assoc_list = get_assoc_list (snd yaml_root) in
   match get_value assoc_list "base" with
   | Ok _ ->
-      let%bind node = make_rnode yaml_root in
+      let* node = make_rnode yaml_root in
       Ok (Rnode node)
   | Error _ ->
-      let%bind node = make_snode yaml_root in
+      let* node = make_snode yaml_root in
       Ok (Snode node)
diff --git a/engine/provider_aws.ml b/engine/provider_aws.ml
index ca8a728..a73be37 100644
--- a/engine/provider_aws.ml
+++ b/engine/provider_aws.ml
@@ -294,9 +294,9 @@ module Aws : Provider_template.Provider = struct
     Lwt.return @@ R.reword_error (fun _ -> `Msg "Failed to store ami in s3.") result
 
   let check_on_ami ~t ~(settings : Settings.t) ~n image_id () =
-    let bind = Lwt_result.bind in
+    let ( let* ) = Lwt_result.bind in
     let ami_req = Types.DescribeImagesRequest.make ~image_ids:[image_id] () in
-    let%bind result =
+    let* result =
       Lwt.Infix.(Aws_lwt.Runtime.run_request
         ~region:settings.aws_region
         ~access_key:t.aws_key
@@ -321,15 +321,15 @@ module Aws : Provider_template.Provider = struct
     | Error as e -> R.error_msgf "AMI has failed with reason %s."
       (Types.ImageState.to_string e)
 
-  let publish_image ?profile ~t ~settings ~n ~guid =
+  let publish_image ~profile ~t ~settings ~n ~guid =
     let instance_id = t.instance_id in
-    let bind = Lwt_result.bind in
-    let%bind box_id = repeat_until_ok (save_box ~t ~settings ~n ~instance_id ~guid) 20 in
+    let ( let* ) = Lwt_result.bind in
+    let* box_id = repeat_until_ok (save_box ~t ~settings ~n ~instance_id ~guid) 20 in
     let none = (fun () -> R.error_msg missing_ami_err_msg) in
-    let%bind image_id = Types.CreateImageResult.(box_id.image_id) |> R.of_option ~none |> Lwt.return
+    let* image_id = Types.CreateImageResult.(box_id.image_id) |> R.of_option ~none |> Lwt.return
     in
-    let%bind waiting_image = repeat_until_ok (check_on_ami ~t ~settings ~n image_id) 240 in
-    let%bind _store_result = store_ami ?profile ~settings ~n ~guid waiting_image in
+    let* waiting_image = repeat_until_ok (check_on_ami ~t ~settings ~n image_id) 240 in
+    let* _store_result = store_ami ?profile ~settings ~n ~guid waiting_image in
     Lwt.return_ok waiting_image
 
   let make_file_transfer_payload src dst =
@@ -360,7 +360,7 @@ module Aws : Provider_template.Provider = struct
       let payload = make_file_transfer_payload uri second_arg in
       send_command u ~expire_time payload
     | Publish ->
-      let%lwt image_id = publish_image ?profile:params.aws_profile ~t ~settings ~n ~guid in
+      let%lwt image_id = publish_image ~profile:params.aws_profile ~t ~settings ~n ~guid in
       (match image_id with
       | Ok i ->
         let%lwt () = Node.node_log n (Fmt.str "Saved instance as %s" i) in
diff --git a/engine/runner.ml b/engine/runner.ml
index d102cb4..51796b4 100644
--- a/engine/runner.ml
+++ b/engine/runner.ml
@@ -41,11 +41,11 @@ let get_configs dir_root =
   aux [dir_root] []
 
 let parse_configs config_list : (Node.node list, [> R.msg]) result =
-  let bind = R.bind in
-  let%bind dirty_root_nodes =
+  let ( let* ) = R.bind in
+  let* dirty_root_nodes =
     result_fold (fun x -> Yaml_unix.of_file Fpath.(v x)) [] config_list
   in
-  let%bind cleaned_roots = result_fold get_assoc_list [] dirty_root_nodes in
+  let* cleaned_roots = result_fold get_assoc_list [] dirty_root_nodes in
   let flattened_roots = List.concat cleaned_roots in
   result_fold Node.make_node [] flattened_roots
 
@@ -156,7 +156,7 @@ module Runner (M : Provider_template.Provider) = struct
     in
     Lwt.return ()
 
-  let check_cache ?profile ~(settings : Settings.t) ~cwd ~n =
+  let check_cache ~profile ~(settings : Settings.t) ~cwd ~n =
     let%lwt hash = Node.hash_of_node cwd n in
     let%lwt creds = Aws_s3_lwt.Credentials.Helper.get_credentials ?profile () in
     let safe_creds = R.get_ok creds in
@@ -180,15 +180,15 @@ module Runner (M : Provider_template.Provider) = struct
     let retries = 3 in
     let old_key = sprintf "%s/%s/%s" old_guid n.name filename in
     let new_key = sprintf "%s/%s/%s" new_guid n.name filename in
-    let bind = Lwt_result.bind in
-    let%bind init =
+    let ( let* ) = Lwt_result.bind in
+    let* init =
       Aws_s3_lwt.S3.retry ~endpoint ~retries
         ~f:(fun ~endpoint () ->
           Aws_s3_lwt.S3.Multipart_upload.init ~endpoint ~credentials
             ~bucket:settings.storage_bucket ~key:new_key ())
         ()
     in
-    let%bind () =
+    let* () =
       Aws_s3_lwt.S3.retry ~endpoint ~retries
         ~f:(fun ~endpoint () ->
           Aws_s3_lwt.S3.Multipart_upload.copy_part ~endpoint ~credentials init
@@ -223,7 +223,7 @@ module Runner (M : Provider_template.Provider) = struct
       (transfer_fn : string -> [`Get | `Put] -> Uri.t) :
       (bool, [> R.msg]) result Lwt.t =
     let is_cachable = Node.is_node_cachable n in
-    let%lwt cache_status = check_cache ?profile:params.aws_profile ~settings ~cwd:params.repo_dir ~n in
+    let%lwt cache_status = check_cache ~profile:params.aws_profile ~settings ~cwd:params.repo_dir ~n in
     let guid = Uuidm.to_string params.guid in
     match is_cachable && R.is_ok cache_status && not params.nocache with
     | true -> (
diff --git a/engine/settings.ml b/engine/settings.ml
index 21b7d5a..bff6db7 100644
--- a/engine/settings.ml
+++ b/engine/settings.ml
@@ -36,9 +36,9 @@ type t =
 
 let parse_settings filepath =
   let aux () =
-    let bind = R.bind in
-    let%bind contents = Bos.OS.File.read filepath in
-    let%bind yaml = Yaml.of_string contents in
+    let ( let* ) = R.bind in
+    let* contents = Bos.OS.File.read filepath in
+    let* yaml = Yaml.of_string contents in
     match of_yaml yaml with
     | Ok y ->
         R.ok y
diff --git a/makecloud.opam b/makecloud.opam
index 38c5c1b..6b19d0c 100644
--- a/makecloud.opam
+++ b/makecloud.opam
@@ -26,7 +26,6 @@ depends: [
   "lwt"{>="2.7.0"}
   "lwt_ppx"
   "menhir"
-  "ocaml-monadic"{>="0.4.0"}
   "opam-lock"
   "ppx_blob"
   "ppx_defer"
diff --git a/makecloud.opam.locked b/makecloud.opam.locked
index 6725ad3..545ef55 100644
--- a/makecloud.opam.locked
+++ b/makecloud.opam.locked
@@ -150,7 +150,6 @@ depends: [
   "ocaml-compiler-libs" {= "v0.12.3"}
   "ocaml-inifiles" {= "1.2"}
   "ocaml-migrate-parsetree" {= "1.8.0"}
-  "ocaml-monadic" {= "0.4.1"}
   "ocaml-syntax-shims" {= "1.0.0"}
   "ocamlbuild" {= "0.14.0"}
   "ocamlfind" {= "1.8.1"}
diff --git a/web/github.ml b/web/github.ml
index d1237a3..8fd28e4 100644
--- a/web/github.ml
+++ b/web/github.ml
@@ -101,7 +101,7 @@ let process aws_profile req body =
       (sprintf "refs/heads/%s" gh_info.repository.master_branch)
   in
   Lwt.async (fun () ->
-    let params = Engine.Lib.make_params ~repo_dir ~nocache:false ~deploy ~target_nodes:[] ~dont_delete:[] ?aws_profile in
+    let params = Engine.Lib.make_params ~repo_dir ~nocache:false ~deploy ~target_nodes:[] ~dont_delete:[] ~aws_profile in
     Engine.Runner.main params);
   Lwt.return ()
 

From 948ecc49791deac38a5f756559d9c0624efe720d Mon Sep 17 00:00:00 2001
From: "Hezekiah M. Carty" <hezekiah.carty@elastic.co>
Date: Tue, 27 Apr 2021 23:09:54 -0600
Subject: [PATCH 10/14] Catch cohttp client exceptions, add lwt_ppx

---
 agent/agent.ml | 42 ++++++++++++++++++++++++------------------
 agent/dune     |  2 +-
 2 files changed, 25 insertions(+), 19 deletions(-)

diff --git a/agent/agent.ml b/agent/agent.ml
index 8b832e4..643f8f8 100644
--- a/agent/agent.ml
+++ b/agent/agent.ml
@@ -90,12 +90,11 @@ module File_transfer = struct
     of_yojson json |> R.reword_error R.msg
 
   let upload cmd out_push err_push () =
-    let (let*) = Lwt.bind in
-    let* f = Lwt_io.open_file ~mode:Input cmd.src in
+    let%lwt f = Lwt_io.open_file ~mode:Input cmd.src in
     let safe_read ic =
       let buf = Bytes.create 4096 in
       let aux () =
-        let* data = Lwt_io.read_into ic buf 0 4096 in
+        let%lwt data = Lwt_io.read_into ic buf 0 4096 in
         match data with
           | 0 -> Lwt.return None
           | i -> Lwt.return @@ Some (Bytes.sub_string buf 0 i)
@@ -104,22 +103,29 @@ module File_transfer = struct
     in
     let body = Cohttp_lwt.Body.of_stream (safe_read f) in
     let uri = Uri.of_string cmd.dst in
-    let* response, rbody = Cohttp_lwt_unix.Client.put ~chunked:false ~body uri in
-    let* result = match response.status with
-    | #Cohttp.Code.success_status ->
-      let () = out_push (Some "Upload successful.\n") in
-      Lwt.return true
-    | #Cohttp.Code.server_error_status ->
-      let* msg = Cohttp_lwt.Body.to_string rbody in
-      let () = err_push (Some (Fmt.str "Upload failed from server with body:\n %s\n" msg)) in
-      Lwt.return false
-    | _ as c ->
-      let* msg = Cohttp_lwt.Body.to_string rbody in
-      let code = Cohttp.Code.string_of_status c in
-      let () = err_push (Some (Fmt.str "Upload failed from server with code %s and body:\n %s\n" code msg)) in
-      Lwt.return false
+    let%lwt result =
+      match%lwt Cohttp_lwt_unix.Client.put ~chunked:false ~body uri with
+      | response, rbody -> begin
+        match response.status with
+        | #Cohttp.Code.success_status ->
+          let%lwt () = Cohttp_lwt.Body.drain_body rbody in
+          let () = out_push (Some "Upload successful.\n") in
+          Lwt.return true
+        | #Cohttp.Code.server_error_status ->
+          let%lwt msg = Cohttp_lwt.Body.to_string rbody in
+          let () = err_push (Some (Fmt.str "Upload failed from server with body:\n %s\n" msg)) in
+          Lwt.return false
+        | _ as c ->
+          let%lwt msg = Cohttp_lwt.Body.to_string rbody in
+          let code = Cohttp.Code.string_of_status c in
+          let () = err_push (Some (Fmt.str "Upload failed from server with code %s and body:\n %s\n" code msg)) in
+          Lwt.return false
+      end
+      | exception e ->
+        let () = err_push (Some (Fmt.str "Upload failed with exception %a" Fmt.exn e)) in
+        Lwt.return false
     in
-    let* () = Lwt_io.close f in
+    let%lwt () = Lwt_io.close f in
     Lwt.return result
 
   let download cmd out_push err_push () =
diff --git a/agent/dune b/agent/dune
index 212d652..298ab22 100644
--- a/agent/dune
+++ b/agent/dune
@@ -1,7 +1,7 @@
 (executable
  (name agent)
  (libraries lwt.unix cmdliner cohttp-lwt-unix yojson rresult ppx_deriving_yojson.runtime)
- (preprocess (pps ppx_deriving_yojson)))
+ (preprocess (pps lwt_ppx ppx_deriving_yojson)))
 
 (alias
   (name makecloud-agent)

From 38d7238ac3db7d3fffd749e9ee51dccdb137208c Mon Sep 17 00:00:00 2001
From: "Hezekiah M. Carty" <hezekiah.carty@elastic.co>
Date: Tue, 27 Apr 2021 23:14:17 -0600
Subject: [PATCH 11/14] Get rid of some more ocaml-monadic

---
 web/dune   |  2 +-
 web/web.ml | 18 +++++++++---------
 2 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/web/dune b/web/dune
index 115fd35..5c301ca 100644
--- a/web/dune
+++ b/web/dune
@@ -2,7 +2,7 @@
  (name web)
  (libraries engine lwt.unix cmdliner yaml.unix aws-s3-lwt rresult uuidm digestif astring jingoo bos cohttp-lwt-unix irmin-unix)
  (preprocessor_deps "templates/index.html" "templates/show_runs.html" "templates/base.html" "assets/timeago.min.js" "assets/full.render.js" "assets/viz.js")
- (preprocess (pps lwt_ppx ppx_defer ocaml-monadic ppx_protocol_conv ppx_blob ppx_irmin)))
+ (preprocess (pps lwt_ppx ppx_defer ppx_protocol_conv ppx_blob ppx_irmin)))
 
 (alias
   (name makecloud-web)
diff --git a/web/web.ml b/web/web.ml
index c6e10c3..4622e85 100644
--- a/web/web.ml
+++ b/web/web.ml
@@ -50,15 +50,15 @@ let show_index _req body =
 
 let report_http_check req body =
   let uri = Request.uri req in
-  let bind = R.bind in
-  let%bind guid =
+  let ( let* ) = R.bind in
+  let* guid =
     match Uri.get_query_param uri "guid" with
     | None ->
         R.error (`Bad_request, "must supply a guid parameter for the run.")
     | Some i ->
         R.ok i
   in
-  let%bind node_name =
+  let* node_name =
     match Uri.get_query_param uri "node_name" with
     | None ->
         R.error (`Bad_request, "must supply a node_name parameter for the run.")
@@ -66,7 +66,7 @@ let report_http_check req body =
         R.ok i
   in
   let clean_json = Yojson.Safe.from_string body in
-  let%bind state =
+  let* state =
     match Engine.Notify.state_of_json clean_json with
     | Error _ ->
         R.error (`Bad_request, "must supply a valid state for the node.")
@@ -98,8 +98,8 @@ let report_http t req body =
 
 let run_report_http_check req body =
   let uri = Request.uri req in
-  let bind = R.bind in
-  let%bind guid =
+  let ( let* ) = R.bind in
+  let* guid =
     match Uri.get_query_param uri "guid" with
     | None ->
         R.error (`Bad_request, "must supply a guid parameter for the run.")
@@ -108,7 +108,7 @@ let run_report_http_check req body =
   in
   let name = Uri.get_query_param uri "name" in
   let body_json = Yojson.Safe.from_string body in
-  let%bind state = Engine.Notify.run_state_of_json body_json |> R.reword_error (fun _ -> (`Bad_request, "Error decoding run state"))
+  let* state = Engine.Notify.run_state_of_json body_json |> R.reword_error (fun _ -> (`Bad_request, "Error decoding run state"))
   in
   R.ok (guid, name, state)
 
@@ -136,8 +136,8 @@ let ret_404_http () =
 
 let show_run_http_check req : (string, [> `Bad_request] * string) result =
   let uri = Request.uri req in
-  let bind = R.bind in
-  let%bind guid =
+  let ( let* ) = R.bind in
+  let* guid =
     match Uri.get_query_param uri "guid" with
     | None ->
         R.error

From f1931109990b8dfaaf373f4741ff4bc3d35b031f Mon Sep 17 00:00:00 2001
From: "Hezekiah M. Carty" <hezekiah.carty@elastic.co>
Date: Tue, 27 Apr 2021 23:39:07 -0600
Subject: [PATCH 12/14] Get rid of just a bit more ocaml-monadic

---
 cli/dune | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cli/dune b/cli/dune
index 2f49b6c..35aecfb 100644
--- a/cli/dune
+++ b/cli/dune
@@ -2,7 +2,7 @@
  (name main)
  (public_name mc)
  (libraries engine lwt.unix cmdliner yaml.unix aws-ec2 aws-lwt aws-s3-lwt rresult uuidm digestif astring)
- (preprocess (pps lwt_ppx ppx_defer ocaml-monadic )))
+ (preprocess (pps lwt_ppx ppx_defer)))
 
 (alias
   (name makecloud-cli)

From 2cb8dfb2f179e0b5a44eee4554618575acc84079 Mon Sep 17 00:00:00 2001
From: "Hezekiah M. Carty" <hezekiah.carty@elastic.co>
Date: Wed, 28 Apr 2021 14:45:28 -0600
Subject: [PATCH 13/14] Try with an older Ubuntu to get an older glibc

---
 .github/workflows/main.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
index 776bd23..0a1dd43 100644
--- a/.github/workflows/main.yml
+++ b/.github/workflows/main.yml
@@ -21,7 +21,7 @@ jobs:
       fail-fast: false
       matrix:
         os:
-          - ubuntu-latest
+          - ubuntu-16.04
         ocaml-version:
           - 4.11.2
 

From 4d3de18a8b679f001b2544a4847987bcb4de05b3 Mon Sep 17 00:00:00 2001
From: "Hezekiah M. Carty" <hezekiah.carty@elastic.co>
Date: Wed, 28 Apr 2021 14:47:56 -0600
Subject: [PATCH 14/14] Try with a slightly newer Ubuntu which has bubblewrap
 packaged for it

---
 .github/workflows/main.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
index 0a1dd43..9f37bdf 100644
--- a/.github/workflows/main.yml
+++ b/.github/workflows/main.yml
@@ -21,7 +21,7 @@ jobs:
       fail-fast: false
       matrix:
         os:
-          - ubuntu-16.04
+          - ubuntu-18.04
         ocaml-version:
           - 4.11.2