From: Richard Jones Date: Tue, 7 Apr 2009 15:52:25 +0000 (+0100) Subject: Outline OCaml bindings. X-Git-Tag: 0.5~11 X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=commitdiff_plain;h=4144e2106cc70ad8f1e081b57da09f9c1e276812 Outline OCaml bindings. --- diff --git a/.gitignore b/.gitignore index 2992bb4..63ec1f6 100644 --- a/.gitignore +++ b/.gitignore @@ -9,6 +9,7 @@ Makefile.in Makefile aclocal.m4 autom4te.cache +compile config.h config.h.in config.guess @@ -41,6 +42,14 @@ m4/ltoptions.m4 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 diff --git a/configure.ac b/configure.ac index 0a0a450..1359cb0 100644 --- a/configure.ac +++ b/configure.ac @@ -30,7 +30,7 @@ AC_PROG_CPP 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 @@ -101,7 +101,8 @@ AC_SUBST(MIRROR) 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. @@ -122,7 +123,8 @@ AC_CONFIG_FILES([Makefile src/Makefile fish/Makefile examples/Makefile images/Makefile ocaml/Makefile perl/Makefile python/Makefile make-initramfs.sh update-initramfs.sh - libguestfs.spec]) + libguestfs.spec + ocaml/META]) AC_OUTPUT dnl WTF? diff --git a/libguestfs.spec.in b/libguestfs.spec.in index d4ca7b0..3045294 100644 --- a/libguestfs.spec.in +++ b/libguestfs.spec.in @@ -12,10 +12,17 @@ URL: http://et.redhat.com/~rjones/libguestfs/ 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 @@ -69,6 +76,50 @@ modifying virtual machine disk images from the command line and shell 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 @@ -101,6 +152,7 @@ rm -rf $RPM_BUILD_ROOT %postun -p /sbin/ldconfig + %files %defattr(-,root,root,-) %doc COPYING @@ -124,6 +176,22 @@ rm -rf $RPM_BUILD_ROOT %{_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 - @VERSION@-1 - Initial build. diff --git a/ocaml/.depend b/ocaml/.depend new file mode 100644 index 0000000..2f840b0 --- /dev/null +++ b/ocaml/.depend @@ -0,0 +1,5 @@ +guestfs.cmi: +guestfs_internal.cmo: +guestfs_internal.cmx: +guestfs.cmo: guestfs.cmi +guestfs.cmx: guestfs.cmi diff --git a/ocaml/META.in b/ocaml/META.in new file mode 100644 index 0000000..43af4ad --- /dev/null +++ b/ocaml/META.in @@ -0,0 +1,5 @@ +name="guestfs" +version="@PACKAGE_VERSION@" +description="libguestfs bindings for OCaml" +archive(byte)="mlguestfs.cma" +archive(native)="mlguestfs.cmxa" diff --git a/ocaml/Makefile.am b/ocaml/Makefile.am index 2b9e08a..176bcec 100644 --- a/ocaml/Makefile.am +++ b/ocaml/Makefile.am @@ -14,3 +14,49 @@ # 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 diff --git a/ocaml/guestfs.ml b/ocaml/guestfs.ml new file mode 100644 index 0000000..ba6f0d6 --- /dev/null +++ b/ocaml/guestfs.ml @@ -0,0 +1,110 @@ +(* 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" diff --git a/ocaml/guestfs.mli b/ocaml/guestfs.mli new file mode 100644 index 0000000..ba75036 --- /dev/null +++ b/ocaml/guestfs.mli @@ -0,0 +1,153 @@ +(* 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) *) + diff --git a/ocaml/guestfs_c.c b/ocaml/guestfs_c.c new file mode 100644 index 0000000..dda338f --- /dev/null +++ b/ocaml/guestfs_c.c @@ -0,0 +1,41 @@ +/* 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 +#include + +#include + +#include +#include +#include +#include +#include +#include + +#include "guestfs_c.h" + +CAMLprim value +ocaml_guestfs_create (value hv /* XXX */) +{ + CAMLparam1 (hv); /* XXX */ +/* XXX write something here */ + CAMLreturn (Val_unit); /* XXX */ +} + +/* etc */ diff --git a/ocaml/guestfs_c.h b/ocaml/guestfs_c.h new file mode 100644 index 0000000..52b5aea --- /dev/null +++ b/ocaml/guestfs_c.h @@ -0,0 +1,24 @@ +/* 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 */ diff --git a/ocaml/guestfs_c_actions.c b/ocaml/guestfs_c_actions.c new file mode 100644 index 0000000..b22e4d6 --- /dev/null +++ b/ocaml/guestfs_c_actions.c @@ -0,0 +1,147 @@ +/* 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 +#include + +#include + +#include +#include +#include +#include +#include +#include + +#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 */ +} + diff --git a/src/generator.ml b/src/generator.ml index 427c9df..8f5471d 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -1322,6 +1322,150 @@ and generate_call_args ?handle style = ) (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 \n"; + pr "#include \n"; + pr "\n"; + pr "#include \n"; + pr "\n"; + pr "#include \n"; + pr "#include \n"; + pr "#include \n"; + pr "#include \n"; + pr "#include \n"; + pr "#include \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; @@ -1375,4 +1519,16 @@ let () = 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 ();