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/