[Libguestfs] [PATCH] customize: Move virt-customize-related code to a separate directory.
Richard W.M. Jones
rjones at redhat.com
Tue Mar 18 16:08:55 UTC 2014
Split virt-builder into build and customize steps, so that we can spin
off a separate tool called 'virt-customize'. This commit does not in
fact create such a tool, but it moves all the common code into a
library, in the customize/ subdirectory of the source.
Although this is mostly refactoring, it does change the order in which
virt-builder command line arguments are processed, so they are now
processed in the order they appear, not the inflexible fixed order
used before.
---
.gitignore | 3 +
Makefile.am | 12 +-
builder/Makefile.am | 33 ++-
builder/builder.ml | 332 +----------------------
builder/cmdline.ml | 206 +++-----------
builder/virt-builder.pod | 264 +-----------------
configure.ac | 1 +
customize/.depend | 30 +++
customize/Makefile.am | 181 +++++++++++++
customize/crypt-c.c | 44 +++
customize/crypt.ml | 19 ++
customize/crypt.mli | 22 ++
customize/customize_cmdline.ml | 183 +++++++++++++
customize/customize_cmdline.mli | 75 ++++++
customize/customize_run.ml | 315 ++++++++++++++++++++++
customize/customize_run.mli | 26 ++
customize/firstboot.ml | 171 ++++++++++++
customize/firstboot.mli | 27 ++
customize/hostname.ml | 110 ++++++++
customize/hostname.mli | 21 ++
customize/password.ml | 175 ++++++++++++
customize/password.mli | 42 +++
customize/perl_edit.ml | 78 ++++++
customize/perl_edit.mli | 19 ++
customize/random_seed.ml | 96 +++++++
customize/random_seed.mli | 21 ++
customize/timezone.ml | 39 +++
customize/timezone.mli | 22 ++
customize/urandom.ml | 69 +++++
customize/urandom.mli | 26 ++
generator/Makefile.am | 2 +
generator/customize.ml | 577 ++++++++++++++++++++++++++++++++++++++++
generator/main.ml | 6 +
mllib/Makefile.am | 26 --
mllib/crypt-c.c | 44 ---
mllib/crypt.ml | 19 --
mllib/crypt.mli | 22 --
mllib/firstboot.ml | 171 ------------
mllib/firstboot.mli | 27 --
mllib/hostname.ml | 110 --------
mllib/hostname.mli | 21 --
mllib/password.ml | 175 ------------
mllib/password.mli | 42 ---
mllib/perl_edit.ml | 78 ------
mllib/perl_edit.mli | 19 --
mllib/random_seed.ml | 96 -------
mllib/random_seed.mli | 21 --
mllib/timezone.ml | 39 ---
mllib/timezone.mli | 22 --
mllib/urandom.ml | 69 -----
mllib/urandom.mli | 26 --
po-docs/ja/Makefile.am | 9 +
po-docs/podfiles | 2 +
po-docs/uk/Makefile.am | 9 +
po/POTFILES | 2 +-
po/POTFILES-ml | 8 -
src/guestfs.pod | 4 +
sysprep/Makefile.am | 23 +-
58 files changed, 2512 insertions(+), 1819 deletions(-)
create mode 100644 customize/.depend
create mode 100644 customize/Makefile.am
create mode 100644 customize/crypt-c.c
create mode 100644 customize/crypt.ml
create mode 100644 customize/crypt.mli
create mode 100644 customize/customize_cmdline.ml
create mode 100644 customize/customize_cmdline.mli
create mode 100644 customize/customize_run.ml
create mode 100644 customize/customize_run.mli
create mode 100644 customize/firstboot.ml
create mode 100644 customize/firstboot.mli
create mode 100644 customize/hostname.ml
create mode 100644 customize/hostname.mli
create mode 100644 customize/password.ml
create mode 100644 customize/password.mli
create mode 100644 customize/perl_edit.ml
create mode 100644 customize/perl_edit.mli
create mode 100644 customize/random_seed.ml
create mode 100644 customize/random_seed.mli
create mode 100644 customize/timezone.ml
create mode 100644 customize/timezone.mli
create mode 100644 customize/urandom.ml
create mode 100644 customize/urandom.mli
create mode 100644 generator/customize.ml
delete mode 100644 mllib/crypt-c.c
delete mode 100644 mllib/crypt.ml
delete mode 100644 mllib/crypt.mli
delete mode 100644 mllib/firstboot.ml
delete mode 100644 mllib/firstboot.mli
delete mode 100644 mllib/hostname.ml
delete mode 100644 mllib/hostname.mli
delete mode 100644 mllib/password.ml
delete mode 100644 mllib/password.mli
delete mode 100644 mllib/perl_edit.ml
delete mode 100644 mllib/perl_edit.mli
delete mode 100644 mllib/random_seed.ml
delete mode 100644 mllib/random_seed.mli
delete mode 100644 mllib/timezone.ml
delete mode 100644 mllib/timezone.mli
delete mode 100644 mllib/urandom.ml
delete mode 100644 mllib/urandom.mli
diff --git a/.gitignore b/.gitignore
index 317ddd5..8d62ec2 100644
--- a/.gitignore
+++ b/.gitignore
@@ -90,6 +90,9 @@ Makefile.in
/config.sub
/configure
/csharp/Libguestfs.cs
+/customize/customize-options.pod
+/customize/customize-synopsis.pod
+/customize/virt-customize
/daemon/actions.h
/daemon/errnostring.c
/daemon/errnostring-gperf.c
diff --git a/Makefile.am b/Makefile.am
index aa176db..5b8a82e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -123,10 +123,16 @@ endif
# Unconditional because nothing is built yet.
SUBDIRS += csharp
-# OCaml tools. Note 'mllib' contains random shared code used by
-# all of the OCaml tools.
+# OCaml tools. Note 'mllib' and 'customize' contain shared code used
+# by other OCaml tools, so these must come first.
if HAVE_OCAML
-SUBDIRS += mllib builder builder/website resize sparsify sysprep
+SUBDIRS += \
+ mllib \
+ customize \
+ builder builder/website \
+ resize \
+ sparsify \
+ sysprep
endif
# Perl tools.
diff --git a/builder/Makefile.am b/builder/Makefile.am
index ad791e9..a777942 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -77,26 +77,28 @@ if HAVE_OCAML
# Note this list must be in dependency order.
deps = \
$(top_builddir)/mllib/libdir.cmx \
+ $(top_builddir)/mllib/config.cmx \
$(top_builddir)/mllib/common_gettext.cmx \
$(top_builddir)/mllib/common_utils.cmx \
- $(top_builddir)/mllib/urandom.cmx \
- $(top_builddir)/mllib/random_seed.cmx \
- $(top_builddir)/mllib/hostname.cmx \
- $(top_builddir)/mllib/timezone.cmx \
- $(top_builddir)/mllib/firstboot.cmx \
- $(top_builddir)/mllib/perl_edit.cmx \
- $(top_builddir)/mllib/crypt-c.o \
- $(top_builddir)/mllib/crypt.cmx \
$(top_builddir)/mllib/fsync-c.o \
$(top_builddir)/mllib/fsync.cmx \
- $(top_builddir)/mllib/password.cmx \
$(top_builddir)/mllib/planner.cmx \
- $(top_builddir)/mllib/config.cmx \
- $(top_builddir)/fish/guestfish-uri.o \
$(top_builddir)/mllib/uri-c.o \
$(top_builddir)/mllib/uRI.cmx \
$(top_builddir)/mllib/mkdtemp-c.o \
$(top_builddir)/mllib/mkdtemp.cmx \
+ $(top_builddir)/customize/urandom.cmx \
+ $(top_builddir)/customize/random_seed.cmx \
+ $(top_builddir)/customize/hostname.cmx \
+ $(top_builddir)/customize/timezone.cmx \
+ $(top_builddir)/customize/firstboot.cmx \
+ $(top_builddir)/customize/perl_edit.cmx \
+ $(top_builddir)/customize/crypt-c.o \
+ $(top_builddir)/customize/crypt.cmx \
+ $(top_builddir)/customize/password.cmx \
+ $(top_builddir)/customize/customize_cmdline.cmx \
+ $(top_builddir)/customize/customize_run.cmx \
+ $(top_builddir)/fish/guestfish-uri.o \
index-scan.o \
index-struct.o \
index-parse.o \
@@ -135,7 +137,8 @@ OCAMLPACKAGES = \
-package str,unix \
-I $(top_builddir)/src/.libs \
-I $(top_builddir)/ocaml \
- -I $(top_builddir)/mllib
+ -I $(top_builddir)/mllib \
+ -I $(top_builddir)/customize
if HAVE_OCAML_PKG_GETTEXT
OCAMLPACKAGES += -package gettext-stub
endif
@@ -182,10 +185,12 @@ noinst_DATA += $(top_builddir)/html/virt-builder.1.html
virt-builder.1 $(top_builddir)/html/virt-builder.1.html: stamp-virt-builder.pod
-stamp-virt-builder.pod: virt-builder.pod
+stamp-virt-builder.pod: virt-builder.pod $(top_srcdir)/customize/customize-synopsis.pod $(top_srcdir)/customize/customize-options.pod
$(PODWRAPPER) \
--man virt-builder.1 \
--html $(top_builddir)/html/virt-builder.1.html \
+ --insert $(top_srcdir)/customize/customize-synopsis.pod:__CUSTOMIZE_SYNOPSIS__ \
+ --insert $(top_srcdir)/customize/customize-options.pod:__CUSTOMIZE_OPTIONS__ \
--license GPLv2+ \
$<
touch $@
@@ -236,7 +241,7 @@ depend: .depend
.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
rm -f $@ $@-t
- $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib $^ | \
+ $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize $^ | \
$(SED) 's/ *$$//' | \
$(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
$(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
diff --git a/builder/builder.ml b/builder/builder.ml
index b3ca46a..164b2dd 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -38,12 +38,9 @@ let () = Random.self_init ()
let main () =
(* Command line argument parsing - see cmdline.ml. *)
let mode, arg,
- arch, attach, cache, check_signature, curl, debug, delete,
- delete_on_failure, edit, firstboot, run, format, gpg, hostname, install,
- list_format, links, memsize, mkdirs,
- network, output, password_crypto, quiet, root_password, scrub,
- scrub_logfile, selinux_relabel, size, smp, sources, sync, timezone,
- update, upload, writes =
+ arch, attach, cache, check_signature, curl, debug,
+ delete_on_failure, format, gpg, list_format, memsize,
+ network, ops, output, quiet, size, smp, sources, sync =
parse_cmdline () in
(* Timestamped messages in ordinary, non-debug non-quiet mode. *)
@@ -593,7 +590,7 @@ let main () =
(match smp with None -> () | Some smp -> g#set_smp smp);
g#set_network network;
- g#set_selinux selinux_relabel;
+ g#set_selinux ops.flags.selinux_relabel;
(* The output disk is being created, so use cache=unsafe here. *)
g#add_drive_opts ~format:output_format ~cachemode:"unsafe" output_filename;
@@ -626,313 +623,7 @@ let main () =
eprintf (f_"%s: 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.\n") prog;
exit 1 in
- (* Set the random seed. *)
- msg (f_"Setting a random seed");
- if not (Random_seed.set_random_seed g root) then
- eprintf (f_"%s: warning: random seed could not be set for this type of guest\n%!") prog;
-
- (* Set the hostname. *)
- (match hostname with
- | None -> ()
- | Some hostname ->
- msg (f_"Setting the hostname: %s") hostname;
- if not (Hostname.set_hostname g root hostname) then
- eprintf (f_"%s: warning: hostname could not be set for this type of guest\n%!") prog
- );
-
- (* Set the timezone. *)
- (match timezone with
- | None -> ()
- | Some timezone ->
- msg (f_"Setting the timezone: %s") timezone;
- if not (Timezone.set_timezone ~prog g root timezone) then
- eprintf (f_"%s: warning: timezone could not be set for this type of guest\n%!") prog
- );
-
- (* Root password.
- * Note 'None' means that we randomize the root password.
- *)
- let () =
- match g#inspect_get_type root with
- | "linux" ->
- let password_map = Hashtbl.create 1 in
- let pw =
- match root_password with
- | Some pw ->
- msg (f_"Setting root password");
- pw
- | None ->
- msg (f_"Setting random root password [did you mean to use --root-password?]");
- parse_selector ~prog "random" in
- Hashtbl.replace password_map "root" pw;
- set_linux_passwords ~prog ?password_crypto g root password_map
- | _ ->
- eprintf (f_"%s: warning: root password could not be set for this type of guest\n%!") prog in
-
- (* Based on the guest type, choose a log file location. *)
- let logfile =
- match g#inspect_get_type root with
- | "windows" | "dos" ->
- if g#is_dir ~followsymlinks:true "/Temp" then "/Temp/builder.log"
- else "/builder.log"
- | _ ->
- if g#is_dir ~followsymlinks:true "/tmp" then "/tmp/builder.log"
- else "/builder.log" in
-
- (* Function to cat the log file, for debugging and error messages. *)
- let debug_logfile () =
- try
- (* XXX If stderr is redirected this actually truncates the
- * redirection file, which is pretty annoying to say the
- * least.
- *)
- g#download logfile "/dev/stderr"
- with exn ->
- eprintf (f_"%s: log file %s: %s (ignored)\n")
- prog logfile (Printexc.to_string exn) in
-
- (* Useful wrapper for scripts. *)
- let do_run ~display cmd =
- (* Add a prologue to the scripts:
- * - Pass environment variables through from the host.
- * - Send stdout and stderr to a log file so we capture all output
- * in error messages.
- * Also catch errors and dump the log file completely on error.
- *)
- let env_vars =
- filter_map (
- fun name ->
- try Some (sprintf "export %s=%s" name (quote (Sys.getenv name)))
- with Not_found -> None
- ) [ "http_proxy"; "https_proxy"; "ftp_proxy"; "no_proxy" ] in
- let env_vars = String.concat "\n" env_vars ^ "\n" in
-
- let cmd = sprintf "\
-exec >>%s 2>&1
-%s
-%s
-" (quote logfile) env_vars cmd in
-
- if debug then eprintf "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
- in
-
- (* http://distrowatch.com/dwres.php?resource=package-management *)
- let guest_install_command packages =
- let quoted_args = String.concat " " (List.map quote packages) in
- match g#inspect_get_package_management root with
- | "apt" ->
- (* http://unix.stackexchange.com/questions/22820 *)
- sprintf "
- export DEBIAN_FRONTEND=noninteractive
- apt_opts='-q -y -o Dpkg::Options::=--force-confnew'
- apt-get $apt_opts update
- apt-get $apt_opts install %s
- " quoted_args
- | "pisi" ->
- sprintf "pisi it %s" quoted_args
- | "pacman" ->
- sprintf "pacman -S %s" quoted_args
- | "urpmi" ->
- sprintf "urpmi %s" quoted_args
- | "yum" ->
- sprintf "yum -y install %s" quoted_args
- | "zypper" ->
- (* 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
- | pm ->
- eprintf (f_"%s: sorry, don't know how to use --install with the '%s' package manager\n")
- prog pm;
- exit 1
-
- and guest_update_command () =
- match g#inspect_get_package_management root with
- | "apt" ->
- (* http://unix.stackexchange.com/questions/22820 *)
- sprintf "
- export DEBIAN_FRONTEND=noninteractive
- apt_opts='-q -y -o Dpkg::Options::=--force-confnew'
- apt-get $apt_opts update
- apt-get $apt_opts upgrade
- "
- | "pisi" ->
- sprintf "pisi upgrade"
- | "pacman" ->
- sprintf "pacman -Su"
- | "urpmi" ->
- sprintf "urpmi --auto-select"
- | "yum" ->
- sprintf "yum -y update"
- | "zypper" ->
- sprintf "zypper update"
- | "unknown" ->
- eprintf (f_"%s: --update is not supported for this guest operating system\n")
- prog;
- exit 1
- | pm ->
- eprintf (f_"%s: sorry, don't know how to use --update with the '%s' package manager\n")
- prog pm;
- exit 1
- in
-
- (* Update core/template packages. *)
- if update then (
- msg (f_"Updating core packages");
-
- let cmd = guest_update_command () in
- do_run ~display:cmd cmd
- );
-
- (* Install packages. *)
- if install <> [] then (
- msg (f_"Installing packages: %s") (String.concat " " install);
-
- let cmd = guest_install_command install in
- do_run ~display:cmd cmd
- );
-
- (* Make directories. *)
- List.iter (
- fun dir ->
- msg (f_"Making directory: %s") dir;
- g#mkdir_p dir
- ) mkdirs;
-
- (* Write files. *)
- List.iter (
- fun (file, content) ->
- msg (f_"Writing: %s") file;
- g#write file content
- ) writes;
-
- (* Upload files. *)
- List.iter (
- fun (file, dest) ->
- msg (f_"Uploading: %s to %s") file dest;
- let dest =
- if g#is_dir ~followsymlinks:true dest then
- dest ^ "/" ^ Filename.basename file
- else
- dest in
- (* Do the file upload. *)
- g#upload file dest;
-
- (* Copy (some of) the permissions from the local file to the
- * uploaded file.
- *)
- let statbuf = stat file in
- let perms = statbuf.st_perm land 0o7777 (* sticky & set*id *) in
- g#chmod perms dest;
- let uid, gid = statbuf.st_uid, statbuf.st_gid in
- g#chown uid gid dest
- ) upload;
-
- (* Edit files. *)
- 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. *)
- List.iter (
- fun file ->
- msg (f_"Deleting: %s") file;
- g#rm_rf file
- ) delete;
-
- (* Symbolic links. *)
- List.iter (
- fun (target, links) ->
- List.iter (
- fun link ->
- msg (f_"Linking: %s -> %s") link target;
- g#ln_sf target link
- ) links
- ) links;
-
- (* Scrub files. *)
- List.iter (
- fun file ->
- msg (f_"Scrubbing: %s") file;
- g#scrub_file file
- ) scrub;
-
- (* Firstboot scripts/commands/install. *)
- let () =
- let i = ref 0 in
- List.iter (
- fun op ->
- incr i;
- match op with
- | `Script script ->
- msg (f_"Installing firstboot script: [%d] %s") !i script;
- let cmd = read_whole_file script in
- Firstboot.add_firstboot_script g root !i cmd
- | `Command cmd ->
- msg (f_"Installing firstboot command: [%d] %s") !i cmd;
- Firstboot.add_firstboot_script g root !i cmd
- | `Packages pkgs ->
- msg (f_"Installing firstboot packages: [%d] %s") !i
- (String.concat " " pkgs);
- let cmd = guest_install_command pkgs in
- Firstboot.add_firstboot_script g root !i cmd
- ) firstboot in
-
- (* Run scripts. *)
- List.iter (
- function
- | `Script script ->
- msg (f_"Running: %s") script;
- let cmd = read_whole_file script in
- do_run ~display:script cmd
- | `Command cmd ->
- msg (f_"Running: %s") cmd;
- do_run ~display:cmd cmd
- ) run;
-
- if selinux_relabel then (
- msg (f_"SELinux relabelling");
- let cmd = sprintf "
- if load_policy && fixfiles restore; then
- rm -f /.autorelabel
- else
- touch /.autorelabel
- echo '%s: SELinux relabelling failed, will relabel at boot instead.'
- fi
- " prog in
- do_run ~display:"load_policy && fixfiles restore" cmd
- );
-
- (* Clean up the log file:
- *
- * If debugging, dump out the log file.
- * Then if asked, scrub the log file.
- *)
- if debug then debug_logfile ();
- if scrub_logfile && g#exists logfile then (
- msg (f_"Scrubbing the log file");
-
- (* Try various methods with decreasing complexity. *)
- try g#scrub_file logfile
- with _ -> g#rm_f logfile
- );
+ Customize_run.run ~prog ~debug ~quiet g root ops;
(* Collect some stats about the final output file.
* Notes:
@@ -976,19 +667,6 @@ exec >>%s 2>&1
(* Unmount everything and we're done! *)
msg (f_"Finishing off");
- (* Kill any daemons (eg. started by newly installed packages) using
- * the sysroot.
- * XXX How to make this nicer?
- * XXX fuser returns an error if it doesn't kill any processes, which
- * is not very useful.
- *)
- (try ignore (g#debug "sh" [| "fuser"; "-k"; "/sysroot" |])
- with exn ->
- if debug then
- eprintf (f_"%s: %s (ignored)\n") prog (Printexc.to_string exn)
- );
- g#ping_daemon (); (* tiny delay after kill *)
-
g#umount_all ();
g#shutdown ();
g#close ();
diff --git a/builder/cmdline.ml b/builder/cmdline.ml
index 2657906..2d242c7 100644
--- a/builder/cmdline.ml
+++ b/builder/cmdline.ml
@@ -21,10 +21,10 @@
open Common_gettext.Gettext
open Common_utils
+open Customize_cmdline
+
module G = Guestfs
-open Password
-
open Unix
open Printf
@@ -62,67 +62,14 @@ let parse_cmdline () =
let curl = ref "curl" in
let debug = ref false in
- let delete = ref [] in
- let add_delete s = delete := s :: !delete in
-
let delete_on_failure = ref true 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 fingerprints = ref [] in
let add_fingerprint arg = fingerprints := arg :: !fingerprints in
- let firstboot = ref [] in
- let add_firstboot s =
- if not (Sys.file_exists s) then (
- if not (String.contains s ' ') then
- eprintf (f_"%s: %s: %s: file not found\n") prog "--firstboot" s
- else
- eprintf (f_"%s: %s: %s: file not found [did you mean %s?]\n") prog "--firstboot" s "--firstboot-command";
- exit 1
- );
- firstboot := `Script s :: !firstboot
- in
- let add_firstboot_cmd s = firstboot := `Command s :: !firstboot in
- let add_firstboot_install pkgs =
- let pkgs = string_nsplit "," pkgs in
- firstboot := `Packages pkgs :: !firstboot
- in
-
let format = ref "" in
let gpg = ref "gpg" in
- let hostname = ref None in
- let set_hostname s = hostname := Some s in
-
- let install = ref [] in
- let add_install pkgs =
- let pkgs = string_nsplit "," pkgs in
- install := pkgs @ !install
- in
-
- let links = ref [] in
- let add_link arg =
- let target, lns =
- match string_nsplit ":" arg with
- | [] | [_] ->
- eprintf (f_"%s: invalid --link format, see the man page.\n") prog;
- exit 1
- | target :: lns -> target, lns in
- links := (target, lns) :: !links
- in
-
let list_format = ref `Short in
let list_set_long () = list_format := `Long in
let list_set_format arg =
@@ -137,44 +84,11 @@ let parse_cmdline () =
let memsize = ref None in
let set_memsize arg = memsize := Some arg in
- let mkdirs = ref [] in
- let add_mkdir arg = mkdirs := arg :: !mkdirs in
-
let network = ref true in
let output = ref "" in
- let password_crypto : password_crypto option ref = ref None in
- let set_password_crypto arg =
- password_crypto := Some (password_crypto_of_string ~prog arg)
- in
-
let quiet = ref false in
- let root_password = ref None in
- let set_root_password arg =
- let pw = parse_selector ~prog arg in
- root_password := Some pw
- in
-
- let run = ref [] in
- let add_run s =
- if not (Sys.file_exists s) then (
- if not (String.contains s ' ') then
- eprintf (f_"%s: %s: %s: file not found\n") prog "--run" s
- else
- eprintf (f_"%s: %s: %s: file not found [did you mean %s?]\n") prog "--run" s "--run-command";
- exit 1
- );
- run := `Script s :: !run
- in
- let add_run_cmd s = run := `Command s :: !run in
-
- let scrub = ref [] in
- let add_scrub s = scrub := s :: !scrub in
-
- let scrub_logfile = ref false in
- let selinux_relabel = ref false in
-
let size = ref None in
let set_size arg = size := Some (parse_size ~prog arg) in
@@ -186,43 +100,8 @@ let parse_cmdline () =
let sync = ref true in
- let timezone = ref None in
- let set_timezone s = timezone := Some s in
-
- let update = ref false in
-
- let upload = ref [] in
- let add_upload arg =
- let i =
- try String.index arg ':'
- with Not_found ->
- eprintf (f_"%s: invalid --upload format, see the man page.\n") prog;
- exit 1 in
- let len = String.length arg in
- let file = String.sub arg 0 i in
- if not (Sys.file_exists file) then (
- eprintf (f_"%s: --upload: %s: file not found\n") prog file;
- exit 1
- );
- let dest = String.sub arg (i+1) (len-(i+1)) in
- upload := (file, dest) :: !upload
- in
-
- let writes = ref [] in
- let add_write arg =
- let i =
- try String.index arg ':'
- with Not_found ->
- eprintf (f_"%s: invalid --write 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 content = String.sub arg (i+1) (len-(i+1)) in
- writes := (file, content) :: !writes
- in
-
let ditto = " -\"-" in
- let argspec = Arg.align [
+ let argspec = [
"--arch", Arg.Set_string arch, "arch" ^ " " ^ s_"Set the output architecture";
"--attach", Arg.String attach_disk, "iso" ^ " " ^ s_"Attach data disk/ISO during install";
"--attach-format", Arg.String set_attach_format,
@@ -238,65 +117,46 @@ let parse_cmdline () =
" " ^ s_"Disable digital signatures";
"--no-check-signatures", Arg.Clear check_signature, ditto;
"--curl", Arg.Set_string curl, "curl" ^ " " ^ s_"Set curl binary/command";
- "--delete", Arg.String add_delete, "name" ^ " " ^ s_"Delete a file or dir";
"--delete-cache", Arg.Unit delete_cache_mode,
" " ^ s_"Delete the template cache";
"--no-delete-on-failure", Arg.Clear delete_on_failure,
" " ^ s_"Don't delete output file on failure";
- "--edit", Arg.String add_edit, "file:expr" ^ " " ^ s_"Edit file with Perl expr";
"--fingerprint", Arg.String add_fingerprint,
"AAAA.." ^ " " ^ s_"Fingerprint of valid signing key";
- "--firstboot", Arg.String add_firstboot, "script" ^ " " ^ s_"Run script at first guest boot";
- "--firstboot-command", Arg.String add_firstboot_cmd, "cmd+args" ^ " " ^ s_"Run command at first guest boot";
- "--firstboot-install", Arg.String add_firstboot_install,
- "pkg,pkg" ^ " " ^ s_"Add package(s) to install at firstboot";
"--format", Arg.Set_string format, "raw|qcow2" ^ " " ^ s_"Output format (default: raw)";
"--get-kernel", Arg.Unit get_kernel_mode,
"image" ^ " " ^ s_"Get kernel from image";
"--gpg", Arg.Set_string gpg, "gpg" ^ " " ^ s_"Set GPG binary/command";
- "--hostname", Arg.String set_hostname, "hostname" ^ " " ^ s_"Set the hostname";
- "--install", Arg.String add_install, "pkg,pkg" ^ " " ^ s_"Add package(s) to install";
- "--link", Arg.String add_link, "target:link.." ^ " " ^ s_"Create symbolic links";
"-l", Arg.Unit list_mode, " " ^ s_"List available templates";
"--list", Arg.Unit list_mode, ditto;
"--long", Arg.Unit list_set_long, " " ^ s_"Shortcut for --list-format short";
"--list-format", Arg.String list_set_format,
"short|long|json" ^ " " ^ s_"Set the format for --list (default: short)";
- "--no-logfile", Arg.Set scrub_logfile, " " ^ s_"Scrub build log file";
"--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
"-m", Arg.Int set_memsize, "mb" ^ " " ^ s_"Set memory size";
"--memsize", Arg.Int set_memsize, "mb" ^ ditto;
- "--mkdir", Arg.String add_mkdir, "dir" ^ " " ^ s_"Create directory";
"--network", Arg.Set network, " " ^ s_"Enable appliance network (default)";
"--no-network", Arg.Clear network, " " ^ s_"Disable appliance network";
"--notes", Arg.Unit notes_mode, " " ^ s_"Display installation notes";
"-o", Arg.Set_string output, "file" ^ " " ^ s_"Set output filename";
"--output", Arg.Set_string output, "file" ^ ditto;
- "--password-crypto", Arg.String set_password_crypto,
- "md5|sha256|sha512" ^ " " ^ s_"Set password crypto";
"--print-cache", Arg.Unit print_cache_mode,
" " ^ s_"Print info about template cache";
"--quiet", Arg.Set quiet, " " ^ s_"No progress messages";
- "--root-password", Arg.String set_root_password,
- "..." ^ " " ^ s_"Set root password";
- "--run", Arg.String add_run, "script" ^ " " ^ s_"Run script in disk image";
- "--run-command", Arg.String add_run_cmd, "cmd+args" ^ " " ^ s_"Run command in disk image";
- "--scrub", Arg.String add_scrub, "name" ^ " " ^ s_"Scrub a file";
- "--selinux-relabel", Arg.Set selinux_relabel,
- " " ^ s_"Relabel files with correct SELinux labels";
"--size", Arg.String set_size, "size" ^ " " ^ s_"Set output disk size";
"--smp", Arg.Int set_smp, "vcpus" ^ " " ^ s_"Set number of vCPUs";
"--source", Arg.String add_source, "URL" ^ " " ^ s_"Set source URL";
"--no-sync", Arg.Clear sync, " " ^ s_"Do not fsync output file on exit";
- "--timezone",Arg.String set_timezone, "timezone" ^ " " ^ s_"Set the default timezone";
- "--update", Arg.Set update, " " ^ s_"Update core packages";
- "--upload", Arg.String add_upload, "file:dest" ^ " " ^ s_"Upload file to dest";
"-v", Arg.Set debug, " " ^ s_"Enable debugging messages";
"--verbose", Arg.Set debug, ditto;
"-V", Arg.Unit display_version, " " ^ s_"Display version and exit";
"--version", Arg.Unit display_version, ditto;
- "--write", Arg.String add_write, "file:content" ^ " " ^ s_"Write file";
] in
+ let customize_argspec, get_customize_ops =
+ Customize_cmdline.argspec ~prog () in
+ let argspec = argspec @ customize_argspec in
+ let argspec = List.sort compare argspec in
+ let argspec = Arg.align argspec in
long_options := argspec;
let args = ref [] in
@@ -328,36 +188,20 @@ read the man page virt-builder(1).
let check_signature = !check_signature in
let curl = !curl in
let debug = !debug in
- let delete = List.rev !delete in
let delete_on_failure = !delete_on_failure in
- let edit = List.rev !edit in
let fingerprints = List.rev !fingerprints in
- let firstboot = List.rev !firstboot in
- let run = List.rev !run in
let format = match !format with "" -> None | s -> Some s in
let gpg = !gpg in
- let hostname = !hostname in
- let install = List.rev !install in
let list_format = !list_format in
- let links = List.rev !links in
let memsize = !memsize in
- let mkdirs = List.rev !mkdirs in
let network = !network in
+ let ops = get_customize_ops () in
let output = match !output with "" -> None | s -> Some s in
- let password_crypto = !password_crypto in
let quiet = !quiet in
- let root_password = !root_password in
- let scrub = List.rev !scrub in
- let scrub_logfile = !scrub_logfile in
- let selinux_relabel = !selinux_relabel in
let size = !size in
let smp = !smp in
let sources = List.rev !sources in
let sync = !sync in
- let timezone = !timezone in
- let update = !update in
- let upload = List.rev !upload in
- let writes = List.rev !writes in
(* Check options. *)
let arg =
@@ -442,7 +286,15 @@ read the man page virt-builder(1).
| arch ->
let target_arch = Architecture.filter_arch arch in
if Architecture.arch_is_compatible Architecture.current_arch target_arch <> true then (
- if install <> [] || run <> [] || update then (
+ let requires_execute_on_guest = List.exists (
+ function
+ | `Command _ | `InstallPackages _ | `Script _ | `Update -> true
+ | `Delete _ | `Edit _ | `FirstbootCommand _ | `FirstbootPackages _
+ | `FirstbootScript _ | `Hostname _ | `Link _ | `Mkdir _
+ | `RootPassword _ | `Scrub _ | `Timezone _ | `Upload _
+ | `Write _ -> false
+ ) ops.ops in
+ if requires_execute_on_guest then (
eprintf (f_"%s: sorry, cannot run commands on a guest with a different architecture\n")
prog;
exit 1
@@ -450,10 +302,20 @@ read the man page virt-builder(1).
);
target_arch in
+ (* If user didn't elect any root password, that means we set a random
+ * root password.
+ *)
+ let ops =
+ let has_set_root_password = List.exists (
+ function `RootPassword _ -> true | _ -> false
+ ) ops.ops in
+ if has_set_root_password then ops
+ else (
+ let pw = Password.parse_selector ~prog "random" in
+ { ops with ops = ops.ops @ [ `RootPassword pw ] }
+ ) in
+
mode, arg,
- arch, attach, cache, check_signature, curl, debug, delete,
- delete_on_failure, edit, firstboot, run, format, gpg, hostname, install,
- list_format, links, memsize, mkdirs,
- network, output, password_crypto, quiet, root_password, scrub,
- scrub_logfile, selinux_relabel, size, smp, sources, sync, timezone,
- update, upload, writes
+ arch, attach, cache, check_signature, curl, debug,
+ delete_on_failure, format, gpg, list_format, memsize,
+ network, ops, output, quiet, size, smp, sources, sync
diff --git a/builder/virt-builder.pod b/builder/virt-builder.pod
index 7cf345c..2429f66 100644
--- a/builder/virt-builder.pod
+++ b/builder/virt-builder.pod
@@ -13,23 +13,8 @@ virt-builder - Build virtual machine images quickly
virt-builder os-version
[-o|--output DISKIMAGE] [--size SIZE] [--format raw|qcow2]
- [--arch ARCHITECTURE]
- [--attach ISOFILE]
- [--root-password SELECTOR]
- [--hostname HOSTNAME]
- [--timezone TIMEZONE]
- [--update]
- [--install PKG,[PKG...]]
- [--mkdir DIR]
- [--write FILE:CONTENT]
- [--upload FILE:DEST]
- [--link TARGET:LINK[:LINK]]
- [--edit FILE:EXPR]
- [--delete FILE] [--scrub FILE]
- [--selinux-relabel]
- [--run SCRIPT] [--run-command 'CMD ARGS ...']
- [--firstboot SCRIPT] [--firstboot-command 'CMD ARGS ...']
- [--firstboot-install PKG,[PKG...]]
+ [--arch ARCHITECTURE] [--attach ISOFILE]
+__CUSTOMIZE_SYNOPSIS__
virt-builder -l|--list [--long] [--list-format short|long|json]
@@ -261,15 +246,6 @@ curl parameters, for example to disable https certificate checks:
virt-builder --curl "curl --insecure" [...]
-=item B<--delete> FILE
-
-=item B<--delete> DIR
-
-Delete a file from the guest. Or delete a directory (and all its
-contents, recursively).
-
-See also: I<--upload>, I<--scrub>.
-
=item B<--delete-cache>
Delete the template cache. See L</CACHING>.
@@ -283,17 +259,6 @@ debug images.
The default is to delete the output file if virt-builder fails (or,
for example, some script that it runs fails).
-=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 index and templates are signed by the key with the
@@ -305,33 +270,6 @@ URLs, then you can have either no fingerprint, one fingerprint or
multiple fingerprints. If you have multiple, then each must
correspond 1-1 with a source URL.
-=item B<--firstboot> SCRIPT
-
-=item B<--firstboot-command> 'CMD ARGS ...'
-
-Install C<SCRIPT> inside the guest, so that when the guest first boots
-up, the script runs (as root, late in the boot process).
-
-The script is automatically chmod +x after installation in the guest.
-
-The alternative version I<--firstboot-command> is the same, but it
-conveniently wraps the command up in a single line script for you.
-
-You can have multiple I<--firstboot> and I<--firstboot-command>
-options. They run in the same order that they appear on the command
-line.
-
-See also I<--run>.
-
-=item B<--firstboot-install> PKG[,PKG,...]
-
-Install the named packages (a comma-separated list). These are
-installed when the guest first boots using the guest's package manager
-(eg. apt, yum, etc.) and the guest's network connection.
-
-For an overview on the different ways to install packages, see
-L</INSTALLING PACKAGES>.
-
=item B<--format> qcow2
=item B<--format> raw
@@ -365,29 +303,6 @@ alternate home directory:
virt-builder --gpg "gpg --homedir /tmp" [...]
-=item B<--hostname> HOSTNAME
-
-Set the hostname of the guest to C<HOSTNAME>. You can use a
-dotted hostname.domainname (FQDN) if you want.
-
-=item B<--install> PKG[,PKG,...]
-
-Install the named packages (a comma-separated list). These are
-installed during the image build using the guest's package manager
-(eg. apt, yum, etc.) and the host's network connection.
-
-For an overview on the different ways to install packages, see
-L</INSTALLING PACKAGES>.
-
-See also I<--update>.
-
-=item B<--link TARGET:LINK>
-
-=item B<--link TARGET:LINK[:LINK...]>
-
-Create symbolic link(s) in the guest, starting at C<LINK> and
-pointing at C<TARGET>.
-
=item B<-l>
=item B<--list>
@@ -429,14 +344,6 @@ I<--long> is a shorthand for the C<long> format.
See also: I<--source>, I<--notes>, L</SOURCES OF TEMPLATES>.
-=item B<--no-logfile>
-
-Scrub C<builder.log> (log file from build commands) from the image
-after building is complete. If you don't want to reveal precisely how
-the image was built, use this option.
-
-See also: L</LOG FILE>.
-
=item B<-m> MB
=item B<--memsize> MB
@@ -449,13 +356,6 @@ The default can be found with this command:
guestfish get-memsize
-=item B<--mkdir> DIR
-
-Create a directory in the guest.
-
-This uses S<C<mkdir -p>> so any intermediate directories are created,
-and it also works if the directory already exists.
-
=item B<--network>
=item B<--no-network>
@@ -539,20 +439,6 @@ volume.
When used with I<--get-kernel>, this option specifies the output
directory.
-=item B<--password-crypto> password-crypto
-
-Set the password encryption to C<md5>, C<sha256> or C<sha512>.
-
-C<sha256> and C<sha512> require glibc E<ge> 2.7 (check crypt(3) inside
-the guest).
-
-C<md5> will work with relatively old Linux guests (eg. RHEL 3), but
-is not secure against modern attacks.
-
-The default is C<sha512> unless libguestfs detects an old guest that
-didn't have support for SHA-512, in which case it will use C<md5>.
-You can override libguestfs by specifying this option.
-
=item B<--print-cache>
Print information about the template cache. See L</CACHING>.
@@ -561,62 +447,6 @@ Print information about the template cache. See L</CACHING>.
Don't print ordinary progress messages.
-=item B<--root-password> SELECTOR
-
-Set the root password.
-
-See L</USERS AND PASSWORDS> below for the format of the C<SELECTOR>
-field, and also how to set up user accounts.
-
-Note if you I<don't> set I<--root-password> then the guest is given
-a I<random> root password.
-
-=item B<--run> SCRIPT
-
-=item B<--run-command> 'CMD ARGS ...'
-
-Run the shell script (or any program) called C<SCRIPT> on the disk
-image. The script runs virtualized inside a small appliance, chrooted
-into the guest filesystem.
-
-The script is automatically chmod +x.
-
-If libguestfs supports it then a limited network connection is
-available but it only allows outgoing network connections. You can
-also attach data disks (eg. ISO files) as another way to provide data
-(eg. software packages) to the script without needing a network
-connection (I<--attach>). You can also upload data files (I<--upload>).
-
-The alternative version I<--run-command> is the same, but it
-conveniently wraps the command up in a single line script for you.
-
-You can have multiple I<--run> and I<--run-command> options. They run
-in the same order that they appear on the command line.
-
-See also: I<--firstboot>, I<--attach>, I<--upload>.
-
-=item B<--scrub> FILE
-
-Scrub a file from the guest. This is like I<--delete> except that:
-
-=over 4
-
-=item *
-
-It scrubs the data so a guest could not recover it.
-
-=item *
-
-It cannot delete directories, only regular files.
-
-=back
-
-=item B<--selinux-relabel>
-
-Relabel files in the guest so that they have the correct SELinux label.
-
-You should only use this option for guests which support SELinux.
-
=item B<--size> SIZE
Select the size of the output disk, where the size can be specified
@@ -649,34 +479,6 @@ Note that you should not point I<--source> to sources that you don't
trust (unless the source is signed by someone you do trust). See also
the I<--no-network> option.
-=item B<--timezone> TIMEZONE
-
-Set the default timezone of the guest to C<TIMEZONE>. Use a location
-string like C<Europe/London>
-
-=item B<--update>
-
-Do the equivalent of C<yum update>, C<apt-get upgrade>, or whatever
-command is required to update the packages already installed in the
-template to their latest versions.
-
-See also I<--install>.
-
-=item B<--upload> FILE:DEST
-
-Upload local file C<FILE> to destination C<DEST> in the disk image.
-File owner and permissions from the original are preserved, so you
-should set them to what you want them to be in the disk image.
-
-C<DEST> could be the final filename. This can be used to rename
-the file on upload.
-
-If C<DEST> is a directory name (which must already exist in the guest)
-then the file is uploaded into that directory, and it keeps the same
-name as on the local filesystem.
-
-See also: I<--mkdir>, I<--delete>, I<--scrub>.
-
=item B<-v>
=item B<--verbose>
@@ -692,12 +494,12 @@ your bug report.
Display version number and exit.
-=item B<--write> FILE:CONTENT
-
-Write C<CONTENT> to C<FILE>.
-
=back
+=head2 Customization options
+
+__CUSTOMIZE_OPTIONS__
+
=head1 REFERENCE
=head2 INSTALLING PACKAGES
@@ -996,58 +798,8 @@ A new random seed is generated for the guest.
=item *
-The hostname and timezone are set (I<--hostname>, I<--timezone>).
-
-=item *
-
-The root password is changed (I<--root-password>).
-
-=item *
-
-Core packages are updated (I<--update>).
-
-=item *
-
-Packages are installed (I<--install>).
-
-=item *
-
-Directories are created (I<--mkdir>).
-
-=item *
-
-Files are written (I<--write>).
-
-=item *
-
-Files are uploaded (I<--upload>).
-
-=item *
-
-Files are edited (I<--edit>).
-
-=item *
-
-Files are deleted (I<--delete>, I<--scrub>).
-
-=item *
-
-Symbolic links are created (I<--link>).
-
-=item *
-
-Firstboot scripts are installed (I<--firstboot>,
-I<--firstboot-command>, I<--firstboot-install>).
-
-Note that although firstboot scripts are installed at this step, they
-do not run until the guest is booted first time. Firstboot scripts
-will run in the order they appear on the command line.
-
-=item *
-
-Scripts are run (I<--run>, I<--run-command>).
-
-Scripts run in the order they appear on the command line.
+Guest customization is performed, in the order specified on the
+command line.
=item *
diff --git a/configure.ac b/configure.ac
index ac339a3..4640d03 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1613,6 +1613,7 @@ AC_CONFIG_FILES([Makefile
builder/website/Makefile
cat/Makefile
csharp/Makefile
+ customize/Makefile
daemon/Makefile
df/Makefile
diff/Makefile
diff --git a/customize/.depend b/customize/.depend
new file mode 100644
index 0000000..7a9594b
--- /dev/null
+++ b/customize/.depend
@@ -0,0 +1,30 @@
+./crypt.cmi :
+./crypt.cmo : ./crypt.cmi
+./crypt.cmx : ./crypt.cmi
+./customize_cmdline.cmi : password.cmi
+./customize_cmdline.cmo : password.cmi /home/rjones/d/libguestfs/mllib/common_utils.cmo /home/rjones/d/libguestfs/mllib/common_gettext.cmo ./customize_cmdline.cmi
+./customize_cmdline.cmx : password.cmx /home/rjones/d/libguestfs/mllib/common_utils.cmx /home/rjones/d/libguestfs/mllib/common_gettext.cmx ./customize_cmdline.cmi
+./customize_run.cmi : ../ocaml/guestfs.cmi customize_cmdline.cmi
+./customize_run.cmo : timezone.cmi random_seed.cmi perl_edit.cmi password.cmi hostname.cmi ../ocaml/guestfs.cmi firstboot.cmi customize_cmdline.cmi /home/rjones/d/libguestfs/mllib/common_utils.cmo /home/rjones/d/libguestfs/mllib/common_gettext.cmo ./customize_run.cmi
+./customize_run.cmx : timezone.cmx random_seed.cmx perl_edit.cmx password.cmx hostname.cmx ../ocaml/guestfs.cmx firstboot.cmx customize_cmdline.cmx /home/rjones/d/libguestfs/mllib/common_utils.cmx /home/rjones/d/libguestfs/mllib/common_gettext.cmx ./customize_run.cmi
+./firstboot.cmi : ../ocaml/guestfs.cmi
+./firstboot.cmo : ../ocaml/guestfs.cmi /home/rjones/d/libguestfs/mllib/common_utils.cmo /home/rjones/d/libguestfs/mllib/common_gettext.cmo ./firstboot.cmi
+./firstboot.cmx : ../ocaml/guestfs.cmx /home/rjones/d/libguestfs/mllib/common_utils.cmx /home/rjones/d/libguestfs/mllib/common_gettext.cmx ./firstboot.cmi
+./hostname.cmi : ../ocaml/guestfs.cmi
+./hostname.cmo : ../ocaml/guestfs.cmi /home/rjones/d/libguestfs/mllib/common_utils.cmo ./hostname.cmi
+./hostname.cmx : ../ocaml/guestfs.cmx /home/rjones/d/libguestfs/mllib/common_utils.cmx ./hostname.cmi
+./password.cmi : ../ocaml/guestfs.cmi
+./password.cmo : urandom.cmi crypt.cmi /home/rjones/d/libguestfs/mllib/common_utils.cmo /home/rjones/d/libguestfs/mllib/common_gettext.cmo ./password.cmi
+./password.cmx : urandom.cmx crypt.cmx /home/rjones/d/libguestfs/mllib/common_utils.cmx /home/rjones/d/libguestfs/mllib/common_gettext.cmx ./password.cmi
+./perl_edit.cmi : ../ocaml/guestfs.cmi
+./perl_edit.cmo : ../ocaml/guestfs.cmi /home/rjones/d/libguestfs/mllib/common_utils.cmo /home/rjones/d/libguestfs/mllib/common_gettext.cmo ./perl_edit.cmi
+./perl_edit.cmx : ../ocaml/guestfs.cmx /home/rjones/d/libguestfs/mllib/common_utils.cmx /home/rjones/d/libguestfs/mllib/common_gettext.cmx ./perl_edit.cmi
+./random_seed.cmi : ../ocaml/guestfs.cmi
+./random_seed.cmo : urandom.cmi ../ocaml/guestfs.cmi ./random_seed.cmi
+./random_seed.cmx : urandom.cmx ../ocaml/guestfs.cmx ./random_seed.cmi
+./timezone.cmi : ../ocaml/guestfs.cmi
+./timezone.cmo : ../ocaml/guestfs.cmi /home/rjones/d/libguestfs/mllib/common_utils.cmo ./timezone.cmi
+./timezone.cmx : ../ocaml/guestfs.cmx /home/rjones/d/libguestfs/mllib/common_utils.cmx ./timezone.cmi
+./urandom.cmi :
+./urandom.cmo : ./urandom.cmi
+./urandom.cmx : ./urandom.cmi
diff --git a/customize/Makefile.am b/customize/Makefile.am
new file mode 100644
index 0000000..abe5660
--- /dev/null
+++ b/customize/Makefile.am
@@ -0,0 +1,181 @@
+# virt-customize
+# Copyright (C) 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
+# 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.
+
+include $(top_srcdir)/subdir-rules.mk
+
+EXTRA_DIST = \
+ $(SOURCES)
+
+CLEANFILES = *~ *.cmi *.cmo *.cmx *.cmxa *.o
+
+generator_built = \
+ customize_cmdline.mli \
+ customize_cmdline.ml \
+ customize-options.pod \
+ customize-synopsis.pod
+
+# Alphabetical order.
+SOURCES = \
+ crypt.ml \
+ crypt.mli \
+ crypt-c.c \
+ customize_cmdline.ml \
+ customize_cmdline.mli \
+ customize_run.ml \
+ customize_run.mli \
+ firstboot.ml \
+ firstboot.mli \
+ hostname.ml \
+ hostname.mli \
+ password.ml \
+ password.mli \
+ perl_edit.ml \
+ perl_edit.mli \
+ random_seed.ml \
+ random_seed.mli \
+ timezone.ml \
+ timezone.mli \
+ urandom.ml \
+ urandom.mli
+
+if HAVE_OCAML
+
+deps = \
+ $(top_builddir)/mllib/common_gettext.cmx \
+ $(top_builddir)/mllib/common_utils.cmx \
+ crypt-c.o
+
+if HAVE_OCAMLOPT
+OBJECTS = $(deps)
+else
+OBJECTS = $(patsubst %.cmx,%.cmo,$(deps))
+endif
+
+# This list must be in dependency order.
+ocaml_modules = \
+ crypt \
+ firstboot \
+ hostname \
+ urandom \
+ password \
+ perl_edit \
+ random_seed \
+ timezone \
+ customize_cmdline \
+ customize_run
+
+if HAVE_OCAMLOPT
+OBJECTS += $(patsubst %,%.cmx,$(ocaml_modules))
+else
+OBJECTS += $(patsubst %,%.cmo,$(ocaml_modules))
+endif
+
+# XXX virt-customize isn't a complete tool yet, so currently this is
+# just a dummy target binary.
+noinst_SCRIPTS = virt-customize
+
+# -I $(top_builddir)/src/.libs is a hack which forces corresponding -L
+# option to be passed to gcc, so we don't try linking against an
+# installed copy of libguestfs.
+OCAMLPACKAGES = \
+ -package str,unix \
+ -I $(top_builddir)/src/.libs \
+ -I $(top_builddir)/ocaml \
+ -I $(top_builddir)/mllib
+if HAVE_OCAML_PKG_GETTEXT
+OCAMLPACKAGES += -package gettext-stub
+endif
+
+OCAMLCFLAGS = -g -warn-error CDEFLMPSUVYZX $(OCAMLPACKAGES)
+OCAMLOPTFLAGS = $(OCAMLCFLAGS)
+
+OCAMLCLIBS = \
+ $(LIBXML2_LIBS) -lncurses -lcrypt \
+ -L../src/.libs -lutils \
+ -L../gnulib/lib/.libs -lgnu
+
+virt-customize: $(OBJECTS)
+if HAVE_OCAMLOPT
+ $(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) \
+ mlguestfs.cmxa -linkpkg $^ \
+ -cclib '$(OCAMLCLIBS)' \
+ $(OCAML_GCOV_LDFLAGS) \
+ -o $@
+else
+ $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) \
+ mlguestfs.cma -linkpkg $^ \
+ -cclib '$(OCAMLCLIBS)' \
+ -custom \
+ $(OCAML_GCOV_LDFLAGS) \
+ -o $@
+endif
+
+.mli.cmi:
+ $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -c $< -o $@
+.ml.cmo:
+ $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -c $< -o $@
+.ml.cmx:
+ $(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -c $< -o $@
+
+# This OCaml module has to be generated by make (configure will put
+# unexpanded prefix macro in).
+
+libdir.ml: Makefile
+ echo 'let libdir = "$(libdir)"' > $@-t
+ mv $@-t $@
+
+# automake will decide we don't need C support in this file. Really
+# we do, so we have to provide it ourselves.
+
+DEFAULT_INCLUDES = \
+ -I. \
+ -I$(top_builddir) \
+ -I$(shell $(OCAMLC) -where) \
+ -I$(top_srcdir)/src \
+ -I$(top_srcdir)/fish
+
+.c.o:
+ $(CC) $(CFLAGS) $(PROF_CFLAGS) $(DEFAULT_INCLUDES) -c $< -o $@
+
+# Tests.
+
+TESTS_ENVIRONMENT = $(top_builddir)/run --test
+
+TESTS =
+
+check-valgrind:
+ $(MAKE) VG="$(top_builddir)/run @VG@" check
+
+# Dependencies.
+depend: .depend
+
+.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
+ rm -f $@ $@-t
+ $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib $^ | \
+ $(SED) 's/ *$$//' | \
+ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
+ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
+ sort > $@-t
+ mv $@-t $@
+
+-include .depend
+
+endif
+
+DISTCLEANFILES = .depend
+
+.PHONY: depend docs
diff --git a/customize/crypt-c.c b/customize/crypt-c.c
new file mode 100644
index 0000000..29a91e4
--- /dev/null
+++ b/customize/crypt-c.c
@@ -0,0 +1,44 @@
+/* virt-sysprep - interface to crypt(3)
+ * 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.
+ */
+
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+value
+virt_sysprep_crypt (value keyv, value saltv)
+{
+ CAMLparam2 (keyv, saltv);
+ CAMLlocal1 (rv);
+ char *r;
+
+ /* Note that crypt returns a pointer to a statically allocated
+ * buffer in glibc. For this and other reasons, this function
+ * is not thread safe.
+ */
+ r = crypt (String_val (keyv), String_val (saltv));
+ rv = caml_copy_string (r);
+
+ CAMLreturn (rv);
+}
diff --git a/customize/crypt.ml b/customize/crypt.ml
new file mode 100644
index 0000000..2c48c0d
--- /dev/null
+++ b/customize/crypt.ml
@@ -0,0 +1,19 @@
+(* virt-sysprep
+ * 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.
+ *)
+
+external crypt : string -> string -> string = "virt_sysprep_crypt"
diff --git a/customize/crypt.mli b/customize/crypt.mli
new file mode 100644
index 0000000..ef4066f
--- /dev/null
+++ b/customize/crypt.mli
@@ -0,0 +1,22 @@
+(* virt-sysprep
+ * 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.
+ *)
+
+(** Wrapper around glibc crypt(3) function. *)
+
+val crypt : string -> string -> string
+(** [crypt key salt] returns the password ([key]) encrypted. *)
diff --git a/customize/customize_cmdline.ml b/customize/customize_cmdline.ml
new file mode 100644
index 0000000..6ff2b4d
--- /dev/null
+++ b/customize/customize_cmdline.ml
@@ -0,0 +1,183 @@
+(* libguestfs generated file
+ * WARNING: THIS FILE IS GENERATED FROM:
+ * generator/ *.ml
+ * ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.
+ *
+ * Copyright (C) 2009-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
+ * 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.
+ *)
+
+(* Command line argument parsing, both for the virt-customize binary
+ * and for the other tools that share the same code.
+ *)
+
+open Printf
+
+open Common_utils
+open Common_gettext.Gettext
+
+type ops = {
+ ops : op list;
+ flags : flags;
+}
+and op = [
+ | `Delete of string
+ (* --delete PATH *)
+ | `Edit of string * string
+ (* --edit FILE:EXPR *)
+ | `FirstbootScript of string
+ (* --firstboot SCRIPT *)
+ | `FirstbootCommand of string
+ (* --firstboot-command 'CMD ARGS' *)
+ | `FirstbootPackages of string list
+ (* --firstboot-install PKG,PKG.. *)
+ | `Hostname of string
+ (* --hostname HOSTNAME *)
+ | `InstallPackages of string list
+ (* --install PKG,PKG.. *)
+ | `Link of string * string list
+ (* --link TARGET:LINK[:LINK..] *)
+ | `Mkdir of string
+ (* --mkdir DIR *)
+ | `RootPassword of Password.password_selector
+ (* --root-password SELECTOR *)
+ | `Script of string
+ (* --run SCRIPT *)
+ | `Command of string
+ (* --run-command 'CMD ARGS' *)
+ | `Scrub of string
+ (* --scrub FILE *)
+ | `Timezone of string
+ (* --timezone TIMEZONE *)
+ | `Update
+ (* --update *)
+ | `Upload of string * string
+ (* --upload FILE:DEST *)
+ | `Write of string * string
+ (* --write FILE:CONTENT *)
+]
+and flags = {
+ scrub_logfile : bool;
+ (* --no-logfile *)
+ password_crypto : Password.password_crypto option;
+ (* --password-crypto md5|sha256|sha512 *)
+ selinux_relabel : bool;
+ (* --selinux-relabel *)
+}
+
+let rec argspec ~prog () =
+ let ops = ref [] in
+ let scrub_logfile = ref false in
+ let password_crypto = ref None in
+ let selinux_relabel = ref false in
+
+ let rec get_ops () = {
+ ops = List.rev !ops;
+ flags = get_flags ();
+ }
+ and get_flags () = {
+ scrub_logfile = !scrub_logfile;
+ password_crypto = !password_crypto;
+ selinux_relabel = !selinux_relabel;
+ }
+ in
+
+ let split_string_pair option_name arg =
+ 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
+ let len = String.length arg in
+ String.sub arg 0 i, String.sub arg (i+1) (len-(i+1))
+ in
+ let split_string_list arg =
+ string_nsplit "," arg
+ in
+ 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
+ | target :: lns -> target, lns
+ in
+
+ let argspec = [
+ "--delete",
+ Arg.String (fun s -> ops := `Delete s :: !ops),
+ s_"PATH" ^ " " ^ s_"Delete a file or directory";
+ "--edit",
+ Arg.String (fun s -> let p = split_string_pair "edit" s in ops := `Edit p :: !ops),
+ s_"FILE:EXPR" ^ " " ^ s_"Edit file using Perl expression";
+ "--firstboot",
+ Arg.String (fun s -> ops := `FirstbootScript s :: !ops),
+ s_"SCRIPT" ^ " " ^ s_"Run script at first guest boot";
+ "--firstboot-command",
+ Arg.String (fun s -> ops := `FirstbootCommand s :: !ops),
+ s_"'CMD ARGS'" ^ " " ^ s_"Run command at first guest boot";
+ "--firstboot-install",
+ Arg.String (fun s -> let ss = split_string_list s in ops := `FirstbootPackages ss :: !ops),
+ s_"PKG,PKG.." ^ " " ^ s_"Add package(s) to install at first boot";
+ "--hostname",
+ Arg.String (fun s -> ops := `Hostname s :: !ops),
+ s_"HOSTNAME" ^ " " ^ s_"Set the hostname";
+ "--install",
+ Arg.String (fun s -> let ss = split_string_list s in ops := `InstallPackages ss :: !ops),
+ s_"PKG,PKG.." ^ " " ^ s_"Add package(s) to install";
+ "--link",
+ Arg.String (fun s -> let ss = split_links_list "link" s in ops := `Link ss :: !ops),
+ s_"TARGET:LINK[:LINK..]" ^ " " ^ s_"Create symbolic links";
+ "--mkdir",
+ Arg.String (fun s -> ops := `Mkdir s :: !ops),
+ s_"DIR" ^ " " ^ s_"Create a directory";
+ "--root-password",
+ Arg.String (fun s -> let sel = Password.parse_selector ~prog s in ops := `RootPassword sel :: !ops),
+ s_"SELECTOR" ^ " " ^ s_"Set root password";
+ "--run",
+ Arg.String (fun s -> ops := `Script s :: !ops),
+ s_"SCRIPT" ^ " " ^ s_"Run script in disk image";
+ "--run-command",
+ Arg.String (fun s -> ops := `Command s :: !ops),
+ s_"'CMD ARGS'" ^ " " ^ s_"Run command in disk image";
+ "--scrub",
+ Arg.String (fun s -> ops := `Scrub s :: !ops),
+ s_"FILE" ^ " " ^ s_"Scrub a file";
+ "--timezone",
+ Arg.String (fun s -> ops := `Timezone s :: !ops),
+ s_"TIMEZONE" ^ " " ^ s_"Set the default timezone";
+ "--update",
+ Arg.Unit (fun () -> ops := `Update :: !ops),
+ " " ^ s_"Update core packages";
+ "--upload",
+ Arg.String (fun s -> let p = split_string_pair "upload" s in ops := `Upload p :: !ops),
+ s_"FILE:DEST" ^ " " ^ s_"Upload local file to destination";
+ "--write",
+ Arg.String (fun s -> let p = split_string_pair "write" s in ops := `Write p :: !ops),
+ s_"FILE:CONTENT" ^ " " ^ s_"Write file";
+ "--no-logfile",
+ Arg.Set scrub_logfile,
+ " " ^ s_"Scrub build log file";
+ "--password-crypto",
+ Arg.String (fun s -> password_crypto := Some (Password.password_crypto_of_string ~prog s)),
+ "md5|sha256|sha512" ^ " " ^ s_"Set password crypto";
+ "--selinux-relabel",
+ Arg.Set selinux_relabel,
+ " " ^ s_"Relabel files with correct SELinux labels";
+] in
+
+ argspec, get_ops
diff --git a/customize/customize_cmdline.mli b/customize/customize_cmdline.mli
new file mode 100644
index 0000000..c2b8d8b
--- /dev/null
+++ b/customize/customize_cmdline.mli
@@ -0,0 +1,75 @@
+(* libguestfs generated file
+ * WARNING: THIS FILE IS GENERATED FROM:
+ * generator/ *.ml
+ * ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.
+ *
+ * Copyright (C) 2009-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
+ * 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.
+ *)
+
+(** Command line argument parsing, both for the virt-customize binary
+ and for the other tools that share the same code. *)
+
+type ops = {
+ ops : op list;
+ flags : flags;
+}
+and op = [
+ | `Delete of string
+ (* --delete PATH *)
+ | `Edit of string * string
+ (* --edit FILE:EXPR *)
+ | `FirstbootScript of string
+ (* --firstboot SCRIPT *)
+ | `FirstbootCommand of string
+ (* --firstboot-command 'CMD ARGS' *)
+ | `FirstbootPackages of string list
+ (* --firstboot-install PKG,PKG.. *)
+ | `Hostname of string
+ (* --hostname HOSTNAME *)
+ | `InstallPackages of string list
+ (* --install PKG,PKG.. *)
+ | `Link of string * string list
+ (* --link TARGET:LINK[:LINK..] *)
+ | `Mkdir of string
+ (* --mkdir DIR *)
+ | `RootPassword of Password.password_selector
+ (* --root-password SELECTOR *)
+ | `Script of string
+ (* --run SCRIPT *)
+ | `Command of string
+ (* --run-command 'CMD ARGS' *)
+ | `Scrub of string
+ (* --scrub FILE *)
+ | `Timezone of string
+ (* --timezone TIMEZONE *)
+ | `Update
+ (* --update *)
+ | `Upload of string * string
+ (* --upload FILE:DEST *)
+ | `Write of string * string
+ (* --write FILE:CONTENT *)
+]
+and flags = {
+ scrub_logfile : bool;
+ (* --no-logfile *)
+ password_crypto : Password.password_crypto option;
+ (* --password-crypto md5|sha256|sha512 *)
+ selinux_relabel : bool;
+ (* --selinux-relabel *)
+}
+
+val argspec : prog:string -> unit -> (Arg.key * Arg.spec * Arg.doc) list * (unit -> ops)
diff --git a/customize/customize_run.ml b/customize/customize_run.ml
new file mode 100644
index 0000000..3756070
--- /dev/null
+++ b/customize/customize_run.ml
@@ -0,0 +1,315 @@
+(* virt-customize
+ * Copyright (C) 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
+ * 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 Unix
+open Printf
+
+open Common_gettext.Gettext
+open Common_utils
+
+open Customize_cmdline
+open Password
+
+let quote = Filename.quote
+
+let run ~prog ~debug ~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
+
+ (* Based on the guest type, choose a log file location. *)
+ let logfile =
+ match g#inspect_get_type root with
+ | "windows" | "dos" ->
+ if g#is_dir ~followsymlinks:true "/Temp" then "/Temp/builder.log"
+ else "/builder.log"
+ | _ ->
+ if g#is_dir ~followsymlinks:true "/tmp" then "/tmp/builder.log"
+ else "/builder.log" in
+
+ (* Function to cat the log file, for debugging and error messages. *)
+ let debug_logfile () =
+ try
+ (* XXX If stderr is redirected this actually truncates the
+ * redirection file, which is pretty annoying to say the
+ * least.
+ *)
+ g#download logfile "/dev/stderr"
+ with exn ->
+ eprintf (f_"%s: log file %s: %s (ignored)\n")
+ prog logfile (Printexc.to_string exn) in
+
+ (* Useful wrapper for scripts. *)
+ let do_run ~display cmd =
+ (* Add a prologue to the scripts:
+ * - Pass environment variables through from the host.
+ * - Send stdout and stderr to a log file so we capture all output
+ * in error messages.
+ * Also catch errors and dump the log file completely on error.
+ *)
+ let env_vars =
+ filter_map (
+ fun name ->
+ try Some (sprintf "export %s=%s" name (quote (Sys.getenv name)))
+ with Not_found -> None
+ ) [ "http_proxy"; "https_proxy"; "ftp_proxy"; "no_proxy" ] in
+ let env_vars = String.concat "\n" env_vars ^ "\n" in
+
+ let cmd = sprintf "\
+exec >>%s 2>&1
+%s
+%s
+" (quote logfile) env_vars cmd in
+
+ if debug then eprintf "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
+ in
+
+ (* http://distrowatch.com/dwres.php?resource=package-management *)
+ let guest_install_command packages =
+ let quoted_args = String.concat " " (List.map quote packages) in
+ match g#inspect_get_package_management root with
+ | "apt" ->
+ (* http://unix.stackexchange.com/questions/22820 *)
+ sprintf "
+ export DEBIAN_FRONTEND=noninteractive
+ apt_opts='-q -y -o Dpkg::Options::=--force-confnew'
+ apt-get $apt_opts update
+ apt-get $apt_opts install %s
+ " quoted_args
+ | "pisi" ->
+ sprintf "pisi it %s" quoted_args
+ | "pacman" ->
+ sprintf "pacman -S %s" quoted_args
+ | "urpmi" ->
+ sprintf "urpmi %s" quoted_args
+ | "yum" ->
+ sprintf "yum -y install %s" quoted_args
+ | "zypper" ->
+ (* 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
+ | pm ->
+ eprintf (f_"%s: sorry, don't know how to use --install with the '%s' package manager\n")
+ prog pm;
+ exit 1
+
+ and guest_update_command () =
+ match g#inspect_get_package_management root with
+ | "apt" ->
+ (* http://unix.stackexchange.com/questions/22820 *)
+ sprintf "
+ export DEBIAN_FRONTEND=noninteractive
+ apt_opts='-q -y -o Dpkg::Options::=--force-confnew'
+ apt-get $apt_opts update
+ apt-get $apt_opts upgrade
+ "
+ | "pisi" ->
+ sprintf "pisi upgrade"
+ | "pacman" ->
+ sprintf "pacman -Su"
+ | "urpmi" ->
+ sprintf "urpmi --auto-select"
+ | "yum" ->
+ sprintf "yum -y update"
+ | "zypper" ->
+ sprintf "zypper update"
+ | "unknown" ->
+ eprintf (f_"%s: --update is not supported for this guest operating system\n")
+ prog;
+ exit 1
+ | pm ->
+ eprintf (f_"%s: sorry, don't know how to use --update with the '%s' package manager\n")
+ prog pm;
+ exit 1
+ in
+
+ (* Set the random seed. *)
+ msg (f_"Setting a random seed");
+ if not (Random_seed.set_random_seed g root) then
+ eprintf (f_"%s: warning: random seed could not be set for this type of guest\n%!") prog;
+
+ (* Used for numbering firstboot commands. *)
+ let i = ref 0 in
+
+ (* Perform the remaining customizations in command-line order. *)
+ List.iter (
+ function
+ | `Command cmd ->
+ msg (f_"Running: %s") cmd;
+ do_run ~display:cmd cmd
+
+ | `Delete path ->
+ msg (f_"Deleting: %s") path;
+ g#rm_rf path
+
+ | `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
+ );
+
+ Perl_edit.edit_file ~debug g path expr
+
+ | `FirstbootCommand cmd ->
+ incr i;
+ msg (f_"Installing firstboot command: [%d] %s") !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 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 g root !i cmd
+
+ | `Hostname hostname ->
+ msg (f_"Setting the hostname: %s") hostname;
+ if not (Hostname.set_hostname g root hostname) then
+ eprintf (f_"%s: warning: hostname could not be set for this type of guest\n%!")
+ prog
+
+ | `InstallPackages pkgs ->
+ msg (f_"Installing packages: %s") (String.concat " " pkgs);
+ let cmd = guest_install_command pkgs in
+ do_run ~display:cmd cmd
+
+ | `Link (target, links) ->
+ List.iter (
+ fun link ->
+ msg (f_"Linking: %s -> %s") link target;
+ g#ln_sf target link
+ ) links
+
+ | `Mkdir dir ->
+ msg (f_"Making directory: %s") dir;
+ g#mkdir_p dir
+
+ | `RootPassword pw ->
+ (match g#inspect_get_type root with
+ | "linux" ->
+ msg (f_"Setting root password");
+ let password_map = Hashtbl.create 1 in
+ Hashtbl.replace password_map "root" pw;
+ let password_crypto = ops.flags.password_crypto in
+ set_linux_passwords ~prog ?password_crypto g root password_map
+
+ | _ ->
+ eprintf (f_"%s: warning: root password could not be set for this type of guest\n%!")
+ prog
+ )
+
+ | `Script script ->
+ msg (f_"Running: %s") script;
+ let cmd = read_whole_file script in
+ do_run ~display:script cmd
+
+ | `Scrub path ->
+ msg (f_"Scrubbing: %s") path;
+ g#scrub_file path
+
+ | `Timezone tz ->
+ msg (f_"Setting the timezone: %s") tz;
+ if not (Timezone.set_timezone ~prog g root tz) then
+ eprintf (f_"%s: warning: timezone could not be set for this type of guest\n%!")
+ prog
+
+ | `Update ->
+ msg (f_"Updating core packages");
+ let cmd = guest_update_command () in
+ do_run ~display:cmd cmd
+
+ | `Upload (path, dest) ->
+ msg (f_"Uploading: %s to %s") path dest;
+ let dest =
+ if g#is_dir ~followsymlinks:true dest then
+ dest ^ "/" ^ Filename.basename path
+ else
+ dest in
+ (* Do the file upload. *)
+ g#upload path dest;
+
+ (* Copy (some of) the permissions from the local file to the
+ * uploaded file.
+ *)
+ let statbuf = stat path in
+ let perms = statbuf.st_perm land 0o7777 (* sticky & set*id *) in
+ g#chmod perms dest;
+ let uid, gid = statbuf.st_uid, statbuf.st_gid in
+ g#chown uid gid dest
+
+ | `Write (path, content) ->
+ msg (f_"Writing: %s") path;
+ g#write path content
+ ) ops.ops;
+
+ if ops.flags.selinux_relabel then (
+ msg (f_"SELinux relabelling");
+ let cmd = sprintf "
+ if load_policy && fixfiles restore; then
+ rm -f /.autorelabel
+ else
+ touch /.autorelabel
+ echo '%s: SELinux relabelling failed, will relabel at boot instead.'
+ fi
+ " prog in
+ do_run ~display:"load_policy && fixfiles restore" cmd
+ );
+
+ (* Clean up the log file:
+ *
+ * If debugging, dump out the log file.
+ * Then if asked, scrub the log file.
+ *)
+ if debug then debug_logfile ();
+ if ops.flags.scrub_logfile && g#exists logfile then (
+ msg (f_"Scrubbing the log file");
+
+ (* Try various methods with decreasing complexity. *)
+ try g#scrub_file logfile
+ with _ -> g#rm_f logfile
+ );
+
+ (* Kill any daemons (eg. started by newly installed packages) using
+ * the sysroot.
+ * XXX How to make this nicer?
+ * XXX fuser returns an error if it doesn't kill any processes, which
+ * is not very useful.
+ *)
+ (try ignore (g#debug "sh" [| "fuser"; "-k"; "/sysroot" |])
+ with exn ->
+ if debug then
+ eprintf (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
new file mode 100644
index 0000000..0fa7683
--- /dev/null
+++ b/customize/customize_run.mli
@@ -0,0 +1,26 @@
+(* virt-customize
+ * Copyright (C) 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
+ * 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.
+ *)
+
+(* After command line arguments have been parsed, call this function
+ * to perform the operations on a guest handle.
+ *
+ * Note that inspection must have been done on the handle, and
+ * filesystems must be mounted up.
+ *)
+
+val run : prog:string -> debug:bool -> quiet:bool -> Guestfs.guestfs -> string -> Customize_cmdline.ops -> unit
diff --git a/customize/firstboot.ml b/customize/firstboot.ml
new file mode 100644
index 0000000..9e4c7b6
--- /dev/null
+++ b/customize/firstboot.ml
@@ -0,0 +1,171 @@
+(* virt-sysprep
+ * Copyright (C) 2012 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 Printf
+
+open Common_utils
+open Common_gettext.Gettext
+
+(* For Linux guests. *)
+let firstboot_dir = "/usr/lib/virt-sysprep"
+
+let firstboot_sh = sprintf "\
+#!/bin/sh -
+
+### BEGIN INIT INFO
+# Provides: virt-sysprep
+# Required-Start: $null
+# Should-Start: $all
+# Required-Stop: $null
+# Should-Stop: $all
+# Default-Start: 2 3 5
+# Default-Stop: 0 1 6
+# Short-Description: Start scripts to run once at next boot
+# Description: Start scripts to run once at next boot
+# These scripts run the first time the guest boots,
+# and then are deleted. Output or errors from the scripts
+# are written to ~root/virt-sysprep-firstboot.log.
+### END INIT INFO
+
+d=%s/scripts
+logfile=~root/virt-sysprep-firstboot.log
+
+echo \"$0\" \"$@\" 2>&1 | tee $logfile
+echo \"Scripts dir: $d\" 2>&1 | tee $logfile
+
+if test \"$1\" = \"start\"
+then
+ for f in $d/* ; do
+ if test -x \"$f\"
+ then
+ echo '=== Running' $f '===' 2>&1 | tee $logfile
+ $f 2>&1 | tee $logfile
+ rm -f $f
+ fi
+ done
+fi
+" firstboot_dir
+
+let firstboot_service = sprintf "\
+[Unit]
+Description=virt-sysprep firstboot service
+After=network.target
+Before=prefdm.service
+
+[Service]
+Type=oneshot
+ExecStart=%s/firstboot.sh start
+RemainAfterExit=yes
+StandardOutput=journal+console
+StandardError=inherit
+
+[Install]
+WantedBy=default.target
+" firstboot_dir
+
+let failed fs =
+ ksprintf (fun msg -> failwith (s_"firstboot: failed: " ^ msg)) fs
+
+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;
+ g#chmod 0o755 (sprintf "%s/firstboot.sh" firstboot_dir);
+
+ (* Note we install both systemd and sysvinit services. This is
+ * because init systems can be switched at runtime, and it's easy to
+ * tell if systemd is installed (eg. Ubuntu uses upstart but installs
+ * systemd configuration directories). There is no danger of a
+ * firstboot script running twice because they disable themselves
+ * after running.
+ *)
+ 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 g distro
+
+(* Install the systemd firstboot service, if not installed already. *)
+and install_systemd_service g =
+ g#write (sprintf "%s/firstboot.service" firstboot_dir) firstboot_service;
+ g#mkdir_p "/etc/systemd/system/default.target.wants";
+ g#ln_sf (sprintf "%s/firstboot.service" firstboot_dir)
+ "/etc/systemd/system/default.target.wants"
+
+and install_sysvinit_service g = function
+ | "fedora"|"rhel"|"centos"|"scientificlinux"|"redhat-based" ->
+ install_sysvinit_redhat g
+ | "opensuse"|"sles"|"suse-based" ->
+ install_sysvinit_suse g
+ | "debian"|"ubuntu" ->
+ install_sysvinit_debian g
+ | distro ->
+ failed "guest type %s is not supported" distro
+
+and install_sysvinit_redhat g =
+ g#mkdir_p "/etc/rc.d/rc2.d";
+ g#mkdir_p "/etc/rc.d/rc3.d";
+ g#mkdir_p "/etc/rc.d/rc5.d";
+ g#ln_sf (sprintf "%s/firstboot.sh" firstboot_dir)
+ "/etc/rc.d/rc2.d/S99virt-sysprep-firstboot";
+ g#ln_sf (sprintf "%s/firstboot.sh" firstboot_dir)
+ "/etc/rc.d/rc3.d/S99virt-sysprep-firstboot";
+ g#ln_sf (sprintf "%s/firstboot.sh" firstboot_dir)
+ "/etc/rc.d/rc5.d/S99virt-sysprep-firstboot"
+
+(* Make firstboot.sh look like a runlevel script to avoid insserv warnings. *)
+and install_sysvinit_suse g =
+ g#mkdir_p "/etc/init.d/rc2.d";
+ g#mkdir_p "/etc/init.d/rc3.d";
+ g#mkdir_p "/etc/init.d/rc5.d";
+ g#ln_sf (sprintf "%s/firstboot.sh" firstboot_dir)
+ "/etc/init.d/virt-sysprep-firstboot";
+ g#ln_sf "../virt-sysprep-firstboot"
+ "/etc/init.d/rc2.d/S99virt-sysprep-firstboot";
+ g#ln_sf "../virt-sysprep-firstboot"
+ "/etc/init.d/rc3.d/S99virt-sysprep-firstboot";
+ g#ln_sf "../virt-sysprep-firstboot"
+ "/etc/init.d/rc5.d/S99virt-sysprep-firstboot"
+
+and install_sysvinit_debian g =
+ g#mkdir_p "/etc/init.d";
+ g#mkdir_p "/etc/rc2.d";
+ g#mkdir_p "/etc/rc3.d";
+ g#mkdir_p "/etc/rc5.d";
+ g#ln_sf (sprintf "%s/firstboot.sh" firstboot_dir)
+ "/etc/init.d/virt-sysprep-firstboot";
+ g#ln_sf "/etc/init.d/virt-sysprep-firstboot"
+ "/etc/rc2.d/S99virt-sysprep-firstboot";
+ g#ln_sf "/etc/init.d/virt-sysprep-firstboot"
+ "/etc/rc3.d/S99virt-sysprep-firstboot";
+ g#ln_sf "/etc/init.d/virt-sysprep-firstboot"
+ "/etc/rc5.d/S99virt-sysprep-firstboot"
+
+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", _ ->
+ 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" firstboot_dir i t r in
+ g#write filename content;
+ g#chmod 0o755 filename
+
+ | _ ->
+ failed "guest type %s/%s is not supported" typ distro
diff --git a/customize/firstboot.mli b/customize/firstboot.mli
new file mode 100644
index 0000000..4fb8812
--- /dev/null
+++ b/customize/firstboot.mli
@@ -0,0 +1,27 @@
+(* virt-sysprep
+ * Copyright (C) 2012 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 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.
+
+ The scripts run in index ([idx]) order.
+
+ You should make sure the filesystem is relabelled after calling this. *)
diff --git a/customize/hostname.ml b/customize/hostname.ml
new file mode 100644
index 0000000..70ca934
--- /dev/null
+++ b/customize/hostname.ml
@@ -0,0 +1,110 @@
+(* virt-sysprep
+ * Copyright (C) 2012-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
+ * 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_utils
+
+open Printf
+
+let rec set_hostname (g : Guestfs.guestfs) root hostname =
+ let typ = g#inspect_get_type root in
+ let distro = g#inspect_get_distro root in
+ let major_version = g#inspect_get_major_version root in
+
+ match typ, distro, major_version with
+ (* Fedora 18 (hence RHEL 7+) changed to using /etc/hostname
+ * (RHBZ#881953, RHBZ#858696). We may also need to modify
+ * /etc/machine-info (RHBZ#890027).
+ *)
+ | "linux", "fedora", v when v >= 18 ->
+ update_etc_hostname g hostname;
+ update_etc_machine_info g hostname;
+ true
+
+ | "linux", ("rhel"|"centos"|"scientificlinux"|"redhat-based"), v
+ when v >= 7 ->
+ update_etc_hostname g hostname;
+ update_etc_machine_info g hostname;
+ true
+
+ | "linux", ("debian"|"ubuntu"), _ ->
+ let old_hostname = read_etc_hostname g in
+ update_etc_hostname g hostname;
+ (match old_hostname with
+ | Some old_hostname -> replace_host_in_etc_hosts g old_hostname hostname
+ | None -> ()
+ );
+ true
+
+ | "linux", ("fedora"|"rhel"|"centos"|"scientificlinux"|"redhat-based"), _ ->
+ replace_line_in_file g "/etc/sysconfig/network" "HOSTNAME" hostname;
+ true
+
+ | "linux", ("opensuse"|"sles"|"suse-based"), _ ->
+ g#write "/etc/HOSTNAME" hostname;
+ true
+
+ | _ ->
+ false
+
+(* Replace <key>=... entry in file. The code assumes it's a small,
+ * plain text file.
+ *)
+and replace_line_in_file g filename key value =
+ let content =
+ if g#is_file filename then (
+ let lines = Array.to_list (g#read_lines filename) in
+ let lines = List.filter (
+ fun line -> not (string_prefix line (key ^ "="))
+ ) lines in
+ let lines = lines @ [sprintf "%s=%s" key value] in
+ String.concat "\n" lines ^ "\n"
+ ) else (
+ sprintf "%s=%s\n" key value
+ ) in
+ g#write filename content
+
+and update_etc_hostname g hostname =
+ g#write "/etc/hostname" (hostname ^ "\n")
+
+and update_etc_machine_info g hostname =
+ replace_line_in_file g "/etc/machine-info" "PRETTY_HOSTNAME" hostname
+
+and read_etc_hostname g =
+ let filename = "/etc/hostname" in
+ if g#is_file filename then (
+ let lines = Array.to_list (g#read_lines filename) in
+ match lines with
+ | hd :: _ -> Some hd
+ | [] -> None
+ ) else
+ None
+
+and replace_host_in_etc_hosts g oldhost newhost =
+ if g#is_file "/etc/hosts" then (
+ let expr = "/files/etc/hosts/*[label() != '#comment']/*[label() != 'ipaddr']" in
+ g#aug_init "/" 0;
+ let matches = Array.to_list (g#aug_match expr) in
+ List.iter (
+ fun m ->
+ let value = g#aug_get m in
+ if value = oldhost then (
+ g#aug_set m newhost
+ )
+ ) matches;
+ g#aug_save ()
+ )
diff --git a/customize/hostname.mli b/customize/hostname.mli
new file mode 100644
index 0000000..15487f6
--- /dev/null
+++ b/customize/hostname.mli
@@ -0,0 +1,21 @@
+(* virt-sysprep
+ * Copyright (C) 2012-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
+ * 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 set_hostname : Guestfs.guestfs -> string -> string -> bool
+(** Set the hostname in a guest. Returns true if it was able to
+ do set it, false if not. *)
diff --git a/customize/password.ml b/customize/password.ml
new file mode 100644
index 0000000..6527138
--- /dev/null
+++ b/customize/password.ml
@@ -0,0 +1,175 @@
+(* virt-sysprep
+ * Copyright (C) 2012-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
+ * 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
+
+type password_crypto = [`MD5 | `SHA256 | `SHA512 ]
+
+type password_selector = {
+ pw_password : password;
+ pw_locked : bool;
+}
+and password =
+| Password of string
+| Random_password
+| Disabled_password
+
+type password_map = (string, password_selector) Hashtbl.t
+
+let make_random_password =
+ (* Get random characters from the set [A-Za-z0-9] with some
+ * homoglyphs removed.
+ *)
+ let chars = "ABCDEFGHIJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz0123456789" in
+ fun () -> Urandom.urandom_uniform 16 chars
+
+let password_crypto_of_string ~prog = 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
+
+let rec parse_selector ~prog arg =
+ parse_selector_list ~prog arg (string_nsplit ":" arg)
+
+and parse_selector_list ~prog 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
+ { pw with pw_locked = true }
+ | [ "file"; filename ] ->
+ { pw_password = Password (read_password_from_file filename);
+ pw_locked = false }
+ | "password" :: password ->
+ { pw_password = Password (String.concat ":" password); pw_locked = false }
+ | [ "random" ] ->
+ { pw_password = Random_password; pw_locked = false }
+ | [ "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
+
+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./"
+
+let rec set_linux_passwords ~prog ?password_crypto g root passwords =
+ let crypto =
+ match password_crypto with
+ | None -> default_crypto g root
+ | Some c -> c in
+
+ (* XXX Would like to use Augeas here, but Augeas doesn't support
+ * /etc/shadow (as of 1.1.0).
+ *)
+
+ let shadow = Array.to_list (g#read_lines "/etc/shadow") in
+ let shadow =
+ List.map (
+ fun line ->
+ try
+ (* Each line is: "user:[!!]password:..."
+ * !! at the front of the password field means the account is locked.
+ * 'i' points to the first colon, 'j' to the second colon.
+ *)
+ let i = String.index line ':' in
+ let user = String.sub line 0 i in
+ let selector = Hashtbl.find passwords user in
+ let j = String.index_from line (i+1) ':' in
+ let rest = String.sub line j (String.length line - j) in
+ let pwfield =
+ match selector with
+ | { pw_locked = locked;
+ pw_password = Password password } ->
+ if locked then "!!" else "" ^ encrypt password crypto
+ | { 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;
+ if locked then "!!" else "" ^ encrypt password crypto
+ | { pw_locked = true; pw_password = Disabled_password } -> "!!*"
+ | { pw_locked = false; pw_password = Disabled_password } -> "*" in
+ user ^ ":" ^ pwfield ^ rest
+ with Not_found -> line
+ ) shadow in
+
+ g#write "/etc/shadow" (String.concat "\n" shadow ^ "\n");
+ (* In virt-sysprep /.autorelabel will label it correctly. *)
+ g#chmod 0 "/etc/shadow"
+
+(* Encrypt each password. Use glibc (on the host). See:
+ * https://rwmj.wordpress.com/2013/07/09/setting-the-root-or-other-passwords-in-a-linux-guest/
+ *)
+and encrypt password crypto =
+ (* Get random characters from the set [A-Za-z0-9./] *)
+ let salt = Urandom.urandom_uniform 16 chars in
+ let salt =
+ (match crypto with
+ | `MD5 -> "$1$"
+ | `SHA256 -> "$5$"
+ | `SHA512 -> "$6$") ^ salt ^ "$" in
+ let r = Crypt.crypt password salt in
+ (*printf "password: encrypt %s with salt %s -> %s\n" password salt r;*)
+ r
+
+(* glibc 2.7 was released in Oct 2007. Approximately, all guests that
+ * precede this date only support md5, whereas all guests after this
+ * date can support sha512.
+ *)
+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
+ | ("rhel"|"centos"|"scientificlinux"|"redhat-based"), v when v >= 6 ->
+ `SHA512
+ | ("rhel"|"centos"|"scientificlinux"|"redhat-based"), _ ->
+ `MD5 (* RHEL 5 does not appear to support SHA512, according to crypt(3) *)
+
+ | "fedora", v when v >= 9 -> `SHA512
+ | "fedora", _ -> `MD5
+
+ | "debian", v when v >= 5 -> `SHA512
+ | "debian", _ -> `MD5
+
+ (* Very likely earlier versions of Ubuntu than 10.04 had new crypt,
+ * but Ubuntu 10.04 is the earliest version I have checked.
+ *)
+ | "ubuntu", v when v >= 10 -> `SHA512
+ | "ubuntu", _ -> `MD5
+
+ | _, _ ->
+ eprintf (f_"\
+virt-sysprep: password: warning: using insecure md5 password encryption for
+guest of type %s version %d.
+If this is incorrect, use --password-crypto option and file a bug.\n%!")
+ distro major;
+ `MD5
diff --git a/customize/password.mli b/customize/password.mli
new file mode 100644
index 0000000..c662b1b
--- /dev/null
+++ b/customize/password.mli
@@ -0,0 +1,42 @@
+(* virt-sysprep
+ * Copyright (C) 2012-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
+ * 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 password_crypto = [ `MD5 | `SHA256 | `SHA512 ]
+
+val password_crypto_of_string : prog:string -> string -> password_crypto
+(** Parse --password-crypto parameter on command line. *)
+
+type password_selector = {
+ pw_password : password; (** The password. *)
+ pw_locked : bool; (** If the account should be locked. *)
+}
+and password =
+| Password of string (** Password (literal string). *)
+| Random_password (** Choose a random password. *)
+| Disabled_password (** [*] in the password field. *)
+
+val parse_selector : prog:string -> 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
+(** Adjust the passwords of a Linux guest according to the
+ password map. *)
diff --git a/customize/perl_edit.ml b/customize/perl_edit.ml
new file mode 100644
index 0000000..28e5dea
--- /dev/null
+++ b/customize/perl_edit.ml
@@ -0,0 +1,78 @@
+(* 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. *)
+ g#copy_attributes ~all:true 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
diff --git a/customize/perl_edit.mli b/customize/perl_edit.mli
new file mode 100644
index 0000000..fd30dcc
--- /dev/null
+++ b/customize/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
diff --git a/customize/random_seed.ml b/customize/random_seed.ml
new file mode 100644
index 0000000..84236cd
--- /dev/null
+++ b/customize/random_seed.ml
@@ -0,0 +1,96 @@
+(* virt-sysprep
+ * Copyright (C) 2012-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
+ * 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.
+ *)
+
+(* It's important that we write a random seed if we possibly can.
+ * Unfortunately some installers (hello, Debian) don't include the file
+ * in the basic guest, so we have to work out where to create it.
+ *)
+let rec set_random_seed (g : Guestfs.guestfs) root =
+ let typ = g#inspect_get_type root in
+ let created = ref false in
+
+ if typ = "linux" then (
+ let files = [
+ "/var/lib/random-seed"; (* Fedora *)
+ "/var/lib/urandom/random-seed"; (* Debian *)
+ "/var/lib/misc/random-seed"; (* SuSE *)
+ ] in
+ List.iter (
+ fun file ->
+ if g#is_file file then (
+ make_random_seed_file g file;
+ created := true
+ )
+ ) files;
+ );
+
+ if not !created then (
+ (* Backup plan: Try to create a new file. *)
+
+ let distro = g#inspect_get_distro root in
+ let file =
+ match typ, distro with
+ | "linux", ("fedora"|"rhel"|"centos"|"scientificlinux"|"redhat-based") ->
+ Some "/var/lib/random-seed"
+ | "linux", ("debian"|"ubuntu") ->
+ Some "/var/lib/urandom/random-seed"
+ | "linux", ("opensuse"|"sles"|"suse-based") ->
+ Some "/var/lib/misc/random-seed"
+ | _ ->
+ None in
+ match file with
+ | Some file ->
+ make_random_seed_file g file;
+ created := true
+ | None -> ()
+ );
+
+ !created
+
+and make_random_seed_file g file =
+ let file_exists = g#is_file file in
+ let n =
+ if file_exists then (
+ let n = Int64.to_int (g#filesize file) in
+
+ (* This file is usually 512 bytes in size. However during
+ * guest creation of some guests it can be just 8 bytes long.
+ * Cap the file size to [512, 8192] bytes.
+ *)
+ min (max n 512) 8192
+ )
+ else
+ (* Default to 512 bytes of randomness. *)
+ 512 in
+
+ (* Get n bytes of randomness from the host. *)
+ let entropy = Urandom.urandom_bytes n in
+
+ if file_exists then (
+ (* Truncate the original file and append, in order to
+ * preserve original permissions.
+ *)
+ g#truncate file;
+ g#write_append file entropy
+ )
+ else (
+ (* Create a new file, set the permissions restrictively. *)
+ g#write file entropy;
+ g#chown 0 0 file;
+ g#chmod 0o600 file
+ )
diff --git a/customize/random_seed.mli b/customize/random_seed.mli
new file mode 100644
index 0000000..b5261f2
--- /dev/null
+++ b/customize/random_seed.mli
@@ -0,0 +1,21 @@
+(* virt-sysprep
+ * Copyright (C) 2012-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
+ * 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 set_random_seed : Guestfs.guestfs -> string -> bool
+(** Set the random seed in the guest. Returns true if it was able to
+ do set it, false if not. *)
diff --git a/customize/timezone.ml b/customize/timezone.ml
new file mode 100644
index 0000000..8b302d9
--- /dev/null
+++ b/customize/timezone.ml
@@ -0,0 +1,39 @@
+(* Set timezone in virt-sysprep and virt-builder.
+ * Copyright (C) 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
+ * 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_utils
+
+open Printf
+
+let set_timezone ~prog (g : Guestfs.guestfs) root timezone =
+ let typ = g#inspect_get_type root in
+
+ match typ with
+ (* Every known Linux has /etc/localtime be either a copy of or a
+ * symlink to a timezone file in /usr/share/zoneinfo.
+ * Even systemd didn't fuck this up.
+ *)
+ | "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;
+ g#ln_sf target "/etc/localtime";
+ true
+
+ | _ ->
+ false
diff --git a/customize/timezone.mli b/customize/timezone.mli
new file mode 100644
index 0000000..ad0d4b2
--- /dev/null
+++ b/customize/timezone.mli
@@ -0,0 +1,22 @@
+(* Set timezone in virt-sysprep and virt-builder.
+ * Copyright (C) 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
+ * 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 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. *)
diff --git a/customize/urandom.ml b/customize/urandom.ml
new file mode 100644
index 0000000..9b613e8
--- /dev/null
+++ b/customize/urandom.ml
@@ -0,0 +1,69 @@
+(* Read /dev/urandom.
+ * 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.
+ *)
+
+(* Read and return N bytes (only) from /dev/urandom.
+ *
+ * As pointed out by Edwin Török, previous versions of this had a big
+ * problem. They used the OCaml buffered I/O library which would read
+ * a lot more data than requested. This version uses unbuffered I/O
+ * from the Unix module.
+ *)
+
+open Unix
+
+let open_urandom_fd () = openfile "/dev/urandom" [O_RDONLY] 0
+
+let read_byte fd =
+ let s = String.make 1 ' ' in
+ fun () ->
+ if read fd s 0 1 = 0 then (
+ close fd;
+ raise End_of_file
+ );
+ Char.code s.[0]
+
+let urandom_bytes n =
+ assert (n > 0);
+ let ret = String.make n ' ' in
+ let fd = open_urandom_fd () in
+ for i = 0 to n-1 do
+ ret.[i] <- Char.chr (read_byte fd ())
+ done;
+ close fd;
+ ret
+
+(* Return a random number uniformly distributed in [0, upper_bound)
+ * avoiding modulo bias.
+ *)
+let rec uniform_random read upper_bound =
+ let c = read () in
+ if c >= 256 mod upper_bound then c mod upper_bound
+ else uniform_random read upper_bound
+
+let urandom_uniform n chars =
+ assert (n > 0);
+ let nr_chars = String.length chars in
+ assert (nr_chars > 0);
+
+ let ret = String.make n ' ' in
+ let fd = open_urandom_fd () in
+ for i = 0 to n-1 do
+ ret.[i] <- chars.[uniform_random (read_byte fd) nr_chars]
+ done;
+ close fd;
+ ret
diff --git a/customize/urandom.mli b/customize/urandom.mli
new file mode 100644
index 0000000..ffc77dd
--- /dev/null
+++ b/customize/urandom.mli
@@ -0,0 +1,26 @@
+(* Read /dev/urandom.
+ * 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.
+ *)
+
+(** Read and return N bytes (only) from /dev/urandom. *)
+
+val urandom_bytes : int -> string
+(** Read N bytes from /dev/urandom and return it as a binary string. *)
+
+val urandom_uniform : int -> string -> string
+(** [urandom_uniform n chars] returns [n] bytes, uniformly
+ distributed from the sets of characters [chars]. *)
diff --git a/generator/Makefile.am b/generator/Makefile.am
index c129747..e66644c 100644
--- a/generator/Makefile.am
+++ b/generator/Makefile.am
@@ -27,6 +27,7 @@ sources = \
c.ml \
checks.ml \
csharp.ml \
+ customize.ml \
daemon.ml \
docstrings.ml \
erlang.ml \
@@ -89,6 +90,7 @@ objects = \
golang.cmo \
bindtests.cmo \
errnostring.cmo \
+ customize.cmo \
main.cmo
EXTRA_DIST = $(sources) files-generated.txt
diff --git a/generator/customize.ml b/generator/customize.ml
new file mode 100644
index 0000000..84ffeaa
--- /dev/null
+++ b/generator/customize.ml
@@ -0,0 +1,577 @@
+(* libguestfs
+ * Copyright (C) 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
+ * 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
+ *)
+
+(* Please read generator/README first. *)
+
+open Printf
+
+open Docstrings
+open Pr
+
+(* Command-line arguments used by virt-customize, virt-builder and
+ * virt-sysprep.
+ *)
+
+type op = {
+ op_name : string; (* argument name, without "--" *)
+ op_type : op_type; (* argument value type *)
+ op_discrim : string; (* argument discriminator in OCaml code *)
+ op_shortdesc : string; (* single-line description *)
+ op_pod_longdesc : string; (* multi-line description *)
+}
+and op_type =
+| Unit (* no argument *)
+| String of string (* string *)
+| StringPair of string (* string:string *)
+| StringList of string (* string,string,... *)
+| TargetLinks of string (* target:link[:link...] *)
+| PasswordSelector of string (* password selector *)
+
+let ops = [
+ { op_name = "delete";
+ op_type = String "PATH";
+ op_discrim = "`Delete";
+ op_shortdesc = "Delete a file or directory";
+ op_pod_longdesc = "\
+Delete a file from the guest. Or delete a directory (and all its
+contents, recursively).
+
+See also: I<--upload>, I<--scrub>.";
+ };
+ { op_name = "edit";
+ op_type = StringPair "FILE:EXPR";
+ op_discrim = "`Edit";
+ op_shortdesc = "Edit file using Perl expression";
+ op_pod_longdesc = "\
+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>.";
+ };
+ { op_name = "firstboot";
+ op_type = String "SCRIPT";
+ op_discrim = "`FirstbootScript";
+ op_shortdesc = "Run script at first guest boot";
+ op_pod_longdesc = "\
+Install C<SCRIPT> inside the guest, so that when the guest first boots
+up, the script runs (as root, late in the boot process).
+
+The script is automatically chmod +x after installation in the guest.
+
+The alternative version I<--firstboot-command> is the same, but it
+conveniently wraps the command up in a single line script for you.
+
+You can have multiple I<--firstboot> options. They run in the same
+order that they appear on the command line.
+
+See also I<--run>.";
+ };
+ { op_name = "firstboot-command";
+ op_type = String "'CMD ARGS'";
+ op_discrim = "`FirstbootCommand";
+ op_shortdesc = "Run command at first guest boot";
+ op_pod_longdesc = "\
+Run command (and arguments) inside the guest when the guest first
+boots up (as root, late in the boot process).
+
+You can have multiple I<--firstboot> options. They run in the same
+order that they appear on the command line.
+
+See also I<--run>.";
+ };
+ { op_name = "firstboot-install";
+ op_type = StringList "PKG,PKG..";
+ op_discrim = "`FirstbootPackages";
+ op_shortdesc = "Add package(s) to install at first boot";
+ op_pod_longdesc = "\
+Install the named packages (a comma-separated list). These are
+installed when the guest first boots using the guest's package manager
+(eg. apt, yum, etc.) and the guest's network connection.
+
+For an overview on the different ways to install packages, see
+L<virt-builder(1)/INSTALLING PACKAGES>.";
+ };
+ { op_name = "hostname";
+ op_type = String "HOSTNAME";
+ op_discrim = "`Hostname";
+ op_shortdesc = "Set the hostname";
+ op_pod_longdesc = "\
+Set the hostname of the guest to C<HOSTNAME>. You can use a
+dotted hostname.domainname (FQDN) if you want.";
+ };
+ { op_name = "install";
+ op_type = StringList "PKG,PKG..";
+ op_discrim = "`InstallPackages";
+ op_shortdesc = "Add package(s) to install";
+ op_pod_longdesc = "\
+Install the named packages (a comma-separated list). These are
+installed during the image build using the guest's package manager
+(eg. apt, yum, etc.) and the host's network connection.
+
+For an overview on the different ways to install packages, see
+L<virt-builder(1)/INSTALLING PACKAGES>.
+
+See also I<--update>.";
+ };
+ { op_name = "link";
+ op_type = TargetLinks "TARGET:LINK[:LINK..]";
+ op_discrim = "`Link";
+ op_shortdesc = "Create symbolic links";
+ op_pod_longdesc = "\
+Create symbolic link(s) in the guest, starting at C<LINK> and
+pointing at C<TARGET>.";
+ };
+ { op_name = "mkdir";
+ op_type = String "DIR";
+ op_discrim = "`Mkdir";
+ op_shortdesc = "Create a directory";
+ op_pod_longdesc = "\
+Create a directory in the guest.
+
+This uses S<C<mkdir -p>> so any intermediate directories are created,
+and it also works if the directory already exists.";
+ };
+ { op_name = "root-password";
+ op_type = PasswordSelector "SELECTOR";
+ op_discrim = "`RootPassword";
+ op_shortdesc = "Set root password";
+ op_pod_longdesc = "\
+Set the root password.
+
+See L<virt-builder(1)/USERS AND PASSWORDS> for the format of
+the C<SELECTOR> field, and also how to set up user accounts.
+
+Note: In virt-builder, if you I<don't> set I<--root-password>
+then the guest is given a I<random> root password.";
+ };
+ { op_name = "run";
+ op_type = String "SCRIPT";
+ op_discrim = "`Script";
+ op_shortdesc = "Run script in disk image";
+ op_pod_longdesc = "\
+Run the shell script (or any program) called C<SCRIPT> on the disk
+image. The script runs virtualized inside a small appliance, chrooted
+into the guest filesystem.
+
+The script is automatically chmod +x.
+
+If libguestfs supports it then a limited network connection is
+available but it only allows outgoing network connections. You can
+also attach data disks (eg. ISO files) as another way to provide data
+(eg. software packages) to the script without needing a network
+connection (I<--attach>). You can also upload data files (I<--upload>).
+
+You can have multiple I<--run> options. They run
+in the same order that they appear on the command line.
+
+See also: I<--firstboot>, I<--attach>, I<--upload>.";
+ };
+ { op_name = "run-command";
+ op_type = String "'CMD ARGS'";
+ op_discrim = "`Command";
+ op_shortdesc = "Run command in disk image";
+ op_pod_longdesc = "\
+Run the command and arguments on the disk image. The command runs
+virtualized inside a small appliance, chrooted into the guest filesystem.
+
+If libguestfs supports it then a limited network connection is
+available but it only allows outgoing network connections. You can
+also attach data disks (eg. ISO files) as another way to provide data
+(eg. software packages) to the script without needing a network
+connection (I<--attach>). You can also upload data files (I<--upload>).
+
+You can have multiple I<--run-command> options. They run
+in the same order that they appear on the command line.
+
+See also: I<--firstboot>, I<--attach>, I<--upload>.";
+ };
+ { op_name = "scrub";
+ op_type = String "FILE";
+ op_discrim = "`Scrub";
+ op_shortdesc = "Scrub a file" ;
+ op_pod_longdesc = "\
+Scrub a file from the guest. This is like I<--delete> except that:
+
+=over 4
+
+=item *
+
+It scrubs the data so a guest could not recover it.
+
+=item *
+
+It cannot delete directories, only regular files.
+
+=back";
+ };
+ { op_name = "timezone";
+ op_type = String "TIMEZONE";
+ op_discrim = "`Timezone";
+ op_shortdesc = "Set the default timezone";
+ op_pod_longdesc = "\
+Set the default timezone of the guest to C<TIMEZONE>. Use a location
+string like C<Europe/London>";
+ };
+ { op_name = "update";
+ op_type = Unit;
+ op_discrim = "`Update";
+ op_shortdesc = "Update core packages";
+ op_pod_longdesc = "\
+Do the equivalent of C<yum update>, C<apt-get upgrade>, or whatever
+command is required to update the packages already installed in the
+template to their latest versions.
+
+See also I<--install>.";
+ };
+ { op_name = "upload";
+ op_type = StringPair "FILE:DEST";
+ op_discrim = "`Upload";
+ op_shortdesc = "Upload local file to destination";
+ op_pod_longdesc = "\
+Upload local file C<FILE> to destination C<DEST> in the disk image.
+File owner and permissions from the original are preserved, so you
+should set them to what you want them to be in the disk image.
+
+C<DEST> could be the final filename. This can be used to rename
+the file on upload.
+
+If C<DEST> is a directory name (which must already exist in the guest)
+then the file is uploaded into that directory, and it keeps the same
+name as on the local filesystem.
+
+See also: I<--mkdir>, I<--delete>, I<--scrub>.";
+ };
+ { op_name = "write";
+ op_type = StringPair "FILE:CONTENT";
+ op_discrim = "`Write";
+ op_shortdesc = "Write file";
+ op_pod_longdesc = "\
+Write C<CONTENT> to C<FILE>.";
+ };
+]
+
+(* Flags. *)
+type flag = {
+ flag_name : string; (* argument name, without "--" *)
+ flag_type : flag_type; (* argument value type *)
+ flag_ml_var : string; (* variable name in OCaml code *)
+ flag_shortdesc : string; (* single-line description *)
+ flag_pod_longdesc : string; (* multi-line description *)
+}
+and flag_type =
+| FlagBool of bool (* boolean is the default value *)
+| FlagPasswordCrypto of string
+
+let flags = [
+ { flag_name = "no-logfile";
+ flag_type = FlagBool false;
+ flag_ml_var = "scrub_logfile";
+ flag_shortdesc = "Scrub build log file";
+ flag_pod_longdesc = "\
+Scrub C<builder.log> (log file from build commands) from the image
+after building is complete. If you don't want to reveal precisely how
+the image was built, use this option.
+
+See also: L</LOG FILE>.";
+ };
+ { flag_name = "password-crypto";
+ flag_type = FlagPasswordCrypto "md5|sha256|sha512";
+ flag_ml_var = "password_crypto";
+ flag_shortdesc = "Set password crypto";
+ flag_pod_longdesc = "\
+Set the password encryption to C<md5>, C<sha256> or C<sha512>.
+
+C<sha256> and C<sha512> require glibc E<ge> 2.7 (check crypt(3) inside
+the guest).
+
+C<md5> will work with relatively old Linux guests (eg. RHEL 3), but
+is not secure against modern attacks.
+
+The default is C<sha512> unless libguestfs detects an old guest that
+didn't have support for SHA-512, in which case it will use C<md5>.
+You can override libguestfs by specifying this option.";
+ };
+ { flag_name = "selinux-relabel";
+ flag_type = FlagBool false (* XXX - the default in virt-builder *);
+ flag_ml_var = "selinux_relabel";
+ flag_shortdesc = "Relabel files with correct SELinux labels";
+ flag_pod_longdesc = "\
+Relabel files in the guest so that they have the correct SELinux label.
+
+You should only use this option for guests which support SELinux.";
+ };
+]
+
+let rec generate_customize_cmdline_mli () =
+ generate_header OCamlStyle GPLv2plus;
+
+ pr "\
+(** Command line argument parsing, both for the virt-customize binary
+ and for the other tools that share the same code. *)
+
+";
+ generate_ops_struct_decl ();
+ pr "\n";
+
+ pr "val argspec : prog:string -> unit -> (Arg.key * Arg.spec * Arg.doc) list * (unit -> ops)\n"
+
+and generate_customize_cmdline_ml () =
+ generate_header OCamlStyle GPLv2plus;
+
+ pr "\
+(* Command line argument parsing, both for the virt-customize binary
+ * and for the other tools that share the same code.
+ *)
+
+open Printf
+
+open Common_utils
+open Common_gettext.Gettext
+
+";
+ generate_ops_struct_decl ();
+ pr "\n";
+
+ pr "\
+let rec argspec ~prog () =
+ let ops = ref [] in
+";
+ List.iter (
+ function
+ | { flag_type = FlagBool default; flag_ml_var = var } ->
+ pr " let %s = ref %b in\n" var default
+ | { flag_type = FlagPasswordCrypto _; flag_ml_var = var } ->
+ pr " let %s = ref None in\n" var
+ ) flags;
+ pr "\
+
+ let rec get_ops () = {
+ ops = List.rev !ops;
+ flags = get_flags ();
+ }
+ and get_flags () = {
+";
+ List.iter (fun { flag_ml_var = var } -> pr " %s = !%s;\n" var var) flags;
+ pr " }
+ in
+
+ let split_string_pair option_name arg =
+ 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
+ let len = String.length arg in
+ String.sub arg 0 i, String.sub arg (i+1) (len-(i+1))
+ in
+ let split_string_list arg =
+ string_nsplit \",\" arg
+ in
+ 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
+ | target :: lns -> target, lns
+ in
+
+ let argspec = [
+";
+
+ List.iter (
+ function
+ | { op_type = Unit; op_name = name; op_discrim = discrim;
+ op_shortdesc = shortdesc } ->
+ pr " \"--%s\",\n" name;
+ pr " Arg.Unit (fun () -> ops := %s :: !ops),\n" discrim;
+ pr " \" \" ^ s_\"%s\";\n" shortdesc
+ | { op_type = String v; op_name = name; op_discrim = discrim;
+ op_shortdesc = shortdesc } ->
+ pr " \"--%s\",\n" name;
+ pr " Arg.String (fun s -> ops := %s s :: !ops),\n" discrim;
+ pr " s_\"%s\" ^ \" \" ^ s_\"%s\";\n" v shortdesc
+ | { op_type = StringPair v; op_name = name; op_discrim = discrim;
+ op_shortdesc = shortdesc } ->
+ pr " \"--%s\",\n" name;
+ pr " Arg.String (fun s -> let p = split_string_pair \"%s\" s in ops := %s p :: !ops),\n" name discrim;
+ pr " s_\"%s\" ^ \" \" ^ s_\"%s\";\n" v shortdesc
+ | { op_type = StringList v; op_name = name; op_discrim = discrim;
+ op_shortdesc = shortdesc } ->
+ pr " \"--%s\",\n" name;
+ pr " Arg.String (fun s -> let ss = split_string_list s in ops := %s ss :: !ops),\n" discrim;
+ pr " s_\"%s\" ^ \" \" ^ s_\"%s\";\n" v shortdesc
+ | { op_type = TargetLinks v; op_name = name; op_discrim = discrim;
+ op_shortdesc = shortdesc } ->
+ pr " \"--%s\",\n" name;
+ pr " Arg.String (fun s -> let ss = split_links_list \"%s\" s in ops := %s ss :: !ops),\n" name discrim;
+ pr " s_\"%s\" ^ \" \" ^ s_\"%s\";\n" v shortdesc
+ | { op_type = PasswordSelector v; op_name = name; op_discrim = discrim;
+ op_shortdesc = shortdesc } ->
+ pr " \"--%s\",\n" name;
+ pr " Arg.String (fun s -> let sel = Password.parse_selector ~prog s in ops := %s sel :: !ops),\n" discrim;
+ pr " s_\"%s\" ^ \" \" ^ s_\"%s\";\n" v shortdesc
+ ) ops;
+
+ List.iter (
+ function
+ | { flag_type = FlagBool default; flag_ml_var = var; flag_name = name;
+ flag_shortdesc = shortdesc } ->
+ pr " \"--%s\",\n" name;
+ if default (* is true *) then
+ pr " Arg.Clear %s,\n" var
+ else
+ pr " Arg.Set %s,\n" var;
+ pr " \" \" ^ s_\"%s\";\n" shortdesc
+ | { flag_type = FlagPasswordCrypto v; flag_ml_var = var;
+ flag_name = name; flag_shortdesc = shortdesc } ->
+ pr " \"--%s\",\n" name;
+ pr " Arg.String (fun s -> %s := Some (Password.password_crypto_of_string ~prog s)),\n" var;
+ pr " \"%s\" ^ \" \" ^ s_\"%s\";\n" v shortdesc
+ ) flags;
+
+ pr "\
+ ] in
+
+ argspec, get_ops
+"
+
+and generate_ops_struct_decl () =
+ pr "\
+type ops = {
+ ops : op list;
+ flags : flags;
+}
+";
+
+ (* Operations. *)
+ pr "and op = [\n";
+ List.iter (
+ function
+ | { op_type = Unit; op_discrim = discrim; op_name = name } ->
+ pr " | %s\n (* --%s *)\n" discrim name
+ | { op_type = String v; op_discrim = discrim; op_name = name } ->
+ pr " | %s of string\n (* --%s %s *)\n" discrim name v
+ | { op_type = StringPair v; op_discrim = discrim;
+ op_name = name } ->
+ pr " | %s of string * string\n (* --%s %s *)\n" discrim name v
+ | { op_type = StringList v; op_discrim = discrim;
+ op_name = name } ->
+ pr " | %s of string list\n (* --%s %s *)\n" discrim name v
+ | { op_type = TargetLinks v; op_discrim = discrim;
+ op_name = name } ->
+ pr " | %s of string * string list\n (* --%s %s *)\n" discrim name v
+ | { op_type = PasswordSelector v; op_discrim = discrim;
+ op_name = name } ->
+ pr " | %s of Password.password_selector\n (* --%s %s *)\n"
+ discrim name v
+ ) ops;
+ pr "]\n";
+
+ (* Flags. *)
+ pr "and flags = {\n";
+ List.iter (
+ function
+ | { flag_type = FlagBool _; flag_ml_var = var; flag_name = name } ->
+ pr " %s : bool;\n (* --%s *)\n" var name
+ | { flag_type = FlagPasswordCrypto v; flag_ml_var = var;
+ flag_name = name } ->
+ pr " %s : Password.password_crypto option;\n (* --%s %s *)\n"
+ var name v
+ ) flags;
+ pr "}\n"
+
+let generate_customize_synopsis_pod () =
+ (* generate_header PODStyle GPLv2plus; - NOT POSSIBLE *)
+
+ let options =
+ List.map (
+ function
+ | { op_type = Unit; op_name = n } ->
+ n, sprintf "[--%s]" n
+ | { op_type = String v | StringPair v | StringList v | TargetLinks v
+ | PasswordSelector v;
+ op_name = n } ->
+ n, sprintf "[--%s %s]" n v
+ ) ops @
+ List.map (
+ function
+ | { flag_type = FlagBool _; flag_name = n } ->
+ n, sprintf "[--%s]" n
+ | { flag_type = FlagPasswordCrypto v; flag_name = n } ->
+ n, sprintf "[--%s %s]" n v
+ ) flags in
+
+ (* Print the option names in the synopsis, line-wrapped. *)
+ let col = ref 4 in
+ pr " ";
+
+ List.iter (
+ fun (_, str) ->
+ let len = String.length str + 1 in
+ col := !col + len;
+ if !col >= 72 then (
+ col := 4 + len;
+ pr "\n "
+ );
+ pr " %s" str
+ ) options;
+ if !col > 4 then
+ pr "\n"
+
+let generate_customize_options_pod () =
+ generate_header PODStyle GPLv2plus;
+
+ pr "=over 4\n\n";
+
+ let pod =
+ List.map (
+ function
+ | { op_type = Unit; op_name = n; op_pod_longdesc = ld } ->
+ n, sprintf "B<--%s>" n, ld
+ | { op_type = String v | StringPair v | StringList v | TargetLinks v
+ | PasswordSelector v;
+ op_name = n; op_pod_longdesc = ld } ->
+ n, sprintf "B<--%s> %s" n v, ld
+ ) ops @
+ List.map (
+ function
+ | { flag_type = FlagBool _; flag_name = n; flag_pod_longdesc = ld } ->
+ n, sprintf "B<--%s>" n, ld
+ | { flag_type = FlagPasswordCrypto v;
+ flag_name = n; flag_pod_longdesc = ld } ->
+ n, sprintf "B<--%s> %s" n v, ld
+ ) flags in
+ let pod = List.sort compare pod in
+
+ List.iter (
+ fun (_, item, longdesc) ->
+ pr "\
+=item %s
+
+%s
+
+" item longdesc
+ ) pod;
+
+ pr "=back\n\n"
diff --git a/generator/main.ml b/generator/main.ml
index d1fa4d2..63ddb9a 100644
--- a/generator/main.ml
+++ b/generator/main.ml
@@ -46,6 +46,7 @@ open Gobject
open Golang
open Bindtests
open Errnostring
+open Customize
let perror msg = function
| Unix_error (err, _, _) ->
@@ -208,6 +209,11 @@ Run it from the top source directory using the command
generate_gobject_session_header;
output_to "gobject/src/session.c" generate_gobject_session_source;
+ output_to "customize/customize_cmdline.mli" generate_customize_cmdline_mli;
+ output_to "customize/customize_cmdline.ml" generate_customize_cmdline_ml;
+ output_to "customize/customize-synopsis.pod" generate_customize_synopsis_pod;
+ output_to "customize/customize-options.pod" generate_customize_options_pod;
+
(* Generate the list of files generated -- last. *)
printf "generated %d lines of code\n" (get_lines_generated ());
let files = List.sort compare (get_files_generated ()) in
diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index e275213..fe215f8 100644
--- a/mllib/Makefile.am
+++ b/mllib/Makefile.am
@@ -28,37 +28,20 @@ SOURCES = \
common_utils.ml \
common_utils_tests.ml \
config.ml \
- crypt-c.c \
- crypt.ml \
- crypt.mli \
- firstboot.mli \
- firstboot.ml \
fsync-c.c \
fsync.mli \
fsync.ml \
mkdtemp.mli \
mkdtemp.ml \
mkdtemp-c.c \
- hostname.mli \
- hostname.ml \
- password.mli \
- password.ml \
- perl_edit.mli \
- perl_edit.ml \
planner.mli \
planner.ml \
progress-c.c \
progress.mli \
progress.ml \
- random_seed.mli \
- random_seed.ml \
- timezone.mli \
- timezone.ml \
tty-c.c \
tTY.mli \
tTY.ml \
- urandom.mli \
- urandom.ml \
uri-c.c \
uRI.mli \
uRI.ml
@@ -73,18 +56,10 @@ ocaml_modules = config \
libdir \
common_gettext \
common_utils \
- urandom \
- random_seed \
- hostname \
- timezone \
- firstboot \
- perl_edit \
tTY \
fsync \
progress \
uRI \
- crypt \
- password \
mkdtemp \
planner
@@ -95,7 +70,6 @@ OBJECTS = \
fsync-c.o \
progress-c.o \
uri-c.o \
- crypt-c.o \
mkdtemp-c.o
if HAVE_OCAMLOPT
diff --git a/mllib/crypt-c.c b/mllib/crypt-c.c
deleted file mode 100644
index 29a91e4..0000000
--- a/mllib/crypt-c.c
+++ /dev/null
@@ -1,44 +0,0 @@
-/* virt-sysprep - interface to crypt(3)
- * 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.
- */
-
-#include <config.h>
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <unistd.h>
-
-#include <caml/alloc.h>
-#include <caml/memory.h>
-#include <caml/mlvalues.h>
-
-value
-virt_sysprep_crypt (value keyv, value saltv)
-{
- CAMLparam2 (keyv, saltv);
- CAMLlocal1 (rv);
- char *r;
-
- /* Note that crypt returns a pointer to a statically allocated
- * buffer in glibc. For this and other reasons, this function
- * is not thread safe.
- */
- r = crypt (String_val (keyv), String_val (saltv));
- rv = caml_copy_string (r);
-
- CAMLreturn (rv);
-}
diff --git a/mllib/crypt.ml b/mllib/crypt.ml
deleted file mode 100644
index 2c48c0d..0000000
--- a/mllib/crypt.ml
+++ /dev/null
@@ -1,19 +0,0 @@
-(* virt-sysprep
- * 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.
- *)
-
-external crypt : string -> string -> string = "virt_sysprep_crypt"
diff --git a/mllib/crypt.mli b/mllib/crypt.mli
deleted file mode 100644
index ef4066f..0000000
--- a/mllib/crypt.mli
+++ /dev/null
@@ -1,22 +0,0 @@
-(* virt-sysprep
- * 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.
- *)
-
-(** Wrapper around glibc crypt(3) function. *)
-
-val crypt : string -> string -> string
-(** [crypt key salt] returns the password ([key]) encrypted. *)
diff --git a/mllib/firstboot.ml b/mllib/firstboot.ml
deleted file mode 100644
index 9e4c7b6..0000000
--- a/mllib/firstboot.ml
+++ /dev/null
@@ -1,171 +0,0 @@
-(* virt-sysprep
- * Copyright (C) 2012 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 Printf
-
-open Common_utils
-open Common_gettext.Gettext
-
-(* For Linux guests. *)
-let firstboot_dir = "/usr/lib/virt-sysprep"
-
-let firstboot_sh = sprintf "\
-#!/bin/sh -
-
-### BEGIN INIT INFO
-# Provides: virt-sysprep
-# Required-Start: $null
-# Should-Start: $all
-# Required-Stop: $null
-# Should-Stop: $all
-# Default-Start: 2 3 5
-# Default-Stop: 0 1 6
-# Short-Description: Start scripts to run once at next boot
-# Description: Start scripts to run once at next boot
-# These scripts run the first time the guest boots,
-# and then are deleted. Output or errors from the scripts
-# are written to ~root/virt-sysprep-firstboot.log.
-### END INIT INFO
-
-d=%s/scripts
-logfile=~root/virt-sysprep-firstboot.log
-
-echo \"$0\" \"$@\" 2>&1 | tee $logfile
-echo \"Scripts dir: $d\" 2>&1 | tee $logfile
-
-if test \"$1\" = \"start\"
-then
- for f in $d/* ; do
- if test -x \"$f\"
- then
- echo '=== Running' $f '===' 2>&1 | tee $logfile
- $f 2>&1 | tee $logfile
- rm -f $f
- fi
- done
-fi
-" firstboot_dir
-
-let firstboot_service = sprintf "\
-[Unit]
-Description=virt-sysprep firstboot service
-After=network.target
-Before=prefdm.service
-
-[Service]
-Type=oneshot
-ExecStart=%s/firstboot.sh start
-RemainAfterExit=yes
-StandardOutput=journal+console
-StandardError=inherit
-
-[Install]
-WantedBy=default.target
-" firstboot_dir
-
-let failed fs =
- ksprintf (fun msg -> failwith (s_"firstboot: failed: " ^ msg)) fs
-
-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;
- g#chmod 0o755 (sprintf "%s/firstboot.sh" firstboot_dir);
-
- (* Note we install both systemd and sysvinit services. This is
- * because init systems can be switched at runtime, and it's easy to
- * tell if systemd is installed (eg. Ubuntu uses upstart but installs
- * systemd configuration directories). There is no danger of a
- * firstboot script running twice because they disable themselves
- * after running.
- *)
- 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 g distro
-
-(* Install the systemd firstboot service, if not installed already. *)
-and install_systemd_service g =
- g#write (sprintf "%s/firstboot.service" firstboot_dir) firstboot_service;
- g#mkdir_p "/etc/systemd/system/default.target.wants";
- g#ln_sf (sprintf "%s/firstboot.service" firstboot_dir)
- "/etc/systemd/system/default.target.wants"
-
-and install_sysvinit_service g = function
- | "fedora"|"rhel"|"centos"|"scientificlinux"|"redhat-based" ->
- install_sysvinit_redhat g
- | "opensuse"|"sles"|"suse-based" ->
- install_sysvinit_suse g
- | "debian"|"ubuntu" ->
- install_sysvinit_debian g
- | distro ->
- failed "guest type %s is not supported" distro
-
-and install_sysvinit_redhat g =
- g#mkdir_p "/etc/rc.d/rc2.d";
- g#mkdir_p "/etc/rc.d/rc3.d";
- g#mkdir_p "/etc/rc.d/rc5.d";
- g#ln_sf (sprintf "%s/firstboot.sh" firstboot_dir)
- "/etc/rc.d/rc2.d/S99virt-sysprep-firstboot";
- g#ln_sf (sprintf "%s/firstboot.sh" firstboot_dir)
- "/etc/rc.d/rc3.d/S99virt-sysprep-firstboot";
- g#ln_sf (sprintf "%s/firstboot.sh" firstboot_dir)
- "/etc/rc.d/rc5.d/S99virt-sysprep-firstboot"
-
-(* Make firstboot.sh look like a runlevel script to avoid insserv warnings. *)
-and install_sysvinit_suse g =
- g#mkdir_p "/etc/init.d/rc2.d";
- g#mkdir_p "/etc/init.d/rc3.d";
- g#mkdir_p "/etc/init.d/rc5.d";
- g#ln_sf (sprintf "%s/firstboot.sh" firstboot_dir)
- "/etc/init.d/virt-sysprep-firstboot";
- g#ln_sf "../virt-sysprep-firstboot"
- "/etc/init.d/rc2.d/S99virt-sysprep-firstboot";
- g#ln_sf "../virt-sysprep-firstboot"
- "/etc/init.d/rc3.d/S99virt-sysprep-firstboot";
- g#ln_sf "../virt-sysprep-firstboot"
- "/etc/init.d/rc5.d/S99virt-sysprep-firstboot"
-
-and install_sysvinit_debian g =
- g#mkdir_p "/etc/init.d";
- g#mkdir_p "/etc/rc2.d";
- g#mkdir_p "/etc/rc3.d";
- g#mkdir_p "/etc/rc5.d";
- g#ln_sf (sprintf "%s/firstboot.sh" firstboot_dir)
- "/etc/init.d/virt-sysprep-firstboot";
- g#ln_sf "/etc/init.d/virt-sysprep-firstboot"
- "/etc/rc2.d/S99virt-sysprep-firstboot";
- g#ln_sf "/etc/init.d/virt-sysprep-firstboot"
- "/etc/rc3.d/S99virt-sysprep-firstboot";
- g#ln_sf "/etc/init.d/virt-sysprep-firstboot"
- "/etc/rc5.d/S99virt-sysprep-firstboot"
-
-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", _ ->
- 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" firstboot_dir i t r in
- g#write filename content;
- g#chmod 0o755 filename
-
- | _ ->
- failed "guest type %s/%s is not supported" typ distro
diff --git a/mllib/firstboot.mli b/mllib/firstboot.mli
deleted file mode 100644
index 4fb8812..0000000
--- a/mllib/firstboot.mli
+++ /dev/null
@@ -1,27 +0,0 @@
-(* virt-sysprep
- * Copyright (C) 2012 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 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.
-
- The scripts run in index ([idx]) order.
-
- You should make sure the filesystem is relabelled after calling this. *)
diff --git a/mllib/hostname.ml b/mllib/hostname.ml
deleted file mode 100644
index 70ca934..0000000
--- a/mllib/hostname.ml
+++ /dev/null
@@ -1,110 +0,0 @@
-(* virt-sysprep
- * Copyright (C) 2012-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
- * 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_utils
-
-open Printf
-
-let rec set_hostname (g : Guestfs.guestfs) root hostname =
- let typ = g#inspect_get_type root in
- let distro = g#inspect_get_distro root in
- let major_version = g#inspect_get_major_version root in
-
- match typ, distro, major_version with
- (* Fedora 18 (hence RHEL 7+) changed to using /etc/hostname
- * (RHBZ#881953, RHBZ#858696). We may also need to modify
- * /etc/machine-info (RHBZ#890027).
- *)
- | "linux", "fedora", v when v >= 18 ->
- update_etc_hostname g hostname;
- update_etc_machine_info g hostname;
- true
-
- | "linux", ("rhel"|"centos"|"scientificlinux"|"redhat-based"), v
- when v >= 7 ->
- update_etc_hostname g hostname;
- update_etc_machine_info g hostname;
- true
-
- | "linux", ("debian"|"ubuntu"), _ ->
- let old_hostname = read_etc_hostname g in
- update_etc_hostname g hostname;
- (match old_hostname with
- | Some old_hostname -> replace_host_in_etc_hosts g old_hostname hostname
- | None -> ()
- );
- true
-
- | "linux", ("fedora"|"rhel"|"centos"|"scientificlinux"|"redhat-based"), _ ->
- replace_line_in_file g "/etc/sysconfig/network" "HOSTNAME" hostname;
- true
-
- | "linux", ("opensuse"|"sles"|"suse-based"), _ ->
- g#write "/etc/HOSTNAME" hostname;
- true
-
- | _ ->
- false
-
-(* Replace <key>=... entry in file. The code assumes it's a small,
- * plain text file.
- *)
-and replace_line_in_file g filename key value =
- let content =
- if g#is_file filename then (
- let lines = Array.to_list (g#read_lines filename) in
- let lines = List.filter (
- fun line -> not (string_prefix line (key ^ "="))
- ) lines in
- let lines = lines @ [sprintf "%s=%s" key value] in
- String.concat "\n" lines ^ "\n"
- ) else (
- sprintf "%s=%s\n" key value
- ) in
- g#write filename content
-
-and update_etc_hostname g hostname =
- g#write "/etc/hostname" (hostname ^ "\n")
-
-and update_etc_machine_info g hostname =
- replace_line_in_file g "/etc/machine-info" "PRETTY_HOSTNAME" hostname
-
-and read_etc_hostname g =
- let filename = "/etc/hostname" in
- if g#is_file filename then (
- let lines = Array.to_list (g#read_lines filename) in
- match lines with
- | hd :: _ -> Some hd
- | [] -> None
- ) else
- None
-
-and replace_host_in_etc_hosts g oldhost newhost =
- if g#is_file "/etc/hosts" then (
- let expr = "/files/etc/hosts/*[label() != '#comment']/*[label() != 'ipaddr']" in
- g#aug_init "/" 0;
- let matches = Array.to_list (g#aug_match expr) in
- List.iter (
- fun m ->
- let value = g#aug_get m in
- if value = oldhost then (
- g#aug_set m newhost
- )
- ) matches;
- g#aug_save ()
- )
diff --git a/mllib/hostname.mli b/mllib/hostname.mli
deleted file mode 100644
index 15487f6..0000000
--- a/mllib/hostname.mli
+++ /dev/null
@@ -1,21 +0,0 @@
-(* virt-sysprep
- * Copyright (C) 2012-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
- * 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 set_hostname : Guestfs.guestfs -> string -> string -> bool
-(** Set the hostname in a guest. Returns true if it was able to
- do set it, false if not. *)
diff --git a/mllib/password.ml b/mllib/password.ml
deleted file mode 100644
index 6527138..0000000
--- a/mllib/password.ml
+++ /dev/null
@@ -1,175 +0,0 @@
-(* virt-sysprep
- * Copyright (C) 2012-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
- * 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
-
-type password_crypto = [`MD5 | `SHA256 | `SHA512 ]
-
-type password_selector = {
- pw_password : password;
- pw_locked : bool;
-}
-and password =
-| Password of string
-| Random_password
-| Disabled_password
-
-type password_map = (string, password_selector) Hashtbl.t
-
-let make_random_password =
- (* Get random characters from the set [A-Za-z0-9] with some
- * homoglyphs removed.
- *)
- let chars = "ABCDEFGHIJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz0123456789" in
- fun () -> Urandom.urandom_uniform 16 chars
-
-let password_crypto_of_string ~prog = 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
-
-let rec parse_selector ~prog arg =
- parse_selector_list ~prog arg (string_nsplit ":" arg)
-
-and parse_selector_list ~prog 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
- { pw with pw_locked = true }
- | [ "file"; filename ] ->
- { pw_password = Password (read_password_from_file filename);
- pw_locked = false }
- | "password" :: password ->
- { pw_password = Password (String.concat ":" password); pw_locked = false }
- | [ "random" ] ->
- { pw_password = Random_password; pw_locked = false }
- | [ "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
-
-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./"
-
-let rec set_linux_passwords ~prog ?password_crypto g root passwords =
- let crypto =
- match password_crypto with
- | None -> default_crypto g root
- | Some c -> c in
-
- (* XXX Would like to use Augeas here, but Augeas doesn't support
- * /etc/shadow (as of 1.1.0).
- *)
-
- let shadow = Array.to_list (g#read_lines "/etc/shadow") in
- let shadow =
- List.map (
- fun line ->
- try
- (* Each line is: "user:[!!]password:..."
- * !! at the front of the password field means the account is locked.
- * 'i' points to the first colon, 'j' to the second colon.
- *)
- let i = String.index line ':' in
- let user = String.sub line 0 i in
- let selector = Hashtbl.find passwords user in
- let j = String.index_from line (i+1) ':' in
- let rest = String.sub line j (String.length line - j) in
- let pwfield =
- match selector with
- | { pw_locked = locked;
- pw_password = Password password } ->
- if locked then "!!" else "" ^ encrypt password crypto
- | { 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;
- if locked then "!!" else "" ^ encrypt password crypto
- | { pw_locked = true; pw_password = Disabled_password } -> "!!*"
- | { pw_locked = false; pw_password = Disabled_password } -> "*" in
- user ^ ":" ^ pwfield ^ rest
- with Not_found -> line
- ) shadow in
-
- g#write "/etc/shadow" (String.concat "\n" shadow ^ "\n");
- (* In virt-sysprep /.autorelabel will label it correctly. *)
- g#chmod 0 "/etc/shadow"
-
-(* Encrypt each password. Use glibc (on the host). See:
- * https://rwmj.wordpress.com/2013/07/09/setting-the-root-or-other-passwords-in-a-linux-guest/
- *)
-and encrypt password crypto =
- (* Get random characters from the set [A-Za-z0-9./] *)
- let salt = Urandom.urandom_uniform 16 chars in
- let salt =
- (match crypto with
- | `MD5 -> "$1$"
- | `SHA256 -> "$5$"
- | `SHA512 -> "$6$") ^ salt ^ "$" in
- let r = Crypt.crypt password salt in
- (*printf "password: encrypt %s with salt %s -> %s\n" password salt r;*)
- r
-
-(* glibc 2.7 was released in Oct 2007. Approximately, all guests that
- * precede this date only support md5, whereas all guests after this
- * date can support sha512.
- *)
-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
- | ("rhel"|"centos"|"scientificlinux"|"redhat-based"), v when v >= 6 ->
- `SHA512
- | ("rhel"|"centos"|"scientificlinux"|"redhat-based"), _ ->
- `MD5 (* RHEL 5 does not appear to support SHA512, according to crypt(3) *)
-
- | "fedora", v when v >= 9 -> `SHA512
- | "fedora", _ -> `MD5
-
- | "debian", v when v >= 5 -> `SHA512
- | "debian", _ -> `MD5
-
- (* Very likely earlier versions of Ubuntu than 10.04 had new crypt,
- * but Ubuntu 10.04 is the earliest version I have checked.
- *)
- | "ubuntu", v when v >= 10 -> `SHA512
- | "ubuntu", _ -> `MD5
-
- | _, _ ->
- eprintf (f_"\
-virt-sysprep: password: warning: using insecure md5 password encryption for
-guest of type %s version %d.
-If this is incorrect, use --password-crypto option and file a bug.\n%!")
- distro major;
- `MD5
diff --git a/mllib/password.mli b/mllib/password.mli
deleted file mode 100644
index c662b1b..0000000
--- a/mllib/password.mli
+++ /dev/null
@@ -1,42 +0,0 @@
-(* virt-sysprep
- * Copyright (C) 2012-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
- * 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 password_crypto = [ `MD5 | `SHA256 | `SHA512 ]
-
-val password_crypto_of_string : prog:string -> string -> password_crypto
-(** Parse --password-crypto parameter on command line. *)
-
-type password_selector = {
- pw_password : password; (** The password. *)
- pw_locked : bool; (** If the account should be locked. *)
-}
-and password =
-| Password of string (** Password (literal string). *)
-| Random_password (** Choose a random password. *)
-| Disabled_password (** [*] in the password field. *)
-
-val parse_selector : prog:string -> 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
-(** Adjust the passwords of a Linux guest according to the
- password map. *)
diff --git a/mllib/perl_edit.ml b/mllib/perl_edit.ml
deleted file mode 100644
index 28e5dea..0000000
--- a/mllib/perl_edit.ml
+++ /dev/null
@@ -1,78 +0,0 @@
-(* 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. *)
- g#copy_attributes ~all:true 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
diff --git a/mllib/perl_edit.mli b/mllib/perl_edit.mli
deleted file mode 100644
index fd30dcc..0000000
--- a/mllib/perl_edit.mli
+++ /dev/null
@@ -1,19 +0,0 @@
-(* 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
diff --git a/mllib/random_seed.ml b/mllib/random_seed.ml
deleted file mode 100644
index 84236cd..0000000
--- a/mllib/random_seed.ml
+++ /dev/null
@@ -1,96 +0,0 @@
-(* virt-sysprep
- * Copyright (C) 2012-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
- * 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.
- *)
-
-(* It's important that we write a random seed if we possibly can.
- * Unfortunately some installers (hello, Debian) don't include the file
- * in the basic guest, so we have to work out where to create it.
- *)
-let rec set_random_seed (g : Guestfs.guestfs) root =
- let typ = g#inspect_get_type root in
- let created = ref false in
-
- if typ = "linux" then (
- let files = [
- "/var/lib/random-seed"; (* Fedora *)
- "/var/lib/urandom/random-seed"; (* Debian *)
- "/var/lib/misc/random-seed"; (* SuSE *)
- ] in
- List.iter (
- fun file ->
- if g#is_file file then (
- make_random_seed_file g file;
- created := true
- )
- ) files;
- );
-
- if not !created then (
- (* Backup plan: Try to create a new file. *)
-
- let distro = g#inspect_get_distro root in
- let file =
- match typ, distro with
- | "linux", ("fedora"|"rhel"|"centos"|"scientificlinux"|"redhat-based") ->
- Some "/var/lib/random-seed"
- | "linux", ("debian"|"ubuntu") ->
- Some "/var/lib/urandom/random-seed"
- | "linux", ("opensuse"|"sles"|"suse-based") ->
- Some "/var/lib/misc/random-seed"
- | _ ->
- None in
- match file with
- | Some file ->
- make_random_seed_file g file;
- created := true
- | None -> ()
- );
-
- !created
-
-and make_random_seed_file g file =
- let file_exists = g#is_file file in
- let n =
- if file_exists then (
- let n = Int64.to_int (g#filesize file) in
-
- (* This file is usually 512 bytes in size. However during
- * guest creation of some guests it can be just 8 bytes long.
- * Cap the file size to [512, 8192] bytes.
- *)
- min (max n 512) 8192
- )
- else
- (* Default to 512 bytes of randomness. *)
- 512 in
-
- (* Get n bytes of randomness from the host. *)
- let entropy = Urandom.urandom_bytes n in
-
- if file_exists then (
- (* Truncate the original file and append, in order to
- * preserve original permissions.
- *)
- g#truncate file;
- g#write_append file entropy
- )
- else (
- (* Create a new file, set the permissions restrictively. *)
- g#write file entropy;
- g#chown 0 0 file;
- g#chmod 0o600 file
- )
diff --git a/mllib/random_seed.mli b/mllib/random_seed.mli
deleted file mode 100644
index b5261f2..0000000
--- a/mllib/random_seed.mli
+++ /dev/null
@@ -1,21 +0,0 @@
-(* virt-sysprep
- * Copyright (C) 2012-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
- * 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 set_random_seed : Guestfs.guestfs -> string -> bool
-(** Set the random seed in the guest. Returns true if it was able to
- do set it, false if not. *)
diff --git a/mllib/timezone.ml b/mllib/timezone.ml
deleted file mode 100644
index 8b302d9..0000000
--- a/mllib/timezone.ml
+++ /dev/null
@@ -1,39 +0,0 @@
-(* Set timezone in virt-sysprep and virt-builder.
- * Copyright (C) 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
- * 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_utils
-
-open Printf
-
-let set_timezone ~prog (g : Guestfs.guestfs) root timezone =
- let typ = g#inspect_get_type root in
-
- match typ with
- (* Every known Linux has /etc/localtime be either a copy of or a
- * symlink to a timezone file in /usr/share/zoneinfo.
- * Even systemd didn't fuck this up.
- *)
- | "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;
- g#ln_sf target "/etc/localtime";
- true
-
- | _ ->
- false
diff --git a/mllib/timezone.mli b/mllib/timezone.mli
deleted file mode 100644
index ad0d4b2..0000000
--- a/mllib/timezone.mli
+++ /dev/null
@@ -1,22 +0,0 @@
-(* Set timezone in virt-sysprep and virt-builder.
- * Copyright (C) 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
- * 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 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. *)
diff --git a/mllib/urandom.ml b/mllib/urandom.ml
deleted file mode 100644
index 9b613e8..0000000
--- a/mllib/urandom.ml
+++ /dev/null
@@ -1,69 +0,0 @@
-(* Read /dev/urandom.
- * 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.
- *)
-
-(* Read and return N bytes (only) from /dev/urandom.
- *
- * As pointed out by Edwin Török, previous versions of this had a big
- * problem. They used the OCaml buffered I/O library which would read
- * a lot more data than requested. This version uses unbuffered I/O
- * from the Unix module.
- *)
-
-open Unix
-
-let open_urandom_fd () = openfile "/dev/urandom" [O_RDONLY] 0
-
-let read_byte fd =
- let s = String.make 1 ' ' in
- fun () ->
- if read fd s 0 1 = 0 then (
- close fd;
- raise End_of_file
- );
- Char.code s.[0]
-
-let urandom_bytes n =
- assert (n > 0);
- let ret = String.make n ' ' in
- let fd = open_urandom_fd () in
- for i = 0 to n-1 do
- ret.[i] <- Char.chr (read_byte fd ())
- done;
- close fd;
- ret
-
-(* Return a random number uniformly distributed in [0, upper_bound)
- * avoiding modulo bias.
- *)
-let rec uniform_random read upper_bound =
- let c = read () in
- if c >= 256 mod upper_bound then c mod upper_bound
- else uniform_random read upper_bound
-
-let urandom_uniform n chars =
- assert (n > 0);
- let nr_chars = String.length chars in
- assert (nr_chars > 0);
-
- let ret = String.make n ' ' in
- let fd = open_urandom_fd () in
- for i = 0 to n-1 do
- ret.[i] <- chars.[uniform_random (read_byte fd) nr_chars]
- done;
- close fd;
- ret
diff --git a/mllib/urandom.mli b/mllib/urandom.mli
deleted file mode 100644
index ffc77dd..0000000
--- a/mllib/urandom.mli
+++ /dev/null
@@ -1,26 +0,0 @@
-(* Read /dev/urandom.
- * 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.
- *)
-
-(** Read and return N bytes (only) from /dev/urandom. *)
-
-val urandom_bytes : int -> string
-(** Read N bytes from /dev/urandom and return it as a binary string. *)
-
-val urandom_uniform : int -> string -> string
-(** [urandom_uniform n chars] returns [n] bytes, uniformly
- distributed from the sets of characters [chars]. *)
diff --git a/po-docs/ja/Makefile.am b/po-docs/ja/Makefile.am
index e954f04..f17be96 100644
--- a/po-docs/ja/Makefile.am
+++ b/po-docs/ja/Makefile.am
@@ -107,6 +107,15 @@ guestfish.1: guestfish.pod guestfish-actions.pod guestfish-commands.pod guestfis
--insert $(srcdir)/guestfish-prepopts.pod:__PREPOPTS__ \
$<
+virt-builder.1: virt-builder.pod customize-synopsis.pod customize-options.pod
+ $(PODWRAPPER) \
+ --no-strict-checks \
+ --man $@ \
+ --license GPLv2+ \
+ --insert $(srcdir)/customize-synopsis.pod:__CUSTOMIZE_SYNOPSIS__ \
+ --insert $(srcdir)/customize-options.pod:__CUSTOMIZE_OPTIONS__ \
+ $<
+
virt-sysprep.1: virt-sysprep.pod sysprep-extra-options.pod sysprep-operations.pod
$(PODWRAPPER) \
--no-strict-checks \
diff --git a/po-docs/podfiles b/po-docs/podfiles
index d863554..802f18e 100644
--- a/po-docs/podfiles
+++ b/po-docs/podfiles
@@ -5,6 +5,8 @@
../cat/virt-cat.pod
../cat/virt-filesystems.pod
../cat/virt-ls.pod
+../customize/customize-options.pod
+../customize/customize-synopsis.pod
../daemon/guestfsd.pod
../df/virt-df.pod
../diff/virt-diff.pod
diff --git a/po-docs/uk/Makefile.am b/po-docs/uk/Makefile.am
index e954f04..f17be96 100644
--- a/po-docs/uk/Makefile.am
+++ b/po-docs/uk/Makefile.am
@@ -107,6 +107,15 @@ guestfish.1: guestfish.pod guestfish-actions.pod guestfish-commands.pod guestfis
--insert $(srcdir)/guestfish-prepopts.pod:__PREPOPTS__ \
$<
+virt-builder.1: virt-builder.pod customize-synopsis.pod customize-options.pod
+ $(PODWRAPPER) \
+ --no-strict-checks \
+ --man $@ \
+ --license GPLv2+ \
+ --insert $(srcdir)/customize-synopsis.pod:__CUSTOMIZE_SYNOPSIS__ \
+ --insert $(srcdir)/customize-options.pod:__CUSTOMIZE_OPTIONS__ \
+ $<
+
virt-sysprep.1: virt-sysprep.pod sysprep-extra-options.pod sysprep-operations.pod
$(PODWRAPPER) \
--no-strict-checks \
diff --git a/po/POTFILES b/po/POTFILES
index ecdbae4..37dbbaa 100644
--- a/po/POTFILES
+++ b/po/POTFILES
@@ -11,6 +11,7 @@ cat/cat.c
cat/filesystems.c
cat/ls.c
cat/visit.c
+customize/crypt-c.c
daemon/9p.c
daemon/acl.c
daemon/augeas.c
@@ -239,7 +240,6 @@ inspector/inspector.c
java/com_redhat_et_libguestfs_GuestFS.c
lua/lua-guestfs.c
make-fs/make-fs.c
-mllib/crypt-c.c
mllib/fsync-c.c
mllib/mkdtemp-c.c
mllib/progress-c.c
diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index ed96697..3870f3d 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -17,21 +17,13 @@ mllib/common_gettext.ml
mllib/common_utils.ml
mllib/common_utils_tests.ml
mllib/config.ml
-mllib/crypt.ml
-mllib/firstboot.ml
mllib/fsync.ml
-mllib/hostname.ml
mllib/libdir.ml
mllib/mkdtemp.ml
-mllib/password.ml
-mllib/perl_edit.ml
mllib/planner.ml
mllib/progress.ml
-mllib/random_seed.ml
mllib/tTY.ml
-mllib/timezone.ml
mllib/uRI.ml
-mllib/urandom.ml
resize/resize.ml
sparsify/cmdline.ml
sparsify/copying.ml
diff --git a/src/guestfs.pod b/src/guestfs.pod
index b3c32eb..e6e91f4 100644
--- a/src/guestfs.pod
+++ b/src/guestfs.pod
@@ -4272,6 +4272,10 @@ and documentation.
Outside contributions, experimental parts.
+=item C<customize>
+
+virt-customize mini-library.
+
=item C<daemon>
The daemon that runs inside the libguestfs appliance and carries out
diff --git a/sysprep/Makefile.am b/sysprep/Makefile.am
index d20ad08..1bff338 100644
--- a/sysprep/Makefile.am
+++ b/sysprep/Makefile.am
@@ -88,20 +88,20 @@ if HAVE_OCAML
deps = \
$(top_builddir)/mllib/common_gettext.cmx \
$(top_builddir)/mllib/common_utils.cmx \
- $(top_builddir)/fish/guestfish-uri.o \
$(top_builddir)/mllib/uri-c.o \
$(top_builddir)/mllib/uRI.cmx \
- $(top_builddir)/mllib/crypt-c.o \
- $(top_builddir)/mllib/crypt.cmx \
- $(top_builddir)/mllib/urandom.cmx \
- $(top_builddir)/mllib/password.cmx \
- $(top_builddir)/mllib/random_seed.cmx \
- $(top_builddir)/mllib/hostname.cmx \
- $(top_builddir)/mllib/timezone.cmx \
- $(top_builddir)/mllib/firstboot.cmx \
$(top_builddir)/mllib/config.cmx \
$(top_builddir)/mllib/mkdtemp-c.o \
$(top_builddir)/mllib/mkdtemp.cmx \
+ $(top_builddir)/customize/crypt-c.o \
+ $(top_builddir)/customize/crypt.cmx \
+ $(top_builddir)/customize/urandom.cmx \
+ $(top_builddir)/customize/password.cmx \
+ $(top_builddir)/customize/random_seed.cmx \
+ $(top_builddir)/customize/hostname.cmx \
+ $(top_builddir)/customize/timezone.cmx \
+ $(top_builddir)/customize/firstboot.cmx \
+ $(top_builddir)/fish/guestfish-uri.o \
sysprep_operation.cmx \
$(patsubst %,sysprep_operation_%.cmx,$(operations)) \
main.cmx
@@ -121,7 +121,8 @@ OCAMLPACKAGES = \
-package str,unix \
-I $(top_builddir)/src/.libs \
-I $(top_builddir)/ocaml \
- -I $(top_builddir)/mllib
+ -I $(top_builddir)/mllib \
+ -I $(top_builddir)/customize
if HAVE_OCAML_PKG_GETTEXT
OCAMLPACKAGES += -package gettext-stub
endif
@@ -225,7 +226,7 @@ depend: .depend
.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
rm -f $@ $@-t
- $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib $^ | \
+ $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize $^ | \
$(SED) 's/ *$$//' | \
$(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
$(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
--
1.8.5.3
More information about the Libguestfs
mailing list