Add binding for virDomainCreateXML.
This commit is contained in:
Richard W.M. Jones
parent
e20867dcd3
commit
41bd2465b7
213
0001-Add-a-binding-for-virDomainCreateXML.patch
Normal file
213
0001-Add-a-binding-for-virDomainCreateXML.patch
Normal file
@ -0,0 +1,213 @@
|
||||
From 7483c7454538584a3dbe4582096f058e6e877df6 Mon Sep 17 00:00:00 2001
|
||||
From: "Richard W.M. Jones" <rjones@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
|
||||
|
||||
@ -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@redhat.com> - 0.6.1.4-5
|
||||
- Add binding for virDomainCreateXML.
|
||||
|
||||
* Mon Feb 16 2015 Richard W.M. Jones <rjones@redhat.com> - 0.6.1.4-4
|
||||
- ocaml-4.02.1 rebuild.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user