Permalink
Browse files

Merge pull request #124 from jeromemaloberti/XOP-229

XOP-229: Stunnel_cache fixes.
  • Loading branch information...
2 parents 2b61fac + 23fd992 commit 30fc1f80a5144a3d05aa6ccb966ad63c1600251c @thomassa thomassa committed Mar 21, 2013
Showing with 20 additions and 19 deletions.
  1. +4 −4 http-svr/http.ml
  2. +4 −5 http-svr/xmlrpc_client.ml
  3. +2 −1 stunnel/stunnel.ml
  4. +1 −0 stunnel/stunnel.mli
  5. +7 −7 stunnel/stunnel_cache.ml
  6. +2 −2 stunnel/stunnel_cache.mli
View
@@ -376,7 +376,7 @@ module Request = struct
body = None;
}
- let make ?(frame=false) ?(version="1.0") ?(keep_alive=false) ?accept ?cookie ?length ?auth ?subtask_of ?body ?(headers=[]) ?content_type ?host ?(query=[]) ~user_agent meth path =
+ let make ?(frame=false) ?(version="1.1") ?(keep_alive=true) ?accept ?cookie ?length ?auth ?subtask_of ?body ?(headers=[]) ?content_type ?host ?(query=[]) ~user_agent meth path =
{ empty with
version = version;
frame = frame;
@@ -479,7 +479,7 @@ module Response = struct
}
let empty = {
- version = "1.0";
+ version = "1.1";
frame = false;
code = "500";
message = "Empty response";
@@ -498,7 +498,7 @@ module Response = struct
(kvpairs x.additional_headers)
let empty = {
- version = "1.0";
+ version = "1.1";
frame = false;
code = "500";
message = "Unknown error message";
@@ -507,7 +507,7 @@ module Response = struct
additional_headers = [];
body = None;
}
- let make ?(frame=false) ?(version="1.0") ?length ?task ?(headers=[]) ?body code message = {
+ let make ?(frame=false) ?(version="1.1") ?length ?task ?(headers=[]) ?body code message = {
version = version;
frame = frame;
code = code;
@@ -96,14 +96,14 @@ let get_new_stunnel_id =
(** Returns an stunnel, either from the persistent cache or a fresh one which
has been checked out and guaranteed to work. *)
-let get_reusable_stunnel ?use_fork_exec_helper ?write_to_log host port =
+let get_reusable_stunnel ?use_fork_exec_helper ?write_to_log host port verify_cert =
let start_time = Unix.gettimeofday () in
let found = ref None in
(* 1. First check if there is a suitable stunnel in the cache. *)
begin
try
while !found = None do
- let (x: Stunnel.t) = Stunnel_cache.remove host port in
+ let (x: Stunnel.t) = Stunnel_cache.remove host port verify_cert in
if check_reusable x.Stunnel.fd
then found := Some x
else begin
@@ -129,7 +129,7 @@ let get_reusable_stunnel ?use_fork_exec_helper ?write_to_log host port =
incr attempt_number;
try
let unique_id = get_new_stunnel_id () in
- let (x: Stunnel.t) = Stunnel.connect ~unique_id ?use_fork_exec_helper ?write_to_log host port in
+ let (x: Stunnel.t) = Stunnel.connect ~unique_id ?use_fork_exec_helper ?write_to_log ~verify_cert host port in
if check_reusable x.Stunnel.fd
then found := Some x
else begin
@@ -211,10 +211,9 @@ let with_transport transport f = match transport with
use_stunnel_cache = use_stunnel_cache;
verify_cert = verify_cert;
task_id = task_id}, host, port) ->
- assert (not (verify_cert && use_stunnel_cache));
let st_proc =
if use_stunnel_cache
- then get_reusable_stunnel ~use_fork_exec_helper ~write_to_log host port
+ then get_reusable_stunnel ~use_fork_exec_helper ~write_to_log host port verify_cert
else
let unique_id = get_new_stunnel_id () in
Stunnel.connect ~use_fork_exec_helper ~write_to_log ~unique_id ~verify_cert ~extended_diagnosis:true host port in
View
@@ -113,6 +113,7 @@ type t = { mutable pid: pid; fd: Unix.file_descr; host: string; port: int;
connected_time: float;
unique_id: int option;
mutable logfile: string;
+ verified: bool;
}
let config_file verify_cert extended_diagnosis host port =
@@ -187,7 +188,7 @@ let attempt_one_connect ?unique_id ?(use_fork_exec_helper = true)
let t =
{ pid = Nopid; fd = data_out; host = host; port = port;
connected_time = Unix.gettimeofday (); unique_id = unique_id;
- logfile = "" } in
+ logfile = ""; verified = verify_cert } in
let result = Forkhelpers.with_logfile_fd "stunnel"
~delete:(not extended_diagnosis)
(fun logfd ->
View
@@ -34,6 +34,7 @@ type t = { mutable pid: pid;
connected_time: float; (** time when the connection opened, for 'early retirement' *)
unique_id: int option;
mutable logfile: string;
+ verified: bool;
}
(** Connects via stunnel (optionally via an external 'fork/exec' helper) to
@@ -23,7 +23,7 @@
module D=Debug.Debugger(struct let name="stunnel_cache" end)
open D
-type endpoint = { host: string; port: int }
+type endpoint = { host: string; port: int; verified: bool }
(* Need to limit the absolute number of stunnels as well as the maximum age *)
let max_stunnel = 22
@@ -127,7 +127,7 @@ let add (x: Stunnel.t) =
incr counter;
Hashtbl.add !times idx now;
Hashtbl.add !stunnels idx x;
- let ep = { host = x.Stunnel.host; port = x.Stunnel.port } in
+ let ep = { host = x.Stunnel.host; port = x.Stunnel.port; verified = x.Stunnel.verified } in
let existing =
if Hashtbl.mem !index ep
then Hashtbl.find !index ep
@@ -140,8 +140,8 @@ let add (x: Stunnel.t) =
(** Returns an Stunnel.t for this endpoint (oldest first), raising Not_found
if none can be found *)
-let remove host port =
- let ep = { host = host; port = port } in
+let remove host port verified =
+ let ep = { host = host; port = port; verified = verified } in
Mutex.execute m
(fun () ->
unlocked_gc ();
@@ -174,10 +174,10 @@ let flush () =
info "Flushed!")
-let connect ?use_fork_exec_helper ?write_to_log host port =
+let connect ?use_fork_exec_helper ?write_to_log host port verify_cert =
try
- remove host port
+ remove host port verify_cert
with Not_found ->
error "Failed to find stunnel in cache for endpoint %s:%d" host port;
- Stunnel.connect ?use_fork_exec_helper ?write_to_log host port
+ Stunnel.connect ?use_fork_exec_helper ?write_to_log ~verify_cert host port
@@ -26,13 +26,13 @@
will be used, otherwise we make a fresh one. *)
val connect :
?use_fork_exec_helper:bool ->
- ?write_to_log:(string -> unit) -> string -> int -> Stunnel.t
+ ?write_to_log:(string -> unit) -> string -> int -> bool -> Stunnel.t
(** Adds a reusable stunnel to the cache *)
val add : Stunnel.t -> unit
(** Given a host and port return a cached stunnel, or throw Not_found *)
-val remove : string -> int -> Stunnel.t
+val remove : string -> int -> bool -> Stunnel.t
(** Empty the cache of all stunnels *)
val flush : unit -> unit

0 comments on commit 30fc1f8

Please sign in to comment.