(* 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 Utils open Printf open Sysprep_gettext.Gettext type flag = [ `Created_files ] type callback = Guestfs.guestfs -> string -> flag list type operation = { name : string; enabled_by_default : bool; heading : string; pod_description : string option; extra_args : ((Arg.key * Arg.spec * Arg.doc) * string) list; perform_on_filesystems : callback option; perform_on_devices : callback option; } let all_operations = ref [] let enabled_by_default_operations = ref [] module OperationSet = Set.Make ( struct type t = operation let compare a b = compare a.name b.name end ) type set = OperationSet.t let empty_set = OperationSet.empty let add_to_set name set = let op = List.find (fun { name = n } -> name = n) !all_operations in OperationSet.add op set let register_operation op = all_operations := op :: !all_operations; if op.enabled_by_default then enabled_by_default_operations := op :: !enabled_by_default_operations let baked = ref false let rec bake () = let ops = List.sort (fun { name = a } { name = b } -> compare a b) !all_operations in check_no_dupes ops; List.iter check ops; all_operations := ops; baked := true and check_no_dupes ops = ignore ( List.fold_left ( fun opset op -> if OperationSet.mem op opset then ( eprintf (f_"virt-sysprep: duplicate operation name (%s)\n") op.name; exit 1 ); add_to_set op.name opset ) empty_set ops ) and check op = let n = String.length op.name in if n = 0 then ( eprintf (f_"virt-sysprep: operation name is an empty string\n"); exit 1; ); for i = 0 to n-1 do match String.unsafe_get op.name i with | 'a'..'z' | 'A'..'Z' | '0'..'9' | '-' -> () | c -> eprintf (f_"virt-sysprep: disallowed character (%c) in operation name\n") c; exit 1 done; let n = String.length op.heading in if n = 0 then ( eprintf (f_"virt-sysprep: operation %s has no heading\n") op.name; exit 1 ); if op.heading.[n-1] = '\n' || op.heading.[n-1] = '.' then ( eprintf (f_"virt-sysprep: heading for %s must not end with newline or period\n") op.name; exit 1 ); (match op.pod_description with | None -> () | Some description -> let n = String.length description in if n = 0 then ( eprintf (f_"virt-sysprep: operation %s has no POD\n") op.name; exit 1 ); if description.[n-1] = '\n' then ( eprintf (f_"virt-sysprep: POD for %s must not end with newline\n") op.name; exit 1 ) ) let extra_args () = assert !baked; List.flatten ( List.map (fun { extra_args = extra_args } -> List.map fst extra_args ) !all_operations ) (* These internal functions are used to generate the man page. *) let dump_pod () = assert !baked; List.iter ( fun op -> printf "=head2 B<%s>\n" op.name; if op.enabled_by_default then printf "*\n"; printf "\n"; printf "%s.\n\n" op.heading; (match op.pod_description with | None -> () | Some description -> printf "%s\n\n" description ) ) !all_operations let dump_pod_options () = assert !baked; let args = List.map ( fun { name = op_name; extra_args = extra_args } -> List.map (fun ea -> op_name, ea) extra_args ) !all_operations in let args = List.flatten args in let args = List.map ( fun (op_name, ((arg_name, spec, _), pod)) -> match spec with | Arg.Unit _ | Arg.Bool _ | Arg.Set _ | Arg.Clear _ -> let heading = sprintf "B<%s>" arg_name in arg_name, (op_name, heading, pod) | Arg.String _ | Arg.Set_string _ | Arg.Int _ | Arg.Set_int _ | Arg.Float _ | Arg.Set_float _ -> let heading = sprintf "B<%s> %s" arg_name (skip_dashes arg_name) in arg_name, (op_name, heading, pod) | Arg.Tuple _ | Arg.Symbol _ | Arg.Rest _ -> assert false (* XXX not implemented *) ) args in let args = List.sort (fun (a, _) (b, _) -> compare_command_line_args a b) args in List.iter ( fun (arg_name, (op_name, heading, pod)) -> printf "=item %s\n" heading; printf "(see C<%s> below)\n" op_name; printf "\n"; printf "%s\n\n" pod ) args let list_operations () = assert !baked; List.iter ( fun op -> printf "%s %s %s\n" op.name (if op.enabled_by_default then "*" else " ") op.heading ) !all_operations let perform_operations_on_filesystems ?operations ?(quiet = false) g root = assert !baked; let ops = match operations with | None -> !enabled_by_default_operations | 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.flatten flags let perform_operations_on_devices ?operations ?(quiet = false) g root = assert !baked; let ops = match operations with | None -> !enabled_by_default_operations | 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