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[5];
  91   const int code = aug_error (t);
  92   const char *aug_err_msg;
  93   const char *aug_err_minor;
  94   const char *aug_err_details;
  95   int ocaml_code = -1;
  96   int i;
  97
  98   if (code == AUG_ENOMEM) {
  99     if (close_handle)
 100       aug_close (t);
 101     caml_raise_out_of_memory ();
 102   }
 103
 104   aug_err_msg = aug_error_message (t);
 105   aug_err_minor = aug_error_minor_message (t);
 106   aug_err_details = aug_error_details (t);
 107
 108   for (i = 0; i < error_map_len; ++i)
 109     if (error_map[i] == code) {
 110       ocaml_code = i;
 111       break;
 112     }
 113
 114   if (ocaml_code != -1)
 115     args[0] = Val_int (ocaml_code);
 116   else {
 117     args[0] = caml_alloc (1, 0);
 118     Store_field (args[0], 0, Val_int (code));
 119   }
 120   args[1] = caml_copy_string (msg);
 121   args[2] = caml_copy_string (aug_err_msg);
 122   args[3] = caml_copy_string (aug_err_minor ? : "");
 123   args[4] = caml_copy_string (aug_err_details ? : "");
 124
 125   if (close_handle)
 126     aug_close (t);
 127
 128   caml_raise_with_args (*exn, 5, args);
 129 }
 130 #define raise_error(t, msg) raise_error_and_maybe_close(t, msg, false)
 131
 132 static void
 133 raise_init_error (const char *msg)
 134 {
 135   value *exn = caml_named_value ("Augeas.Error");
 136   value args[5];
 137
 138   args[0] = caml_alloc (1, 0);
 139   Store_field (args[0], 0, Val_int (-1));
 140   args[1] = caml_copy_string (msg);
 141   args[2] = caml_copy_string ("aug_init failed");
 142   args[3] = caml_copy_string ("augeas initialization failed");
 143   args[4] = caml_copy_string ("");
 144
 145   caml_raise_with_args (*exn, 5, args);
 146 }
 147
 148 static const char *
 149 Optstring_val (value strv)
 150 {
 151   if (strv == Val_int (0))      /* None */
 152     return NULL;
 153   else                          /* Some string */
 154     return String_val (Field (strv, 0));
 155 }
 156
 157 /* Map OCaml flags to C flags. */
 158 static const int flag_map[] = {
 159   /* AugSaveBackup */  AUG_SAVE_BACKUP,
 160   /* AugSaveNewFile */ AUG_SAVE_NEWFILE,
 161   /* AugTypeCheck */   AUG_TYPE_CHECK,
 162   /* AugNoStdinc */    AUG_NO_STDINC,
 163   /* AugSaveNoop */    AUG_SAVE_NOOP,
 164   /* AugNoLoad */      AUG_NO_LOAD,
 165   /* AugNoModlAutoload */ AUG_NO_MODL_AUTOLOAD,
 166   /* AugEnableSpan */  AUG_ENABLE_SPAN,
 167   /* AugNoErrClose */  AUG_NO_ERR_CLOSE,
 168   /* AugTraceModuleLoading */ AUG_TRACE_MODULE_LOADING,
 169 };
 170
 171 /* Wrap and unwrap augeas_t handles, with a finalizer. */
 172 #define Augeas_t_val(rv) (*(augeas_t *)Data_custom_val(rv))
 173
 174 static void
 175 augeas_t_finalize (value tv)
 176 {
 177   augeas_t t = Augeas_t_val (tv);
 178   if (t) aug_close (t);
 179 }
 180
 181 static struct custom_operations custom_operations = {
 182   (char *) "augeas_t_custom_operations",
 183   augeas_t_finalize,
 184   custom_compare_default,
 185   custom_hash_default,
 186   custom_serialize_default,
 187   custom_deserialize_default,
 188   custom_compare_ext_default,
 189 };
 190
 191 static value Val_augeas_t (augeas_t t)
 192 {
 193   CAMLparam0 ();
 194   CAMLlocal1 (rv);
 195   /* We could choose these so that the GC can make better decisions.
 196    * See 18.9.2 of the OCaml manual.
 197    */
 198   const int used = 0;
 199   const int max = 1;
 200
 201   rv = caml_alloc_custom (&custom_operations,
 202                           sizeof (augeas_t), used, max);
 203   Augeas_t_val(rv) = t;
 204
 205   CAMLreturn (rv);
 206 }
 207
 208 #pragma GCC diagnostic ignored "-Wmissing-prototypes"
 209
 210 /* val create : string -> string option -> flag list -> t */
 211 CAMLprim value
 212 ocaml_augeas_create (value rootv, value loadpathv, value flagsv)
 213 {
 214   CAMLparam1 (rootv);
 215   const char *root = String_val (rootv);
 216   const char *loadpath = Optstring_val (loadpathv);
 217   int flags = 0, i;
 218   augeas_t t;
 219
 220   /* Convert list of flags to C. */
 221   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) {
 222     i = Int_val (Field (flagsv, 0));
 223     flags |= flag_map[i];
 224   }
 225
 226   /* Pass AUG_NO_ERR_CLOSE so we raise a detailed Augeas.Error. */
 227   t = aug_init (root, loadpath, flags | AUG_NO_ERR_CLOSE);
 228
 229   if (t == NULL)
 230     raise_init_error ("Augeas.create");
 231
 232   if (aug_error (t) != AUG_NOERROR) {
 233     raise_error_and_maybe_close (t, "Augeas.init", true);
 234   }
 235
 236   CAMLreturn (Val_augeas_t (t));
 237 }
 238
 239 /* val close : t -> unit */
 240 CAMLprim value
 241 ocaml_augeas_close (value tv)
 242 {
 243   CAMLparam1 (tv);
 244   augeas_t t = Augeas_t_val (tv);
 245
 246   if (t) {
 247     aug_close (t);
 248     Augeas_t_val(tv) = NULL;    /* So the finalizer doesn't double-free. */
 249   }
 250
 251   CAMLreturn (Val_unit);
 252 }
 253
 254 /* val defnode : t -> string -> string -> string option -> int * bool */
 255 CAMLprim value
 256 ocaml_augeas_defnode (value tv, value namev, value exprv, value valv)
 257 {
 258   CAMLparam4 (tv, namev, exprv, valv);
 259   CAMLlocal2 (optv, v);
 260   augeas_t t = Augeas_t_val (tv);
 261   const char *name = String_val (namev);
 262   const char *expr = String_val (exprv);
 263   const char *val = Optstring_val (valv);
 264   int r, created;
 265
 266   r = aug_defnode (t, name, expr, val, &created);
 267   if (r == -1) {
 268     raise_error (t, "Augeas.defnode");
 269   }
 270
 271   v = caml_alloc (2, 0);
 272   Store_field (v, 0, Val_int (r));
 273   Store_field (v, 1, Val_bool (created));
 274
 275   CAMLreturn (v);
 276 }
 277
 278 /* val defvar : t -> string -> string option -> int option */
 279 CAMLprim value
 280 ocaml_augeas_defvar (value tv, value namev, value exprv)
 281 {
 282   CAMLparam3 (tv, namev, exprv);
 283   CAMLlocal2 (optv, v);
 284   augeas_t t = Augeas_t_val (tv);
 285   const char *name = String_val (namev);
 286   const char *expr = Optstring_val (exprv);
 287   int r;
 288
 289   r = aug_defvar (t, name, expr);
 290   if (r > 0) {          /* Return Some val */
 291     v = Val_int (r);
 292     optv = caml_alloc (1, 0);
 293     Field (optv, 0) = v;
 294   } else if (r == 0)    /* Return None */
 295     optv = Val_int (0);
 296   else if (r == -1)             /* Error or multiple matches */
 297     raise_error (t, "Augeas.defvar");
 298   else
 299     caml_failwith ("Augeas.defvar: bad return value");
 300
 301   CAMLreturn (optv);
 302 }
 303
 304 /* val get : t -> path -> value option */
 305 CAMLprim value
 306 ocaml_augeas_get (value tv, value pathv)
 307 {
 308   CAMLparam2 (tv, pathv);
 309   CAMLlocal2 (optv, v);
 310   augeas_t t = Augeas_t_val (tv);
 311   const char *path = String_val (pathv);
 312   const char *val;
 313   int r;
 314
 315   r = aug_get (t, path, &val);
 316   if (r == 1 && val) {          /* Return Some val */
 317     v = caml_copy_string (val);
 318     optv = caml_alloc (1, 0);
 319     Field (optv, 0) = v;
 320   } else if (r == 0 || !val)    /* Return None */
 321     optv = Val_int (0);
 322   else if (r == -1)             /* Error or multiple matches */
 323     raise_error (t, "Augeas.get");
 324   else
 325     caml_failwith ("Augeas.get: bad return value");
 326
 327   CAMLreturn (optv);
 328 }
 329
 330 /* val exists : t -> path -> bool */
 331 CAMLprim value
 332 ocaml_augeas_exists (value tv, value pathv)
 333 {
 334   CAMLparam2 (tv, pathv);
 335   CAMLlocal1 (v);
 336   augeas_t t = Augeas_t_val (tv);
 337   const char *path = String_val (pathv);
 338   int r;
 339
 340   r = aug_get (t, path, NULL);
 341   if (r == 1)                   /* Return true. */
 342     v = Val_int (1);
 343   else if (r == 0)              /* Return false */
 344     v = Val_int (0);
 345   else if (r == -1)             /* Error or multiple matches */
 346     raise_error (t, "Augeas.exists");
 347   else
 348     failwith ("Augeas.exists: bad return value");
 349
 350   CAMLreturn (v);
 351 }
 352
 353 /* val insert : t -> ?before:bool -> path -> string -> unit */
 354 CAMLprim value
 355 ocaml_augeas_insert (value tv, value beforev, value pathv, value labelv)
 356 {
 357   CAMLparam4 (tv, beforev, pathv, labelv);
 358   augeas_t t = Augeas_t_val (tv);
 359   const char *path = String_val (pathv);
 360   const char *label = String_val (labelv);
 361   int before;
 362
 363   before = beforev == Val_int (0) ? 0 : Int_val (Field (beforev, 0));
 364
 365   if (aug_insert (t, path, label, before) == -1)
 366     raise_error (t, "Augeas.insert");
 367
 368   CAMLreturn (Val_unit);
 369 }
 370
 371 /* val label : t -> path -> string option */
 372 CAMLprim value
 373 ocaml_augeas_label (value tv, value pathv)
 374 {
 375   CAMLparam2 (tv, pathv);
 376   CAMLlocal2 (optv, v);
 377   augeas_t t = Augeas_t_val (tv);
 378   const char *path = String_val (pathv);
 379   const char *val;
 380   int r;
 381
 382   r = aug_label (t, path, &val);
 383   if (r == 1 && val) {          /* Return Some val */
 384     v = caml_copy_string (val);
 385     optv = caml_alloc (1, 0);
 386     Field (optv, 0) = v;
 387   } else if (r == 0 || !val)    /* Return None */
 388     optv = Val_int (0);
 389   else if (r == -1)             /* Error or multiple matches */
 390     raise_error (t, "Augeas.label");
 391   else
 392     caml_failwith ("Augeas.label: bad return value");
 393
 394   CAMLreturn (optv);
 395 }
 396
 397 /* val mv : t -> path -> path -> unit */
 398 CAMLprim value
 399 ocaml_augeas_mv (value tv, value srcv, value destv)
 400 {
 401   CAMLparam3 (tv, srcv, destv);
 402   augeas_t t = Augeas_t_val (tv);
 403   const char *src = String_val (srcv);
 404   const char *dest = String_val (destv);
 405
 406   if (aug_mv (t, src, dest) == -1)
 407     raise_error (t, "Augeas.mv");
 408
 409   CAMLreturn (Val_unit);
 410 }
 411
 412 /* val rm : t -> path -> int */
 413 CAMLprim value
 414 ocaml_augeas_rm (value tv, value pathv)
 415 {
 416   CAMLparam2 (tv, pathv);
 417   augeas_t t = Augeas_t_val (tv);
 418   const char *path = String_val (pathv);
 419   int r;
 420
 421   r = aug_rm (t, path);
 422   if (r == -1)
 423     raise_error (t, "Augeas.rm");
 424
 425   CAMLreturn (Val_int (r));
 426 }
 427
 428 /* val matches : t -> path -> path list */
 429 CAMLprim value
 430 ocaml_augeas_match (value tv, value pathv)
 431 {
 432   CAMLparam2 (tv, pathv);
 433   CAMLlocal3 (rv, v, cons);
 434   augeas_t t = Augeas_t_val (tv);
 435   const char *path = String_val (pathv);
 436   char **matches;
 437   int r, i;
 438
 439   r = aug_match (t, path, &matches);
 440   if (r == -1)
 441     raise_error (t, "Augeas.matches");
 442
 443   /* Copy the paths to a list. */
 444   rv = Val_int (0);
 445   for (i = 0; i < r; ++i) {
 446     v = caml_copy_string (matches[i]);
 447     free (matches[i]);
 448     cons = caml_alloc (2, 0);
 449     Field (cons, 1) = rv;
 450     Field (cons, 0) = v;
 451     rv = cons;
 452   }
 453
 454   free (matches);
 455
 456   CAMLreturn (rv);
 457 }
 458
 459 /* val count_matches : t -> path -> int */
 460 CAMLprim value
 461 ocaml_augeas_count_matches (value tv, value pathv)
 462 {
 463   CAMLparam2 (tv, pathv);
 464   augeas_t t = Augeas_t_val (tv);
 465   const char *path = String_val (pathv);
 466   int r;
 467
 468   r = aug_match (t, path, NULL);
 469   if (r == -1)
 470     raise_error (t, "Augeas.count_matches");
 471
 472   CAMLreturn (Val_int (r));
 473 }
 474
 475 /* val save : t -> unit */
 476 CAMLprim value
 477 ocaml_augeas_save (value tv)
 478 {
 479   CAMLparam1 (tv);
 480   augeas_t t = Augeas_t_val (tv);
 481
 482   if (aug_save (t) == -1)
 483     raise_error (t, "Augeas.save");
 484
 485   CAMLreturn (Val_unit);
 486 }
 487
 488 /* val load : t -> unit */
 489 CAMLprim value
 490 ocaml_augeas_load (value tv)
 491 {
 492   CAMLparam1 (tv);
 493   augeas_t t = Augeas_t_val (tv);
 494
 495   if (aug_load (t) == -1)
 496     raise_error (t, "Augeas.load");
 497
 498   CAMLreturn (Val_unit);
 499 }
 500
 501 /* val set : t -> -> path -> value option -> unit */
 502 CAMLprim value
 503 ocaml_augeas_set (value tv, value pathv, value valuev)
 504 {
 505   CAMLparam3 (tv, pathv, valuev);
 506   augeas_t t = Augeas_t_val (tv);
 507   const char *path = String_val (pathv);
 508   const char *val = Optstring_val (valuev);
 509
 510   if (aug_set (t, path, val) == -1)
 511     raise_error (t, "Augeas.set");
 512
 513   CAMLreturn (Val_unit);
 514 }
 515
 516 /* val setm : t -> path -> string option -> value option -> int */
 517 CAMLprim value
 518 ocaml_augeas_setm (value tv, value basev, value subv, value valv)
 519 {
 520   CAMLparam4 (tv, basev, subv, valv);
 521   augeas_t t = Augeas_t_val (tv);
 522   const char *base = String_val (basev);
 523   const char *sub = Optstring_val (subv);
 524   const char *val = Optstring_val (valv);
 525   int r;
 526
 527   r = aug_setm (t, base, sub, val);
 528   if (r == -1)
 529     raise_error (t, "Augeas.setm");
 530
 531   CAMLreturn (Val_int (r));
 532 }
 533
 534 /* val transform : t -> string -> string -> transform_mode -> unit */
 535 CAMLprim value
 536 ocaml_augeas_transform (value tv, value lensv, value filev, value modev)
 537 {
 538   CAMLparam4 (tv, lensv, filev, modev);
 539   augeas_t t = Augeas_t_val (tv);
 540   const char *lens = String_val (lensv);
 541   const char *file = String_val (filev);
 542   const int excl = Int_val (modev) == 1 ? 1 : 0;
 543
 544   if (aug_transform (t, lens, file, excl) == -1)
 545     raise_error (t, "Augeas.transform");
 546
 547   CAMLreturn (Val_unit);
 548 }
 549
 550 /* val source : t -> path -> path option */
 551 CAMLprim value
 552 ocaml_augeas_source (value tv, value pathv)
 553 {
 554 #ifdef HAVE_AUG_SOURCE
 555   CAMLparam2 (tv, pathv);
 556   CAMLlocal2 (optv, v);
 557   augeas_t t = Augeas_t_val (tv);
 558   const char *path = String_val (pathv);
 559   char *file_path;
 560   int r;
 561
 562   r = aug_source (t, path, &file_path);
 563   if (r == 0) {
 564     if (file_path) {    /* Return Some file_path */
 565       v = caml_copy_string (file_path);
 566       optv = caml_alloc (1, 0);
 567       Field (optv, 0) = v;
 568       free (file_path);
 569     } else              /* Return None */
 570       optv = Val_int (0);
 571   }
 572   else                  /* Error */
 573     raise_error (t, "Augeas.source");
 574
 575   CAMLreturn (optv);
 576 #else
 577   caml_failwith ("Augeas.source: function not implemented");
 578 #endif
 579 }