augeas-c.c

   1 /* Augeas OCaml bindings
   2  * Copyright (C) 2008-2012 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 /* Raise an Augeas.Error exception. */
  35 static void
  36 raise_error (augeas_t t, const char *msg)
  37 {
  38   caml_raise_with_string (*caml_named_value ("Augeas.Error"), msg);
  39 }
  40
  41 static void
  42 raise_init_error (const char *msg)
  43 {
  44   caml_raise_with_string (*caml_named_value ("Augeas.Error"), msg);
  45 }
  46
  47 /* Map OCaml flags to C flags. */
  48 static int flag_map[] = {
  49   /* AugSaveBackup */  AUG_SAVE_BACKUP,
  50   /* AugSaveNewFile */ AUG_SAVE_NEWFILE,
  51   /* AugTypeCheck */   AUG_TYPE_CHECK,
  52   /* AugNoStdinc */    AUG_NO_STDINC,
  53   /* AugSaveNoop */    AUG_SAVE_NOOP,
  54   /* AugNoLoad */      AUG_NO_LOAD,
  55 };
  56
  57 /* Wrap and unwrap augeas_t handles, with a finalizer. */
  58 #define Augeas_t_val(rv) (*(augeas_t *)Data_custom_val(rv))
  59
  60 static void
  61 augeas_t_finalize (value tv)
  62 {
  63   augeas_t t = Augeas_t_val (tv);
  64   if (t) aug_close (t);
  65 }
  66
  67 static struct custom_operations custom_operations = {
  68   (char *) "augeas_t_custom_operations",
  69   augeas_t_finalize,
  70   custom_compare_default,
  71   custom_hash_default,
  72   custom_serialize_default,
  73   custom_deserialize_default
  74 };
  75
  76 static value Val_augeas_t (augeas_t t)
  77 {
  78   CAMLparam0 ();
  79   CAMLlocal1 (rv);
  80   /* We could choose these so that the GC can make better decisions.
  81    * See 18.9.2 of the OCaml manual.
  82    */
  83   const int used = 0;
  84   const int max = 1;
  85
  86   rv = caml_alloc_custom (&custom_operations,
  87                           sizeof (augeas_t), used, max);
  88   Augeas_t_val(rv) = t;
  89
  90   CAMLreturn (rv);
  91 }
  92
  93 #pragma GCC diagnostic ignored "-Wmissing-prototypes"
  94
  95 /* val create : string -> string option -> flag list -> t */
  96 CAMLprim value
  97 ocaml_augeas_create (value rootv, value loadpathv, value flagsv)
  98 {
  99   CAMLparam1 (rootv);
 100   char *root = String_val (rootv);
 101   char *loadpath;
 102   int flags = 0, i;
 103   augeas_t t;
 104
 105   /* Optional loadpath. */
 106   loadpath =
 107     loadpathv == Val_int (0)
 108     ? NULL
 109     : String_val (Field (loadpathv, 0));
 110
 111   /* Convert list of flags to C. */
 112   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) {
 113     i = Int_val (Field (flagsv, 0));
 114     flags |= flag_map[i];
 115   }
 116
 117   t = aug_init (root, loadpath, flags);
 118
 119   if (t == NULL)
 120     raise_init_error ("Augeas.create");
 121
 122   CAMLreturn (Val_augeas_t (t));
 123 }
 124
 125 /* val close : t -> unit */
 126 CAMLprim value
 127 ocaml_augeas_close (value tv)
 128 {
 129   CAMLparam1 (tv);
 130   augeas_t t = Augeas_t_val (tv);
 131
 132   if (t) {
 133     aug_close (t);
 134     Augeas_t_val(tv) = NULL;    /* So the finalizer doesn't double-free. */
 135   }
 136
 137   CAMLreturn (Val_unit);
 138 }
 139
 140 /* val get : t -> path -> value option */
 141 CAMLprim value
 142 ocaml_augeas_get (value tv, value pathv)
 143 {
 144   CAMLparam2 (tv, pathv);
 145   CAMLlocal2 (optv, v);
 146   augeas_t t = Augeas_t_val (tv);
 147   char *path = String_val (pathv);
 148   const char *val;
 149   int r;
 150
 151   r = aug_get (t, path, &val);
 152   if (r == 1) {                 /* Return Some val */
 153     v = caml_copy_string (val);
 154     optv = caml_alloc (1, 0);
 155     Field (optv, 0) = v;
 156   } else if (r == 0)            /* Return None */
 157     optv = Val_int (0);
 158   else if (r == -1)             /* Error or multiple matches */
 159     raise_error (t, "Augeas.get");
 160   else
 161     failwith ("Augeas.get: bad return value");
 162
 163   CAMLreturn (optv);
 164 }
 165
 166 /* val exists : t -> path -> bool */
 167 CAMLprim value
 168 ocaml_augeas_exists (value tv, value pathv)
 169 {
 170   CAMLparam2 (tv, pathv);
 171   CAMLlocal1 (v);
 172   augeas_t t = Augeas_t_val (tv);
 173   char *path = String_val (pathv);
 174   int r;
 175
 176   r = aug_get (t, path, NULL);
 177   if (r == 1)                   /* Return true. */
 178     v = Val_int (1);
 179   else if (r == 0)              /* Return false */
 180     v = Val_int (0);
 181   else if (r == -1)             /* Error or multiple matches */
 182     raise_error (t, "Augeas.exists");
 183   else
 184     failwith ("Augeas.exists: bad return value");
 185
 186   CAMLreturn (v);
 187 }
 188
 189 /* val insert : t -> ?before:bool -> path -> string -> unit */
 190 CAMLprim value
 191 ocaml_augeas_insert (value tv, value beforev, value pathv, value labelv)
 192 {
 193   CAMLparam4 (tv, beforev, pathv, labelv);
 194   augeas_t t = Augeas_t_val (tv);
 195   char *path = String_val (pathv);
 196   char *label = String_val (labelv);
 197   int before;
 198
 199   before = beforev == Val_int (0) ? 0 : Int_val (Field (beforev, 0));
 200
 201   if (aug_insert (t, path, label, before) == -1)
 202     raise_error (t, "Augeas.insert");
 203
 204   CAMLreturn (Val_unit);
 205 }
 206
 207 /* val rm : t -> path -> int */
 208 CAMLprim value
 209 ocaml_augeas_rm (value tv, value pathv)
 210 {
 211   CAMLparam2 (tv, pathv);
 212   augeas_t t = Augeas_t_val (tv);
 213   char *path = String_val (pathv);
 214   int r;
 215
 216   r = aug_rm (t, path);
 217   if (r == -1)
 218     raise_error (t, "Augeas.rm");
 219
 220   CAMLreturn (Val_int (r));
 221 }
 222
 223 /* val matches : t -> path -> path list */
 224 CAMLprim value
 225 ocaml_augeas_match (value tv, value pathv)
 226 {
 227   CAMLparam2 (tv, pathv);
 228   CAMLlocal3 (rv, v, cons);
 229   augeas_t t = Augeas_t_val (tv);
 230   char *path = String_val (pathv);
 231   char **matches;
 232   int r, i;
 233
 234   r = aug_match (t, path, &matches);
 235   if (r == -1)
 236     raise_error (t, "Augeas.matches");
 237
 238   /* Copy the paths to a list. */
 239   rv = Val_int (0);
 240   for (i = 0; i < r; ++i) {
 241     v = caml_copy_string (matches[i]);
 242     free (matches[i]);
 243     cons = caml_alloc (2, 0);
 244     Field (cons, 1) = rv;
 245     Field (cons, 0) = v;
 246     rv = cons;
 247   }
 248
 249   free (matches);
 250
 251   CAMLreturn (rv);
 252 }
 253
 254 /* val count_matches : t -> path -> int */
 255 CAMLprim value
 256 ocaml_augeas_count_matches (value tv, value pathv)
 257 {
 258   CAMLparam2 (tv, pathv);
 259   augeas_t t = Augeas_t_val (tv);
 260   char *path = String_val (pathv);
 261   int r;
 262
 263   r = aug_match (t, path, NULL);
 264   if (r == -1)
 265     raise_error (t, "Augeas.count_matches");
 266
 267   CAMLreturn (Val_int (r));
 268 }
 269
 270 /* val save : t -> unit */
 271 CAMLprim value
 272 ocaml_augeas_save (value tv)
 273 {
 274   CAMLparam1 (tv);
 275   augeas_t t = Augeas_t_val (tv);
 276
 277   if (aug_save (t) == -1)
 278     raise_error (t, "Augeas.save");
 279
 280   CAMLreturn (Val_unit);
 281 }
 282
 283 /* val load : t -> unit */
 284 CAMLprim value
 285 ocaml_augeas_load (value tv)
 286 {
 287   CAMLparam1 (tv);
 288   augeas_t t = Augeas_t_val (tv);
 289
 290   if (aug_load (t) == -1)
 291     raise_error (t, "Augeas.load");
 292
 293   CAMLreturn (Val_unit);
 294 }