Libguestfs - Apr 2014 - [PATCH] builder: isolate all the cache handling to a new Cache module

While there is not that much in it, it groups together the small
scattered-around bits handling the cache directory.
---
 builder/Makefile.am    |  3 +++
 builder/builder.ml     | 48 ++++++++++++++-----------------------
 builder/cache.ml       | 65 ++++++++++++++++++++++++++++++++++++++++++++++++++
 builder/cache.mli      | 45 ++++++++++++++++++++++++++++++++++
 builder/downloader.ml  | 12 ++++------
 builder/downloader.mli |  7 +-----
 po/POTFILES-ml         |  1 +
 7 files changed, 137 insertions(+), 44 deletions(-)
 create mode 100644 builder/cache.ml
 create mode 100644 builder/cache.mli

diff --git a/builder/Makefile.am b/builder/Makefile.am
index 7d399d4..21710f1 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -46,6 +46,8 @@ CLEANFILES = *~ *.cmi *.cmo *.cmx *.cmxa *.o virt-builder
 SOURCES = \
 	architecture.ml \
 	builder.ml \
+	cache.mli \
+	cache.ml \
 	cmdline.ml \
 	downloader.mli \
 	downloader.ml \
@@ -120,6 +122,7 @@ deps = \
 	paths.cmx \
 	languages.cmx \
 	get_kernel.cmx \
+	cache.cmx \
 	downloader.cmx \
 	sigchecker.cmx \
 	index_parser.cmx \
