[Pkg-ocaml-maint-commits] r1821 - in
trunk/projects/approx/branches/nethttpd: . debian
Eric Cooper
ecc-guest at costa.debian.org
Mon Oct 10 14:37:11 UTC 2005
Author: ecc-guest
Date: 2005-10-10 14:37:09 +0000 (Mon, 10 Oct 2005)
New Revision: 1821
Modified:
trunk/projects/approx/branches/nethttpd/approx.ml
trunk/projects/approx/branches/nethttpd/debian/approx.cron.weekly
trunk/projects/approx/branches/nethttpd/debian/changelog
trunk/projects/approx/branches/nethttpd/gen_version
trunk/projects/approx/branches/nethttpd/url.ml
Log:
restore streaming of downloads to client
Modified: trunk/projects/approx/branches/nethttpd/approx.ml
===================================================================
--- trunk/projects/approx/branches/nethttpd/approx.ml 2005-10-10 14:32:36 UTC (rev 1820)
+++ trunk/projects/approx/branches/nethttpd/approx.ml 2005-10-10 14:37:09 UTC (rev 1821)
@@ -40,18 +40,14 @@
let exception_message exc =
match exc with
- | Sys_error str ->
- error_message "%s" str
- | Failure str ->
- error_message "Failure: %s" str
- | Invalid_argument str ->
- error_message "Invalid argument: %s" str
+ | Failure str -> error_message "%s" (String.capitalize str)
+ | Invalid_argument str -> error_message "Invalid argument: %s" str
+ | Sys_error str -> error_message "%s" str
| Unix_error (err, str, "") ->
error_message "%s: %s" str (Unix.error_message err)
| Unix_error (err, str, arg) ->
error_message "%s: %s (%s)" str (Unix.error_message err) arg
- | e ->
- error_message "%s" (Printexc.to_string e)
+ | e -> error_message "%s" (Printexc.to_string e)
let print_config () =
let units u = function
@@ -67,18 +63,6 @@
info_message "Max wait: %d" max_wait;
info_message "Debug: %B" debug
-type download_status =
- | Cached
- | Not_modified
- | File_not_found
- | Wrong_size
-
-let string_of_download_status = function
- | Cached -> "Cached"
- | Not_modified -> "Not modified"
- | File_not_found -> "File not found"
- | Wrong_size -> "Wrong size"
-
let http_time t =
Netdate.format ~fmt: "%a, %d %b %Y %T GMT" (Netdate.create ~zone: 0 t)
@@ -111,18 +95,19 @@
debug_message "%s" msg;
List.iter (fun (x, y) -> debug_message " %s: %s" x y) headers
-let proxy_headers name =
+let proxy_headers size modtime =
["Content-Type", "text/plain";
- "Content-Length", Int64.to_string (file_size name);
- "Last-Modified", http_time (file_modtime name)]
+ "Content-Length", Int64.to_string size ] @
+ if modtime <> 0. then ["Last-Modified", http_time modtime] else []
(* Deliver a file from the local cache *)
let deliver_local name env =
if not debug then info_message "%s" name;
- env#set_output_header_fields (proxy_headers name);
+ let size = file_size name in
+ env#set_output_header_fields (proxy_headers size (file_modtime name));
if debug then print_headers "Cache hit" env#output_header_fields;
- `File (`Ok, None, cache_dir ^/ name, 0L, file_size name)
+ `File (`Ok, None, cache_dir ^/ name, 0L, size)
(* Return the age of a file in minutes, using the last status change
time (ctime) rather than the modification time (mtime).
@@ -180,10 +165,10 @@
| dir :: rest ->
let name = cwd ^/ dir in
(try
- if (stat name).st_kind <> S_DIR then
- failwith (name ^ " exists but is not a directory")
- with
- Unix_error (ENOENT, "stat", _) -> mkdir name 0o755);
+ if (stat name).st_kind <> S_DIR then
+ failwith ("file " ^ name ^ " is not a directory")
+ with
+ Unix_error (ENOENT, "stat", _) -> mkdir name 0o755);
loop name rest
| [] -> ()
in
@@ -208,16 +193,19 @@
tmp_cache_file := in_progress name;
cache_chan := Some (create_file !tmp_cache_file)
with e ->
- exception_message e;
- error_message "Cannot cache %s" name
+ error_message "Cannot cache %s" name;
+ raise e
let write_cache str pos len =
match !cache_chan with
+ | None -> assert false
| Some chan -> output chan str pos len
- | None -> assert false
+exception Wrong_size
+
let close_cache mod_time size =
match !cache_chan with
+ | None -> assert false
| Some chan ->
let real_name = !cache_file in
let tmp_name = !tmp_cache_file in
@@ -234,18 +222,14 @@
(string_of_time mod_time);
utimes real_name mod_time mod_time
end;
- Cached
end
else
- (* FIXME:
- gc_approx or another approx process might have removed .tmp file *)
begin
error_message "Size of %s should be %Ld, not %Ld"
real_name size (file_size tmp_name);
Sys.remove tmp_name;
- Wrong_size
+ raise Wrong_size
end
- | None -> assert false
let remove_cache () =
match !cache_chan with
@@ -257,6 +241,25 @@
error_message "Removing %s (size: %Ld)" tmp_name (file_size tmp_name);
Sys.remove tmp_name
+type download_status =
+ | Delivered
+ | Cached
+ | Not_modified
+ | File_not_found
+
+let string_of_download_status = function
+ | Delivered -> "Delivered"
+ | Cached -> "Cached"
+ | Not_modified -> "Not modified"
+ | File_not_found -> "File not found"
+
+let send_header size modtime (cgi : Netcgi_types.cgi_activation) =
+ let headers = proxy_headers size modtime in
+ let fields = List.map (fun (name, value) -> (name, [value])) headers in
+ cgi#set_header ~status: `Ok ~fields ();
+ if debug then
+ print_headers "Proxy response" cgi#environment#output_header_fields
+
(* Update the ctime but not the mtime of the file, if it exists *)
let update_ctime name =
@@ -289,7 +292,7 @@
| "content-length" ->
(try length := Int64.of_string value
with Failure _ ->
- error_message "Cannot parse Content-Length value %s" value)
+ error_message "Cannot parse Content-Length %s" value)
| "last-modified" ->
(try last_modified := Netdate.parse_epoch value
with Invalid_argument _ ->
@@ -304,17 +307,26 @@
(* Download a file from an HTTP repository *)
-let download_http url name ims =
+let download_http url name ims cgi =
let status = ref 0 in
let length = ref (-1L) in
let last_modified = ref 0. in
let header_callback = process_header (status, length, last_modified) in
let body_seen = ref false in
+ let start_transfer () =
+ open_cache name;
+ if !length >= 0L then
+ (* start our response now *)
+ send_header !length !last_modified cgi
+ in
let body_callback str pos len =
if !status = 200 then
begin
- once body_seen (fun () -> open_cache name);
- write_cache str pos len
+ once body_seen start_transfer;
+ write_cache str pos len;
+ if !length >= 0L then
+ (* stream the data back to the client as we receive it *)
+ cgi#output#really_output str pos len
end
in
let headers =
@@ -322,14 +334,16 @@
in
Url.download url ~headers ~header_callback body_callback;
match !status with
- | 200 -> close_cache !last_modified !length
+ | 200 ->
+ close_cache !last_modified !length;
+ if !length >= 0L then Delivered else Cached
| 304 -> Not_modified
| 404 -> File_not_found
| n -> error_message "Unexpected status code: %d" n; File_not_found
(* Download a file from an FTP repository *)
-let download_ftp url name ims =
+let download_ftp url name ims cgi =
let status = ref 0 in
let length = ref (-1L) in
let last_modified = ref 0. in
@@ -337,14 +351,23 @@
Url.head url header_callback;
let mod_time = !last_modified in
if debug then
- debug_message " ims %s mtime %s"
- (string_of_time ims) (string_of_time mod_time);
+ debug_message " ims %s mtime %s"
+ (string_of_time ims) (string_of_time mod_time);
if mod_time > ims || mod_time = 0. then
- begin
- open_cache name;
- Url.download url write_cache;
- close_cache !last_modified !length
- end
+ let size = !length in
+ if size >= 0L then
+ (* start our response now *)
+ send_header size mod_time cgi;
+ let body_callback str pos len =
+ write_cache str pos len;
+ if size >= 0L then
+ (* stream the data back to the client as we receive it *)
+ cgi#output#really_output str pos len
+ in
+ open_cache name;
+ Url.download url body_callback;
+ close_cache mod_time size;
+ if size >= 0L then Delivered else Cached
else
Not_modified
@@ -379,47 +402,42 @@
in
loop ()
-let send_header name (cgi : Netcgi_types.cgi_activation) =
- let fields =
- List.map (fun (name, value) -> (name, [value])) (proxy_headers name)
- in
- cgi#set_header ~status: `Ok ~fields ();
- if debug then print_headers "Cache miss" cgi#environment#output_header_fields
-
(* Similar to deliver_local, but we have to copy it ourselves *)
let copy_from_cache name cgi =
wait_for_download_in_progress name;
- send_header name cgi;
+ send_header (file_size name) (file_modtime name) cgi;
let output = cgi#output in
with_channel open_in name (fun input -> copy input output);
output#commit_work ()
+let respond code = raise (Standard_response (code, None, None))
+
let serve_remote url name ims mod_time cgi =
info_message "%s" url;
let status =
- try download_url url name (max ims mod_time)
+ try download_url url name (max ims mod_time) cgi
with e ->
remove_cache ();
exception_message e;
- raise (Standard_response (`Not_found, None, Some "Download failed"))
+ respond `Not_found
in
if debug then debug_message " => %s" (string_of_download_status status);
match status with
+ | Delivered ->
+ cleanup_after name
| Cached ->
copy_from_cache name cgi;
cleanup_after name
| Not_modified ->
update_ctime name;
if mod_time > ims then
- (* the cached copy is newer than what the client has *)
+ (* the cached copy is newer than what the client has *)
copy_from_cache name cgi
else
- raise (Standard_response (`Not_modified, None, None))
+ respond `Not_modified
| File_not_found ->
- raise (Standard_response (`Not_found, None, None))
- | Wrong_size ->
- raise (Standard_response (`Service_unavailable, None, Some "Wrong size"))
+ respond `Not_found
let remote_service url name ims mod_time =
object
Modified: trunk/projects/approx/branches/nethttpd/debian/approx.cron.weekly
===================================================================
--- trunk/projects/approx/branches/nethttpd/debian/approx.cron.weekly 2005-10-10 14:32:36 UTC (rev 1820)
+++ trunk/projects/approx/branches/nethttpd/debian/approx.cron.weekly 2005-10-10 14:37:09 UTC (rev 1821)
@@ -2,8 +2,10 @@
# Garbage collect the approx(8) cache
-gc_approx --quiet
+# Run as the approx user in case we need to download replacement files
+su approx -c "gc_approx --quiet"
+
# Remove any empty directories
# The trailing /. makes it work when /var/cache/approx is a symlink
Modified: trunk/projects/approx/branches/nethttpd/debian/changelog
===================================================================
--- trunk/projects/approx/branches/nethttpd/debian/changelog 2005-10-10 14:32:36 UTC (rev 1820)
+++ trunk/projects/approx/branches/nethttpd/debian/changelog 2005-10-10 14:37:09 UTC (rev 1821)
@@ -1,3 +1,10 @@
+approx (2.00) unstable; urgency=low
+
+ * Stream the response to the client while downloading to the cache
+ * Release with new major version
+
+ -- Eric Cooper <ecc at cmu.edu> Mon, 10 Oct 2005 10:04:09 -0400
+
approx (1.51) unstable; urgency=low
* Changed client to use curl subprocesses instead of ocurl
Modified: trunk/projects/approx/branches/nethttpd/gen_version
===================================================================
--- trunk/projects/approx/branches/nethttpd/gen_version 2005-10-10 14:32:36 UTC (rev 1820)
+++ trunk/projects/approx/branches/nethttpd/gen_version 2005-10-10 14:37:09 UTC (rev 1821)
@@ -1,9 +1,26 @@
#!/usr/bin/perl -w
use strict;
-open(CHANGELOG, "dpkg-parsechangelog |") or exit 1;
-while (<CHANGELOG>) {
- /^Source:\s+(\S+)/ && print "let name = \"$1\"\n";
- /^Version:\s+(\S+)/ && print "let number = \"$1\"\n";
+my $name = undef;
+my $number = undef;
+
+sub parse_changelog() {
+ open(CHANGELOG, "-|", "dpkg-parsechangelog") or exit 1;
+ while (<CHANGELOG>) {
+ $name = $1 if /^Source:\s+(\S+)/;
+ $number = $1 if /^Version:\s+(\S+)/;
+ }
+ close(CHANGELOG);
+ defined $name or die "$0: package name not found in changelog\n";
+ defined $number or die "$0: version number not found in changelog\n";
}
-close(CHANGELOG);
+
+sub write_version() {
+ print <<EOF;
+let name = "$name"
+let number = "$number"
+EOF
+}
+
+parse_changelog();
+write_version();
Modified: trunk/projects/approx/branches/nethttpd/url.ml
===================================================================
--- trunk/projects/approx/branches/nethttpd/url.ml 2005-10-10 14:32:36 UTC (rev 1820)
+++ trunk/projects/approx/branches/nethttpd/url.ml 2005-10-10 14:37:09 UTC (rev 1821)
@@ -34,12 +34,17 @@
in
loop ()
+let finish = function
+ | Unix.WEXITED 0 -> ()
+ | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
+ failwith "download failed"
+
let head url callback =
let cmd = head_command url in
if debug then debug_message "Command: %s" cmd;
let chan = Unix.open_process_in cmd in
iter_headers chan callback;
- ignore (Unix.close_process_in chan)
+ finish (Unix.close_process_in chan)
let download_command url headers headers_wanted =
let buf = Buffer.create 200 in
@@ -69,4 +74,4 @@
| Some proc -> iter_headers chan proc
| None -> ());
iter_body chan callback;
- ignore (Unix.close_process_in chan)
+ finish (Unix.close_process_in chan)
More information about the Pkg-ocaml-maint-commits
mailing list