builder: Add --edit option.

This allows you to use Perl to edit files in the guest.

This works very similarly to the 'virt-edit -e' (non-interactive
editing) function.

builder/Makefile.am

@@ -49,6 +49,8 @@ SOURCES = \
 	index_parser.ml \
 	list_entries.mli \
 	list_entries.ml \
+	perl_edit.ml \
+	perl_edit.mli \
 	sigchecker.mli \
 	sigchecker.ml
 
@@ -70,6 +72,7 @@ OBJECTS = \
 	sigchecker.cmx \
 	index_parser.cmx \
 	list_entries.cmx \
+	perl_edit.cmx \
 	builder.cmx
 
 bin_SCRIPTS = virt-builder

builder/builder.ml

@@ -39,7 +39,7 @@ let default_cachedir =
       None (* no cache directory *)
 
 let mode, arg,
-  attach, cache, check_signature, curl, debug, delete, fingerprint,
+  attach, cache, check_signature, curl, debug, delete, edit, fingerprint,
   firstboot, run,
   format, gpg, hostname, install, list_long, network, output,
   password_crypto, quiet, root_password,
@@ -78,6 +78,19 @@ let mode, arg,
   let delete = ref [] in
   let add_delete s = delete := s :: !delete in
 
+  let edit = ref [] in
+  let add_edit arg =
+    let i =
+      try String.index arg ':'
+      with Not_found ->
+        eprintf (f_"%s: invalid --edit format, see the man page.\n") prog;
+        exit 1 in
+    let len = String.length arg in
+    let file = String.sub arg 0 i in
+    let expr = String.sub arg (i+1) (len-(i+1)) in
+    edit := (file, expr) :: !edit
+  in
+
   let fingerprint =
     try Some (Sys.getenv "VIRT_BUILDER_FINGERPRINT")
     with Not_found -> None in
@@ -192,6 +205,7 @@ let mode, arg,
     "--delete",  Arg.String add_delete,     "name" ^ s_"Delete a file or dir";
     "--delete-cache", Arg.Unit delete_cache_mode,
                                             " " ^ s_"Delete the template cache";
+    "--edit",    Arg.String add_edit,       "file:expr" ^ " " ^ s_"Edit file with Perl expr";
     "--fingerprint", Arg.String set_fingerprint,
                                             "AAAA.." ^ " " ^ s_"Fingerprint of valid signing key";
     "--firstboot", Arg.String add_firstboot, "script" ^ " " ^ s_"Run script at first guest boot";
@@ -254,6 +268,7 @@ read the man page virt-builder(1).
   let curl = !curl in
   let debug = !debug in
   let delete = List.rev !delete in
+  let edit = List.rev !edit in
   let fingerprint = !fingerprint in
   let firstboot = List.rev !firstboot in
   let run = List.rev !run in
@@ -314,7 +329,7 @@ read the man page virt-builder(1).
       ) in
 
   mode, arg,
-  attach, cache, check_signature, curl, debug, delete, fingerprint,
+  attach, cache, check_signature, curl, debug, delete, edit, fingerprint,
   firstboot, run,
   format, gpg, hostname, install, list_long, network, output,
   password_crypto, quiet, root_password,
@@ -786,6 +801,21 @@ let () =
       g#upload file dest
   ) upload
 
