[Sks-devel] [PATCH] Bundle IPv6, DNS fixes, sks dump fix

[Kim Minh Kaplan]

Hello,

I have finally bundled recent changes into a single patch against Yaron
Minsky's repository.  It includes sks dump fix[1], DNS staleness fix[2]
and IPv6 support as Phil Pennock suggested it[3] but with additional
rewritings:

   * work with the other fixes.

   * no specific configuration for using IPv6.  But you can have
     multiple addresses in your hkp_address and recon_address.  If you
     have IPv4 addresses then IPv4 is enabled, if you have IPv6
     addresses then IPv6 is enabled.  For example I use:

        recon_address: 91.121.167.18 2001:41d0:1:e812:1c:c0ff:fe65:2cd4
        hkp_address:   91.121.167.18 2001:41d0:1:e812:1c:c0ff:fe65:2cd4

Or you can download a patched source tree at

    http://www.kim-minh.com/pub/sks/sks-kmkaplan-1.tgz

Would a backport to stable version help for wider adoption?

Regards,
Kim Minh.

[1] http://lists.gnu.org/archive/html/sks-devel/2009-03/msg00091.html
[2] http://lists.gnu.org/archive/html/sks-devel/2009-03/msg00118.html
[3] http://lists.gnu.org/archive/html/sks-devel/2009-03/msg00002.html

diff -r e30dc5376cbb -r d8b8ca6daf0c common.ml
--- a/common.ml Fri May 23 21:16:40 2008 -0400
+++ b/common.ml Mon Mar 23 19:05:17 2009 +0000
@@ -197,6 +197,11 @@
 (************************************************************)
 (**  Network Related definitions   *)
 
+let make_addr_list address_string port =
+  let addrlist = Str.split (Str.regexp "[ \t]+") address_string in
+  let f s = Unix.ADDR_INET (Unix.inet_addr_of_string s, port) in
+  List.map ~f addrlist
+
 let recon_port = !Settings.recon_port 
 let recon_address = !Settings.recon_address
 let http_port = !Settings.hkp_port
@@ -213,6 +218,11 @@
 
 
 let get_client_recon_addr () =
-  Unix.ADDR_INET (Unix.inet_addr_of_string recon_address,0)
+  make_addr_list recon_address 0
 let get_client_recon_addr = 
   Utils.unit_memoize get_client_recon_addr
+
+let match_client_recon_addr addr =
+  let family = Unix.domain_of_sockaddr addr in
+  List.find ~f:(fun caddr -> family = Unix.domain_of_sockaddr caddr)
+    (get_client_recon_addr ())
diff -r e30dc5376cbb -r d8b8ca6daf0c dbserver.ml
--- a/dbserver.ml       Fri May 23 21:16:40 2008 -0400
+++ b/dbserver.ml       Mon Mar 23 19:05:17 2009 +0000
@@ -56,9 +56,11 @@
     if not withtxn then 
       failwith "Running sks_db without transactions is no longer supported."
 
+  let websocks =
+    List.map ~f:Eventloop.create_sock
+      ((if !Settings.use_port_80 then make_addr_list http_address 80 else [])
+       @ make_addr_list http_address http_port)
 
-  let addr = inet_addr_of_string http_address
-  let websock = Eventloop.create_sock (ADDR_INET (addr,http_port))
   let () = 
     if Sys.file_exists db_command_name 
     then Unix.unlink db_command_name
@@ -652,23 +654,16 @@
       )
 
       (
-       (websock, Eventloop.make_th ~name:"webserver" 
-         ~timeout:!Settings.wserver_timeout
-         ~cb:(Wserver.accept_connection webhandler ~recover_timeout:1))
-       ::
         (comsock, Eventloop.make_th ~name:"command handler" 
            ~timeout:!Settings.command_timeout
            ~cb:(eventify_handler command_handler))
        ::
-        (if !Settings.use_port_80 then
-           let sock = Eventloop.create_sock (ADDR_INET (addr,80)) in
-           (sock,Eventloop.make_th ~name:"webserver80" 
-              ~timeout:!Settings.wserver_timeout
-              ~cb:(Wserver.accept_connection webhandler ~recover_timeout:1)
-           )::[]
-         else
-           []
-        )
+        (List.map
+           ~f:(fun sock ->
+             (sock, Eventloop.make_th ~name:"webserver" 
+                ~timeout:!Settings.wserver_timeout
+                ~cb:(Wserver.accept_connection webhandler ~recover_timeout:1)))
+           websocks)
       )
 
 
diff -r e30dc5376cbb -r d8b8ca6daf0c eventloop.ml
--- a/eventloop.ml      Fri May 23 21:16:40 2008 -0400
+++ b/eventloop.ml      Mon Mar 23 19:05:17 2009 +0000
@@ -122,9 +122,7 @@
 let create_sock addr = 
   try
     let domain = 
