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 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
 230 static struct custom_operations conn_custom_operations = {
 231   (char *) "conn_custom_operations",
 232   conn_finalize,
 233   custom_compare_default,
 234   custom_hash_default,
 235   custom_serialize_default,
 236   custom_deserialize_default
 237 };
 238
 239 static struct custom_operations dom_custom_operations = {
 240   (char *) "dom_custom_operations",
 241   dom_finalize,
 242   custom_compare_default,
 243   custom_hash_default,
 244   custom_serialize_default,
 245   custom_deserialize_default
 246
 247 };
 248
 249 static struct custom_operations net_custom_operations = {
 250   (char *) "net_custom_operations",
 251   net_finalize,
 252   custom_compare_default,
 253   custom_hash_default,
 254   custom_serialize_default,
 255   custom_deserialize_default
 256 };
 257
 258 static struct custom_operations pol_custom_operations = {
 259   (char *) "pol_custom_operations",
 260   pol_finalize,
 261   custom_compare_default,
 262   custom_hash_default,
 263   custom_serialize_default,
 264   custom_deserialize_default
 265 };
 266
 267 static struct custom_operations vol_custom_operations = {
 268   (char *) "vol_custom_operations",
 269   vol_finalize,
 270   custom_compare_default,
 271   custom_hash_default,
 272   custom_serialize_default,
 273   custom_deserialize_default
 274 };
 275
 276 static value
 277 Val_connect (virConnectPtr conn)
 278 {
 279   CAMLparam0 ();
 280   CAMLlocal1 (rv);
 281   rv = caml_alloc_custom (&conn_custom_operations,
 282                           sizeof (virConnectPtr), 0, 1);
 283   Connect_val (rv) = conn;
 284   CAMLreturn (rv);
 285 }
 286
 287 static value
 288 Val_dom (virDomainPtr dom)
 289 {
 290   CAMLparam0 ();
 291   CAMLlocal1 (rv);
 292   rv = caml_alloc_custom (&dom_custom_operations,
 293                           sizeof (virDomainPtr), 0, 1);
 294   Dom_val (rv) = dom;
 295   CAMLreturn (rv);
 296 }
 297
 298 static value
 299 Val_net (virNetworkPtr net)
 300 {
 301   CAMLparam0 ();
 302   CAMLlocal1 (rv);
 303   rv = caml_alloc_custom (&net_custom_operations,
 304                           sizeof (virNetworkPtr), 0, 1);
 305   Net_val (rv) = net;
 306   CAMLreturn (rv);
 307 }
 308
 309 static value
 310 Val_pol (virStoragePoolPtr pol)
 311 {
 312   CAMLparam0 ();
 313   CAMLlocal1 (rv);
 314   rv = caml_alloc_custom (&pol_custom_operations,
 315                           sizeof (virStoragePoolPtr), 0, 1);
 316   Pol_val (rv) = pol;
 317   CAMLreturn (rv);
 318 }
 319
 320 static value
 321 Val_vol (virStorageVolPtr vol)
 322 {
 323   CAMLparam0 ();
 324   CAMLlocal1 (rv);
 325   rv = caml_alloc_custom (&vol_custom_operations,
 326                           sizeof (virStorageVolPtr), 0, 1);
 327   Vol_val (rv) = vol;
 328   CAMLreturn (rv);
 329 }
 330
 331 /* This wraps up the (dom, conn) pair (Domain.t). */
 332 static value
 333 Val_domain (virDomainPtr dom, value connv)
 334 {
 335   CAMLparam1 (connv);
 336   CAMLlocal2 (rv, v);
 337
 338   rv = caml_alloc_tuple (2);
 339   v = Val_dom (dom);
 340   Store_field (rv, 0, v);
 341   Store_field (rv, 1, connv);
 342   CAMLreturn (rv);
 343 }
 344
 345 /* This wraps up the (net, conn) pair (Network.t). */
 346 static value
 347 Val_network (virNetworkPtr net, value connv)
 348 {
 349   CAMLparam1 (connv);
 350   CAMLlocal2 (rv, v);
 351
 352   rv = caml_alloc_tuple (2);
 353   v = Val_net (net);
 354   Store_field (rv, 0, v);
 355   Store_field (rv, 1, connv);
 356   CAMLreturn (rv);
 357 }
 358
 359 /* This wraps up the (pol, conn) pair (Pool.t). */
 360 static value
 361 Val_pool (virStoragePoolPtr pol, value connv)
 362 {
 363   CAMLparam1 (connv);
 364   CAMLlocal2 (rv, v);
 365
 366   rv = caml_alloc_tuple (2);
 367   v = Val_pol (pol);
 368   Store_field (rv, 0, v);
 369   Store_field (rv, 1, connv);
 370   CAMLreturn (rv);
 371 }
 372
 373 /* This wraps up the (vol, conn) pair (Volume.t). */
 374 static value
 375 Val_volume (virStorageVolPtr vol, value connv)
 376 {
 377   CAMLparam1 (connv);
 378   CAMLlocal2 (rv, v);
 379
 380   rv = caml_alloc_tuple (2);
 381   v = Val_vol (vol);
 382   Store_field (rv, 0, v);
 383   Store_field (rv, 1, connv);
 384   CAMLreturn (rv);
 385 }
 386
 387 static void
 388 conn_finalize (value connv)
 389 {
 390   virConnectPtr conn = Connect_val (connv);
 391   if (conn) (void) virConnectClose (conn);
 392 }
 393
 394 static void
 395 dom_finalize (value domv)
 396 {
 397   virDomainPtr dom = Dom_val (domv);
 398   if (dom) (void) virDomainFree (dom);
 399 }
 400
 401 static void
 402 net_finalize (value netv)
 403 {
 404   virNetworkPtr net = Net_val (netv);
 405   if (net) (void) virNetworkFree (net);
 406 }
 407
 408 static void
 409 pol_finalize (value polv)
 410 {
 411   virStoragePoolPtr pol = Pol_val (polv);
 412   if (pol) (void) virStoragePoolFree (pol);
 413 }
 414
 415 static void
 416 vol_finalize (value volv)
 417 {
 418   virStorageVolPtr vol = Vol_val (volv);
 419   if (vol) (void) virStorageVolFree (vol);
 420 }