This is an automated email from the git hooks/post-receive script. ecc-guest pushed a commit to branch master in repository approx.
commit fbef8e07a70b0d81633e3949815814af8802d845 Author: Eric Cooper <e...@cmu.edu> Date: Sun Jun 15 13:57:56 2014 -0400 only cache "not found" for true 404 responses (closes: #655986) use curl(1) exit status to distinguish File_not_found (404 response) from Download_error (currently all other failures) --- approx.ml | 17 +++++++++++++---- url.ml | 27 ++++++++++++++++++++++++--- url.mli | 5 ++++- util.ml | 14 +------------- util.mli | 12 ++++++------ 5 files changed, 48 insertions(+), 27 deletions(-) diff --git a/approx.ml b/approx.ml index 983e74f..7115994 100644 --- a/approx.ml +++ b/approx.ml @@ -1,5 +1,5 @@ (* approx: proxy server for Debian archive files - Copyright (C) 2013 Eric C. Cooper <e...@cmu.edu> + Copyright (C) 2014 Eric C. Cooper <e...@cmu.edu> Released under the GNU General Public License *) open Printf @@ -209,6 +209,7 @@ type download_status = | Not_modified | Redirect of string | File_not_found + | Download_error let string_of_download_status = function | Delivered -> "delivered" @@ -216,6 +217,7 @@ let string_of_download_status = function | Not_modified -> "not modified" | Redirect url -> "redirected to " ^ url | File_not_found -> "not found" + | Download_error -> "download error" type response_state = { name : string; @@ -350,7 +352,7 @@ let download_http resp url name ims cgi = end else loop (redirects + 1) | 404 -> File_not_found - | n -> error_message "Unexpected status code: %d" n; File_not_found + | n -> error_message "Unexpected status code: %d" n; Download_error in loop 0 @@ -383,8 +385,10 @@ let download_url url name ims cgi = (fun () -> remove_hint name) with e -> remove_cache resp.cache; - if e <> Failure url then info_message "%s" (string_of_exception e); - File_not_found + match e with + | Url.File_not_found -> File_not_found + | Url.Download_error -> Download_error + | e -> info_message "%s" (string_of_exception e); Download_error (* Handle any processing triggered by downloading a given file *) @@ -471,6 +475,11 @@ let serve_remote url name ims mod_time cgi = cache_nak name; respond `Not_found end + | Download_error -> + if not (is_cached_nak name) && offline && Sys.file_exists name then + copy_if_newer () + else + respond `Not_found let remote_service url name ims mod_time = object diff --git a/url.ml b/url.ml index 193c08b..c2d2da6 100644 --- a/url.ml +++ b/url.ml @@ -1,5 +1,5 @@ (* approx: proxy server for Debian archive files - Copyright (C) 2012 Eric C. Cooper <e...@cmu.edu> + Copyright (C) 2014 Eric C. Cooper <e...@cmu.edu> Released under the GNU General Public License *) open Config @@ -80,10 +80,31 @@ let iter_headers proc chan = in loop () +exception File_not_found +exception Download_error + +let process_status = function + | Unix.WEXITED n -> Printf.sprintf "exited with status %d" n + | Unix.WSIGNALED _ -> "killed" + | Unix.WSTOPPED _ -> "stopped" + +(* Spawn a curl command and apply a function to its output. *) + +let with_curl_process cmd = + let close chan = + match Unix.close_process_in chan with + | Unix.WEXITED 0 -> () + | Unix.WEXITED 22 -> raise File_not_found (* see curl(1) *) + | e -> + error_message "Command [%s] %s" cmd (process_status e); + raise Download_error + in + with_resource close Unix.open_process_in cmd + let head url callback = let cmd = head_command url in debug_message "Command: %s" cmd; - with_process cmd ~error: url (iter_headers callback) + with_curl_process cmd (iter_headers callback) let download_command headers header_callback = let hdr_opts = List.map (fun h -> "--header " ^ quoted_string h) headers in @@ -109,7 +130,7 @@ let seq f g x = (f x; g x) let download url ?(headers=[]) ?header_callback callback = let cmd = download_command headers header_callback url in debug_message "Command: %s" cmd; - with_process cmd ~error: url + with_curl_process cmd (match header_callback with | Some proc -> seq (iter_headers proc) (iter_body callback) | None -> iter_body callback) diff --git a/url.mli b/url.mli index 0fe7bfc..420866a 100644 --- a/url.mli +++ b/url.mli @@ -1,5 +1,5 @@ (* approx: proxy server for Debian archive files - Copyright (C) 2011 Eric C. Cooper <e...@cmu.edu> + Copyright (C) 2014 Eric C. Cooper <e...@cmu.edu> Released under the GNU General Public License *) (* Translate a request URL to the remote repository URL and @@ -15,6 +15,9 @@ type protocol = HTTP | HTTPS | FTP | FILE val protocol : string -> protocol +exception File_not_found (* raised when remote server returns 404 *) +exception Download_error (* raised when any other failure occurs *) + (* Perform HTTP HEAD (or equivalent for FTP and FILE) on the given URL and apply a callback to each header that is returned *) diff --git a/util.ml b/util.ml index f136029..1960686 100644 --- a/util.ml +++ b/util.ml @@ -1,5 +1,5 @@ (* approx: proxy server for Debian archive files - Copyright (C) 2013 Eric C. Cooper <e...@cmu.edu> + Copyright (C) 2014 Eric C. Cooper <e...@cmu.edu> Released under the GNU General Public License *) open Printf @@ -128,9 +128,6 @@ let unwind_protect body post = | Unwind e -> raise e (* assume cleanup has been done *) | e -> post (); raise e -(* Apply a function to a resource that is acquired and released by - the given functions *) - let with_resource release acquire x f = let res = acquire x in unwind_protect @@ -141,15 +138,6 @@ let with_in_channel openf = with_resource close_in openf let with_out_channel openf = with_resource close_out openf -let with_process ?error cmd = - let close chan = - if close_process_in chan <> WEXITED 0 then - failwith (match error with - | None -> cmd - | Some msg -> msg) - in - with_resource close open_process_in cmd - let gensym str = sprintf "%s.%d.%09.0f" (without_extension str) diff --git a/util.mli b/util.mli index 72225cd..427cc7f 100644 --- a/util.mli +++ b/util.mli @@ -1,5 +1,5 @@ (* approx: proxy server for Debian archive files - Copyright (C) 2013 Eric C. Cooper <e...@cmu.edu> + Copyright (C) 2014 Eric C. Cooper <e...@cmu.edu> Released under the GNU General Public License *) val invalid_string_arg : string -> string -> 'a @@ -64,6 +64,11 @@ val the : 'a option -> 'a val unwind_protect : (unit -> 'a) -> (unit -> unit) -> 'a +(* Apply a function to a resource that is acquired and released by + the given functions *) + +val with_resource : ('t -> unit) -> ('a -> 't) -> 'a -> ('t -> 'b) -> 'b + (* Open an input channel and apply a function to the channel, using unwind_protect to ensure that the channel gets closed *) @@ -74,11 +79,6 @@ val with_in_channel : ('a -> in_channel) -> 'a -> (in_channel -> 'b) -> 'b val with_out_channel : ('a -> out_channel) -> 'a -> (out_channel -> 'b) -> 'b -(* Spawn a shell command and apply a function to its output, - using unwind_protect to ensure that the channel gets closed *) - -val with_process : ?error:string -> string -> (in_channel -> 'a) -> 'a - (* Generate a unique string, suitable for use as a filename *) val gensym : string -> string -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/approx.git _______________________________________________ Pkg-ocaml-maint-commits mailing list Pkg-ocaml-maint-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits