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
