1 #!/usr/bin/ocamlrun ocaml
3 * Copyright (C) 2009 Red Hat Inc.
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19 * This script generates a large amount of code and documentation for
20 * all the daemon actions. To add a new action there are only two
21 * files you need to change, this one to describe the interface, and
22 * daemon/<somefile>.c to write the implementation.
30 | Int_Void (* int foo (guestfs_h); *)
31 | Int_String (* int foo (guestfs_h, const char * ); *)
32 | Int_StringString (* int foo (guestfs_h, const char *, const char * ); *)
35 ("mount", Int_StringString, [|"device"; "mountpoint"|],
36 "Mount a guest disk at a position in the filesystem",
38 Mount a guest disk at a position in the filesystem. Block devices
39 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
40 the guest. If those block devices contain partitions, they will have
41 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
44 The rules are the same as for L<mount(2)>: A filesystem must
45 first be mounted on C</> before others can be mounted. Other
46 filesystems can only be mounted on directories which already
49 ("sync", Int_Void, [||],
50 "Sync disks, writes are flushed through to the disk image",
52 This syncs the disk, so that any writes are flushed through to the
53 underlying disk image.
55 You should always call this if you have modified a disk image, before
56 calling C<guestfs_close>.");
58 ("touch", Int_String, [|"path"|],
59 "Update file timestamps or create a new file",
61 Touch acts like the L<touch(1)> command. It can be used to
62 update the filesystems on a file, or, if the file does not exist,
63 to create a new zero-length file.");
66 (* 'pr' prints to the current output file. *)
68 let pr fs = ksprintf (output_string !chan) fs
70 type comment_style = CStyle | HashStyle | OCamlStyle
71 type license = GPLv2 | LGPLv2
73 (* Generate a header block in a number of standard styles. *)
74 let rec generate_header comment license =
75 let c = match comment with
76 | CStyle -> pr "/* "; " *"
77 | HashStyle -> pr "# "; "#"
78 | OCamlStyle -> pr "(* "; " *" in
79 pr "libguestfs generated file\n";
80 pr "%s WARNING: This file is generated by 'src/generator.ml'.\n" c;
81 pr "%s Any changes you make to this file will be lost.\n" c;
83 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
87 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
88 pr "%s it under the terms of the GNU General Public License as published by\n" c;
89 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
90 pr "%s (at your option) any later version.\n" c;
92 pr "%s This program is distributed in the hope that it will be useful,\n" c;
93 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
94 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
95 pr "%s GNU General Public License for more details.\n" c;
97 pr "%s You should have received a copy of the GNU General Public License along\n" c;
98 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
99 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
102 pr "%s This library is free software; you can redistribute it and/or\n" c;
103 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
104 pr "%s License as published by the Free Software Foundation; either\n" c;
105 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
107 pr "%s This library is distributed in the hope that it will be useful,\n" c;
108 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
109 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
110 pr "%s Lesser General Public License for more details.\n" c;
112 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
113 pr "%s License along with this library; if not, write to the Free Software\n" c;
114 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
117 | CStyle -> pr " */\n"
119 | OCamlStyle -> pr " *)\n"
123 (* Generate the pod documentation for the C API. *)
124 and generate_pod () =
126 fun (shortname, style, params, _, longdesc) ->
127 let name = "guestfs_" ^ shortname in
128 pr "=head2 %s\n\n" name;
130 generate_prototype ~extern:false name style params;
135 (* Generate the protocol (XDR) file. *)
136 and generate_xdr () =
137 generate_header CStyle LGPLv2;
139 fun (shortname, style, params, _, longdesc) ->
140 let name = "guestfs_" ^ shortname in
141 pr "/* %s */\n" name;
147 (* Generate a single line prototype. *)
148 and generate_prototype ~extern ?(semi = true) ?(handle = "handle")
150 if extern then pr "extern ";
152 | Int_Void | Int_String | Int_StringString -> pr "int "
154 pr "%s (guestfs_h *%s" name handle;
158 pr ", const char *%s" params.(0)
159 | Int_StringString ->
160 pr ", const char *%s" params.(0);
161 pr ", const char *%s" params.(1)
166 let output_to filename =
167 let filename_new = filename ^ ".new" in
168 chan := open_out filename_new;
172 Unix.rename filename_new filename
178 let close = output_to "guestfs-actions.pod" in
182 let close = output_to "src/guestfs_protocol.x" in