ocaml: Remove the old OCaml viewer program.
[libguestfs.git] / generator / generator_fish.ml
1 (* libguestfs
2  * Copyright (C) 2009-2010 Red Hat Inc.
3  *
4  * This program is free software; you can redistribute it and/or modify
5  * it under the terms of the GNU General Public License as published by
6  * the Free Software Foundation; either version 2 of the License, or
7  * (at your option) any later version.
8  *
9  * This program is distributed in the hope that it will be useful,
10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12  * GNU General Public License for more details.
13  *
14  * You should have received a copy of the GNU General Public License
15  * along with this program; if not, write to the Free Software
16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
17  *)
18
19 (* Please read generator/README first. *)
20
21 open Printf
22
23 open Generator_types
24 open Generator_utils
25 open Generator_pr
26 open Generator_docstrings
27 open Generator_optgroups
28 open Generator_actions
29 open Generator_structs
30 open Generator_prepopts
31 open Generator_c
32
33 (* Generate a lot of different functions for guestfish. *)
34 let generate_fish_cmds () =
35   generate_header CStyle GPLv2plus;
36
37   let all_functions =
38     List.filter (
39       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
40     ) all_functions in
41   let all_functions_sorted =
42     List.filter (
43       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
44     ) all_functions_sorted in
45
46   let all_functions_and_fish_commands_sorted =
47     List.sort action_compare (all_functions_sorted @ fish_commands) in
48
49   pr "#include <config.h>\n";
50   pr "\n";
51   pr "#include <stdio.h>\n";
52   pr "#include <stdlib.h>\n";
53   pr "#include <string.h>\n";
54   pr "#include <inttypes.h>\n";
55   pr "\n";
56   pr "#include <guestfs.h>\n";
57   pr "#include \"c-ctype.h\"\n";
58   pr "#include \"full-write.h\"\n";
59   pr "#include \"xstrtol.h\"\n";
60   pr "#include \"fish.h\"\n";
61   pr "#include \"options.h\"\n";
62   pr "#include \"cmds_gperf.h\"\n";
63   pr "\n";
64   pr "/* Valid suffixes allowed for numbers.  See Gnulib xstrtol function. */\n";
65   pr "static const char *xstrtol_suffixes = \"0kKMGTPEZY\";\n";
66   pr "\n";
67
68   List.iter (
69     fun (name, _, _, _, _, _, _) ->
70       pr "static int run_%s (const char *cmd, size_t argc, char *argv[]);\n"
71         name
72   ) all_functions;
73
74   pr "\n";
75
76   (* List of command_entry structs. *)
77   List.iter (
78     fun (name, _, _, flags, _, shortdesc, longdesc) ->
79       pr "struct command_entry %s_cmd_entry = {\n" name;
80
81       let name2 = replace_char name '_' '-' in
82       pr "  .name = \"%s\",\n" name2;
83
84       let aliases =
85         filter_map (function FishAlias n -> Some n | _ -> None) flags in
86       let describe_alias =
87         if aliases <> [] then
88           sprintf "\n\nYou can use %s as an alias for this command."
89             (String.concat " or " (List.map (fun s -> "'" ^ s ^ "'") aliases))
90         else "" in
91
92       pr "  .shortdesc = \"%s\",\n" shortdesc;
93       pr "  .podbody = %S,\n"
94         ("=head1 DESCRIPTION\n\n" ^ longdesc ^ describe_alias);
95
96       pr "  .run = run_%s\n" name;
97       pr "};\n";
98       pr "\n";
99   ) fish_commands;
100
101   List.iter (
102     fun (name, (_, args, optargs), _, flags, _, shortdesc, longdesc) ->
103       pr "struct command_entry %s_cmd_entry = {\n" name;
104
105       let name2 = replace_char name '_' '-' in
106       pr "  .name = \"%s\",\n" name2;
107
108       let aliases =
109         filter_map (function FishAlias n -> Some n | _ -> None) flags in
110
111       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
112       let synopsis =
113         match args with
114         | [] -> name2
115         | args ->
116             let args = List.filter (function Key _ -> false | _ -> true) args in
117             sprintf "%s%s%s"
118               name2
119               (String.concat ""
120                  (List.map (fun arg -> " " ^ name_of_argt arg) args))
121               (String.concat ""
122                  (List.map (fun arg -> sprintf " [%s:..]" (name_of_argt arg)) optargs)) in
123
124       let warnings =
125         if List.exists (function Key _ -> true | _ -> false) args then
126           "\n\nThis command has one or more key or passphrase parameters.
127 Guestfish will prompt for these separately."
128         else "" in
129
130       let warnings =
131         warnings ^
132           if List.mem ProtocolLimitWarning flags then
133             ("\n\n" ^ protocol_limit_warning)
134           else "" in
135
136       (* For DangerWillRobinson commands, we should probably have
137        * guestfish prompt before allowing you to use them (especially
138        * in interactive mode). XXX
139        *)
140       let warnings =
141         warnings ^
142           if List.mem DangerWillRobinson flags then
143             ("\n\n" ^ danger_will_robinson)
144           else "" in
145
146       let warnings =
147         warnings ^
148           match deprecation_notice flags with
149           | None -> ""
150           | Some txt -> "\n\n" ^ txt in
151
152       let describe_alias =
153         if aliases <> [] then
154           sprintf "\n\nYou can use %s as an alias for this command."
155             (String.concat " or " (List.map (fun s -> "'" ^ s ^ "'") aliases))
156         else "" in
157
158       pr "  .shortdesc = \"%s\",\n" shortdesc;
159       pr "  .podbody = %S,\n"
160         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
161          "=head1 DESCRIPTION\n\n" ^
162          longdesc ^ warnings ^ describe_alias);
163
164       pr "  .run = run_%s\n" name;
165       pr "};\n";
166       pr "\n";
167   ) all_functions;
168
169   (* list_commands function, which implements guestfish -h *)
170   pr "void list_commands (void)\n";
171   pr "{\n";
172   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
173   pr "  list_builtin_commands ();\n";
174   List.iter (
175     fun (name, _, _, flags, _, shortdesc, _) ->
176       let name = replace_char name '_' '-' in
177       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
178         name shortdesc
179   ) all_functions_and_fish_commands_sorted;
180   pr "  printf (\"    %%s\\n\",";
181   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
182   pr "}\n";
183   pr "\n";
184
185   (* display_command function, which implements guestfish -h cmd *)
186   pr "int display_command (const char *cmd)\n";
187   pr "{\n";
188   pr "  const struct command_table *ct;\n";
189   pr "\n";
190   pr "  ct = lookup_fish_command (cmd, strlen (cmd));\n";
191   pr "  if (ct) {\n";
192   pr "    pod2text (ct->entry->name, ct->entry->shortdesc, ct->entry->podbody);\n";
193   pr "    return 0;\n";
194   pr "  }\n";
195   pr "  else\n";
196   pr "    return display_builtin_command (cmd);\n";
197   pr "}\n";
198   pr "\n";
199
200   let emit_print_list_function typ =
201     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
202       typ typ typ;
203     pr "{\n";
204     pr "  unsigned int i;\n";
205     pr "\n";
206     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
207     pr "    printf (\"[%%d] = {\\n\", i);\n";
208     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
209     pr "    printf (\"}\\n\");\n";
210     pr "  }\n";
211     pr "}\n";
212     pr "\n";
213   in
214
215   (* print_* functions *)
216   List.iter (
217     fun (typ, cols) ->
218       let needs_i =
219         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
220
221       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
222       pr "{\n";
223       if needs_i then (
224         pr "  unsigned int i;\n";
225         pr "\n"
226       );
227       List.iter (
228         function
229         | name, FString ->
230             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
231         | name, FUUID ->
232             pr "  printf (\"%%s%s: \", indent);\n" name;
233             pr "  for (i = 0; i < 32; ++i)\n";
234             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
235             pr "  printf (\"\\n\");\n"
236         | name, FBuffer ->
237             pr "  printf (\"%%s%s: \", indent);\n" name;
238             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
239             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
240             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
241             pr "    else\n";
242             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
243             pr "  printf (\"\\n\");\n"
244         | name, (FUInt64|FBytes) ->
245             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
246               name typ name
247         | name, FInt64 ->
248             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
249               name typ name
250         | name, FUInt32 ->
251             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
252               name typ name
253         | name, FInt32 ->
254             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
255               name typ name
256         | name, FChar ->
257             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
258               name typ name
259         | name, FOptPercent ->
260             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
261               typ name name typ name;
262             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
263       ) cols;
264       pr "}\n";
265       pr "\n";
266   ) structs;
267
268   (* Emit a print_TYPE_list function definition only if that function is used. *)
269   List.iter (
270     function
271     | typ, (RStructListOnly | RStructAndList) ->
272         (* generate the function for typ *)
273         emit_print_list_function typ
274     | typ, _ -> () (* empty *)
275   ) (rstructs_used_by all_functions);
276
277   (* Emit a print_TYPE function definition only if that function is used. *)
278   List.iter (
279     function
280     | typ, (RStructOnly | RStructAndList) ->
281         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
282         pr "{\n";
283         pr "  print_%s_indent (%s, \"\");\n" typ typ;
284         pr "}\n";
285         pr "\n";
286     | typ, _ -> () (* empty *)
287   ) (rstructs_used_by all_functions);
288
289   (* run_<action> actions *)
290   List.iter (
291     fun (name, (ret, args, optargs as style), _, flags, _, _, _) ->
292       pr "static int\n";
293       pr "run_%s (const char *cmd, size_t argc, char *argv[])\n" name;
294       pr "{\n";
295       (match ret with
296        | RErr
297        | RInt _
298        | RBool _ -> pr "  int r;\n"
299        | RInt64 _ -> pr "  int64_t r;\n"
300        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
301        | RString _ -> pr "  char *r;\n"
302        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
303        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
304        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
305        | RBufferOut _ ->
306            pr "  char *r;\n";
307            pr "  size_t size;\n";
308       );
309       List.iter (
310         function
311         | Device n
312         | String n
313         | OptString n -> pr "  const char *%s;\n" n
314         | Pathname n
315         | Dev_or_Path n
316         | FileIn n
317         | FileOut n
318         | Key n -> pr "  char *%s;\n" n
319         | BufferIn n ->
320             pr "  const char *%s;\n" n;
321             pr "  size_t %s_size;\n" n
322         | StringList n | DeviceList n -> pr "  char **%s;\n" n
323         | Bool n -> pr "  int %s;\n" n
324         | Int n -> pr "  int %s;\n" n
325         | Int64 n -> pr "  int64_t %s;\n" n
326       ) args;
327
328       if optargs <> [] then (
329         pr "  struct guestfs_%s_argv optargs_s = { .bitmask = 0 };\n" name;
330         pr "  struct guestfs_%s_argv *optargs = &optargs_s;\n" name
331       );
332
333       if args <> [] || optargs <> [] then
334         pr "  size_t i = 0;\n";
335
336       pr "\n";
337
338       (* Check and convert parameters. *)
339       let argc_minimum, argc_maximum =
340         let args_no_keys =
341           List.filter (function Key _ -> false | _ -> true) args in
342         let argc_minimum = List.length args_no_keys in
343         let argc_maximum = argc_minimum + List.length optargs in
344         argc_minimum, argc_maximum in
345
346       if argc_minimum = argc_maximum then (
347         pr "  if (argc != %d) {\n" argc_minimum;
348         pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
349           argc_minimum;
350       ) else (
351         pr "  if (argc < %d || argc > %d) {\n" argc_minimum argc_maximum;
352         pr "    fprintf (stderr, _(\"%%s should have %%d-%%d parameter(s)\\n\"), cmd, %d, %d);\n"
353           argc_minimum argc_maximum;
354       );
355       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
356       pr "    return -1;\n";
357       pr "  }\n";
358
359       let parse_integer expr fn fntyp rtyp range name =
360         pr "  {\n";
361         pr "    strtol_error xerr;\n";
362         pr "    %s r;\n" fntyp;
363         pr "\n";
364         pr "    xerr = %s (%s, NULL, 0, &r, xstrtol_suffixes);\n" fn expr;
365         pr "    if (xerr != LONGINT_OK) {\n";
366         pr "      fprintf (stderr,\n";
367         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
368         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
369         pr "      return -1;\n";
370         pr "    }\n";
371         (match range with
372          | None -> ()
373          | Some (min, max, comment) ->
374              pr "    /* %s */\n" comment;
375              pr "    if (r < %s || r > %s) {\n" min max;
376              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
377                name;
378              pr "      return -1;\n";
379              pr "    }\n";
380              pr "    /* The check above should ensure this assignment does not overflow. */\n";
381         );
382         pr "    %s = r;\n" name;
383         pr "  }\n";
384       in
385
386       List.iter (
387         function
388         | Device name
389         | String name ->
390             pr "  %s = argv[i++];\n" name
391         | Pathname name
392         | Dev_or_Path name ->
393             pr "  %s = resolve_win_path (argv[i++]);\n" name;
394             pr "  if (%s == NULL) return -1;\n" name
395         | OptString name ->
396             pr "  %s = STRNEQ (argv[i], \"\") ? argv[i] : NULL;\n" name;
397             pr "  i++;\n"
398         | BufferIn name ->
399             pr "  %s = argv[i];\n" name;
400             pr "  %s_size = strlen (argv[i]);\n" name;
401             pr "  i++;\n"
402         | FileIn name ->
403             pr "  %s = file_in (argv[i++]);\n" name;
404             pr "  if (%s == NULL) return -1;\n" name
405         | FileOut name ->
406             pr "  %s = file_out (argv[i++]);\n" name;
407             pr "  if (%s == NULL) return -1;\n" name
408         | StringList name | DeviceList name ->
409             pr "  %s = parse_string_list (argv[i++]);\n" name;
410             pr "  if (%s == NULL) return -1;\n" name
411         | Key name ->
412             pr "  %s = read_key (\"%s\");\n" name name;
413             pr "  if (%s == NULL) return -1;\n" name
414         | Bool name ->
415             pr "  %s = is_true (argv[i++]) ? 1 : 0;\n" name
416         | Int name ->
417             let range =
418               let min = "(-(2LL<<30))"
419               and max = "((2LL<<30)-1)"
420               and comment =
421                 "The Int type in the generator is a signed 31 bit int." in
422               Some (min, max, comment) in
423             parse_integer "argv[i++]" "xstrtoll" "long long" "int" range name
424         | Int64 name ->
425             parse_integer "argv[i++]" "xstrtoll" "long long" "int64_t" None name
426       ) args;
427
428       (* Optional arguments are prefixed with <argname>:<value> and
429        * may be missing, so we need to parse those until the end of
430        * the argument list.
431        *)
432       if optargs <> [] then (
433         let uc_name = String.uppercase name in
434         pr "\n";
435         pr "  for (; i < argc; ++i) {\n";
436         pr "    uint64_t this_mask;\n";
437         pr "    const char *this_arg;\n";
438         pr "\n";
439         pr "    ";
440         List.iter (
441           fun argt ->
442             let n = name_of_argt argt in
443             let uc_n = String.uppercase n in
444             let len = String.length n in
445             pr "if (STRPREFIX (argv[i], \"%s:\")) {\n" n;
446             (match argt with
447              | Bool n ->
448                  pr "      optargs_s.%s = is_true (&argv[i][%d]) ? 1 : 0;\n"
449                    n (len+1);
450              | Int n ->
451                  let range =
452                    let min = "(-(2LL<<30))"
453                    and max = "((2LL<<30)-1)"
454                    and comment =
455                      "The Int type in the generator is a signed 31 bit int." in
456                    Some (min, max, comment) in
457                  let expr = sprintf "&argv[i][%d]" (len+1) in
458                  parse_integer expr "xstrtoll" "long long" "int" range name
459              | Int64 n ->
460                  let expr = sprintf "&argv[i][%d]" (len+1) in
461                  parse_integer expr "xstrtoll" "long long" "int64_t" None name
462              | String n ->
463                  pr "      optargs_s.%s = &argv[i][%d];\n" n (len+1);
464              | _ -> assert false
465             );
466             pr "      this_mask = GUESTFS_%s_%s_BITMASK;\n" uc_name uc_n;
467             pr "      this_arg = \"%s\";\n" n;
468             pr "    }\n";
469             pr "    else ";
470         ) optargs;
471
472         pr "{\n";
473         pr "      fprintf (stderr, _(\"%%s: unknown optional argument \\\"%%s\\\"\\n\"),\n";
474         pr "               cmd, argv[i]);\n";
475         pr "      return -1;\n";
476         pr "    }\n";
477         pr "\n";
478         pr "    if (optargs_s.bitmask & this_mask) {\n";
479         pr "      fprintf (stderr, _(\"%%s: optional argument \\\"%%s\\\" given twice\\n\"),\n";
480         pr "               cmd, this_arg);\n";
481         pr "      return -1;\n";
482         pr "    }\n";
483         pr "    optargs_s.bitmask |= this_mask;\n";
484         pr "  }\n";
485         pr "\n";
486       );
487
488       (* Call C API function. *)
489       if optargs = [] then
490         pr "  r = guestfs_%s " name
491       else
492         pr "  r = guestfs_%s_argv " name;
493       generate_c_call_args ~handle:"g" style;
494       pr ";\n";
495
496       List.iter (
497         function
498         | Device _ | String _
499         | OptString _ | Bool _
500         | Int _ | Int64 _
501         | BufferIn _ -> ()
502         | Pathname name | Dev_or_Path name | FileOut name
503         | Key name ->
504             pr "  free (%s);\n" name
505         | FileIn name ->
506             pr "  free_file_in (%s);\n" name
507         | StringList name | DeviceList name ->
508             pr "  free_strings (%s);\n" name
509       ) args;
510
511       (* Any output flags? *)
512       let fish_output =
513         let flags = filter_map (
514           function FishOutput flag -> Some flag | _ -> None
515         ) flags in
516         match flags with
517         | [] -> None
518         | [f] -> Some f
519         | _ ->
520             failwithf "%s: more than one FishOutput flag is not allowed" name in
521
522       (* Check return value for errors and display command results. *)
523       (match ret with
524        | RErr -> pr "  return r;\n"
525        | RInt _ ->
526            pr "  if (r == -1) return -1;\n";
527            (match fish_output with
528             | None ->
529                 pr "  printf (\"%%d\\n\", r);\n";
530             | Some FishOutputOctal ->
531                 pr "  printf (\"%%s%%o\\n\", r != 0 ? \"0\" : \"\", r);\n";
532             | Some FishOutputHexadecimal ->
533                 pr "  printf (\"%%s%%x\\n\", r != 0 ? \"0x\" : \"\", r);\n");
534            pr "  return 0;\n"
535        | RInt64 _ ->
536            pr "  if (r == -1) return -1;\n";
537            (match fish_output with
538             | None ->
539                 pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
540             | Some FishOutputOctal ->
541                 pr "  printf (\"%%s%%\" PRIo64 \"\\n\", r != 0 ? \"0\" : \"\", r);\n";
542             | Some FishOutputHexadecimal ->
543                 pr "  printf (\"%%s%%\" PRIx64 \"\\n\", r != 0 ? \"0x\" : \"\", r);\n");
544            pr "  return 0;\n"
545        | RBool _ ->
546            pr "  if (r == -1) return -1;\n";
547            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
548            pr "  return 0;\n"
549        | RConstString _ ->
550            pr "  if (r == NULL) return -1;\n";
551            pr "  printf (\"%%s\\n\", r);\n";
552            pr "  return 0;\n"
553        | RConstOptString _ ->
554            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
555            pr "  return 0;\n"
556        | RString _ ->
557            pr "  if (r == NULL) return -1;\n";
558            pr "  printf (\"%%s\\n\", r);\n";
559            pr "  free (r);\n";
560            pr "  return 0;\n"
561        | RStringList _ ->
562            pr "  if (r == NULL) return -1;\n";
563            pr "  print_strings (r);\n";
564            pr "  free_strings (r);\n";
565            pr "  return 0;\n"
566        | RStruct (_, typ) ->
567            pr "  if (r == NULL) return -1;\n";
568            pr "  print_%s (r);\n" typ;
569            pr "  guestfs_free_%s (r);\n" typ;
570            pr "  return 0;\n"
571        | RStructList (_, typ) ->
572            pr "  if (r == NULL) return -1;\n";
573            pr "  print_%s_list (r);\n" typ;
574            pr "  guestfs_free_%s_list (r);\n" typ;
575            pr "  return 0;\n"
576        | RHashtable _ ->
577            pr "  if (r == NULL) return -1;\n";
578            pr "  print_table (r);\n";
579            pr "  free_strings (r);\n";
580            pr "  return 0;\n"
581        | RBufferOut _ ->
582            pr "  if (r == NULL) return -1;\n";
583            pr "  if (full_write (1, r, size) != size) {\n";
584            pr "    perror (\"write\");\n";
585            pr "    free (r);\n";
586            pr "    return -1;\n";
587            pr "  }\n";
588            pr "  free (r);\n";
589            pr "  return 0;\n"
590       );
591       pr "}\n";
592       pr "\n"
593   ) all_functions;
594
595   (* run_action function *)
596   pr "int\n";
597   pr "run_action (const char *cmd, size_t argc, char *argv[])\n";
598   pr "{\n";
599   pr "  const struct command_table *ct;\n";
600   pr "\n";
601   pr "  ct = lookup_fish_command (cmd, strlen (cmd));\n";
602   pr "  if (ct)\n";
603   pr "    return ct->entry->run (cmd, argc, argv);\n";
604   pr "  else {\n";
605   pr "    fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
606   pr "    if (command_num == 1)\n";
607   pr "      extended_help_message ();\n";
608   pr "    return -1;\n";
609   pr "  }\n";
610   pr "}\n"
611
612 (* gperf code to do fast lookups of commands. *)
613 and generate_fish_cmds_gperf () =
614   generate_header CStyle GPLv2plus;
615
616   let all_functions_sorted =
617     List.filter (
618       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
619     ) all_functions_sorted in
620
621   let all_functions_and_fish_commands_sorted =
622     List.sort action_compare (all_functions_sorted @ fish_commands) in
623
624   pr "\
625 %%language=ANSI-C
626 %%define lookup-function-name lookup_fish_command
627 %%ignore-case
628 %%readonly-tables
629 %%null-strings
630
631 %%{
632
633 #include <config.h>
634
635 #include <stdlib.h>
636 #include <string.h>
637
638 #include \"cmds_gperf.h\"
639
640 ";
641
642   List.iter (
643     fun (name, _, _, _, _, _, _) ->
644       pr "extern struct command_entry %s_cmd_entry;\n" name
645   ) all_functions_and_fish_commands_sorted;
646
647   pr "\
648 %%}
649
650 struct command_table;
651
652 %%%%
653 ";
654
655   List.iter (
656     fun (name, _, _, flags, _, _, _) ->
657       let name2 = replace_char name '_' '-' in
658       let aliases =
659         filter_map (function FishAlias n -> Some n | _ -> None) flags in
660
661       (* The basic command. *)
662       pr "%s, &%s_cmd_entry\n" name name;
663
664       (* Command with dashes instead of underscores. *)
665       if name <> name2 then
666         pr "%s, &%s_cmd_entry\n" name2 name;
667
668       (* Aliases for the command. *)
669       List.iter (
670         fun alias ->
671           pr "%s, &%s_cmd_entry\n" alias name;
672       ) aliases;
673   ) all_functions_and_fish_commands_sorted
674
675 (* Readline completion for guestfish. *)
676 and generate_fish_completion () =
677   generate_header CStyle GPLv2plus;
678
679   let all_functions =
680     List.filter (
681       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
682     ) all_functions in
683
684   pr "\
685 #include <config.h>
686
687 #include <stdio.h>
688 #include <stdlib.h>
689 #include <string.h>
690
691 #ifdef HAVE_LIBREADLINE
692 #include <readline/readline.h>
693 #endif
694
695 #include \"fish.h\"
696
697 #ifdef HAVE_LIBREADLINE
698
699 static const char *const commands[] = {
700   BUILTIN_COMMANDS_FOR_COMPLETION,
701 ";
702
703   (* Get the commands, including the aliases.  They don't need to be
704    * sorted - the generator() function just does a dumb linear search.
705    *)
706   let commands =
707     List.map (
708       fun (name, _, _, flags, _, _, _) ->
709         let name2 = replace_char name '_' '-' in
710         let aliases =
711           filter_map (function FishAlias n -> Some n | _ -> None) flags in
712         name2 :: aliases
713     ) (all_functions @ fish_commands) in
714   let commands = List.flatten commands in
715
716   List.iter (pr "  \"%s\",\n") commands;
717
718   pr "  NULL
719 };
720
721 static char *
722 generator (const char *text, int state)
723 {
724   static size_t index, len;
725   const char *name;
726
727   if (!state) {
728     index = 0;
729     len = strlen (text);
730   }
731
732   rl_attempted_completion_over = 1;
733
734   while ((name = commands[index]) != NULL) {
735     index++;
736     if (STRCASEEQLEN (name, text, len))
737       return strdup (name);
738   }
739
740   return NULL;
741 }
742
743 #endif /* HAVE_LIBREADLINE */
744
745 #ifdef HAVE_RL_COMPLETION_MATCHES
746 #define RL_COMPLETION_MATCHES rl_completion_matches
747 #else
748 #ifdef HAVE_COMPLETION_MATCHES
749 #define RL_COMPLETION_MATCHES completion_matches
750 #endif
751 #endif /* else just fail if we don't have either symbol */
752
753 char **
754 do_completion (const char *text, int start, int end)
755 {
756   char **matches = NULL;
757
758 #ifdef HAVE_LIBREADLINE
759   rl_completion_append_character = ' ';
760
761   if (start == 0)
762     matches = RL_COMPLETION_MATCHES (text, generator);
763   else if (complete_dest_paths)
764     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
765 #endif
766
767   return matches;
768 }
769 ";
770
771 (* Generate the POD documentation for guestfish. *)
772 and generate_fish_actions_pod () =
773   let all_functions_sorted =
774     List.filter (
775       fun (_, _, _, flags, _, _, _) ->
776         not (List.mem NotInFish flags || List.mem NotInDocs flags)
777     ) all_functions_sorted in
778
779   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
780
781   List.iter (
782     fun (name, (_, args, optargs), _, flags, _, _, longdesc) ->
783       let longdesc =
784         Str.global_substitute rex (
785           fun s ->
786             let sub =
787               try Str.matched_group 1 s
788               with Not_found ->
789                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
790             "L</" ^ replace_char sub '_' '-' ^ ">"
791         ) longdesc in
792       let name = replace_char name '_' '-' in
793       let aliases =
794         filter_map (function FishAlias n -> Some n | _ -> None) flags in
795
796       List.iter (
797         fun name ->
798           pr "=head2 %s\n\n" name
799       ) (name :: aliases);
800       pr " %s" name;
801       List.iter (
802         function
803         | Pathname n | Device n | Dev_or_Path n | String n ->
804             pr " %s" n
805         | OptString n -> pr " %s" n
806         | StringList n | DeviceList n -> pr " '%s ...'" n
807         | Bool _ -> pr " true|false"
808         | Int n -> pr " %s" n
809         | Int64 n -> pr " %s" n
810         | FileIn n | FileOut n -> pr " (%s|-)" n
811         | BufferIn n -> pr " %s" n
812         | Key _ -> () (* keys are entered at a prompt *)
813       ) args;
814       List.iter (
815         function
816         | Bool n | Int n | Int64 n | String n -> pr " [%s:..]" n
817         | _ -> assert false
818       ) optargs;
819       pr "\n";
820       pr "\n";
821       pr "%s\n\n" longdesc;
822
823       if List.exists (function FileIn _ | FileOut _ -> true
824                       | _ -> false) args then
825         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
826
827       if List.exists (function Key _ -> true | _ -> false) args then
828         pr "This command has one or more key or passphrase parameters.
829 Guestfish will prompt for these separately.\n\n";
830
831       if optargs <> [] then
832         pr "This command has one or more optional arguments.  See L</OPTIONAL ARGUMENTS>.\n\n";
833
834       if List.mem ProtocolLimitWarning flags then
835         pr "%s\n\n" protocol_limit_warning;
836
837       if List.mem DangerWillRobinson flags then
838         pr "%s\n\n" danger_will_robinson;
839
840       match deprecation_notice flags with
841       | None -> ()
842       | Some txt -> pr "%s\n\n" txt
843   ) all_functions_sorted
844
845 (* Generate documentation for guestfish-only commands. *)
846 and generate_fish_commands_pod () =
847   List.iter (
848     fun (name, _, _, flags, _, _, longdesc) ->
849       let name = replace_char name '_' '-' in
850       let aliases =
851         filter_map (function FishAlias n -> Some n | _ -> None) flags in
852
853       List.iter (
854         fun name ->
855           pr "=head2 %s\n\n" name
856       ) (name :: aliases);
857       pr "%s\n\n" longdesc;
858   ) fish_commands
859
860 and generate_fish_prep_options_h () =
861   generate_header CStyle GPLv2plus;
862
863   pr "#ifndef PREPOPTS_H\n";
864   pr "\n";
865
866   pr "\
867 struct prep {
868   const char *name;             /* eg. \"fs\" */
869
870   size_t nr_params;             /* optional parameters */
871   struct prep_param *params;
872
873   const char *shortdesc;        /* short description */
874   const char *longdesc;         /* long description */
875
876                                 /* functions to implement it */
877   void (*prelaunch) (const char *filename, prep_data *);
878   void (*postlaunch) (const char *filename, prep_data *, const char *device);
879 };
880
881 struct prep_param {
882   const char *pname;            /* parameter name */
883   const char *pdefault;         /* parameter default */
884   const char *pdesc;            /* parameter description */
885 };
886
887 extern const struct prep preps[];
888 #define NR_PREPS %d
889
890 " (List.length prepopts);
891
892   List.iter (
893     fun (name, shortdesc, args, longdesc) ->
894       pr "\
895 extern void prep_prelaunch_%s (const char *filename, prep_data *data);
896 extern void prep_postlaunch_%s (const char *filename, prep_data *data, const char *device);
897
898 " name name;
899   ) prepopts;
900
901   pr "\n";
902   pr "#endif /* PREPOPTS_H */\n"
903
904 and generate_fish_prep_options_c () =
905   generate_header CStyle GPLv2plus;
906
907   pr "\
908 #include \"fish.h\"
909 #include \"prepopts.h\"
910
911 ";
912
913   List.iter (
914     fun (name, shortdesc, args, longdesc) ->
915       pr "static struct prep_param %s_args[] = {\n" name;
916       List.iter (
917         fun (n, default, desc) ->
918           pr "  { \"%s\", \"%s\", \"%s\" },\n" n default desc
919       ) args;
920       pr "};\n";
921       pr "\n";
922   ) prepopts;
923
924   pr "const struct prep preps[] = {\n";
925   List.iter (
926     fun (name, shortdesc, args, longdesc) ->
927       pr "  { \"%s\", %d, %s_args,
928     \"%s\",
929     \"%s\",
930     prep_prelaunch_%s, prep_postlaunch_%s },
931 "
932         name (List.length args) name
933         (c_quote shortdesc) (c_quote longdesc)
934         name name;
935   ) prepopts;
936   pr "};\n"