(* helper-v2v-input
 * Copyright (C) 2009-2021 Red Hat Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License along
 * with this program; if not, write to the Free Software Foundation, Inc.,
 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 *)

open Printf
open Unix

open Std_utils
open Tools_utils
open Common_gettext.Gettext

open Types
open Utils

open Name_from_disk
open Input

module OVA = struct
  let to_string options args = String.concat " " ("-i ova" :: args)

  let query_input_options () =
    printf (f_"No input options can be used in this mode.\n")

  (* RHBZ#1570407: VMware-generated OVA files found in the wild can
   * contain hrefs referencing snapshots.  The href will be something
   * like: <File href="disk1.vmdk"/> but the actual disk will be a
   * snapshot called something like "disk1.vmdk.000000000".
   *)
  let re_snapshot = PCRE.compile "\\.(\\d+)$"

  let rec setup dir options args =
    if options.input_options <> [] then
      error (f_"no -io (input options) are allowed here");

    let ova =
      match args with
      | [ova] -> ova
      | _ ->
         error (f_"-i ova: expecting an OVA file name on the command line") in

    (* Check the OVA file is readable. *)
    access ova [R_OK];

    (* Extract ova file. *)
    let ova_t = OVA.parse_ova ova in

    (* Extract ovf file from ova. *)
    let ovf = OVA.get_ovf_file ova_t in

    (* Extract the manifest from *.mf files in the ova. *)
    let manifest = OVA.get_manifest ova_t in

    (* Verify checksums of files listed in the manifest. *)
    List.iter (
      fun (file_ref, csum) ->
        let filename, r =
          match file_ref with
          | OVA.LocalFile filename ->
             filename, Checksums.verify_checksum csum filename
          | OVA.TarFile (tar, filename) ->
             filename, Checksums.verify_checksum csum ~tar filename in
        match r with
        | Checksums.Good_checksum -> ()
        | Checksums.Mismatched_checksum (_, actual) ->
           error (f_"-i ova: corrupt OVA: checksum of disk %s does not match manifest (actual = %s, expected = %s)")
             filename actual (Checksums.string_of_csum_t csum)
        | Checksums.Missing_file ->
           (* RHBZ#1570407: Some OVA files generated by VMware
            * reference non-existent components in the *.mf file.
            * Generate a warning and ignore it.
            *)
           warning (f_"manifest has a checksum for non-existent file %s (ignored)")
             filename
    ) manifest;

    (* Parse the ovf file. *)
    let name, memory, vcpu, cpu_topology, firmware, disks, removables, nics =
      OVF.parse_ovf_from_ova ovf in

    let name =
      match name with
      | None ->
         warning (f_"could not parse ovf:Name from OVF document");
         name_from_disk ova
      | Some name -> name in

    (* Convert the disk hrefs into qemu URIs. *)
    let qemu_uris =
      List.map (
        fun { OVF.href; compressed } ->
          let file_ref = find_file_or_snapshot ova_t href manifest in

          match compressed, file_ref with
          | false, OVA.LocalFile filename ->
             filename

          | true, OVA.LocalFile filename ->
             (* The spec allows the file to be gzip-compressed, in
              * which case we must uncompress it into a temporary.
              *)
             let new_filename =
               Filename.temp_file ~temp_dir:Utils.large_tmpdir
                 "ova" ".vmdk" in
             On_exit.unlink new_filename;
             let cmd =
               sprintf "zcat %s > %s"
                 (quote filename) (quote new_filename) in
             if shell_command cmd <> 0 then
               error (f_"error uncompressing %s, see earlier error messages")
                 filename;
             new_filename

          | false, OVA.TarFile (tar, filename) ->
             (* This is the tar optimization. *)
             let offset, size =
               try OVA.get_tar_offet_and_size tar filename
               with
               | Not_found ->
                  error (f_"file ‘%s’ not found in the ova") filename
               | Failure msg -> error (f_"%s") msg in
             (* QEMU requires size aligned to 512 bytes. This is safe because
              * tar also works with 512 byte blocks.
              *)
             let size = roundup64 size 512L in

             (* Workaround for libvirt bug RHBZ#1431652. *)
             let tar_path = absolute_path tar in

             let doc = [
                 "file", JSON.Dict [
                             "driver", JSON.String "raw";
                             "offset", JSON.Int offset;
                             "size", JSON.Int size;
                             "file", JSON.Dict [
                                         "driver", JSON.String "file";
                                         "filename", JSON.String tar_path]
                           ]
               ] in
             let uri =
               sprintf "json:%s"
                 (JSON.string_of_doc ~fmt:JSON.Compact doc) in
             uri

          | true, OVA.TarFile _ ->
             (* This should not happen since {!OVA} knows that
              * qemu cannot handle compressed files here.
              *)
             assert false
      ) disks in

    (* Create the source metadata. *)
    let s_disks = List.map (fun { OVF.source_disk } -> source_disk) disks in

    let source = {
      s_hypervisor = VMware;
      s_name = name;
      s_genid = None; (* XXX *)
      s_memory = memory;
      s_vcpu = vcpu;
      s_cpu_vendor = None;
      s_cpu_model = None;
      s_cpu_topology = cpu_topology;
      s_features = []; (* XXX *)
      s_firmware = firmware;
      s_display = None; (* XXX *)
      s_sound = None;
      s_disks = s_disks;
      s_removables = removables;
      s_nics = nics;
    } in

    (* Run qemu-nbd for each disk. *)
    List.iteri (
      fun i qemu_uri ->
        let socket = sprintf "%s/in%d" dir i in
        On_exit.unlink socket;

        let cmd = QemuNBD.create qemu_uri in
        QemuNBD.set_snapshot cmd options.read_only; (* protective overlay *)
        QemuNBD.set_format cmd None; (* auto-detect format *)
        let _, pid = QemuNBD.run_unix socket cmd in
        On_exit.kill pid
      ) qemu_uris;

    source

  and find_file_or_snapshot ova_t href manifest =
    match OVA.resolve_href ova_t href with
    | Some f -> f
    | None ->
       (* Find all files in the OVA called [<href>.\d+] *)
       let files = OVA.get_file_list ova_t in
       let snapshots =
         List.filter_map (
             function
             | OVA.LocalFile filename ->
                get_snapshot_if_matches href filename
             | OVA.TarFile (_, filename) ->
                get_snapshot_if_matches href filename
         ) files in
       (* Pick highest. *)
       let snapshots = List.sort (fun a b -> compare b a) snapshots in
       match snapshots with
       | [] -> error_missing_href href
       | snapshot::_ ->
          let href = sprintf "%s.%s" href snapshot in
          match OVA.resolve_href ova_t href with
          | None -> error_missing_href href
          | Some f -> f

  (* If [filename] matches [<href>.\d+] then return [Some snapshot]. *)
  and get_snapshot_if_matches href filename =
    if PCRE.matches re_snapshot filename then (
      let snapshot = PCRE.sub 1 in
      if String.is_suffix filename (sprintf "%s.%s" href snapshot) then
        Some snapshot
      else
        None
    )
    else None

  and error_missing_href href =
    error (f_"-i ova: OVF references file ‘%s’ which was not found in the OVA archive") href
end
