[Pkg-libvirt-commits] [libguestfs] 48/61: customize: Add Customize_utils module and use common error/warning/info functions.
Hilko Bengen
bengen at moszumanska.debian.org
Fri Oct 31 19:09:40 UTC 2014
This is an automated email from the git hooks/post-receive script.
bengen pushed a commit to annotated tag debian/1%1.28.2-1
in repository libguestfs.
commit 9924d5622c6efd8a7f0eb6968890fcbec4af243f
Author: Richard W.M. Jones <rjones at redhat.com>
Date: Sat Oct 25 11:36:15 2014 +0100
customize: Add Customize_utils module and use common error/warning/info functions.
Add a Customize_utils module. This contains common error/warning/info
functions, and also quote = Filename.quote.
Examine every existing call to printf/eprintf and change where
necessary so that:
- error is used instead of eprintf + exit 1
- warning no longer needs ~prog argument (it is added by Utils module)
- any verbose output should go to stdout, not stderr
- info is used to print general informational messages
Also, don't pass ~prog parameter around. Instead we just get it from
the executable name.
(cherry picked from commit f7664b7f76bc7e997e1d714a894ea6e696b168e8)
---
builder/Makefile.am | 1 +
builder/builder.ml | 2 +-
builder/cmdline.ml | 5 +-
customize/Makefile.am | 2 +
customize/customize_main.ml | 34 ++++++--------
customize/customize_run.ml | 63 ++++++++++----------------
customize/customize_run.mli | 2 +-
customize/{timezone.mli => customize_utils.ml} | 20 +++++---
customize/firstboot.ml | 21 +++++----
customize/firstboot.mli | 4 +-
customize/password.ml | 32 ++++++-------
customize/password.mli | 6 +--
customize/timezone.ml | 6 ++-
customize/timezone.mli | 4 +-
generator/customize.ml | 22 ++++-----
po/POTFILES-ml | 1 +
sysprep/Makefile.am | 1 +
sysprep/sysprep_operation_customize.ml | 4 +-
v2v/Makefile.am | 1 +
v2v/convert_windows.ml | 2 +-
20 files changed, 111 insertions(+), 122 deletions(-)
diff --git a/builder/Makefile.am b/builder/Makefile.am
index b53e183..5702d75 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -100,6 +100,7 @@ deps = \
$(top_builddir)/mllib/uRI.cmx \
$(top_builddir)/mllib/mkdtemp-c.o \
$(top_builddir)/mllib/mkdtemp.cmx \
+ $(top_builddir)/customize/customize_utils.cmx \
$(top_builddir)/customize/urandom.cmx \
$(top_builddir)/customize/random_seed.cmx \
$(top_builddir)/customize/hostname.cmx \
diff --git a/builder/builder.ml b/builder/builder.ml
index fdf9334..d7d8fb2 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -654,7 +654,7 @@ let main () =
error (f_"no guest operating systems or multiboot OS found in this disk image\nThis is a failure of the source repository. Use -v for more information.")
in
- Customize_run.run ~prog ~verbose ~quiet g root ops;
+ Customize_run.run ~verbose ~quiet g root ops;
(* Collect some stats about the final output file.
* Notes:
diff --git a/builder/cmdline.ml b/builder/cmdline.ml
index 14706a9..c0584f7 100644
--- a/builder/cmdline.ml
+++ b/builder/cmdline.ml
@@ -157,8 +157,7 @@ let parse_cmdline () =
"--version", Arg.Unit display_version, " " ^ s_"Display version and exit";
"-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
- let customize_argspec, get_customize_ops =
- Customize_cmdline.argspec ~prog () in
+ let customize_argspec, get_customize_ops = Customize_cmdline.argspec () in
let customize_argspec =
List.map (fun (spec, _, _) -> spec) customize_argspec in
let argspec = argspec @ customize_argspec in
@@ -324,7 +323,7 @@ read the man page virt-builder(1).
) ops.ops in
if has_set_root_password then ops
else (
- let pw = Password.parse_selector ~prog "random" in
+ let pw = Password.parse_selector "random" in
{ ops with ops = ops.ops @ [ `RootPassword pw ] }
) in
diff --git a/customize/Makefile.am b/customize/Makefile.am
index 39759dc..60e2091 100644
--- a/customize/Makefile.am
+++ b/customize/Makefile.am
@@ -42,6 +42,7 @@ SOURCES = \
customize_cmdline.mli \
customize_run.ml \
customize_run.mli \
+ customize_utils.ml \
firstboot.ml \
firstboot.mli \
hostname.ml \
@@ -83,6 +84,7 @@ endif
# This list must be in dependency order.
ocaml_modules = \
+ customize_utils \
crypt \
firstboot \
hostname \
diff --git a/customize/customize_main.ml b/customize/customize_main.ml
index 2c8b2ef..2830e8d 100644
--- a/customize/customize_main.ml
+++ b/customize/customize_main.ml
@@ -19,6 +19,7 @@
open Common_gettext.Gettext
open Common_utils
+open Customize_utils
open Customize_cmdline
open Printf
@@ -27,8 +28,6 @@ module G = Guestfs
let () = Random.self_init ()
-let prog = Filename.basename Sys.executable_name
-
let main () =
let attach = ref [] in
let attach_format = ref None in
@@ -67,16 +66,14 @@ let main () =
let uri =
try URI.parse_uri arg
with Invalid_argument "URI.parse_uri" ->
- eprintf "Error parsing URI '%s'. Look for error messages printed above.\n" arg;
- exit 1 in
+ error (f_"error parsing URI '%s'. Look for error messages printed above.")
+ arg in
let format = match !format with "auto" -> None | fmt -> Some fmt in
files := (uri, format) :: !files;
format_consumed := true
and set_domain dom =
- if !domain <> None then (
- eprintf (f_"%s: --domain option can only be given once\n") prog;
- exit 1
- );
+ if !domain <> None then
+ error (f_"--domain option can only be given once");
domain := Some dom
in
@@ -110,7 +107,7 @@ let main () =
"-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
let customize_argspec, get_customize_ops =
- Customize_cmdline.argspec ~prog () in
+ Customize_cmdline.argspec () in
let customize_argspec =
List.map (fun (spec, _, _) -> spec) customize_argspec in
let argspec = argspec @ customize_argspec in
@@ -139,10 +136,10 @@ read the man page virt-customize(1).
Arg.parse argspec anon_fun usage_msg;
if not !format_consumed then
- error ~prog (f_"--format parameter must appear before -a parameter");
+ error (f_"--format parameter must appear before -a parameter");
if not !attach_format_consumed then
- error ~prog (f_"--attach-format parameter must appear before --attach parameter");
+ error (f_"--attach-format parameter must appear before --attach parameter");
(* Check -a and -d options. *)
let files = !files in
@@ -151,9 +148,7 @@ read the man page virt-customize(1).
let add =
match files, domain with
| [], None ->
- eprintf (f_"%s: you must give either -a or -d options\n") prog;
- eprintf (f_"Read virt-customize(1) man page for further information.\n");
- exit 1
+ error (f_"you must give either -a or -d options. Read virt-customize(1) man page for further information.")
| [], Some dom ->
fun (g : Guestfs.guestfs) readonly ->
let allowuuid = true in
@@ -164,9 +159,7 @@ read the man page virt-customize(1).
?libvirturi ~allowuuid ~readonlydisk
dom)
| _, Some _ ->
- eprintf (f_"%s: you cannot give -a and -d options together\n") prog;
- eprintf (f_"Read virt-customize(1) man page for further information.\n");
- exit 1
+ error (f_"you cannot give -a and -d options together. Read virt-customize(1) man page for further information.")
| files, None ->
fun g readonly ->
List.iter (
@@ -229,8 +222,7 @@ read the man page virt-customize(1).
(* Inspection. *)
(match Array.to_list (g#inspect_os ()) with
| [] ->
- eprintf (f_"%s: no operating systems were found in the guest image\n") prog;
- exit 1
+ error (f_"no operating systems were found in the guest image")
| roots ->
List.iter (
fun root ->
@@ -243,11 +235,11 @@ read the man page virt-customize(1).
List.iter (
fun (mp, dev) ->
try g#mount dev mp;
- with Guestfs.Error msg -> eprintf (f_"%s (ignored)\n") msg
+ with Guestfs.Error msg -> warning (f_"%s (ignored)") msg
) mps;
(* Do the customization. *)
- Customize_run.run ~prog ~verbose ~quiet g root ops;
+ Customize_run.run ~verbose ~quiet g root ops;
g#umount_all ();
) roots;
diff --git a/customize/customize_run.ml b/customize/customize_run.ml
index af513f0..51b218a 100644
--- a/customize/customize_run.ml
+++ b/customize/customize_run.ml
@@ -22,12 +22,11 @@ open Printf
open Common_gettext.Gettext
open Common_utils
+open Customize_utils
open Customize_cmdline
open Password
-let quote = Filename.quote
-
-let run ~prog ~verbose ~quiet (g : Guestfs.guestfs) root (ops : ops) =
+let run ~verbose ~quiet (g : Guestfs.guestfs) root (ops : ops) =
(* Timestamped messages in ordinary, non-debug non-quiet mode. *)
let msg fs = make_message_function ~quiet fs in
@@ -50,8 +49,7 @@ let run ~prog ~verbose ~quiet (g : Guestfs.guestfs) root (ops : ops) =
*)
g#download logfile "/dev/stderr"
with exn ->
- eprintf (f_"%s: log file %s: %s (ignored)\n")
- prog logfile (Printexc.to_string exn) in
+ warning (f_"log file %s: %s (ignored)") logfile (Printexc.to_string exn) in
(* Useful wrapper for scripts. *)
let do_run ~display cmd =
@@ -75,13 +73,12 @@ exec >>%s 2>&1
%s
" (quote logfile) env_vars cmd in
- if verbose then eprintf "running command:\n%s\n%!" cmd;
+ if verbose then printf "running command:\n%s\n%!" cmd;
try ignore (g#sh cmd)
with
Guestfs.Error msg ->
debug_logfile ();
- eprintf (f_"%s: %s: command exited with an error\n") prog display;
- exit 1
+ error (f_"%s: command exited with an error") display
in
(* http://distrowatch.com/dwres.php?resource=package-management *)
@@ -108,13 +105,9 @@ exec >>%s 2>&1
(* XXX Should we use -n option? *)
sprintf "zypper in %s" quoted_args
| "unknown" ->
- eprintf (f_"%s: --install is not supported for this guest operating system\n")
- prog;
- exit 1
+ error (f_"--install is not supported for this guest operating system")
| pm ->
- eprintf (f_"%s: sorry, don't know how to use --install with the '%s' package manager\n")
- prog pm;
- exit 1
+ error (f_"sorry, don't know how to use --install with the '%s' package manager") pm
and guest_update_command () =
match g#inspect_get_package_management root with
@@ -137,19 +130,15 @@ exec >>%s 2>&1
| "zypper" ->
sprintf "zypper update"
| "unknown" ->
- eprintf (f_"%s: --update is not supported for this guest operating system\n")
- prog;
- exit 1
+ error (f_"--update is not supported for this guest operating system")
| pm ->
- eprintf (f_"%s: sorry, don't know how to use --update with the '%s' package manager\n")
- prog pm;
- exit 1
+ error (f_"sorry, don't know how to use --update with the '%s' package manager") pm
in
(* Set the random seed. *)
msg (f_"Setting a random seed");
if not (Random_seed.set_random_seed g root) then
- warning ~prog (f_"random seed could not be set for this type of guest");
+ warning (f_"random seed could not be set for this type of guest");
(* Used for numbering firstboot commands. *)
let i = ref 0 in
@@ -157,11 +146,8 @@ exec >>%s 2>&1
(* Store the passwords and set them all at the end. *)
let passwords = Hashtbl.create 13 in
let set_password user pw =
- if Hashtbl.mem passwords user then (
- eprintf (f_"%s: error: multiple --root-password/--password options set the password for user '%s' twice.\n")
- prog user;
- exit 1
- );
+ if Hashtbl.mem passwords user then
+ error (f_"multiple --root-password/--password options set the password for user '%s' twice") user;
Hashtbl.replace passwords user pw
in
@@ -187,36 +173,33 @@ exec >>%s 2>&1
| `Edit (path, expr) ->
msg (f_"Editing: %s") path;
- if not (g#is_file path) then (
- eprintf (f_"%s: error: %s is not a regular file in the guest\n")
- prog path;
- exit 1
- );
+ if not (g#is_file path) then
+ error (f_"%s is not a regular file in the guest") path;
Perl_edit.edit_file ~verbose g#ocaml_handle path expr
| `FirstbootCommand cmd ->
incr i;
msg (f_"Installing firstboot command: [%d] %s") !i cmd;
- Firstboot.add_firstboot_script ~prog g root !i cmd
+ Firstboot.add_firstboot_script g root !i cmd
| `FirstbootPackages pkgs ->
incr i;
msg (f_"Installing firstboot packages: [%d] %s") !i
(String.concat " " pkgs);
let cmd = guest_install_command pkgs in
- Firstboot.add_firstboot_script ~prog g root !i cmd
+ Firstboot.add_firstboot_script g root !i cmd
| `FirstbootScript script ->
incr i;
msg (f_"Installing firstboot script: [%d] %s") !i script;
let cmd = read_whole_file script in
- Firstboot.add_firstboot_script ~prog g root !i cmd
+ Firstboot.add_firstboot_script g root !i cmd
| `Hostname hostname ->
msg (f_"Setting the hostname: %s") hostname;
if not (Hostname.set_hostname g root hostname) then
- warning ~prog (f_"hostname could not be set for this type of guest")
+ warning (f_"hostname could not be set for this type of guest")
| `InstallPackages pkgs ->
msg (f_"Installing packages: %s") (String.concat " " pkgs);
@@ -251,8 +234,8 @@ exec >>%s 2>&1
| `Timezone tz ->
msg (f_"Setting the timezone: %s") tz;
- if not (Timezone.set_timezone ~prog g root tz) then
- warning ~prog (f_"timezone could not be set for this type of guest")
+ if not (Timezone.set_timezone g root tz) then
+ warning (f_"timezone could not be set for this type of guest")
| `Update ->
msg (f_"Updating core packages");
@@ -289,10 +272,10 @@ exec >>%s 2>&1
| "linux" ->
msg (f_"Setting passwords");
let password_crypto = ops.flags.password_crypto in
- set_linux_passwords ~prog ?password_crypto g root passwords
+ set_linux_passwords ?password_crypto g root passwords
| _ ->
- warning ~prog (f_"passwords could not be set for this type of guest")
+ warning (f_"passwords could not be set for this type of guest")
);
if ops.flags.selinux_relabel then (
@@ -331,6 +314,6 @@ exec >>%s 2>&1
(try ignore (g#debug "sh" [| "fuser"; "-k"; "/sysroot" |])
with exn ->
if verbose then
- eprintf (f_"%s: %s (ignored)\n") prog (Printexc.to_string exn)
+ printf (f_"%s: %s (ignored)\n") prog (Printexc.to_string exn)
);
g#ping_daemon () (* tiny delay after kill *)
diff --git a/customize/customize_run.mli b/customize/customize_run.mli
index 0b375eb..6289813 100644
--- a/customize/customize_run.mli
+++ b/customize/customize_run.mli
@@ -23,4 +23,4 @@
* filesystems must be mounted up.
*)
-val run : prog:string -> verbose:bool -> quiet:bool -> Guestfs.guestfs -> string -> Customize_cmdline.ops -> unit
+val run : verbose:bool -> quiet:bool -> Guestfs.guestfs -> string -> Customize_cmdline.ops -> unit
diff --git a/customize/timezone.mli b/customize/customize_utils.ml
similarity index 67%
copy from customize/timezone.mli
copy to customize/customize_utils.ml
index ad0d4b2..eeeb18c 100644
--- a/customize/timezone.mli
+++ b/customize/customize_utils.ml
@@ -1,5 +1,5 @@
-(* Set timezone in virt-sysprep and virt-builder.
- * Copyright (C) 2014 Red Hat Inc.
+(* virt-customize
+ * Copyright (C) 2013-2014 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
@@ -16,7 +16,15 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-val set_timezone : prog:string -> Guestfs.guestfs -> string -> string -> bool
-(** [set_timezone ~prog g root "Europe/London"] sets the default timezone
- of the guest. Returns [true] if it was able to set the
- timezone or [false] if not. *)
+(* Utilities/common functions used in virt-customize only. *)
+
+open Printf
+
+open Common_utils
+
+let prog = Filename.basename Sys.executable_name
+let error ?exit_code fs = error ~prog ?exit_code fs
+let warning fs = warning ~prog fs
+let info fs = info ~prog fs
+
+let quote = Filename.quote
diff --git a/customize/firstboot.ml b/customize/firstboot.ml
index 142eab4..67b9479 100644
--- a/customize/firstboot.ml
+++ b/customize/firstboot.ml
@@ -21,6 +21,7 @@ open Printf
open Common_utils
open Common_gettext.Gettext
+open Customize_utils
open Regedit
(* For Linux guests. *)
@@ -81,7 +82,7 @@ StandardError=inherit
WantedBy=default.target
" firstboot_dir
- let rec install_service ~prog (g : Guestfs.guestfs) distro =
+ let rec install_service (g : Guestfs.guestfs) distro =
g#mkdir_p firstboot_dir;
g#mkdir_p (sprintf "%s/scripts" firstboot_dir);
g#write (sprintf "%s/firstboot.sh" firstboot_dir) firstboot_sh;
@@ -97,7 +98,7 @@ WantedBy=default.target
if g#is_dir "/etc/systemd/system" then
install_systemd_service g;
if g#is_dir "/etc/rc.d" || g#is_dir "/etc/init.d" then
- install_sysvinit_service ~prog g distro
+ install_sysvinit_service g distro
(* Install the systemd firstboot service, if not installed already. *)
and install_systemd_service g =
@@ -106,7 +107,7 @@ WantedBy=default.target
g#ln_sf (sprintf "%s/firstboot.service" firstboot_dir)
"/etc/systemd/system/default.target.wants"
- and install_sysvinit_service ~prog g = function
+ and install_sysvinit_service g = function
| "fedora"|"rhel"|"centos"|"scientificlinux"|"redhat-based" ->
install_sysvinit_redhat g
| "opensuse"|"sles"|"suse-based" ->
@@ -114,7 +115,7 @@ WantedBy=default.target
| "debian"|"ubuntu" ->
install_sysvinit_debian g
| distro ->
- error ~prog (f_"guest type %s is not supported") distro
+ error (f_"guest type %s is not supported") distro
and install_sysvinit_redhat g =
g#mkdir_p "/etc/rc.d/rc2.d";
@@ -158,7 +159,7 @@ end
module Windows = struct
- let rec install_service ~prog (g : Guestfs.guestfs) root =
+ let rec install_service (g : Guestfs.guestfs) root =
(* Get the data directory. *)
let virt_tools_data_dir =
try Sys.getenv "VIRT_TOOLS_DATA_DIR"
@@ -174,7 +175,7 @@ module Windows = struct
close_in chan
with
Sys_error msg ->
- error ~prog (f_"'%s' is missing. This file is required in order to install Windows firstboot scripts. You can get it by building rhsrvany (https://github.com/rwmjones/rhsrvany). Original error: %s")
+ error (f_"'%s' is missing. This file is required in order to install Windows firstboot scripts. You can get it by building rhsrvany (https://github.com/rwmjones/rhsrvany). Original error: %s")
rhsrvany_exe msg
);
@@ -261,12 +262,12 @@ module Windows = struct
end
-let add_firstboot_script ~prog (g : Guestfs.guestfs) root i content =
+let add_firstboot_script (g : Guestfs.guestfs) root i content =
let typ = g#inspect_get_type root in
let distro = g#inspect_get_distro root in
match typ, distro with
| "linux", _ ->
- Linux.install_service ~prog g distro;
+ Linux.install_service g distro;
let t = Int64.of_float (Unix.time ()) in
let r = string_random8 () in
let filename = sprintf "%s/scripts/%04d-%Ld-%s" Linux.firstboot_dir i t r in
@@ -274,11 +275,11 @@ let add_firstboot_script ~prog (g : Guestfs.guestfs) root i content =
g#chmod 0o755 filename
| "windows", _ ->
- let firstboot_dir = Windows.install_service ~prog g root in
+ let firstboot_dir = Windows.install_service g root in
let t = Int64.of_float (Unix.time ()) in
let r = string_random8 () in
let filename = sprintf "%s/scripts/%04d-%Ld-%s.bat" firstboot_dir i t r in
g#write filename content
| _ ->
- error ~prog (f_"guest type %s/%s is not supported") typ distro
+ error (f_"guest type %s/%s is not supported") typ distro
diff --git a/customize/firstboot.mli b/customize/firstboot.mli
index 2aa8eff..79172de 100644
--- a/customize/firstboot.mli
+++ b/customize/firstboot.mli
@@ -16,8 +16,8 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-val add_firstboot_script : prog:string -> Guestfs.guestfs -> string -> int -> string -> unit
- (** [add_firstboot_script ~prog g root idx content] adds a firstboot
+val add_firstboot_script : Guestfs.guestfs -> string -> int -> string -> unit
+ (** [add_firstboot_script g root idx content] adds a firstboot
script called [shortname] containing [content].
NB. [content] is the contents of the script, {b not} a filename.
diff --git a/customize/password.ml b/customize/password.ml
index 2bbfbbc..0ac627a 100644
--- a/customize/password.ml
+++ b/customize/password.ml
@@ -18,6 +18,9 @@
open Common_gettext.Gettext
open Common_utils
+
+open Customize_utils
+
open Printf
type password_crypto = [`MD5 | `SHA256 | `SHA512 ]
@@ -40,23 +43,21 @@ let make_random_password =
let chars = "ABCDEFGHIJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz0123456789" in
fun () -> Urandom.urandom_uniform 16 chars
-let password_crypto_of_string ~prog = function
+let password_crypto_of_string = function
| "md5" -> `MD5
| "sha256" -> `SHA256
| "sha512" -> `SHA512
| arg ->
- eprintf (f_"%s: password-crypto: unknown algorithm %s, use \"md5\", \"sha256\" or \"sha512\".\n")
- prog arg;
- exit 1
+ error (f_"password-crypto: unknown algorithm %s, use \"md5\", \"sha256\" or \"sha512\"") arg
-let rec parse_selector ~prog arg =
- parse_selector_list ~prog arg (string_nsplit ":" arg)
+let rec parse_selector arg =
+ parse_selector_list arg (string_nsplit ":" arg)
-and parse_selector_list ~prog orig_arg = function
+and parse_selector_list orig_arg = function
| [ "lock"|"locked" ] ->
{ pw_locked = true; pw_password = Disabled_password }
| ("lock"|"locked") :: rest ->
- let pw = parse_selector_list ~prog orig_arg rest in
+ let pw = parse_selector_list orig_arg rest in
{ pw with pw_locked = true }
| [ "file"; filename ] ->
{ pw_password = Password (read_password_from_file filename);
@@ -68,9 +69,7 @@ and parse_selector_list ~prog orig_arg = function
| [ "disable"|"disabled" ] ->
{ pw_password = Disabled_password; pw_locked = false }
| _ ->
- eprintf (f_"%s: invalid password selector '%s'; see the man page.\n")
- prog orig_arg;
- exit 1
+ error (f_"invalid password selector '%s'; see the man page") orig_arg
and read_password_from_file filename =
let chan = open_in filename in
@@ -81,10 +80,10 @@ and read_password_from_file filename =
(* Permissible characters in a salt. *)
let chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789./"
-let rec set_linux_passwords ~prog ?password_crypto (g : Guestfs.guestfs) root passwords =
+let rec set_linux_passwords ?password_crypto (g : Guestfs.guestfs) root passwords =
let crypto =
match password_crypto with
- | None -> default_crypto ~prog g root
+ | None -> default_crypto g root
| Some c -> c in
(* Create a (almost) empty temporary file with the attributes of
@@ -114,8 +113,7 @@ let rec set_linux_passwords ~prog ?password_crypto (g : Guestfs.guestfs) root pa
| { pw_locked = locked;
pw_password = Random_password } ->
let password = make_random_password () in
- printf (f_"Setting random password of %s to %s\n%!")
- user password;
+ info (f_"Setting random password of %s to %s") user password;
(if locked then "!!" else "") ^ encrypt password crypto
| { pw_locked = true; pw_password = Disabled_password } -> "!!*"
| { pw_locked = false; pw_password = Disabled_password } -> "*" in
@@ -148,7 +146,7 @@ and encrypt password crypto =
* precede this date only support md5, whereas all guests after this
* date can support sha512.
*)
-and default_crypto ~prog g root =
+and default_crypto g root =
let distro = g#inspect_get_distro root in
let major = g#inspect_get_major_version root in
match distro, major with
@@ -170,6 +168,6 @@ and default_crypto ~prog g root =
| "ubuntu", _ -> `MD5
| _, _ ->
- warning ~prog (f_"password: using insecure md5 password encryption for
+ warning (f_"password: using insecure md5 password encryption for
guest of type %s version %d.\nIf this is incorrect, use --password-crypto option and file a bug.") distro major;
`MD5
diff --git a/customize/password.mli b/customize/password.mli
index c662b1b..570f048 100644
--- a/customize/password.mli
+++ b/customize/password.mli
@@ -18,7 +18,7 @@
type password_crypto = [ `MD5 | `SHA256 | `SHA512 ]
-val password_crypto_of_string : prog:string -> string -> password_crypto
+val password_crypto_of_string : string -> password_crypto
(** Parse --password-crypto parameter on command line. *)
type password_selector = {
@@ -30,13 +30,13 @@ and password =
| Random_password (** Choose a random password. *)
| Disabled_password (** [*] in the password field. *)
-val parse_selector : prog:string -> string -> password_selector
+val parse_selector : string -> password_selector
(** Parse the selector field in --password/--root-password. Note this
doesn't parse the username part. Exits if the format is not valid. *)
type password_map = (string, password_selector) Hashtbl.t
(** A map of username -> selector. *)
-val set_linux_passwords : prog:string -> ?password_crypto:password_crypto -> Guestfs.guestfs -> string -> password_map -> unit
+val set_linux_passwords : ?password_crypto:password_crypto -> Guestfs.guestfs -> string -> password_map -> unit
(** Adjust the passwords of a Linux guest according to the
password map. *)
diff --git a/customize/timezone.ml b/customize/timezone.ml
index 8b302d9..be5e41d 100644
--- a/customize/timezone.ml
+++ b/customize/timezone.ml
@@ -18,9 +18,11 @@
open Common_utils
+open Customize_utils
+
open Printf
-let set_timezone ~prog (g : Guestfs.guestfs) root timezone =
+let set_timezone (g : Guestfs.guestfs) root timezone =
let typ = g#inspect_get_type root in
match typ with
@@ -31,7 +33,7 @@ let set_timezone ~prog (g : Guestfs.guestfs) root timezone =
| "linux" ->
let target = sprintf "/usr/share/zoneinfo/%s" timezone in
if not (g#exists target) then
- error ~prog "timezone '%s' does not exist, use a location like 'Europe/London'" timezone;
+ error "timezone '%s' does not exist, use a location like 'Europe/London'" timezone;
g#ln_sf target "/etc/localtime";
true
diff --git a/customize/timezone.mli b/customize/timezone.mli
index ad0d4b2..50927db 100644
--- a/customize/timezone.mli
+++ b/customize/timezone.mli
@@ -16,7 +16,7 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-val set_timezone : prog:string -> Guestfs.guestfs -> string -> string -> bool
-(** [set_timezone ~prog g root "Europe/London"] sets the default timezone
+val set_timezone : Guestfs.guestfs -> string -> string -> bool
+(** [set_timezone g root "Europe/London"] sets the default timezone
of the guest. Returns [true] if it was able to set the
timezone or [false] if not. *)
diff --git a/generator/customize.ml b/generator/customize.ml
index 439eb24..a138e90 100644
--- a/generator/customize.ml
+++ b/generator/customize.ml
@@ -364,7 +364,7 @@ let rec generate_customize_cmdline_mli () =
pr "\
type argspec = Arg.key * Arg.spec * Arg.doc
-val argspec : prog:string -> unit -> (argspec * string option * string) list * (unit -> ops)
+val argspec : unit -> (argspec * string option * string) list * (unit -> ops)
(** This returns a pair [(list, get_ops)].
[list] is a list of the command line arguments, plus some extra data.
@@ -386,6 +386,8 @@ open Printf
open Common_utils
open Common_gettext.Gettext
+open Customize_utils
+
";
generate_ops_struct_decl ();
pr "\n";
@@ -393,7 +395,7 @@ open Common_gettext.Gettext
pr "\
type argspec = Arg.key * Arg.spec * Arg.doc
-let rec argspec ~prog () =
+let rec argspec () =
let ops = ref [] in
";
List.iter (
@@ -419,9 +421,8 @@ let rec argspec ~prog () =
let i =
try String.index arg ':'
with Not_found ->
- eprintf (f_\"%%s: invalid format for '--%%s' parameter, see the man page.\\n\")
- prog option_name;
- exit 1 in
+ error (f_\"invalid format for '--%%s' parameter, see the man page\")
+ option_name in
let len = String.length arg in
String.sub arg 0 i, String.sub arg (i+1) (len-(i+1))
in
@@ -431,9 +432,8 @@ let rec argspec ~prog () =
let split_links_list option_name arg =
match string_nsplit \":\" arg with
| [] | [_] ->
- eprintf (f_\"%%s: invalid format for '--%%s' parameter, see the man page.\\n\")
- prog option_name;
- exit 1
+ error (f_\"invalid format for '--%%s' parameter, see the man page\")
+ option_name
| target :: lns -> target, lns
in
@@ -500,7 +500,7 @@ let rec argspec ~prog () =
pr " \"--%s\",\n" name;
pr " Arg.String (\n";
pr " fun s ->\n";
- pr " let sel = Password.parse_selector ~prog s in\n";
+ pr " let sel = Password.parse_selector s in\n";
pr " ops := %s sel :: !ops\n" discrim;
pr " ),\n";
pr " s_\"%s\" ^ \" \" ^ s_\"%s\"\n" v shortdesc;
@@ -513,7 +513,7 @@ let rec argspec ~prog () =
pr " Arg.String (\n";
pr " fun s ->\n";
pr " let user, sel = split_string_pair \"%s\" s in\n" name;
- pr " let sel = Password.parse_selector ~prog sel in\n";
+ pr " let sel = Password.parse_selector sel in\n";
pr " ops := %s (user, sel) :: !ops\n" discrim;
pr " ),\n";
pr " s_\"%s\" ^ \" \" ^ s_\"%s\"\n" v shortdesc;
@@ -541,7 +541,7 @@ let rec argspec ~prog () =
pr " \"--%s\",\n" name;
pr " Arg.String (\n";
pr " fun s ->\n";
- pr " %s := Some (Password.password_crypto_of_string ~prog s)\n" var;
+ pr " %s := Some (Password.password_crypto_of_string s)\n" var;
pr " ),\n";
pr " \"%s\" ^ \" \" ^ s_\"%s\"\n" v shortdesc;
pr " ),\n";
diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index 1f08e47..0d87dea 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -19,6 +19,7 @@ customize/crypt.ml
customize/customize_cmdline.ml
customize/customize_main.ml
customize/customize_run.ml
+customize/customize_utils.ml
customize/firstboot.ml
customize/hostname.ml
customize/password.ml
diff --git a/sysprep/Makefile.am b/sysprep/Makefile.am
index 6c760a8..6553c9c 100644
--- a/sysprep/Makefile.am
+++ b/sysprep/Makefile.am
@@ -91,6 +91,7 @@ deps = \
$(top_builddir)/mllib/mkdtemp-c.o \
$(top_builddir)/mllib/mkdtemp.cmx \
$(top_builddir)/mllib/regedit.cmx \
+ $(top_builddir)/customize/customize_utils.cmx \
$(top_builddir)/customize/crypt-c.o \
$(top_builddir)/customize/crypt.cmx \
$(top_builddir)/customize/urandom.cmx \
diff --git a/sysprep/sysprep_operation_customize.ml b/sysprep/sysprep_operation_customize.ml
index 668c25a..c602640 100644
--- a/sysprep/sysprep_operation_customize.ml
+++ b/sysprep/sysprep_operation_customize.ml
@@ -22,7 +22,7 @@ open Common_gettext.Gettext
module G = Guestfs
let customize_args, get_ops =
- let args, get_ops = Customize_cmdline.argspec ~prog () in
+ let args, get_ops = Customize_cmdline.argspec () in
let args = List.map (
fun (spec, v, longdesc) ->
{ extra_argspec = spec;
@@ -32,7 +32,7 @@ let customize_args, get_ops =
let customize_perform ~verbose ~quiet g root side_effects =
let ops = get_ops () in
- Customize_run.run ~prog ~verbose ~quiet g root ops;
+ Customize_run.run ~verbose ~quiet g root ops;
side_effects#created_file () (* XXX Did we? *)
let op = {
diff --git a/v2v/Makefile.am b/v2v/Makefile.am
index 2f1f9bc..b4bb9cc 100644
--- a/v2v/Makefile.am
+++ b/v2v/Makefile.am
@@ -130,6 +130,7 @@ BOBJECTS = \
$(top_builddir)/mllib/config.cmo \
$(top_builddir)/mllib/mkdtemp.cmo \
$(top_builddir)/mllib/JSON.cmo \
+ $(top_builddir)/customize/customize_utils.cmo \
$(top_builddir)/customize/urandom.cmo \
$(top_builddir)/customize/random_seed.cmo \
$(top_builddir)/customize/hostname.cmo \
diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml
index beca99c..e5afbc9 100644
--- a/v2v/convert_windows.ml
+++ b/v2v/convert_windows.ml
@@ -148,7 +148,7 @@ let convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
(* Write the completed script to the guest. *)
let firstboot_script = Buffer.contents fb in
- Firstboot.add_firstboot_script ~prog g inspect.i_root 1 firstboot_script
+ Firstboot.add_firstboot_script g inspect.i_root 1 firstboot_script
and configure_rhev_apt fb =
(* Configure RHEV-APT (the RHEV guest agent). However if it doesn't
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-libvirt/libguestfs.git
More information about the Pkg-libvirt-commits
mailing list