Libguestfs - Dec 2016 - [PATCH NOT TO BE APPLIED] builder: make-template: Add --encrypted

I was attempting one way to solve:
https://bugzilla.redhat.com/show_bug.cgi?id=1400332
"RFE: virt-builder should support templates with encrypted
filesystems"

However this approach doesn't really work because templates containing
encrypted partitions cannot be compressed, and therefore the guest
template would be a multi-gigabyte download.

I better approach will likely be to use the new qcow2 encryption
(LUKS-based) recently written by Dan Berrange.

I am posting this patch just to record the code changes.

Rich.

This allows encrypted templates to be built.  However virt-builder
cannot handle them yet.
---
 builder/templates/make-template.ml | 126 ++++++++++++++++++++++++++-----------
 1 file changed, 88 insertions(+), 38 deletions(-)

diff --git a/builder/templates/make-template.ml
b/builder/templates/make-template.ml
index e0e9dee..9c3173b 100755
--- a/builder/templates/make-template.ml
+++ b/builder/templates/make-template.ml
@@ -61,12 +61,15 @@ type arch = X86_64 | Aarch64 | Armv7 | I686 | PPC64 |
PPC64le | S390X
 let quote = Filename.quote
 let (//) = Filename.concat
 
+(* Encryption passphrase, replaced later by virt-builder. *)
+let passphrase = "builder"
+
 let rec main ()    assert (Sys.word_size = 64);
   Random.self_init ();
 
   (* Parse the command line. *)
-  let os, arch = parse_cmdline () in
+  let os, arch, encrypted = parse_cmdline () in
 
   (* Choose a disk size for this OS. *)
   let virtual_size_gb = get_virtual_size_gb os arch in
@@ -75,7 +78,7 @@ let rec main ()     * For OSes which require a preseed file,
this returns one (we
    * don't generate preseed files at the moment).
    *)
-  let ks = make_kickstart_or_preseed os arch in
+  let ks = make_kickstart_or_preseed os arch encrypted in
 
   (* Find the virt-install --location for this OS. *)
   let location = make_location os arch in
@@ -155,19 +158,28 @@ let rec main ()    (* Get the root filesystem.  If the
root filesystem is LVM then
    * get the partition containing it.
    *)
-  let g = open_guest tmpout in
+  let g = open_guest ~encrypted tmpout in
   let roots = g#inspect_get_roots () in
   let expandfs, lvexpandfs      let rootfs = g#canonical_device_name roots.(0)
in
-    if String.length rootfs >= 7 && String.sub rootfs 0 7 =
"/dev/sd" then
+    if string_prefix rootfs "/dev/sd" then
       rootfs, None (* non-LVM case *)
+    else if encrypted then (
+      (* In the encrypted case we just find the crypto_LUKS partition,
+       * and we assume LVM is being used inside there.
+       *)
+      let parts = get_crypto_LUKS_partitions g in
+      assert (List.length parts = 1);
+      assert (string_count_chars rootfs '/' >= 2 (* an LVM device
*));
+      List.hd parts, Some rootfs
+    )
     else (
       (* The LVM case, find the containing partition to expand. *)
       let pvs = Array.to_list (g#pvs ()) in
       match pvs with
       | [pv] ->
          let pv = g#canonical_device_name pv in
-         assert (String.length pv >= 7 && String.sub pv 0 7 =
"/dev/sd");
+         assert (string_prefix pv "/dev/sd");
          pv, Some rootfs
       | [] | _::_::_ -> assert false
     ) in
@@ -213,7 +225,7 @@ let rec main ()    (* Create the final output name (actually
not quite final because
    * we will xz-compress it).
    *)
-  let output = filename_of_os os arch "" in
+  let output = filename_of_os os arch encrypted "" in
 
   (* Sparsify and copy to output name. *)
   printf "Sparsifying ...\n%!";
@@ -251,7 +263,7 @@ let rec main ()    (match os with
    | RHEL _ -> ()
    | _ ->
-      let index_fragment = filename_of_os os arch ".index-fragment"
in
+      let index_fragment = filename_of_os os arch encrypted
".index-fragment" in
       (* If there is an existing file, read the revision and increment it. *)
       let revision = read_revision index_fragment in
       let revision = match revision with None -> None | Some i -> Some
(i+1) in
@@ -268,6 +280,7 @@ let rec main ()  
 and parse_cmdline ()    let anon = ref [] in
+  let encrypted = ref false in
 
   let usage = "\
 ../../run ./make-template.ml [--options] os version [arch]
@@ -278,6 +291,7 @@ Usage:
 Examples:
   ../../run ./make-template.ml fedora 25
   ../../run ./make-template.ml rhel 7.3 ppc64le
+  ../../run ./make-template.ml --encrypted rhel 7.3
 
 The arch defaults to x86_64.  Note that i686 is treated as a
 separate arch.
@@ -285,6 +299,7 @@ separate arch.
 Options:
 " in
   let spec = Arg.align [
+    "--encrypted", Arg.Set encrypted, "Create a LUKS-encrypted
template.";
   ] in
 
   Arg.parse spec (fun s -> anon := s :: !anon) usage;
@@ -299,7 +314,9 @@ Options:
   let os = os_of_string os ver
   and arch = arch_of_string arch in
 
-  os, arch
+  let encrypted = !encrypted in
+
+  os, arch, encrypted
 
 and os_of_string os ver    match os, ver with
@@ -347,25 +364,11 @@ and string_of_arch = function
   | PPC64le -> "ppc64le"
   | S390X -> "s390x"
 
-and filename_of_os os arch ext -  match os with
-  | Fedora ver ->
-     if arch = X86_64 then sprintf "fedora-%d%s" ver ext
-     else sprintf "fedora-%d-%s%s" ver (string_of_arch arch) ext
-  | CentOS (major, minor) ->
-     if arch = X86_64 then sprintf "centos-%d.%d%s" major minor ext
-     else sprintf "centos-%d.%d-%s%s" major minor (string_of_arch
arch) ext
-  | RHEL (major, minor) ->
-     if arch = X86_64 then sprintf "rhel-%d.%d%s" major minor ext
-     else sprintf "rhel-%d.%d-%s%s" major minor (string_of_arch arch)
ext
-  | Debian (ver, _) ->
-     if arch = X86_64 then sprintf "debian-%d%s" ver ext
-     else sprintf "debian-%d-%s%s" ver (string_of_arch arch) ext
-  | Ubuntu (ver, _) ->
-     if arch = X86_64 then sprintf "ubuntu-%s%s" ver ext
-     else sprintf "ubuntu-%s-%s%s" ver (string_of_arch arch) ext
-
-and string_of_os os arch = filename_of_os os arch ""
+and filename_of_os os arch encrypted ext +  let os = string_of_os_noarch os in
+  let arch = if arch = X86_64 then "" else "-" ^
string_of_arch arch in
+  let encrypted = if encrypted then "-encrypted" else "" in
+  os ^ arch ^ encrypted ^ ext
 
 (* This is what virt-builder called "os-version". *)
 and string_of_os_noarch = function
@@ -381,23 +384,32 @@ and is_selinux_os = function
 
 and get_virtual_size_gb os arch = 6
 
-and make_kickstart_or_preseed os arch +and make_kickstart_or_preseed os arch
encrypted    match os with
   (* Kickstart. *)
   | Fedora _ | CentOS _ | RHEL _ ->
-     let ks_filename = filename_of_os os arch ".ks" in
-     make_kickstart_common ks_filename os arch
+     let ks_filename = filename_of_os os arch encrypted ".ks" in
+     make_kickstart_common ks_filename os arch encrypted
 
   (* Preseed. *)
-  | Debian _ -> copy_preseed_to_temporary "debian.preseed"
-  | Ubuntu _ -> copy_preseed_to_temporary "ubuntu.preseed"
+  | Debian _ ->
+     if encrypted then encrypted_not_supported ();
+     copy_preseed_to_temporary "debian.preseed"
+  | Ubuntu _ ->
+     if encrypted then encrypted_not_supported ();
+     copy_preseed_to_temporary "ubuntu.preseed"
 
-and make_kickstart_common ks_filename os arch +and encrypted_not_supported () +
eprintf "%s: the --encrypted flag is not supported for
Debian/Ubuntu.\n"
+          prog;
+  exit 1
+
+and make_kickstart_common ks_filename os arch encrypted    let buf =
Buffer.create 4096 in
   let bpf fs = bprintf buf fs in
 
   bpf "\
-# Kickstart file for %s
+# Kickstart file: %s
 # Generated by libguestfs.git/builder/templates/make-template.ml
 
 install
@@ -409,7 +421,7 @@ network --bootproto dhcp
 rootpw builder
 firewall --enabled --ssh
 timezone --utc America/New_York
-" (string_of_os os arch);
+" ks_filename;
 
   (match os with
    | RHEL (ver, _) when ver <= 4 ->
@@ -438,6 +450,7 @@ mouse generic
 
   (match os with
    | CentOS ((3|4|5|6) as major, _) | RHEL ((3|4|5|6) as major, _) ->
+      if encrypted then encrypted_not_supported ();
       let bootfs = if major <= 5 then "ext2" else "ext4"
in
       let rootfs = if major <= 4 then "ext3" else "ext4"
in
       bpf "\
@@ -447,12 +460,14 @@ part /boot --fstype=%s   --size=512         --asprimary
 part swap                --size=1024        --asprimary
 part /     --fstype=%s   --size=1024 --grow --asprimary
 " bootfs rootfs;
+
    | CentOS _ | RHEL _ | Fedora _ ->
       bpf "\
 zerombr
 clearpart --all --initlabel
-autopart --type=lvm
-";
+autopart --type=lvm%s
+" (if encrypted then sprintf " --encrypted --passphrase=%s"
passphrase else "");
+
    | _ -> assert false (* cannot happen, see caller *)
   );
   bpf "\n";
@@ -1033,11 +1048,25 @@ and sha512sum_of_file filename  
 and size_of_file filename = (Unix.stat filename).Unix.st_size
 
-and open_guest filename +and open_guest ~encrypted filename    let g = new
Guestfs.guestfs () in
   g#add_drive_opts ~format:"raw" filename;
   g#launch ();
 
+  (* Modelled on code in fish/decrypt.c *)
+  if encrypted then (
+    let parts = get_crypto_LUKS_partitions g in
+    List.iteri (
+      fun i part ->
+        let luksdev = sprintf "luks%d" i in
+        g#luks_open part passphrase luksdev
+    ) parts;
+    if parts <> [] then (
+      g#vgscan ();
+      g#vg_activate_all true
+    )
+  );
+
   let roots = g#inspect_os () in
   if Array.length roots = 0 then (
     eprintf "%s: cannot inspect this guest - this may mean guest
installation failed\n" prog;
@@ -1052,6 +1081,15 @@ and open_guest filename  
   g
 
+and get_crypto_LUKS_partitions g +  let parts = g#list_partitions () in
+  let parts = Array.to_list parts in
+  List.filter (
+    fun part ->
+      let vfs = try g#vfs_type part with Guestfs.Error _ -> "" in
+      vfs = "crypto_LUKS"
+  ) parts
+
 and check_process_status_for_errors = function
   | Unix.WEXITED 0 -> ()
   | Unix.WEXITED i ->
@@ -1076,4 +1114,16 @@ and random8        ) [1;2;3;4;5;6;7;8]
     )
 
+and string_prefix str prefix +  let len = String.length prefix in
+  String.length str >= len && String.sub str 0 len = prefix
+
+and string_count_chars str char +  let len = String.length str in
+  let count = ref 0 in
+  for i = 0 to len-1 do
+    if String.unsafe_get str i = char then incr count
+  done;
+  !count
+
 let () = main ()
-- 
2.10.2