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 50 /* VIR_ERR_NO_STORAGE_VOL */
 115 #define MAX_VIR_DOMAIN 17 /* VIR_FROM_STORAGE */
 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 #ifdef HAVE_VIRJOBPTR
 228 static void jb_finalize (value);
 229 #endif
 230
 231 static struct custom_operations conn_custom_operations = {
 232   "conn_custom_operations",
 233   conn_finalize,
 234   custom_compare_default,
 235   custom_hash_default,
 236   custom_serialize_default,
 237   custom_deserialize_default
 238 };
 239
 240 static struct custom_operations dom_custom_operations = {
 241   "dom_custom_operations",
 242   dom_finalize,
 243   custom_compare_default,
 244   custom_hash_default,
 245   custom_serialize_default,
 246   custom_deserialize_default
 247
 248 };
 249
 250 static struct custom_operations net_custom_operations = {
 251   "net_custom_operations",
 252   net_finalize,
 253   custom_compare_default,
 254   custom_hash_default,
 255   custom_serialize_default,
 256   custom_deserialize_default
 257 };
 258
 259 #ifdef HAVE_VIRSTORAGEPOOLPTR
 260 static struct custom_operations pol_custom_operations = {
 261   "pol_custom_operations",
 262   pol_finalize,
 263   custom_compare_default,
 264   custom_hash_default,
 265   custom_serialize_default,
 266   custom_deserialize_default
 267 };
 268 #endif
 269
 270 #ifdef HAVE_VIRSTORAGEVOLPTR
 271 static struct custom_operations vol_custom_operations = {
 272   "vol_custom_operations",
 273   vol_finalize,
 274   custom_compare_default,
 275   custom_hash_default,
 276   custom_serialize_default,
 277   custom_deserialize_default
 278 };
 279 #endif
 280
 281 #ifdef HAVE_VIRJOBPTR
 282 static struct custom_operations jb_custom_operations = {
 283   "jb_custom_operations",
 284   jb_finalize,
 285   custom_compare_default,
 286   custom_hash_default,
 287   custom_serialize_default,
 288   custom_deserialize_default
 289 };
 290 #endif
 291
 292 static value
 293 Val_connect (virConnectPtr conn)
 294 {
 295   CAMLparam0 ();
 296   CAMLlocal1 (rv);
 297   rv = caml_alloc_custom (&conn_custom_operations,
 298                           sizeof (virConnectPtr), 0, 1);
 299   Connect_val (rv) = conn;
 300   CAMLreturn (rv);
 301 }
 302
 303 static value
 304 Val_dom (virDomainPtr dom)
 305 {
 306   CAMLparam0 ();
 307   CAMLlocal1 (rv);
 308   rv = caml_alloc_custom (&dom_custom_operations,
 309                           sizeof (virDomainPtr), 0, 1);
 310   Dom_val (rv) = dom;
 311   CAMLreturn (rv);
 312 }
 313
 314 static value
 315 Val_net (virNetworkPtr net)
 316 {
 317   CAMLparam0 ();
 318   CAMLlocal1 (rv);
 319   rv = caml_alloc_custom (&net_custom_operations,
 320                           sizeof (virNetworkPtr), 0, 1);
 321   Net_val (rv) = net;
 322   CAMLreturn (rv);
 323 }
 324
 325 #ifdef HAVE_VIRSTORAGEPOOLPTR
 326 static value
 327 Val_pol (virStoragePoolPtr pol)
 328 {
 329   CAMLparam0 ();
 330   CAMLlocal1 (rv);
 331   rv = caml_alloc_custom (&pol_custom_operations,
 332                           sizeof (virStoragePoolPtr), 0, 1);
 333   Pol_val (rv) = pol;
 334   CAMLreturn (rv);
 335 }
 336 #endif
 337
 338 #ifdef HAVE_VIRSTORAGEVOLPTR
 339 static value
 340 Val_vol (virStorageVolPtr vol)
 341 {
 342   CAMLparam0 ();
 343   CAMLlocal1 (rv);
 344   rv = caml_alloc_custom (&vol_custom_operations,
 345                           sizeof (virStorageVolPtr), 0, 1);
 346   Vol_val (rv) = vol;
 347   CAMLreturn (rv);
 348 }
 349 #endif
 350
 351 #ifdef HAVE_VIRJOBPTR
 352 static value
 353 Val_jb (virJobPtr jb)
 354 {
 355   CAMLparam0 ();
 356   CAMLlocal1 (rv);
 357   rv = caml_alloc_custom (&jb_custom_operations,
 358                           sizeof (virJobPtr), 0, 1);
 359   Jb_val (rv) = jb;
 360   CAMLreturn (rv);
 361 }
 362 #endif
 363
 364 /* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use
 365  * by virterror wrappers.
 366  */
 367 static value
 368 Val_connect_no_finalize (virConnectPtr conn)
 369 {
 370   CAMLparam0 ();
 371   CAMLlocal1 (rv);
 372   rv = caml_alloc (1, Abstract_tag);
 373   Store_field (rv, 0, (value) conn);
 374   CAMLreturn (rv);
 375 }
 376
 377 static value
 378 Val_dom_no_finalize (virDomainPtr dom)
 379 {
 380   CAMLparam0 ();
 381   CAMLlocal1 (rv);
 382   rv = caml_alloc (1, Abstract_tag);
 383   Store_field (rv, 0, (value) dom);
 384   CAMLreturn (rv);
 385 }
 386
 387 static value
 388 Val_net_no_finalize (virNetworkPtr net)
 389 {
 390   CAMLparam0 ();
 391   CAMLlocal1 (rv);
 392   rv = caml_alloc (1, Abstract_tag);
 393   Store_field (rv, 0, (value) net);
 394   CAMLreturn (rv);
 395 }
 396
 397 /* This wraps up the (dom, conn) pair (Domain.t). */
 398 static value
 399 Val_domain (virDomainPtr dom, value connv)
 400 {
 401   CAMLparam1 (connv);
 402   CAMLlocal2 (rv, v);
 403
 404   rv = caml_alloc_tuple (2);
 405   v = Val_dom (dom);
 406   Store_field (rv, 0, v);
 407   Store_field (rv, 1, connv);
 408   CAMLreturn (rv);
 409 }
 410
 411 /* This wraps up the (net, conn) pair (Network.t). */
 412 static value
 413 Val_network (virNetworkPtr net, value connv)
 414 {
 415   CAMLparam1 (connv);
 416   CAMLlocal2 (rv, v);
 417
 418   rv = caml_alloc_tuple (2);
 419   v = Val_net (net);
 420   Store_field (rv, 0, v);
 421   Store_field (rv, 1, connv);
 422   CAMLreturn (rv);
 423 }
 424
 425 #ifdef HAVE_VIRSTORAGEPOOLPTR
 426 /* This wraps up the (pol, conn) pair (Pool.t). */
 427 static value
 428 Val_pool (virStoragePoolPtr pol, value connv)
 429 {
 430   CAMLparam1 (connv);
 431   CAMLlocal2 (rv, v);
 432
 433   rv = caml_alloc_tuple (2);
 434   v = Val_pol (pol);
 435   Store_field (rv, 0, v);
 436   Store_field (rv, 1, connv);
 437   CAMLreturn (rv);
 438 }
 439 #endif
 440
 441 #ifdef HAVE_VIRSTORAGEVOLPTR
 442 /* This wraps up the (vol, conn) pair (Volume.t). */
 443 static value
 444 Val_volume (virStorageVolPtr vol, value connv)
 445 {
 446   CAMLparam1 (connv);
 447   CAMLlocal2 (rv, v);
 448
 449   rv = caml_alloc_tuple (2);
 450   v = Val_vol (vol);
 451   Store_field (rv, 0, v);
 452   Store_field (rv, 1, connv);
 453   CAMLreturn (rv);
 454 }
 455 #endif
 456
 457 #ifdef HAVE_VIRJOBPTR
 458 /* This wraps up the (jb, conn) pair (Job.t). */
 459 static value
 460 Val_job (virJobPtr jb, value connv)
 461 {
 462   CAMLparam1 (connv);
 463   CAMLlocal2 (rv, v);
 464
 465   rv = caml_alloc_tuple (2);
 466   v = Val_jb (jb);
 467   Store_field (rv, 0, v);
 468   Store_field (rv, 1, connv);
 469   CAMLreturn (rv);
 470 }
 471 #endif
 472
 473 /* No-finalize versions of Val_domain, Val_network ONLY for use by
 474  * virterror wrappers.
 475  */
 476 static value
 477 Val_domain_no_finalize (virDomainPtr dom, value connv)
 478 {
 479   CAMLparam1 (connv);
 480   CAMLlocal2 (rv, v);
 481
 482   rv = caml_alloc_tuple (2);
 483   v = Val_dom_no_finalize (dom);
 484   Store_field (rv, 0, v);
 485   Store_field (rv, 1, connv);
 486   CAMLreturn (rv);
 487 }
 488
 489 static value
 490 Val_network_no_finalize (virNetworkPtr net, value connv)
 491 {
 492   CAMLparam1 (connv);
 493   CAMLlocal2 (rv, v);
 494
 495   rv = caml_alloc_tuple (2);
 496   v = Val_net_no_finalize (net);
 497   Store_field (rv, 0, v);
 498   Store_field (rv, 1, connv);
 499   CAMLreturn (rv);
 500 }
 501
 502 static void
 503 conn_finalize (value connv)
 504 {
 505   virConnectPtr conn = Connect_val (connv);
 506   if (conn) (void) virConnectClose (conn);
 507 }
 508
 509 static void
 510 dom_finalize (value domv)
 511 {
 512   virDomainPtr dom = Dom_val (domv);
 513   if (dom) (void) virDomainFree (dom);
 514 }
 515
 516 static void
 517 net_finalize (value netv)
 518 {
 519   virNetworkPtr net = Net_val (netv);
 520   if (net) (void) virNetworkFree (net);
 521 }
 522
 523 #ifdef HAVE_VIRSTORAGEPOOLPTR
 524 static void
 525 pol_finalize (value polv)
 526 {
 527   virStoragePoolPtr pol = Pol_val (polv);
 528   if (pol) (void) virStoragePoolFree (pol);
 529 }
 530 #endif
 531
 532 #ifdef HAVE_VIRSTORAGEVOLPTR
 533 static void
 534 vol_finalize (value volv)
 535 {
 536   virStorageVolPtr vol = Vol_val (volv);
 537   if (vol) (void) virStorageVolFree (vol);
 538 }
 539 #endif
 540
 541 #ifdef HAVE_VIRJOBPTR
 542 static void
 543 jb_finalize (value jbv)
 544 {
 545   virJobPtr jb = Jb_val (jbv);
 546   if (jb) (void) virJobFree (jb);
 547 }
 548 #endif