Libguestfs - Jul 2015 - [PATCH 1/2] mllib: add and use read_first_line_from_file

Hi,

this is the v2 of a series introducing basic support for 
registering/attaching/unregistering RHEL guests using
subscription-manager, so it is possible to do for example:

  $ virt-customize -a rhel-guest.qcow2 \
    --sm-credentials user:file:/path/to/password-file --sm-register \
    --sm-attach file:/path/to/pool-file \
    --install pkg1 --install pkg2 .. \
    --sm-remove --sm-unregister

The same operations are doable also using --run-command, but this
allows to not put passwords/pools on command lines, and in general
encapsulate them for better control.


Pino Toscano (2):
  mllib: add and use read_first_line_from_file
  customize: add basic subscription-manager operations

 builder/Makefile.am                |  1 +
 builder/virt-builder.pod           | 47 ++++++++++++++++++
 customize/Makefile.am              |  2 +
 customize/customize_run.ml         | 34 +++++++++++++
 customize/password.ml              |  8 +--
 customize/subscription_manager.ml  | 53 ++++++++++++++++++++
 customize/subscription_manager.mli | 34 +++++++++++++
 generator/customize.ml             | 99 ++++++++++++++++++++++++++++++++++++--
 mllib/common_utils.ml              |  6 +++
 mllib/common_utils.mli             |  4 ++
 po/POTFILES-ml                     |  1 +
 sysprep/Makefile.am                |  1 +
 v2v/cmdline.ml                     |  2 +-
 13 files changed, 281 insertions(+), 11 deletions(-)
 create mode 100644 customize/subscription_manager.ml
 create mode 100644 customize/subscription_manager.mli

-- 
2.1.0

Move the read_password_from_file helper in Password to mllib with a more
generic name, and use it in place of the former.

Also, use it in v2v instead of reading the whole file contaning a
password: given that the documentation says that the whole content is
used, there will not be newlines in the password file, so the behaviour
will be preserved. The oly difference is that newline is no more an
acceptable character for passwords, but that is a really unlikely
(if not impossible at all) situation.
---
 customize/password.ml  | 8 +-------
 mllib/common_utils.ml  | 6 ++++++
 mllib/common_utils.mli | 4 ++++
 v2v/cmdline.ml         | 2 +-
 4 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/customize/password.ml b/customize/password.ml
index d91c4b5..111240e 100644
--- a/customize/password.ml
+++ b/customize/password.ml
@@ -60,7 +60,7 @@ and parse_selector_list orig_arg = function
     let pw = parse_selector_list orig_arg rest in
     { pw with pw_locked = true }
   | [ "file"; filename ] ->
