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