Makefile
aclocal.m4
autom4te.cache
+compile
config.h
config.h.in
config.guess
m4/ltsugar.m4
m4/ltversion.m4
m4/lt~obsolete.m4
+ocaml/META
+ocaml/*.cmi
+ocaml/*.cmo
+ocaml/*.cmx
+ocaml/*.cma
+ocaml/*.cmxa
+ocaml/*.a
+ocaml/*.so
stamp-h1
test*.img
update-initramfs.sh
AC_C_PROTOTYPES
test "x$U" != "x" && AC_MSG_ERROR([Compiler not ANSI compliant])
-AC_PROG_CC_C_O
+AM_PROG_CC_C_O
dnl Check support for 64 bit file offsets.
AC_SYS_LARGEFILE
dnl Check for OCaml (optional, for OCaml bindings).
AC_PROG_OCAML
-AM_CONDITIONAL([HAVE_OCAML],[test "x$OCAMLC" != "xno"])
+AC_PROG_FINDLIB
+AM_CONDITIONAL([HAVE_OCAML],[test "x$OCAMLC" != "xno" -a "x$OCAMLFIND" != "xno"])
dnl Check for Perl (optional, for Perl bindings).
dnl XXX This isn't quite right, we should check for devel libraries.
images/Makefile ocaml/Makefile perl/Makefile
python/Makefile
make-initramfs.sh update-initramfs.sh
- libguestfs.spec])
+ libguestfs.spec
+ ocaml/META])
AC_OUTPUT
dnl WTF?
Source0: http://et.redhat.com/~rjones/libguestfs/files/%{name}-%{version}.tar.gz
BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root
+# Basic build requirements:
BuildRequires: /usr/bin/pod2man
BuildRequires: /usr/bin/pod2text
BuildRequires: febootstrap
+# If you want to build the bindings for different languages:
+BuildRequires: ocaml
+BuildRequires: perl-devel
+BuildRequires: python-devel
+
+# Runtime requires:
Requires: qemu
scripts.
+%package ocaml
+Summary: OCaml bindings for %{name}
+Group: Development/Libraries
+Requires: %{name} = %{version}-%{release}
+
+
+%description ocaml
+%{name}-ocaml contains OCaml bindings for %{name}.
+
+This is for toplevel and scripting access only. To compile OCaml
+programs which use %{name} you will also need %{name}-ocaml-devel.
+
+
+%package ocaml-devel
+Summary: OCaml bindings for %{name}
+Group: Development/Libraries
+Requires: %{name}-ocaml = %{version}-%{release}
+
+
+%description ocaml-devel
+%{name}-ocaml-devel contains development libraries
+required to use the OCaml bindings for %{name}.
+
+
+%package perl
+Summary: Perl bindings for %{name}
+Group: Development/Libraries
+Requires: %{name} = %{version}-%{release}
+
+
+%description perl
+%{name}-perl contains Perl bindings for %{name}.
+
+
+%package python
+Summary: Python bindings for %{name}
+Group: Development/Libraries
+Requires: %{name} = %{version}-%{release}
+
+
+%description python
+%{name}-python contains Python bindings for %{name}.
+
+
%prep
%setup -q
%postun -p /sbin/ldconfig
+
%files
%defattr(-,root,root,-)
%doc COPYING
%{_mandir}/man1/guestfish.1*
+%files ocaml
+%defattr(-,root,root,-)
+
+
+%files ocaml-devel
+%defattr(-,root,root,-)
+
+
+%files perl
+%defattr(-,root,root,-)
+
+
+%files python
+%defattr(-,root,root,-)
+
+
%changelog
* Sat Apr 4 2009 Richard Jones <rjones@redhat.com> - @VERSION@-1
- Initial build.
--- /dev/null
+guestfs.cmi:
+guestfs_internal.cmo:
+guestfs_internal.cmx:
+guestfs.cmo: guestfs.cmi
+guestfs.cmx: guestfs.cmi
--- /dev/null
+name="guestfs"
+version="@PACKAGE_VERSION@"
+description="libguestfs bindings for OCaml"
+archive(byte)="mlguestfs.cma"
+archive(native)="mlguestfs.cmxa"
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+if HAVE_OCAML
+
+EXTRA_DIST = \
+ guestfs.mli guestfs.ml \
+ guestfs_internal.ml \
+ guestfs_c.c guestfs_c.h guestfs_c_actions.c \
+ .depend META.in
+
+noinst_DATA = mlguestfs.cma mlguestfs.cmxa META
+
+mlguestfs.cma: guestfs_c.o guestfs_c_actions.o guestfs_internal.cmo guestfs.cmo
+ $(OCAMLMKLIB) -o mlguestfs $^ -lguestfs
+
+mlguestfs.cmxa: guestfs_c.o guestfs_c_actions.o guestfs_internal.cmx guestfs.cmx
+ $(OCAMLMKLIB) -o mlguestfs $^ -lguestfs
+
+guestfs_c.o: guestfs_c.c
+ $(CC) $(CFLAGS) -I$(OCAMLLIB) -c $<
+
+guestfs_c_actions.o: guestfs_c_actions.c
+ $(CC) $(CFLAGS) -I$(OCAMLLIB) -c $<
+
+.mli.cmi:
+ $(OCAMLFIND) ocamlc -c $<
+.ml.cmo:
+ $(OCAMLFIND) ocamlc -c $<
+.ml.cmx:
+ $(OCAMLFIND) ocamlopt -c $<
+
+depend: .depend
+
+.depend: $(wildcard *.mli) $(wildcard *.ml)
+ rm -f .depend
+ $(OCAMLFIND) ocamldep $^ > $@
+
+include .depend
+
+SUFFIXES = .cmo .cmi .cmx .ml .mli .mll .mly
+
+# Do the installation by hand, because we want to run ocamlfind.
+install-data-hook:
+ $(OCAMLFIND) install -destdir $(DESTDIR) guestfs \
+ META *.so *.a *.cma *.cmx *.cmxa *.cmi *.mli
+
+endif
\ No newline at end of file
--- /dev/null
+(* libguestfs generated file
+ * WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.
+ * ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.
+ *
+ * Copyright (C) 2009 Red Hat Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+
+type t
+exception Error of string
+external create : unit -> t = "ocaml_guestfs_create"
+external close : t -> unit = "ocaml_guestfs_create"
+external launch : t -> unit = "ocaml_guestfs_launch"
+external wait_ready : t -> unit = "ocaml_guestfs_wait_ready"
+external kill_subprocess : t -> unit = "ocaml_guestfs_kill_subprocess"
+external add_drive : t -> string -> unit = "ocaml_guestfs_add_drive"
+external add_cdrom : t -> string -> unit = "ocaml_guestfs_add_cdrom"
+external config : t -> string -> string option -> unit = "ocaml_guestfs_config"
+external set_path : t -> string option -> unit = "ocaml_guestfs_set_path"
+external get_path : t -> string = "ocaml_guestfs_get_path"
+external set_autosync : t -> bool -> unit = "ocaml_guestfs_set_autosync"
+external get_autosync : t -> bool = "ocaml_guestfs_get_autosync"
+external set_verbose : t -> bool -> unit = "ocaml_guestfs_set_verbose"
+external get_verbose : t -> bool = "ocaml_guestfs_get_verbose"
+
+type lvm_pv = {
+ pv_name : string;
+ pv_uuid : string;
+ pv_fmt : string;
+ pv_size : int64;
+ dev_size : int64;
+ pv_free : int64;
+ pv_used : int64;
+ pv_attr : string;
+ pv_pe_count : int64;
+ pv_pe_alloc_count : int64;
+ pv_tags : string;
+ pe_start : int64;
+ pv_mda_count : int64;
+ pv_mda_free : int64;
+}
+
+type lvm_vg = {
+ vg_name : string;
+ vg_uuid : string;
+ vg_fmt : string;
+ vg_attr : string;
+ vg_size : int64;
+ vg_free : int64;
+ vg_sysid : string;
+ vg_extent_size : int64;
+ vg_extent_count : int64;
+ vg_free_count : int64;
+ max_lv : int64;
+ max_pv : int64;
+ pv_count : int64;
+ lv_count : int64;
+ snap_count : int64;
+ vg_seqno : int64;
+ vg_tags : string;
+ vg_mda_count : int64;
+ vg_mda_free : int64;
+}
+
+type lvm_lv = {
+ lv_name : string;
+ lv_uuid : string;
+ lv_attr : string;
+ lv_major : int64;
+ lv_minor : int64;
+ lv_kernel_major : int64;
+ lv_kernel_minor : int64;
+ lv_size : int64;
+ seg_count : int64;
+ origin : string;
+ snap_percent : float option;
+ copy_percent : float option;
+ move_pv : string;
+ lv_tags : string;
+ mirror_log : string;
+ modules : string;
+}
+
+external cat : t -> string -> string = "ocaml_guestfs_cat"
+external list_devices : t -> string list = "ocaml_guestfs_list_devices"
+external list_partitions : t -> string list = "ocaml_guestfs_list_partitions"
+external ll : t -> string -> string = "ocaml_guestfs_ll"
+external ls : t -> string -> string list = "ocaml_guestfs_ls"
+external lvs : t -> string list = "ocaml_guestfs_lvs"
+external lvs_full : t -> lvm_lv list = "ocaml_guestfs_lvs_full"
+external mount : t -> string -> string -> unit = "ocaml_guestfs_mount"
+external pvs : t -> string list = "ocaml_guestfs_pvs"
+external pvs_full : t -> lvm_pv list = "ocaml_guestfs_pvs_full"
+external sync : t -> unit = "ocaml_guestfs_sync"
+external touch : t -> string -> unit = "ocaml_guestfs_touch"
+external vgs : t -> string list = "ocaml_guestfs_vgs"
+external vgs_full : t -> lvm_vg list = "ocaml_guestfs_vgs_full"
--- /dev/null
+(* libguestfs generated file
+ * WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.
+ * ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.
+ *
+ * Copyright (C) 2009 Red Hat Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+
+(** For API documentation you should refer to the C API
+ in the guestfs(3) manual page. The OCaml API uses almost
+ exactly the same calls. *)
+
+type t
+(** A [guestfs_h] handle. *)
+
+exception Error of string
+(** This exception is raised when there is an error. *)
+
+val create : unit -> t
+
+val close : t -> unit
+(** Handles are closed by the garbage collector when they become
+ unreferenced, but callers can also call this in order to
+ provide predictable cleanup. *)
+
+val launch : t -> unit
+val wait_ready : t -> unit
+val kill_subprocess : t -> unit
+
+val add_drive : t -> string -> unit
+val add_cdrom : t -> string -> unit
+val config : t -> string -> string option -> unit
+
+val set_path : t -> string option -> unit
+val get_path : t -> string
+val set_autosync : t -> bool -> unit
+val get_autosync : t -> bool
+val set_verbose : t -> bool -> unit
+val get_verbose : t -> bool
+
+type lvm_pv = {
+ pv_name : string;
+ pv_uuid : string;
+ pv_fmt : string;
+ pv_size : int64;
+ dev_size : int64;
+ pv_free : int64;
+ pv_used : int64;
+ pv_attr : string;
+ pv_pe_count : int64;
+ pv_pe_alloc_count : int64;
+ pv_tags : string;
+ pe_start : int64;
+ pv_mda_count : int64;
+ pv_mda_free : int64;
+}
+
+type lvm_vg = {
+ vg_name : string;
+ vg_uuid : string;
+ vg_fmt : string;
+ vg_attr : string;
+ vg_size : int64;
+ vg_free : int64;
+ vg_sysid : string;
+ vg_extent_size : int64;
+ vg_extent_count : int64;
+ vg_free_count : int64;
+ max_lv : int64;
+ max_pv : int64;
+ pv_count : int64;
+ lv_count : int64;
+ snap_count : int64;
+ vg_seqno : int64;
+ vg_tags : string;
+ vg_mda_count : int64;
+ vg_mda_free : int64;
+}
+
+type lvm_lv = {
+ lv_name : string;
+ lv_uuid : string;
+ lv_attr : string;
+ lv_major : int64;
+ lv_minor : int64;
+ lv_kernel_major : int64;
+ lv_kernel_minor : int64;
+ lv_size : int64;
+ seg_count : int64;
+ origin : string;
+ snap_percent : float option;
+ copy_percent : float option;
+ move_pv : string;
+ lv_tags : string;
+ mirror_log : string;
+ modules : string;
+}
+
+val cat : t -> string -> string
+(** list the contents of a file *)
+
+val list_devices : t -> string list
+(** list the block devices *)
+
+val list_partitions : t -> string list
+(** list the partitions *)
+
+val ll : t -> string -> string
+(** list the files in a directory (long format) *)
+
+val ls : t -> string -> string list
+(** list the files in a directory *)
+
+val lvs : t -> string list
+(** list the LVM logical volumes (LVs) *)
+
+val lvs_full : t -> lvm_lv list
+(** list the LVM logical volumes (LVs) *)
+
+val mount : t -> string -> string -> unit
+(** mount a guest disk at a position in the filesystem *)
+
+val pvs : t -> string list
+(** list the LVM physical volumes (PVs) *)
+
+val pvs_full : t -> lvm_pv list
+(** list the LVM physical volumes (PVs) *)
+
+val sync : t -> unit
+(** sync disks, writes are flushed through to the disk image *)
+
+val touch : t -> string -> unit
+(** update file timestamps or create a new file *)
+
+val vgs : t -> string list
+(** list the LVM volume groups (VGs) *)
+
+val vgs_full : t -> lvm_vg list
+(** list the LVM volume groups (VGs) *)
+
--- /dev/null
+/* libguestfs
+ * Copyright (C) 2009 Red Hat Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <guestfs.h>
+
+#include <caml/config.h>
+#include <caml/alloc.h>
+#include <caml/callback.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#include "guestfs_c.h"
+
+CAMLprim value
+ocaml_guestfs_create (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+/* etc */
--- /dev/null
+/* libguestfs
+ * Copyright (C) 2009 Red Hat Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+#ifndef GUESTFS_OCAML_C_H
+#define GUESTFS_OCAML_C_H
+
+
+
+#endif /* GUESTFS_OCAML_C_H */
--- /dev/null
+/* libguestfs generated file
+ * WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.
+ * ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.
+ *
+ * Copyright (C) 2009 Red Hat Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <guestfs.h>
+
+#include <caml/config.h>
+#include <caml/alloc.h>
+#include <caml/callback.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#include "guestfs_c.h"
+
+CAMLprim value
+ocaml_guestfs_cat (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_list_devices (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_list_partitions (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_ll (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_ls (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_lvs (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_lvs_full (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_mount (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_pvs (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_pvs_full (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_sync (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_touch (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_vgs (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
+CAMLprim value
+ocaml_guestfs_vgs_full (value hv /* XXX */)
+{
+ CAMLparam1 (hv); /* XXX */
+/* XXX write something here */
+ CAMLreturn (Val_unit); /* XXX */
+}
+
) (snd style);
pr ")"
+(* Generate the OCaml bindings interface. *)
+and generate_ocaml_mli () =
+ generate_header OCamlStyle LGPLv2;
+
+ pr "\
+(** For API documentation you should refer to the C API
+ in the guestfs(3) manual page. The OCaml API uses almost
+ exactly the same calls. *)
+
+type t
+(** A [guestfs_h] handle. *)
+
+exception Error of string
+(** This exception is raised when there is an error. *)
+
+val create : unit -> t
+
+val close : t -> unit
+(** Handles are closed by the garbage collector when they become
+ unreferenced, but callers can also call this in order to
+ provide predictable cleanup. *)
+
+val launch : t -> unit
+val wait_ready : t -> unit
+val kill_subprocess : t -> unit
+
+val add_drive : t -> string -> unit
+val add_cdrom : t -> string -> unit
+val config : t -> string -> string option -> unit
+
+val set_path : t -> string option -> unit
+val get_path : t -> string
+val set_autosync : t -> bool -> unit
+val get_autosync : t -> bool
+val set_verbose : t -> bool -> unit
+val get_verbose : t -> bool
+
+";
+ generate_ocaml_lvm_structure_decls ();
+
+ (* The actions. *)
+ List.iter (
+ fun (name, style, _, _, shortdesc, _) ->
+ generate_ocaml_prototype name style;
+ pr "(** %s *)\n" shortdesc;
+ pr "\n"
+ ) sorted_functions
+
+(* Generate the OCaml bindings implementation. *)
+and generate_ocaml_ml () =
+ generate_header OCamlStyle LGPLv2;
+
+ pr "\
+type t
+exception Error of string
+external create : unit -> t = \"ocaml_guestfs_create\"
+external close : t -> unit = \"ocaml_guestfs_create\"
+external launch : t -> unit = \"ocaml_guestfs_launch\"
+external wait_ready : t -> unit = \"ocaml_guestfs_wait_ready\"
+external kill_subprocess : t -> unit = \"ocaml_guestfs_kill_subprocess\"
+external add_drive : t -> string -> unit = \"ocaml_guestfs_add_drive\"
+external add_cdrom : t -> string -> unit = \"ocaml_guestfs_add_cdrom\"
+external config : t -> string -> string option -> unit = \"ocaml_guestfs_config\"
+external set_path : t -> string option -> unit = \"ocaml_guestfs_set_path\"
+external get_path : t -> string = \"ocaml_guestfs_get_path\"
+external set_autosync : t -> bool -> unit = \"ocaml_guestfs_set_autosync\"
+external get_autosync : t -> bool = \"ocaml_guestfs_get_autosync\"
+external set_verbose : t -> bool -> unit = \"ocaml_guestfs_set_verbose\"
+external get_verbose : t -> bool = \"ocaml_guestfs_get_verbose\"
+
+";
+ generate_ocaml_lvm_structure_decls ();
+
+ (* The actions. *)
+ List.iter (
+ fun (name, style, _, _, shortdesc, _) ->
+ generate_ocaml_prototype ~is_external:true name style;
+ ) sorted_functions
+
+(* Generate the OCaml bindings C implementation. *)
+and generate_ocaml_c () =
+ generate_header CStyle LGPLv2;
+
+ pr "#include <stdio.h>\n";
+ pr "#include <stdlib.h>\n";
+ pr "\n";
+ pr "#include <guestfs.h>\n";
+ pr "\n";
+ pr "#include <caml/config.h>\n";
+ pr "#include <caml/alloc.h>\n";
+ pr "#include <caml/callback.h>\n";
+ pr "#include <caml/fail.h>\n";
+ pr "#include <caml/memory.h>\n";
+ pr "#include <caml/mlvalues.h>\n";
+ pr "\n";
+ pr "#include \"guestfs_c.h\"\n";
+ pr "\n";
+
+ List.iter (
+ fun (name, style, _, _, _, _) ->
+ pr "CAMLprim value\n";
+ pr "ocaml_guestfs_%s (value hv /* XXX */)\n" name;
+ pr "{\n";
+ pr " CAMLparam1 (hv); /* XXX */\n";
+ pr "/* XXX write something here */\n";
+ pr " CAMLreturn (Val_unit); /* XXX */\n";
+ pr "}\n";
+ pr "\n"
+ ) sorted_functions
+
+and generate_ocaml_lvm_structure_decls () =
+ List.iter (
+ fun (typ, cols) ->
+ pr "type lvm_%s = {\n" typ;
+ List.iter (
+ function
+ | name, `String -> pr " %s : string;\n" name
+ | name, `UUID -> pr " %s : string;\n" name
+ | name, `Bytes -> pr " %s : int64;\n" name
+ | name, `Int -> pr " %s : int64;\n" name
+ | name, `OptPercent -> pr " %s : float option;\n" name
+ ) cols;
+ pr "}\n";
+ pr "\n"
+ ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
+
+and generate_ocaml_prototype ?(is_external = false) name style =
+ if is_external then pr "external " else pr "val ";
+ pr "%s : t -> " name;
+ iter_args (
+ function
+ | String _ -> pr "string -> " (* note String is not allowed to be NULL *)
+ ) (snd style);
+ (match fst style with
+ | Err -> pr "unit" (* all errors are turned into exceptions *)
+ | RString _ -> pr "string"
+ | RStringList _ -> pr "string list"
+ | RPVList _ -> pr "lvm_pv list"
+ | RVGList _ -> pr "lvm_vg list"
+ | RLVList _ -> pr "lvm_lv list"
+ );
+ if is_external then pr " = \"ocaml_guestfs_%s\"" name;
+ pr "\n"
+
let output_to filename =
let filename_new = filename ^ ".new" in
chan := open_out filename_new;
let close = output_to "guestfish-actions.pod" in
generate_fish_actions_pod ();
- close ()
+ close ();
+
+ let close = output_to "ocaml/guestfs.mli" in
+ generate_ocaml_mli ();
+ close ();
+
+ let close = output_to "ocaml/guestfs.ml" in
+ generate_ocaml_ml ();
+ close ();
+
+ let close = output_to "ocaml/guestfs_c_actions.c" in
+ generate_ocaml_c ();
+ close ();
git.annexia.org / libguestfs.git / commitdiff