-      match addr with 
-         ADDR_UNIX _ -> PF_UNIX 
-       | ADDR_INET (_,_) -> PF_INET in
+      (Unix.domain_of_sockaddr addr) in
     let sock =
       socket ~domain ~kind:SOCK_STREAM ~protocol:0 in
     setsockopt sock SO_REUSEADDR true;
diff -r e30dc5376cbb -r d8b8ca6daf0c membership.ml
--- a/membership.ml     Fri May 23 21:16:40 2008 -0400
+++ b/membership.ml     Mon Mar 23 19:05:17 2009 +0000
@@ -34,43 +34,42 @@
 
 let whitespace = Str.regexp "[ \t]+"
 
-let lookup_hostname string = 
-  try (Unix.gethostbyname string).Unix.h_addr_list.(0)
-  with 
-    | Invalid_argument _ | Not_found -> raise (Lookup_failure string)
+let lookup_hostname string service =
+  Unix.getaddrinfo string service
+    [Unix.AI_SOCKTYPE Unix.SOCK_STREAM]
 
 let local_recon_addr () = 
-  Unix.ADDR_INET (lookup_hostname !Settings.hostname, recon_port)
+  lookup_hostname !Settings.hostname (string_of_int recon_port)
 
 let local_recon_addr = Utils.unit_memoize local_recon_addr
 
-let remove_self addresses = 
-  List.filter ~f:(fun (addr,str) -> addr <> local_recon_addr ()) addresses
+let parse_address l =
+  let make_pair addr service =
+    if addr = "" || service = "" then raise (Malformed_entry l) else
+    addr, service
+  in
+  try
+    sscanf l "%s %s" make_pair
+  with
+    Scanf.Scan_failure _ | End_of_file | Failure _ -> raise (Malformed_entry l)
 
 let convert_address l =
-  try 
-    sscanf l "%s %d" 
-    (fun addr port -> Unix.ADDR_INET (lookup_hostname addr,port))
-  with 
-    Scanf.Scan_failure _ | End_of_file | Failure _ -> raise (Malformed_entry l)
+  let (addr, port) = parse_address l in
+  lookup_hostname addr port
 
 let load_membership_file file =
   let rec loop list =
     try
       let line = decomment (input_line file) in
-      let addr = convert_address line in
-      (addr,line) :: loop list
+      ignore (parse_address line);
+      loop (line :: list)
     with
       | End_of_file -> list
-      | Lookup_failure addr -> 
-         perror "Lookup failure on address %s" addr;
-         loop list
       | Malformed_entry line -> 
          perror "Malformed entry %s" line;
          loop list
   in
-  let raw_membership = loop [] in
-  Array.of_list (remove_self raw_membership)
+  loop []
 
 let get_mtime fname = 
   try
@@ -80,45 +79,62 @@
   with 
       Unix.Unix_error _ -> None
 
-let load_membership fname = 
-  let file = open_in fname in
-  protect ~f:(fun () -> 
-               let mshp = load_membership_file file in
-               match get_mtime fname with
-                 | None -> 
-                     plerror 2 "%s" 
-                       ("Unable to get mtime for membership. " ^
-                        "Failed to reload.")
-                 | Some mtime -> membership := (mshp,mtime)
-            )
-    ~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 sockaddr_to_string sockaddr = match sockaddr with
-    Unix.ADDR_UNIX s -> sprintf "<ADDR_UNIX %s>" s
-  | Unix.ADDR_INET (addr,p) -> sprintf "<ADDR_INET %s:%d>" 
-      (Unix.string_of_inet_addr addr) p
+let ai_list_to_string = function
+    [] -> "<UNKNOWN>"
+  | ai :: [] -> ai_to_string ai
+  | ai_list ->
+      "(" ^ (String.concat ~sep:", " (List.map ~f:ai_to_string ai_list)) ^ ")"
 
 let membership_string () = 
   let (mshp,_) = !membership in
-  let to_string (addr,str) =
-    sprintf "%s(%s)" (sockaddr_to_string addr) str
-  in
+  let to_string (addr, str) = sprintf "(%s)%s" str (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, line) ->
+      let fresh_addr = convert_address line in
+      if addr <> fresh_addr then begin
+       members.(n) <- (fresh_addr, line);
+       plerror 3 "address for %s changed from %s to %s"
+         line (ai_list_to_string addr) (ai_list_to_string fresh_addr)
+      end
 
