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