diff --git a/builder/builder.ml b/builder/builder.ml
index 35f5780..acb6129 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -69,8 +69,7 @@ let main ()        (match cache with
       | Some cachedir ->
         msg "Deleting: %s" cachedir;
-        let cmd = sprintf "rm -rf %s" (quote cachedir) in
-        ignore (Sys.command cmd);
+        Cache.clean_cachedir cachedir;
         exit 0
       | None ->
         eprintf (f_"%s: error: could not find cache directory. Is $HOME
set?\n")
@@ -109,27 +108,17 @@ let main ()      exit 1
   );
 
-  (* Create the cache directory. *)
+  (* Create the cache. *)
   let cache      match cache with
     | None -> None
     | Some dir ->
-      (* Annoyingly Sys.is_directory throws an exception on failure
-       * (RHBZ#1022431).
-       *)
-      if (try Sys.is_directory dir with Sys_error _ -> false) then
-        Some dir
-      else (
-        (* Try to make the directory.  If that fails, warn and continue
-         * without any cache.
-         *)
-        try mkdir dir 0o755; Some dir
-        with exn ->
-          eprintf (f_"%s: warning: cache %s: %s\n") prog dir
-            (Printexc.to_string exn);
-          eprintf (f_"%s: disabling the cache\n%!") prog;
-          None
-      )
+      try Some (Cache.create ~debug ~directory:dir)
+      with exn ->
+        eprintf (f_"%s: warning: cache %s: %s\n") prog dir
+          (Printexc.to_string exn);
+        eprintf (f_"%s: disabling the cache\n%!") prog;
+        None
   in
 
   (* Download the sources. *)
@@ -167,17 +156,16 @@ let main ()  
     | `Print_cache ->                   (* --print-cache *)
       (match cache with
-      | Some cachedir ->
-        printf (f_"cache directory: %s\n") cachedir;
-        List.iter (
-          fun (name, { Index_parser.revision = revision; arch = arch; hidden =
hidden }) ->
-            if not hidden then (
-              let filename = Downloader.cache_of_name cachedir name arch
revision in
-              let cached = Sys.file_exists filename in
-              printf "%-24s %-10s %s\n" name arch
-                (if cached then s_"cached" else (*s_*)"no")
-            )
-        ) index
+      | Some cache ->
+        let l = List.filter (
+          fun (_, { Index_parser.hidden = hidden }) ->
+            hidden <> true
+        ) index in
+        let l = List.map (
+          fun (name, { Index_parser.revision = revision; arch = arch }) ->
+            (name, arch, revision)
+        ) l in
+        Cache.print_item_status cache ~header:true l
       | None -> printf (f_"no cache directory\n")
       );
       exit 0
diff --git a/builder/cache.ml b/builder/cache.ml
new file mode 100644
index 0000000..581b2cf
--- /dev/null
+++ b/builder/cache.ml
@@ -0,0 +1,65 @@
+(* virt-builder
+ * Copyright (C) 2013-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Common_gettext.Gettext
+open Common_utils
+
+open Unix
+open Printf
+
+let quote = Filename.quote
+
+let clean_cachedir dir +  let cmd = sprintf "rm -rf %s" (quote dir)
in
+  ignore (Sys.command cmd);
+
+type t = {
+  debug : bool;
+  directory : string;
+}
+
+let create ~debug ~directory +  (* Annoyingly Sys.is_directory throws an
exception on failure
+   * (RHBZ#1022431).
+   *)
+  let is_dir = try Sys.is_directory directory with Sys_error _ -> false in
+  if is_dir = false then (
+    mkdir directory 0o755
+  );
+  {
+    debug = debug;
+    directory = directory;
+  }
+
+let cache_of_name t name arch revision +  t.directory // sprintf
"%s.%s.%d" name arch revision
+
+let is_cached t name arch revision +  let filename = cache_of_name t name arch
revision in
+  Sys.file_exists filename
+
+let print_item_status t ~header l +  if header then (
+    printf (f_"cache directory: %s\n") t.directory
+  );
+  List.iter (
+    fun (name, arch, revision) ->
+      let cached = is_cached t name arch revision in
+      printf "%-24s %-10s %s\n" name arch
+        (if cached then s_"cached" else (*s_*)"no")
+  ) l
diff --git a/builder/cache.mli b/builder/cache.mli
new file mode 100644
index 0000000..220ebcb
--- /dev/null
+++ b/builder/cache.mli
@@ -0,0 +1,45 @@
+(* virt-builder
+ * Copyright (C) 2013-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(** This module represents a local cache. *)
+
+val clean_cachedir : string -> unit
+(** [clean_cachedir dir] clean the specified cache directory. *)
+
+type t
+(** The abstract data type. *)
+
+val create : debug:bool -> directory:string -> t
+(** Create the abstract type. *)
+
+val cache_of_name : t -> string -> string -> int -> string
+(** [cache_of_name t name arch revision] return the filename
+    of the cached file.  (Note: It doesn't check if the filename
+    exists, this is just a simple string transformation). *)
+
+val is_cached : t -> string -> string -> int -> bool
+(** [is_cached t name arch revision] return whether the file with
+    specified name, architecture and revision is cached. *)
+
+val print_item_status : t -> header:bool -> (string * string * int) list
-> unit
+(** [print_item_status t header items] print the status in the cache
+    of the specified items (which are tuples of name, architecture,
+    and revision).
+
+    If [~header:true] then display a header with the path of the
+    cache. *)
diff --git a/builder/downloader.ml b/builder/downloader.ml
index f8cd7ab..9fed774 100644
--- a/builder/downloader.ml
+++ b/builder/downloader.ml
@@ -23,10 +23,6 @@ open Unix
 open Printf
 
 let quote = Filename.quote
-let (//) = Filename.concat
-
-let cache_of_name cachedir name arch revision -  cachedir // sprintf
"%s.%s.%d" name arch revision
 
 type uri = string
 type filename = string
@@ -34,7 +30,7 @@ type filename = string
 type t = {
   debug : bool;
   curl : string;
-  cache : string option;                (* cache directory for templates *)
+  cache : Cache.t option;               (* cache for templates *)
 }
 
 type proxy_mode @@ -62,8 +58,8 @@ let rec download ~prog t ?template
?progress_bar ?(proxy = SystemProxy) uri        (* Not using the cache at all?
*)
       download t ~prog ?progress_bar ~proxy uri
 
-    | Some cachedir ->
-      let filename = cache_of_name cachedir name arch revision in
+    | Some cache ->
+      let filename = Cache.cache_of_name cache name arch revision in
 
       (* Is the requested template name + revision in the cache already?
        * If not, download it.
@@ -81,7 +77,7 @@ and download_to ~prog t ?(progress_bar = false) ~proxy uri
filename        exit 1 in
 
   (* Note because there may be parallel virt-builder instances running
-   * and also to avoid partial downloads in the cachedir if the network
+   * and also to avoid partial downloads in the cache if the network
    * fails, we download to a random name in the cache and then
    * atomically rename it to the final filename.
    *)
diff --git a/builder/downloader.mli b/builder/downloader.mli
index 4d24a34..a10cdca 100644
--- a/builder/downloader.mli
+++ b/builder/downloader.mli
@@ -18,11 +18,6 @@
 
 (** This module is a wrapper around curl, plus local caching. *)
 
-val cache_of_name : string -> string -> string -> int -> string
-(** [cache_of_name cachedir name arch revision] returns the filename
-    of the cached file.  (Note: It doesn't check if the filename
-    exists, this is just a simple string transformation). *)
-
 type uri = string
 type filename = string
 
@@ -37,7 +32,7 @@ type proxy_mode                                  *)
   | ForcedProxy of string      (* The proxy is forced to the specified URL. *)
 
-val create : debug:bool -> curl:string -> cache:string option -> t
+val create : debug:bool -> curl:string -> cache:Cache.t option -> t
 (** Create the abstract type. *)
 
 val download : prog:string -> t -> ?template:(string*string*int) ->
?progress_bar:bool -> ?proxy:proxy_mode -> uri -> (filename * bool)
diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index 4dce0e5..8993136 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -1,5 +1,6 @@
 builder/architecture.ml
 builder/builder.ml
+builder/cache.ml
 builder/cmdline.ml
 builder/downloader.ml
 builder/get_kernel.ml
-- 
1.9.0

Looks like simple code motion, ACK!

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-p2v converts physical machines to virtual machines.  Boot with a
live CD or over the network (PXE) and turn machines into KVM guests.
http://libguestfs.org/virt-v2v