2 * Copyright (C) 2009-2010 Red Hat Inc.
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.
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.
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
19 (* Please read generator/README first. *)
26 open Generator_docstrings
27 open Generator_optgroups
28 open Generator_actions
29 open Generator_structs
32 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
33 let rec generate_perl_xs () =
34 generate_header CStyle LGPLv2plus;
44 #define PRId64 \"lld\"
48 my_newSVll(long long val) {
54 len = snprintf(buf, 100, \"%%\" PRId64, val);
55 return newSVpv(buf, len);
60 #define PRIu64 \"llu\"
64 my_newSVull(unsigned long long val) {
70 len = snprintf(buf, 100, \"%%\" PRIu64, val);
71 return newSVpv(buf, len);
75 /* http://www.perlmonks.org/?node_id=680842 */
77 XS_unpack_charPtrPtr (SV *arg) {
82 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
83 croak (\"array reference expected\");
85 av = (AV *)SvRV (arg);
86 ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
88 croak (\"malloc failed\");
90 for (i = 0; i <= av_len (av); i++) {
91 SV **elem = av_fetch (av, i, 0);
94 croak (\"missing element in list\");
96 ret[i] = SvPV_nolen (*elem);
104 #define PROGRESS_KEY \"_perl_progress_cb\"
107 _clear_progress_callback (guestfs_h *g)
109 guestfs_set_progress_callback (g, NULL, NULL);
110 SV *cb = guestfs_get_private (g, PROGRESS_KEY);
112 guestfs_set_private (g, PROGRESS_KEY, NULL);
117 /* http://www.perlmonks.org/?node=338857 */
119 _progress_callback (guestfs_h *g, void *cb,
120 int proc_nr, int serial, uint64_t position, uint64_t total)
126 XPUSHs (sv_2mortal (newSViv (proc_nr)));
127 XPUSHs (sv_2mortal (newSViv (serial)));
128 XPUSHs (sv_2mortal (my_newSVull (position)));
129 XPUSHs (sv_2mortal (my_newSVull (total)));
131 call_sv ((SV *) cb, G_VOID | G_DISCARD | G_EVAL);
137 _close_handle (guestfs_h *g)
140 _clear_progress_callback (g);
144 MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
151 RETVAL = guestfs_create ();
153 croak (\"could not create guestfs handle\");
154 guestfs_set_error_handler (RETVAL, NULL, NULL);
162 /* For the 'g' argument above we do the conversion explicitly and
163 * don't rely on the typemap, because if the handle has been
164 * explicitly closed we don't want the typemap conversion to
167 HV *hv = (HV *) SvRV (sv);
168 SV **svp = hv_fetch (hv, \"_g\", 2, 0);
170 guestfs_h *g = (guestfs_h *) SvIV (*svp);
179 /* Avoid double-free in DESTROY method. */
180 HV *hv = (HV *) SvRV (ST(0));
181 (void) hv_delete (hv, \"_g\", 2, G_DISCARD);
184 set_progress_callback (g, cb)
188 _clear_progress_callback (g);
190 guestfs_set_private (g, PROGRESS_KEY, cb);
191 guestfs_set_progress_callback (g, _progress_callback, cb);
194 clear_progress_callback (g)
197 _clear_progress_callback (g);
202 fun (name, style, _, _, _, _, _) ->
203 (match fst style with
204 | RErr -> pr "void\n"
205 | RInt _ -> pr "SV *\n"
206 | RInt64 _ -> pr "SV *\n"
207 | RBool _ -> pr "SV *\n"
208 | RConstString _ -> pr "SV *\n"
209 | RConstOptString _ -> pr "SV *\n"
210 | RString _ -> pr "SV *\n"
211 | RBufferOut _ -> pr "SV *\n"
213 | RStruct _ | RStructList _
215 pr "void\n" (* all lists returned implictly on the stack *)
217 (* Call and arguments. *)
220 fun arg -> pr ", %s" (name_of_argt arg)
223 pr " guestfs_h *g;\n";
227 | Pathname n | Device n | Dev_or_Path n | String n
228 | FileIn n | FileOut n | Key n ->
232 pr " size_t %s_size = SvCUR (ST(%d));\n" n (i+1)
234 (* http://www.perlmonks.org/?node_id=554277
235 * Note that the implicit handle argument means we have
236 * to add 1 to the ST(x) operator.
238 pr " char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
239 | StringList n | DeviceList n -> pr " char **%s;\n" n
240 | Bool n -> pr " int %s;\n" n
241 | Int n -> pr " int %s;\n" n
242 | Int64 n -> pr " int64_t %s;\n" n
245 (* PREINIT section (local variable declarations). *)
247 (match fst style with
256 pr " const char *r;\n";
257 | RConstOptString _ ->
258 pr " const char *r;\n";
261 | RStringList _ | RHashtable _ ->
263 pr " size_t i, n;\n";
264 | RStruct (_, typ) ->
265 pr " struct guestfs_%s *r;\n" typ;
266 | RStructList (_, typ) ->
267 pr " struct guestfs_%s_list *r;\n" typ;
272 pr " size_t size;\n";
275 (* CODE or PPCODE section. PPCODE is used where we are
276 * returning void, or where we push the return value on the stack
277 * ourselves. Using CODE means we will manipulate RETVAL.
279 (match fst style with
289 | RConstOptString n ->
293 | RStringList n | RHashtable n ->
302 (* The call to the C function. *)
303 pr " r = guestfs_%s " name;
304 generate_c_call_args ~handle:"g" style;
307 (* Cleanup any arguments. *)
310 | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
311 | Bool _ | Int _ | Int64 _
312 | FileIn _ | FileOut _
313 | BufferIn _ | Key _ -> ()
314 | StringList n | DeviceList n -> pr " free (%s);\n" n
317 (* Check return value for errors and return it if necessary. *)
318 (match fst style with
320 pr " if (r == -1)\n";
321 pr " croak (\"%%s\", guestfs_last_error (g));\n";
324 pr " if (r == -1)\n";
325 pr " croak (\"%%s\", guestfs_last_error (g));\n";
326 pr " RETVAL = newSViv (r);\n";
330 pr " if (r == -1)\n";
331 pr " croak (\"%%s\", guestfs_last_error (g));\n";
332 pr " RETVAL = my_newSVll (r);\n";
336 pr " if (r == NULL)\n";
337 pr " croak (\"%%s\", guestfs_last_error (g));\n";
338 pr " RETVAL = newSVpv (r, 0);\n";
341 | RConstOptString n ->
342 pr " if (r == NULL)\n";
343 pr " RETVAL = &PL_sv_undef;\n";
345 pr " RETVAL = newSVpv (r, 0);\n";
349 pr " if (r == NULL)\n";
350 pr " croak (\"%%s\", guestfs_last_error (g));\n";
351 pr " RETVAL = newSVpv (r, 0);\n";
355 | RStringList n | RHashtable n ->
356 pr " if (r == NULL)\n";
357 pr " croak (\"%%s\", guestfs_last_error (g));\n";
358 pr " for (n = 0; r[n] != NULL; ++n) /**/;\n";
359 pr " EXTEND (SP, n);\n";
360 pr " for (i = 0; i < n; ++i) {\n";
361 pr " PUSHs (sv_2mortal (newSVpv (r[i], 0)));\n";
362 pr " free (r[i]);\n";
365 | RStruct (n, typ) ->
366 let cols = cols_of_struct typ in
367 generate_perl_struct_code typ cols name style n
368 | RStructList (n, typ) ->
369 let cols = cols_of_struct typ in
370 generate_perl_struct_list_code typ cols name style n
372 pr " if (r == NULL)\n";
373 pr " croak (\"%%s\", guestfs_last_error (g));\n";
374 pr " RETVAL = newSVpvn (r, size);\n";
383 and generate_perl_struct_list_code typ cols name style n =
384 pr " if (r == NULL)\n";
385 pr " croak (\"%%s\", guestfs_last_error (g));\n";
386 pr " EXTEND (SP, r->len);\n";
387 pr " for (i = 0; i < r->len; ++i) {\n";
388 pr " hv = newHV ();\n";
392 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (r->val[i].%s, 0), 0);\n"
393 name (String.length name) name
395 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (r->val[i].%s, 32), 0);\n"
396 name (String.length name) name
398 pr " (void) hv_store (hv, \"%s\", %d, newSVpvn (r->val[i].%s, r->val[i].%s_len), 0);\n"
399 name (String.length name) name name
400 | name, (FBytes|FUInt64) ->
401 pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (r->val[i].%s), 0);\n"
402 name (String.length name) name
404 pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (r->val[i].%s), 0);\n"
405 name (String.length name) name
406 | name, (FInt32|FUInt32) ->
407 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (r->val[i].%s), 0);\n"
408 name (String.length name) name
410 pr " (void) hv_store (hv, \"%s\", %d, newSVpv (&r->val[i].%s, 1), 0);\n"
411 name (String.length name) name
412 | name, FOptPercent ->
413 pr " (void) hv_store (hv, \"%s\", %d, newSVnv (r->val[i].%s), 0);\n"
414 name (String.length name) name
416 pr " PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
418 pr " guestfs_free_%s_list (r);\n" typ
420 and generate_perl_struct_code typ cols name style n =
421 pr " if (r == NULL)\n";
422 pr " croak (\"%%s\", guestfs_last_error (g));\n";
423 pr " EXTEND (SP, 2 * %d);\n" (List.length cols);
425 fun ((name, _) as col) ->
426 pr " PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
430 pr " PUSHs (sv_2mortal (newSVpv (r->%s, 0)));\n"
433 pr " PUSHs (sv_2mortal (newSVpvn (r->%s, r->%s_len)));\n"
436 pr " PUSHs (sv_2mortal (newSVpv (r->%s, 32)));\n"
438 | name, (FBytes|FUInt64) ->
439 pr " PUSHs (sv_2mortal (my_newSVull (r->%s)));\n"
442 pr " PUSHs (sv_2mortal (my_newSVll (r->%s)));\n"
444 | name, (FInt32|FUInt32) ->
445 pr " PUSHs (sv_2mortal (newSVnv (r->%s)));\n"
448 pr " PUSHs (sv_2mortal (newSVpv (&r->%s, 1)));\n"
450 | name, FOptPercent ->
451 pr " PUSHs (sv_2mortal (newSVnv (r->%s)));\n"
456 (* Generate Sys/Guestfs.pm. *)
457 and generate_perl_pm () =
458 generate_header HashStyle LGPLv2plus;
465 Sys::Guestfs - Perl bindings for libguestfs
471 my $h = Sys::Guestfs->new ();
472 $h->add_drive ('guest.img');
474 $h->mount ('/dev/sda1', '/');
475 $h->touch ('/hello');
480 The C<Sys::Guestfs> module provides a Perl XS binding to the
481 libguestfs API for examining and modifying virtual machine
484 Amongst the things this is good for: making batch configuration
485 changes to guests, getting disk used/free statistics (see also:
486 virt-df), migrating between virtualization systems (see also:
487 virt-p2v), performing partial backups, performing partial guest
488 clones, cloning guests and changing registry/UUID/hostname info, and
491 Libguestfs uses Linux kernel and qemu code, and can access any type of
492 guest filesystem that Linux and qemu can, including but not limited
493 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
494 schemes, qcow, qcow2, vmdk.
496 Libguestfs provides ways to enumerate guest storage (eg. partitions,
497 LVs, what filesystem is in each LV, etc.). It can also run commands
498 in the context of the guest. Also you can access filesystems over
501 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
502 functions for using libguestfs from Perl, including integration
507 All errors turn into calls to C<croak> (see L<Carp(3)>).
515 package Sys::Guestfs;
520 # This version number changes whenever a new function
521 # is added to the libguestfs API. It is not directly
522 # related to the libguestfs version number.
523 use vars qw($VERSION);
527 XSLoader::load ('Sys::Guestfs');
529 =item $h = Sys::Guestfs->new ();
531 Create a new guestfs handle.
537 my $class = ref ($proto) || $proto;
539 my $g = Sys::Guestfs::_create ();
540 my $self = { _g => $g };
547 Explicitly close the guestfs handle.
549 B<Note:> You should not usually call this function. The handle will
550 be closed implicitly when its reference count goes to zero (eg.
551 when it goes out of scope or the program ends). This call is
552 only required in some exceptional cases, such as where the program
553 may contain cached references to the handle 'somewhere' and you
554 really have to have the close happen right away. After calling
555 C<close> the program must not call any method (including C<close>)
556 on the handle (but the implicit call to C<DESTROY> that happens
557 when the final reference is cleaned up is OK).
559 =item $h->set_progress_callback (\\&cb);
561 Set the progress notification callback for this handle
562 to the Perl closure C<cb>.
564 C<cb> will be called whenever a long-running operation
565 generates a progress notification message. The 4 parameters
566 to the function are: C<proc_nr>, C<serial>, C<position>
569 You should carefully read the documentation for
570 L<guestfs(3)/guestfs_set_progress_callback> before using
573 =item $h->clear_progress_callback ();
575 This removes any progress callback function associated with
582 (* Actions. We only need to print documentation for these as
583 * they are pulled in from the XS code automatically.
586 fun (name, style, _, flags, _, _, longdesc) ->
587 if not (List.mem NotInDocs flags) then (
588 let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
590 generate_perl_prototype name style;
592 pr "%s\n\n" longdesc;
593 if List.mem ProtocolLimitWarning flags then
594 pr "%s\n\n" protocol_limit_warning;
595 if List.mem DangerWillRobinson flags then
596 pr "%s\n\n" danger_will_robinson;
597 match deprecation_notice flags with
599 | Some txt -> pr "%s\n\n" txt
601 ) all_functions_sorted;
613 From time to time we add new libguestfs APIs. Also some libguestfs
614 APIs won't be available in all builds of libguestfs (the Fedora
615 build is full-featured, but other builds may disable features).
616 How do you test whether the APIs that your Perl program needs are
617 available in the version of C<Sys::Guestfs> that you are using?
619 To test if a particular function is available in the C<Sys::Guestfs>
620 class, use the ordinary Perl UNIVERSAL method C<can(METHOD)>
621 (see L<perlobj(1)>). For example:
624 if (defined (Sys::Guestfs->can (\"set_verbose\"))) {
625 print \"\\$h->set_verbose is available\\n\";
628 To test if particular features are supported by the current
629 build, use the L</available> method like the example below. Note
630 that the appliance must be launched first.
632 $h->available ( [\"augeas\"] );
634 Since the L</available> method croaks if the feature is not supported,
635 you might also want to wrap this in an eval and return a boolean.
636 In fact this has already been done for you: use
637 L<Sys::Guestfs::Lib(3)/feature_available>.
639 For further discussion on this topic, refer to
640 L<guestfs(3)/AVAILABILITY>.
642 =head1 STORING DATA IN THE HANDLE
644 The handle returned from L</new> is a hash reference. The hash
645 normally contains a single element:
648 _g => [private data used by libguestfs]
651 Callers can add other elements to this hash to store data for their own
652 purposes. The data lasts for the lifetime of the handle.
654 Any fields whose names begin with an underscore are reserved
655 for private use by libguestfs. We may add more in future.
657 It is recommended that callers prefix the name of their field(s)
658 with some unique string, to avoid conflicts with other users.
662 Copyright (C) %s Red Hat Inc.
666 Please see the file COPYING.LIB for the full license.
672 L<http://libguestfs.org>,
673 L<Sys::Guestfs::Lib(3)>.
678 and generate_perl_prototype name style =
679 (match fst style with
687 | RBufferOut n -> pr "$%s = " n
689 | RHashtable n -> pr "%%%s = " n
691 | RStructList (n,_) -> pr "@%s = " n
694 let comma = ref false in
697 if !comma then pr ", ";
700 | Pathname n | Device n | Dev_or_Path n | String n
701 | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n
702 | BufferIn n | Key n ->
704 | StringList n | DeviceList n ->