1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233
|
(***********************************************************************)
(* membership.ml - Simple module for loading membership information. *)
(* Currently only loads membership from membership *)
(* file. *)
(* @author Yaron M. Minsky *)
(* *)
(* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *)
(* 2011, 2012, 2013 Yaron Minsky and Contributors *)
(* *)
(* This file is part of SKS. SKS is free software; you can *)
(* redistribute it and/or modify it under the terms of the GNU General *)
(* Public License as published by the Free Software Foundation; either *)
(* version 2 of the License, or (at your option) any later version. *)
(* *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU General Public License *)
(* along with this program; if not, write to the Free Software *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
(* USA or see <http://www.gnu.org/licenses/>. *)
(***********************************************************************)
open StdLabels
open MoreLabels
module Unix=UnixLabels
open Printf
open Scanf
open Common
exception Bug of string
exception Lookup_failure of string
exception Malformed_entry of string
exception Empty_line
let membership = ref ([| |],-1.)
let whitespace = Str.regexp "[ \t]+"
let lookup_hostname string service =
Unix.getaddrinfo string service [Unix.AI_SOCKTYPE Unix.SOCK_STREAM]
let local_recon_addr () =
lookup_hostname !Settings.hostname (string_of_int recon_port)
let local_recon_addr = Utils.unit_memoize local_recon_addr
let convert_address l =
try
if String.length l = 0 then raise Empty_line else
sscanf l "%s %s"
(fun addr service ->
if addr = "" || service = "" then failwith "Blank line";
addr, service)
with
Scanf.Scan_failure _ | End_of_file | Failure _ -> raise (Malformed_entry l)
let load_membership_file file =
let rec loop list =
try
let line = decomment (input_line file) in
let addr = convert_address line in
addr :: loop list
with
| Empty_line -> loop list
| End_of_file -> list
| Malformed_entry line ->
perror "Malformed entry %s" line;
loop list
in
loop []
let get_mtime fname =
try
if Sys.file_exists fname
then Some (Unix.stat fname).Unix.st_mtime
else None
with
Unix.Unix_error _ -> None
let load_membership fname =
let file = open_in fname in
protect ~f:(fun () ->
load_membership_file file)
~finally:(fun () -> close_in file)
let ai_to_string = function
| { Unix.ai_addr = Unix.ADDR_UNIX s } -> sprintf "<ADDR_UNIX %s>" s
| { Unix.ai_addr = Unix.ADDR_INET (addr,p) } -> sprintf "<ADDR_INET [%s]:%d>"
(Unix.string_of_inet_addr addr) p
let ai_list_to_string ai_list =
"[" ^ (String.concat ~sep:", " (List.map ~f:ai_to_string ai_list)) ^ "]"
let membership_string () =
let (mshp,_) = !membership in
let to_string (addr, (host, service)) =
sprintf "(%s %s)%s" host service (ai_list_to_string addr)
in
let strings = List.map ~f:to_string (Array.to_list mshp) in
"Membership: " ^ String.concat ~sep:", " strings
(* Refresh member n's address *)
let refresh_member members n =
match members.(n) with
(addr, (host, service as line)) ->
let fresh_addr = lookup_hostname host service in
if addr <> fresh_addr then begin
members.(n) <- (fresh_addr, line);
plerror 3 "address for %s:%s changed from %s to %s"
host service (ai_list_to_string addr) (ai_list_to_string fresh_addr)
end
let reload_if_changed () =
let fname = Lazy.force Settings.membership_file in
let (mshp,old_mtime) = !membership in
match get_mtime fname with
| None ->
plerror 2 "%s" ("Unable to get mtime for membership file. " ^
"Can't decide whether to reload")
| Some mtime ->
if old_mtime <> mtime then
( let memberlines = load_membership fname in
let old = Array.to_list mshp in
let f line =
try
List.find ~f:(fun (_, old_line) -> line = old_line) old
with
Not_found -> ([], line)
in
let merged = Array.of_list (List.map ~f memberlines) in
membership := (merged, mtime);
plerror 5 "%s" (membership_string ());
(* Try to lookup unknown names *)
Array.iteri
~f:(fun i mb -> if fst mb = [] then refresh_member merged i)
merged
)
let get_names () =
let file = Lazy.force Settings.membership_file in
let mshp =
if not (Sys.file_exists file) then [||]
else (
reload_if_changed ();
let (m,_) = !membership in
m
)
in
Array.map ~f:(function (_, (host, service)) -> host ^ " " ^ service) mshp
let reset_membership_time () =
let (m,mtime) = !membership in
membership := (m,0.)
let same_inet_addr addr1 addr2 =
match (addr1,addr2) with
(Unix.ADDR_INET (ip1,_), Unix.ADDR_INET (ip2,_)) -> ip1 = ip2
| _ -> false
let rec choose () =
if Sys.file_exists (Lazy.force Settings.membership_file) then begin
reload_if_changed ();
let (mshp, _) = !membership in
let choice = Random.int (Array.length mshp) in
refresh_member mshp choice;
match fst mshp.(choice) with
[] -> choose ()
| addrlist ->
let saddr = (List.hd addrlist).Unix.ai_addr in
let same_addr thisaddr = same_inet_addr saddr thisaddr.Unix.ai_addr in
if List.exists ~f:same_addr (local_recon_addr ()) then
choose () else
addrlist
end else
raise Not_found
let test addr =
reload_if_changed ();
let (m,_) = !membership in
let same_as_addr this_addr = same_inet_addr addr this_addr.Unix.ai_addr in
List.exists (Array.to_list m)
~f:(fun x -> List.exists ~f:same_as_addr (fst x))
(************************************************************)
(** Code for keeping track of hosts to send mail updates to *)
(************************************************************)
let mailsync_partners = ref ([ ],-1.)
let rec load_mailsync_partners_file file =
try
let email = Wserver.strip (decomment (input_line file)) in
if String.contains email '@'
then email::(load_mailsync_partners_file file)
else load_mailsync_partners_file file
with
End_of_file -> []
let load_mailsync_partners fname =
let file = open_in fname in
let run () =
match get_mtime fname with
| Some mtime ->
mailsync_partners := (load_mailsync_partners_file file,mtime)
| None ->
plerror 2 "Failed to find mtime -- can't load mailsync file"
in
protect ~f:run ~finally:(fun () -> close_in file)
let reload_mailsync_if_changed () =
let fname = Lazy.force Settings.mailsync_file in
let (msync,old_mtime) = !mailsync_partners in
match get_mtime fname with
None -> if !Settings.send_mailsyncs then plerror 2 "%s"
("Failed to find mtime, can't decide whether to" ^
" load mailsync file")
| Some mtime -> if old_mtime <> mtime then load_mailsync_partners fname
let get_mailsync_partners () =
let partners =
if Sys.file_exists (Lazy.force Settings.membership_file) then (
reload_mailsync_if_changed ();
let (m,mtime) = !mailsync_partners in
m
)
else []
in
if partners = [] then failwith "No partners specified"
else partners
|