libvirt/libvirt_c_epilogue.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 *
  24 Optstring_val (value strv)
  25 {
  26   if (strv == Val_int (0))      /* None */
  27     return NULL;
  28   else                          /* Some string */
  29     return String_val (Field (strv, 0));
  30 }
  31
  32 static value
  33 Val_opt (void *ptr, Val_ptr_t Val_ptr)
  34 {
  35   CAMLparam0 ();
  36   CAMLlocal2 (optv, ptrv);
  37
  38   if (ptr) {                    /* Some ptr */
  39     optv = caml_alloc (1, 0);
  40     ptrv = Val_ptr (ptr);
  41     Store_field (optv, 0, ptrv);
  42   } else                        /* None */
  43     optv = Val_int (0);
  44
  45   CAMLreturn (optv);
  46 }
  47
  48 static value
  49 Val_opt_const (const void *ptr, Val_const_ptr_t Val_ptr)
  50 {
  51   CAMLparam0 ();
  52   CAMLlocal2 (optv, ptrv);
  53
  54   if (ptr) {                    /* Some ptr */
  55     optv = caml_alloc (1, 0);
  56     ptrv = Val_ptr (ptr);
  57     Store_field (optv, 0, ptrv);
  58   } else                        /* None */
  59     optv = Val_int (0);
  60
  61   CAMLreturn (optv);
  62 }
  63
  64 #if 0
  65 static value
  66 option_default (value option, value deflt)
  67 {
  68   if (option == Val_int (0))    /* "None" */
  69     return deflt;
  70   else                          /* "Some 'a" */
  71     return Field (option, 0);
  72 }
  73 #endif
  74
  75 static void
  76 _raise_virterror (const char *fn)
  77 {
  78   CAMLparam0 ();
  79   CAMLlocal1 (rv);
  80   virErrorPtr errp;
  81   struct _virError err;
  82
  83   errp = virGetLastError ();
  84
  85   if (!errp) {
  86     /* Fake a _virError structure. */
  87     memset (&err, 0, sizeof err);
  88     err.code = VIR_ERR_INTERNAL_ERROR;
  89     err.domain = VIR_FROM_NONE;
  90     err.level = VIR_ERR_ERROR;
  91     err.message = (char *) fn;
  92     errp = &err;
  93   }
  94
  95   rv = Val_virterror (errp);
  96   caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv);
  97
  98   /*NOTREACHED*/
  99   /* Suppresses a compiler warning. */
 100   (void) caml__frame;
 101 }
 102
 103 /* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums
 104  * into values (longs because they are variants in OCaml).
 105  *
 106  * The enum values are part of the libvirt ABI so they cannot change,
 107  * which means that we can convert these numbers directly into
 108  * OCaml variants (which use the same ordering) very fast.
 109  *
 110  * The tricky part here is when we are linked to a newer version of
 111  * libvirt than the one we were compiled against.  If the newer libvirt
 112  * generates an error code which we don't know about then we need
 113  * to convert it into VIR_*_UNKNOWN (code).
 114  */
 115
 116 #define MAX_VIR_CODE 50 /* VIR_ERR_NO_STORAGE_VOL */
 117 #define MAX_VIR_DOMAIN 17 /* VIR_FROM_STORAGE */
 118 #define MAX_VIR_LEVEL VIR_ERR_ERROR
 119
 120 static inline value
 121 Val_err_number (virErrorNumber code)
 122 {
 123   CAMLparam0 ();
 124   CAMLlocal1 (rv);
 125
 126   if (0 <= code && code <= MAX_VIR_CODE)
 127     rv = Val_int (code);
 128   else {
 129     rv = caml_alloc (1, 0);     /* VIR_ERR_UNKNOWN (code) */
 130     Store_field (rv, 0, Val_int (code));
 131   }
 132
 133   CAMLreturn (rv);
 134 }
 135
 136 static inline value
 137 Val_err_domain (virErrorDomain code)
 138 {
 139   CAMLparam0 ();
 140   CAMLlocal1 (rv);
 141
 142   if (0 <= code && code <= MAX_VIR_DOMAIN)
 143     rv = Val_int (code);
 144   else {
 145     rv = caml_alloc (1, 0);     /* VIR_FROM_UNKNOWN (code) */
 146     Store_field (rv, 0, Val_int (code));
 147   }
 148
 149   CAMLreturn (rv);
 150 }
 151
 152 static inline value
 153 Val_err_level (virErrorLevel code)
 154 {
 155   CAMLparam0 ();
 156   CAMLlocal1 (rv);
 157
 158   if (0 <= code && code <= MAX_VIR_LEVEL)
 159     rv = Val_int (code);
 160   else {
 161     rv = caml_alloc (1, 0);     /* VIR_ERR_UNKNOWN_LEVEL (code) */
 162     Store_field (rv, 0, Val_int (code));
 163   }
 164
 165   CAMLreturn (rv);
 166 }
 167
 168 /* Convert a virterror to a value. */
 169 static value
 170 Val_virterror (virErrorPtr err)
 171 {
 172   CAMLparam0 ();
 173   CAMLlocal3 (rv, connv, optv);
 174
 175   rv = caml_alloc (9, 0);
 176   Store_field (rv, 0, Val_err_number (err->code));
 177   Store_field (rv, 1, Val_err_domain (err->domain));
 178   Store_field (rv, 2,
 179                Val_opt (err->message, (Val_ptr_t) caml_copy_string));
 180   Store_field (rv, 3, Val_err_level (err->level));
 181
 182   Store_field (rv, 4,
 183                Val_opt (err->str1, (Val_ptr_t) caml_copy_string));
 184   Store_field (rv, 5,
 185                Val_opt (err->str2, (Val_ptr_t) caml_copy_string));
 186   Store_field (rv, 6,
 187                Val_opt (err->str3, (Val_ptr_t) caml_copy_string));
 188   Store_field (rv, 7, caml_copy_int32 (err->int1));
 189   Store_field (rv, 8, caml_copy_int32 (err->int2));
 190
 191   CAMLreturn (rv);
 192 }
 193
 194 static void conn_finalize (value);
 195 static void dom_finalize (value);
 196 static void net_finalize (value);
 197 static void pol_finalize (value);
 198 static void vol_finalize (value);
 199
 200 static struct custom_operations conn_custom_operations = {
 201   "conn_custom_operations",
 202   conn_finalize,
 203   custom_compare_default,
 204   custom_hash_default,
 205   custom_serialize_default,
 206   custom_deserialize_default
 207 };
 208
 209 static struct custom_operations dom_custom_operations = {
 210   "dom_custom_operations",
 211   dom_finalize,
 212   custom_compare_default,
 213   custom_hash_default,
 214   custom_serialize_default,
 215   custom_deserialize_default
 216
 217 };
 218
 219 static struct custom_operations net_custom_operations = {
 220   "net_custom_operations",
 221   net_finalize,
 222   custom_compare_default,
 223   custom_hash_default,
 224   custom_serialize_default,
 225   custom_deserialize_default
 226 };
 227
 228 static struct custom_operations pol_custom_operations = {
 229   "pol_custom_operations",
 230   pol_finalize,
 231   custom_compare_default,
 232   custom_hash_default,
 233   custom_serialize_default,
 234   custom_deserialize_default
 235 };
 236
 237 static struct custom_operations vol_custom_operations = {
 238   "vol_custom_operations",
 239   vol_finalize,
 240   custom_compare_default,
 241   custom_hash_default,
 242   custom_serialize_default,
 243   custom_deserialize_default
 244 };
 245
 246 static value
 247 Val_connect (virConnectPtr conn)
 248 {
 249   CAMLparam0 ();
 250   CAMLlocal1 (rv);
 251   rv = caml_alloc_custom (&conn_custom_operations,
 252                           sizeof (virConnectPtr), 0, 1);
 253   Connect_val (rv) = conn;
 254   CAMLreturn (rv);
 255 }
 256
 257 static value
 258 Val_dom (virDomainPtr dom)
 259 {
 260   CAMLparam0 ();
 261   CAMLlocal1 (rv);
 262   rv = caml_alloc_custom (&dom_custom_operations,
 263                           sizeof (virDomainPtr), 0, 1);
 264   Dom_val (rv) = dom;
 265   CAMLreturn (rv);
 266 }
 267
 268 static value
 269 Val_net (virNetworkPtr net)
 270 {
 271   CAMLparam0 ();
 272   CAMLlocal1 (rv);
 273   rv = caml_alloc_custom (&net_custom_operations,
 274                           sizeof (virNetworkPtr), 0, 1);
 275   Net_val (rv) = net;
 276   CAMLreturn (rv);
 277 }
 278
 279 static value
 280 Val_pol (virStoragePoolPtr pol)
 281 {
 282   CAMLparam0 ();
 283   CAMLlocal1 (rv);
 284   rv = caml_alloc_custom (&pol_custom_operations,
 285                           sizeof (virStoragePoolPtr), 0, 1);
 286   Pol_val (rv) = pol;
 287   CAMLreturn (rv);
 288 }
 289
 290 static value
 291 Val_vol (virStorageVolPtr vol)
 292 {
 293   CAMLparam0 ();
 294   CAMLlocal1 (rv);
 295   rv = caml_alloc_custom (&vol_custom_operations,
 296                           sizeof (virStorageVolPtr), 0, 1);
 297   Vol_val (rv) = vol;
 298   CAMLreturn (rv);
 299 }
 300
 301 /* This wraps up the (dom, conn) pair (Domain.t). */
 302 static value
 303 Val_domain (virDomainPtr dom, value connv)
 304 {
 305   CAMLparam1 (connv);
 306   CAMLlocal2 (rv, v);
 307
 308   rv = caml_alloc_tuple (2);
 309   v = Val_dom (dom);
 310   Store_field (rv, 0, v);
 311   Store_field (rv, 1, connv);
 312   CAMLreturn (rv);
 313 }
 314
 315 /* This wraps up the (net, conn) pair (Network.t). */
 316 static value
 317 Val_network (virNetworkPtr net, value connv)
 318 {
 319   CAMLparam1 (connv);
 320   CAMLlocal2 (rv, v);
 321
 322   rv = caml_alloc_tuple (2);
 323   v = Val_net (net);
 324   Store_field (rv, 0, v);
 325   Store_field (rv, 1, connv);
 326   CAMLreturn (rv);
 327 }
 328
 329 /* This wraps up the (pol, conn) pair (Pool.t). */
 330 static value
 331 Val_pool (virStoragePoolPtr pol, value connv)
 332 {
 333   CAMLparam1 (connv);
 334   CAMLlocal2 (rv, v);
 335
 336   rv = caml_alloc_tuple (2);
 337   v = Val_pol (pol);
 338   Store_field (rv, 0, v);
 339   Store_field (rv, 1, connv);
 340   CAMLreturn (rv);
 341 }
 342
 343 /* This wraps up the (vol, conn) pair (Volume.t). */
 344 static value
 345 Val_volume (virStorageVolPtr vol, value connv)
 346 {
 347   CAMLparam1 (connv);
 348   CAMLlocal2 (rv, v);
 349
 350   rv = caml_alloc_tuple (2);
 351   v = Val_vol (vol);
 352   Store_field (rv, 0, v);
 353   Store_field (rv, 1, connv);
 354   CAMLreturn (rv);
 355 }
 356
 357 static void
 358 conn_finalize (value connv)
 359 {
 360   virConnectPtr conn = Connect_val (connv);
 361   if (conn) (void) virConnectClose (conn);
 362 }
 363
 364 static void
 365 dom_finalize (value domv)
 366 {
 367   virDomainPtr dom = Dom_val (domv);
 368   if (dom) (void) virDomainFree (dom);
 369 }
 370
 371 static void
 372 net_finalize (value netv)
 373 {
 374   virNetworkPtr net = Net_val (netv);
 375   if (net) (void) virNetworkFree (net);
 376 }
 377
 378 static void
 379 pol_finalize (value polv)
 380 {
 381   virStoragePoolPtr pol = Pol_val (polv);
 382   if (pol) (void) virStoragePoolFree (pol);
 383 }
 384
 385 static void
 386 vol_finalize (value volv)
 387 {
 388   virStorageVolPtr vol = Vol_val (volv);
 389   if (vol) (void) virStorageVolFree (vol);
 390 }