ubuntu: Add extra suppressions for libnl.1 leaks.
[libguestfs.git] / generator / generator_perl.ml
1 (* libguestfs
2  * Copyright (C) 2009-2011 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_c
31 open Generator_events
32
33 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
34 let rec generate_perl_xs () =
35   generate_header CStyle LGPLv2plus;
36
37   pr "\
38 #include \"EXTERN.h\"
39 #include \"perl.h\"
40 #include \"XSUB.h\"
41
42 #include <guestfs.h>
43
44 #ifndef PRId64
45 #define PRId64 \"lld\"
46 #endif
47
48 static SV *
49 my_newSVll(long long val) {
50 #ifdef USE_64_BIT_ALL
51   return newSViv(val);
52 #else
53   char buf[100];
54   int len;
55   len = snprintf(buf, 100, \"%%\" PRId64, val);
56   return newSVpv(buf, len);
57 #endif
58 }
59
60 #ifndef PRIu64
61 #define PRIu64 \"llu\"
62 #endif
63
64 static SV *
65 my_newSVull(unsigned long long val) {
66 #ifdef USE_64_BIT_ALL
67   return newSVuv(val);
68 #else
69   char buf[100];
70   int len;
71   len = snprintf(buf, 100, \"%%\" PRIu64, val);
72   return newSVpv(buf, len);
73 #endif
74 }
75
76 /* http://www.perlmonks.org/?node_id=680842 */
77 static char **
78 XS_unpack_charPtrPtr (SV *arg) {
79   char **ret;
80   AV *av;
81   I32 i;
82
83   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
84     croak (\"array reference expected\");
85
86   av = (AV *)SvRV (arg);
87   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
88   if (!ret)
89     croak (\"malloc failed\");
90
91   for (i = 0; i <= av_len (av); i++) {
92     SV **elem = av_fetch (av, i, 0);
93
94     if (!elem || !*elem)
95       croak (\"missing element in list\");
96
97     ret[i] = SvPV_nolen (*elem);
98   }
99
100   ret[i] = NULL;
101
102   return ret;
103 }
104
105 /* http://www.perlmonks.org/?node=338857 */
106 static void
107 _event_callback_wrapper (guestfs_h *g,
108                          void *cb,
109                          uint64_t event,
110                          int event_handle,
111                          int flags,
112                          const char *buf, size_t buf_len,
113                          const uint64_t *array, size_t array_len)
114 {
115   dSP;
116   ENTER;
117   SAVETMPS;
118   PUSHMARK (SP);
119   XPUSHs (sv_2mortal (my_newSVull (event)));
120   XPUSHs (sv_2mortal (newSViv (event_handle)));
121   XPUSHs (sv_2mortal (newSVpvn (buf ? buf : \"\", buf_len)));
122   AV *av = newAV ();
123   size_t i;
124   for (i = 0; i < array_len; ++i)
125     av_push (av, my_newSVull (array[i]));
126   XPUSHs (sv_2mortal (newRV ((SV *) av)));
127   PUTBACK;
128   call_sv ((SV *) cb, G_VOID | G_DISCARD | G_EVAL);
129   FREETMPS;
130   LEAVE;
131 }
132
133 static SV **
134 get_all_event_callbacks (guestfs_h *g, size_t *len_rtn)
135 {
136   SV **r;
137   size_t i;
138   const char *key;
139   SV *cb;
140
141   /* Count the length of the array that will be needed. */
142   *len_rtn = 0;
143   cb = guestfs_first_private (g, &key);
144   while (cb != NULL) {
145     if (strncmp (key, \"_perl_event_\", strlen (\"_perl_event_\")) == 0)
146       (*len_rtn)++;
147     cb = guestfs_next_private (g, &key);
148   }
149
150   /* Copy them into the return array. */
151   r = guestfs_safe_malloc (g, sizeof (SV *) * (*len_rtn));
152
153   i = 0;
154   cb = guestfs_first_private (g, &key);
155   while (cb != NULL) {
156     if (strncmp (key, \"_perl_event_\", strlen (\"_perl_event_\")) == 0) {
157       r[i] = cb;
158       i++;
159     }
160     cb = guestfs_next_private (g, &key);
161   }
162
163   return r;
164 }
165
166 static void
167 _close_handle (guestfs_h *g)
168 {
169   size_t i, len;
170   SV **cbs;
171
172   assert (g != NULL);
173
174   /* As in the OCaml bindings, there is a hard to solve case where the
175    * caller can delete a callback from within the callback, resulting
176    * in a double-free here.  XXX
177    */
178   cbs = get_all_event_callbacks (g, &len);
179
180   guestfs_close (g);
181
182   for (i = 0; i < len; ++i)
183     SvREFCNT_dec (cbs[i]);
184 }
185
186 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
187
188 PROTOTYPES: ENABLE
189
190 guestfs_h *
191 _create ()
192    CODE:
193       RETVAL = guestfs_create ();
194       if (!RETVAL)
195         croak (\"could not create guestfs handle\");
196       guestfs_set_error_handler (RETVAL, NULL, NULL);
197  OUTPUT:
198       RETVAL
199
200 void
201 DESTROY (sv)
202       SV *sv;
203  PPCODE:
204       /* For the 'g' argument above we do the conversion explicitly and
205        * don't rely on the typemap, because if the handle has been
206        * explicitly closed we don't want the typemap conversion to
207        * display an error.
208        */
209       HV *hv = (HV *) SvRV (sv);
210       SV **svp = hv_fetch (hv, \"_g\", 2, 0);
211       if (svp != NULL) {
212         guestfs_h *g = (guestfs_h *) SvIV (*svp);
213         _close_handle (g);
214       }
215
216 void
217 close (g)
218       guestfs_h *g;
219  PPCODE:
220       _close_handle (g);
221       /* Avoid double-free in DESTROY method. */
222       HV *hv = (HV *) SvRV (ST(0));
223       (void) hv_delete (hv, \"_g\", 2, G_DISCARD);
224
225 SV *
226 set_event_callback (g, cb, event_bitmask)
227       guestfs_h *g;
228       SV *cb;
229       int event_bitmask;
230 PREINIT:
231       int eh;
232       char key[64];
233    CODE:
234       eh = guestfs_set_event_callback (g, _event_callback_wrapper,
235                                        event_bitmask, 0, cb);
236       if (eh == -1)
237         croak (\"%%s\", guestfs_last_error (g));
238
239       /* Increase the refcount for this callback, since we are storing
240        * it in the opaque C libguestfs handle.  We need to remember that
241        * we did this, so we can decrease the refcount for all undeleted
242        * callbacks left around at close time (see _close_handle).
243        */
244       SvREFCNT_inc (cb);
245
246       snprintf (key, sizeof key, \"_perl_event_%%d\", eh);
247       guestfs_set_private (g, key, cb);
248
249       RETVAL = newSViv (eh);
250  OUTPUT:
251       RETVAL
252
253 void
254 delete_event_callback (g, event_handle)
255       guestfs_h *g;
256       int event_handle;
257 PREINIT:
258       char key[64];
259       SV *cb;
260    CODE:
261       snprintf (key, sizeof key, \"_perl_event_%%d\", event_handle);
262       cb = guestfs_get_private (g, key);
263       if (cb) {
264         SvREFCNT_dec (cb);
265         guestfs_set_private (g, key, NULL);
266         guestfs_delete_event_callback (g, event_handle);
267       }
268
269 SV *
270 last_errno (g)
271       guestfs_h *g;
272 PREINIT:
273       int errnum;
274    CODE:
275       errnum = guestfs_last_errno (g);
276       RETVAL = newSViv (errnum);
277  OUTPUT:
278       RETVAL
279
280 void
281 user_cancel (g)
282       guestfs_h *g;
283  PPCODE:
284       guestfs_user_cancel (g);
285
286 ";
287
288   List.iter (
289     fun (name, (ret, args, optargs as style), _, _, _, _, _) ->
290       (match ret with
291        | RErr -> pr "void\n"
292        | RInt _ -> pr "SV *\n"
293        | RInt64 _ -> pr "SV *\n"
294        | RBool _ -> pr "SV *\n"
295        | RConstString _ -> pr "SV *\n"
296        | RConstOptString _ -> pr "SV *\n"
297        | RString _ -> pr "SV *\n"
298        | RBufferOut _ -> pr "SV *\n"
299        | RStringList _
300        | RStruct _ | RStructList _
301        | RHashtable _ ->
302            pr "void\n" (* all lists returned implictly on the stack *)
303       );
304       (* Call and arguments. *)
305       pr "%s (g" name;
306       List.iter (
307         fun arg -> pr ", %s" (name_of_argt arg)
308       ) args;
309       if optargs <> [] then
310         pr ", ...";
311       pr ")\n";
312       pr "      guestfs_h *g;\n";
313       iteri (
314         fun i ->
315           function
316           | Pathname n | Device n | Dev_or_Path n | String n
317           | FileIn n | FileOut n | Key n ->
318               pr "      char *%s;\n" n
319           | BufferIn n ->
320               pr "      char *%s;\n" n;
321               pr "      size_t %s_size = SvCUR (ST(%d));\n" n (i+1)
322           | OptString n ->
323               (* http://www.perlmonks.org/?node_id=554277
324                * Note that the implicit handle argument means we have
325                * to add 1 to the ST(x) operator.
326                *)
327               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
328           | StringList n | DeviceList n -> pr "      char **%s;\n" n
329           | Bool n -> pr "      int %s;\n" n
330           | Int n -> pr "      int %s;\n" n
331           | Int64 n -> pr "      int64_t %s;\n" n
332           | Pointer (t, n) -> pr "      %s %s;\n" t n
333       ) args;
334
335       (* PREINIT section (local variable declarations). *)
336       pr "PREINIT:\n";
337       (match ret with
338        | RErr ->
339            pr "      int r;\n";
340        | RInt _
341        | RBool _ ->
342            pr "      int r;\n";
343        | RInt64 _ ->
344            pr "      int64_t r;\n";
345        | RConstString _ ->
346            pr "      const char *r;\n";
347        | RConstOptString _ ->
348            pr "      const char *r;\n";
349        | RString _ ->
350            pr "      char *r;\n";
351        | RStringList _ | RHashtable _ ->
352            pr "      char **r;\n";
353            pr "      size_t i, n;\n";
354        | RStruct (_, typ) ->
355            pr "      struct guestfs_%s *r;\n" typ;
356        | RStructList (_, typ) ->
357            pr "      struct guestfs_%s_list *r;\n" typ;
358            pr "      size_t i;\n";
359            pr "      HV *hv;\n";
360        | RBufferOut _ ->
361            pr "      char *r;\n";
362            pr "      size_t size;\n";
363       );
364
365       if optargs <> [] then (
366         pr "      struct guestfs_%s_argv optargs_s = { .bitmask = 0 };\n" name;
367         pr "      struct guestfs_%s_argv *optargs = &optargs_s;\n" name;
368         pr "      size_t items_i;\n";
369       );
370
371       (* CODE or PPCODE section.  PPCODE is used where we are
372        * returning void, or where we push the return value on the stack
373        * ourselves.  Using CODE means we will manipulate RETVAL.
374        *)
375       (match ret with
376        | RErr ->
377            pr " PPCODE:\n";
378        | RInt n
379        | RBool n ->
380            pr "   CODE:\n";
381        | RInt64 n ->
382            pr "   CODE:\n";
383        | RConstString n ->
384            pr "   CODE:\n";
385        | RConstOptString n ->
386            pr "   CODE:\n";
387        | RString n ->
388            pr "   CODE:\n";
389        | RStringList n | RHashtable n ->
390            pr " PPCODE:\n";
391        | RBufferOut n ->
392            pr "   CODE:\n";
393        | RStruct _
394        | RStructList _ ->
395            pr " PPCODE:\n";
396       );
397
398       (* For optional arguments, convert these from the XSUB "items"
399        * variable by hand.
400        *)
401       if optargs <> [] then (
402         let uc_name = String.uppercase name in
403         let skip = List.length args + 1 in
404         pr "      if (((items - %d) & 1) != 0)\n" skip;
405         pr "        croak (\"expecting an even number of extra parameters\");\n";
406         pr "      for (items_i = %d; items_i < items; items_i += 2) {\n" skip;
407         pr "        uint64_t this_mask;\n";
408         pr "        const char *this_arg;\n";
409         pr "\n";
410         pr "        this_arg = SvPV_nolen (ST (items_i));\n";
411         pr "        ";
412         List.iter (
413           fun argt ->
414             let n = name_of_argt argt in
415             let uc_n = String.uppercase n in
416             pr "if (strcmp (this_arg, \"%s\") == 0) {\n" n;
417             pr "          optargs_s.%s = " n;
418             (match argt with
419              | Bool _
420              | Int _
421              | Int64 _ -> pr "SvIV (ST (items_i+1))"
422              | String _ -> pr "SvPV_nolen (ST (items_i+1))"
423              | _ -> assert false
424             );
425             pr ";\n";
426             pr "          this_mask = GUESTFS_%s_%s_BITMASK;\n" uc_name uc_n;
427             pr "        }\n";
428             pr "        else ";
429         ) optargs;
430         pr "croak (\"unknown optional argument '%%s'\", this_arg);\n";
431         pr "        if (optargs_s.bitmask & this_mask)\n";
432         pr "          croak (\"optional argument '%%s' given twice\",\n";
433         pr "                 this_arg);\n";
434         pr "        optargs_s.bitmask |= this_mask;\n";
435         pr "      }\n";
436         pr "\n";
437       );
438
439       (* The call to the C function. *)
440       if optargs = [] then
441         pr "      r = guestfs_%s " name
442       else
443         pr "      r = guestfs_%s_argv " name;
444       generate_c_call_args ~handle:"g" style;
445       pr ";\n";
446
447       (* Cleanup any arguments. *)
448       List.iter (
449         function
450         | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
451         | Bool _ | Int _ | Int64 _
452         | FileIn _ | FileOut _
453         | BufferIn _ | Key _ | Pointer _ -> ()
454         | StringList n | DeviceList n -> pr "      free (%s);\n" n
455       ) args;
456
457       (* Check return value for errors and return it if necessary. *)
458       (match ret with
459        | RErr ->
460            pr "      if (r == -1)\n";
461            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
462        | RInt n
463        | RBool n ->
464            pr "      if (r == -1)\n";
465            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
466            pr "      RETVAL = newSViv (r);\n";
467            pr " OUTPUT:\n";
468            pr "      RETVAL\n"
469        | RInt64 n ->
470            pr "      if (r == -1)\n";
471            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
472            pr "      RETVAL = my_newSVll (r);\n";
473            pr " OUTPUT:\n";
474            pr "      RETVAL\n"
475        | RConstString n ->
476            pr "      if (r == NULL)\n";
477            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
478            pr "      RETVAL = newSVpv (r, 0);\n";
479            pr " OUTPUT:\n";
480            pr "      RETVAL\n"
481        | RConstOptString n ->
482            pr "      if (r == NULL)\n";
483            pr "        RETVAL = &PL_sv_undef;\n";
484            pr "      else\n";
485            pr "        RETVAL = newSVpv (r, 0);\n";
486            pr " OUTPUT:\n";
487            pr "      RETVAL\n"
488        | RString n ->
489            pr "      if (r == NULL)\n";
490            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
491            pr "      RETVAL = newSVpv (r, 0);\n";
492            pr "      free (r);\n";
493            pr " OUTPUT:\n";
494            pr "      RETVAL\n"
495        | RStringList n | RHashtable n ->
496            pr "      if (r == NULL)\n";
497            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
498            pr "      for (n = 0; r[n] != NULL; ++n) /**/;\n";
499            pr "      EXTEND (SP, n);\n";
500            pr "      for (i = 0; i < n; ++i) {\n";
501            pr "        PUSHs (sv_2mortal (newSVpv (r[i], 0)));\n";
502            pr "        free (r[i]);\n";
503            pr "      }\n";
504            pr "      free (r);\n";
505        | RStruct (n, typ) ->
506            let cols = cols_of_struct typ in
507            generate_perl_struct_code typ cols name style n
508        | RStructList (n, typ) ->
509            let cols = cols_of_struct typ in
510            generate_perl_struct_list_code typ cols name style n
511        | RBufferOut n ->
512            pr "      if (r == NULL)\n";
513            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
514            pr "      RETVAL = newSVpvn (r, size);\n";
515            pr "      free (r);\n";
516            pr " OUTPUT:\n";
517            pr "      RETVAL\n"
518       );
519
520       pr "\n"
521   ) all_functions
522
523 and generate_perl_struct_list_code typ cols name style n =
524   pr "      if (r == NULL)\n";
525   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
526   pr "      EXTEND (SP, r->len);\n";
527   pr "      for (i = 0; i < r->len; ++i) {\n";
528   pr "        hv = newHV ();\n";
529   List.iter (
530     function
531     | name, FString ->
532         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (r->val[i].%s, 0), 0);\n"
533           name (String.length name) name
534     | name, FUUID ->
535         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (r->val[i].%s, 32), 0);\n"
536           name (String.length name) name
537     | name, FBuffer ->
538         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (r->val[i].%s, r->val[i].%s_len), 0);\n"
539           name (String.length name) name name
540     | name, (FBytes|FUInt64) ->
541         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (r->val[i].%s), 0);\n"
542           name (String.length name) name
543     | name, FInt64 ->
544         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (r->val[i].%s), 0);\n"
545           name (String.length name) name
546     | name, (FInt32|FUInt32) ->
547         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (r->val[i].%s), 0);\n"
548           name (String.length name) name
549     | name, FChar ->
550         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&r->val[i].%s, 1), 0);\n"
551           name (String.length name) name
552     | name, FOptPercent ->
553         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (r->val[i].%s), 0);\n"
554           name (String.length name) name
555   ) cols;
556   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
557   pr "      }\n";
558   pr "      guestfs_free_%s_list (r);\n" typ
559
560 and generate_perl_struct_code typ cols name style n =
561   pr "      if (r == NULL)\n";
562   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
563   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
564   List.iter (
565     fun ((name, _) as col) ->
566       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
567
568       match col with
569       | name, FString ->
570           pr "      PUSHs (sv_2mortal (newSVpv (r->%s, 0)));\n"
571             name
572       | name, FBuffer ->
573           pr "      PUSHs (sv_2mortal (newSVpvn (r->%s, r->%s_len)));\n"
574             name name
575       | name, FUUID ->
576           pr "      PUSHs (sv_2mortal (newSVpv (r->%s, 32)));\n"
577             name
578       | name, (FBytes|FUInt64) ->
579           pr "      PUSHs (sv_2mortal (my_newSVull (r->%s)));\n"
580             name
581       | name, FInt64 ->
582           pr "      PUSHs (sv_2mortal (my_newSVll (r->%s)));\n"
583             name
584       | name, (FInt32|FUInt32) ->
585           pr "      PUSHs (sv_2mortal (newSVnv (r->%s)));\n"
586             name
587       | name, FChar ->
588           pr "      PUSHs (sv_2mortal (newSVpv (&r->%s, 1)));\n"
589             name
590       | name, FOptPercent ->
591           pr "      PUSHs (sv_2mortal (newSVnv (r->%s)));\n"
592             name
593   ) cols;
594   pr "      free (r);\n"
595
596 (* Generate Sys/Guestfs.pm. *)
597 and generate_perl_pm () =
598   generate_header HashStyle LGPLv2plus;
599
600   pr "\
601 =pod
602
603 =head1 NAME
604
605 Sys::Guestfs - Perl bindings for libguestfs
606
607 =head1 SYNOPSIS
608
609  use Sys::Guestfs;
610
611  my $h = Sys::Guestfs->new ();
612  $h->add_drive_opts ('guest.img', format => 'raw');
613  $h->launch ();
614  $h->mount_options ('', '/dev/sda1', '/');
615  $h->touch ('/hello');
616  $h->sync ();
617
618 =head1 DESCRIPTION
619
620 The C<Sys::Guestfs> module provides a Perl XS binding to the
621 libguestfs API for examining and modifying virtual machine
622 disk images.
623
624 Amongst the things this is good for: making batch configuration
625 changes to guests, getting disk used/free statistics (see also:
626 virt-df), migrating between virtualization systems (see also:
627 virt-p2v), performing partial backups, performing partial guest
628 clones, cloning guests and changing registry/UUID/hostname info, and
629 much else besides.
630
631 Libguestfs uses Linux kernel and qemu code, and can access any type of
632 guest filesystem that Linux and qemu can, including but not limited
633 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
634 schemes, qcow, qcow2, vmdk.
635
636 Libguestfs provides ways to enumerate guest storage (eg. partitions,
637 LVs, what filesystem is in each LV, etc.).  It can also run commands
638 in the context of the guest.  Also you can access filesystems over
639 FUSE.
640
641 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
642 functions for using libguestfs from Perl, including integration
643 with libvirt.
644
645 =head1 ERRORS
646
647 All errors turn into calls to C<croak> (see L<Carp(3)>).
648
649 The error string from libguestfs is directly available from
650 C<$@>.  Use the C<last_errno> method if you want to get the errno.
651
652 =head1 METHODS
653
654 =over 4
655
656 =cut
657
658 package Sys::Guestfs;
659
660 use strict;
661 use warnings;
662
663 # This version number changes whenever a new function
664 # is added to the libguestfs API.  It is not directly
665 # related to the libguestfs version number.
666 use vars qw($VERSION);
667 $VERSION = '0.%d';
668
669 require XSLoader;
670 XSLoader::load ('Sys::Guestfs');
671
672 " max_proc_nr;
673
674   (* Methods. *)
675   pr "\
676 =item $h = Sys::Guestfs->new ();
677
678 Create a new guestfs handle.
679
680 =cut
681
682 sub new {
683   my $proto = shift;
684   my $class = ref ($proto) || $proto;
685
686   my $g = Sys::Guestfs::_create ();
687   my $self = { _g => $g };
688   bless $self, $class;
689   return $self;
690 }
691
692 =item $h->close ();
693
694 Explicitly close the guestfs handle.
695
696 B<Note:> You should not usually call this function.  The handle will
697 be closed implicitly when its reference count goes to zero (eg.
698 when it goes out of scope or the program ends).  This call is
699 only required in some exceptional cases, such as where the program
700 may contain cached references to the handle 'somewhere' and you
701 really have to have the close happen right away.  After calling
702 C<close> the program must not call any method (including C<close>)
703 on the handle (but the implicit call to C<DESTROY> that happens
704 when the final reference is cleaned up is OK).
705
706 ";
707
708   List.iter (
709     fun (name, bitmask) ->
710       pr "=item $Sys::Guestfs::EVENT_%s\n" (String.uppercase name);
711       pr "\n";
712       pr "See L<guestfs(3)/GUESTFS_EVENT_%s>.\n"
713         (String.uppercase name);
714       pr "\n";
715       pr "=cut\n";
716       pr "\n";
717       pr "our $EVENT_%s = 0x%x;\n" (String.uppercase name) bitmask;
718       pr "\n"
719   ) events;
720
721   pr "\
722 =item $event_handle = $h->set_event_callback (\\&cb, $event_bitmask);
723
724 Register C<cb> as a callback function for all of the events
725 in C<$event_bitmask> (one or more C<$Sys::Guestfs::EVENT_*> flags
726 logically or'd together).
727
728 This function returns an event handle which
729 can be used to delete the callback using C<delete_event_callback>.
730
731 The callback function receives 4 parameters:
732
733  &cb ($event, $event_handle, $buf, $array)
734
735 =over 4
736
737 =item $event
738
739 The event which happened (equal to one of C<$Sys::Guestfs::EVENT_*>).
740
741 =item $event_handle
742
743 The event handle.
744
745 =item $buf
746
747 For some event types, this is a message buffer (ie. a string).
748
749 =item $array
750
751 For some event types (notably progress events), this is
752 an array of integers.
753
754 =back
755
756 You should carefully read the documentation for
757 L<guestfs(3)/guestfs_set_event_callback> before using
758 this function.
759
760 =item $h->delete_event_callback ($event_handle);
761
762 This removes the callback which was previously registered using
763 C<set_event_callback>.
764
765 =item $errnum = $h->last_errno ();
766
767 This returns the last error number (errno) that happened on the
768 handle C<$h>.
769
770 If successful, an errno integer not equal to zero is returned.
771
772 If no error number is available, this returns 0.
773 See L<guestfs(3)/guestfs_last_errno> for more details of why
774 this can happen.
775
776 You can use the standard Perl module L<Errno(3)> to compare
777 the numeric error returned from this call with symbolic
778 errnos:
779
780  $h->mkdir (\"/foo\");
781  if ($h->last_errno() == Errno::EEXIST()) {
782    # mkdir failed because the directory exists already.
783  }
784
785 =item $h->user_cancel ();
786
787 Cancel current transfer.  This is safe to call from Perl signal
788 handlers and threads.
789
790 =cut
791
792 ";
793
794   (* Actions.  We only need to print documentation for these as
795    * they are pulled in from the XS code automatically.
796    *)
797   List.iter (
798     fun (name, style, _, flags, _, _, longdesc) ->
799       if not (List.mem NotInDocs flags) then (
800         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
801         pr "=item ";
802         generate_perl_prototype name style;
803         pr "\n\n";
804         pr "%s\n\n" longdesc;
805         if List.mem ProtocolLimitWarning flags then
806           pr "%s\n\n" protocol_limit_warning;
807         match deprecation_notice flags with
808         | None -> ()
809         | Some txt -> pr "%s\n\n" txt
810       )
811   ) all_functions_sorted;
812
813   pr "=cut\n\n";
814
815   (* Introspection hash. *)
816   pr "use vars qw(%%guestfs_introspection);\n";
817   pr "%%guestfs_introspection = (\n";
818   List.iter (
819     fun (name, (ret, args, optargs), _, _, _, shortdesc, _) ->
820       pr "  \"%s\" => {\n" name;
821       pr "    ret => ";
822       (match ret with
823        | RErr -> pr "'void'"
824        | RInt _ -> pr "'int'"
825        | RBool _ -> pr "'bool'"
826        | RInt64 _ -> pr "'int64'"
827        | RConstString _ -> pr "'const string'"
828        | RConstOptString _ -> pr "'const nullable string'"
829        | RString _ -> pr "'string'"
830        | RStringList _ -> pr "'string list'"
831        | RHashtable _ -> pr "'hash'"
832        | RStruct (_, typ) -> pr "'struct %s'" typ
833        | RStructList (_, typ) -> pr "'struct %s list'" typ
834        | RBufferOut _ -> pr "'buffer'"
835       );
836       pr ",\n";
837       let pr_type i = function
838         | Pathname n -> pr "[ '%s', 'string(path)', %d ]" n i
839         | Device n -> pr "[ '%s', 'string(device)', %d ]" n i
840         | Dev_or_Path n -> pr "[ '%s', 'string(dev_or_path)', %d ]" n i
841         | String n -> pr "[ '%s', 'string', %d ]" n i
842         | FileIn n -> pr "[ '%s', 'string(filename)', %d ]" n i
843         | FileOut n -> pr "[ '%s', 'string(filename)', %d ]" n i
844         | Key n -> pr "[ '%s', 'string(key)', %d ]" n i
845         | BufferIn n -> pr "[ '%s', 'buffer', %d ]" n i
846         | OptString n -> pr "[ '%s', 'nullable string', %d ]" n i
847         | StringList n -> pr "[ '%s', 'string list', %d ]" n i
848         | DeviceList n -> pr "[ '%s', 'string(device) list', %d ]" n i
849         | Bool n -> pr "[ '%s', 'bool', %d ]" n i
850         | Int n -> pr "[ '%s', 'int', %d ]" n i
851         | Int64 n -> pr "[ '%s', 'int64', %d ]" n i
852         | Pointer (t, n) -> pr "[ '%s', 'pointer(%s)', %d ]" n t i
853       in
854       pr "    args => [\n";
855       iteri (fun i arg ->
856         pr "      ";
857         pr_type i arg;
858         pr ",\n"
859       ) args;
860       pr "    ],\n";
861       if optargs <> [] then (
862         pr "    optargs => {\n";
863         iteri (fun i arg ->
864           pr "      %s => " (name_of_argt arg);
865           pr_type i arg;
866           pr ",\n"
867         ) optargs;
868         pr "    },\n";
869       );
870       pr "    name => \"%s\",\n" name;
871       pr "    description => %S,\n" shortdesc;
872       pr "  },\n";
873   ) all_functions_sorted;
874   pr ");\n\n";
875
876   (* End of file. *)
877   pr "\
878 1;
879
880 =back
881
882 =head1 AVAILABILITY
883
884 From time to time we add new libguestfs APIs.  Also some libguestfs
885 APIs won't be available in all builds of libguestfs (the Fedora
886 build is full-featured, but other builds may disable features).
887 How do you test whether the APIs that your Perl program needs are
888 available in the version of C<Sys::Guestfs> that you are using?
889
890 To test if a particular function is available in the C<Sys::Guestfs>
891 class, use the ordinary Perl UNIVERSAL method C<can(METHOD)>
892 (see L<perlobj(1)>).  For example:
893
894  use Sys::Guestfs;
895  if (defined (Sys::Guestfs->can (\"set_verbose\"))) {
896    print \"\\$h->set_verbose is available\\n\";
897  }
898
899 Perl does not offer a way to list the arguments of a method, and
900 from time to time we may add extra arguments to calls that take
901 optional arguments.  For this reason, we provide a global hash
902 variable C<%%guestfs_introspection> which contains the arguments
903 and their types for each libguestfs method.  The keys of this
904 hash are the method names, and the values are an hashref
905 containing useful introspection information about the method
906 (further fields may be added to this in future).
907
908  use Sys::Guestfs;
909  $Sys::Guestfs::guestfs_introspection{mkfs_opts}
910  => {
911     ret => 'void',                    # return type
912     args => [                         # required arguments
913       [ 'fstype', 'string', 0 ],
914       [ 'device', 'string(device)', 1 ],
915     ],
916     optargs => {                      # optional arguments
917       blocksize => [ 'blocksize', 'int', 0 ],
918       features => [ 'features', 'string', 1 ],
919       inode => [ 'inode', 'int', 2 ],
920       sectorsize => [ 'sectorsize', 'int', 3 ],
921     },
922     name => \"mkfs_opts\",
923     description => \"make a filesystem\",
924   }
925
926 To test if particular features are supported by the current
927 build, use the L</available> method like the example below.  Note
928 that the appliance must be launched first.
929
930  $h->available ( [\"augeas\"] );
931
932 Since the L</available> method croaks if the feature is not supported,
933 you might also want to wrap this in an eval and return a boolean.
934 In fact this has already been done for you: use
935 L<Sys::Guestfs::Lib(3)/feature_available>.
936
937 For further discussion on this topic, refer to
938 L<guestfs(3)/AVAILABILITY>.
939
940 =head1 STORING DATA IN THE HANDLE
941
942 The handle returned from L</new> is a hash reference.  The hash
943 normally contains a single element:
944
945  {
946    _g => [private data used by libguestfs]
947  }
948
949 Callers can add other elements to this hash to store data for their own
950 purposes.  The data lasts for the lifetime of the handle.
951
952 Any fields whose names begin with an underscore are reserved
953 for private use by libguestfs.  We may add more in future.
954
955 It is recommended that callers prefix the name of their field(s)
956 with some unique string, to avoid conflicts with other users.
957
958 =head1 COPYRIGHT
959
960 Copyright (C) %s Red Hat Inc.
961
962 =head1 LICENSE
963
964 Please see the file COPYING.LIB for the full license.
965
966 =head1 SEE ALSO
967
968 L<guestfs(3)>,
969 L<guestfish(1)>,
970 L<http://libguestfs.org>,
971 L<Sys::Guestfs::Lib(3)>.
972
973 =cut
974 " copyright_years
975
976 and generate_perl_prototype name (ret, args, optargs) =
977   (match ret with
978    | RErr -> ()
979    | RBool n
980    | RInt n
981    | RInt64 n
982    | RConstString n
983    | RConstOptString n
984    | RString n
985    | RBufferOut n -> pr "$%s = " n
986    | RStruct (n,_)
987    | RHashtable n -> pr "%%%s = " n
988    | RStringList n
989    | RStructList (n,_) -> pr "@%s = " n
990   );
991   pr "$h->%s (" name;
992   let comma = ref false in
993   List.iter (
994     fun arg ->
995       if !comma then pr ", ";
996       comma := true;
997       match arg with
998       | Pathname n | Device n | Dev_or_Path n | String n
999       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n
1000       | BufferIn n | Key n | Pointer (_, n) ->
1001           pr "$%s" n
1002       | StringList n | DeviceList n ->
1003           pr "\\@%s" n
1004   ) args;
1005   List.iter (
1006     fun arg ->
1007       if !comma then pr " [, " else pr "[";
1008       comma := true;
1009       let n = name_of_argt arg in
1010       pr "%s => $%s]" n n
1011   ) optargs;
1012   pr ");"