When visiting the modules we need to copy into the initrd, use a simplier StringSet instead of a Hashtbl with bool values; this also avoids the need for a separate variable with the number of modules visited. --- src/ext2_initrd.ml | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/ext2_initrd.ml b/src/ext2_initrd.ml index 09536d3..63ed493 100644 --- a/src/ext2_initrd.ml +++ b/src/ext2_initrd.ml @@ -82,14 +82,13 @@ let rec build_initrd debug tmpdir modpath initrd = (* Do depth-first search to locate the modules we need to load. Keep * track of which modules we've added so we don't add them twice. *) - let visited = Hashtbl.create 13 in - let loaded = ref 0 in + let visited = ref StringSet.empty in let chan = open_out (initdir // "modules") in let rec visit set = StringSet.iter ( fun modl -> - if not (Hashtbl.mem visited modl) then ( - Hashtbl.add visited modl true; + if not (StringSet.mem modl !visited) then ( + visited := StringSet.add modl !visited; if debug >= 2 then printf "supermin: ext2: initrd: visiting module %s\n%!" modl; @@ -141,7 +140,6 @@ let rec build_initrd debug tmpdir modpath initrd = (* Write module name to 'modules' file. *) fprintf chan "%s\n" basename; - incr loaded ) ) set in @@ -149,7 +147,7 @@ let rec build_initrd debug tmpdir modpath initrd = close_out chan; if debug >= 1 then - printf "supermin: ext2: wrote %d modules to minimal initrd\n%!" !loaded; + printf "supermin: ext2: wrote %d modules to minimal initrd\n%!" (StringSet.cardinal !visited); (* This is the binary blob containing the init "script". *) let init = binary_init () in -- 2.5.0

Simplier version of what is implemented in Common_utils in libguestfs, only adding the application prefix and handling the exit. --- src/build.ml | 20 +++++----------- src/dpkg.ml | 4 +--- src/kernel.ml | 27 ++++++++++------------ src/package_handler.ml | 7 +++--- src/pacman.ml | 6 ++--- src/prepare.ml | 12 ++++------ src/rpm.ml | 33 ++++++++------------------- src/supermin.ml | 62 +++++++++++++++++++------------------------------- src/utils.ml | 36 ++++++++++++++--------------- src/utils.mli | 3 +++ 10 files changed, 81 insertions(+), 129 deletions(-) diff --git a/src/build.ml b/src/build.ml index 4675454..e34ec5f 100644 --- a/src/build.ml +++ b/src/build.ml @@ -65,10 +65,8 @@ let rec build debug if debug >= 1 then printf "supermin: build: %s\n%!" (String.concat " " inputs); - if inputs = [] then ( - eprintf "supermin: build: no input supermin appliance specified\n"; - exit 1; - ); + if inputs = [] then + error "build: no input supermin appliance specified"; (* When base images are seen, they are unpacked into this temporary * directory. But to speed things up, when we are building a chroot, @@ -297,10 +295,8 @@ and update_appliance appliance lines = function let lines = List.map ( fun path -> let n = String.length path in - if n < 1 || path.[0] <> '-' then ( - eprintf "supermin: excludefiles line does not start with '-'\n"; - exit 1 - ); + if n < 1 || path.[0] <> '-' then + error "excludefiles line does not start with '-'"; String.sub path 1 (n-1) ) lines in { appliance with excludefiles = appliance.excludefiles @ lines } @@ -335,16 +331,12 @@ and get_file_content file buf len = (* However we intend to support them in future for both input * and output. *) - eprintf "supermin: %s: cpio files are not supported in this version of supermin\n" file; - exit 1 + error "%s: cpio files are not supported in this version of supermin" file; ) else if len >= 2 && buf.[0] = '/' then Hostfiles else if len >= 2 && buf.[0] = '-' then Excludefiles else if len >= 1 && isalnum buf.[0] then Packages - else ( - eprintf "supermin: %s: unknown file type in supermin directory\n" file; - exit 1 - ) + else error "%s: unknown file type in supermin directory" file and get_compressed_file_content zcat file = let cmd = sprintf "%s %s" zcat (quote file) in diff --git a/src/dpkg.ml b/src/dpkg.ml index ddfb03a..70acfa2 100644 --- a/src/dpkg.ml +++ b/src/dpkg.ml @@ -39,9 +39,7 @@ let dpkg_init s = let cmd = sprintf "%s --print-architecture" Config.dpkg in let lines = run_command_get_lines cmd in match lines with - | [] -> - eprintf "supermin: dpkg: expecting %s to return some output\n" cmd; - exit 1 + | [] -> error "dpkg: expecting %s to return some output" cmd | arch :: _ -> dpkg_primary_arch := arch type dpkg_t = { diff --git a/src/kernel.ml b/src/kernel.ml index 046cde9..356ac4b 100644 --- a/src/kernel.ml +++ b/src/kernel.ml @@ -128,16 +128,15 @@ and kernel_filter patterns is_arm all_files = List.filter (fun filename -> has_modpath filename) files and no_kernels host_cpu = - eprintf "\ -supermin: failed to find a suitable kernel (host_cpu=%s). + error "\ +failed to find a suitable kernel (host_cpu=%s). I looked for kernels in /boot and modules in /lib/modules. If this is a Xen guest, and you only have Xen domU kernels installed, try installing a fullvirt kernel (only for -supermin use, you shouldn't boot the Xen guest with it).\n" - host_cpu; - exit 1 +supermin use, you shouldn't boot the Xen guest with it)." + host_cpu and find_dtb debug copy_kernel kernel_name wildcard dtb = let dtb_file = @@ -180,27 +179,25 @@ and find_dtb debug copy_kernel kernel_name wildcard dtb = copy_or_symlink_file copy_kernel dtb_file dtb and no_dtb_dir kernel_name = - eprintf "\ -supermin: failed to find a dtb (device tree) directory. + error "\ +failed to find a dtb (device tree) directory. I expected to take '%s' and to replace vmlinuz- with dtb- to form a directory. You can set SUPERMIN_KERNEL, SUPERMIN_MODULES and SUPERMIN_DTB -to override automatic selection. See supermin(1).\n" - kernel_name; - exit 1 +to override automatic selection. See supermin(1)." + kernel_name and no_dtb dtb_dir wildcard = - eprintf "\ -supermin: failed to find a matching device tree. + error "\ +failed to find a matching device tree. I looked for a file matching '%s' in directory '%s'. You can set SUPERMIN_KERNEL, SUPERMIN_MODULES and SUPERMIN_DTB -to override automatic selection. See supermin(1).\n" - wildcard dtb_dir; - exit 1 +to override automatic selection. See supermin(1)." + wildcard dtb_dir and find_modpath debug kernel_version = try diff --git a/src/package_handler.ml b/src/package_handler.ml index 64b8f66..0409438 100644 --- a/src/package_handler.ml +++ b/src/package_handler.ml @@ -116,8 +116,8 @@ let check_system settings = handler := Some h; ph.ph_init settings with Not_found -> - eprintf "\ -supermin: could not detect package manager used by this system or distro. + error "\ +could not detect package manager used by this system or distro. If this is a new Linux distro, or not Linux, or a Linux distro that uses an unusual packaging format then you may need to port supermin. If @@ -128,8 +128,7 @@ To list which package handlers are compiled into this version of supermin, do: supermin --list-drivers -"; - exit 1 +" let rec get_package_handler () = match !handler with diff --git a/src/pacman.ml b/src/pacman.ml index 45fb393..3340fa6 100644 --- a/src/pacman.ml +++ b/src/pacman.ml @@ -66,10 +66,8 @@ let pacman_package_of_string str = ) lines; let name = !name and evr = !evr and arch = !arch in - if name = "" || evr = "" || arch = "" then ( - eprintf "supermin: pacman: Name/Version/Architecture field missing in output of %s\n" cmd; - exit 1 - ); + if name = "" || evr = "" || arch = "" then + error "pacman: Name/Version/Architecture field missing in output of %s" cmd; (* Parse epoch:version-release field. *) let epoch, version, release = diff --git a/src/prepare.ml b/src/prepare.ml index 8193f36..830b620 100644 --- a/src/prepare.ml +++ b/src/prepare.ml @@ -28,10 +28,8 @@ let prepare debug (copy_kernel, dtb_wildcard, format, host_cpu, if debug >= 1 then printf "supermin: prepare: %s\n%!" (String.concat " " inputs); - if inputs = [] then ( - eprintf "supermin: prepare: no input packages specified\n"; - exit 1; - ); + if inputs = [] then + error "prepare: no input packages specified"; let ph = get_package_handler () in @@ -40,10 +38,8 @@ let prepare debug (copy_kernel, dtb_wildcard, format, host_cpu, * filter_map will return only packages which are installed. *) let packages = filter_map ph.ph_package_of_string inputs in - if packages = [] then ( - eprintf "supermin: prepare: none of the packages listed on the command line seem to be installed\n"; - exit 1; - ); + if packages = [] then + error "prepare: none of the packages listed on the command line seem to be installed"; if debug >= 1 then ( printf "supermin: packages specified on the command line:\n"; diff --git a/src/rpm.ml b/src/rpm.ml index cf6341c..a5dc67a 100644 --- a/src/rpm.ml +++ b/src/rpm.ml @@ -61,9 +61,7 @@ let t = ref None let get_rpm () = match !t with - | None -> - eprintf "supermin: rpm: get_rpm called too early"; - exit 1 + | None -> error "rpm: get_rpm called too early" | Some t -> t let rec rpm_init s = @@ -75,17 +73,12 @@ let rec rpm_init s = let version = rpm_version () in let major, minor = match string_split "." version with - | [] -> - eprintf "supermin: unable to parse empty rpm version string\n"; - exit 1 - | [x] -> - eprintf "supermin: unable to parse rpm version string: %s\n" x; - exit 1 + | [] -> error "unable to parse empty rpm version string" + | [x] -> error "unable to parse rpm version string: %s" x | major :: minor :: _ -> try int_of_string major, int_of_string minor with Failure "int_of_string" -> - eprintf "supermin: unable to parse rpm version string: non-numeric, %s\n" version; - exit 1 in + error "unable to parse rpm version string: non-numeric, %s" version in rpm_major := major; rpm_minor := minor; if !settings.debug >= 1 then @@ -103,28 +96,20 @@ and opensuse_init s = let lines = run_command_get_lines cmd in let major, minor, patch = match lines with - | [] -> - eprintf "supermin: zypper --version command had no output\n"; - exit 1 + | [] -> error "zypper --version command had no output" | line :: _ -> let line = string_split "." line in match line with - | [] -> - eprintf "supermin: unable to parse empty output of zypper --version\n"; - exit 1 - | [x] -> - eprintf "supermin: unable to parse output of zypper --version: %s\n" x; - exit 1 + | [] -> error "unable to parse empty output of zypper --version" + | [x] -> error "unable to parse output of zypper --version: %s" x | major :: minor :: [] -> (try int_of_string major, int_of_string minor, 0 with Failure "int_of_string" -> - eprintf "supermin: unable to parse output of zypper --version: non-numeric\n"; - exit 1) + error "unable to parse output of zypper --version: non-numeric") | major :: minor :: patch :: _ -> (try int_of_string major, int_of_string minor, int_of_string patch with Failure "int_of_string" -> - eprintf "supermin: unable to parse output of zypper --version: non-numeric\n"; - exit 1) in + error "unable to parse output of zypper --version: non-numeric") in zypper_major := major; zypper_minor := minor; zypper_patch := patch; diff --git a/src/supermin.ml b/src/supermin.ml index bbb1dba..b0532e5 100644 --- a/src/supermin.ml +++ b/src/supermin.ml @@ -54,10 +54,8 @@ let main () = * This is untested and will break in some way or another later, so * better to die now with a meaningful error message. *) - if try Filename.is_relative (getenv "TMPDIR") with Not_found -> false then ( - eprintf "supermin: error: environment variable $TMPDIR must be an absolute path\n"; - exit 1 - ); + if try Filename.is_relative (getenv "TMPDIR") with Not_found -> false then + error "error: environment variable $TMPDIR must be an absolute path"; (* Create a temporary directory for scratch storage. *) let tmpdir = @@ -102,9 +100,7 @@ let main () = let set_format = function | "chroot" | "fs" | "filesystem" -> format := Some Chroot | "ext2" -> format := Some Ext2 - | s -> - eprintf "supermin: unknown --format option (%s)\n" s; - exit 1 + | s -> error "unknown --format option (%s)\n" s in let rec set_prepare_mode () = @@ -116,20 +112,19 @@ let main () = bad_mode (); mode := Some Build and bad_mode () = - eprintf "supermin: you must use --prepare or --build to select the mode\n"; - exit 1 + error "you must use --prepare or --build to select the mode" in let set_size arg = size := Some (parse_size arg) in let error_supermin_5 () = - eprintf "supermin: *** error: This is supermin version 5.\n"; - eprintf "supermin: *** It looks like you are looking for supermin version 4.\n"; - eprintf "\n"; - eprintf "This version of supermin will not work. You need to find the old version\n"; - eprintf "or upgrade to libguestfs >= 1.26.\n"; - eprintf "\n"; - exit 1 + error "\ +*** error: This is supermin version 5. +supermin: *** It looks like you are looking for supermin version 4. + +This version of supermin will not work. You need to find the old version +or upgrade to libguestfs >= 1.26. +" in let ditto = " -\"-" in @@ -178,18 +173,14 @@ let main () = let format = match mode, !format with | Prepare, Some _ -> - eprintf "supermin: cannot use --prepare and --format options together\n"; - exit 1 + error "cannot use --prepare and --format options together" | Prepare, None -> Chroot (* doesn't matter, prepare doesn't use this *) | Build, None -> - eprintf "supermin: when using --build, you must specify an output --format\n"; - exit 1 + error "when using --build, you must specify an output --format" | Build, Some f -> f in - if outputdir = "" then ( - eprintf "supermin: output directory (-o option) must be supplied\n"; - exit 1 - ); + if outputdir = "" then + error "supermin: output directory (-o option) must be supplied"; (* Chop final '/' in output directory (RHBZ#1146753). *) let outputdir = let len = String.length outputdir in @@ -293,24 +284,17 @@ let () = try main () with | Unix.Unix_error (code, fname, "") -> (* from a syscall *) - eprintf "supermin: error: %s: %s\n" fname (Unix.error_message code); - exit 1 + error "error: %s: %s" fname (Unix.error_message code) | Unix.Unix_error (code, fname, param) -> (* from a syscall *) - eprintf "supermin: error: %s: %s: %s\n" fname (Unix.error_message code) - param; - exit 1 + error "error: %s: %s: %s" fname (Unix.error_message code) param | Failure msg -> (* from failwith/failwithf *) - eprintf "supermin: failure: %s\n" msg; - exit 1 + error "failure: %s" msg | Invalid_argument msg -> (* probably should never happen *) - eprintf "supermin: internal error: invalid argument: %s\n" msg; - exit 1 + error "internal error: invalid argument: %s" msg | Assert_failure (file, line, char) -> (* should never happen *) - eprintf "supermin: internal error: assertion failed at %s, line %d, char %d\n" file line char; - exit 1 + error "internal error: assertion failed at %s, line %d, char %d" + file line char | Not_found -> (* should never happen *) - eprintf "supermin: internal error: Not_found exception was thrown\n"; - exit 1 + error "internal error: Not_found exception was thrown" | exn -> (* something not matched above *) - eprintf "supermin: exception: %s\n" (Printexc.to_string exn); - exit 1 + error "exception: %s" (Printexc.to_string exn) diff --git a/src/utils.ml b/src/utils.ml index 87c9cf7..4223be4 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -28,6 +28,13 @@ let (//) = Filename.concat let quote = Filename.quote let quoted_list names = String.concat " " (List.map quote names) +let error ?(exit_code = 1) fs = + let display str = + prerr_endline (sprintf "supermin: %s" str); + exit exit_code + in + ksprintf display fs + let dir_exists name = try (stat name).st_kind = S_DIR with Unix_error _ -> false @@ -59,31 +66,25 @@ let run_command_get_lines cmd = (match stat with | WEXITED 0 -> () | WEXITED i -> - eprintf "supermin: command '%s' failed (returned %d), see earlier error messages\n" cmd i; - exit i + error ~exit_code:i "command '%s' failed (returned %d), see earlier error messages" + cmd i | WSIGNALED i -> - eprintf "supermin: command '%s' killed by signal %d" cmd i; - exit 1 + error "command '%s' killed by signal %d" cmd i | WSTOPPED i -> - eprintf "supermin: command '%s' stopped by signal %d" cmd i; - exit 1 + error "command '%s' stopped by signal %d" cmd i ); lines let run_command cmd = - if Sys.command cmd <> 0 then ( - eprintf "supermin: %s: command failed, see earlier errors\n" cmd; - exit 1 - ) + if Sys.command cmd <> 0 then + error "%s: command failed, see earlier errors" cmd let run_shell code args = let cmd = sprintf "sh -c %s arg0 %s" (Filename.quote code) (String.concat " " (List.map Filename.quote args)) in - if Sys.command cmd <> 0 then ( - eprintf "supermin: external shell program failed, see earlier error messages\n"; - exit 1 - ) + if Sys.command cmd <> 0 then + error "external shell program failed, see earlier error messages" let rec find s sub = let len = String.length s in @@ -191,8 +192,8 @@ let compare_architecture a1 a2 = | "s390x" -> 64 | "alpha" -> 64 | a -> - eprintf "supermin: missing support for architecture '%s'\nIt may need to be added to supermin.\n" a; - exit 1 + error "missing support for architecture '%s'\nIt may need to be added to supermin." + a in compare (index_of_architecture a1) (index_of_architecture a2) @@ -213,6 +214,5 @@ let parse_size = if matches const_re then ( size_scaled (float_of_string (sub 1)) (sub 2) ) else ( - eprintf "supermin: cannot parse size field '%s'\n" field; - exit 1 + error "cannot parse size field '%s'" field ) diff --git a/src/utils.mli b/src/utils.mli index 1a7687a..c5e931b 100644 --- a/src/utils.mli +++ b/src/utils.mli @@ -24,6 +24,9 @@ val ( *^ ) : int64 -> int64 -> int64 val (/^) : int64 -> int64 -> int64 (** Int64 operators. *) +val error : ?exit_code:int -> ('a, unit, string, 'b) format4 -> 'a +(** Standard error function. *) + val dir_exists : string -> bool (** Return [true] iff dir exists. *) -- 2.5.0