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" +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 - 0.6.1.4-5 +- Add binding for virDomainCreateXML. + * Mon Feb 16 2015 Richard W.M. Jones - 0.6.1.4-4 - ocaml-4.02.1 rebuild.