Partially downloaded image is not deleted on exit anymore.
There is a check for partially downloaded image in cache directory
based on its name. When found, download_to crafts appropriate
options to continue its download.
---
builder/downloader.ml | 31 +++++++++++++++++++++++++------
1 file changed, 25 insertions(+), 6 deletions(-)
diff --git a/builder/downloader.ml b/builder/downloader.ml
index 8a23bdc..feda745 100644
--- a/builder/downloader.ml
+++ b/builder/downloader.ml
@@ -65,11 +65,11 @@ let rec download ~prog t ?template ?progress_bar ?(proxy =
SystemProxy) uri =
* If not, download it.
*)
if not (Sys.file_exists filename) then
- download_to ~prog t ?progress_bar ~proxy uri filename;
+ download_to ~prog t ?progress_bar ~continue:true ~proxy uri filename;
(filename, false)
-and download_to ~prog t ?(progress_bar = false) ~proxy uri filename =
+and download_to ~prog t ?(progress_bar = false) ?(continue = false) ~proxy uri filename
=
let parseduri =
try URI.parse_uri uri
with Invalid_argument "URI.parse_uri" ->
@@ -82,9 +82,10 @@ and download_to ~prog t ?(progress_bar = false) ~proxy uri filename =
* atomically rename it to the final filename.
*)
let filename_new = filename ^ "." ^ string_random8 () in
- unlink_on_exit filename_new;
+ if not continue then
+ unlink_on_exit filename_new;
- (match parseduri.URI.protocol with
+ let filename_new = (match parseduri.URI.protocol with
| "file" ->
let path = parseduri.URI.path in
let cmd = sprintf "cp%s %s %s"
@@ -93,6 +94,7 @@ and download_to ~prog t ?(progress_bar = false) ~proxy uri filename =
let r = Sys.command cmd in
if r <> 0 then
error (f_"cp (download) command failed copying '%s'") path;
+ filename_new
| _ as protocol -> (* Any other protocol. *)
let outenv = proxy_envvar protocol proxy in
(* Get the status code first to ensure the file exists. *)
@@ -115,17 +117,34 @@ and download_to ~prog t ?(progress_bar = false) ~proxy uri filename
=
if bad_status_code status_code then
error (f_"failed to download %s: HTTP status code %s") uri status_code;
+ let compare_basenames a b =
+ (Filename.basename a) = (try Filename.chop_extension b with _ -> b)
+ in
+
+ let files = Array.to_list (Sys.readdir (Filename.dirname filename)) in
+ let files =
+ if continue then
+ List.filter (compare_basenames filename) files
+ else
+ [] in
+
+ let filename_new, continue_download = match files with
+ | [] -> filename_new, ""
+ | fil::_ -> (Filename.dirname filename_new) // fil, " -C -" in
+
(* Now download the file. *)
- let cmd = sprintf "%s%s%s -g -o %s %s"
+ let cmd = sprintf "%s%s%s%s -g -o %s %s"
outenv
t.curl
(if t.verbose then "" else if progress_bar then " -#" else
" -s -S")
+ continue_download
(quote filename_new) (quote uri) in
if t.verbose then printf "%s\n%!" cmd;
let r = Sys.command cmd in
if r <> 0 then
error (f_"curl (download) command failed downloading '%s'") uri;
- );
+ filename_new
+ ) in
(* Rename the file if the download was successful. *)
rename filename_new filename
--
1.9.3