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