diff --git a/common.ml b/common.ml --- a/common.ml +++ b/common.ml @@ -171,10 +171,15 @@ let rec filter_opts optlist = match optl | (Some x)::tl -> x::(filter_opts tl) | None::tl -> filter_opts tl +let horiz_whitespace c = c = ' ' || c = '\t' + let decomment l = try - let pos = String.index l '#' in - String.sub l ~pos:0 ~len:pos + let pos = ref (String.index l '#') in + while !pos > 0 && horiz_whitespace l.[!pos - 1] do + decr pos + done; + String.sub l ~pos:0 ~len:!pos with Not_found -> l @@ -202,6 +207,11 @@ type timestamp = float (************************************************************) (** Network Related definitions *) +let enabled_ipv ipv = match ipv with + | IPv4 -> not !Settings.disable_ipv4 + | IPv6 -> not !Settings.disable_ipv6 +let disabled_ipv ipv = not (enabled_ipv ipv) + let recon_port = !Settings.recon_port let recon_address = !Settings.recon_address let recon6_address = !Settings.recon6_address @@ -234,3 +244,8 @@ let sockaddr_to_string sockaddr = match | Unix.ADDR_INET (addr,p) -> sprintf "" (Unix.string_of_inet_addr addr) p +let sockaddr_is_ipv sockaddr ipv = match Unix.domain_of_sockaddr sockaddr with + | Unix.PF_UNIX -> false + | Unix.PF_INET -> ipv = IPv4 + | Unix.PF_INET6 -> ipv = IPv6 + diff --git a/dbMessages.ml b/dbMessages.ml --- a/dbMessages.ml +++ b/dbMessages.ml @@ -162,10 +162,6 @@ let rec unmarshal_msg cin = in rval -let sockaddr_to_string sockaddr = match sockaddr with - Unix.ADDR_UNIX s -> sprintf "" s - | Unix.ADDR_INET (addr,p) -> sprintf "" (Unix.string_of_inet_addr addr) p - let msg_to_string msg = match msg with WordQuery words -> "WordQuery: " ^ (String.concat ", " words) diff --git a/dbserver.ml b/dbserver.ml --- a/dbserver.ml +++ b/dbserver.ml @@ -652,27 +652,29 @@ struct inet_addr_of_string (match ipv with IPv4 -> http_address | IPv6 -> http6_address) in let build ipv = + if disabled_ipv ipv then [] else let sock = Eventloop.create_sock (ADDR_INET (addr ipv,http_port)) in let name = sprintf "webserver (%s)" (string_of_ipv ipv) in - (sock, Eventloop.make_th ~name - ~timeout:!Settings.wserver_timeout - ~cb:(Wserver.accept_connection webhandler ~recover_timeout:1)) + [(sock, Eventloop.make_th ~name + ~timeout:!Settings.wserver_timeout + ~cb:(Wserver.accept_connection webhandler ~recover_timeout:1))] in - build IPv4 :: build IPv6 - :: - (comsock, Eventloop.make_th ~name:"command handler" - ~timeout:!Settings.command_timeout - ~cb:(eventify_handler command_handler)) - :: + build IPv4 @ build IPv6 + @ + [(comsock, Eventloop.make_th ~name:"command handler" + ~timeout:!Settings.command_timeout + ~cb:(eventify_handler command_handler))] + @ (if !Settings.use_port_80 then let build ipv = + if disabled_ipv ipv then [] else let sock = Eventloop.create_sock (ADDR_INET (addr ipv,80)) in let name = sprintf "webserver80 (%s)" (string_of_ipv ipv) in - (sock,Eventloop.make_th ~name + [(sock,Eventloop.make_th ~name ~timeout:!Settings.wserver_timeout - ~cb:(Wserver.accept_connection webhandler ~recover_timeout:1)) + ~cb:(Wserver.accept_connection webhandler ~recover_timeout:1))] in - [build IPv4; build IPv6] + build IPv4 @ build IPv6 else [] ) diff --git a/eventloop.ml b/eventloop.ml --- a/eventloop.ml +++ b/eventloop.ml @@ -109,7 +109,7 @@ let do_timed_callback cb = perror "%scallback timed out." (cbname cb); [] | e -> - eplerror 2 e "%serror in callback." (cbname cb); + eplerror 2 e "%serror in callback" (cbname cb); [] let do_callback cb = match cb with diff --git a/membership.ml b/membership.ml --- a/membership.ml +++ b/membership.ml @@ -47,6 +47,12 @@ let inet_addr_of_sockaddr = function | Unix.ADDR_UNIX _ -> None | Unix.ADDR_INET (addr, port) -> Some addr +let ipv_of_family ai_family = match ai_family with + | Unix.PF_UNIX -> raise (Bug "trying to find local address of remote local domain socket") + | Unix.PF_INET -> IPv4 + | Unix.PF_INET6 -> IPv6 +let ipv_of_family = Utils.memoize ipv_of_family + let lookup_hostname ~port string = try let reslist = Unix.getaddrinfo string (string_of_int port) @@ -63,7 +69,16 @@ let lookup_hostname_filtered ~family str |! List.map ~f:(fun ai -> inet_addr_of_sockaddr ai.Unix.ai_addr) |! filter_opts +let allow_ip_family ai = + enabled_ipv (ipv_of_family ai.Unix.ai_family) +let allow_ip_family = Utils.memoize allow_ip_family + +let lookup_hostname_allowed_ipvs ~port string = + lookup_hostname ~port string + |! List.filter ~f:allow_ip_family + let my_recon_addresses ipv = + if disabled_ipv ipv then [] else let recon_addr,family = match ipv with | IPv4 -> !Settings.recon_address, Unix.PF_INET | IPv6 -> !Settings.recon6_address, Unix.PF_INET6 @@ -76,11 +91,7 @@ let my_recon_addresses ipv = let my_recon_addresses = Utils.memoize my_recon_addresses let is_local_recon_addr peer = - let ipv = match Unix.domain_of_sockaddr peer with - | Unix.PF_UNIX -> raise (Bug "trying to find local address of remote local domain socket") - | Unix.PF_INET -> IPv4 - | Unix.PF_INET6 -> IPv6 - in + let ipv = ipv_of_family (Unix.domain_of_sockaddr peer) in List.exists (my_recon_addresses ipv) ~f:(fun addr -> inet_addr_of_sockaddr peer = Some addr) @@ -107,7 +118,7 @@ let convert_hostname_to_sockaddrs l = sscanf l "%s %d" (fun addr port -> List.map ~f:(fun a -> a.Unix.ai_addr) - (lookup_hostname ~port:port addr)) + (lookup_hostname_allowed_ipvs ~port:port addr)) with Scanf.Scan_failure _ | End_of_file | Failure _ -> raise (Malformed_entry l) diff --git a/reconMessages.ml b/reconMessages.ml --- a/reconMessages.ml +++ b/reconMessages.ml @@ -129,11 +129,6 @@ let marshal_configdata cout configdata = let unmarshal_configdata cin = Map.of_alist (unmarshal_stringpair_list cin) -let sockaddr_to_string sockaddr = match sockaddr with - Unix.ADDR_UNIX s -> sprintf "" s - | Unix.ADDR_INET (addr,p) -> sprintf "" - (Unix.string_of_inet_addr addr) p - (***********************************) (***********************************) diff --git a/reconserver.ml b/reconserver.ml --- a/reconserver.ml +++ b/reconserver.ml @@ -79,10 +79,25 @@ struct if Array.length array = 0 then raise Not_found else array.(Random.int (Array.length array)) - let choose_addr list = + let choose_addr_simple list = if List.length list = 0 then raise Not_found else List.nth list (Random.int (List.length list)) + (* When debugging IPv6 functionality, it's useful to skew things in + * favour of IPv6 to make up for the relative scarcity, so we go + * heavy-handed with this bias. If IPv6 is disabled there should be + * no such addresses in membership. + *) + let choose_addr list = + if not !Settings.bias_ipv6_favour then + choose_addr_simple list + else + let only6 = List.filter ~f:(fun sa -> sockaddr_is_ipv sa IPv6) list in + if List.length only6 = 0 then + choose_addr_simple list + else + choose_addr_simple only6 + let choose_partner () = try choose_addr (choose (Membership.get ())) @@ -364,12 +379,13 @@ struct ~timeout:!Settings.command_timeout) :: let build ipv = - (reconsock ipv, Eventloop.make_th + if disabled_ipv ipv then [] else + [(reconsock ipv, Eventloop.make_th ~name:(sprintf "reconciliation handler (%s)" (string_of_ipv ipv)) ~cb:recon_handler - ~timeout:!Settings.reconciliation_config_timeout) + ~timeout:!Settings.reconciliation_config_timeout)] in - [ build IPv4; build IPv6 ]) + build IPv4 @ build IPv6) (******************************************************************) diff --git a/settings.ml b/settings.ml --- a/settings.ml +++ b/settings.ml @@ -55,6 +55,10 @@ let set_seed value = self_seed := false; seed := value +let disable_ipv4 = ref false +let disable_ipv6 = ref false +let bias_ipv6_favour = ref false + let recon_port = ref 11370 let recon_address = ref (Unix.string_of_inet_addr Unix.inet_addr_any) let set_recon_address value = recon_address := value @@ -250,6 +254,9 @@ let parse_spec = " Cache size in megs for prefix tree db"); ("-baseport",Arg.Int set_base_port, " Set base port number"); ("-logfile",Arg.String (fun _ -> ()), " DEPRECATED. Now ignored."); + ("-disable_ipv4",Arg.Set disable_ipv4, " Disable use of IPv4"); + ("-disable_ipv6",Arg.Set disable_ipv6, " Disable use of IPv6"); + ("-bias_ipv6_favour",Arg.Set bias_ipv6_favour, " Prefer a host's IPv6 addresses"); ("-recon_port",Arg.Int set_recon_port, " Set recon port number"); ("-recon_address",Arg.String set_recon_address, " Set recon binding address (IPv4)"); ("-recon6_address",Arg.String set_recon6_address, " Set recon binding address (IPv6)"); diff --git a/sks.pod b/sks.pod --- a/sks.pod +++ b/sks.pod @@ -142,6 +142,20 @@ Pagesize in bytes for prefix tree db. Cache size in megs for prefix tree db. +=item -disable_ipv4 + +Disable listening on or connecting to IPv4 addresses. + +=item -disable_ipv6 + +Disable listening on or connecting to IPv6 addresses. + +=item -bias_ipv6_favour + +When a host has both IPv4 and IPv6 addresses, prefer to use the IPv6 +addresses. (Currently, means will always only use IPv6 if present, +but this is subject to future change0. + =item -baseport Set base port number. @@ -335,8 +349,9 @@ The configuration file for your SKS serv =item sksconf - logfile: log + initial_stat: on membership_reload_interval: 1 + disable_ipv6: on hostname: keyserver.yourhost.com from_addr: address@hidden