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  *
  10  * This library 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 GNU
  13  * Lesser General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU Lesser General Public
  16  * License along with this library; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
  18  */
  19
  20 /* Please read libvirt/README file. */
  21
  22 static char *
  23 Optstring_val (value strv)
  24 {
  25   if (strv == Val_int (0))      /* None */
  26     return NULL;
  27   else                          /* Some string */
  28     return String_val (Field (strv, 0));
  29 }
  30
  31 static value
  32 Val_opt (void *ptr, Val_ptr_t Val_ptr)
  33 {
  34   CAMLparam0 ();
  35   CAMLlocal2 (optv, ptrv);
  36
  37   if (ptr) {                    /* Some ptr */
  38     optv = caml_alloc (1, 0);
  39     ptrv = Val_ptr (ptr);
  40     Store_field (optv, 0, ptrv);
  41   } else                        /* None */
  42     optv = Val_int (0);
  43
  44   CAMLreturn (optv);
  45 }
  46
  47 #if 0
  48 static value
  49 option_default (value option, value deflt)
  50 {
  51   if (option == Val_int (0))    /* "None" */
  52     return deflt;
  53   else                          /* "Some 'a" */
  54     return Field (option, 0);
  55 }
  56 #endif
  57
  58 static void
  59 _raise_virterror (virConnectPtr conn, const char *fn)
  60 {
  61   CAMLparam0 ();
  62   CAMLlocal1 (rv);
  63   virErrorPtr errp;
  64   struct _virError err;
  65
  66   errp = conn ? virConnGetLastError (conn) : virGetLastError ();
  67
  68   if (!errp) {
  69     /* Fake a _virError structure. */
  70     memset (&err, 0, sizeof err);
  71     err.code = VIR_ERR_INTERNAL_ERROR;
  72     err.domain = VIR_FROM_NONE;
  73     err.level = VIR_ERR_ERROR;
  74     err.message = (char *) fn;
  75     errp = &err;
  76   }
  77
  78   rv = Val_virterror (errp);
  79   caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv);
  80
  81   /*NOTREACHED*/
  82   /* Suppresses a compiler warning. */
  83   (void) caml__frame;
  84 }
  85
  86 /* Raise an error if a function is not supported. */
  87 static void
  88 not_supported (const char *fn)
  89 {
  90   CAMLparam0 ();
  91   CAMLlocal1 (fnv);
  92
  93   fnv = caml_copy_string (fn);
  94   caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_not_supported"), fnv);
  95
  96   /*NOTREACHED*/
  97   /* Suppresses a compiler warning. */
  98   (void) caml__frame;
  99 }
 100
 101 /* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums
 102  * into values (longs because they are variants in OCaml).
 103  *
 104  * The enum values are part of the libvirt ABI so they cannot change,
 105  * which means that we can convert these numbers directly into
 106  * OCaml variants (which use the same ordering) very fast.
 107  *
 108  * The tricky part here is when we are linked to a newer version of
 109  * libvirt than the one we were compiled against.  If the newer libvirt
 110  * generates an error code which we don't know about then we need
 111  * to convert it into VIR_*_UNKNOWN (code).
 112  */
 113
 114 #define MAX_VIR_CODE 44 /* VIR_ERR_INVALID_MAC */
 115 #define MAX_VIR_DOMAIN 16 /* VIR_FROM_STATS_LINUX */
 116 #define MAX_VIR_LEVEL VIR_ERR_ERROR
 117
 118 static inline value
 119 Val_err_number (virErrorNumber code)
 120 {
 121   CAMLparam0 ();
 122   CAMLlocal1 (rv);
 123
 124   if (0 <= code && code <= MAX_VIR_CODE)
 125     rv = Val_int (code);
 126   else {
 127     rv = caml_alloc (1, 0);     /* VIR_ERR_UNKNOWN (code) */
 128     Store_field (rv, 0, Val_int (code));
 129   }
 130
 131   CAMLreturn (rv);
 132 }
 133
 134 static inline value
 135 Val_err_domain (virErrorDomain code)
 136 {
 137   CAMLparam0 ();
 138   CAMLlocal1 (rv);
 139
 140   if (0 <= code && code <= MAX_VIR_DOMAIN)
 141     rv = Val_int (code);
 142   else {
 143     rv = caml_alloc (1, 0);     /* VIR_FROM_UNKNOWN (code) */
 144     Store_field (rv, 0, Val_int (code));
 145   }
 146
 147   CAMLreturn (rv);
 148 }
 149
 150 static inline value
 151 Val_err_level (virErrorLevel code)
 152 {
 153   CAMLparam0 ();
 154   CAMLlocal1 (rv);
 155
 156   if (0 <= code && code <= MAX_VIR_LEVEL)
 157     rv = Val_int (code);
 158   else {
 159     rv = caml_alloc (1, 0);     /* VIR_ERR_UNKNOWN_LEVEL (code) */
 160     Store_field (rv, 0, Val_int (code));
 161   }
 162
 163   CAMLreturn (rv);
 164 }
 165
 166 /* Convert a virterror to a value. */
 167 static value
 168 Val_virterror (virErrorPtr err)
 169 {
 170   CAMLparam0 ();
 171   CAMLlocal3 (rv, connv, optv);
 172
 173   rv = caml_alloc (12, 0);
 174   Store_field (rv, 0, Val_err_number (err->code));
 175   Store_field (rv, 1, Val_err_domain (err->domain));
 176   Store_field (rv, 2,
 177                Val_opt (err->message, (Val_ptr_t) caml_copy_string));
 178   Store_field (rv, 3, Val_err_level (err->level));
 179
 180   /* conn, dom and net fields, all optional */
 181   if (err->conn) {
 182     connv = Val_connect_no_finalize (err->conn);
 183     optv = caml_alloc (1, 0);
 184     Store_field (optv, 0, connv);
 185     Store_field (rv, 4, optv);  /* Some conn */
 186
 187     if (err->dom) {
 188       optv = caml_alloc (1, 0);
 189       Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv));
 190       Store_field (rv, 5, optv); /* Some (dom, conn) */
 191     }
 192     else
 193       Store_field (rv, 5, Val_int (0)); /* None */
 194     if (err->net) {
 195       optv = caml_alloc (1, 0);
 196       Store_field (optv, 0, Val_network_no_finalize (err->net, connv));
 197       Store_field (rv, 11, optv); /* Some (net, conn) */
 198     } else
 199       Store_field (rv, 11, Val_int (0)); /* None */
 200   } else {
 201     Store_field (rv, 4, Val_int (0)); /* None */
 202     Store_field (rv, 5, Val_int (0)); /* None */
 203     Store_field (rv, 11, Val_int (0)); /* None */
 204   }
 205
 206   Store_field (rv, 6,
 207                Val_opt (err->str1, (Val_ptr_t) caml_copy_string));
 208   Store_field (rv, 7,
 209                Val_opt (err->str2, (Val_ptr_t) caml_copy_string));
 210   Store_field (rv, 8,
 211                Val_opt (err->str3, (Val_ptr_t) caml_copy_string));
 212   Store_field (rv, 9, caml_copy_int32 (err->int1));
 213   Store_field (rv, 10, caml_copy_int32 (err->int2));
 214
 215   CAMLreturn (rv);
 216 }
 217
 218 static void conn_finalize (value);
 219 static void dom_finalize (value);
 220 static void net_finalize (value);
 221 #ifdef HAVE_VIRSTORAGEPOOLPTR
 222 static void pol_finalize (value);
 223 #endif
 224 #ifdef HAVE_VIRSTORAGEVOLPTR
 225 static void vol_finalize (value);
 226 #endif
 227
 228 static struct custom_operations conn_custom_operations = {
 229   "conn_custom_operations",
 230   conn_finalize,
 231   custom_compare_default,
 232   custom_hash_default,
 233   custom_serialize_default,
 234   custom_deserialize_default
 235 };
 236
 237 static struct custom_operations dom_custom_operations = {
 238   "dom_custom_operations",
 239   dom_finalize,
 240   custom_compare_default,
 241   custom_hash_default,
 242   custom_serialize_default,
 243   custom_deserialize_default
 244
 245 };
 246
 247 static struct custom_operations net_custom_operations = {
 248   "net_custom_operations",
 249   net_finalize,
 250   custom_compare_default,
 251   custom_hash_default,
 252   custom_serialize_default,
 253   custom_deserialize_default
 254 };
 255
 256 #ifdef HAVE_VIRSTORAGEPOOLPTR
 257 static struct custom_operations pol_custom_operations = {
 258   "pol_custom_operations",
 259   pol_finalize,
 260   custom_compare_default,
 261   custom_hash_default,
 262   custom_serialize_default,
 263   custom_deserialize_default
 264 };
 265 #endif
 266
 267 #ifdef HAVE_VIRSTORAGEVOLPTR
 268 static struct custom_operations vol_custom_operations = {
 269   "vol_custom_operations",
 270   vol_finalize,
 271   custom_compare_default,
 272   custom_hash_default,
 273   custom_serialize_default,
 274   custom_deserialize_default
 275 };
 276 #endif
 277
 278 static value
 279 Val_connect (virConnectPtr conn)
 280 {
 281   CAMLparam0 ();
 282   CAMLlocal1 (rv);
 283   rv = caml_alloc_custom (&conn_custom_operations,
 284                           sizeof (virConnectPtr), 0, 1);
 285   Connect_val (rv) = conn;
 286   CAMLreturn (rv);
 287 }
 288
 289 static value
 290 Val_dom (virDomainPtr dom)
 291 {
 292   CAMLparam0 ();
 293   CAMLlocal1 (rv);
 294   rv = caml_alloc_custom (&dom_custom_operations,
 295                           sizeof (virDomainPtr), 0, 1);
 296   Dom_val (rv) = dom;
 297   CAMLreturn (rv);
 298 }
 299
 300 static value
 301 Val_net (virNetworkPtr net)
 302 {
 303   CAMLparam0 ();
 304   CAMLlocal1 (rv);
 305   rv = caml_alloc_custom (&net_custom_operations,
 306                           sizeof (virNetworkPtr), 0, 1);
 307   Net_val (rv) = net;
 308   CAMLreturn (rv);
 309 }
 310
 311 #ifdef HAVE_VIRSTORAGEPOOLPTR
 312 static value
 313 Val_pol (virStoragePoolPtr pol)
 314 {
 315   CAMLparam0 ();
 316   CAMLlocal1 (rv);
 317   rv = caml_alloc_custom (&pol_custom_operations,
 318                           sizeof (virStoragePoolPtr), 0, 1);
 319   Pol_val (rv) = pol;
 320   CAMLreturn (rv);
 321 }
 322 #endif
 323
 324 #ifdef HAVE_VIRSTORAGEVOLPTR
 325 static value
 326 Val_vol (virStorageVolPtr net)
 327 {
 328   CAMLparam0 ();
 329   CAMLlocal1 (rv);
 330   rv = caml_alloc_custom (&vol_custom_operations,
 331                           sizeof (virStorageVolPtr), 0, 1);
 332   Vol_val (rv) = vol;
 333   CAMLreturn (rv);
 334 }
 335 #endif
 336
 337 /* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use
 338  * by virterror wrappers.
 339  */
 340 static value
 341 Val_connect_no_finalize (virConnectPtr conn)
 342 {
 343   CAMLparam0 ();
 344   CAMLlocal1 (rv);
 345   rv = caml_alloc (1, Abstract_tag);
 346   Store_field (rv, 0, (value) conn);
 347   CAMLreturn (rv);
 348 }
 349
 350 static value
 351 Val_dom_no_finalize (virDomainPtr dom)
 352 {
 353   CAMLparam0 ();
 354   CAMLlocal1 (rv);
 355   rv = caml_alloc (1, Abstract_tag);
 356   Store_field (rv, 0, (value) dom);
 357   CAMLreturn (rv);
 358 }
 359
 360 static value
 361 Val_net_no_finalize (virNetworkPtr net)
 362 {
 363   CAMLparam0 ();
 364   CAMLlocal1 (rv);
 365   rv = caml_alloc (1, Abstract_tag);
 366   Store_field (rv, 0, (value) net);
 367   CAMLreturn (rv);
 368 }
 369
 370 /* This wraps up the (dom, conn) pair (Domain.t). */
 371 static value
 372 Val_domain (virDomainPtr dom, value connv)
 373 {
 374   CAMLparam1 (connv);
 375   CAMLlocal2 (rv, v);
 376
 377   rv = caml_alloc_tuple (2);
 378   v = Val_dom (dom);
 379   Store_field (rv, 0, v);
 380   Store_field (rv, 1, connv);
 381   CAMLreturn (rv);
 382 }
 383
 384 /* This wraps up the (net, conn) pair (Network.t). */
 385 static value
 386 Val_network (virNetworkPtr net, value connv)
 387 {
 388   CAMLparam1 (connv);
 389   CAMLlocal2 (rv, v);
 390
 391   rv = caml_alloc_tuple (2);
 392   v = Val_net (net);
 393   Store_field (rv, 0, v);
 394   Store_field (rv, 1, connv);
 395   CAMLreturn (rv);
 396 }
 397
 398 #ifdef HAVE_VIRSTORAGEPOOLPTR
 399 /* This wraps up the (pol, conn) pair (Pool.t). */
 400 static value
 401 Val_pool (virStoragePoolPtr pol, value connv)
 402 {
 403   CAMLparam1 (connv);
 404   CAMLlocal2 (rv, v);
 405
 406   rv = caml_alloc_tuple (2);
 407   v = Val_pol (pol);
 408   Store_field (rv, 0, v);
 409   Store_field (rv, 1, connv);
 410   CAMLreturn (rv);
 411 }
 412 #endif
 413
 414 #ifdef HAVE_VIRSTORAGEVOLPTR
 415 /* This wraps up the (vol, conn) pair (Volume.t). */
 416 static value
 417 Val_volume (virStorageVolPtr vol, value connv)
 418 {
 419   CAMLparam1 (connv);
 420   CAMLlocal2 (rv, v);
 421
 422   rv = caml_alloc_tuple (2);
 423   v = Val_vol (vol);
 424   Store_field (rv, 0, v);
 425   Store_field (rv, 1, connv);
 426   CAMLreturn (rv);
 427 }
 428 #endif
 429
 430 /* No-finalize versions of Val_domain, Val_network ONLY for use by
 431  * virterror wrappers.
 432  */
 433 static value
 434 Val_domain_no_finalize (virDomainPtr dom, value connv)
 435 {
 436   CAMLparam1 (connv);
 437   CAMLlocal2 (rv, v);
 438
 439   rv = caml_alloc_tuple (2);
 440   v = Val_dom_no_finalize (dom);
 441   Store_field (rv, 0, v);
 442   Store_field (rv, 1, connv);
 443   CAMLreturn (rv);
 444 }
 445
 446 static value
 447 Val_network_no_finalize (virNetworkPtr net, value connv)
 448 {
 449   CAMLparam1 (connv);
 450   CAMLlocal2 (rv, v);
 451
 452   rv = caml_alloc_tuple (2);
 453   v = Val_net_no_finalize (net);
 454   Store_field (rv, 0, v);
 455   Store_field (rv, 1, connv);
 456   CAMLreturn (rv);
 457 }
 458
 459 static void
 460 conn_finalize (value connv)
 461 {
 462   virConnectPtr conn = Connect_val (connv);
 463   if (conn) (void) virConnectClose (conn);
 464 }
 465
 466 static void
 467 dom_finalize (value domv)
 468 {
 469   virDomainPtr dom = Dom_val (domv);
 470   if (dom) (void) virDomainFree (dom);
 471 }
 472
 473 static void
 474 net_finalize (value netv)
 475 {
 476   virNetworkPtr net = Net_val (netv);
 477   if (net) (void) virNetworkFree (net);
 478 }
 479
 480 #ifdef HAVE_VIRSTORAGEPOOLPTR
 481 static void
 482 pol_finalize (value polv)
 483 {
 484   virStoragePoolPtr pol = Pol_val (polv);
 485   if (pol) (void) virStoragePoolFree (pol);
 486 }
 487 #endif
 488
 489 #ifdef HAVE_VIRSTORAGEVOLPTR
 490 static void
 491 vol_finalize (value volv)
 492 {
 493   virStorageVolPtr vol = Vol_val (volv);
 494   if (vol) (void) virStorageVolFree (vol);
 495 }
 496 #endif