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