-let reload_if_changed () = 
+(* Returns true if membership has been reloaded, false otherwise *)
+let load_membership fname = 
+  let mtime = (Unix.stat fname).Unix.st_mtime in
+  if mtime <> (snd !membership) then
+    let memberlines =
+      let file = open_in fname in
+      protect ~f:(fun () -> load_membership_file file)
+       ~finally:(fun () -> close_in file)
+    in
+    let old = Array.to_list (fst !membership) 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);
+    (* Try to lookup unknown names *)
+    Array.iteri ~f:(fun i mb -> if fst mb = [] then refresh_member merged i)
+      merged;
+    plerror 5 "%s" (membership_string ())
+
+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 
-         ( load_membership fname;
-           plerror 5 "%s" (membership_string ())
-         )
+  try
+    load_membership fname
+  with _ -> plerror 2 "Failed to reload %s." fname
 
 let get_names () = 
   let mshp = 
@@ -136,21 +152,37 @@
   let (m,mtime) = !membership in
   membership := (m,0.)
 
-let get () = 
-  let mshp = 
-    if Sys.file_exists (Lazy.force Settings.membership_file) then (
-      reload_if_changed ();
-      let (m,mtime) = !membership in 
-      m
-    )
-    else [| |]
-  in
-  Array.map ~f:fst mshp
-
 let same_inet_addr addr1 addr2 = 
   match (addr1,addr2) with
       (Unix.ADDR_INET (ip1,_), Unix.ADDR_INET (ip2,_)) -> ip1 = ip2
     | _ -> false
+
+let rec choose_partner () =
+  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_partner()
+    | addrlist ->
+       let saddr = (List.hd addrlist).Unix.ai_addr in
+       let f { Unix.ai_addr = thisaddr } = same_inet_addr saddr thisaddr
+       in
+       if List.exists ~f (local_recon_addr ()) then
+         choose_partner () else
+         let is_compatible addr =
+           try
+             ignore (match_client_recon_addr addr.Unix.ai_addr);
+             true
+           with Not_found -> false
+         in
+         let addrlist = List.filter ~f:is_compatible addrlist in
+         if addrlist = [] then
+           choose_partner () else
+           List.nth addrlist (Random.int (List.length addrlist))
+  end else
+    raise Not_found
 
 let test addr = 
   reload_if_changed ();
@@ -158,9 +190,9 @@
   
   let found = ref false in
   let i = ref 0 in
+  let f { Unix.ai_addr = thisaddr } = same_inet_addr addr thisaddr in
   while !i < Array.length m && not !found do 
-    if same_inet_addr addr (fst m.(!i)) then
-      found := true;
+    found := List.exists ~f (fst m.(!i));
     incr i
   done;
   !found
diff -r e30dc5376cbb -r d8b8ca6daf0c reconCS.ml
--- a/reconCS.ml        Fri May 23 21:16:40 2008 -0400
+++ b/reconCS.ml        Mon Mar 23 19:05:17 2009 +0000
@@ -132,21 +132,21 @@
 let connect tree ~filters ~partner ~self = 
   (* TODO: change the following to depend on the address type *)
   let s = Unix.socket 
-           ~domain:Unix.PF_INET 
-           ~kind:Unix.SOCK_STREAM 
-           ~protocol:0 
+           ~domain:partner.Unix.ai_family 
+           ~kind:partner.Unix.ai_socktype
+           ~protocol:partner.Unix.ai_protocol
   in
   let run () =
-    Unix.bind s ~addr:(get_client_recon_addr ());
-    Unix.connect s ~addr:partner;
+    Unix.bind s ~addr:(match_client_recon_addr partner.Unix.ai_addr);
+    Unix.connect s ~addr:partner.Unix.ai_addr;
     let cin = Channel.sys_in_from_fd s
     and cout = Channel.sys_out_from_fd s in
     plerror 4 "Initiating reconciliation";
-    let remote_config = handle_config cin cout filters partner in
+    let remote_config = handle_config cin cout filters partner.Unix.ai_addr in
     ignore (Unix.alarm !Settings.reconciliation_timeout);
 
     let http_port = config_get_http_port remote_config in
-    let remote_http_address = change_port partner http_port in
+    let remote_http_address = change_port partner.Unix.ai_addr http_port in
 
     let data = Server.handle tree cin cout in
     (data,remote_http_address)
diff -r e30dc5376cbb -r d8b8ca6daf0c reconComm.ml
--- a/reconComm.ml      Fri May 23 21:16:40 2008 -0400
+++ b/reconComm.ml      Mon Mar 23 19:05:17 2009 +0000
@@ -67,11 +67,11 @@
 
 let get_keystrings_via_http addr hashes = 
   let s = Unix.socket 
-           ~domain:Unix.PF_INET 
+           ~domain:(Unix.domain_of_sockaddr addr)
            ~kind:Unix.SOCK_STREAM 
            ~protocol:0  in
   protect ~f:(fun () -> 
-               Unix.bind s ~addr:(get_client_recon_addr ());
+               Unix.bind s ~addr:(match_client_recon_addr addr);
                Unix.connect s ~addr;
                let cin = Channel.sys_in_from_fd s 
                and cout = Channel.sys_out_from_fd s in
@@ -84,7 +84,11 @@
                                     (String.length msg));
                cout#write_string msg;
                cout#flush;
