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