-    { pw_password = Password (read_password_from_file filename);
+    { pw_password = Password (read_first_line_from_file filename);
       pw_locked = false }
   | "password" :: password ->
     { pw_password = Password (String.concat ":" password); pw_locked
= false }
@@ -71,12 +71,6 @@ and parse_selector_list orig_arg = function
   | _ ->
     error (f_"invalid password selector '%s'; see the man
page") orig_arg
 
-and read_password_from_file filename -  let chan = open_in filename in
-  let password = input_line chan in
-  close_in chan;
-  password
-
 (* Permissible characters in a salt. *)
 let chars =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789./"
 
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 083c5d5..f9e8996 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -745,3 +745,9 @@ let last_part_of str sep      let i = String.rindex str sep
in
     Some (String.sub str (i+1) (String.length str - (i+1)))
   with Not_found -> None
+
+let read_first_line_from_file filename +  let chan = open_in filename in
+  let line = input_line chan in
+  close_in chan;
+  line
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index 550f37f..16834f7 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -181,3 +181,7 @@ val guest_arch_compatible : string -> bool
 
 val last_part_of : string -> char -> string option
 (** Return the last part of a string, after the specified separator. *)
+
+val read_first_line_from_file : string -> string
+(** Read only the first line (i.e. until the first newline character)
+    of a file. *)
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index 705051f..eaf57dc 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -259,7 +259,7 @@ read the man page virt-v2v(1).
     match password_file with
     | None -> None
     | Some filename ->
-      let password = read_whole_file filename in
+      let password = read_first_line_from_file filename in
       Some password in
 
   (* Parsing of the argument(s) depends on the input mode. *)
-- 
2.1.0

Add simple operations for RHEL guests using subscription-manager, so it
is possible to e.g. install software on them.
---
 builder/Makefile.am                |  1 +
 builder/virt-builder.pod           | 47 ++++++++++++++++++
 customize/Makefile.am              |  2 +
 customize/customize_run.ml         | 34 +++++++++++++
 customize/subscription_manager.ml  | 53 ++++++++++++++++++++
 customize/subscription_manager.mli | 34 +++++++++++++
 generator/customize.ml             | 99 ++++++++++++++++++++++++++++++++++++--
 po/POTFILES-ml                     |  1 +
 sysprep/Makefile.am                |  1 +
 9 files changed, 269 insertions(+), 3 deletions(-)
 create mode 100644 customize/subscription_manager.ml
 create mode 100644 customize/subscription_manager.mli

diff --git a/builder/Makefile.am b/builder/Makefile.am
index d69e25f..2413217 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -125,6 +125,7 @@ BOBJECTS = \
 	$(top_builddir)/customize/crypt.cmo \
 	$(top_builddir)/customize/password.cmo \
 	$(top_builddir)/customize/ssh_key.cmo \
+	$(top_builddir)/customize/subscription_manager.cmo \
 	$(top_builddir)/customize/customize_cmdline.cmo \
 	$(top_builddir)/customize/customize_run.cmo \
 	$(SOURCES_ML:.ml=.cmo)
diff --git a/builder/virt-builder.pod b/builder/virt-builder.pod
index 41cda1a..b4a341f 100644
--- a/builder/virt-builder.pod
+++ b/builder/virt-builder.pod
@@ -844,6 +844,53 @@ F<C:\Program Files\Red Hat\Firstboot\log.txt>.
 
 =back
 
+=head2 SUBSCRIPTION-MANAGER
+
+It is possible to automate the registration and attaching of the
+system using C<subscription-manager>.  This is typical on
+Red Hat Enterprise Linux guests.  There are few options which ease
+this process, avoid executing commands manually and exposing
+passwords on command line.
+
+I<--sm-register> starts the registration process, and requires
+I<--sm-credentials> to be specified; the format of the C<SELECTOR>
+of I<--sm-credentials> is one of the following formats:
+
+=over 4
+
+=item B<--sm-credentials> USER:file:FILENAME
+
+Read the password for the specified C<USER> from F<FILENAME>.
+
+=item B<--sm-credentials> USER:password:PASSWORD
+
+Use the literal string C<PASSWORD> for the specified C<USER>.
+
+=back
+
+I<--sm-attach> attaches the system to subscriptions; the format
+of its C<SELECTOR> is one of the following:
+
+=over 4
+
+=item B<--sm-attach> auto
+
+C<subscription-manager> attaches to the best-fitting subscriptions
+for the system.
+
+=item B<--sm-attach> file:FILENAME
+
+Read the pool ID from F<FILENAME>.
+
+=item B<--sm-attach> pool:POOL
+
+Use the literal string C<POOL> as pool ID.
+
+=back
+
+I<--sm-remove> removes all the subscriptions from the guest, while
+I<--sm-unregister> completely unregister the system.
+
 =head2 INSTALLATION PROCESS
 
 When you invoke virt-builder, installation proceeds as follows:
diff --git a/customize/Makefile.am b/customize/Makefile.am
index 8f0a2d8..1974b80 100644
--- a/customize/Makefile.am
+++ b/customize/Makefile.am
@@ -43,6 +43,7 @@ SOURCES_MLI = \
 	perl_edit.mli \
 	random_seed.mli \
 	ssh_key.mli \
+	subscription_manager.mli \
 	timezone.mli \
 	urandom.mli
 
@@ -57,6 +58,7 @@ SOURCES_ML = \
 	perl_edit.ml \
 	random_seed.ml \
 	ssh_key.ml \
+	subscription_manager.ml \
 	timezone.ml \
 	customize_cmdline.ml \
 	customize_run.ml \
diff --git a/customize/customize_run.ml b/customize/customize_run.ml
index d9547a0..bce0aca 100644
--- a/customize/customize_run.ml
+++ b/customize/customize_run.ml
@@ -249,6 +249,40 @@ exec >>%s 2>&1
       message (f_"Scrubbing: %s") path;
       g#scrub_file path
 
+    | `SMAttach pool ->
+      (match pool with
+      | Subscription_manager.PoolAuto ->
+        message (f_"Attaching to compatible subscriptions");
+        let cmd = "subscription-manager attach --auto" in
+        do_run ~display:cmd cmd
+      | Subscription_manager.PoolId id ->
+        message (f_"Attaching to the pool %s") id;
+        let cmd = sprintf "subscription-manager attach --pool=%s"
(quote id) in
+        do_run ~display:cmd cmd
+      )
+
+    | `SMRegister ->
+      message (f_"Registering with subscription-manager");
+      let creds +        match ops.flags.sm_credentials with
+        | None ->
+          error (f_"subscription-manager credentials required for
--sm-register")
+        | Some c -> c in
+      let cmd = sprintf "subscription-manager register --username=%s
--password=%s"
+                  (quote creds.Subscription_manager.sm_username)
+                  (quote creds.Subscription_manager.sm_password) in
+      do_run ~display:"subscription-manager register" cmd
+
+    | `SMRemove ->
+      message (f_"Removing all the subscriptions");
+      let cmd = "subscription-manager remove --all" in
+      do_run ~display:cmd cmd
+
+    | `SMUnregister ->
+      message (f_"Unregistering with subscription-manager");
+      let cmd = "subscription-manager unregister" in
+      do_run ~display:cmd cmd
+
     | `SSHInject (user, selector) ->
       (match g#inspect_get_type root with
       | "linux" | "freebsd" | "netbsd" |
"openbsd" | "hurd" ->
diff --git a/customize/subscription_manager.ml
b/customize/subscription_manager.ml
new file mode 100644
index 0000000..c9828d6
--- /dev/null
+++ b/customize/subscription_manager.ml
@@ -0,0 +1,53 @@
+(* virt-customize
+ * Copyright (C) 2015 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
+
+type sm_credentials = {
+  sm_username : string;
+  sm_password : string;
+}
+
+type sm_pool +| PoolAuto
+| PoolId of string
+
+let rec parse_credentials_selector arg +  parse_credentials_selector_list arg
(string_nsplit ":" arg)
+
+and parse_credentials_selector_list orig_arg = function
+  | [ username; "password"; password ] ->
+    { sm_username = username; sm_password = password }
+  | [ username; "file"; filename ] ->
+    { sm_username = username; sm_password = read_first_line_from_file filename
}
+  | _ ->
+    error (f_"invalid sm-credentials selector '%s'; see the man
page") orig_arg
+
+let rec parse_pool_selector arg +  parse_pool_selector_list arg (string_nsplit
":" arg)
+
+and parse_pool_selector_list orig_arg = function
+  | [ "auto" ] ->
+    PoolAuto
+  | [ "pool"; pool ] ->
+    PoolId pool
+  | [ "file"; filename ] ->
+    PoolId (read_first_line_from_file filename)
+  | _ ->
+    error (f_"invalid sm-attach selector '%s'; see the man
page") orig_arg
diff --git a/customize/subscription_manager.mli
b/customize/subscription_manager.mli
new file mode 100644
index 0000000..bb6b920
--- /dev/null
+++ b/customize/subscription_manager.mli
@@ -0,0 +1,34 @@
+(* virt-customize
+ * Copyright (C) 2015 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.
+ *)
+
+type sm_credentials = {
+  sm_username : string;
+  sm_password : string;
+}
+
+type sm_pool +| PoolAuto                           (** Automatic entitlements.
*)
+| PoolId of string                   (** Specific pool. *)
+
+val parse_credentials_selector : string -> sm_credentials
+(** Parse the selector field in --sm-credentials.  Exits if the format
+    is not valid. *)
+
+val parse_pool_selector : string -> sm_pool
+(** Parse the selector field in --sm-attach.  Exits if the format
+    is not valid. *)
diff --git a/generator/customize.ml b/generator/customize.ml
index f57aba6..2196e9e 100644
--- a/generator/customize.ml
+++ b/generator/customize.ml
@@ -44,6 +44,7 @@ and op_type  | UserPasswordSelector of string        (*
user:selector *)
 | SSHKeySelector of string              (* user:selector *)
 | StringFn of (string * string)         (* string, function name *)
+| SMPoolSelector of string              (* pool selector *)
 
 let ops = [
   { op_name = "chmod";
@@ -327,6 +328,44 @@ It cannot delete directories, only regular files.
 =back";
   };
 
+  { op_name = "sm-attach";
+    op_type = SMPoolSelector "SELECTOR";
+    op_discrim = "`SMAttach";
+    op_shortdesc = "Attach to a subscription-manager pool";
+    op_pod_longdesc = "\
+Attach to a pool using C<subscription-manager>.
+
+See L<virt-builder(1)/SUBSCRIPTION-MANAGER> for the format of
+the C<SELECTOR> field.";
+  };
+
+  { op_name = "sm-register";
+    op_type = Unit;
+    op_discrim = "`SMRegister";
+    op_shortdesc = "Register using subscription-manager";
+    op_pod_longdesc = "\
+Register the guest using C<subscription-manager>.
+
+This requires credentials being set using I<--sm-credentials>.";
+  };
+
+  { op_name = "sm-remove";
+    op_type = Unit;
+    op_discrim = "`SMRemove";
+    op_shortdesc = "Remove all the subscriptions";
+    op_pod_longdesc = "\
+Remove all the subscriptions from the guest using
+C<subscription-manager>.";
+  };
+
+  { op_name = "sm-unregister";
+    op_type = Unit;
+    op_discrim = "`SMUnregister";
+    op_shortdesc = "Unregister using subscription-manager";
+    op_pod_longdesc = "\
+Unregister the guest using C<subscription-manager>.";
+  };
+
   { op_name = "ssh-inject";
     op_type = SSHKeySelector "USER[:SELECTOR]";
     op_discrim = "`SSHInject";
@@ -428,6 +467,7 @@ type flag = {
 and flag_type  | FlagBool of bool                  (* boolean is the default
value *)
 | FlagPasswordCrypto of string
+| FlagSMCredentials of string
 
 let flags = [
   { flag_name = "no-logfile";
@@ -477,6 +517,18 @@ Relabel files in the guest so that they have the correct
SELinux label.
 
 You should only use this option for guests which support SELinux.";
   };
+
+  { flag_name = "sm-credentials";
+    flag_type = FlagSMCredentials "SELECTOR";
+    flag_ml_var = "sm_credentials";
+    flag_shortdesc = "credentials for subscription-manager";
+    flag_pod_longdesc = "\
+Set the credentials for C<subscription-manager>.
+
+See L<virt-builder(1)/SUBSCRIPTION-MANAGER> for the format of
+the C<SELECTOR> field.";
+  };
+
 ]
 
 let rec generate_customize_cmdline_mli () @@ -532,6 +584,8 @@ let rec argspec
()        pr "  let %s = ref %b in\n" var default
     | { flag_type = FlagPasswordCrypto _; flag_ml_var = var } ->
       pr "  let %s = ref None in\n" var
+    | { flag_type = FlagSMCredentials _; flag_ml_var = var } ->
+      pr "  let %s = ref None in\n" var
   ) flags;
   pr "\
 
@@ -672,6 +726,18 @@ let rec argspec ()        pr "      s_\"%s\"
^ \" \" ^ s_\"%s\"\n" v shortdesc;
       pr "    ),\n";
       pr "    Some %S, %S;\n" v longdesc
+    | { op_type = SMPoolSelector v; op_name = name; op_discrim = discrim;
+        op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
+      pr "    (\n";
+      pr "      \"--%s\",\n" name;
+      pr "      Arg.String (\n";
+      pr "        fun s ->\n";
+      pr "          let sel = Subscription_manager.parse_pool_selector s
in\n";
+      pr "          ops := %s sel :: !ops\n" discrim;
+      pr "      ),\n";
+      pr "      s_\"%s\" ^ \" \" ^
s_\"%s\"\n" v shortdesc;
+      pr "    ),\n";
+      pr "    Some %S, %S;\n" v longdesc
   ) ops;
 
   List.iter (
@@ -699,6 +765,19 @@ let rec argspec ()        pr "      \"%s\" ^
\" \" ^ s_\"%s\"\n" v shortdesc;
       pr "    ),\n";
       pr "    Some %S, %S;\n" v longdesc
+    | { flag_type = FlagSMCredentials v; flag_ml_var = var;
+        flag_name = name; flag_shortdesc = shortdesc;
+        flag_pod_longdesc = longdesc } ->
+      pr "    (\n";
+      pr "      \"--%s\",\n" name;
+      pr "      Arg.String (\n";
+      pr "        fun s ->\n";
+      pr "          %s := Some
(Subscription_manager.parse_credentials_selector s)\n"
+        var;
+      pr "      ),\n";
+      pr "      \"%s\" ^ \" \" ^
s_\"%s\"\n" v shortdesc;
+      pr "    ),\n";
+      pr "    Some %S, %S;\n" v longdesc
   ) flags;
 
   pr "  ]
@@ -717,7 +796,8 @@ let rec argspec ()      | { op_type = TargetLinks _; }
     | { op_type = PasswordSelector _; }
     | { op_type = UserPasswordSelector _; }
-    | { op_type = SSHKeySelector _; } -> ()
+    | { op_type = SSHKeySelector _; }
+    | { op_type = SMPoolSelector _; } -> ()
   ) ops;
 
 pr "    ] in
@@ -796,6 +876,10 @@ type ops = {
         discrim name v
     | { op_type = StringFn (v, _); op_discrim = discrim; op_name = name } ->
       pr "  | %s of string\n      (* --%s %s *)\n" discrim name v
+    | { op_type = SMPoolSelector v; op_discrim = discrim;
+        op_name = name } ->
+      pr "  | %s of Subscription_manager.sm_pool\n      (* --%s %s
*)\n"
+        discrim name v
   ) ops;
   pr "]\n";
 
@@ -809,6 +893,10 @@ type ops = {
         flag_name = name } ->
       pr "  %s : Password.password_crypto option;\n      (* --%s %s
*)\n"
         var name v
