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