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