[Pkg-ocaml-maint-commits] [SCM] approx upstream and debian packaging branch, master, updated. upstream/3.5-103-g447143e
Eric Cooper
ecc at cmu.edu
Wed Mar 11 20:14:51 UTC 2009
The following commit has been merged in the master branch:
commit 97f0280562444ea6a369282de1710803f7e14088
Author: Eric Cooper <ecc at cmu.edu>
Date: Sun Mar 8 14:55:13 2009 -0400
change approx to run under inetd
eliminate code for listening, libwrap, daemonizing
diff --git a/_tags b/_tags
index 5718d61..f1f9cd1 100644
--- a/_tags
+++ b/_tags
@@ -15,4 +15,4 @@
<**/*.{byte,native}>: use_unix, use_pcre, use_sha
<*.{byte,native}>: use_syslog, use_netsys, use_netstring
-<approx.{byte,native}>: use_netcgi, use_nethttpd-for-netcgi2, use_libapprox
+<approx.{byte,native}>: use_netcgi, use_nethttpd-for-netcgi2
diff --git a/approx.ml b/approx.ml
index 0917f70..ecaa6bb 100644
--- a/approx.ml
+++ b/approx.ml
@@ -1,8 +1,6 @@
-(* approx: proxy server for Debian archive files *)
-
-let copyright =
- "Copyright (C) 2009 Eric C. Cooper <ecc at cmu.edu>\n\
- Released under the GNU General Public License"
+(* approx: proxy server for Debian archive files
+ Copyright (C) 2009 Eric C. Cooper <ecc at cmu.edu>
+ Released under the GNU General Public License *)
open Printf
open Unix
@@ -11,31 +9,6 @@ open Util
open Config
open Log
-let usage () =
- prerr_endline
- "Usage: approx [options]
-Proxy server for Debian archive files
-
-Options:
- -f|--foreground remain in foreground instead of detaching
- -v|--version display version information and exit";
- exit 1
-
-let version () =
- eprintf "%s %s\n" Version.name Version.number;
- prerr_endline copyright;
- exit 0
-
-let foreground = ref false
-
-let () =
- for i = 1 to Array.length Sys.argv - 1 do
- match Sys.argv.(i) with
- | "-f" | "--foreground" -> foreground := true
- | "-v" | "--version" -> version ()
- | _ -> usage ()
- done
-
let stat_file name = try Some (stat name) with Unix_error _ -> None
(* Hint that a download is in progress *)
@@ -479,32 +452,47 @@ let process_header env =
forbidden "invalid HTTP request"
end
-let server sockets =
- info_message "Version: %s" Version.number;
- print_config (info_message "%s");
- Server.loop sockets
- (object
- method name = "proxy_service"
- method def_term = `Proxy_service
- method print fmt = Format.fprintf fmt "%s" "proxy_service"
- method process_header = process_header
- end)
-
-let daemonize proc x =
- ignore (setsid ());
- use_syslog ();
- List.iter close [stdin; stdout; stderr];
- (* double fork to detach daemon *)
- if fork () = 0 && fork () = 0 then
- proc x
+let error_response code =
+ let msg =
+ try Nethttp.string_of_http_status (Nethttp.http_status_of_int code)
+ with Not_found -> "???"
+ in
+ sprintf "<html><title>%d %s</title><body><h1>%d: %s</h1></body></html>"
+ code msg code msg
+
+let version = Version.name ^ "/" ^ Version.number
+
+let config =
+ object
+ (* http_protocol_config *)
+ method config_max_reqline_length = 256
+ method config_max_header_length = 32768
+ method config_max_trailer_length = 32768
+ method config_limit_pipeline_length = 5
+ method config_limit_pipeline_size = 250000
+ method config_announce_server = `Ocamlnet_and version
+ (* http_processor_config *)
+ method config_timeout_next_request = 15.
+ method config_timeout = 300.
+ method config_cgi = Netcgi1_compat.Netcgi_env.default_config
+ method config_error_response n = error_response n
+ method config_log_error _ _ _ _ msg = error_message "%s" msg
+ (* http_reactor_config *)
+ method config_reactor_synch = `Write
+ end
+
+let proxy_service =
+ object
+ method name = "proxy_service"
+ method def_term = `Proxy_service
+ method print fmt = Format.fprintf fmt "%s" "proxy_service"
+ method process_header = process_header
+ end
let approx () =
- match Server.bind ~interface ~port with
- | [] -> failwith "no sockets created"
- | sockets ->
- drop_privileges ~user ~group;
- Sys.chdir cache_dir;
- if !foreground then server sockets
- else daemonize server sockets
+ check_id ~user ~group;
+ Sys.chdir cache_dir;
+ set_nonblock stdin;
+ Nethttpd_reactor.process_connection config stdin proxy_service
let () = main_program approx ()
diff --git a/config.ml b/config.ml
index d4228f5..877e5b1 100644
--- a/config.ml
+++ b/config.ml
@@ -1,5 +1,5 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2008 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2009 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
open Config_file
@@ -9,8 +9,6 @@ let cache_dir = "/var/cache/approx"
let () = try read config_file with Sys_error _ -> ()
-let interface = get "$interface" ~default: "any"
-let port = get_int "$port" ~default: 9999 (* compatible with apt-proxy *)
let max_rate = get "$max_rate" ~default: "unlimited"
let max_redirects = get_int "$max_redirects" ~default: 5
@@ -24,18 +22,3 @@ let max_wait = get_int "$max_wait" ~default: 10 (* seconds *)
let debug = get_bool "$debug" ~default: false
let verbose = get_bool "$verbose" ~default: false || debug
-
-let print_config f =
- let pf fmt = Printf.ksprintf f fmt in
- pf "Interface: %s" interface;
- pf "Port: %d" port;
- pf "Max rate: %s" max_rate;
- pf "Max redirects: %d" max_redirects;
- pf "User: %s" user;
- pf "Group: %s" group;
- pf "Syslog: %s" syslog;
- pf "Pdiffs: %B" pdiffs;
- pf "Offline: %B" offline;
- pf "Max wait: %d" max_wait;
- pf "Verbose: %B" verbose;
- pf "Debug: %B" debug
diff --git a/config.mli b/config.mli
index a82ea83..727d733 100644
--- a/config.mli
+++ b/config.mli
@@ -1,12 +1,10 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2008 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2009 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
val config_file : string
val cache_dir : string
-val interface : string
-val port : int
val max_rate : string (* bytes/second with optional K, M, or G suffix *)
val max_redirects : int
@@ -20,7 +18,3 @@ val max_wait : int (* seconds *)
val verbose : bool
val debug : bool
-
-(* Print the configuration by applying the given function to each line *)
-
-val print_config : (string -> unit) -> unit
diff --git a/libapprox.clib b/libapprox.clib
deleted file mode 100644
index c42dddb..0000000
--- a/libapprox.clib
+++ /dev/null
@@ -1,2 +0,0 @@
-libwrap.o
-netstubs.o
diff --git a/libwrap.c b/libwrap.c
deleted file mode 100644
index ba4e1f2..0000000
--- a/libwrap.c
+++ /dev/null
@@ -1,14 +0,0 @@
-/* approx: proxy server for Debian archive files
- Copyright (C) 2008 Eric C. Cooper <ecc at cmu.edu>
- Released under the GNU General Public License */
-
-#include <tcpd.h>
-#include <caml/memory.h>
-
-value
-wrap_hosts_ctl(value daemon, value host, value address, value user)
-{
- CAMLparam4(daemon, host, address, user);
- CAMLreturn(Val_int(hosts_ctl(String_val(daemon), String_val(host),
- String_val(address), String_val(user)) != 0));
-}
diff --git a/log.ml b/log.ml
index 3f8ce51..8b44c30 100644
--- a/log.ml
+++ b/log.ml
@@ -1,12 +1,13 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2008 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2009 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
open Printf
open Util
open Syslog
-let printer = ref (fun _ msg -> prerr_string msg; flush stderr)
+let facility = facility_of_string Config.syslog
+let log = openlog ~facility Version.name
let message enabled level =
(* ensure message is newline-terminated,
@@ -17,20 +18,8 @@ let message enabled level =
else if str.[n - 1] = '\n' then str
else str ^ "\n"
in
- ksprintf (fun str -> if enabled then !printer level (terminate str))
+ ksprintf (fun str -> if enabled then syslog log level (terminate str))
let error_message fmt = message true `LOG_ERR fmt
let info_message fmt = message Config.verbose `LOG_INFO fmt
let debug_message fmt = message Config.debug `LOG_DEBUG fmt
-
-let exception_message exc = error_message "%s" (string_of_exception exc)
-
-let facility = facility_of_string Config.syslog
-
-let use_syslog () =
- try
- let log = openlog ~facility Version.name in
- printer := syslog log
- with _ ->
- error_message "Cannot connect to system logger";
- printer := (fun _ -> ignore)
diff --git a/log.mli b/log.mli
index 3aa1986..80076de 100644
--- a/log.mli
+++ b/log.mli
@@ -1,9 +1,7 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2008 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2009 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
-val use_syslog : unit -> unit
-
val error_message : ('a, unit, string, unit) format4 -> 'a
val info_message : ('a, unit, string, unit) format4 -> 'a
val debug_message : ('a, unit, string, unit) format4 -> 'a
diff --git a/myocamlbuild.ml b/myocamlbuild.ml
index 9492288..5f93b8a 100644
--- a/myocamlbuild.ml
+++ b/myocamlbuild.ml
@@ -22,10 +22,6 @@ let add_library lib =
ocaml_lib ~extern: true ~dir: ("+" ^ inc) lib
let custom_rules () =
- flag ["ocamlmklib"; "c"] & S [A "-lwrap"];
- dep ["link"; "ocaml"; "use_libapprox"] ["libapprox.a"];
- flag ["link"; "ocaml"; "byte"; "use_libapprox"] & S [A "-dllib"; A "-lapprox"];
- flag ["link"; "ocaml"; "native"; "use_libapprox"] & S [A "-cclib"; A "-lwrap"];
List.iter add_library libraries
let () = dispatch (function After_rules -> custom_rules () | _ -> ())
diff --git a/netstubs.c b/netstubs.c
deleted file mode 100644
index 07c8780..0000000
--- a/netstubs.c
+++ /dev/null
@@ -1,60 +0,0 @@
-/* approx: proxy server for Debian archive files
- Copyright (C) 2008 Eric C. Cooper <ecc at cmu.edu>
- Released under the GNU General Public License */
-
-#include <string.h>
-#include <unistd.h>
-#include <net/if.h>
-#include <netinet/in.h>
-#include <sys/ioctl.h>
-
-static int
-ifaddr(char *name, /* OUT */ struct in_addr *addr)
-{
- struct ifreq ifr;
- int s, r;
-
- s = socket(AF_INET, SOCK_DGRAM, IPPROTO_IP);
- if (s == -1)
- return 0;
- strncpy(ifr.ifr_name, name, sizeof(ifr.ifr_name));
- ifr.ifr_addr.sa_family = AF_INET;
- r = ioctl(s, SIOCGIFADDR, &ifr);
- close(s);
- if (r == -1)
- return 0;
- *addr = ((struct sockaddr_in *) &ifr.ifr_addr)->sin_addr;
- return 1;
-}
-
-#include <caml/fail.h>
-#include <caml/memory.h>
-
-/*
- * defined in otherlibs/unix/socketaddr.c
- */
-extern value alloc_inet_addr(struct in_addr *);
-
-value
-interface_address(value name)
-{
- CAMLparam1(name);
- struct in_addr sin;
-
- if (ifaddr(String_val(name), &sin))
- CAMLreturn(alloc_inet_addr(&sin));
- else
- caml_raise_not_found();
-}
-
-value
-set_ipv6_only(value descr, value on_off)
-{
- CAMLparam2(descr, on_off);
- int fd = Int_val(descr);
- int v = Bool_val(on_off);
- if (setsockopt(fd, IPPROTO_IPV6, IPV6_V6ONLY, &v, sizeof(int)) == 0)
- CAMLreturn(Val_unit);
- else
- caml_failwith("set_ipv6_only");
-}
diff --git a/server.ml b/server.ml
deleted file mode 100644
index c6616b8..0000000
--- a/server.ml
+++ /dev/null
@@ -1,98 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2008 Eric C. Cooper <ecc at cmu.edu>
- Released under the GNU General Public License *)
-
-open Printf
-open Unix
-open Util
-open Log
-
-let error_response code =
- let msg =
- try Nethttp.string_of_http_status (Nethttp.http_status_of_int code)
- with Not_found -> "???"
- in
- sprintf "<html><title>%d %s</title><body><h1>%d: %s</h1></body></html>"
- code msg code msg
-
-let version = Version.name ^ "/" ^ Version.number
-
-let config =
- object
- (* http_protocol_config *)
- method config_max_reqline_length = 256
- method config_max_header_length = 32768
- method config_max_trailer_length = 32768
- method config_limit_pipeline_length = 5
- method config_limit_pipeline_size = 250000
- method config_announce_server = `Ocamlnet_and version
- (* http_processor_config *)
- method config_timeout_next_request = 15.
- method config_timeout = 300.
- method config_cgi = Netcgi1_compat.Netcgi_env.default_config
- method config_error_response n = error_response n
- method config_log_error _ _ _ _ msg = error_message "%s" msg
- (* http_reactor_config *)
- method config_reactor_synch = `Write
- end
-
-let address interface = function
- | PF_INET ->
- if interface = "any" || interface = "all" then inet_addr_any
- else begin try
- Network.interface_address interface
- with Not_found ->
- error_message "IP address for interface %s not found" interface;
- raise Not_found
- end
- | PF_INET6 ->
- if interface = "any" || interface = "all" then inet6_addr_any
- else begin
- error_message "Cannot use $interface parameter (%s) for IPv6" interface;
- raise Not_found
- end
- | _ -> failwith "invalid protocol family"
-
-let bind ~interface ~port =
- let add_socket list pf =
- try
- let sock = socket pf SOCK_STREAM 0 in
- if pf = PF_INET6 then Network.set_ipv6_only sock true;
- setsockopt sock SO_REUSEADDR true;
- Unix.bind sock (ADDR_INET (address interface pf, port));
- listen sock 10;
- sock :: list
- with
- | Unix_error (EAFNOSUPPORT, _, _) | Not_found ->
- list
- | e ->
- error_message "%s" (string_of_exception e);
- list
- in
- List.fold_left add_socket [] [PF_INET6; PF_INET]
-
-let loop sockets service =
- let process sock =
- let fd, ip = accept sock in
- let address = string_of_sockaddr ip ~with_port: false in
- if Tcp_wrappers.hosts_ctl Version.name ~address then
- match fork () with
- | 0 ->
- if fork () <> 0 then exit 0;
- close sock;
- set_nonblock fd;
- Nethttpd_reactor.process_connection config fd service;
- exit 0
- | pid ->
- close fd;
- ignore (waitpid [] pid)
- else begin
- close fd;
- debug_message "Connection from %s denied by TCP wrappers" address
- end
- in
- while true do
- match select sockets [] [] (-1.) with
- | [], _, _ -> failwith "no sockets selected"
- | ready, _, _ -> List.iter process ready
- done
diff --git a/server.mli b/server.mli
deleted file mode 100644
index cab3565..0000000
--- a/server.mli
+++ /dev/null
@@ -1,7 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2008 Eric C. Cooper <ecc at cmu.edu>
- Released under the GNU General Public License *)
-
-val bind : interface:string -> port:int -> Unix.file_descr list
-
-val loop : Unix.file_descr list -> 'a Nethttpd_types.http_service -> unit
diff --git a/tcp_wrappers.ml b/tcp_wrappers.ml
deleted file mode 100644
index 6fe6e88..0000000
--- a/tcp_wrappers.ml
+++ /dev/null
@@ -1,9 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2008 Eric C. Cooper <ecc at cmu.edu>
- Released under the GNU General Public License *)
-
-external wrap_hosts_ctl : string -> string -> string -> string -> bool
- = "wrap_hosts_ctl"
-
-let hosts_ctl ?(address="unknown") ?(host="unknown") ?(user="unknown") daemon =
- wrap_hosts_ctl daemon host address user
diff --git a/tcp_wrappers.mli b/tcp_wrappers.mli
deleted file mode 100644
index ed928b8..0000000
--- a/tcp_wrappers.mli
+++ /dev/null
@@ -1,6 +0,0 @@
-(* approx: proxy server for Debian archive files
- Copyright (C) 2008 Eric C. Cooper <ecc at cmu.edu>
- Released under the GNU General Public License *)
-
-val hosts_ctl :
- ?address:string -> ?host:string -> ?user:string -> string -> bool
diff --git a/version.mli b/version.ml
similarity index 52%
copy from version.mli
copy to version.ml
index 195d561..2301b66 100644
--- a/version.mli
+++ b/version.ml
@@ -1,6 +1,6 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2006 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2009 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
-val name : string
-val number : string
+let name = "approx"
+let number = "4.0"
--
approx upstream and debian packaging
More information about the Pkg-ocaml-maint-commits
mailing list