File: cmdline.ml

package info (click to toggle)
libguestfs 1%3A1.44.0-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 118,932 kB
  • sloc: ansic: 458,017; ml: 51,424; sh: 13,191; java: 9,578; makefile: 7,931; cs: 6,328; haskell: 5,674; python: 3,871; perl: 3,528; erlang: 2,446; xml: 1,347; ruby: 350; pascal: 257; javascript: 157; lex: 135; yacc: 128; cpp: 10
file content (334 lines) | stat: -rw-r--r-- 12,092 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
(* virt-builder
 * Copyright (C) 2013-2020 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. *)

open Std_utils
open Tools_utils
open Common_gettext.Gettext
open Getopt.OptionName

open Customize_cmdline

open Utils

module G = Guestfs

open Unix
open Printf

type cmdline = {
  mode : [ `Cache_all | `Delete_cache | `Get_kernel | `Install | `List
           | `Notes | `Print_cache ];
  arg : string;
  arch : string;
  attach : (string option * string) list;
  cache : string option;
  check_signature : bool;
  curl : string;
  customize_ops : Customize_cmdline.ops;
  delete_on_failure : bool;
  format : string option;
  gpg : string;
  list_format : List_entries.format;
  memsize : int option;
  network : bool;
  output : string option;
  size : int64 option;
  smp : int option;
  sources : (string * string) list;
  sync : bool;
  warn_if_partition : bool;
}

let parse_cmdline () =
  let mode = ref `Install in
  let list_mode () = mode := `List in
  let notes_mode () = mode := `Notes in
  let get_kernel_mode () = mode := `Get_kernel in
  let cache_all_mode () = mode := `Cache_all in
  let print_cache_mode () = mode := `Print_cache in
  let delete_cache_mode () = mode := `Delete_cache in

  let arch = ref "" in

  let attach = ref [] in
  let attach_format = ref None in
  let set_attach_format = function
    | "auto" -> attach_format := None
    | s -> attach_format := Some s
  in
  let attach_disk s = List.push_front (!attach_format, s) attach in

  let cache = ref Paths.xdg_cache_home in
  let set_cache arg = cache := Some arg in
  let no_cache () = cache := None in

  let check_signature = ref true in
  let curl = ref "curl" in

  let delete_on_failure = ref true in

  let fingerprints = ref [] in
  let add_fingerprint arg = List.push_front arg fingerprints in

  let format = ref "" in
  let gpg =
    try which "gpg2"
    with Executable_not_found _ ->
         try which "gpg"
         with Executable_not_found _ ->
              "" in
  let gpg = ref gpg in

  let list_format = ref List_entries.Short in
  let list_set_long () = list_format := List_entries.Long in
  let list_set_format arg =
    (* Do not catch the Invalid_argument that list_format_of_string
     * throws on invalid input, as it is already checked by the
     * Getopt handling of Symbol. *)
    list_format := List_entries.list_format_of_string arg in

  let memsize = ref None in
  let set_memsize arg = memsize := Some arg in

  let network = ref true in
  let output = ref "" in

  let size = ref None in
  let set_size arg = size := Some (parse_size arg) in

  let smp = ref None in
  let set_smp arg = smp := Some arg in

  let sources = ref [] in
  let add_source arg = List.push_front arg sources in

  let sync = ref true in
  let warn_if_partition = ref true in

  let formats = List_entries.list_formats
  and formats_string = String.concat "|" List_entries.list_formats in

  let argspec = [
    [ L"arch" ],    Getopt.Set_string ("arch", arch),        s_"Set the output architecture";
    [ L"attach" ],  Getopt.String ("iso", attach_disk),     s_"Attach data disk/ISO during install";
    [ L"attach-format" ],  Getopt.String ("format", set_attach_format),
                                             s_"Set attach disk format";
    [ L"cache" ],   Getopt.String ("dir", set_cache),       s_"Set template cache dir";
    [ L"no-cache" ], Getopt.Unit no_cache,        s_"Disable template cache";
    [ L"cache-all-templates" ], Getopt.Unit cache_all_mode,
                                            s_"Download all templates to the cache";
    [ L"check-signature"; L"check-signatures" ], Getopt.Set check_signature,
                                            s_"Check digital signatures";
    [ L"no-check-signature"; L"no-check-signatures" ], Getopt.Clear check_signature,
                                            s_"Disable digital signatures";
    [ L"curl" ],    Getopt.Set_string ("curl", curl),        s_"Set curl binary/command";
    [ L"delete-cache" ], Getopt.Unit delete_cache_mode,
                                            s_"Delete the template cache";
    [ L"no-delete-on-failure" ], Getopt.Clear delete_on_failure,
                                            s_"Don’t delete output file on failure";
    [ L"fingerprint" ], Getopt.String ("AAAA..", add_fingerprint),
                                             s_"Fingerprint of valid signing key";
    [ L"format" ],  Getopt.Set_string ("raw|qcow2", format),      s_"Output format (default: raw)";
    [ L"get-kernel" ], Getopt.Unit get_kernel_mode,
                                            s_"Get kernel from image";
    [ L"gpg" ],    Getopt.Set_string ("gpg", gpg),          s_"Set GPG binary/command";
    [ S 'l'; L"list" ],        Getopt.Unit list_mode,        s_"List available templates";
    [ L"long" ],    Getopt.Unit list_set_long,    s_"Shortcut for --list-format long";
    [ L"list-format" ], Getopt.Symbol (formats_string, formats, list_set_format),
                                             s_"Set the format for --list (default: short)";
    [ S 'm'; L"memsize" ],        Getopt.Int ("mb", set_memsize),        s_"Set memory size";
    [ L"network" ], Getopt.Set network,           s_"Enable appliance network (default)";
    [ L"no-network" ], Getopt.Clear network,      s_"Disable appliance network";
    [ L"notes" ],   Getopt.Unit notes_mode,       s_"Display installation notes";
    [ S 'o'; L"output" ],        Getopt.Set_string ("file", output),      s_"Set output filename";
    [ L"print-cache" ], Getopt.Unit print_cache_mode,
                                            s_"Print info about template cache";
    [ L"size" ],    Getopt.String ("size", set_size),        s_"Set output disk size";
    [ L"smp" ],     Getopt.Int ("vcpus", set_smp),            s_"Set number of vCPUs";
    [ L"source" ],  Getopt.String ("URL", add_source),      s_"Set source URL";
    [ L"no-sync" ], Getopt.Clear sync,            s_"Do not fsync output file on exit";
    [ L"no-warn-if-partition" ], Getopt.Clear warn_if_partition,
                                            s_"Do not warn if writing to a partition";
  ] in
  let customize_argspec, get_customize_ops = Customize_cmdline.argspec () in
  let customize_argspec =
    List.map (fun (spec, _, _) -> spec) customize_argspec in
  let argspec = argspec @ customize_argspec in

  let args = ref [] in
  let anon_fun s = List.push_front s args in
  let usage_msg =
    sprintf (f_"\
%s: build virtual machine images quickly

 virt-builder OS-VERSION
 virt-builder -l
 virt-builder --notes OS-VERSION
 virt-builder --print-cache
 virt-builder --cache-all-templates
 virt-builder --delete-cache
 virt-builder --get-kernel IMAGE

A short summary of the options is given below.  For detailed help please
read the man page virt-builder(1).
")
      prog in
  let opthandle = create_standard_options argspec ~anon_fun ~machine_readable:true usage_msg in
  Getopt.parse opthandle.getopt;

  (* Dereference options. *)
  let args = List.rev !args in
  let mode = !mode in
  let arch = !arch in
  let attach = List.rev !attach in
  let cache = !cache in
  let check_signature = !check_signature in
  let curl = !curl in
  let delete_on_failure = !delete_on_failure in
  let fingerprints = List.rev !fingerprints in
  let format = match !format with "" -> None | s -> Some s in
  let gpg = !gpg in
  let list_format = !list_format in
  let memsize = !memsize in
  let network = !network in
  let ops = get_customize_ops () in
  let output = match !output with "" -> None | s -> Some s in
  let size = !size in
  let smp = !smp in
  let sources = List.rev !sources in
  let sync = !sync in
  let warn_if_partition = !warn_if_partition in

  (* No arguments and machine-readable mode?  Print some facts. *)
  (match args, machine_readable () with
  | [], Some { pr } ->
    pr "virt-builder\n";
    pr "arch\n";
    pr "config-file\n";
    pr "customize\n";
    pr "json-list\n";
    if Pxzcat.using_parallel_xzcat () then pr "pxzcat\n";
    exit 0
  | _, _ -> ()
  );

  (* Check options. *)
  let arg =
    match mode with
    | `Install ->
      (match args with
      | [arg] -> arg
      | [] ->
        error (f_"virt-builder os-version\nMissing ‘os-version’. Use ‘--list’ to list available template names.")
      | _ ->
        error (f_"too many parameters, expecting ‘os-version’")
      )
    | `List ->
      if format <> None then
        error (f_"--list: use ‘--list-format’, not ‘--format’");
      (match args with
      | [arg] -> arg
      | [] -> ""
      | _ ->
        error (f_"too many parameters, at most one ‘os-version’ is allowed for --list")
      )
    | `Notes ->
      (match args with
      | [arg] -> arg
      | [] ->
        error (f_"virt-builder --notes os-version\nMissing ‘os-version’. Use ‘--list’ to list available template names.")
      | _ ->
        error (f_"--notes: too many parameters, expecting ‘os-version’");
      )
    | `Cache_all
    | `Print_cache
    | `Delete_cache ->
      (match args with
      | [] -> ""
      | _ ->
        error (f_"--cache-all-templates/--print-cache/--delete-cache does not need any extra arguments")
      )
    | `Get_kernel ->
      (match args with
      | [arg] -> arg
      | [] ->
        error (f_"virt-builder --get-kernel image\nMissing ‘image’ (disk image file) argument")
      | _ ->
        error (f_"--get-kernel: too many parameters")
      ) in

  (* Check source(s) and fingerprint(s). *)
  let sources =
    let rec repeat x = function
      | 0 -> [] | 1 -> [x]
      | n -> x :: repeat x (n-1)
    in

    let nr_sources = List.length sources in
    let fingerprints =
      if check_signature then (
        match fingerprints with
        | [fingerprint] ->
          (* You're allowed to have multiple sources and one fingerprint: it
           * means that the same fingerprint is used for all sources.
           *)
          repeat fingerprint nr_sources
        | xs -> xs
      ) else
        (* We are not checking signatures, so just ignore any fingerprint
         * specified. *)
        repeat "" nr_sources in

    if List.length fingerprints <> nr_sources then
      error (f_"source and fingerprint lists are not the same length");

    (* Combine the sources and fingerprints into a single list of pairs. *)
    List.combine sources fingerprints in

  (* Check the architecture. *)
  let arch =
    match arch with
    | "" -> Guestfs_config.host_cpu
    | arch -> arch in
  let arch = normalize_arch arch in

  (* If user didn't elect any root password, that means we set a random
   * root password.
   *)
  let customize_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 "random" in
      { ops with ops = ops.ops @ [ `RootPassword pw ] }
    ) in

  { mode = mode; arg = arg;
    arch = arch; attach = attach; cache = cache;
    check_signature = check_signature; curl = curl;
    customize_ops = customize_ops;
    delete_on_failure = delete_on_failure; format = format;
    gpg = gpg; list_format = list_format; memsize = memsize;
    network = network; output = output;
    size = size; smp = smp; sources = sources; sync = sync;
    warn_if_partition = warn_if_partition;
  }