Libguestfs - Oct 2016 - [PATCH v2 1/2] mllib: curl: add optional tmpdir parameter

Add a new optional parameter for the Curl ADT, so temporary files can be
created in a specified directory (which is supposed to be temporary, and
disposed only when the application quits).
---
 mllib/curl.ml  | 10 ++++++----
 mllib/curl.mli |  2 +-
 2 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/mllib/curl.ml b/mllib/curl.ml
index 376406e..baa75ec 100644
--- a/mllib/curl.ml
+++ b/mllib/curl.ml
@@ -25,6 +25,7 @@ let quote = Filename.quote
 type t = {
   curl : string;
   args : args;
+  tmpdir : string option;
 }
 and args = (string * string option) list
 
@@ -40,12 +41,13 @@ let args_of_proxy = function
   | SystemProxy ->     []
   | ForcedProxy url -> [ "proxy", Some url; "noproxy",
Some "" ]
 
-let create ?(curl = "curl") ?(proxy = SystemProxy) args +let create
?(curl = "curl") ?(proxy = SystemProxy) ?tmpdir args    let args =
safe_args @ args_of_proxy proxy @ args in
-  { curl = curl; args = args }
+  { curl = curl; args = args; tmpdir = tmpdir }
 
-let run { curl = curl; args = args } -  let config_file, chan =
Filename.open_temp_file "guestfscurl" ".conf" in
+let run { curl = curl; args = args; tmpdir = tmpdir } +  let config_file, chan
= Filename.open_temp_file ?temp_dir:tmpdir
+    "guestfscurl" ".conf" in
   List.iter (
     function
     | name, None -> fprintf chan "%s\n" name
diff --git a/mllib/curl.mli b/mllib/curl.mli
index f045572..c0c2fb0 100644
--- a/mllib/curl.mli
+++ b/mllib/curl.mli
@@ -27,7 +27,7 @@ type proxy    | SystemProxy           (** Use the system
settings. *)
   | ForcedProxy of string (** The proxy is forced to the specified URL. *)
 
-val create : ?curl:string -> ?proxy:proxy -> args -> t
+val create : ?curl:string -> ?proxy:proxy -> ?tmpdir:string -> args
-> t
 (** Create a curl command handle.
 
     The curl arguments are a list of key, value pairs corresponding
-- 
2.7.4

Create a single temporary directory for all the files created during the
virt-builder run (except big disk images, which already use the
libguestfs cache directory).  A single directory means there is no need
to manually schedule all the temporary files and directories for removal
when the application quits.
---
 builder/builder.ml              | 12 ++++++++++--
 builder/downloader.ml           | 10 ++++++----
 builder/downloader.mli          |  2 +-
 builder/index_parser.ml         |  4 +---
 builder/sigchecker.ml           | 32 ++++++++++++++------------------
 builder/sigchecker.mli          |  2 +-
 builder/simplestreams_parser.ml |  4 +---
 7 files changed, 34 insertions(+), 32 deletions(-)

diff --git a/builder/builder.ml b/builder/builder.ml
index 799208a..ebbcad3 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -177,8 +177,15 @@ let main ()          None
   in
 
+  (* Create a single temporary directory for all the small-or-so
+   * temporary files that Downloader, Sigchecker, etc, are going
+   * create.
+   *)
+  let tmpdir = Mkdtemp.temp_dir "virt-builder." "" in
+  rmdir_on_exit tmpdir;
+
   (* Download the sources. *)
-  let downloader = Downloader.create ~curl:cmdline.curl ~cache in
+  let downloader = Downloader.create ~curl:cmdline.curl ~cache ~tmpdir in
   let repos = Sources.read_sources () in
   let sources = List.map (
     fun (source, fingerprint) ->
@@ -197,7 +204,8 @@ let main ()            let sigchecker             
Sigchecker.create ~gpg:cmdline.gpg
                               ~check_signature:cmdline.check_signature
-                              ~gpgkey:source.Sources.gpgkey in
+                              ~gpgkey:source.Sources.gpgkey
+                              ~tmpdir in
           match source.Sources.format with
           | Sources.FormatNative ->
             Index_parser.get_index ~downloader ~sigchecker source
diff --git a/builder/downloader.ml b/builder/downloader.ml
index c164450..afd9c0f 100644
--- a/builder/downloader.ml
+++ b/builder/downloader.ml
@@ -29,11 +29,13 @@ type filename = string
 
 type t = {
   curl : string;
+  tmpdir : string;
   cache : Cache.t option;               (* cache for templates *)
 }
 
-let create ~curl ~cache = {
+let create ~curl ~tmpdir ~cache = {
   curl = curl;
+  tmpdir = tmpdir;
   cache = cache;
 }
 
@@ -41,7 +43,7 @@ let rec download t ?template ?progress_bar ?(proxy =
Curl.SystemProxy) uri    match template with
   | None ->                       (* no cache, simple download *)
     (* Create a temporary name. *)
-    let tmpfile = Filename.temp_file "vbcache" ".txt" in
+    let tmpfile = Filename.temp_file ~temp_dir:t.tmpdir "vbcache"
".txt" in
     download_to t ?progress_bar ~proxy uri tmpfile;
     (tmpfile, true)
 
@@ -107,7 +109,7 @@ and download_to t ?(progress_bar = false) ~proxy uri
filename          "write-out", Some "%{http_code}" (* HTTP
status code to stdout. *)
       ];
 
-      Curl.create ~curl:t.curl !curl_args in
+      Curl.create ~curl:t.curl ~tmpdir:t.tmpdir !curl_args in
 
     let lines = Curl.run curl_h in
     if List.length lines < 1 then
@@ -132,7 +134,7 @@ and download_to t ?(progress_bar = false) ~proxy uri
filename          else append curl_args quiet_args
       );
 
-      Curl.create ~curl:t.curl !curl_args in
+      Curl.create ~curl:t.curl ~tmpdir:t.tmpdir !curl_args in
 
     ignore (Curl.run curl_h)
   );
diff --git a/builder/downloader.mli b/builder/downloader.mli
index c99aee2..7f39f7e 100644
--- a/builder/downloader.mli
+++ b/builder/downloader.mli
@@ -24,7 +24,7 @@ type filename = string
 type t
 (** The abstract data type. *)
 
-val create : curl:string -> cache:Cache.t option -> t
+val create : curl:string -> tmpdir:string -> cache:Cache.t option -> t
 (** Create the abstract type. *)
 
 val download : t -> ?template:(string*string*Utils.revision) ->
?progress_bar:bool -> ?proxy:Curl.proxy -> uri -> (filename * bool)
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index d232a3a..e5e4c6c 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -32,7 +32,7 @@ let get_index ~downloader ~sigchecker
 
   let rec get_index ()      (* Get the index page. *)
-    let tmpfile, delete_tmpfile = Downloader.download downloader ~proxy uri in
+    let tmpfile, _ = Downloader.download downloader ~proxy uri in
 
     (* Check index file signature (also verifies it was fully
      * downloaded and not corrupted in transit).
@@ -41,8 +41,6 @@ let get_index ~downloader ~sigchecker
 
     (* Try parsing the file. *)
     let sections = Ini_reader.read_ini tmpfile in
-    if delete_tmpfile then
-      (try Unix.unlink tmpfile with _ -> ());
 
     (* Check for repeated os-version+arch combination. *)
     let name_arch_map = List.map (
diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml
index c1cc1f3..4c0d78e 100644
--- a/builder/sigchecker.ml
+++ b/builder/sigchecker.ml
@@ -30,12 +30,12 @@ type t = {
   subkeys_fingerprints : string list;
   check_signature : bool;
   gpghome : string;
+  tmpdir : string;
 }
 
 (* Import the specified key file. *)
-let import_keyfile ~gpg ~gpghome ?(trust = true) keyfile -  let status_file =
Filename.temp_file "vbstat" ".txt" in
-  unlink_on_exit status_file;
+let import_keyfile ~gpg ~gpghome ~tmpdir ?(trust = true) keyfile +  let
status_file = Filename.temp_file ~temp_dir:tmpdir "vbstat"
".txt" in
   let cmd = sprintf "%s --homedir %s --status-file %s --import %s%s"
     gpg gpghome (quote status_file) (quote keyfile)
     (if verbose () then "" else " >/dev/null
2>&1") in
@@ -88,10 +88,9 @@ let import_keyfile ~gpg ~gpghome ?(trust = true) keyfile     
!subkeys in
   !fingerprint, subkeys
 
-let rec create ~gpg ~gpgkey ~check_signature +let rec create ~gpg ~gpgkey
~check_signature ~tmpdir    (* Create a temporary directory for gnupg. *)
-  let tmpdir = Mkdtemp.temp_dir "vb.gpghome." "" in
-  rmdir_on_exit tmpdir;
+  let gpgtmpdir = Mkdtemp.temp_dir ~base_dir:tmpdir "vb.gpghome."
"" in
   (* Make sure we have no check_signature=true with no actual key. *)
   let check_signature, gpgkey      match check_signature, gpgkey with
@@ -103,7 +102,7 @@ let rec create ~gpg ~gpgkey ~check_signature         *
cannot.
        *)
       let cmd = sprintf "%s --homedir %s --list-keys%s"
-        gpg tmpdir (if verbose () then "" else " >/dev/null
2>&1") in
+        gpg gpgtmpdir (if verbose () then "" else "
>/dev/null 2>&1") in
       let r = shell_command cmd in
       if r <> 0 then
         error (f_"GPG failure: could not run GPG the first time\nUse the
'-v' option and look for earlier error messages.");
@@ -111,17 +110,16 @@ let rec create ~gpg ~gpgkey ~check_signature        |
No_Key ->
         assert false
       | KeyFile kf ->
-        import_keyfile gpg tmpdir kf
+        import_keyfile gpg gpgtmpdir tmpdir kf
       | Fingerprint fp ->
-        let filename = Filename.temp_file "vbpubkey" ".asc"
in
-        unlink_on_exit filename;
+        let filename = Filename.temp_file ~temp_dir:tmpdir "vbpubkey"
".asc" in
         let cmd = sprintf "%s --yes --armor --output %s --export
%s%s"
           gpg (quote filename) (quote fp)
           (if verbose () then "" else " >/dev/null
2>&1") in
         let r = shell_command cmd in
         if r <> 0 then
           error (f_"could not export public key\nUse the '-v'
option and look for earlier error messages.");
-        import_keyfile gpg tmpdir filename
+        import_keyfile gpg gpgtmpdir tmpdir filename
     ) else
       "", [] in
   {
@@ -129,7 +127,8 @@ let rec create ~gpg ~gpgkey ~check_signature     
fingerprint = fingerprint;
     subkeys_fingerprints = subkeys;
     check_signature = check_signature;
-    gpghome = tmpdir;
+    gpghome = gpgtmpdir;
+    tmpdir = tmpdir;
   }
 
 (* Compare two strings of hex digits ignoring whitespace and case. *)
@@ -179,12 +178,10 @@ and verify_and_remove_signature t filename    if
t.check_signature then (
     (* Copy the input file as temporary file with the .asc extension,
      * so gpg recognises that format. *)
-    let asc_file = Filename.temp_file "vbfile" ".asc" in
-    unlink_on_exit asc_file;
+    let asc_file = Filename.temp_file ~temp_dir:t.tmpdir "vbfile"
".asc" in
     let cmd = [ "cp"; filename; asc_file ] in
     if run_command cmd <> 0 then exit 1;
-    let out_file = Filename.temp_file "vbfile" "" in
-    unlink_on_exit out_file;
+    let out_file = Filename.temp_file ~temp_dir:t.tmpdir "vbfile"
"" in
     let args = sprintf "--yes --output %s %s" (quote out_file) (quote
filename) in
     do_verify ~verify_only:false t args;
     Some out_file
@@ -192,8 +189,7 @@ and verify_and_remove_signature t filename      None
 
 and do_verify ?(verify_only = true) t args -  let status_file =
Filename.temp_file "vbstat" ".txt" in
-  unlink_on_exit status_file;
+  let status_file = Filename.temp_file ~temp_dir:t.tmpdir "vbstat"
".txt" in
   let cmd      sprintf "%s --homedir %s %s%s --status-file %s %s"
         t.gpg t.gpghome
diff --git a/builder/sigchecker.mli b/builder/sigchecker.mli
index ac57072..bba2b6d 100644
--- a/builder/sigchecker.mli
+++ b/builder/sigchecker.mli
@@ -18,7 +18,7 @@
 
 type t
 
-val create : gpg:string -> gpgkey:Utils.gpgkey_type ->
check_signature:bool -> t
+val create : gpg:string -> gpgkey:Utils.gpgkey_type ->
check_signature:bool -> tmpdir:string -> t
 
 val verifying_signatures : t -> bool
 (** Return whether signatures are being verified by this
diff --git a/builder/simplestreams_parser.ml b/builder/simplestreams_parser.ml
index f7682cd..81e7018 100644
--- a/builder/simplestreams_parser.ml
+++ b/builder/simplestreams_parser.ml
@@ -86,9 +86,7 @@ let get_index ~downloader ~sigchecker
   let uri = ensure_trailing_slash uri in
 
   let download_and_parse uri -    let tmpfile, delete_tmpfile =
Downloader.download downloader ~proxy uri in
-    if delete_tmpfile then
-      unlink_on_exit tmpfile;
+    let tmpfile, _ = Downloader.download downloader ~proxy uri in
     let file        if Sigchecker.verifying_signatures sigchecker then (
         let tmpunsigned -- 
2.7.4

ACK series.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
Fedora Windows cross-compiler. Compile Windows programs, test, and
build Windows installers. Over 100 libraries supported.
http://fedoraproject.org/wiki/MinGW