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