[Pkg-ocaml-maint-commits] r1224 - in trunk/projects/approx: . debian trunk
Eric Cooper
ecc-guest@costa.debian.org
Fri, 08 Apr 2005 18:59:29 +0000
Author: ecc-guest
Date: 2005-04-08 18:59:28 +0000 (Fri, 08 Apr 2005)
New Revision: 1224
Added:
trunk/projects/approx/Makefile
trunk/projects/approx/approx.8
trunk/projects/approx/approx.conf
trunk/projects/approx/approx.conf.5
trunk/projects/approx/approx.ml
trunk/projects/approx/config.ml
trunk/projects/approx/config.mli
trunk/projects/approx/debian/
trunk/projects/approx/default_config.ml
trunk/projects/approx/default_config.mli
trunk/projects/approx/gc_approx.8
trunk/projects/approx/gc_approx.ml
trunk/projects/approx/package.ml
trunk/projects/approx/package.mli
trunk/projects/approx/url.ml
trunk/projects/approx/url.mli
trunk/projects/approx/util.ml
trunk/projects/approx/util.mli
Removed:
trunk/projects/approx/trunk/Makefile
trunk/projects/approx/trunk/approx.8
trunk/projects/approx/trunk/approx.conf
trunk/projects/approx/trunk/approx.conf.5
trunk/projects/approx/trunk/approx.ml
trunk/projects/approx/trunk/config.ml
trunk/projects/approx/trunk/config.mli
trunk/projects/approx/trunk/debian/
trunk/projects/approx/trunk/default_config.ml
trunk/projects/approx/trunk/default_config.mli
trunk/projects/approx/trunk/gc_approx.8
trunk/projects/approx/trunk/gc_approx.ml
trunk/projects/approx/trunk/package.ml
trunk/projects/approx/trunk/package.mli
trunk/projects/approx/trunk/url.ml
trunk/projects/approx/trunk/url.mli
trunk/projects/approx/trunk/util.ml
trunk/projects/approx/trunk/util.mli
Modified:
trunk/projects/approx/debian/changelog
trunk/projects/approx/debian/control
Log:
removed trunk directory layer
add build-dependency on ocaml-tools (CLOSES #303774)
Copied: trunk/projects/approx/Makefile (from rev 1223, trunk/projects/approx/trunk/Makefile)
Copied: trunk/projects/approx/approx.8 (from rev 1223, trunk/projects/approx/trunk/approx.8)
Copied: trunk/projects/approx/approx.conf (from rev 1223, trunk/projects/approx/trunk/approx.conf)
Copied: trunk/projects/approx/approx.conf.5 (from rev 1223, trunk/projects/approx/trunk/approx.conf.5)
Copied: trunk/projects/approx/approx.ml (from rev 1223, trunk/projects/approx/trunk/approx.ml)
Copied: trunk/projects/approx/config.ml (from rev 1223, trunk/projects/approx/trunk/config.ml)
Copied: trunk/projects/approx/config.mli (from rev 1223, trunk/projects/approx/trunk/config.mli)
Copied: trunk/projects/approx/debian (from rev 1223, trunk/projects/approx/trunk/debian)
Modified: trunk/projects/approx/debian/changelog
===================================================================
--- trunk/projects/approx/trunk/debian/changelog 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/debian/changelog 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,3 +1,10 @@
+approx (1.08) unstable; urgency=low
+
+ * Removed trunk directory layer
+ * Add build-dependency on ocaml-tools (CLOSES #303774)
+
+ -- Eric Cooper <ecc@cmu.edu> Fri, 8 Apr 2005 14:57:43 -0400
+
approx (1.07) unstable; urgency=low
* Eliminate timeout for approx daemon callbacks
Modified: trunk/projects/approx/debian/control
===================================================================
--- trunk/projects/approx/trunk/debian/control 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/debian/control 2005-04-08 18:59:28 UTC (rev 1224)
@@ -3,7 +3,7 @@
Priority: optional
Maintainer: Eric Cooper <ecc@cmu.edu>
Uploaders: Sven Luther <luther@debian.org>
-Build-Depends: debhelper, ocaml-nox-3.08.3, libsyslog-ocaml-dev, libhttp-ocaml-dev, libocamlnet-ocaml-dev, libpcre-ocaml-dev, libcurl-ocaml-dev
+Build-Depends: debhelper, ocaml-nox-3.08.3, ocaml-tools, libsyslog-ocaml-dev, libhttp-ocaml-dev, libocamlnet-ocaml-dev, libpcre-ocaml-dev, libcurl-ocaml-dev
Standards-Version: 3.6.1
Package: approx
Copied: trunk/projects/approx/default_config.ml (from rev 1223, trunk/projects/approx/trunk/default_config.ml)
Copied: trunk/projects/approx/default_config.mli (from rev 1223, trunk/projects/approx/trunk/default_config.mli)
Copied: trunk/projects/approx/gc_approx.8 (from rev 1223, trunk/projects/approx/trunk/gc_approx.8)
Copied: trunk/projects/approx/gc_approx.ml (from rev 1223, trunk/projects/approx/trunk/gc_approx.ml)
Copied: trunk/projects/approx/package.ml (from rev 1223, trunk/projects/approx/trunk/package.ml)
Copied: trunk/projects/approx/package.mli (from rev 1223, trunk/projects/approx/trunk/package.mli)
Deleted: trunk/projects/approx/trunk/Makefile
===================================================================
--- trunk/projects/approx/trunk/Makefile 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/Makefile 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,32 +0,0 @@
-# approx: proxy server for Debian archive files
-# Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
-# Released under the GNU General Public License
-
-export OCAMLMAKEFILE = /usr/share/ocaml-tools/OCamlMakefile
-
-export OCAMLFLAGS = -w A
-
-define PROJ_server
- SOURCES = util.ml config.ml default_config.ml url.ml approx.ml
- LIBS = unix pcre syslog netstring http curl
- INCDIRS = +pcre +syslog +netstring +http +curl
- RESULT = approx
-endef
-export PROJ_server
-
-define PROJ_gc
- SOURCES = util.ml config.ml default_config.ml package.ml gc_approx.ml
- LIBS = unix pcre
- INCDIRS = +pcre
- RESULT = gc_approx
-endef
-export PROJ_gc
-
-ifndef SUBPROJS
- export SUBPROJS = server gc
-endif
-
-all: native-code
-
-%:
- @$(MAKE) -f $(OCAMLMAKEFILE) subprojs SUBTARGET=$@
Deleted: trunk/projects/approx/trunk/approx.8
===================================================================
--- trunk/projects/approx/trunk/approx.8 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/approx.8 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,102 +0,0 @@
-.\" approx: proxy server for Debian archive files
-.\" Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
-.\" Released under the GNU General Public License
-.\" -*- nroff -*-
-.TH APPROX 8 "January 2005"
-.\" Please adjust this date whenever revising the manpage.
-
-.SH NAME
-approx \- proxy server for Debian archive files
-
-.SH SYNOPSIS
-.PP
-.B approx
-
-.SH DESCRIPTION
-.B approx
-listens for HTTP requests made by
-.BR apt\-get (8).
-It maintains a cache of Debian archive files that have been previously
-downloaded, so that it can respond with a local copy when possible.
-If a file not in the cache is requested,
-.B approx
-will download it from a remote Debian repository and deliver the
-contents to the client, simultaneously caching it for future use.
-
-Over time, the
-.B approx
-server cache will grow to contain multiple, unneeded versions of
-Debian packages. The
-.BR gc_approx (8)
-program removes these from the cache.
-
-.SH EXAMPLES
-By default,
-.B approx
-listens on port 9999 (for compatibility with
-.BR apt\-cache (8)).
-Suppose that a client machine's
-.I /etc/apt/sources.list
-file contains the following lines:
-.IP
-deb http://apt:9999/debian testing main contrib
-.br
-deb http://apt:9999/misc testing main
-.br
-deb-src http://apt:9999/debian unstable main contrib
-.PP
-In this example,
-.I apt
-is the hostname of the
-.B approx
-server machine on the local network.
-Each distribution, such as "debian" or "misc", is mapped
-to a remote repository in the
-.B approx
-server's configuration file.
-.PP
-For example, the
-.I approx.conf
-file on the
-.B approx
-server might contain the lines
-.IP
-debian http://debian.mirrors.pair.com
-.br
-misc ftp://ftp.nerim.net/debian-marillat
-
-.SH FILES
-.TP
-.I /etc/approx/approx.conf
-.br
-Configuration file for
-.B approx
-and
-.BR gc_approx .
-.TP
-.I /var/cache/approx
-.br
-Cache directory for archive files.
-
-.SH SEE ALSO
-.IR approx.conf (5),
-.BR gc_approx (8),
-.BR apt\-get (8),
-.IR sources.list (5)
-
-.SH BUGS
-.PP
-When a client uses
-.BR apt\-get (8)
-to install a package that is not in the
-.B approx
-server's cache,
-the transfer will occasionally fail with an MD5 checksum error.
-In all of the cases the author has observed, the file has been cached
-correctly on the server,
-and re-running
-.BR apt\-get (8)
-solves the problem.
-
-.SH AUTHOR
-Eric Cooper <ecc@cmu.edu>
Deleted: trunk/projects/approx/trunk/approx.conf
===================================================================
--- trunk/projects/approx/trunk/approx.conf 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/approx.conf 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,21 +0,0 @@
-# The following are the defaults, so there is no need
-# to uncomment them unless you want a different value.
-
-#port 9999
-#cache /var/cache/approx
-#interval 720
-#debug false
-
-# Here are some examples of remote repository mappings.
-
-#debian http://debian.mirrors.pair.com
-#non-US http://debian.teleglobe.net/non-US
-#security http://security.debian.org/debian-security
-
-#approx http://www.cs.cmu.edu/~ecc
-#misc ftp://ftp.nerim.net/debian-marillat
-#motion http://sentinel.dk/debian
-#mythtv http://dijkstra.csh.rit.edu/~mdz/debian
-#ppc-misc http://honk.physik.uni-konstanz.de/~agx/linux-ppc/debian
-#sis http://www.winischhofer.net/sis/debian/unstable
-#thinkpad http://debian.isg.ee.ethz.ch/public
Deleted: trunk/projects/approx/trunk/approx.conf.5
===================================================================
--- trunk/projects/approx/trunk/approx.conf.5 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/approx.conf.5 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,51 +0,0 @@
-.\" approx: proxy server for Debian archive files
-.\" Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
-.\" Released under the GNU General Public License
-.\" -*- nroff -*-
-.TH APPROX.CONF 5 "January 2005"
-.\" Please adjust this date whenever revising the manpage.
-
-.SH NAME
-approx.conf \- configuration file for approx proxy server
-
-.SH SYNOPSIS
-.PP
-/etc/approx/approx.conf
-
-.SH DESCRIPTION
-.PP
-Each non-blank line of the configuration file should contain
-a name/value pair, separated by white space.
-Comments start with a "#" character and continue to the end of the line.
-.PP
-The following names have special meaning:
-.IP port
-Specifies the TCP port on which the
-.BR approx (8)
-server listens for HTTP requests (default: 9999)
-.IP cache
-Specifies the directory used to cache downloaded Debian archive files
-(default:
-.IR /var/cache/approx )
-.IP interval
-Specifies the time in minutes after which a cached file will be
-considered too old to deliver without first checking with the remote
-repository for a newer version (default: 720, or 12 hours)
-.IP debug
-Specifies whether debugging messages should be printed
-(default:
-.BR false )
-.PP
-The other name/value pairs are used to map distribution names
-to remote repositories. For example,
-.IP
-debian http://debian.mirrors.pair.com
-.br
-security http://security.debian.org/debian-security
-
-.SH SEE ALSO
-.BR approx (8),
-.BR gc_approx (8)
-
-.SH AUTHOR
-Eric Cooper <ecc@cmu.edu>
Deleted: trunk/projects/approx/trunk/approx.ml
===================================================================
--- trunk/projects/approx/trunk/approx.ml 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/approx.ml 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,349 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
- Released under the GNU General Public License *)
-
-open Util
-open Default_config
-open Http_daemon
-open Printf
-
-let prog = Filename.basename Sys.argv.(0)
-
-let log = Syslog.openlog ~facility: `LOG_DAEMON prog
-
-let message fmt = kprintf (Syslog.syslog log `LOG_INFO) fmt
-
-let print_config () =
- let units u = function
- | 0 -> ""
- | 1 -> sprintf " 1 %s" u
- | n -> sprintf " %d %ss" n u
- in
- message "Config file: %s" config_file;
- message "Port: %d" port;
- message "Cache: %s" cache;
- message "Interval:%s%s"
- (units "hour" (interval / 60)) (units "minute" (interval mod 60));
- message "Debug: %B" debug
-
-let http_time t = Netdate.format ~fmt: "%a, %d %b %Y %T GMT" (Netdate.create t)
-
-let string_of_time = http_time
-
-let copy ~src ~dst =
- let len = 4096 in
- let buf = String.create len in
- let rec loop () =
- match input src buf 0 len with
- | 0 -> ()
- | n -> output dst buf 0 n; loop ()
- in
- loop ()
-
-let response_headers ?(msg = "Local") code headers chan =
- if debug then
- begin
- message "%s response: %d" msg code;
- List.iter (fun (x, y) -> message " %s: %s" x y) headers
- end;
- send_basic_headers chan ~code: (`Code code);
- send_headers chan ~headers;
- send_CRLF chan
-
-let content_headers file_name =
- if Filename.check_suffix file_name ".gz" then
- [ "Content-Type", "application/x-gzip";
- "Content-Encoding", "x-gzip" ]
- else
- [ "Content-Type", "text/plain" ]
-
-let proxy_headers file_name length =
- response_headers 200
- (content_headers file_name @ [ "Content-Length", string_of_int length ])
-
-let respond_not_modified =
- response_headers 304 []
-
-let relay_headers code headers =
- response_headers (int_of_string code) headers ~msg: "HTTP proxy"
-
-let ftp_headers file_name =
- response_headers 200 (content_headers file_name) ~msg: "FTP proxy"
-
-let is_mutable name =
- not (Filename.check_suffix name ".deb")
-
-let minutes_old stats =
- int_of_float ((Unix.time () -. stats.Unix.st_ctime) /. 60. +. 0.5)
-
-let ims_time headers =
- let rec loop = function
- | [] -> raise Not_found
- | (name, value) :: rest ->
- if name = "if-modified-since" then value
- else loop rest
- in
- try Netdate.parse_epoch (loop headers)
- with Not_found | Invalid_argument _ -> 0.
-
-let is_stale name stats =
- stats.Unix.st_kind <> Unix.S_REG ||
- (is_mutable name && minutes_old stats > interval)
-
-let serve_local dir path ims ochan =
- let name = cache ^/ dir ^/ path in
- let stats = Unix.stat name in
- if debug then
- begin
- message "%s" name;
- let age = minutes_old stats in
- message " %d minute%s old" age (if age = 1 then "" else "s");
- message " ims %s mtime %s"
- (string_of_time ims) (string_of_time stats.Unix.st_mtime)
- end;
- if is_stale name stats then
- raise Not_found
- else if stats.Unix.st_mtime <= ims then
- respond_not_modified ochan
- else
- let ichan = open_in name in
- if not debug then message "%s" name;
- proxy_headers name stats.Unix.st_size ochan;
- copy ~src: ichan ~dst: ochan;
- close_in ichan
-
-let make_directory path =
- let rec loop cwd = function
- | dir :: rest ->
- let name = cwd ^/ dir in
- begin
- try
- if (Unix.stat name).Unix.st_kind <> Unix.S_DIR then
- failwith (name ^ " exists but is not a directory")
- with
- Unix.Unix_error (Unix.ENOENT, "stat", _) -> Unix.mkdir name 0o755
- end;
- loop name rest
- | [] -> ()
- in
- match explode_path path with
- | "" :: dirs -> loop "/" dirs
- | dirs -> loop "." dirs
-
-let create_file path =
- make_directory (Filename.dirname path);
- open_out path
-
-let cache_chan = ref None
-let cache_file = ref ""
-
-let open_cache name =
- assert (!cache_chan = None && !cache_file = "");
- try
- if debug then message " open cache %s" name;
- (* use a ".tmp" suffix in case the download is interrupted *)
- cache_chan := Some (create_file (name ^ ".tmp"));
- cache_file := name
- with e ->
- message "Cannot cache %s (reason: %s)" name (Printexc.to_string e)
-
-let write_cache str =
- match !cache_chan with
- | Some ch -> output_string ch str
- | None -> ()
-
-let close_cache t =
- match !cache_chan with
- | Some ch ->
- if debug then message " close cache %s" !cache_file;
- close_out ch;
- Sys.rename (!cache_file ^ ".tmp") !cache_file;
- if t <> 0. then
- begin
- if debug then
- message " setting mtime to %s" (string_of_time t);
- Unix.utimes !cache_file t t
- end;
- cache_chan := None;
- cache_file := ""
- | None -> ()
-
-let remove_cache () =
- let name = !cache_file in
- close_cache 0.;
- if name <> "" then
- begin
- message "Removing %s" name;
- Sys.remove name
- end
-
-(* Update the ctime but not the mtime of the file, if it exists *)
-
-let update_ctime name =
- try
- let stats = Unix.stat name in
- let now = Unix.time () in
- if debug then
- message " updating ctime to %s" (string_of_time now);
- Unix.utimes name stats.Unix.st_mtime now
- with Unix.Unix_error (Unix.ENOENT, "stat", _) -> ()
-
-let map_dir dir =
- try Config.get dir
- with Not_found ->
- message "No mapping for %s" dir;
- raise Not_found
-
-let print_header str =
- let n = String.length str in
- if n >= 2 && str.[n-2] = '\r' && str.[n-1] = '\n' then
- (if n > 2 then message " %s" (substring str ~until: (n-2)))
- else
- message "No CRLF in header: %s" str
-
-let status_re = Pcre.regexp "^HTTP/\\d+\\.\\d+ (\\d{3}) (.*?)\\s*\\r\\n"
-let header_re = Pcre.regexp "^(.*?):\\s*(.*?)\\s*\\r\\n"
-
-let with_pair rex str proc =
- match Pcre.extract ~rex ~full_match: false str with
- | [| a; b |] ->
- assert (not (String.contains b '\r' || String.contains b '\n'));
- proc (a, b)
- | _ ->
- assert false
-
-let serve_http url local_name ims chan =
- let headers = ref [] in
- let last_modified = ref 0. in
- let add_header (header, value as pair) =
- match String.lowercase header with
- | "content-encoding" | "content-length" | "content-type"
- | "date" | "server" ->
- headers := pair :: !headers
- | "last-modified" ->
- headers := pair :: !headers;
- (try last_modified := Netdate.parse_epoch value;
- with Invalid_argument _ ->
- message "Cannot parse last-modified date %s" value)
- | _ -> ()
- in
- let status = ref "" in
- let do_status (code, _) =
- status := code;
- if code = "304" then update_ctime local_name (* not modified *)
- in
- let header =
- if ims > 0. then Some ("If-Modified-Since: " ^ http_time ims) else None
- in
- let header_callback str =
- if debug then print_header str;
- try with_pair header_re str add_header
- with Not_found -> (* e.g., status line or CRLF *)
- try with_pair status_re str do_status
- with Not_found ->
- if str <> "\r\n" then message "Unrecognized response: %s" str
- in
- let body_seen = ref false in
- let body_callback str =
- if not !body_seen then
- begin
- body_seen := true;
- relay_headers !status (List.rev !headers) chan;
- if !status = "200" then open_cache local_name
- end;
- output_string chan str;
- write_cache str
- in
- Url.iter url ?header ~header_callback body_callback;
- close_cache !last_modified;
- if not !body_seen then
- relay_headers !status (List.rev !headers) chan
-
-let serve_ftp url local_name ims chan =
- let body_seen = ref false in
- let body_callback str =
- if not !body_seen then
- begin
- body_seen := true;
- ftp_headers local_name chan;
- open_cache local_name
- end;
- output_string chan str;
- write_cache str
- in
- Url.iter url body_callback;
- close_cache 0.;
- if not !body_seen then
- ftp_headers local_name chan
-
-let method_of_url url =
- let meth =
- try String.lowercase (substring url ~until: (String.index url ':'))
- with Not_found ->
- message "No method in URL: %s" url;
- raise Not_found
- in
- match meth with
- | "http" -> serve_http
- | "ftp" -> serve_ftp
- | m ->
- message "Unsupported URL method: %s" m;
- raise Not_found
-
-let serve_remote dir path ims chan =
- try
- let url = map_dir dir ^/ path in
- message "%s" url;
- let local_name = cache ^/ dir ^/ path in
- let handler = method_of_url url in
- handler url local_name ims chan
- with e ->
- remove_cache ();
- message "%s" (Printexc.to_string e);
- respond_not_found ~url: path chan
-
-(* Split absolute path into top-level directory and rest of path.
- Example: split_path "/a/b/c" = ("a", "b/c") *)
-
-let split_path path =
- match explode_path path with
- | "" :: head :: tail -> head, implode_path tail
- | _ -> failwith ("split_path: " ^ path)
-
-let serve_file path headers chan =
- try
- if debug then
- begin
- message "Request %s" path;
- List.iter (fun (x, y) -> message " %s: %s" x y) headers
- end;
- let dir, path = split_path path in
- let ims = ims_time headers in
- try serve_local dir path ims chan
- with _ -> serve_remote dir path ims chan
- with Failure _ ->
- respond_forbidden ~url: path chan
-
-let callback req chan =
- message "Connection from %s" req#clientAddr;
- match req#params with
- | [] -> serve_file req#path req#headers chan
- | _ -> respond_forbidden ~url: req#path chan
-
-let daemon () =
- print_config ();
- main (daemon_spec ~port ~callback ~mode: `Single ~timeout: None ())
-
-let write_pid_file pid =
- let chan = open_out ("/var/run" ^/ prog ^ ".pid") in
- fprintf chan "%d\n" pid;
- close_out chan
-
-let () =
- match Unix.fork () with
- | 0 ->
- (match Unix.fork () with
- | 0 -> daemon ()
- | grandchild -> write_pid_file grandchild)
- | child ->
- ignore (Unix.waitpid [] child)
Deleted: trunk/projects/approx/trunk/config.ml
===================================================================
--- trunk/projects/approx/trunk/config.ml 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/config.ml 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,58 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
- Released under the GNU General Public License *)
-
-let lines_of_channel chan =
- let next () =
- try Some (input_line chan)
- with End_of_file -> None
- in
- let rec loop list =
- match next () with
- | Some line -> loop (line :: list)
- | None -> List.rev list
- in
- loop []
-
-let comment_re = Pcre.regexp "\\s*#.*$"
-
-let remove_comment str = Pcre.qreplace ~rex: comment_re str ~templ: ""
-
-let words_of_line line = Pcre.split (remove_comment line)
-
-let map = ref []
-
-let get_generic convert ?default k =
- try convert (List.assoc k !map)
- with Not_found ->
- (match default with
- | Some v -> v
- | None -> raise Not_found)
-
-let get = get_generic (fun x -> x)
-
-let get_int = get_generic int_of_string
-
-let bool_of_string str =
- match String.lowercase str with
- | "true" | "yes" | "on" | "1" -> true
- | "false" | "no" | "off" | "0" -> false
- | _ -> failwith ("not a boolean value: " ^ str)
-
-let get_bool = get_generic bool_of_string
-
-let set key value = map := (key, value) :: !map
-
-let iter f = List.iter (fun (k, v) -> f k v) !map
-
-let read filename =
- let chan = open_in filename in
- let lines = List.map words_of_line (lines_of_channel chan) in
- close_in chan;
- let enter = function
- | [ key; value ] -> set key value
- | [] -> ()
- | words -> failwith ("malformed line in " ^ filename ^ ": " ^
- String.concat " " words)
- in
- List.iter enter lines
Deleted: trunk/projects/approx/trunk/config.mli
===================================================================
--- trunk/projects/approx/trunk/config.mli 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/config.mli 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,13 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
- Released under the GNU General Public License *)
-
-val read : string -> unit
-
-val get : ?default:string -> string -> string
-val get_int : ?default:int -> string -> int
-val get_bool : ?default:bool -> string -> bool
-
-val set : string -> string -> unit
-
-val iter : (string -> string -> unit) -> unit
Deleted: trunk/projects/approx/trunk/default_config.ml
===================================================================
--- trunk/projects/approx/trunk/default_config.ml 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/default_config.ml 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,14 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
- Released under the GNU General Public License *)
-
-open Config
-
-let config_file = "/etc/approx/approx.conf"
-
-let () = read config_file
-
-let cache = get "cache" ~default: "/var/cache/approx"
-let port = get_int "port" ~default: 9999
-let interval = get_int "interval" ~default: 720 (* minutes *)
-let debug = get_bool "debug" ~default: false
Deleted: trunk/projects/approx/trunk/default_config.mli
===================================================================
--- trunk/projects/approx/trunk/default_config.mli 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/default_config.mli 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,9 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
- Released under the GNU General Public License *)
-
-val config_file : string
-val cache : string
-val port : int
-val interval : int
-val debug : bool
Deleted: trunk/projects/approx/trunk/gc_approx.8
===================================================================
--- trunk/projects/approx/trunk/gc_approx.8 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/gc_approx.8 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,80 +0,0 @@
-.\" approx: proxy server for Debian archive files
-.\" Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
-.\" Released under the GNU General Public License
-.\" -*- nroff -*-
-.TH GC_APPROX 8 "January 2005"
-.\" Please adjust this date whenever revising the manpage.
-
-.SH NAME
-gc_approx \- garbage-collect the cache of Debian archive files
-
-.SH SYNOPSIS
-.PP
-.B gc_approx
-[\fIOPTION\fP]...
-
-.SH DESCRIPTION
-.PP
-.B gc_approx
-scans the cache created by
-.BR approx (8)
-and finds files that are corrupted or no longer needed.
-With no options specified, these files
-are listed on standard output and removed from the cache.
-.PP
-A corrupted file is one whose size or MD5 checksum
-does not match the value specified in the
-.I Packages
-file.
-An unneeded file is one that is not referenced from any distribution's
-.I Packages
-file.
-.PP
-.B gc_approx
-may take several minutes to finish.
-
-.SH OPTIONS
-.TP
-.BR \-f ", " \-\^\-fast
-MD5 checksum validation is not performed.
-.TP
-.BR \-k ", " \-\^\-keep
-Files are not removed from the cache.
-.TP
-.BR \-q ", " \-\^\-quiet
-File names are not printed.
-
-.SH EXAMPLES
-.IP
-gc_approx \-\^\-quiet
-.PP
-removes all unneeded or corrupted files from the cache.
-This is run as a weekly
-.BR cron (8)
-job.
-.IP
-gc_approx \-\^\-keep
-.PP
-lists the files that would be removed from the cache,
-without actually doing so.
-
-.SH FILES
-.TP
-.I /etc/approx/approx.conf
-.br
-Configuration file for
-.B approx
-and
-.BR gc_approx .
-.TP
-.I /var/cache/approx
-.br
-Cache directory for archive files.
-
-.SH SEE ALSO
-.IR approx.conf (5),
-.BR approx (8),
-.BR cron (8)
-
-.SH AUTHOR
-Eric Cooper <ecc@cmu.edu>
Deleted: trunk/projects/approx/trunk/gc_approx.ml
===================================================================
--- trunk/projects/approx/trunk/gc_approx.ml 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/gc_approx.ml 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,112 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
- Released under the GNU General Public License *)
-
-open Util
-open Default_config
-
-let usage () =
- prerr_endline "Usage: gc_approx [options]";
- prerr_endline "Garbage-collect the approx cache.";
- prerr_endline "Options:";
- prerr_endline " -f|--fast do not validate MD5 checksums";
- prerr_endline " -k|--keep do not remove files";
- prerr_endline " -q|--quiet do not print file names";
- exit 1
-
-let checksum = ref true
-let verbose = ref true
-let remove = ref true
-
-let () =
- for i = 1 to Array.length Sys.argv - 1 do
- match Sys.argv.(i) with
- | "-f" | "--fast" -> checksum := false
- | "-k" | "--keep" -> remove := false
- | "-q" | "--quiet" -> verbose := false
- | _ -> usage ()
- done
-
-let rec treewalk proc path =
- let visit name =
- let path = path ^/ name in
- if (Unix.stat path).Unix.st_kind = Unix.S_DIR then
- treewalk proc path
- else
- proc path
- in
- Array.iter visit (try Sys.readdir path with Sys_error _ -> [||])
-
-let packages = ref []
-
-let find_roots () =
- let find file =
- match Filename.basename file with
- | "Packages" | "Packages.gz" -> packages := file :: !packages
- | _ -> ()
- in
- Config.iter (fun dir _ -> treewalk find (cache ^/ dir))
-
-let files = Hashtbl.create 4096
-
-let record_files () =
- let record file =
- match Filename.basename file with
- | "Packages" | "Packages.gz"
- | "Release" | "Release.gz"
- | "Sources" | "Sources.gz" ->
- () (* never consider these for garbage collection *)
- | _ ->
- Hashtbl.replace files file false
- in
- treewalk record cache
-
-let dist_prefix path =
- let n = String.length cache in
- try substring path ~until: (String.index_from path (n+1) '/')
- with Not_found -> failwith ("unexpected pathname: " ^ path)
-
-let canonical path =
- if String.length path >= 2 && path.[0] = '.' && path.[1] = '/' then
- substring path ~from: 2
- else
- path
-
-let mark_file prefix fields =
- let file = canonical (List.assoc "filename" fields) in
- let size = int_of_string (List.assoc "size" fields) in
- let md5sum = List.assoc "md5sum" fields in
- let path = prefix ^/ file in
- let check_size () =
- (Unix.stat path).Unix.st_size = size
- in
- let check_md5sum () =
- not !checksum || Digest.to_hex (Digest.file path) = md5sum
- in
- try
- if check_size () && check_md5sum () then
- Hashtbl.replace files path true
- with
- Unix.Unix_error (Unix.ENOENT, "stat", _) -> ()
-
-let mark_package package =
- Package.iter (mark_file (dist_prefix package)) package
-
-let mark () =
- find_roots ();
- record_files ();
- List.iter mark_package !packages
-
-let sweep () =
- let garbage_collect file marked =
- if not marked then
- begin
- if !verbose then print_endline file;
- if !remove then Sys.remove file
- end
- in
- Hashtbl.iter garbage_collect files
-
-let () =
- mark ();
- sweep ()
Deleted: trunk/projects/approx/trunk/package.ml
===================================================================
--- trunk/projects/approx/trunk/package.ml 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/package.ml 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,63 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
- Released under the GNU General Public License *)
-
-let uncompress file =
- let command = Printf.sprintf "/bin/gzip --decompress --stdout %s" file in
- Unix.open_process_in command
-
-let with_package_file file proc =
- let input =
- if Filename.check_suffix file ".gz" then
- uncompress file
- else
- open_in file
- in
- try
- proc input;
- close_in input
- with e ->
- close_in input;
- raise e
-
-let parse line =
- let rec lskip i =
- if line.[i] <> ' ' then i else lskip (i + 1)
- in
- let rec rskip i =
- if line.[i] <> ' ' then i else rskip (i - 1)
- in
- let i = String.index line ':' in
- let name = String.lowercase (String.sub line 0 i) in
- let i = lskip (i + 1) in
- let j = rskip (String.length line - 1) in
- let info = String.sub line i (j - i + 1) in
- name, info
-
-let read_paragraph input =
- let rec loop lines =
- let line = input_line input in
- if line = "" then lines
- else if line.[0] = ' ' then
- (* line with leading space should be concatenated with previous line
- but we just ignore it here *)
- loop lines
- else
- loop (parse line :: lines)
- in
- loop [] (* reverse order doesn't matter *)
-
-let read proc input =
- let next () =
- try Some (read_paragraph input)
- with End_of_file -> None
- in
- let rec loop () =
- match next () with
- | Some p -> proc p; loop ()
- | None -> ()
- in
- loop ()
-
-let iter proc file =
- with_package_file file (read proc)
Deleted: trunk/projects/approx/trunk/package.mli
===================================================================
--- trunk/projects/approx/trunk/package.mli 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/package.mli 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,5 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
- Released under the GNU General Public License *)
-
-val iter : ((string * string) list -> unit) -> string -> unit
Deleted: trunk/projects/approx/trunk/url.ml
===================================================================
--- trunk/projects/approx/trunk/url.ml 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/url.ml 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,24 +0,0 @@
-(* URL access in OCaml using Curl
- Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
- Released under the GNU Lesser General Public License *)
-
-let () = Curl.global_init Curl.CURLINIT_GLOBALALL
-
-let iter url ?header ?header_callback callback =
- let connection = Curl.init () in
- Curl.set_followlocation connection true;
- Curl.set_connecttimeout connection 10;
- Curl.set_url connection url;
- (match header with
- | Some str -> Curl.set_httpheader connection [str]
- | None -> ());
- (match header_callback with
- | Some proc -> Curl.set_headerfunction connection proc
- | None -> ());
- Curl.set_writefunction connection callback;
- try
- Curl.perform connection;
- Curl.cleanup connection
- with Curl.CurlException (_, _, msg) ->
- Curl.cleanup connection;
- failwith msg
Deleted: trunk/projects/approx/trunk/url.mli
===================================================================
--- trunk/projects/approx/trunk/url.mli 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/url.mli 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,6 +0,0 @@
-(* URL access in OCaml using Curl
- Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
- Released under the GNU Lesser General Public License *)
-
-val iter : string -> ?header:string -> ?header_callback:(string -> unit) ->
- (string -> unit) -> unit
Deleted: trunk/projects/approx/trunk/util.ml
===================================================================
--- trunk/projects/approx/trunk/util.ml 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/util.ml 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,26 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
- Released under the GNU General Public License *)
-
-let substring ?(from=0) ?until str =
- let i = from in
- let j =
- match until with
- | Some n -> n
- | None -> String.length str
- in
- String.sub str i (j-i)
-
-let explode_path path =
- let rec loop acc i =
- try
- let j = String.index_from path i '/' in
- loop (substring path ~from: i ~until: j :: acc) (j+1)
- with Not_found ->
- substring path ~from: i :: acc
- in
- List.rev (loop [] 0)
-
-let implode_path = String.concat "/"
-
-let (^/) = Filename.concat
Deleted: trunk/projects/approx/trunk/util.mli
===================================================================
--- trunk/projects/approx/trunk/util.mli 2005-04-08 18:38:32 UTC (rev 1223)
+++ trunk/projects/approx/trunk/util.mli 2005-04-08 18:59:28 UTC (rev 1224)
@@ -1,21 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2005 Eric C. Cooper <ecc@cmu.edu>
- Released under the GNU General Public License *)
-
-(* Create substring s.[from] .. s.[until-1] *)
-
-val substring : ?from:int -> ?until:int -> string -> string
-
-(* Split pathname into list of components.
- Initial and final "/" map to empty strings;
- "/" by itself maps to [""; ""] *)
-
-val explode_path : string -> string list
-
-(* Inverse of explode_path. *)
-
-val implode_path : string list -> string
-
-(* Infix operator to concatenate two pathname components. *)
-
-val (^/) : string -> string -> string
Copied: trunk/projects/approx/url.ml (from rev 1223, trunk/projects/approx/trunk/url.ml)
Copied: trunk/projects/approx/url.mli (from rev 1223, trunk/projects/approx/trunk/url.mli)
Copied: trunk/projects/approx/util.ml (from rev 1223, trunk/projects/approx/trunk/util.ml)
Copied: trunk/projects/approx/util.mli (from rev 1223, trunk/projects/approx/trunk/util.mli)