augeas-c.c

   1 /* Augeas OCaml bindings
   2  * Copyright (C) 2008-2017 Red Hat Inc., Richard W.M. Jones
   3  *
   4  * This library is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU Lesser General Public
   6  * License as published by the Free Software Foundation; either
   7  * version 2 of the License, or (at your option) any later version.
   8  *
   9  * This library is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12  * Lesser General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU Lesser General Public
  15  * License along with this library; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  17  *
  18  * $Id: augeas_c.c,v 1.1 2008/05/06 10:48:20 rjones Exp $
  19  */
  20
  21 #include "config.h"
  22
  23 #include <augeas.h>
  24
  25 #include <caml/alloc.h>
  26 #include <caml/memory.h>
  27 #include <caml/mlvalues.h>
  28 #include <caml/fail.h>
  29 #include <caml/callback.h>
  30 #include <caml/custom.h>
  31
  32 #include <stdbool.h>
  33
  34 #ifdef __GNUC__
  35   #define NORETURN __attribute__ ((noreturn))
  36 #else
  37   #define NORETURN
  38 #endif
  39
  40 extern CAMLprim value ocaml_augeas_create (value rootv, value loadpathv, value flagsv);
  41 extern CAMLprim value ocaml_augeas_close (value tv);
  42 extern CAMLprim value ocaml_augeas_defnode (value tv, value namev, value exprv, value valv);
  43 extern CAMLprim value ocaml_augeas_defvar (value tv, value namev, value exprv);
  44 extern CAMLprim value ocaml_augeas_get (value tv, value pathv);
  45 extern CAMLprim value ocaml_augeas_exists (value tv, value pathv);
  46 extern CAMLprim value ocaml_augeas_insert (value tv, value beforev, value pathv, value labelv);
  47 extern CAMLprim value ocaml_augeas_label (value tv, value pathv);
  48 extern CAMLprim value ocaml_augeas_mv (value tv, value srcv, value destv);
  49 extern CAMLprim value ocaml_augeas_rm (value tv, value pathv);
  50 extern CAMLprim value ocaml_augeas_match (value tv, value pathv);
  51 extern CAMLprim value ocaml_augeas_count_matches (value tv, value pathv);
  52 extern CAMLprim value ocaml_augeas_save (value tv);
  53 extern CAMLprim value ocaml_augeas_load (value tv);
  54 extern CAMLprim value ocaml_augeas_set (value tv, value pathv, value valuev);
  55 extern CAMLprim value ocaml_augeas_setm (value tv, value basev, value subv, value valv);
  56 extern CAMLprim value ocaml_augeas_transform (value tv, value lensv, value filev, value modev);
  57 extern CAMLprim value ocaml_augeas_source (value tv, value pathv)
  58 #ifndef HAVE_AUG_SOURCE
  59   NORETURN
  60 #endif
  61 ;
  62
  63 typedef augeas *augeas_t;
  64
  65 /* Map C aug_errcode_t to OCaml error_code. */
  66 static const int error_map[] = {
  67   /* AugErrInternal */ AUG_EINTERNAL,
  68   /* AugErrPathX */    AUG_EPATHX,
  69   /* AugErrNoMatch */  AUG_ENOMATCH,
  70   /* AugErrMMatch */   AUG_EMMATCH,
  71   /* AugErrSyntax */   AUG_ESYNTAX,
  72   /* AugErrNoLens */   AUG_ENOLENS,
  73   /* AugErrMXfm */     AUG_EMXFM,
  74   /* AugErrNoSpan */   AUG_ENOSPAN,
  75   /* AugErrMvDesc */   AUG_EMVDESC,
  76   /* AugErrCmdRun */   AUG_ECMDRUN,
  77   /* AugErrBadArg */   AUG_EBADARG,
  78   /* AugErrLabel */    AUG_ELABEL,
  79   /* AugErrCpDesc */   AUG_ECPDESC,
  80 };
  81 static const int error_map_len = sizeof error_map / sizeof error_map[0];
  82
  83 /* Raise an Augeas.Error exception, and optionally close the
  84  * specified handle.
  85  */
  86 static void
  87 raise_error_and_maybe_close (augeas_t t, const char *msg, bool close_handle)
  88 {
  89   value *exn = caml_named_value ("Augeas.Error");
  90   value args[4];
  91   const int code = aug_error (t);
  92   const char *aug_err_minor;
  93   const char *aug_err_details;
  94   int ocaml_code = -1;
  95   int i;
  96
  97   if (code == AUG_ENOMEM) {
  98     if (close_handle)
  99       aug_close (t);
 100     caml_raise_out_of_memory ();
 101   }
 102
 103   aug_err_minor = aug_error_minor_message (t);
 104   aug_err_details = aug_error_details (t);
 105
 106   for (i = 0; i < error_map_len; ++i)
 107     if (error_map[i] == code) {
 108       ocaml_code = i;
 109       break;
 110     }
 111
 112   if (ocaml_code != -1)
 113     args[0] = Val_int (ocaml_code);
 114   else {
 115     args[0] = caml_alloc (1, 0);
 116     Store_field (args[0], 0, Val_int (code));
 117   }
 118   args[1] = caml_copy_string (msg);
 119   args[2] = caml_copy_string (aug_err_minor ? : "");
 120   args[3] = caml_copy_string (aug_err_details ? : "");
 121
 122   if (close_handle)
 123     aug_close (t);
 124
 125   caml_raise_with_args (*exn, 4, args);
 126 }
 127 #define raise_error(t, msg) raise_error_and_maybe_close(t, msg, false)
 128
 129 static void
 130 raise_init_error (const char *msg)
 131 {
 132   value *exn = caml_named_value ("Augeas.Error");
 133   value args[4];
 134
 135   args[0] = caml_alloc (1, 0);
 136   Store_field (args[0], 0, Val_int (-1));
 137   args[1] = caml_copy_string (msg);
 138   args[2] = caml_copy_string ("augeas initialization failed");
 139   args[3] = caml_copy_string ("");
 140
 141   caml_raise_with_args (*exn, 4, args);
 142 }
 143
 144 static const char *
 145 Optstring_val (value strv)
 146 {
 147   if (strv == Val_int (0))      /* None */
 148     return NULL;
 149   else                          /* Some string */
 150     return String_val (Field (strv, 0));
 151 }
 152
 153 /* Map OCaml flags to C flags. */
 154 static const int flag_map[] = {
 155   /* AugSaveBackup */  AUG_SAVE_BACKUP,
 156   /* AugSaveNewFile */ AUG_SAVE_NEWFILE,
 157   /* AugTypeCheck */   AUG_TYPE_CHECK,
 158   /* AugNoStdinc */    AUG_NO_STDINC,
 159   /* AugSaveNoop */    AUG_SAVE_NOOP,
 160   /* AugNoLoad */      AUG_NO_LOAD,
 161   /* AugNoModlAutoload */ AUG_NO_MODL_AUTOLOAD,
 162   /* AugEnableSpan */  AUG_ENABLE_SPAN,
 163   /* AugNoErrClose */  AUG_NO_ERR_CLOSE,
 164   /* AugTraceModuleLoading */ AUG_TRACE_MODULE_LOADING,
 165 };
 166
 167 /* Wrap and unwrap augeas_t handles, with a finalizer. */
 168 #define Augeas_t_val(rv) (*(augeas_t *)Data_custom_val(rv))
 169
 170 static void
 171 augeas_t_finalize (value tv)
 172 {
 173   augeas_t t = Augeas_t_val (tv);
 174   if (t) aug_close (t);
 175 }
 176
 177 static struct custom_operations custom_operations = {
 178   (char *) "augeas_t_custom_operations",
 179   augeas_t_finalize,
 180   custom_compare_default,
 181   custom_hash_default,
 182   custom_serialize_default,
 183   custom_deserialize_default,
 184   custom_compare_ext_default,
 185 };
 186
 187 static value Val_augeas_t (augeas_t t)
 188 {
 189   CAMLparam0 ();
 190   CAMLlocal1 (rv);
 191   /* We could choose these so that the GC can make better decisions.
 192    * See 18.9.2 of the OCaml manual.
 193    */
 194   const int used = 0;
 195   const int max = 1;
 196
 197   rv = caml_alloc_custom (&custom_operations,
 198                           sizeof (augeas_t), used, max);
 199   Augeas_t_val(rv) = t;
 200
 201   CAMLreturn (rv);
 202 }
 203
 204 #pragma GCC diagnostic ignored "-Wmissing-prototypes"
 205
 206 /* val create : string -> string option -> flag list -> t */
 207 CAMLprim value
 208 ocaml_augeas_create (value rootv, value loadpathv, value flagsv)
 209 {
 210   CAMLparam1 (rootv);
 211   const char *root = String_val (rootv);
 212   const char *loadpath = Optstring_val (loadpathv);
 213   int flags = 0, i;
 214   augeas_t t;
 215
 216   /* Convert list of flags to C. */
 217   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) {
 218     i = Int_val (Field (flagsv, 0));
 219     flags |= flag_map[i];
 220   }
 221
 222   /* Pass AUG_NO_ERR_CLOSE so we raise a detailed Augeas.Error. */
 223   t = aug_init (root, loadpath, flags | AUG_NO_ERR_CLOSE);
 224
 225   if (t == NULL)
 226     raise_init_error ("Augeas.create");
 227
 228   if (aug_error (t) != AUG_NOERROR) {
 229     raise_error_and_maybe_close (t, "Augeas.init", true);
 230   }
 231
 232   CAMLreturn (Val_augeas_t (t));
 233 }
 234
 235 /* val close : t -> unit */
 236 CAMLprim value
 237 ocaml_augeas_close (value tv)
 238 {
 239   CAMLparam1 (tv);
 240   augeas_t t = Augeas_t_val (tv);
 241
 242   if (t) {
 243     aug_close (t);
 244     Augeas_t_val(tv) = NULL;    /* So the finalizer doesn't double-free. */
 245   }
 246
 247   CAMLreturn (Val_unit);
 248 }
 249
 250 /* val defnode : t -> string -> string -> string option -> int * bool */
 251 CAMLprim value
 252 ocaml_augeas_defnode (value tv, value namev, value exprv, value valv)
 253 {
 254   CAMLparam4 (tv, namev, exprv, valv);
 255   CAMLlocal2 (optv, v);
 256   augeas_t t = Augeas_t_val (tv);
 257   const char *name = String_val (namev);
 258   const char *expr = String_val (exprv);
 259   const char *val = Optstring_val (valv);
 260   int r, created;
 261
 262   r = aug_defnode (t, name, expr, val, &created);
 263   if (r == -1) {
 264     raise_error (t, "Augeas.defnode");
 265   }
 266
 267   v = caml_alloc (2, 0);
 268   Store_field (v, 0, Val_int (r));
 269   Store_field (v, 1, Val_bool (created));
 270
 271   CAMLreturn (v);
 272 }
 273
 274 /* val defvar : t -> string -> string option -> int option */
 275 CAMLprim value
 276 ocaml_augeas_defvar (value tv, value namev, value exprv)
 277 {
 278   CAMLparam3 (tv, namev, exprv);
 279   CAMLlocal2 (optv, v);
 280   augeas_t t = Augeas_t_val (tv);
 281   const char *name = String_val (namev);
 282   const char *expr = Optstring_val (exprv);
 283   int r;
 284
 285   r = aug_defvar (t, name, expr);
 286   if (r > 0) {          /* Return Some val */
 287     v = Val_int (r);
 288     optv = caml_alloc (1, 0);
 289     Field (optv, 0) = v;
 290   } else if (r == 0)    /* Return None */
 291     optv = Val_int (0);
 292   else if (r == -1)             /* Error or multiple matches */
 293     raise_error (t, "Augeas.defvar");
 294   else
 295     caml_failwith ("Augeas.defvar: bad return value");
 296
 297   CAMLreturn (optv);
 298 }
 299
 300 /* val get : t -> path -> value option */
 301 CAMLprim value
 302 ocaml_augeas_get (value tv, value pathv)
 303 {
 304   CAMLparam2 (tv, pathv);
 305   CAMLlocal2 (optv, v);
 306   augeas_t t = Augeas_t_val (tv);
 307   const char *path = String_val (pathv);
 308   const char *val;
 309   int r;
 310
 311   r = aug_get (t, path, &val);
 312   if (r == 1 && val) {          /* Return Some val */
 313     v = caml_copy_string (val);
 314     optv = caml_alloc (1, 0);
 315     Field (optv, 0) = v;
 316   } else if (r == 0 || !val)    /* Return None */
 317     optv = Val_int (0);
 318   else if (r == -1)             /* Error or multiple matches */
 319     raise_error (t, "Augeas.get");
 320   else
 321     caml_failwith ("Augeas.get: bad return value");
 322
 323   CAMLreturn (optv);
 324 }
 325
 326 /* val exists : t -> path -> bool */
 327 CAMLprim value
 328 ocaml_augeas_exists (value tv, value pathv)
 329 {
 330   CAMLparam2 (tv, pathv);
 331   CAMLlocal1 (v);
 332   augeas_t t = Augeas_t_val (tv);
 333   const char *path = String_val (pathv);
 334   int r;
 335
 336   r = aug_get (t, path, NULL);
 337   if (r == 1)                   /* Return true. */
 338     v = Val_int (1);
 339   else if (r == 0)              /* Return false */
 340     v = Val_int (0);
 341   else if (r == -1)             /* Error or multiple matches */
 342     raise_error (t, "Augeas.exists");
 343   else
 344     failwith ("Augeas.exists: bad return value");
 345
 346   CAMLreturn (v);
 347 }
 348
 349 /* val insert : t -> ?before:bool -> path -> string -> unit */
 350 CAMLprim value
 351 ocaml_augeas_insert (value tv, value beforev, value pathv, value labelv)
 352 {
 353   CAMLparam4 (tv, beforev, pathv, labelv);
 354   augeas_t t = Augeas_t_val (tv);
 355   const char *path = String_val (pathv);
 356   const char *label = String_val (labelv);
 357   int before;
 358
 359   before = beforev == Val_int (0) ? 0 : Int_val (Field (beforev, 0));
 360
 361   if (aug_insert (t, path, label, before) == -1)
 362     raise_error (t, "Augeas.insert");
 363
 364   CAMLreturn (Val_unit);
 365 }
 366
 367 /* val label : t -> path -> string option */
 368 CAMLprim value
 369 ocaml_augeas_label (value tv, value pathv)
 370 {
 371   CAMLparam2 (tv, pathv);
 372   CAMLlocal2 (optv, v);
 373   augeas_t t = Augeas_t_val (tv);
 374   const char *path = String_val (pathv);
 375   const char *val;
 376   int r;
 377
 378   r = aug_label (t, path, &val);
 379   if (r == 1 && val) {          /* Return Some val */
 380     v = caml_copy_string (val);
 381     optv = caml_alloc (1, 0);
 382     Field (optv, 0) = v;
 383   } else if (r == 0 || !val)    /* Return None */
 384     optv = Val_int (0);
 385   else if (r == -1)             /* Error or multiple matches */
 386     raise_error (t, "Augeas.label");
 387   else
 388     caml_failwith ("Augeas.label: bad return value");
 389
 390   CAMLreturn (optv);
 391 }
 392
 393 /* val mv : t -> path -> path -> unit */
 394 CAMLprim value
 395 ocaml_augeas_mv (value tv, value srcv, value destv)
 396 {
 397   CAMLparam3 (tv, srcv, destv);
 398   augeas_t t = Augeas_t_val (tv);
 399   const char *src = String_val (srcv);
 400   const char *dest = String_val (destv);
 401
 402   if (aug_mv (t, src, dest) == -1)
 403     raise_error (t, "Augeas.mv");
 404
 405   CAMLreturn (Val_unit);
 406 }
 407
 408 /* val rm : t -> path -> int */
 409 CAMLprim value
 410 ocaml_augeas_rm (value tv, value pathv)
 411 {
 412   CAMLparam2 (tv, pathv);
 413   augeas_t t = Augeas_t_val (tv);
 414   const char *path = String_val (pathv);
 415   int r;
 416
 417   r = aug_rm (t, path);
 418   if (r == -1)
 419     raise_error (t, "Augeas.rm");
 420
 421   CAMLreturn (Val_int (r));
 422 }
 423
 424 /* val matches : t -> path -> path list */
 425 CAMLprim value
 426 ocaml_augeas_match (value tv, value pathv)
 427 {
 428   CAMLparam2 (tv, pathv);
 429   CAMLlocal3 (rv, v, cons);
 430   augeas_t t = Augeas_t_val (tv);
 431   const char *path = String_val (pathv);
 432   char **matches;
 433   int r, i;
 434
 435   r = aug_match (t, path, &matches);
 436   if (r == -1)
 437     raise_error (t, "Augeas.matches");
 438
 439   /* Copy the paths to a list. */
 440   rv = Val_int (0);
 441   for (i = 0; i < r; ++i) {
 442     v = caml_copy_string (matches[i]);
 443     free (matches[i]);
 444     cons = caml_alloc (2, 0);
 445     Field (cons, 1) = rv;
 446     Field (cons, 0) = v;
 447     rv = cons;
 448   }
 449
 450   free (matches);
 451
 452   CAMLreturn (rv);
 453 }
 454
 455 /* val count_matches : t -> path -> int */
 456 CAMLprim value
 457 ocaml_augeas_count_matches (value tv, value pathv)
 458 {
 459   CAMLparam2 (tv, pathv);
 460   augeas_t t = Augeas_t_val (tv);
 461   const char *path = String_val (pathv);
 462   int r;
 463
 464   r = aug_match (t, path, NULL);
 465   if (r == -1)
 466     raise_error (t, "Augeas.count_matches");
 467
 468   CAMLreturn (Val_int (r));
 469 }
 470
 471 /* val save : t -> unit */
 472 CAMLprim value
 473 ocaml_augeas_save (value tv)
 474 {
 475   CAMLparam1 (tv);
 476   augeas_t t = Augeas_t_val (tv);
 477
 478   if (aug_save (t) == -1)
 479     raise_error (t, "Augeas.save");
 480
 481   CAMLreturn (Val_unit);
 482 }
 483
 484 /* val load : t -> unit */
 485 CAMLprim value
 486 ocaml_augeas_load (value tv)
 487 {
 488   CAMLparam1 (tv);
 489   augeas_t t = Augeas_t_val (tv);
 490
 491   if (aug_load (t) == -1)
 492     raise_error (t, "Augeas.load");
 493
 494   CAMLreturn (Val_unit);
 495 }
 496
 497 /* val set : t -> -> path -> value option -> unit */
 498 CAMLprim value
 499 ocaml_augeas_set (value tv, value pathv, value valuev)
 500 {
 501   CAMLparam3 (tv, pathv, valuev);
 502   augeas_t t = Augeas_t_val (tv);
 503   const char *path = String_val (pathv);
 504   const char *val = Optstring_val (valuev);
 505
 506   if (aug_set (t, path, val) == -1)
 507     raise_error (t, "Augeas.set");
 508
 509   CAMLreturn (Val_unit);
 510 }
 511
 512 /* val setm : t -> path -> string option -> value option -> int */
 513 CAMLprim value
 514 ocaml_augeas_setm (value tv, value basev, value subv, value valv)
 515 {
 516   CAMLparam4 (tv, basev, subv, valv);
 517   augeas_t t = Augeas_t_val (tv);
 518   const char *base = String_val (basev);
 519   const char *sub = Optstring_val (subv);
 520   const char *val = Optstring_val (valv);
 521   int r;
 522
 523   r = aug_setm (t, base, sub, val);
 524   if (r == -1)
 525     raise_error (t, "Augeas.setm");
 526
 527   CAMLreturn (Val_int (r));
 528 }
 529
 530 /* val transform : t -> string -> string -> transform_mode -> unit */
 531 CAMLprim value
 532 ocaml_augeas_transform (value tv, value lensv, value filev, value modev)
 533 {
 534   CAMLparam4 (tv, lensv, filev, modev);
 535   augeas_t t = Augeas_t_val (tv);
 536   const char *lens = String_val (lensv);
 537   const char *file = String_val (filev);
 538   const int excl = Int_val (modev) == 1 ? 1 : 0;
 539
 540   if (aug_transform (t, lens, file, excl) == -1)
 541     raise_error (t, "Augeas.transform");
 542
 543   CAMLreturn (Val_unit);
 544 }
 545
 546 /* val source : t -> path -> path option */
 547 CAMLprim value
 548 ocaml_augeas_source (value tv, value pathv)
 549 {
 550 #ifdef HAVE_AUG_SOURCE
 551   CAMLparam2 (tv, pathv);
 552   CAMLlocal2 (optv, v);
 553   augeas_t t = Augeas_t_val (tv);
 554   const char *path = String_val (pathv);
 555   char *file_path;
 556   int r;
 557
 558   r = aug_source (t, path, &file_path);
 559   if (r == 0) {
 560     if (file_path) {    /* Return Some file_path */
 561       v = caml_copy_string (file_path);
 562       optv = caml_alloc (1, 0);
 563       Field (optv, 0) = v;
 564       free (file_path);
 565     } else              /* Return None */
 566       optv = Val_int (0);
 567   }
 568   else                  /* Error */
 569     raise_error (t, "Augeas.source");
 570
 571   CAMLreturn (optv);
 572 #else
 573   caml_failwith ("Augeas.source: function not implemented");
 574 #endif
 575 }