Previously callbacks would return a list of flags, such as [] or [`Created_files]. In this commit we introduce two new objects, filesystem_side_effects and device_side_effects (the latter is not used yet). The callbacks that create files now need to call side_effects#created_file () instead of returning flags. There is no functional change in this patch. --- sysprep/main.ml | 28 +++++----- sysprep/sysprep_operation.ml | 59 ++++++++++++---------- sysprep/sysprep_operation.mli | 29 +++++++---- sysprep/sysprep_operation_abrt_data.ml | 6 +-- sysprep/sysprep_operation_bash_history.ml | 4 +- sysprep/sysprep_operation_blkid_tab.ml | 7 +-- sysprep/sysprep_operation_ca_certificates.ml | 7 +-- sysprep/sysprep_operation_crash_data.ml | 5 +- sysprep/sysprep_operation_cron_spool.ml | 5 +- sysprep/sysprep_operation_delete.ml | 5 +- sysprep/sysprep_operation_dhcp_client_state.ml | 5 +- sysprep/sysprep_operation_dhcp_server_state.ml | 5 +- sysprep/sysprep_operation_dovecot_data.ml | 6 +-- sysprep/sysprep_operation_firewall_rules.ml | 7 +-- sysprep/sysprep_operation_firstboot.ml | 8 +-- sysprep/sysprep_operation_flag_reconfiguration.ml | 5 +- sysprep/sysprep_operation_fs_uuids.ml | 5 +- sysprep/sysprep_operation_hostname.ml | 5 +- sysprep/sysprep_operation_kerberos_data.ml | 7 +-- sysprep/sysprep_operation_logfiles.ml | 5 +- sysprep/sysprep_operation_lvm_uuids.ml | 5 +- sysprep/sysprep_operation_machine_id.ml | 9 ++-- sysprep/sysprep_operation_mail_spool.ml | 5 +- sysprep/sysprep_operation_net_hostname.ml | 9 ++-- sysprep/sysprep_operation_net_hwaddr.ml | 9 ++-- sysprep/sysprep_operation_pacct_log.ml | 16 +++--- sysprep/sysprep_operation_package_manager_cache.ml | 6 +-- sysprep/sysprep_operation_pam_data.ml | 7 +-- sysprep/sysprep_operation_password.ml | 5 +- sysprep/sysprep_operation_puppet_data_log.ml | 7 +-- sysprep/sysprep_operation_random_seed.ml | 5 +- sysprep/sysprep_operation_rhn_systemid.ml | 7 ++- sysprep/sysprep_operation_rpm_db.ml | 6 +-- sysprep/sysprep_operation_samba_db_log.ml | 7 +-- sysprep/sysprep_operation_script.ml | 5 +- sysprep/sysprep_operation_smolt_uuid.ml | 7 +-- sysprep/sysprep_operation_ssh_hostkeys.ml | 6 +-- sysprep/sysprep_operation_ssh_userdir.ml | 6 +-- sysprep/sysprep_operation_sssd_db_log.ml | 7 +-- sysprep/sysprep_operation_timezone.ml | 7 +-- sysprep/sysprep_operation_tmp_files.ml | 7 +-- sysprep/sysprep_operation_udev_persistent_net.ml | 8 ++- sysprep/sysprep_operation_user_account.ml | 4 +- sysprep/sysprep_operation_utmp.ml | 5 +- sysprep/sysprep_operation_yum_uuid.ml | 6 +-- 45 files changed, 169 insertions(+), 215 deletions(-) diff --git a/sysprep/main.ml b/sysprep/main.ml index 49750a9..c1ce3c7 100644 --- a/sysprep/main.ml +++ b/sysprep/main.ml @@ -263,23 +263,21 @@ let do_sysprep () = with Guestfs.Error msg -> eprintf (f_"%s (ignored)\n") msg ) mps; + let side_effects = new Sysprep_operation.filesystem_side_effects in + (* Perform the filesystem operations. *) - let flags = - Sysprep_operation.perform_operations_on_filesystems - ?operations ~quiet g root in + Sysprep_operation.perform_operations_on_filesystems + ?operations ~quiet g root side_effects; - (* Parse flags. *) - let relabel = ref false in - List.iter (function - | `Created_files -> relabel := true - ) flags; + (* Check side-effects. *) + let created_files = side_effects#get_created_file in (* SELinux relabel? *) let relabel = - match selinux_relabel, !relabel with + match selinux_relabel, created_files with | `Force, _ -> true | `Never, _ -> false - | `Auto, relabel -> relabel in + | `Auto, created_files -> created_files in if relabel then ( let typ = g#inspect_get_type root in let distro = g#inspect_get_distro root in @@ -293,13 +291,11 @@ let do_sysprep () = (* Unmount everything in this guest. *) g#umount_all (); + let side_effects = new Sysprep_operation.device_side_effects in + (* Perform the block device operations. *) - let flags = - Sysprep_operation.perform_operations_on_devices - ?operations ~quiet g root in - - (* At present we don't support any flags from perform_on_devices. *) - assert (flags = []) + Sysprep_operation.perform_operations_on_devices + ?operations ~quiet g root side_effects; ) roots (* Finished. *) diff --git a/sysprep/sysprep_operation.ml b/sysprep/sysprep_operation.ml index 572a65f..703bcc7 100644 --- a/sysprep/sysprep_operation.ml +++ b/sysprep/sysprep_operation.ml @@ -24,9 +24,16 @@ open Common_gettext.Gettext let prog = "virt-sysprep" -type flag = [ `Created_files ] +class filesystem_side_effects = +object + val mutable m_created_file = false + method created_file () = m_created_file <- true + method get_created_file = m_created_file +end -type callback = Guestfs.guestfs -> string -> flag list +class device_side_effects = object end + +type 'a callback = Guestfs.guestfs -> string -> 'a -> unit type operation = { name : string; @@ -35,8 +42,8 @@ type operation = { pod_description : string option; pod_notes : string option; extra_args : extra_arg list; - perform_on_filesystems : callback option; - perform_on_devices : callback option; + perform_on_filesystems : filesystem_side_effects callback option; + perform_on_devices : device_side_effects callback option; } and extra_arg = { extra_argspec : Arg.key * Arg.spec * Arg.doc; @@ -260,7 +267,8 @@ let list_operations () = op.heading ) !all_operations -let perform_operations_on_filesystems ?operations ?(quiet = false) g root = +let perform_operations_on_filesystems ?operations ?(quiet = false) g root + side_effects = assert !baked; let ops = @@ -269,19 +277,17 @@ let perform_operations_on_filesystems ?operations ?(quiet = false) g root = | Some opset -> (* just the operation names listed *) OperationSet.elements opset in - let flags = - List.map ( - function - | { name = name; perform_on_filesystems = Some fn } -> - if not quiet then - printf "Performing %S ...\n%!" name; - fn g root - | { perform_on_filesystems = None } -> [] - ) ops in + List.iter ( + function + | { name = name; perform_on_filesystems = Some fn } -> + if not quiet then + printf "Performing %S ...\n%!" name; + fn g root side_effects + | { perform_on_filesystems = None } -> () + ) ops - List.flatten flags - -let perform_operations_on_devices ?operations ?(quiet = false) g root = +let perform_operations_on_devices ?operations ?(quiet = false) g root + side_effects = assert !baked; let ops = @@ -290,14 +296,11 @@ let perform_operations_on_devices ?operations ?(quiet = false) g root = | Some opset -> (* just the operation names listed *) OperationSet.elements opset in - let flags = - List.map ( - function - | { name = name; perform_on_devices = Some fn } -> - if not quiet then - printf "Performing %S ...\n%!" name; - fn g root - | { perform_on_devices = None } -> [] - ) ops in - - List.flatten flags + List.iter ( + function + | { name = name; perform_on_devices = Some fn } -> + if not quiet then + printf "Performing %S ...\n%!" name; + fn g root side_effects + | { perform_on_devices = None } -> () + ) ops diff --git a/sysprep/sysprep_operation.mli b/sysprep/sysprep_operation.mli index eb89db4..ade0f8f 100644 --- a/sysprep/sysprep_operation.mli +++ b/sysprep/sysprep_operation.mli @@ -20,10 +20,21 @@ val prog : string -type flag = [ `Created_files ] +class filesystem_side_effects : object + method created_file : unit -> unit + method get_created_file : bool +end +(** The callback should indicate if it has side effects by calling + methods in this class. *) -type callback = Guestfs.guestfs -> string -> flag list -(** [callback g root] is called to do work. *) +class device_side_effects : object end +(** There are currently no device side-effects. For future use. *) + +type 'side_effects callback = Guestfs.guestfs -> string -> 'side_effects -> unit +(** [callback g root side_effects] is called to do work. + + If the operation has side effects such as creating files, it + should indicate that by calling the [side_effects] object. *) (** Structure used to describe sysprep operations. *) type operation = { @@ -55,7 +66,7 @@ type operation = { You can decide the types of the arguments, whether they are mandatory etc. *) - perform_on_filesystems : callback option; + perform_on_filesystems : filesystem_side_effects callback option; (** The function which is called to perform this operation, when enabled. @@ -69,14 +80,14 @@ type operation = { In the rare case of a multiboot operating system, it is possible for this function to be called multiple times. - On success, the function can return a list of flags (or an - empty list). See {!flag}. + If the callback has side effects such as create files, it should + call the appropriate method in {!filesystem_side_effects}. On error the function should raise an exception. The function also needs to be careful to {i suppress} exceptions for things which are not errors, eg. deleting non-existent files. *) - perform_on_devices : callback option; + perform_on_devices : device_side_effects callback option; (** This is the same as {!perform_on_filesystems} except that the guest filesystem(s) are {i not} mounted. This allows the operation to work directly on block devices, LVs etc. *) @@ -151,8 +162,8 @@ val remove_all_from_set : set -> set (** [remove_all_from_set set] removes from [set] all the available operations. *) -val perform_operations_on_filesystems : ?operations:set -> ?quiet:bool -> Guestfs.guestfs -> string -> flag list +val perform_operations_on_filesystems : ?operations:set -> ?quiet:bool -> Guestfs.guestfs -> string -> filesystem_side_effects -> unit (** Perform all operations, or the subset listed in the [operations] set. *) -val perform_operations_on_devices : ?operations:set -> ?quiet:bool -> Guestfs.guestfs -> string -> flag list +val perform_operations_on_devices : ?operations:set -> ?quiet:bool -> Guestfs.guestfs -> string -> device_side_effects -> unit (** Perform all operations, or the subset listed in the [operations] set. *) diff --git a/sysprep/sysprep_operation_abrt_data.ml b/sysprep/sysprep_operation_abrt_data.ml index d923fec..d950270 100644 --- a/sysprep/sysprep_operation_abrt_data.ml +++ b/sysprep/sysprep_operation_abrt_data.ml @@ -21,16 +21,14 @@ open Common_gettext.Gettext module G = Guestfs -let abrt_data_perform g root = +let abrt_data_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let paths = g#glob_expand "/var/spool/abrt/*" in Array.iter ( fun path -> g#rm_rf path; - ) paths; - [] + ) paths ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_bash_history.ml b/sysprep/sysprep_operation_bash_history.ml index f9efa47..67eb4e3 100644 --- a/sysprep/sysprep_operation_bash_history.ml +++ b/sysprep/sysprep_operation_bash_history.ml @@ -21,7 +21,7 @@ open Common_gettext.Gettext module G = Guestfs -let bash_history_perform g root = +let bash_history_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let files = g#glob_expand "/home/*/.bash_history" in @@ -29,9 +29,7 @@ let bash_history_perform g root = fun file -> try g#rm file with G.Error _ -> (); ) files; (try g#rm "/root/.bash_history" with G.Error _ -> ()); - [] ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_blkid_tab.ml b/sysprep/sysprep_operation_blkid_tab.ml index fe9d10f..9c239b7 100644 --- a/sysprep/sysprep_operation_blkid_tab.ml +++ b/sysprep/sysprep_operation_blkid_tab.ml @@ -21,7 +21,7 @@ open Common_gettext.Gettext module G = Guestfs -let blkid_tab_perform g root = +let blkid_tab_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let files = [ "/var/run/blkid.tab"; @@ -37,11 +37,8 @@ let blkid_tab_perform g root = if not (g#is_symlink file) then ( try g#rm file with G.Error _ -> () ) - ) files; - - [] + ) files ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_ca_certificates.ml b/sysprep/sysprep_operation_ca_certificates.ml index 86a9c54..213f4ac 100644 --- a/sysprep/sysprep_operation_ca_certificates.ml +++ b/sysprep/sysprep_operation_ca_certificates.ml @@ -22,7 +22,7 @@ open Common_gettext.Gettext module StringSet = Set.Make (String) module G = Guestfs -let ca_certificates_perform g root = +let ca_certificates_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let paths = [ "/etc/pki/CA/certs/*.crt"; @@ -41,11 +41,8 @@ let ca_certificates_perform g root = StringSet.iter ( fun filename -> try g#rm filename with G.Error _ -> () - ) set; - - [] + ) set ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_crash_data.ml b/sysprep/sysprep_operation_crash_data.ml index edeb5e2..79f3d7f 100644 --- a/sysprep/sysprep_operation_crash_data.ml +++ b/sysprep/sysprep_operation_crash_data.ml @@ -26,12 +26,11 @@ let globs = [ "/var/log/dump/*"; ] -let crash_data_perform g root = +let crash_data_perform g root side_effects = let typ = g#inspect_get_type root in if typ = "linux" then ( List.iter (fun glob -> Array.iter g#rm_rf (g#glob_expand glob)) globs - ); - [] + ) let op = { defaults with diff --git a/sysprep/sysprep_operation_cron_spool.ml b/sysprep/sysprep_operation_cron_spool.ml index 1a036dd..687a7e9 100644 --- a/sysprep/sysprep_operation_cron_spool.ml +++ b/sysprep/sysprep_operation_cron_spool.ml @@ -21,7 +21,7 @@ open Common_gettext.Gettext module G = Guestfs -let cron_spool_perform (g : Guestfs.guestfs) root = +let cron_spool_perform (g : Guestfs.guestfs) root side_effects = Array.iter g#rm_rf (g#glob_expand "/var/spool/cron/*"); Array.iter g#rm (g#glob_expand "/var/spool/atjobs/*"); Array.iter g#rm (g#glob_expand "/var/spool/atjobs/.SEQ"); @@ -30,8 +30,7 @@ let cron_spool_perform (g : Guestfs.guestfs) root = (fun path -> if not (g#is_dir path) then g#rm path) (g#glob_expand "/var/spool/at/*"); Array.iter g#rm (g#glob_expand "/var/spool/at/.SEQ"); - Array.iter g#rm (g#glob_expand "/var/spool/at/spool/*"); - [] + Array.iter g#rm (g#glob_expand "/var/spool/at/spool/*") let op = { defaults with diff --git a/sysprep/sysprep_operation_delete.ml b/sysprep/sysprep_operation_delete.ml index 3db3f57..e521f91 100644 --- a/sysprep/sysprep_operation_delete.ml +++ b/sysprep/sysprep_operation_delete.ml @@ -25,12 +25,11 @@ module G = Guestfs let paths = ref [] let add_paths path = paths := path :: !paths -let path_perform g root = +let path_perform g root side_effects = let paths = List.rev !paths in if paths <> [] then ( List.iter (fun glob -> Array.iter g#rm_rf (g#glob_expand glob)) paths - ); - [] + ) let op = { defaults with diff --git a/sysprep/sysprep_operation_dhcp_client_state.ml b/sysprep/sysprep_operation_dhcp_client_state.ml index 69c506f..3ee91df 100644 --- a/sysprep/sysprep_operation_dhcp_client_state.ml +++ b/sysprep/sysprep_operation_dhcp_client_state.ml @@ -21,14 +21,13 @@ open Common_gettext.Gettext module G = Guestfs -let dhcp_client_state_perform g root = +let dhcp_client_state_perform g root side_effects = let typ = g#inspect_get_type root in if typ = "linux" then ( List.iter ( fun glob -> Array.iter g#rm_rf (g#glob_expand glob) ) [ "/var/lib/dhclient/*"; "/var/lib/dhcp/*" (* RHEL 3 *) ] - ); - [] + ) let op = { defaults with diff --git a/sysprep/sysprep_operation_dhcp_server_state.ml b/sysprep/sysprep_operation_dhcp_server_state.ml index 9ef2abf..dfc71b2 100644 --- a/sysprep/sysprep_operation_dhcp_server_state.ml +++ b/sysprep/sysprep_operation_dhcp_server_state.ml @@ -21,9 +21,8 @@ open Common_gettext.Gettext module G = Guestfs -let dhcp_server_state_perform g root = - Array.iter g#rm_rf (g#glob_expand "/var/lib/dhcpd/*"); - [] +let dhcp_server_state_perform g root side_effects = + Array.iter g#rm_rf (g#glob_expand "/var/lib/dhcpd/*") let op = { defaults with diff --git a/sysprep/sysprep_operation_dovecot_data.ml b/sysprep/sysprep_operation_dovecot_data.ml index c2004e8..976d483 100644 --- a/sysprep/sysprep_operation_dovecot_data.ml +++ b/sysprep/sysprep_operation_dovecot_data.ml @@ -21,16 +21,14 @@ open Common_gettext.Gettext module G = Guestfs -let dovecot_data_perform g root = +let dovecot_data_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let files = g#glob_expand "/var/lib/dovecot/*" in Array.iter ( fun file -> try g#rm file with G.Error _ -> () - ) files; - [] + ) files ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_firewall_rules.ml b/sysprep/sysprep_operation_firewall_rules.ml index cdb816e..f5967fc 100644 --- a/sysprep/sysprep_operation_firewall_rules.ml +++ b/sysprep/sysprep_operation_firewall_rules.ml @@ -21,7 +21,7 @@ open Common_gettext.Gettext module G = Guestfs -let firewall_rules_perform g root = +let firewall_rules_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let paths = [ "/etc/sysconfig/iptables"; @@ -34,11 +34,8 @@ let firewall_rules_perform g root = fun file -> try g#rm file with G.Error _ -> () ) files; - ) paths; - - [] + ) paths ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_firstboot.ml b/sysprep/sysprep_operation_firstboot.ml index 6be3e92..4c42353 100644 --- a/sysprep/sysprep_operation_firstboot.ml +++ b/sysprep/sysprep_operation_firstboot.ml @@ -26,7 +26,7 @@ module G = Guestfs let files = ref [] -let firstboot_perform g root = +let firstboot_perform g root side_effects = (* Read the files and add them using the {!Firstboot} module. *) let files = List.rev !files in let i = ref 0 in @@ -35,9 +35,9 @@ let firstboot_perform g root = incr i; let i = !i in let content = read_whole_file filename in - Firstboot.add_firstboot_script g root i content - ) files; - if files <> [] then [ `Created_files ] else [] + Firstboot.add_firstboot_script g root i content; + side_effects#created_file () + ) files let op = { defaults with diff --git a/sysprep/sysprep_operation_flag_reconfiguration.ml b/sysprep/sysprep_operation_flag_reconfiguration.ml index 25abfef..e4df324 100644 --- a/sysprep/sysprep_operation_flag_reconfiguration.ml +++ b/sysprep/sysprep_operation_flag_reconfiguration.ml @@ -21,13 +21,12 @@ open Common_gettext.Gettext module G = Guestfs -let flag_reconfiguration g root = +let flag_reconfiguration g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( g#touch "/.unconfigured"; - [ `Created_files ] + side_effects#created_file () ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_fs_uuids.ml b/sysprep/sysprep_operation_fs_uuids.ml index 524c0f6..b91c9d7 100644 --- a/sysprep/sysprep_operation_fs_uuids.ml +++ b/sysprep/sysprep_operation_fs_uuids.ml @@ -23,7 +23,7 @@ open Common_gettext.Gettext module G = Guestfs -let rec fs_uuids_perform g root = +let rec fs_uuids_perform g root side_effects = let fses = g#list_filesystems () in List.iter (function | _, "unknown" -> () @@ -37,8 +37,7 @@ let rec fs_uuids_perform g root = G.Error msg -> eprintf (f_"warning: cannot set random UUID on filesystem %s type %s: %s\n") dev typ msg - ) fses; - [] + ) fses let op = { defaults with diff --git a/sysprep/sysprep_operation_hostname.ml b/sysprep/sysprep_operation_hostname.ml index 3066623..05178a3 100644 --- a/sysprep/sysprep_operation_hostname.ml +++ b/sysprep/sysprep_operation_hostname.ml @@ -26,8 +26,9 @@ module G = Guestfs let hostname = ref "localhost.localdomain" -let hostname_perform (g : Guestfs.guestfs) root = - if Hostname.set_hostname g root !hostname then [ `Created_files ] else [] +let hostname_perform (g : Guestfs.guestfs) root side_effects = + if Hostname.set_hostname g root !hostname then + side_effects#created_file () let op = { defaults with diff --git a/sysprep/sysprep_operation_kerberos_data.ml b/sysprep/sysprep_operation_kerberos_data.ml index 0652719..449d604 100644 --- a/sysprep/sysprep_operation_kerberos_data.ml +++ b/sysprep/sysprep_operation_kerberos_data.ml @@ -22,7 +22,7 @@ open Common_gettext.Gettext module StringSet = Set.Make (String) module G = Guestfs -let kerberos_data_perform g root = +let kerberos_data_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let excepts = [ "/var/kerberos/krb5kdc/kadm5.acl"; @@ -34,11 +34,8 @@ let kerberos_data_perform g root = StringSet.iter ( fun filename -> try g#rm filename with G.Error _ -> () - ) set; - - [] + ) set ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_logfiles.ml b/sysprep/sysprep_operation_logfiles.ml index 2558af1..f154b4d 100644 --- a/sysprep/sysprep_operation_logfiles.ml +++ b/sysprep/sysprep_operation_logfiles.ml @@ -101,12 +101,11 @@ let globs = List.sort compare [ ] let globs_as_pod = String.concat "\n" (List.map ((^) " ") globs) -let logfiles_perform g root = +let logfiles_perform g root side_effects = let typ = g#inspect_get_type root in if typ = "linux" then ( List.iter (fun glob -> Array.iter g#rm_rf (g#glob_expand glob)) globs - ); - [] + ) let op = { defaults with diff --git a/sysprep/sysprep_operation_lvm_uuids.ml b/sysprep/sysprep_operation_lvm_uuids.ml index 7790d0b..c67b214 100644 --- a/sysprep/sysprep_operation_lvm_uuids.ml +++ b/sysprep/sysprep_operation_lvm_uuids.ml @@ -23,7 +23,7 @@ open Common_gettext.Gettext module G = Guestfs -let rec lvm_uuids_perform g root = +let rec lvm_uuids_perform g root side_effects = let typ = g#inspect_get_type root in if typ = "linux" then ( let has_lvm2_feature = @@ -35,8 +35,7 @@ let rec lvm_uuids_perform g root = if has_vgs then g#vgchange_uuid_all (); if has_pvs || has_vgs then g#vg_activate_all true ) - ); - [] + ) let op = { defaults with diff --git a/sysprep/sysprep_operation_machine_id.ml b/sysprep/sysprep_operation_machine_id.ml index 5eadea4..fbcc692 100644 --- a/sysprep/sysprep_operation_machine_id.ml +++ b/sysprep/sysprep_operation_machine_id.ml @@ -21,15 +21,16 @@ open Common_gettext.Gettext module G = Guestfs -let machine_id_perform g root = +let machine_id_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let path = "/etc/machine-id" in (try g#rm path with G.Error _ -> ()); - (try g#touch path with G.Error _ -> ()); - [ `Created_files ] + (try + g#touch path; + side_effects#created_file () + with G.Error _ -> ()); ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_mail_spool.ml b/sysprep/sysprep_operation_mail_spool.ml index fa2b4e7..0db831c 100644 --- a/sysprep/sysprep_operation_mail_spool.ml +++ b/sysprep/sysprep_operation_mail_spool.ml @@ -21,14 +21,13 @@ open Common_gettext.Gettext module G = Guestfs -let mail_spool_perform g root = +let mail_spool_perform g root side_effects = List.iter ( fun glob -> Array.iter g#rm_rf (g#glob_expand glob) ) [ "/var/spool/mail/*"; "/var/mail/*"; - ]; - [] + ] let op = { defaults with diff --git a/sysprep/sysprep_operation_net_hostname.ml b/sysprep/sysprep_operation_net_hostname.ml index a540357..bc99662 100644 --- a/sysprep/sysprep_operation_net_hostname.ml +++ b/sysprep/sysprep_operation_net_hostname.ml @@ -22,7 +22,7 @@ open Common_gettext.Gettext module G = Guestfs -let net_hostname_perform g root = +let net_hostname_perform g root side_effects = let typ = g#inspect_get_type root in let distro = g#inspect_get_distro root in match typ, distro with @@ -36,12 +36,11 @@ let net_hostname_perform g root = fun line -> not (string_prefix line "HOSTNAME=") ) lines in let file = String.concat "\n" lines ^ "\n" in - g#write filename file + g#write filename file; + side_effects#created_file () ) filenames; - if filenames <> [||] then [ `Created_files ] else [] - - | _ -> [] + | _ -> () let op = { defaults with diff --git a/sysprep/sysprep_operation_net_hwaddr.ml b/sysprep/sysprep_operation_net_hwaddr.ml index 6409767..fbf0a33 100644 --- a/sysprep/sysprep_operation_net_hwaddr.ml +++ b/sysprep/sysprep_operation_net_hwaddr.ml @@ -22,7 +22,7 @@ open Common_gettext.Gettext module G = Guestfs -let net_hwaddr_perform g root = +let net_hwaddr_perform g root side_effects = let typ = g#inspect_get_type root in let distro = g#inspect_get_distro root in match typ, distro with @@ -36,12 +36,11 @@ let net_hwaddr_perform g root = fun line -> not (string_prefix line "HWADDR=") ) lines in let file = String.concat "\n" lines ^ "\n" in - g#write filename file + g#write filename file; + side_effects#created_file () ) filenames; - if filenames <> [||] then [ `Created_files ] else [] - - | _ -> [] + | _ -> () let op = { defaults with diff --git a/sysprep/sysprep_operation_pacct_log.ml b/sysprep/sysprep_operation_pacct_log.ml index 10dc25f..355198d 100644 --- a/sysprep/sysprep_operation_pacct_log.ml +++ b/sysprep/sysprep_operation_pacct_log.ml @@ -21,7 +21,7 @@ open Common_gettext.Gettext module G = Guestfs -let pacct_log_perform g root = +let pacct_log_perform g root side_effects = let typ = g#inspect_get_type root in let distro = g#inspect_get_distro root in match typ, distro with @@ -31,8 +31,10 @@ let pacct_log_perform g root = fun file -> try g#rm file with G.Error _ -> () ) files; - (try g#touch "/var/account/pacct" with G.Error _ -> ()); - [ `Created_files ] + (try + g#touch "/var/account/pacct"; + side_effects#created_file () + with G.Error _ -> ()) | "linux", ("debian"|"ubuntu") -> let files = g#glob_expand "/var/log/account/pacct*" in @@ -40,10 +42,12 @@ let pacct_log_perform g root = fun file -> try g#rm file with G.Error _ -> () ) files; - (try g#touch "/var/log/account/pacct" with G.Error _ -> ()); - [ `Created_files ] + (try + g#touch "/var/log/account/pacct"; + side_effects#created_file () + with G.Error _ -> ()) - | _ -> [] + | _ -> () let op = { defaults with diff --git a/sysprep/sysprep_operation_package_manager_cache.ml b/sysprep/sysprep_operation_package_manager_cache.ml index 586490e..18d65e8 100644 --- a/sysprep/sysprep_operation_package_manager_cache.ml +++ b/sysprep/sysprep_operation_package_manager_cache.ml @@ -22,7 +22,7 @@ open Common_utils module G = Guestfs -let package_manager_cache_perform g root = +let package_manager_cache_perform g root side_effects = let packager = g#inspect_get_package_management root in let cache_dirs = match packager with @@ -34,8 +34,8 @@ let package_manager_cache_perform g root = Some [ "/var/cache/apt/archives/" ] | _ -> None in match cache_dirs with - | Some dirs -> List.iter (rm_rf_only_files g) dirs; [] - | _ -> [] + | Some dirs -> List.iter (rm_rf_only_files g) dirs + | _ -> () let op = { defaults with diff --git a/sysprep/sysprep_operation_pam_data.ml b/sysprep/sysprep_operation_pam_data.ml index 82c88f9..c3b988f 100644 --- a/sysprep/sysprep_operation_pam_data.ml +++ b/sysprep/sysprep_operation_pam_data.ml @@ -21,7 +21,7 @@ open Common_gettext.Gettext module G = Guestfs -let pam_data_perform g root = +let pam_data_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let paths = [ "/var/run/console/*"; @@ -34,11 +34,8 @@ let pam_data_perform g root = fun file -> try g#rm file with G.Error _ -> () ) files; - ) paths; - - [] + ) paths ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_password.ml b/sysprep/sysprep_operation_password.ml index ef0e985..ef6221c 100644 --- a/sysprep/sysprep_operation_password.ml +++ b/sysprep/sysprep_operation_password.ml @@ -53,19 +53,18 @@ let password_crypto : password_crypto option ref = ref None let set_password_crypto arg = password_crypto := Some (password_crypto_of_string ~prog arg) -let password_perform g root = +let password_perform g root side_effects = if Hashtbl.length passwords > 0 then ( let typ = g#inspect_get_type root in match typ with | "linux" -> let password_crypto = !password_crypto in set_linux_passwords ~prog ?password_crypto g root passwords; - [ `Created_files ] + side_effects#created_file () | _ -> eprintf (f_"virt-sysprep: cannot set passwords for %s guests.\n") typ; exit 1 ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_puppet_data_log.ml b/sysprep/sysprep_operation_puppet_data_log.ml index 8094b83..f00e4a9 100644 --- a/sysprep/sysprep_operation_puppet_data_log.ml +++ b/sysprep/sysprep_operation_puppet_data_log.ml @@ -21,7 +21,7 @@ open Common_gettext.Gettext module G = Guestfs -let puppet_data_log_perform g root = +let puppet_data_log_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let paths = [ "/var/log/puppet/*"; @@ -34,11 +34,8 @@ let puppet_data_log_perform g root = fun file -> try g#rm file with G.Error _ -> () ) files; - ) paths; - - [] + ) paths ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_random_seed.ml b/sysprep/sysprep_operation_random_seed.ml index 0e6a2a2..194ae6a 100644 --- a/sysprep/sysprep_operation_random_seed.ml +++ b/sysprep/sysprep_operation_random_seed.ml @@ -23,8 +23,9 @@ open Random_seed module G = Guestfs -let random_seed_perform (g : Guestfs.guestfs) root = - if set_random_seed g root then [ `Created_files ] else [] +let random_seed_perform (g : Guestfs.guestfs) root side_effects = + if set_random_seed g root then + side_effects#created_file () let op = { defaults with diff --git a/sysprep/sysprep_operation_rhn_systemid.ml b/sysprep/sysprep_operation_rhn_systemid.ml index 002aa5a..21aace5 100644 --- a/sysprep/sysprep_operation_rhn_systemid.ml +++ b/sysprep/sysprep_operation_rhn_systemid.ml @@ -21,16 +21,15 @@ open Common_gettext.Gettext module G = Guestfs -let rhn_systemid_perform g root = +let rhn_systemid_perform g root side_effects = let typ = g#inspect_get_type root in let distro = g#inspect_get_distro root in match typ, distro with | "linux", "rhel" -> (try g#rm "/etc/sysconfig/rhn/systemid" with G.Error _ -> ()); - (try g#rm "/etc/sysconfig/rhn/osad-auth.conf" with G.Error _ -> ()); - [] - | _ -> [] + (try g#rm "/etc/sysconfig/rhn/osad-auth.conf" with G.Error _ -> ()) + | _ -> () let op = { defaults with diff --git a/sysprep/sysprep_operation_rpm_db.ml b/sysprep/sysprep_operation_rpm_db.ml index 551c266..55e50fe 100644 --- a/sysprep/sysprep_operation_rpm_db.ml +++ b/sysprep/sysprep_operation_rpm_db.ml @@ -22,17 +22,15 @@ open Common_gettext.Gettext module StringSet = Set.Make (String) module G = Guestfs -let rpm_db_perform g root = +let rpm_db_perform g root side_effects = let pf = g#inspect_get_package_format root in if pf = "rpm" then ( let paths = g#glob_expand "/var/lib/rpm/__db.*" in Array.iter ( fun filename -> try g#rm filename with G.Error _ -> () - ) paths; - [] + ) paths ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_samba_db_log.ml b/sysprep/sysprep_operation_samba_db_log.ml index 8ed86ca..126a7ac 100644 --- a/sysprep/sysprep_operation_samba_db_log.ml +++ b/sysprep/sysprep_operation_samba_db_log.ml @@ -21,7 +21,7 @@ open Common_gettext.Gettext module G = Guestfs -let samba_db_log_perform g root = +let samba_db_log_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let paths = [ "/var/log/samba/old/*"; @@ -35,11 +35,8 @@ let samba_db_log_perform g root = fun file -> try g#rm file with G.Error _ -> () ) files; - ) paths; - - [] + ) paths ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_script.ml b/sysprep/sysprep_operation_script.ml index 60586d4..518207e 100644 --- a/sysprep/sysprep_operation_script.ml +++ b/sysprep/sysprep_operation_script.ml @@ -36,7 +36,7 @@ let set_scriptdir dir = let scripts = ref [] let add_script script = scripts := script :: !scripts -let rec script_perform (g : Guestfs.guestfs) root = +let rec script_perform (g : Guestfs.guestfs) root side_effects = let scripts = List.rev !scripts in if scripts <> [] then ( (* Create a temporary directory? *) @@ -73,8 +73,7 @@ let rec script_perform (g : Guestfs.guestfs) root = if cleanup then rmdir scriptdir; if not ok then failwith (s_"script failed") - ); - [] + ) (* Run the scripts in the background and make sure they call * guestunmount afterwards. diff --git a/sysprep/sysprep_operation_smolt_uuid.ml b/sysprep/sysprep_operation_smolt_uuid.ml index bb560c4..dd80c1d 100644 --- a/sysprep/sysprep_operation_smolt_uuid.ml +++ b/sysprep/sysprep_operation_smolt_uuid.ml @@ -21,7 +21,7 @@ open Common_gettext.Gettext module G = Guestfs -let smolt_uuid_perform g root = +let smolt_uuid_perform g root side_effects = let typ = g#inspect_get_type root in if typ = "linux" then ( let files = [ "/etc/sysconfig/hw-uuid"; @@ -29,11 +29,8 @@ let smolt_uuid_perform g root = "/etc/smolt/hw-uuid" ] in List.iter ( fun file -> try g#rm file with G.Error _ -> () - ) files; - - [] + ) files ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_ssh_hostkeys.ml b/sysprep/sysprep_operation_ssh_hostkeys.ml index 6ed7deb..417e792 100644 --- a/sysprep/sysprep_operation_ssh_hostkeys.ml +++ b/sysprep/sysprep_operation_ssh_hostkeys.ml @@ -21,14 +21,12 @@ open Common_gettext.Gettext module G = Guestfs -let ssh_hostkeys_perform g root = +let ssh_hostkeys_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let files = g#glob_expand "/etc/ssh/*_host_*" in - Array.iter g#rm files; - [] + Array.iter g#rm files ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_ssh_userdir.ml b/sysprep/sysprep_operation_ssh_userdir.ml index 59cce9d..19f8890 100644 --- a/sysprep/sysprep_operation_ssh_userdir.ml +++ b/sysprep/sysprep_operation_ssh_userdir.ml @@ -21,17 +21,15 @@ open Common_gettext.Gettext module G = Guestfs -let ssh_userdir_perform g root = +let ssh_userdir_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let dirs = g#glob_expand "/home/*/.ssh" in Array.iter ( fun dir -> g#rm_rf dir; ) dirs; - g#rm_rf "/root/.ssh"; - [] + g#rm_rf "/root/.ssh" ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_sssd_db_log.ml b/sysprep/sysprep_operation_sssd_db_log.ml index 70c0c44..8f1bc88 100644 --- a/sysprep/sysprep_operation_sssd_db_log.ml +++ b/sysprep/sysprep_operation_sssd_db_log.ml @@ -21,7 +21,7 @@ open Common_gettext.Gettext module G = Guestfs -let sssd_db_log_perform g root = +let sssd_db_log_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let paths = [ "/var/log/sssd/*"; @@ -33,11 +33,8 @@ let sssd_db_log_perform g root = fun file -> try g#rm file with G.Error _ -> () ) files; - ) paths; - - [] + ) paths ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_timezone.ml b/sysprep/sysprep_operation_timezone.ml index 7557f44..47ec384 100644 --- a/sysprep/sysprep_operation_timezone.ml +++ b/sysprep/sysprep_operation_timezone.ml @@ -26,11 +26,12 @@ module G = Guestfs let timezone = ref None -let timezone_perform (g : Guestfs.guestfs) root = +let timezone_perform (g : Guestfs.guestfs) root side_effects = match !timezone with - | None -> [] + | None -> () | Some tz -> - if Timezone.set_timezone ~prog g root tz then [ `Created_files ] else [] + if Timezone.set_timezone ~prog g root tz then + side_effects#created_file () let op = { defaults with diff --git a/sysprep/sysprep_operation_tmp_files.ml b/sysprep/sysprep_operation_tmp_files.ml index a42ddbd..72de200 100644 --- a/sysprep/sysprep_operation_tmp_files.ml +++ b/sysprep/sysprep_operation_tmp_files.ml @@ -21,7 +21,7 @@ open Common_gettext.Gettext module G = Guestfs -let tmp_files_perform g root = +let tmp_files_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( let paths = [ "/tmp/*"; @@ -33,11 +33,8 @@ let tmp_files_perform g root = fun file -> g#rm_rf file; ) files; - ) paths; - - [] + ) paths ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_udev_persistent_net.ml b/sysprep/sysprep_operation_udev_persistent_net.ml index 235ef98..d0ddd53 100644 --- a/sysprep/sysprep_operation_udev_persistent_net.ml +++ b/sysprep/sysprep_operation_udev_persistent_net.ml @@ -21,14 +21,12 @@ open Common_gettext.Gettext module G = Guestfs -let udev_persistent_net_perform g root = +let udev_persistent_net_perform g root side_effects = let typ = g#inspect_get_type root in if typ = "linux" then ( - (try g#rm "/etc/udev/rules.d/70-persistent-net.rules" - with G.Error _ -> ()); - [] + try g#rm "/etc/udev/rules.d/70-persistent-net.rules" + with G.Error _ -> () ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_user_account.ml b/sysprep/sysprep_operation_user_account.ml index fc39bc8..b5a6e71 100644 --- a/sysprep/sysprep_operation_user_account.ml +++ b/sysprep/sysprep_operation_user_account.ml @@ -25,7 +25,7 @@ open Common_gettext.Gettext module G = Guestfs -let user_account_perform g root = +let user_account_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( g#aug_init "/" 0; @@ -54,9 +54,7 @@ let user_account_perform g root = ) ) users; g#aug_save (); - [] ) - else [] let op = { defaults with diff --git a/sysprep/sysprep_operation_utmp.ml b/sysprep/sysprep_operation_utmp.ml index be73e16..3c9c6de 100644 --- a/sysprep/sysprep_operation_utmp.ml +++ b/sysprep/sysprep_operation_utmp.ml @@ -21,13 +21,12 @@ open Common_gettext.Gettext module G = Guestfs -let utmp_perform g root = +let utmp_perform g root side_effects = let typ = g#inspect_get_type root in if typ <> "windows" then ( try g#rm "/var/run/utmp" with G.Error _ -> () - ); - [] + ) let op = { defaults with diff --git a/sysprep/sysprep_operation_yum_uuid.ml b/sysprep/sysprep_operation_yum_uuid.ml index 8ffe664..045970c 100644 --- a/sysprep/sysprep_operation_yum_uuid.ml +++ b/sysprep/sysprep_operation_yum_uuid.ml @@ -21,13 +21,11 @@ open Common_gettext.Gettext module G = Guestfs -let yum_uuid_perform g root = +let yum_uuid_perform g root side_effects = let packager = g#inspect_get_package_management root in if packager = "yum" then ( - (try g#rm "/var/lib/yum/uuid" with G.Error _ -> ()); - [] + try g#rm "/var/lib/yum/uuid" with G.Error _ -> () ) - else [] let op = { defaults with -- 1.8.4.2