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