+(* Edit files. *)
+let () =
+  List.iter (
+    fun (file, expr) ->
+      msg (f_"Editing: %s") file;
+
+      if not (g#is_file file) then (
+        eprintf (f_"%s: error: %s is not a regular file in the guest\n")
+          prog file;
+        exit 1
+      );
+
+      Perl_edit.edit_file ~debug g file expr
+  ) edit
+
 (* Delete files. *)
 let () =
   List.iter (

builder/perl_edit.ml

@@ -0,0 +1,105 @@
+(* virt-builder
+ * Copyright (C) 2013 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 Common_gettext.Gettext
+open Common_utils
+
+open Printf
+
+(* Implement the --edit option.
+ *
+ * Code copied from virt-edit.
+ *)
+let rec edit_file ~debug (g : Guestfs.guestfs) file expr =
+  let file_old = file ^ "~" in
+  g#rename file file_old;
+
+  (* Download the file to a temporary. *)
+  let tmpfile = Filename.temp_file "vbedit" "" in
+  unlink_on_exit tmpfile;
+  g#download file_old tmpfile;
+
+  do_perl_edit ~debug g tmpfile expr;
+
+  (* Upload the file.  Unlike virt-edit we can afford to fail here
+   * so we don't need the temporary upload file.
+   *)
+  g#upload tmpfile file;
+
+  (* However like virt-edit we do need to copy attributes. *)
+  copy_attributes g file_old file;
+  g#rm file_old
+
+and do_perl_edit ~debug g file expr =
+  (* Pass the expression to Perl via the environment.  This sidesteps
+   * any quoting problems with the already complex Perl command line.
+   *)
+  Unix.putenv "virt_edit_expr" expr;
+
+  (* Call out to a canned Perl script. *)
+  let cmd = sprintf "\
+    perl -e '
+      $lineno = 0;
+      $expr = $ENV{virt_edit_expr};
+      while (<STDIN>) {
+        $lineno++;
+        eval $expr;
+        die if $@;
+        print STDOUT $_ or die \"print: $!\";
+      }
+      close STDOUT or die \"close: $!\";
+    ' < %s > %s.out" file file in
+
+  if debug then
+    eprintf "%s\n%!" cmd;
+
+  let r = Sys.command cmd in
+  if r <> 0 then (
+    eprintf (f_"virt-builder: error: could not evaluate Perl expression '%s'\n")
+      expr;
+    exit 1
+  );
+
+  Unix.rename (file ^ ".out") file
+
+and copy_attributes g src dest =
+  let has_linuxxattrs = g#feature_available [|"linuxxattrs"|] in
+
+  (* Get the mode. *)
+  let stat = g#stat src in
+
+  (* Get the SELinux context.  XXX Should we copy over other extended
+   * attributes too?
+   *)
+  let selinux_context =
+    if has_linuxxattrs then (
+      try Some (g#getxattr src "security.selinux") with _ -> None
+    ) else None in
+
+  (* Set the permissions (inc. sticky and set*id bits), UID, GID. *)
+  let mode = Int64.to_int stat.G.mode
+  and uid = Int64.to_int stat.G.uid and gid = Int64.to_int stat.G.gid in
+  g#chmod (mode land 0o7777) dest;
+  g#chown uid gid dest;
+
+  (* Set the SELinux context. *)
+  match selinux_context with
+  | None -> ()
+  | Some selinux_context ->
+    g#setxattr "security.selinux"
+      selinux_context (String.length selinux_context) dest

builder/perl_edit.mli

@@ -0,0 +1,19 @@
+(* virt-builder
+ * Copyright (C) 2013 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.
+ *)
+
+val edit_file : debug:bool -> Guestfs.guestfs -> string -> string -> unit

builder/virt-builder.pod

@@ -11,7 +11,9 @@ virt-builder - Build virtual machine images quickly
     [--root-password ...]
     [--hostname HOSTNAME]
     [--install PKG,[PKG...]]
-    [--upload FILE:DEST] [--delete FILE] [--scrub FILE]
+    [--upload FILE:DEST]
+    [--edit FILE:EXPR]
+    [--delete FILE] [--scrub FILE]
     [--run SCRIPT] [--run-command 'CMD ARGS ...']
     [--firstboot SCRIPT] [--firstboot-command 'CMD ARGS ...']
     [--firstboot-install PKG,[PKG...]]
@@ -117,12 +119,13 @@ you would install a meta-package instead.)
 
 =head2 Customizing the installation
 
-There are four options that let you run shell scripts to customize the
-installation.  They are: I<--run>/I<--run-command>, which run a shell
-script or command while the disk image is being generated and lets you
-add or edit files that go into the disk image.  And
+There are many options that let you customize the installation.  These
+include: I<--run>/I<--run-command>, which run a shell script or
+command while the disk image is being generated and lets you add or
+edit files that go into the disk image.
 I<--firstboot>/I<--firstboot-command>, which let you add
 scripts/commands that are run the first time the guest boots.
+I<--edit> to edit files.  I<--upload> to upload files.
 
 For example:
 
@@ -141,17 +144,12 @@ the guest boots.
 
 Or:
 
- cat <<'EOF' > /tmp/no-gpg-sigs.sh
- sed -i 's/gpgcheck=1/gpgcheck=0/' /etc/yum.conf
- EOF
- 
- virt-builder fedora-20 --run /tmp/no-gpg-sigs.sh
+ virt-builder fedora-20 --edit '/etc/yum.conf: s/gpgcheck=1/gpgcheck=0/'
 
 which edits C</etc/yum.conf> inside the disk image (during disk image
 creation, long before boot).
 
-You can combine these options, and have multiple of either or both
-sets of scripts.
+You can combine these options, and have multiple options of all types.
 
 =head1 OPTIONS
 
@@ -233,6 +231,17 @@ See also: I<--upload>, I<--scrub>.
 
 Delete the template cache.  See L</CACHING>.
 
+=item B<--edit> FILE:EXPR
+
+Edit C<FILE> using the Perl expression C<EXPR>.
+
+Be careful to properly quote the expression to prevent it from
+being altered by the shell.
+
+Note that this option is only available when Perl 5 is installed.
+
+See L<virt-edit(1)/NON-INTERACTIVE EDITING>.
+
 =item B<--fingerprint> 'AAAA BBBB ...'
 
 Check that the digital signature is signed by the key with the given
@@ -707,6 +716,10 @@ Files are uploaded (I<--upload>).
 
 =item *
 
+Files are edited (I<--edit>).
+
+=item *
+
 Files are deleted (I<--delete>, I<--scrub>).
 
 =item *

edit/edit.c

@@ -450,6 +450,7 @@ edit_interactively (const char *tmpfile)
   return ret;
 }
 
+/* Note that virt-builder uses exactly the same code .. in OCaml. */
 static char *
 edit_non_interactively (const char *tmpfile)
 {

po/POTFILES-ml

@@ -3,6 +3,7 @@ builder/downloader.ml
 builder/get_kernel.ml
 builder/index_parser.ml
 builder/list_entries.ml
+builder/perl_edit.ml
 builder/sigchecker.ml
 mllib/common_gettext.ml
 mllib/common_utils.ml