[Libguestfs] [PATCH] builder: isolate all the cache handling to a new Cache module
Pino Toscano
ptoscano at redhat.com
Wed Apr 23 08:40:56 UTC 2014
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
More information about the Libguestfs
mailing list