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