libvirt/libvirt_c_prologue.c

   1 /* OCaml bindings for libvirt.
   2  * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
   3  * http://libvirt.org/
   4  *
   5  * This library is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU Lesser General Public
   7  * License as published by the Free Software Foundation; either
   8  * version 2 of the License, or (at your option) any later version,
   9  * with the OCaml linking exception described in ../COPYING.LIB.
  10  *
  11  * This library is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14  * Lesser General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU Lesser General Public
  17  * License along with this library; if not, write to the Free Software
  18  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
  19  */
  20
  21 /* Please read libvirt/README file. */
  22
  23 static char *Optstring_val (value strv);
  24 typedef value (*Val_ptr_t) (void *);
  25 static value Val_opt (void *ptr, Val_ptr_t Val_ptr);
  26 typedef value (*Val_const_ptr_t) (const void *);
  27 static value Val_opt_const (const void *ptr, Val_const_ptr_t Val_ptr);
  28 /*static value option_default (value option, value deflt);*/
  29 static void _raise_virterror (const char *fn) Noreturn;
  30 static value Val_virterror (virErrorPtr err);
  31
  32 /* Use this around synchronous libvirt API calls to release the OCaml
  33  * lock, allowing other threads to run simultaneously.  'code' must not
  34  * perform any caml_* calls, run any OCaml code, or raise any exception.
  35  * http://web.archive.org/web/20030521020915/http://caml.inria.fr/archives/200106/msg00199.html
  36  */
  37 #define NONBLOCKING(code)                       \
  38   do {                                          \
  39     caml_enter_blocking_section ();             \
  40     code;                                       \
  41     caml_leave_blocking_section ();             \
  42   } while (0)
  43
  44 /* Check error condition from a libvirt function, and automatically raise
  45  * an exception if one is found.
  46  */
  47 #define CHECK_ERROR(cond, fn) \
  48   do { if (cond) _raise_virterror (fn); } while (0)
  49
  50 /*----------------------------------------------------------------------*/
  51
  52 /* Some notes about the use of custom blocks to store virConnectPtr,
  53  * virDomainPtr and virNetworkPtr.
  54  *------------------------------------------------------------------
  55  *
  56  * Libvirt does some tricky reference counting to keep track of
  57  * virConnectPtr's, virDomainPtr's and virNetworkPtr's.
  58  *
  59  * There is only one function which can return a virConnectPtr
  60  * (virConnectOpen*) and that allocates a new one each time.
  61  *
  62  * virDomainPtr/virNetworkPtr's on the other hand can be returned
  63  * repeatedly (for the same underlying domain/network), and we must
  64  * keep track of each one and explicitly free it with virDomainFree
  65  * or virNetworkFree.  If we lose track of one then the reference
  66  * counting in libvirt will keep it open.  We therefore wrap these
  67  * in a custom block with a finalizer function.
  68  *
  69  * We also have to allow the user to explicitly free them, in
  70  * which case we set the pointer inside the custom block to NULL.
  71  * The finalizer notices this and doesn't free the object.
  72  *
  73  * Domains and networks "belong to" a connection.  We have to avoid
  74  * the situation like this:
  75  *
  76  *   let conn = Connect.open ... in
  77  *   let dom = Domain.lookup_by_id conn 0 in
  78  *   (* conn goes out of scope and is garbage collected *)
  79  *   printf "dom name = %s\n" (Domain.get_name dom)
  80  *
  81  * The reason is that when conn is garbage collected, virConnectClose
  82  * is called and any subsequent operations on dom will fail (in fact
  83  * will probably segfault).  To stop this from happening, the OCaml
  84  * wrappers store domains (and networks) as explicit (dom, conn)
  85  * pairs.
  86  *
  87  * Update 2008/01: Storage pools and volumes work the same way as
  88  * domains and networks.
  89  */
  90
  91 /* Unwrap a custom block. */
  92 #define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv)))
  93 #define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv)))
  94 #define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv)))
  95 #define Pol_val(rv) (*((virStoragePoolPtr *)Data_custom_val(rv)))
  96 #define Vol_val(rv) (*((virStorageVolPtr *)Data_custom_val(rv)))
  97
  98 /* Wrap up a pointer to something in a custom block. */
  99 static value Val_connect (virConnectPtr conn);
 100 static value Val_dom (virDomainPtr dom);
 101 static value Val_net (virNetworkPtr net);
 102 static value Val_pol (virStoragePoolPtr pool);
 103 static value Val_vol (virStorageVolPtr vol);
 104
 105 /* Domains and networks are stored as pairs (dom/net, conn), so have
 106  * some convenience functions for unwrapping and wrapping them.
 107  */
 108 #define Domain_val(rv) (Dom_val(Field((rv),0)))
 109 #define Network_val(rv) (Net_val(Field((rv),0)))
 110 #define Pool_val(rv) (Pol_val(Field((rv),0)))
 111 #define Volume_val(rv) (Vol_val(Field((rv),0)))
 112 #define Connect_domv(rv) (Connect_val(Field((rv),1)))
 113 #define Connect_netv(rv) (Connect_val(Field((rv),1)))
 114 #define Connect_polv(rv) (Connect_val(Field((rv),1)))
 115 #define Connect_volv(rv) (Connect_val(Field((rv),1)))
 116
 117 static value Val_domain (virDomainPtr dom, value connv);
 118 static value Val_network (virNetworkPtr net, value connv);
 119 static value Val_pool (virStoragePoolPtr pol, value connv);
 120 static value Val_volume (virStorageVolPtr vol, value connv);