From 6f3635fe4dc9989745d154c8b346c47e4d384121 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Thu, 1 Jan 1970 00:00:00 +0000
Subject: [PATCH] Fix native virt-ctrl on Windows. 	*
 virt-ctrl/Makefile.in, virt-ctrl/mingw-gcc-wrapper.ml: Wrapper 	 
 around 'gcc' to fix native virt-ctrl builds on Windows/MinGW. 	* .hgignore:
 Ignore *.exe files.

---
 .hgignore                      |  1 +
 ChangeLog                      |  7 +++++
 virt-ctrl/Makefile.in          | 19 ++++++++++--
 virt-ctrl/mingw-gcc-wrapper.ml | 70 ++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 95 insertions(+), 2 deletions(-)
 create mode 100755 virt-ctrl/mingw-gcc-wrapper.ml

diff --git a/.hgignore b/.hgignore
index b7ad4a6..211b624 100644
--- a/.hgignore
+++ b/.hgignore
@@ -23,6 +23,7 @@ core.*
 *.a
 *.opt
 *.dll
+*.exe
 *~
 libvirt/libvirt_version.ml
 examples/list_domains
diff --git a/ChangeLog b/ChangeLog
index 440e9d1..ba51e44 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2008-01-08  Richard Jones  <rjones@redhat.com>
+
+	Fix native virt-ctrl on Windows.
+	* virt-ctrl/Makefile.in, virt-ctrl/mingw-gcc-wrapper.ml: Wrapper
+	  around 'gcc' to fix native virt-ctrl builds on Windows/MinGW.
+	* .hgignore: Ignore *.exe files.
+
 2008-01-07  Richard Jones  <rjones@redhat.com>
 
 	Updated MANIFEST.
diff --git a/virt-ctrl/Makefile.in b/virt-ctrl/Makefile.in
index c6966a8..26d6fe5 100644
--- a/virt-ctrl/Makefile.in
+++ b/virt-ctrl/Makefile.in
@@ -72,10 +72,25 @@ virt-ctrl: $(OBJS)
 	$(OCAMLC) $(OCAMLCINCS) $(OCAMLCFLAGS) $(OCAMLCLIBS) \
 	  ../libvirt/mllibvirt.cma gtkInit.cmo -o $@ $^
 
+host_os		= @host_os@
+
+ifneq ($(host_os),mingw32)
 virt-ctrl.opt: $(XOBJS)
-	$(OCAMLOPT) -verbose $(OCAMLOPTINCS) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \
-	  -cclib "$(LDFLAGS)" \
+	$(OCAMLOPT) $(OCAMLOPTINCS) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \
+	  $(patsubst %,-cclib %,$(LDFLAGS)) \
 	  ../libvirt/mllibvirt.cmxa gtkInit.cmx -o $@ $^
+else
+# On MinGW, use a hacked 'gcc' wrapper which understands the @...
+# syntax for extending the command line.
+gcc.exe: mingw-gcc-wrapper.ml
+	$(OCAMLC) unix.cma $< -o $@
+
+virt-ctrl.opt: $(XOBJS) gcc.exe
+	PATH=.:$$PATH \
+	$(OCAMLOPT) $(OCAMLOPTINCS) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \
+	  $(patsubst %,-cclib %,$(LDFLAGS)) \
+	  ../libvirt/mllibvirt.cmxa gtkInit.cmx -o $@ $(XOBJS)
+endif
 endif
 
 install:
diff --git a/virt-ctrl/mingw-gcc-wrapper.ml b/virt-ctrl/mingw-gcc-wrapper.ml
new file mode 100755
index 0000000..21cdb8f
--- /dev/null
+++ b/virt-ctrl/mingw-gcc-wrapper.ml
@@ -0,0 +1,70 @@
+(* Wrapper around 'gcc'.  On MinGW, this wrapper understands the '@...'
+ * syntax for extending the command line.
+ *)
+
+open Printf
+open Unix
+
+let (//) = Filename.concat
+
+(* Substitute any @... arguments with the file content. *)
+let rec input_all_lines chan =
+  try
+    let line = input_line chan in
+    line :: input_all_lines chan
+  with
+    End_of_file -> []
+
+let argv = Array.map (
+  fun arg ->
+    if arg.[0] = '@' then (
+      let chan = open_in (String.sub arg 1 (String.length arg - 1)) in
+      let lines = input_all_lines chan in
+      close_in chan;
+      lines
+    ) else
+      [arg]
+) Sys.argv
+
+let argv = Array.to_list argv
+let argv = List.flatten argv
+
+(* Find the real gcc.exe on $PATH, but ignore any '.' elements in the path.
+ * Note that on Windows, $PATH is split with ';' characters.
+ *)
+let rec split_find str sep f =
+  try
+    let i = String.index str sep in
+    let n = String.length str in
+    let str, str' = String.sub str 0 i, String.sub str (i+1) (n-i-1) in
+    match f str with
+    | None -> split_find str' sep f  (* not found, keep searching *)
+    | Some found -> found
+  with
+    Not_found ->
+      match f str with
+      | None -> raise Not_found (* not found at all *)
+      | Some found -> found
+
+let exists filename =
+  try access filename [F_OK]; true with Unix_error _ -> false
+
+let gcc =
+  split_find (Sys.getenv "PATH") ';'
+    (function
+     | "." -> None (* ignore current directory in path *)
+     | path ->
+       let gcc = path // "gcc.exe" in
+       if exists gcc then Some gcc else None)
+
+(* Finally execute the real gcc with the full argument list.
+ * Can't use execv here because then the parent process (ocamlopt) thinks
+ * that this process has finished and deletes all the temp files.  Stupid
+ * Windoze!
+ *)
+let _ =
+  let argv = List.map Filename.quote (List.tl argv) in
+  let cmd = String.concat " " (gcc :: argv) in
+  eprintf "mingw-gcc-wrapper: %s\n%!" cmd;
+  let r = Sys.command cmd in
+  exit r
-- 
1.8.3.1