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