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 <e...@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 <e...@cmu.edu> + Copyright (C) 2017 Eric C. Cooper <e...@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 <e...@cmu.edu> + Copyright (C) 2017 Eric C. Cooper <e...@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 <e...@cmu.edu> + Copyright (C) 2017 Eric C. Cooper <e...@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 <e...@cmu.edu> + Copyright (C) 2017 Eric C. Cooper <e...@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 _______________________________________________ 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