-               ignore (input_line cin#inchan); (* read "HTTP" line *)
+               (* read "HTTP" line and make sure the status is 2xx *)
+               let status_re = Str.regexp "^HTTP/[0-9]+\\.[0-9]+ 2" in
+               let status = input_line cin#inchan in
+               if not (Str.string_match status_re status 0) then
+                 failwith status;
                let _headers = Wserver.parse_headers Map.empty cin#inchan in
                let keystrings = 
                  CMarshal.unmarshal_list ~f:CMarshal.unmarshal_string cin
diff -r e30dc5376cbb -r d8b8ca6daf0c reconserver.ml
--- a/reconserver.ml    Fri May 23 21:16:40 2008 -0400
+++ b/reconserver.ml    Mon Mar 23 19:05:17 2009 +0000
@@ -49,8 +49,8 @@
 
   (******************************************************************)
 
-  let recon_addr = Unix.ADDR_INET (Unix.inet_addr_of_string 
recon_address,recon_port)
-  let reconsock = Eventloop.create_sock recon_addr
+  let reconsocks =
+    List.map Eventloop.create_sock (make_addr_list recon_address recon_port)
 
   let () = 
     if Sys.file_exists recon_command_name
@@ -74,13 +74,9 @@
        handle addr cin cout
     )
 
-  let choose array = 
-    if Array.length array = 0 then raise Not_found
-    else array.(Random.int (Array.length array))
-
   let choose_partner () = 
     try
-      choose (Membership.get ())
+      Membership.choose_partner ()
     with
        Not_found | Invalid_argument _ -> 
          failwith "No gossip partners available"
@@ -211,7 +207,7 @@
     else
       begin
        let partner = choose_partner () in
-       plerror 4 "Recon partner: %s" (sockaddr_to_string partner);
+       plerror 4 "Recon partner: %s" (sockaddr_to_string partner.Unix.ai_addr);
        let filters = get_filters () in
        let (results,http_addr) = 
          ReconCS.connect (get_ptree ()) ~filters ~partner 
@@ -354,17 +350,18 @@
          )
       )
 
-      [ (comsock, Eventloop.make_th 
+      ((comsock, Eventloop.make_th 
           ~name:"command handler"
           ~cb:(eventify_handler command_handler)
           ~timeout:!Settings.command_timeout
-       ); 
-       (reconsock, Eventloop.make_th 
-          ~name:"reconciliation handler"
-          ~cb:recon_handler 
-          ~timeout:!Settings.reconciliation_config_timeout
-       ); 
-      ]
+       )
+       ::
+        (List.map ~f:(fun sock ->
+          (sock, Eventloop.make_th 
+             ~name:"reconciliation handler"
+             ~cb:recon_handler 
+             ~timeout:!Settings.reconciliation_config_timeout))
+           reconsocks))
 
 
   (******************************************************************)
diff -r e30dc5376cbb -r d8b8ca6daf0c sks.pod
--- a/sks.pod   Fri May 23 21:16:40 2008 -0400
+++ b/sks.pod   Mon Mar 23 19:05:17 2009 +0000
@@ -152,7 +152,7 @@
 
 =item -recon_address
 
-Set recon binding address.
+Set recon binding address.  Can be a list of whitespace separated IP addresses.
 
 =item -hkp_port
 
@@ -160,7 +160,7 @@
 
 =item -hkp_address
 
-Set hkp binding address.
+Set hkp binding address.  Can be a list of whitespace separated IP addresses.
 
 =item -use_port_80
 
diff -r e30dc5376cbb -r d8b8ca6daf0c sksdump.ml
--- a/sksdump.ml        Fri May 23 21:16:40 2008 -0400
+++ b/sksdump.ml        Mon Mar 23 19:05:17 2009 +0000
@@ -46,19 +46,22 @@
       match SStream.next stream with
        | None -> ()
        | Some (hash,string) ->
-           try
-             let skey = Keydb.skey_of_string string in
-             if should_dump skey then
-               let keystring = Keydb.keystring_of_skey skey in
-               output_string cout keystring;
-               write_to_file (size - 1) stream cout
-             else
-               write_to_file size stream cout
-           with
+           let remain =
+             try
+               let skey = Keydb.skey_of_string string in
+               if should_dump skey then
+                 let keystring = Keydb.keystring_of_skey skey in
+                 output_string cout keystring;
+                 size - 1
+               else
+                 size
+             with
                e -> 
                  eplerror 1 e "Failed attempt to extract key %s" 
-                 (KeyHash.hexify hash);
-                 write_to_file size stream cout
+                   (KeyHash.hexify hash);
+                 size
+           in
+           write_to_file remain stream cout
 
 
   let write_to_fname size stream fname =