+    | { flag_type = FlagSMCredentials v; flag_ml_var = var;
+        flag_name = name } ->
+      pr "  %s : Subscription_manager.sm_credentials option;\n      (*
--%s %s *)\n"
+        var name v
   ) flags;
   pr "}\n"
 
@@ -822,7 +910,7 @@ let generate_customize_synopsis_pod ()          n, sprintf
"[--%s]" n
       | { op_type = String v | StringPair v | StringList v | TargetLinks v
             | PasswordSelector v | UserPasswordSelector v | SSHKeySelector v
-            | StringFn (v, _);
+            | StringFn (v, _) | SMPoolSelector v;
           op_name = n } ->
         n, sprintf "[--%s %s]" n v
     ) ops @
@@ -832,6 +920,8 @@ let generate_customize_synopsis_pod ()            n, sprintf
"[--%s]" n
         | { flag_type = FlagPasswordCrypto v; flag_name = n } ->
           n, sprintf "[--%s %s]" n v
+        | { flag_type = FlagSMCredentials v; flag_name = n } ->
+          n, sprintf "[--%s %s]" n v
       ) flags in
 
   (* Print the option names in the synopsis, line-wrapped. *)
@@ -863,7 +953,7 @@ let generate_customize_options_pod ()          n, sprintf
"B<--%s>" n, ld
       | { op_type = String v | StringPair v | StringList v | TargetLinks v
             | PasswordSelector v | UserPasswordSelector v | SSHKeySelector v
-            | StringFn (v, _);
+            | StringFn (v, _) | SMPoolSelector v;
           op_name = n; op_pod_longdesc = ld } ->
         n, sprintf "B<--%s> %s" n v, ld
     ) ops @
