[Pkg-ocaml-maint-commits] [approx] 02/08: fix all code that caused compiler warnings
Eric Cooper
ecc at cmu.edu
Sun Jul 23 21:21:57 UTC 2017
This is an automated email from the git hooks/post-receive script.
ecc-guest pushed a commit to branch master
in repository approx.
commit b259832a4b76173fb3852a419239a232788c2ce6
Author: Eric Cooper <ecc at cmu.edu>
Date: Sat Jul 22 13:56:54 2017 -0400
fix all code that caused compiler warnings
---
approx.ml | 52 +++++++++++++++++++++---------------------
config_file.ml | 4 +---
control_file.ml | 2 +-
import.ml | 16 ++++++-------
patch.ml | 4 ++--
url.ml | 6 ++---
util.ml | 71 ++++++++++++++++++++++++++++++---------------------------
7 files changed, 79 insertions(+), 76 deletions(-)
diff --git a/approx.ml b/approx.ml
index 283e274..c1f1c2c 100644
--- a/approx.ml
+++ b/approx.ml
@@ -3,8 +3,9 @@
Released under the GNU General Public License *)
open Printf
-open Unix
-open Unix.LargeFile
+
+module U = Unix
+module ULF = U.LargeFile
open Config
open Log
@@ -20,8 +21,8 @@ let wait_for_download_in_progress name =
let timeout = float_of_int max_wait in
let rec wait n =
match stat_file hint with
- | Some { st_mtime = mtime } ->
- if time () -. mtime > timeout then begin
+ | Some { ULF.st_mtime = mtime; _ } ->
+ if U.time () -. mtime > timeout then begin
error_message "Concurrent download of %s is taking too long" name;
(* remove the other process's hint file if it still exists,
so we can create our own *)
@@ -29,7 +30,7 @@ let wait_for_download_in_progress name =
end else begin
if n = 0 then
debug_message "Waiting for concurrent download of %s" name;
- sleep 1;
+ U.sleep 1;
wait (n + 1)
end
| None -> ()
@@ -98,7 +99,7 @@ let cache_nak file =
let tmp_file = gensym file in
let chan = open_out_excl tmp_file in
close_out chan;
- Unix.chmod tmp_file 0;
+ U.chmod tmp_file 0;
Sys.rename tmp_file file
(* Attempt to serve the requested file from the local cache.
@@ -109,8 +110,8 @@ let cache_nak file =
let serve_local name ims env =
wait_for_download_in_progress name;
match stat_file name with
- | Some { st_mtime = mod_time; st_ctime = ctime;
- st_size = size; st_perm = perm } ->
+ | Some { ULF.st_mtime = mod_time; st_ctime = ctime;
+ st_size = size; st_perm = perm; _ } ->
let deliver_if_newer () =
if mod_time > ims then deliver_local name env
else not_modified ()
@@ -136,7 +137,7 @@ let serve_local name ims env =
let create_hint name =
make_directory (Filename.dirname name);
- close (openfile (in_progress name) [O_CREAT; O_WRONLY] 0o644)
+ U.close (U.openfile (in_progress name) [U.O_CREAT; U.O_WRONLY] 0o644)
let remove_hint name = rm (in_progress name)
@@ -172,7 +173,7 @@ let open_cache file =
let write_cache cache str pos len =
match cache with
- | Cache { chan = chan } -> output chan str pos len
+ | Cache { chan = chan; _ } -> output chan str pos len
| Pass_through -> ()
| Undefined -> assert false
@@ -186,7 +187,7 @@ let close_cache cache size mod_time =
if size = -1L || size = file_size tmp_file then begin
if mod_time <> 0. then begin
debug_message " setting mtime to %s" (Url.string_of_time mod_time);
- utimes tmp_file mod_time mod_time
+ U.utimes tmp_file mod_time mod_time
end;
Sys.rename tmp_file file
end else begin
@@ -200,7 +201,7 @@ let close_cache cache size mod_time =
let remove_cache cache =
match cache with
- | Cache { tmp_file = tmp_file; chan = chan } ->
+ | Cache { tmp_file = tmp_file; chan = chan; _ } ->
close_out chan;
error_message "Removing %s (size: %Ld)" tmp_file (file_size tmp_file);
rm tmp_file
@@ -327,7 +328,7 @@ let process_body resp cgi str pos len =
(* Download a file from an HTTP or HTTPS repository *)
-let download_http resp url name ims cgi =
+let download_http resp url ims cgi =
let headers =
if ims > 0. then ["If-Modified-Since: " ^ Url.string_of_time ims] else []
in
@@ -361,7 +362,7 @@ let download_http resp url name ims cgi =
(* Download a file from an FTP repository *)
-let download_ftp resp url name ims cgi =
+let download_ftp resp url ims cgi =
Url.head url (process_header resp);
let mod_time = resp.last_modified in
debug_message " ims %s mtime %s"
@@ -384,7 +385,7 @@ let download_url url name ims cgi =
try
create_hint name;
unwind_protect
- (fun () -> dl resp url name ims cgi)
+ (fun () -> dl resp url ims cgi)
(fun () -> remove_hint name)
with e ->
remove_cache resp.cache;
@@ -397,7 +398,7 @@ let download_url url name ims cgi =
let updates_needed = ref []
-let cleanup_after url file =
+let cleanup_after file =
if pdiffs && Release.is_pdiff file then
(* record the affected index for later update *)
let index = Pdiff.index_file file in
@@ -430,10 +431,9 @@ let copy_from_cache name cgi =
let update_ctime name =
match stat_file name with
- | Some stats ->
- utimes name stats.st_atime stats.st_mtime;
+ | Some { ULF.st_atime = atime; st_mtime = mtime; st_ctime = ctime; _ } ->
+ U.utimes name atime mtime;
if debug then
- let ctime = (stat name).st_ctime in
debug_message " updated ctime to %s" (Url.string_of_time ctime)
| None -> ()
@@ -460,10 +460,10 @@ let serve_remote url name ims mod_time cgi =
match status with
| Delivered ->
cgi#output#commit_work ();
- if not (head_request cgi#environment) then cleanup_after url name
+ if not (head_request cgi#environment) then cleanup_after name
| Cached ->
copy_from_cache name cgi;
- cleanup_after url name
+ cleanup_after name
| Not_modified ->
update_ctime name;
copy_if_newer ()
@@ -566,10 +566,10 @@ let config =
object
inherit modify_http_reactor_config default_http_reactor_config
(* changes from default_http_protocol_config *)
- method config_announce_server = `Ocamlnet_and ("approx/" ^ version)
+ method! config_announce_server = `Ocamlnet_and ("approx/" ^ version)
(* changes from default_http_processor_config *)
- method config_error_response = error_response
- method config_log_error _ msg = error_message "%s" msg
+ method! config_error_response = error_response
+ method! config_log_error _ msg = error_message "%s" msg
end
let proxy_service =
@@ -584,8 +584,8 @@ let approx () =
log_to_syslog ();
check_id ~user ~group;
Sys.chdir cache_dir;
- set_nonblock stdin;
- Nethttpd_reactor.process_connection config stdin proxy_service;
+ U.set_nonblock U.stdin;
+ Nethttpd_reactor.process_connection config U.stdin proxy_service;
List.iter Pdiff.update !updates_needed
let () = main_program approx ()
diff --git a/config_file.ml b/config_file.ml
index 6acfeb0..49c2a1b 100644
--- a/config_file.ml
+++ b/config_file.ml
@@ -1,5 +1,5 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2014 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2017 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
open Util
@@ -26,8 +26,6 @@ let map = ref []
let reset () = map := []
-let mem k = List.mem_assoc k !map
-
let get_generic convert ?default k =
try convert (List.assoc k !map)
with Not_found ->
diff --git a/control_file.ml b/control_file.ml
index 956671c..71ba66d 100644
--- a/control_file.ml
+++ b/control_file.ml
@@ -30,7 +30,7 @@ let trim_left s i =
in
loop i
-let rec trim_right s i =
+let trim_right s i =
let rec loop i =
if i > 0 && (s.[i - 1] = ' ' || s.[i - 1] = '\t') then loop (i - 1)
else i
diff --git a/import.ml b/import.ml
index 6f4509c..fed5e51 100644
--- a/import.ml
+++ b/import.ml
@@ -9,12 +9,12 @@ open Program
open Util
let usage () =
- print "Usage: approx-import [options] file ...
-Import local files into the approx cache
-Options:
- -s|--simulate scan but do not actually import any files
- -q|--quiet do not print the file names that are imported
- -v|--verbose print information about each file";
+ print "Usage: approx-import [options] file ...\n\
+Import local files into the approx cache\n\
+Options:\n\
+\ -s|--simulate scan but do not actually import any files\n\
+\ -q|--quiet do not print the file names that are imported\n\
+\ -v|--verbose print information about each file";
exit 1
let simulate = ref false
@@ -46,8 +46,8 @@ type import_status =
| Imported of string
let imported = function
+ | Not_seen | Exists _ -> false
| Imported _ -> true
- | _ -> false
let string_of_import_status = function
| Not_seen -> "not referenced by any Packages file"
@@ -160,7 +160,7 @@ let import_files index =
if verbose then print "[ %s/%s ]" dist path;
Control_file.iter check_package index
-let print_package { base = base; status = status } =
+let print_package { base = base; status = status; _ } =
if verbose || imported status then
print "%s: %s" base (string_of_import_status status)
diff --git a/patch.ml b/patch.ml
index 7b59011..18755bc 100644
--- a/patch.ml
+++ b/patch.ml
@@ -1,5 +1,5 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2008 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2017 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
open Util
@@ -49,7 +49,7 @@ let change lines m n ic oc cur =
let delete = change []
-let copy_tail ic oc cur =
+let copy_tail ic oc _ =
iter_eof (output_line oc) ic;
0
diff --git a/url.ml b/url.ml
index 7420861..ac185f2 100644
--- a/url.ml
+++ b/url.ml
@@ -1,5 +1,5 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2014 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2017 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
open Config
@@ -26,7 +26,7 @@ let reverse_translate url =
let longest_match k v r =
if k.[0] <> '$' && is_prefix v url then
match r with
- | Some (dist, repo) as orig ->
+ | Some (_, repo) as orig ->
if String.length v > String.length repo then Some (k, v) else orig
| None -> Some (k, v)
else
@@ -95,7 +95,7 @@ let with_curl_process cmd =
match Unix.close_process_in chan with
| Unix.WEXITED 0 -> ()
| Unix.WEXITED 22 -> raise File_not_found (* see curl(1) *)
- | e ->
+ | (Unix.WEXITED _ as e) | (Unix.WSIGNALED _ as e) | (Unix.WSTOPPED _ as e) ->
error_message "Command [%s] %s" cmd (process_status e);
raise Download_error
in
diff --git a/util.ml b/util.ml
index e4b8096..3cf8858 100644
--- a/util.ml
+++ b/util.ml
@@ -1,10 +1,11 @@
(* approx: proxy server for Debian archive files
- Copyright (C) 2014 Eric C. Cooper <ecc at cmu.edu>
+ Copyright (C) 2017 Eric C. Cooper <ecc at cmu.edu>
Released under the GNU General Public License *)
open Printf
-open Unix
-open Unix.LargeFile
+
+module U = Unix
+module ULF = U.LargeFile
let invalid_string_arg msg arg = invalid_arg (msg ^ ": " ^ arg)
@@ -69,8 +70,8 @@ let make_directory path =
created concurrently, we have to ignore the Unix EEXIST error:
simply testing for existence first introduces a race condition. *)
let make_dir name =
- try mkdir name 0o755
- with Unix_error (EEXIST, _, _) ->
+ try U.mkdir name 0o755
+ with U.Unix_error (U.EEXIST, _, _) ->
if not (Sys.is_directory name) then
failwith ("file " ^ name ^ " is not a directory")
in
@@ -149,8 +150,8 @@ let with_out_channel openf = with_resource close_out openf
let gensym str =
sprintf "%s.%d.%09.0f"
(without_extension str)
- (getpid ())
- (fst (modf (gettimeofday ())) *. 1e9)
+ (U.getpid ())
+ (fst (modf (U.gettimeofday ())) *. 1e9)
(* Use the default temporary directory unless it has been set
to something inaccessible, in which case use "/tmp" *)
@@ -166,9 +167,9 @@ let tmp_dir () =
let dir =
try
let dir = Filename.get_temp_dir_name () in
- access dir [R_OK; W_OK; X_OK];
+ U.access dir [U.R_OK; U.W_OK; U.X_OK];
dir
- with Unix_error _ -> "/tmp"
+ with U.Unix_error _ -> "/tmp"
in
tmp_dir_name := Some dir;
dir
@@ -218,26 +219,28 @@ let compressed_versions name =
if is_compressed name then invalid_string_arg "compressed_versions" name;
name :: List.map (fun ext -> name ^ ext) compressed_extensions
-let stat_file file = try Some (stat file) with Unix_error _ -> None
+let stat_file file = try Some (ULF.stat file) with U.Unix_error _ -> None
let is_cached_nak name =
match stat_file name with
- | Some { st_size = 0L; st_perm = 0 } -> true
+ | Some { ULF.st_size = 0L; st_perm = 0; _ } -> true
| _ -> false
-let file_modtime file = (stat file).st_mtime
+let file_size file = (ULF.stat file).ULF.st_size
+
+let file_modtime file = (ULF.stat file).ULF.st_mtime
-let file_ctime file = (stat file).st_ctime
+let file_ctime file = (ULF.stat file).ULF.st_ctime
-let minutes_old t = int_of_float ((Unix.time () -. t) /. 60. +. 0.5)
+let minutes_old t = int_of_float ((U.time () -. t) /. 60. +. 0.5)
let newest_file list =
let newest cur name =
match stat_file name with
- | None | Some { st_size = 0L; st_perm = 0 } (* cached NAK *) -> cur
- | Some { st_mtime = modtime } ->
+ | None | Some { ULF.st_size = 0L; st_perm = 0; _ } (* cached NAK *) -> cur
+ | Some { ULF.st_mtime = modtime; _ } ->
begin match cur with
- | Some (f, t) -> if modtime > t then Some (name, modtime) else cur
+ | Some (_, t) -> if modtime > t then Some (name, modtime) else cur
| None -> Some (name, modtime)
end
in
@@ -246,7 +249,7 @@ let newest_file list =
| None -> raise Not_found
let open_out_excl file =
- out_channel_of_descr (openfile file [O_CREAT; O_WRONLY; O_EXCL] 0o644)
+ U.out_channel_of_descr (U.openfile file [U.O_CREAT; U.O_WRONLY; U.O_EXCL] 0o644)
let with_temp_file name proc =
let file = gensym name in
@@ -255,13 +258,17 @@ let with_temp_file name proc =
let update_ctime name =
match stat_file name with
- | Some { st_atime = atime; st_mtime = mtime } -> utimes name atime mtime
+ | Some { ULF.st_atime = atime; st_mtime = mtime; _ } -> U.utimes name atime mtime
| None -> ()
let directory_id name =
match stat_file name with
- | Some { st_kind = S_DIR; st_dev = dev; st_ino = ino } -> Some (dev, ino)
- | _ -> None
+ | Some s ->
+ if s.ULF.st_kind = U.S_DIR then
+ Some (s.ULF.st_dev, s.ULF.st_ino)
+ else
+ None
+ | None -> None
let fold_fs_tree non_dirs f init path =
let rec walk uids_seen init path =
@@ -294,8 +301,6 @@ let iter_dirs = iter_of_fold fold_dirs
let iter_non_dirs = iter_of_fold fold_non_dirs
-let file_size file = (stat file).st_size
-
module type MD =
sig
type t
@@ -315,17 +320,17 @@ let file_sha256sum = let module F = FileDigest(Sha256) in F.sum
let user_id =
object
method kind = "user"
- method get = getuid
- method set = setuid
- method lookup x = (getpwnam x).pw_uid
+ method get = U.getuid
+ method set = U.setuid
+ method lookup x = (U.getpwnam x).U.pw_uid
end
let group_id =
object
method kind = "group"
- method get = getgid
- method set = setgid
- method lookup x = (getgrnam x).gr_gid
+ method get = U.getgid
+ method set = U.setgid
+ method lookup x = (U.getgrnam x).U.gr_gid
end
let drop_privileges ~user ~group =
@@ -333,7 +338,7 @@ let drop_privileges ~user ~group =
try id#set (id#lookup name)
with
| Not_found -> failwith ("unknown " ^ id#kind ^ " " ^ name)
- | Unix_error (EPERM, _, _) ->
+ | U.Unix_error (U.EPERM, _, _) ->
failwith (Sys.argv.(0) ^ " must be run by root"
^ (if user <> "root" then " or by " ^ user else ""))
in
@@ -353,8 +358,8 @@ let check_id ~user ~group =
let string_of_sockaddr sockaddr ~with_port =
match sockaddr with
- | ADDR_INET (host, port) ->
- let addr = string_of_inet_addr host in
+ | U.ADDR_INET (host, port) ->
+ let addr = U.string_of_inet_addr host in
if with_port then sprintf "%s port %d" addr port else addr
- | ADDR_UNIX path ->
+ | U.ADDR_UNIX path ->
failwith ("Unix domain socket " ^ path)
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/approx.git
More information about the Pkg-ocaml-maint-commits
mailing list