diff options
Diffstat (limited to 'testing/ocaml-libvirt/0001-Add-a-binding-for-virDomainCreateXML.patch')
| -rw-r--r-- | testing/ocaml-libvirt/0001-Add-a-binding-for-virDomainCreateXML.patch | 213 |
1 files changed, 0 insertions, 213 deletions
diff --git a/testing/ocaml-libvirt/0001-Add-a-binding-for-virDomainCreateXML.patch b/testing/ocaml-libvirt/0001-Add-a-binding-for-virDomainCreateXML.patch deleted file mode 100644 index a25507b4f03..00000000000 --- a/testing/ocaml-libvirt/0001-Add-a-binding-for-virDomainCreateXML.patch +++ /dev/null @@ -1,213 +0,0 @@ -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 - |