@@ -874,6 +964,9 @@ let generate_customize_options_pod ()          | { flag_type
= FlagPasswordCrypto v;
             flag_name = n; flag_pod_longdesc = ld } ->
           n, sprintf "B<--%s> %s" n v, ld
+        | { flag_type = FlagSMCredentials v;
+            flag_name = n; flag_pod_longdesc = ld } ->
+          n, sprintf "B<--%s> %s" n v, ld
       ) flags in
   let cmp (arg1, _, _) (arg2, _, _)      compare (String.lowercase arg1)
(String.lowercase arg2)
diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index cddd02f..bfed0cf 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -23,6 +23,7 @@ customize/password.ml
 customize/perl_edit.ml
 customize/random_seed.ml
 customize/ssh_key.ml
+customize/subscription_manager.ml
 customize/timezone.ml
 customize/urandom.ml
 dib/cmdline.ml
diff --git a/sysprep/Makefile.am b/sysprep/Makefile.am
index c1d1245..9424c40 100644
--- a/sysprep/Makefile.am
+++ b/sysprep/Makefile.am
@@ -119,6 +119,7 @@ BOBJECTS = \
 	$(top_builddir)/customize/firstboot.cmo \
 	$(top_builddir)/customize/perl_edit.cmo \
 	$(top_builddir)/customize/ssh_key.cmo \
+	$(top_builddir)/customize/subscription_manager.cmo \
 	$(top_builddir)/customize/customize_cmdline.cmo \
 	$(top_builddir)/customize/customize_run.cmo \
 	$(SOURCES_ML:.ml=.cmo)
-- 
2.1.0

