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