File: membership.ml

package info (click to toggle)
sks 1.1.6-14
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 2,296 kB
  • sloc: ml: 15,228; ansic: 1,069; sh: 358; makefile: 347
file content (233 lines) | stat: -rw-r--r-- 8,156 bytes parent folder | download | duplicates (5)
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