On Fri, Jul 17, 2015 at 03:31:18PM +0200, Pino Toscano
wrote:
> Move the read_password_from_file helper in Password to mllib with a more
> generic name, and use it in place of the former.
> 
> Also, use it in v2v instead of reading the whole file contaning a
> password: given that the documentation says that the whole content is
> used, there will not be newlines in the password file, so the behaviour
> will be preserved. The oly difference is that newline is no more an
> acceptable character for passwords, but that is a really unlikely
> (if not impossible at all) situation.
> ---
>  customize/password.ml  | 8 +-------
>  mllib/common_utils.ml  | 6 ++++++
>  mllib/common_utils.mli | 4 ++++
>  v2v/cmdline.ml         | 2 +-
>  4 files changed, 12 insertions(+), 8 deletions(-)
> 
> diff --git a/customize/password.ml b/customize/password.ml
> index d91c4b5..111240e 100644
> --- a/customize/password.ml
> +++ b/customize/password.ml
> @@ -60,7 +60,7 @@ and parse_selector_list orig_arg = function
>      let pw = parse_selector_list orig_arg rest in
>      { pw with pw_locked = true }
>    | [ "file"; filename ] ->
> -    { pw_password = Password (read_password_from_file filename);
> +    { pw_password = Password (read_first_line_from_file filename);
>        pw_locked = false }
>    | "password" :: password ->
>      { pw_password = Password (String.concat ":" password);
pw_locked = false }
> @@ -71,12 +71,6 @@ and parse_selector_list orig_arg = function
>    | _ ->
>      error (f_"invalid password selector '%s'; see the man
page") orig_arg
>  
> -and read_password_from_file filename > -  let chan = open_in filename
in
> -  let password = input_line chan in
> -  close_in chan;
> -  password
> -
>  (* Permissible characters in a salt. *)
>  let chars =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789./"
>  
> diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
> index 083c5d5..f9e8996 100644
> --- a/mllib/common_utils.ml
> +++ b/mllib/common_utils.ml
> @@ -745,3 +745,9 @@ let last_part_of str sep >      let i =
String.rindex str sep in
>      Some (String.sub str (i+1) (String.length str - (i+1)))
>    with Not_found -> None
> +
> +let read_first_line_from_file filename > +  let chan = open_in filename
in
> +  let line = input_line chan in
> +  close_in chan;
> +  line
> diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
> index 550f37f..16834f7 100644
> --- a/mllib/common_utils.mli
> +++ b/mllib/common_utils.mli
> @@ -181,3 +181,7 @@ val guest_arch_compatible : string -> bool
>  
>  val last_part_of : string -> char -> string option
>  (** Return the last part of a string, after the specified separator. *)
> +
> +val read_first_line_from_file : string -> string
> +(** Read only the first line (i.e. until the first newline character)
> +    of a file. *)
> diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
> index 705051f..eaf57dc 100644
> --- a/v2v/cmdline.ml
> +++ b/v2v/cmdline.ml
> @@ -259,7 +259,7 @@ read the man page virt-v2v(1).
>      match password_file with
>      | None -> None
>      | Some filename ->
> -      let password = read_whole_file filename in
> +      let password = read_first_line_from_file filename in
>        Some password in
>  
>    (* Parsing of the argument(s) depends on the input mode. *)
> -- 
> 2.1.0
ACK.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-p2v converts physical machines to virtual machines.  Boot with a
live CD or over the network (PXE) and turn machines into KVM guests.
http://libguestfs.org/virt-v2v

On Fri, Jul 17, 2015 at 03:31:19PM +0200, Pino Toscano
wrote:
> Add simple operations for RHEL guests using subscription-manager, so it
> is possible to e.g. install software on them.
> ---
>  builder/Makefile.am                |  1 +
>  builder/virt-builder.pod           | 47 ++++++++++++++++++
>  customize/Makefile.am              |  2 +
>  customize/customize_run.ml         | 34 +++++++++++++
>  customize/subscription_manager.ml  | 53 ++++++++++++++++++++
>  customize/subscription_manager.mli | 34 +++++++++++++
>  generator/customize.ml             | 99
++++++++++++++++++++++++++++++++++++--
>  po/POTFILES-ml                     |  1 +
>  sysprep/Makefile.am                |  1 +
>  9 files changed, 269 insertions(+), 3 deletions(-)
>  create mode 100644 customize/subscription_manager.ml
>  create mode 100644 customize/subscription_manager.mli
> 
> diff --git a/builder/Makefile.am b/builder/Makefile.am
> index d69e25f..2413217 100644
> --- a/builder/Makefile.am
> +++ b/builder/Makefile.am
> @@ -125,6 +125,7 @@ BOBJECTS = \
>  	$(top_builddir)/customize/crypt.cmo \
>  	$(top_builddir)/customize/password.cmo \
>  	$(top_builddir)/customize/ssh_key.cmo \
> +	$(top_builddir)/customize/subscription_manager.cmo \
>  	$(top_builddir)/customize/customize_cmdline.cmo \
>  	$(top_builddir)/customize/customize_run.cmo \
>  	$(SOURCES_ML:.ml=.cmo)
> diff --git a/builder/virt-builder.pod b/builder/virt-builder.pod
> index 41cda1a..b4a341f 100644
> --- a/builder/virt-builder.pod
> +++ b/builder/virt-builder.pod
> @@ -844,6 +844,53 @@ F<C:\Program Files\Red Hat\Firstboot\log.txt>.
>  
>  =back
>  
> +=head2 SUBSCRIPTION-MANAGER
> +
> +It is possible to automate the registration and attaching of the
> +system using C<subscription-manager>.  This is typical on
> +Red Hat Enterprise Linux guests.  There are few options which ease
> +this process, avoid executing commands manually and exposing
> +passwords on command line.
> +
> +I<--sm-register> starts the registration process, and requires
> +I<--sm-credentials> to be specified; the format of the
C<SELECTOR>
> +of I<--sm-credentials> is one of the following formats:
> +
> +=over 4
> +
> +=item B<--sm-credentials> USER:file:FILENAME
> +
> +Read the password for the specified C<USER> from F<FILENAME>.
> +
> +=item B<--sm-credentials> USER:password:PASSWORD
> +
> +Use the literal string C<PASSWORD> for the specified C<USER>.
> +
> +=back
> +
> +I<--sm-attach> attaches the system to subscriptions; the format
> +of its C<SELECTOR> is one of the following:
> +
> +=over 4
> +
> +=item B<--sm-attach> auto
> +
> +C<subscription-manager> attaches to the best-fitting subscriptions
> +for the system.
> +
> +=item B<--sm-attach> file:FILENAME
> +
> +Read the pool ID from F<FILENAME>.
> +
> +=item B<--sm-attach> pool:POOL
> +
> +Use the literal string C<POOL> as pool ID.
> +
> +=back
> +
> +I<--sm-remove> removes all the subscriptions from the guest, while
> +I<--sm-unregister> completely unregister the system.
> +
>  =head2 INSTALLATION PROCESS
>  
>  When you invoke virt-builder, installation proceeds as follows:
> diff --git a/customize/Makefile.am b/customize/Makefile.am
> index 8f0a2d8..1974b80 100644
> --- a/customize/Makefile.am
> +++ b/customize/Makefile.am
> @@ -43,6 +43,7 @@ SOURCES_MLI = \
>  	perl_edit.mli \
>  	random_seed.mli \
>  	ssh_key.mli \
> +	subscription_manager.mli \
>  	timezone.mli \
>  	urandom.mli
>  
> @@ -57,6 +58,7 @@ SOURCES_ML = \
>  	perl_edit.ml \
>  	random_seed.ml \
>  	ssh_key.ml \
> +	subscription_manager.ml \
>  	timezone.ml \
>  	customize_cmdline.ml \
>  	customize_run.ml \
> diff --git a/customize/customize_run.ml b/customize/customize_run.ml
> index d9547a0..bce0aca 100644
> --- a/customize/customize_run.ml
> +++ b/customize/customize_run.ml
> @@ -249,6 +249,40 @@ exec >>%s 2>&1
>        message (f_"Scrubbing: %s") path;
>        g#scrub_file path
>  
> +    | `SMAttach pool ->
> +      (match pool with
> +      | Subscription_manager.PoolAuto ->
> +        message (f_"Attaching to compatible subscriptions");
> +        let cmd = "subscription-manager attach --auto" in
> +        do_run ~display:cmd cmd
> +      | Subscription_manager.PoolId id ->
> +        message (f_"Attaching to the pool %s") id;
> +        let cmd = sprintf "subscription-manager attach
--pool=%s" (quote id) in
> +        do_run ~display:cmd cmd
> +      )
> +
> +    | `SMRegister ->
> +      message (f_"Registering with subscription-manager");
> +      let creds > +        match ops.flags.sm_credentials with
> +        | None ->
> +          error (f_"subscription-manager credentials required for
--sm-register")
> +        | Some c -> c in
> +      let cmd = sprintf "subscription-manager register --username=%s
--password=%s"
> +                  (quote creds.Subscription_manager.sm_username)
> +                  (quote creds.Subscription_manager.sm_password) in
> +      do_run ~display:"subscription-manager register" cmd
> +
> +    | `SMRemove ->
> +      message (f_"Removing all the subscriptions");
> +      let cmd = "subscription-manager remove --all" in
> +      do_run ~display:cmd cmd
> +
> +    | `SMUnregister ->
> +      message (f_"Unregistering with subscription-manager");
> +      let cmd = "subscription-manager unregister" in
> +      do_run ~display:cmd cmd
> +
>      | `SSHInject (user, selector) ->
>        (match g#inspect_get_type root with
>        | "linux" | "freebsd" | "netbsd" |
"openbsd" | "hurd" ->
> diff --git a/customize/subscription_manager.ml
b/customize/subscription_manager.ml
> new file mode 100644
> index 0000000..c9828d6
> --- /dev/null
> +++ b/customize/subscription_manager.ml
> @@ -0,0 +1,53 @@
> +(* virt-customize
> + * Copyright (C) 2015 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
> +
> +type sm_credentials = {
> +  sm_username : string;
> +  sm_password : string;
> +}
> +
> +type sm_pool > +| PoolAuto
> +| PoolId of string
> +
> +let rec parse_credentials_selector arg > + 
parse_credentials_selector_list arg (string_nsplit ":" arg)
> +
> +and parse_credentials_selector_list orig_arg = function
> +  | [ username; "password"; password ] ->
> +    { sm_username = username; sm_password = password }
> +  | [ username; "file"; filename ] ->
> +    { sm_username = username; sm_password = read_first_line_from_file
filename }
> +  | _ ->
> +    error (f_"invalid sm-credentials selector '%s'; see the
man page") orig_arg
> +
> +let rec parse_pool_selector arg > +  parse_pool_selector_list arg
(string_nsplit ":" arg)
> +
> +and parse_pool_selector_list orig_arg = function
> +  | [ "auto" ] ->
> +    PoolAuto
> +  | [ "pool"; pool ] ->
> +    PoolId pool
> +  | [ "file"; filename ] ->
> +    PoolId (read_first_line_from_file filename)
> +  | _ ->
> +    error (f_"invalid sm-attach selector '%s'; see the man
page") orig_arg
> diff --git a/customize/subscription_manager.mli
b/customize/subscription_manager.mli
> new file mode 100644
> index 0000000..bb6b920
> --- /dev/null
> +++ b/customize/subscription_manager.mli
> @@ -0,0 +1,34 @@
> +(* virt-customize
> + * Copyright (C) 2015 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.
> + *)
> +
> +type sm_credentials = {
> +  sm_username : string;
> +  sm_password : string;
> +}
> +
> +type sm_pool > +| PoolAuto                           (** Automatic
entitlements. *)
> +| PoolId of string                   (** Specific pool. *)
> +
> +val parse_credentials_selector : string -> sm_credentials
> +(** Parse the selector field in --sm-credentials.  Exits if the format
> +    is not valid. *)
> +
> +val parse_pool_selector : string -> sm_pool
> +(** Parse the selector field in --sm-attach.  Exits if the format
> +    is not valid. *)
> diff --git a/generator/customize.ml b/generator/customize.ml
> index f57aba6..2196e9e 100644
> --- a/generator/customize.ml
> +++ b/generator/customize.ml
> @@ -44,6 +44,7 @@ and op_type >  | UserPasswordSelector of string       
(* user:selector *)
>  | SSHKeySelector of string              (* user:selector *)
>  | StringFn of (string * string)         (* string, function name *)
> +| SMPoolSelector of string              (* pool selector *)
>  
>  let ops = [
>    { op_name = "chmod";
> @@ -327,6 +328,44 @@ It cannot delete directories, only regular files.
>  =back";
>    };
>  
> +  { op_name = "sm-attach";
> +    op_type = SMPoolSelector "SELECTOR";
> +    op_discrim = "`SMAttach";
> +    op_shortdesc = "Attach to a subscription-manager pool";
> +    op_pod_longdesc = "\
> +Attach to a pool using C<subscription-manager>.
> +
> +See L<virt-builder(1)/SUBSCRIPTION-MANAGER> for the format of
> +the C<SELECTOR> field.";
> +  };
> +
> +  { op_name = "sm-register";
> +    op_type = Unit;
> +    op_discrim = "`SMRegister";
> +    op_shortdesc = "Register using subscription-manager";
> +    op_pod_longdesc = "\
> +Register the guest using C<subscription-manager>.
> +
> +This requires credentials being set using
I<--sm-credentials>.";
> +  };
> +
> +  { op_name = "sm-remove";
> +    op_type = Unit;
> +    op_discrim = "`SMRemove";
> +    op_shortdesc = "Remove all the subscriptions";
> +    op_pod_longdesc = "\
> +Remove all the subscriptions from the guest using
> +C<subscription-manager>.";
> +  };
> +
> +  { op_name = "sm-unregister";
> +    op_type = Unit;
> +    op_discrim = "`SMUnregister";
> +    op_shortdesc = "Unregister using subscription-manager";
> +    op_pod_longdesc = "\
> +Unregister the guest using C<subscription-manager>.";
> +  };
> +
>    { op_name = "ssh-inject";
>      op_type = SSHKeySelector "USER[:SELECTOR]";
>      op_discrim = "`SSHInject";
> @@ -428,6 +467,7 @@ type flag = {
>  and flag_type >  | FlagBool of bool                  (* boolean is the
default value *)
>  | FlagPasswordCrypto of string
> +| FlagSMCredentials of string
>  
>  let flags = [
>    { flag_name = "no-logfile";
> @@ -477,6 +517,18 @@ Relabel files in the guest so that they have the
correct SELinux label.
>  
>  You should only use this option for guests which support SELinux.";
>    };
> +
> +  { flag_name = "sm-credentials";
> +    flag_type = FlagSMCredentials "SELECTOR";
> +    flag_ml_var = "sm_credentials";
> +    flag_shortdesc = "credentials for subscription-manager";
> +    flag_pod_longdesc = "\
> +Set the credentials for C<subscription-manager>.
> +
> +See L<virt-builder(1)/SUBSCRIPTION-MANAGER> for the format of
> +the C<SELECTOR> field.";
> +  };
> +
>  ]
>  
>  let rec generate_customize_cmdline_mli () > @@ -532,6 +584,8 @@ let rec
argspec () >        pr "  let %s = ref %b in\n" var default
>      | { flag_type = FlagPasswordCrypto _; flag_ml_var = var } ->
>        pr "  let %s = ref None in\n" var
> +    | { flag_type = FlagSMCredentials _; flag_ml_var = var } ->
> +      pr "  let %s = ref None in\n" var
>    ) flags;
>    pr "\
>  
> @@ -672,6 +726,18 @@ let rec argspec () >        pr "     
s_\"%s\" ^ \" \" ^ s_\"%s\"\n" v shortdesc;
>        pr "    ),\n";
>        pr "    Some %S, %S;\n" v longdesc
> +    | { op_type = SMPoolSelector v; op_name = name; op_discrim = discrim;
> +        op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
> +      pr "    (\n";
> +      pr "      \"--%s\",\n" name;
> +      pr "      Arg.String (\n";
> +      pr "        fun s ->\n";
> +      pr "          let sel =
Subscription_manager.parse_pool_selector s in\n";
> +      pr "          ops := %s sel :: !ops\n" discrim;
> +      pr "      ),\n";
> +      pr "      s_\"%s\" ^ \" \" ^
s_\"%s\"\n" v shortdesc;
> +      pr "    ),\n";
> +      pr "    Some %S, %S;\n" v longdesc
>    ) ops;
>  
>    List.iter (
> @@ -699,6 +765,19 @@ let rec argspec () >        pr "     
\"%s\" ^ \" \" ^ s_\"%s\"\n" v shortdesc;
>        pr "    ),\n";
>        pr "    Some %S, %S;\n" v longdesc
> +    | { flag_type = FlagSMCredentials v; flag_ml_var = var;
> +        flag_name = name; flag_shortdesc = shortdesc;
> +        flag_pod_longdesc = longdesc } ->
> +      pr "    (\n";
> +      pr "      \"--%s\",\n" name;
> +      pr "      Arg.String (\n";
> +      pr "        fun s ->\n";
> +      pr "          %s := Some
(Subscription_manager.parse_credentials_selector s)\n"
> +        var;
> +      pr "      ),\n";
> +      pr "      \"%s\" ^ \" \" ^
s_\"%s\"\n" v shortdesc;
> +      pr "    ),\n";
> +      pr "    Some %S, %S;\n" v longdesc
>    ) flags;
>  
>    pr "  ]
> @@ -717,7 +796,8 @@ let rec argspec () >      | { op_type = TargetLinks
_; }
>      | { op_type = PasswordSelector _; }
>      | { op_type = UserPasswordSelector _; }
> -    | { op_type = SSHKeySelector _; } -> ()
> +    | { op_type = SSHKeySelector _; }
> +    | { op_type = SMPoolSelector _; } -> ()
>    ) ops;
>  
>  pr "    ] in
> @@ -796,6 +876,10 @@ type ops = {
>          discrim name v
>      | { op_type = StringFn (v, _); op_discrim = discrim; op_name = name }
->
>        pr "  | %s of string\n      (* --%s %s *)\n" discrim name
v
> +    | { op_type = SMPoolSelector v; op_discrim = discrim;
> +        op_name = name } ->
> +      pr "  | %s of Subscription_manager.sm_pool\n      (* --%s %s
*)\n"
> +        discrim name v
>    ) ops;
>    pr "]\n";
>  
> @@ -809,6 +893,10 @@ type ops = {
>          flag_name = name } ->
>        pr "  %s : Password.password_crypto option;\n      (* --%s %s
*)\n"
>          var name v
> +    | { flag_type = FlagSMCredentials v; flag_ml_var = var;
> +        flag_name = name } ->
> +      pr "  %s : Subscription_manager.sm_credentials option;\n     
(* --%s %s *)\n"
> +        var name v
>    ) flags;
>    pr "}\n"
>  
> @@ -822,7 +910,7 @@ let generate_customize_synopsis_pod () >          n,
sprintf "[--%s]" n
>        | { op_type = String v | StringPair v | StringList v | TargetLinks v
>              | PasswordSelector v | UserPasswordSelector v | SSHKeySelector
v
> -            | StringFn (v, _);
> +            | StringFn (v, _) | SMPoolSelector v;
>            op_name = n } ->
>          n, sprintf "[--%s %s]" n v
>      ) ops @
> @@ -832,6 +920,8 @@ let generate_customize_synopsis_pod () >           
n, sprintf "[--%s]" n
>          | { flag_type = FlagPasswordCrypto v; flag_name = n } ->
>            n, sprintf "[--%s %s]" n v
> +        | { flag_type = FlagSMCredentials v; flag_name = n } ->
> +          n, sprintf "[--%s %s]" n v
>        ) flags in
>  
>    (* Print the option names in the synopsis, line-wrapped. *)
> @@ -863,7 +953,7 @@ let generate_customize_options_pod () >          n,
sprintf "B<--%s>" n, ld
>        | { op_type = String v | StringPair v | StringList v | TargetLinks v
>              | PasswordSelector v | UserPasswordSelector v | SSHKeySelector
v
> -            | StringFn (v, _);
> +            | StringFn (v, _) | SMPoolSelector v;
>            op_name = n; op_pod_longdesc = ld } ->
>          n, sprintf "B<--%s> %s" n v, ld
>      ) ops @
> @@ -874,6 +964,9 @@ let generate_customize_options_pod () >          | {
flag_type = FlagPasswordCrypto v;
>              flag_name = n; flag_pod_longdesc = ld } ->
>            n, sprintf "B<--%s> %s" n v, ld
> +        | { flag_type = FlagSMCredentials v;
> +            flag_name = n; flag_pod_longdesc = ld } ->
> +          n, sprintf "B<--%s> %s" n v, ld
>        ) flags in
>    let cmp (arg1, _, _) (arg2, _, _) >      compare (String.lowercase
arg1) (String.lowercase arg2)
> diff --git a/po/POTFILES-ml b/po/POTFILES-ml
> index cddd02f..bfed0cf 100644
> --- a/po/POTFILES-ml
> +++ b/po/POTFILES-ml
> @@ -23,6 +23,7 @@ customize/password.ml
>  customize/perl_edit.ml
>  customize/random_seed.ml
>  customize/ssh_key.ml
> +customize/subscription_manager.ml
>  customize/timezone.ml
>  customize/urandom.ml
>  dib/cmdline.ml
> diff --git a/sysprep/Makefile.am b/sysprep/Makefile.am
> index c1d1245..9424c40 100644
> --- a/sysprep/Makefile.am
> +++ b/sysprep/Makefile.am
> @@ -119,6 +119,7 @@ BOBJECTS = \
>  	$(top_builddir)/customize/firstboot.cmo \
>  	$(top_builddir)/customize/perl_edit.cmo \
>  	$(top_builddir)/customize/ssh_key.cmo \
> +	$(top_builddir)/customize/subscription_manager.cmo \
>  	$(top_builddir)/customize/customize_cmdline.cmo \
>  	$(top_builddir)/customize/customize_run.cmo \
>  	$(SOURCES_ML:.ml=.cmo)
ACK.

Don't know if you want to hold this to 1.31, or push it now.  It's up
to you really, since command line options aren't quite as rigid as
API.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-df lists disk usage of guests without needing to install any
software inside the virtual machine.  Supports Linux and Windows.
http://people.redhat.com/~rjones/virt-df/