1 /* Augeas OCaml bindings
2 * Copyright (C) 2008-2012 Red Hat Inc., Richard W.M. Jones
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.
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.
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
18 * $Id: augeas_c.c,v 1.1 2008/05/06 10:48:20 rjones Exp $
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>
32 typedef augeas *augeas_t;
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,
50 static const int error_map_len = sizeof error_map / sizeof error_map[0];
52 /* Raise an Augeas.Error exception. */
54 raise_error (augeas_t t, const char *msg)
56 value *exn = caml_named_value ("Augeas.Error");
58 const int code = aug_error (t);
59 const char *aug_err_minor;
60 const char *aug_err_details;
64 if (code == AUG_ENOMEM)
65 caml_raise_out_of_memory ();
67 aug_err_minor = aug_error_minor_message (t);
68 aug_err_details = aug_error_details (t);
70 for (i = 0; i < error_map_len; ++i)
71 if (error_map[i] == code) {
77 args[0] = Val_int (ocaml_code);
79 args[0] = caml_alloc (1, 0);
80 Store_field (args[0], 0, Val_int (code));
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 ? : "");
86 caml_raise_with_args (*exn, 4, args);
90 raise_init_error (const char *msg)
92 value *exn = caml_named_value ("Augeas.Error");
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 ("");
101 caml_raise_with_args (*exn, 4, args);
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,
114 /* Wrap and unwrap augeas_t handles, with a finalizer. */
115 #define Augeas_t_val(rv) (*(augeas_t *)Data_custom_val(rv))
118 augeas_t_finalize (value tv)
120 augeas_t t = Augeas_t_val (tv);
121 if (t) aug_close (t);
124 static struct custom_operations custom_operations = {
125 (char *) "augeas_t_custom_operations",
127 custom_compare_default,
129 custom_serialize_default,
130 custom_deserialize_default
133 static value Val_augeas_t (augeas_t t)
137 /* We could choose these so that the GC can make better decisions.
138 * See 18.9.2 of the OCaml manual.
143 rv = caml_alloc_custom (&custom_operations,
144 sizeof (augeas_t), used, max);
145 Augeas_t_val(rv) = t;
150 #pragma GCC diagnostic ignored "-Wmissing-prototypes"
152 /* val create : string -> string option -> flag list -> t */
154 ocaml_augeas_create (value rootv, value loadpathv, value flagsv)
157 const char *root = String_val (rootv);
158 const char *loadpath;
162 /* Optional loadpath. */
164 loadpathv == Val_int (0)
166 : String_val (Field (loadpathv, 0));
168 /* Convert list of flags to C. */
169 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) {
170 i = Int_val (Field (flagsv, 0));
171 flags |= flag_map[i];
174 t = aug_init (root, loadpath, flags);
177 raise_init_error ("Augeas.create");
179 CAMLreturn (Val_augeas_t (t));
182 /* val close : t -> unit */
184 ocaml_augeas_close (value tv)
187 augeas_t t = Augeas_t_val (tv);
191 Augeas_t_val(tv) = NULL; /* So the finalizer doesn't double-free. */
194 CAMLreturn (Val_unit);
197 /* val get : t -> path -> value option */
199 ocaml_augeas_get (value tv, value pathv)
201 CAMLparam2 (tv, pathv);
202 CAMLlocal2 (optv, v);
203 augeas_t t = Augeas_t_val (tv);
204 const char *path = String_val (pathv);
208 r = aug_get (t, path, &val);
209 if (r == 1 && val) { /* Return Some val */
210 v = caml_copy_string (val);
211 optv = caml_alloc (1, 0);
213 } else if (r == 0 || !val) /* Return None */
215 else if (r == -1) /* Error or multiple matches */
216 raise_error (t, "Augeas.get");
218 failwith ("Augeas.get: bad return value");
223 /* val exists : t -> path -> bool */
225 ocaml_augeas_exists (value tv, value pathv)
227 CAMLparam2 (tv, pathv);
229 augeas_t t = Augeas_t_val (tv);
230 const char *path = String_val (pathv);
233 r = aug_get (t, path, NULL);
234 if (r == 1) /* Return true. */
236 else if (r == 0) /* Return false */
238 else if (r == -1) /* Error or multiple matches */
239 raise_error (t, "Augeas.exists");
241 failwith ("Augeas.exists: bad return value");
246 /* val insert : t -> ?before:bool -> path -> string -> unit */
248 ocaml_augeas_insert (value tv, value beforev, value pathv, value labelv)
250 CAMLparam4 (tv, beforev, pathv, labelv);
251 augeas_t t = Augeas_t_val (tv);
252 const char *path = String_val (pathv);
253 const char *label = String_val (labelv);
256 before = beforev == Val_int (0) ? 0 : Int_val (Field (beforev, 0));
258 if (aug_insert (t, path, label, before) == -1)
259 raise_error (t, "Augeas.insert");
261 CAMLreturn (Val_unit);
264 /* val rm : t -> path -> int */
266 ocaml_augeas_rm (value tv, value pathv)
268 CAMLparam2 (tv, pathv);
269 augeas_t t = Augeas_t_val (tv);
270 const char *path = String_val (pathv);
273 r = aug_rm (t, path);
275 raise_error (t, "Augeas.rm");
277 CAMLreturn (Val_int (r));
280 /* val matches : t -> path -> path list */
282 ocaml_augeas_match (value tv, value pathv)
284 CAMLparam2 (tv, pathv);
285 CAMLlocal3 (rv, v, cons);
286 augeas_t t = Augeas_t_val (tv);
287 const char *path = String_val (pathv);
291 r = aug_match (t, path, &matches);
293 raise_error (t, "Augeas.matches");
295 /* Copy the paths to a list. */
297 for (i = 0; i < r; ++i) {
298 v = caml_copy_string (matches[i]);
300 cons = caml_alloc (2, 0);
301 Field (cons, 1) = rv;
311 /* val count_matches : t -> path -> int */
313 ocaml_augeas_count_matches (value tv, value pathv)
315 CAMLparam2 (tv, pathv);
316 augeas_t t = Augeas_t_val (tv);
317 const char *path = String_val (pathv);
320 r = aug_match (t, path, NULL);
322 raise_error (t, "Augeas.count_matches");
324 CAMLreturn (Val_int (r));
327 /* val save : t -> unit */
329 ocaml_augeas_save (value tv)
332 augeas_t t = Augeas_t_val (tv);
334 if (aug_save (t) == -1)
335 raise_error (t, "Augeas.save");
337 CAMLreturn (Val_unit);
340 /* val load : t -> unit */
342 ocaml_augeas_load (value tv)
345 augeas_t t = Augeas_t_val (tv);
347 if (aug_load (t) == -1)
348 raise_error (t, "Augeas.load");
350 CAMLreturn (Val_unit);
353 /* val set : t -> -> path -> value option -> unit */
355 ocaml_augeas_set (value tv, value pathv, value valuev)
357 CAMLparam3 (tv, pathv, valuev);
358 augeas_t t = Augeas_t_val (tv);
359 const char *path = String_val (pathv);
363 valuev == Val_int (0)
365 : String_val (Field (valuev, 0));
367 if (aug_set (t, path, val) == -1)
368 raise_error (t, "Augeas.set");
370 CAMLreturn (Val_unit);