[ocaml-libvirt] Add binding for virDomainCreateXML.
Richard W.M. Jones
rjones at fedoraproject.org
Fri Mar 6 15:53:54 UTC 2015
commit 41bd2465b760442fc5ff9eeb4e9a7fb0eb8b8cb7
Author: Richard W.M. Jones <rjones at redhat.com>
Date: Fri Mar 6 15:38:05 2015 +0000
Add binding for virDomainCreateXML.
0001-Add-a-binding-for-virDomainCreateXML.patch | 213 ++++++++++++++++++++++++
ocaml-libvirt.spec | 9 +-
2 files changed, 221 insertions(+), 1 deletion(-)
---
diff --git a/0001-Add-a-binding-for-virDomainCreateXML.patch b/0001-Add-a-binding-for-virDomainCreateXML.patch
new file mode 100644
index 0000000..a25507b
--- /dev/null
+++ b/0001-Add-a-binding-for-virDomainCreateXML.patch
@@ -0,0 +1,213 @@
+From 7483c7454538584a3dbe4582096f058e6e877df6 Mon Sep 17 00:00:00 2001
+From: "Richard W.M. Jones" <rjones at redhat.com>
+Date: Fri, 6 Mar 2015 15:35:46 +0000
+Subject: [PATCH] Add a binding for virDomainCreateXML.
+
+This is more modern than the ancient virDomainCreateLinux API,
+and crucially allows you to pass flags such as AUTODESTROY.
+---
+ configure.ac | 2 +-
+ libvirt/generator.pl | 23 +++++++++++++++++++++--
+ libvirt/libvirt.ml | 19 ++++++++++++++++++-
+ libvirt/libvirt.mli | 13 +++++++++++--
+ libvirt/libvirt_c.c | 25 ++++++++++++++++++++++++-
+ 5 files changed, 75 insertions(+), 7 deletions(-)
+
+diff --git a/configure.ac b/configure.ac
+index b7544b4..a719fb3 100644
+--- a/configure.ac
++++ b/configure.ac
+@@ -1,5 +1,5 @@
+ # ocaml-libvirt
+-# Copyright (C) 2007-2008 Red Hat Inc., Richard W.M. Jones
++# Copyright (C) 2007-2015 Red Hat Inc., Richard W.M. Jones
+ #
+ # This library is free software; you can redistribute it and/or
+ # modify it under the terms of the GNU Lesser General Public
+diff --git a/libvirt/generator.pl b/libvirt/generator.pl
+index 8229ad1..421592b 100755
+--- a/libvirt/generator.pl
++++ b/libvirt/generator.pl
+@@ -1,7 +1,7 @@
+ #!/usr/bin/perl -w
+ #
+ # OCaml bindings for libvirt.
+-# (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
++# (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
+ # http://libvirt.org/
+ #
+ # This library is free software; you can redistribute it and/or
+@@ -63,6 +63,7 @@ my @functions = (
+ sig => "conn, int : unit" },
+
+ { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" },
++ { name => "virDomainCreateXML", sig => "conn, string, unsigned : dom" },
+ { name => "virDomainFree", sig => "dom : free" },
+ { name => "virDomainDestroy", sig => "dom : free" },
+ { name => "virDomainLookupByName", sig => "conn, string : dom" },
+@@ -198,7 +199,7 @@ print F <<'END';
+ */
+
+ /* OCaml bindings for libvirt.
+- * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
++ * (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
+ * http://libvirt.org/
+ *
+ * This library is free software; you can redistribute it and/or
+@@ -310,6 +311,8 @@ sub gen_arg_names
+ ( "$1v", "strv" )
+ } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
+ ( "$1v", "strv" )
++ } elsif ($sig =~ /^(\w+), string, unsigned : (\w+)$/) {
++ ( "$1v", "strv", "uv" )
+ } elsif ($sig =~ /^(\w+), u?int : (\w+)$/) {
+ ( "$1v", "iv" )
+ } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
+@@ -632,6 +635,22 @@ sub gen_c_code
+
+ CAMLreturn (rv);
+ "
++ } elsif ($sig =~ /^(\w+), string, unsigned : (\w+)$/) {
++ my $c_ret_type = short_name_to_c_type ($2);
++ "\
++ CAMLlocal1 (rv);
++ " . gen_unpack_args ($1) . "
++ char *str = String_val (strv);
++ unsigned int u = Int_val (uv);
++ $c_ret_type r;
++
++ NONBLOCKING (r = $c_name ($1, str, u));
++ CHECK_ERROR (!r, conn, \"$c_name\");
++
++ " . gen_pack_result ($2) . "
++
++ CAMLreturn (rv);
++"
+ } elsif ($sig =~ /^(\w+), (u?)int : unit$/) {
+ my $unsigned = $2 eq "u" ? "unsigned " : "";
+ "\
+diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
+index 9c9368a..1be023d 100644
+--- a/libvirt/libvirt.ml
++++ b/libvirt/libvirt.ml
+@@ -1,5 +1,5 @@
+ (* OCaml bindings for libvirt.
+- (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
++ (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
+ http://libvirt.org/
+
+ This library is free software; you can redistribute it and/or
+@@ -337,6 +337,20 @@ struct
+ cpu : int;
+ }
+
++ type domain_create_flag =
++ | START_PAUSED
++ | START_AUTODESTROY
++ | START_BYPASS_CACHE
++ | START_FORCE_BOOT
++ | START_VALIDATE
++ let rec int_of_domain_create_flags = function
++ | [] -> 0
++ | START_PAUSED :: flags -> 1 lor int_of_domain_create_flags flags
++ | START_AUTODESTROY :: flags -> 2 lor int_of_domain_create_flags flags
++ | START_BYPASS_CACHE :: flags -> 4 lor int_of_domain_create_flags flags
++ | START_FORCE_BOOT :: flags -> 8 lor int_of_domain_create_flags flags
++ | START_VALIDATE :: flags -> 16 lor int_of_domain_create_flags flags
++
+ type sched_param = string * sched_param_value
+ and sched_param_value =
+ | SchedFieldInt32 of int32 | SchedFieldUInt32 of int32
+@@ -385,6 +399,9 @@ struct
+ let max_peek _ = 65536
+
+ external create_linux : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_domain_create_linux"
++ external _create_xml : [>`W] Connect.t -> xml -> int -> rw t = "ocaml_libvirt_domain_create_xml"
++ let create_xml conn xml flags =
++ _create_xml conn xml (int_of_domain_create_flags flags)
+ external lookup_by_id : 'a Connect.t -> int -> 'a t = "ocaml_libvirt_domain_lookup_by_id"
+ external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid"
+ external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid_string"
+diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli
+index 36cd113..8cfcae2 100644
+--- a/libvirt/libvirt.mli
++++ b/libvirt/libvirt.mli
+@@ -1,5 +1,5 @@
+ (** OCaml bindings for libvirt. *)
+-(* (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
++(* (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
+ http://libvirt.org/
+
+ This library is free software; you can redistribute it and/or
+@@ -430,6 +430,13 @@ sig
+ cpu : int; (** real CPU number, -1 if offline *)
+ }
+
++ type domain_create_flag =
++ | START_PAUSED (** Launch guest in paused state *)
++ | START_AUTODESTROY (** Automatically kill guest on close *)
++ | START_BYPASS_CACHE (** Avoid filesystem cache pollution *)
++ | START_FORCE_BOOT (** Discard any managed save *)
++ | START_VALIDATE (** Validate XML against schema *)
++
+ type sched_param = string * sched_param_value
+ and sched_param_value =
+ | SchedFieldInt32 of int32 | SchedFieldUInt32 of int32
+@@ -478,8 +485,10 @@ sig
+
+ val create_linux : [>`W] Connect.t -> xml -> rw t
+ (** Create a new guest domain (not necessarily a Linux one)
+- from the given XML.
++ from the given XML. Use {!create_xml} instead.
+ *)
++ val create_xml : [>`W] Connect.t -> xml -> domain_create_flag list -> rw t
++ (** Create a new guest domain from the given XML. *)
+ val lookup_by_id : 'a Connect.t -> int -> 'a t
+ (** Lookup a domain by ID. *)
+ val lookup_by_uuid : 'a Connect.t -> uuid -> 'a t
+diff --git a/libvirt/libvirt_c.c b/libvirt/libvirt_c.c
+index 71e6f61..6e56682 100644
+--- a/libvirt/libvirt_c.c
++++ b/libvirt/libvirt_c.c
+@@ -6,7 +6,7 @@
+ */
+
+ /* OCaml bindings for libvirt.
+- * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
++ * (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
+ * http://libvirt.org/
+ *
+ * This library is free software; you can redistribute it and/or
+@@ -525,6 +525,29 @@ ocaml_libvirt_domain_create_linux (value connv, value strv)
+ CAMLreturn (rv);
+ }
+
++/* Automatically generated binding for virDomainCreateXML.
++ * In generator.pl this function has signature "conn, string, unsigned : dom".
++ */
++
++CAMLprim value
++ocaml_libvirt_domain_create_xml (value connv, value strv, value uv)
++{
++ CAMLparam3 (connv, strv, uv);
++
++ CAMLlocal1 (rv);
++ virConnectPtr conn = Connect_val (connv);
++ char *str = String_val (strv);
++ unsigned int u = Int_val (uv);
++ virDomainPtr r;
++
++ NONBLOCKING (r = virDomainCreateXML (conn, str, u));
++ CHECK_ERROR (!r, conn, "virDomainCreateXML");
++
++ rv = Val_domain (r, connv);
++
++ CAMLreturn (rv);
++}
++
+ /* Automatically generated binding for virDomainFree.
+ * In generator.pl this function has signature "dom : free".
+ */
+--
+2.3.1
+
diff --git a/ocaml-libvirt.spec b/ocaml-libvirt.spec
index 1bbb7a4..36b8151 100644
--- a/ocaml-libvirt.spec
+++ b/ocaml-libvirt.spec
@@ -2,7 +2,7 @@
Name: ocaml-libvirt
Version: 0.6.1.4
-Release: 4%{?dist}
+Release: 5%{?dist}
Summary: OCaml binding for libvirt
License: LGPLv2+
@@ -12,6 +12,9 @@ Source0: http://libvirt.org/sources/ocaml/%{name}-%{version}.tar.gz
# Upstream patch to fix int types.
Patch1: 0001-Use-C99-standard-int64_t-instead-of-OCaml-defined-an.patch
+# Upstream patch to add virDomainCreateXML binding.
+Patch2: 0001-Add-a-binding-for-virDomainCreateXML.patch
+
ExcludeArch: sparc64 s390 s390x
BuildRequires: ocaml >= 3.10.0
@@ -41,6 +44,7 @@ developing applications that use %{name}.
%setup -q
%patch1 -p1
+%patch2 -p1
%build
@@ -88,6 +92,9 @@ make install-byte
%changelog
+* Fri Mar 6 2015 Richard W.M. Jones <rjones at redhat.com> - 0.6.1.4-5
+- Add binding for virDomainCreateXML.
+
* Mon Feb 16 2015 Richard W.M. Jones <rjones at redhat.com> - 0.6.1.4-4
- ocaml-4.02.1 rebuild.
More information about the scm-commits
mailing list