Partially downloaded file 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..36f89ae 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:(Some 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