struct

  open Ketrew_host.Ssh

  
  (** Generate a proper SSH command for the given host. *)

  let do_ssh ssh command =
    ["ssh"; ssh_batch_option ssh]
    @ ssh.add_ssh_options
    @ (match ssh.port with
      | Some p -> ["-p"; Int.to_string p]
      | None -> [])
    @ (match ssh.user with
      | None -> [ssh.address]
      | Some u -> [fmt "%s@%s" u ssh.address])
    @ [command]

  
  (** Strong version of an SSH call, trying to be like Unix.exec. It “stores” the value of "$?" in the stderr channel enclosing the error log of the actual command between (hopefully) unique strings.

It calls the command (list of strings, argv-like) with exec inside a sub-shell, and escapes all the arguments with Filename.quote.

Then it forces the “script” to return '0', if the overall execution of the whole SSH command does not return '0', we know that the problem is with the SSH call, not the command. *)


  let generic_ssh_exec ssh command =
    let unique_tag = Unique_id.create () in
    let spicied_command =
      fmt "echo -n %s >&2 ; (exec %s) ;
           echo -n %s$? >&2 ;
           exit 0"
        unique_tag
        (List.map command ~f:(Filename.quote) |> String.concat ~sep:" ")
        unique_tag
    in
    let ssh_exec = do_ssh ssh spicied_command in
    let parse_error_log out err =
      let fail_parsing msg = fail (`Ssh_failure (`Wrong_log msg, err)) in
      let pieces = String.split ~on:(`String unique_tag) err in
      match pieces with
      | "" :: actual_stderr :: return_value :: [] ->
        begin match Int.of_string (String.strip return_value) with
        | Some r -> return (out, actual_stderr, r)
        | None ->
          fail_parsing (fmt "Return value not an integer: %S" return_value)
        end
      | somehting_else -> fail_parsing "Cannot parse error log"
    in
    begin Ketrew_unix_process.exec ssh_exec
      >>< function
      | `Ok (out, err, `Exited 0) -> parse_error_log out err
      | `Ok (out, err, other) ->
        fail (`Ssh_failure (`Wrong_status other, err))
      | `Error (`Process _ as process_error) ->
        let msg = Ketrew_unix_process.error_to_string process_error in
        Log.(s "Ssh-cmd " % OCaml.list (sf "%S") ssh_exec
             % s " failed: " %s msg @ verbose);
        fail (`Unix_exec msg)
    end

  
  (** Generate an SCP command for the given host with the destination directory or file path. *)

  let scp_push ssh ~src ~dest =
    ["scp"; ssh_batch_option ssh]
    @ ssh.add_ssh_options
    @ (match ssh.port with
      | Some p -> ["-P"; "port"]
      | None -> [])
    @ src
    @ (match ssh.user with
      | None -> [fmt "%s:%s" ssh.address dest]
      | Some u -> [fmt "%s@%s:%s" u ssh.address dest])

  
  (** Generate an SCP command for the given host as source. *)

  let scp_pull  ssh ~src ~dest =
    ["scp"; ssh_batch_option ssh]
    @ ssh.add_ssh_options
    @ (match ssh.port with
      | Some p -> ["-P"; "port"]
      | None -> [])
    @ (List.map src ~f:(fun src_item ->
        match ssh.user with
        | None -> fmt "%s:%s" ssh.address src_item
        | Some u -> fmt "%s@%s:%s" u ssh.address src_item))
    @ [dest]

end