libvirt/libvirt_c_epilogue.c

   1 /* OCaml bindings for libvirt.
   2  * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
   3  * https://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 const 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 static int
 104 _list_length (value listv)
 105 {
 106   CAMLparam1 (listv);
 107   int len = 0;
 108
 109   for (; listv != Val_emptylist; listv = Field (listv, 1), ++len) {}
 110
 111   CAMLreturnT (int, len);
 112 }
 113
 114 static value
 115 Val_virconnectcredential (const virConnectCredentialPtr cred)
 116 {
 117   CAMLparam0 ();
 118   CAMLlocal1 (rv);
 119
 120   rv = caml_alloc (4, 0);
 121   Store_field (rv, 0, Val_int (cred->type - 1));
 122   Store_field (rv, 1, caml_copy_string (cred->prompt));
 123   Store_field (rv, 2,
 124                Val_opt_const (cred->challenge,
 125                               (Val_const_ptr_t) caml_copy_string));
 126   Store_field (rv, 3,
 127                Val_opt_const (cred->defresult,
 128                               (Val_const_ptr_t) caml_copy_string));
 129
 130   CAMLreturn (rv);
 131 }
 132
 133 /* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums
 134  * into values (longs because they are variants in OCaml).
 135  *
 136  * The enum values are part of the libvirt ABI so they cannot change,
 137  * which means that we can convert these numbers directly into
 138  * OCaml variants (which use the same ordering) very fast.
 139  *
 140  * The tricky part here is when we are linked to a newer version of
 141  * libvirt than the one we were compiled against.  If the newer libvirt
 142  * generates an error code which we don't know about then we need
 143  * to convert it into VIR_*_UNKNOWN (code).
 144  */
 145
 146 #define MAX_VIR_CODE 101 /* VIR_ERR_NO_NWFILTER_BINDING */
 147 #define MAX_VIR_DOMAIN 67 /* VIR_FROM_RESCTRL */
 148 #define MAX_VIR_LEVEL VIR_ERR_ERROR
 149
 150 static inline value
 151 Val_err_number (virErrorNumber code)
 152 {
 153   CAMLparam0 ();
 154   CAMLlocal1 (rv);
 155
 156   if (0 <= code && code <= MAX_VIR_CODE)
 157     rv = Val_int (code);
 158   else {
 159     rv = caml_alloc (1, 0);     /* VIR_ERR_UNKNOWN (code) */
 160     Store_field (rv, 0, Val_int (code));
 161   }
 162
 163   CAMLreturn (rv);
 164 }
 165
 166 static inline value
 167 Val_err_domain (virErrorDomain code)
 168 {
 169   CAMLparam0 ();
 170   CAMLlocal1 (rv);
 171
 172   if (0 <= code && code <= MAX_VIR_DOMAIN)
 173     rv = Val_int (code);
 174   else {
 175     rv = caml_alloc (1, 0);     /* VIR_FROM_UNKNOWN (code) */
 176     Store_field (rv, 0, Val_int (code));
 177   }
 178
 179   CAMLreturn (rv);
 180 }
 181
 182 static inline value
 183 Val_err_level (virErrorLevel code)
 184 {
 185   CAMLparam0 ();
 186   CAMLlocal1 (rv);
 187
 188   if (0 <= code && code <= MAX_VIR_LEVEL)
 189     rv = Val_int (code);
 190   else {
 191     rv = caml_alloc (1, 0);     /* VIR_ERR_UNKNOWN_LEVEL (code) */
 192     Store_field (rv, 0, Val_int (code));
 193   }
 194
 195   CAMLreturn (rv);
 196 }
 197
 198 /* Convert a virterror to a value. */
 199 static value
 200 Val_virterror (virErrorPtr err)
 201 {
 202   CAMLparam0 ();
 203   CAMLlocal3 (rv, connv, optv);
 204
 205   rv = caml_alloc (9, 0);
 206   Store_field (rv, 0, Val_err_number (err->code));
 207   Store_field (rv, 1, Val_err_domain (err->domain));
 208   Store_field (rv, 2,
 209                Val_opt (err->message, (Val_ptr_t) caml_copy_string));
 210   Store_field (rv, 3, Val_err_level (err->level));
 211
 212   Store_field (rv, 4,
 213                Val_opt (err->str1, (Val_ptr_t) caml_copy_string));
 214   Store_field (rv, 5,
 215                Val_opt (err->str2, (Val_ptr_t) caml_copy_string));
 216   Store_field (rv, 6,
 217                Val_opt (err->str3, (Val_ptr_t) caml_copy_string));
 218   Store_field (rv, 7, caml_copy_int32 (err->int1));
 219   Store_field (rv, 8, caml_copy_int32 (err->int2));
 220
 221   CAMLreturn (rv);
 222 }
 223
 224 static void conn_finalize (value);
 225 static void dom_finalize (value);
 226 static void net_finalize (value);
 227 static void pol_finalize (value);
 228 static void vol_finalize (value);
 229 static void sec_finalize (value);
 230
 231 static struct custom_operations conn_custom_operations = {
 232   (char *) "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   (char *) "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   (char *) "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 static struct custom_operations pol_custom_operations = {
 260   (char *) "pol_custom_operations",
 261   pol_finalize,
 262   custom_compare_default,
 263   custom_hash_default,
 264   custom_serialize_default,
 265   custom_deserialize_default
 266 };
 267
 268 static struct custom_operations vol_custom_operations = {
 269   (char *) "vol_custom_operations",
 270   vol_finalize,
 271   custom_compare_default,
 272   custom_hash_default,
 273   custom_serialize_default,
 274   custom_deserialize_default
 275 };
 276
 277 static struct custom_operations sec_custom_operations = {
 278   (char *) "sec_custom_operations",
 279   sec_finalize,
 280   custom_compare_default,
 281   custom_hash_default,
 282   custom_serialize_default,
 283   custom_deserialize_default
 284 };
 285
 286 static value
 287 Val_connect (virConnectPtr conn)
 288 {
 289   CAMLparam0 ();
 290   CAMLlocal1 (rv);
 291   rv = caml_alloc_custom (&conn_custom_operations,
 292                           sizeof (virConnectPtr), 0, 1);
 293   Connect_val (rv) = conn;
 294   CAMLreturn (rv);
 295 }
 296
 297 static value
 298 Val_dom (virDomainPtr dom)
 299 {
 300   CAMLparam0 ();
 301   CAMLlocal1 (rv);
 302   rv = caml_alloc_custom (&dom_custom_operations,
 303                           sizeof (virDomainPtr), 0, 1);
 304   Dom_val (rv) = dom;
 305   CAMLreturn (rv);
 306 }
 307
 308 static value
 309 Val_net (virNetworkPtr net)
 310 {
 311   CAMLparam0 ();
 312   CAMLlocal1 (rv);
 313   rv = caml_alloc_custom (&net_custom_operations,
 314                           sizeof (virNetworkPtr), 0, 1);
 315   Net_val (rv) = net;
 316   CAMLreturn (rv);
 317 }
 318
 319 static value
 320 Val_pol (virStoragePoolPtr pol)
 321 {
 322   CAMLparam0 ();
 323   CAMLlocal1 (rv);
 324   rv = caml_alloc_custom (&pol_custom_operations,
 325                           sizeof (virStoragePoolPtr), 0, 1);
 326   Pol_val (rv) = pol;
 327   CAMLreturn (rv);
 328 }
 329
 330 static value
 331 Val_vol (virStorageVolPtr vol)
 332 {
 333   CAMLparam0 ();
 334   CAMLlocal1 (rv);
 335   rv = caml_alloc_custom (&vol_custom_operations,
 336                           sizeof (virStorageVolPtr), 0, 1);
 337   Vol_val (rv) = vol;
 338   CAMLreturn (rv);
 339 }
 340
 341 static value
 342 Val_sec (virSecretPtr sec)
 343 {
 344   CAMLparam0 ();
 345   CAMLlocal1 (rv);
 346   rv = caml_alloc_custom (&sec_custom_operations,
 347                           sizeof (virSecretPtr), 0, 1);
 348   Sec_val (rv) = sec;
 349   CAMLreturn (rv);
 350 }
 351
 352 /* This wraps up the (dom, conn) pair (Domain.t). */
 353 static value
 354 Val_domain (virDomainPtr dom, value connv)
 355 {
 356   CAMLparam1 (connv);
 357   CAMLlocal2 (rv, v);
 358
 359   rv = caml_alloc_tuple (2);
 360   v = Val_dom (dom);
 361   Store_field (rv, 0, v);
 362   Store_field (rv, 1, connv);
 363   CAMLreturn (rv);
 364 }
 365
 366 /* This wraps up the (net, conn) pair (Network.t). */
 367 static value
 368 Val_network (virNetworkPtr net, value connv)
 369 {
 370   CAMLparam1 (connv);
 371   CAMLlocal2 (rv, v);
 372
 373   rv = caml_alloc_tuple (2);
 374   v = Val_net (net);
 375   Store_field (rv, 0, v);
 376   Store_field (rv, 1, connv);
 377   CAMLreturn (rv);
 378 }
 379
 380 /* This wraps up the (pol, conn) pair (Pool.t). */
 381 static value
 382 Val_pool (virStoragePoolPtr pol, value connv)
 383 {
 384   CAMLparam1 (connv);
 385   CAMLlocal2 (rv, v);
 386
 387   rv = caml_alloc_tuple (2);
 388   v = Val_pol (pol);
 389   Store_field (rv, 0, v);
 390   Store_field (rv, 1, connv);
 391   CAMLreturn (rv);
 392 }
 393
 394 /* This wraps up the (vol, conn) pair (Volume.t). */
 395 static value
 396 Val_volume (virStorageVolPtr vol, value connv)
 397 {
 398   CAMLparam1 (connv);
 399   CAMLlocal2 (rv, v);
 400
 401   rv = caml_alloc_tuple (2);
 402   v = Val_vol (vol);
 403   Store_field (rv, 0, v);
 404   Store_field (rv, 1, connv);
 405   CAMLreturn (rv);
 406 }
 407
 408 /* This wraps up the (sec, conn) pair (Secret.t). */
 409 static value
 410 Val_secret (virSecretPtr sec, value connv)
 411 {
 412   CAMLparam1 (connv);
 413   CAMLlocal2 (rv, v);
 414
 415   rv = caml_alloc_tuple (2);
 416   v = Val_sec (sec);
 417   Store_field (rv, 0, v);
 418   Store_field (rv, 1, connv);
 419   CAMLreturn (rv);
 420 }
 421
 422 static void
 423 conn_finalize (value connv)
 424 {
 425   virConnectPtr conn = Connect_val (connv);
 426   if (conn) (void) virConnectClose (conn);
 427 }
 428
 429 static void
 430 dom_finalize (value domv)
 431 {
 432   virDomainPtr dom = Dom_val (domv);
 433   if (dom) (void) virDomainFree (dom);
 434 }
 435
 436 static void
 437 net_finalize (value netv)
 438 {
 439   virNetworkPtr net = Net_val (netv);
 440   if (net) (void) virNetworkFree (net);
 441 }
 442
 443 static void
 444 pol_finalize (value polv)
 445 {
 446   virStoragePoolPtr pol = Pol_val (polv);
 447   if (pol) (void) virStoragePoolFree (pol);
 448 }
 449
 450 static void
 451 vol_finalize (value volv)
 452 {
 453   virStorageVolPtr vol = Vol_val (volv);
 454   if (vol) (void) virStorageVolFree (vol);
 455 }
 456
 457 static void
 458 sec_finalize (value secv)
 459 {
 460   virSecretPtr sec = Sec_val (secv);
 461   if (sec) (void) virSecretFree (sec);
 462 }