Permalink
Browse files

[feature] Http server: new option to accept client cookie values

  • Loading branch information...
1 parent 3062e57 commit b429b69ceb9a626c216e75e5ef77eb287b850592 @cedricss cedricss committed Oct 7, 2011
Showing with 40 additions and 19 deletions.
  1. +3 −3 libnet/cookie2.ml
  2. +30 −16 libnet/cookieLong.ml
  3. +7 −0 libnet/httpServer.ml
View
@@ -73,7 +73,7 @@ let rand4 () =
let cookie_len = 32
let random _ = String.init cookie_len (fun _ -> chars.[Random.int nchars])
let randomd str =
- let rec aux = function
+ let rec aux = function
| n when n < 0 -> str
(*| n -> String.unsafe_set str n (String.unsafe_get chars (Random.int nchars)); aux (n-1)*)
| 0 ->
@@ -344,12 +344,12 @@ let get_external ic =
| exn -> Logger.warning "Cookie2.get_external: Unknown exception %s" (Printexc.to_string exn); Time.zero, "", ""
let init_cookies ~sched
- ?(gc_period=100) ?(pool_min=100) ?(pool_max=10000) ?(timer_interval=1)
+ ?(gc_period=100) ?(accept_client_values=false) ?(pool_min=100) ?(pool_max=10000) ?(timer_interval=1)
?(rate_max=5.0) ?(period_max=5) ?(rate_ultimate=10.0) ?(period_ultimate=100)
?(expires_short=Time.seconds 5) ?(expires_long=Time.seconds 50) ?(dt1=Time.days 10) ?(dt2=Time.infinity)
?(max_external_cookies=25) ?(rotate_cookies=true) ?(cookies_filename="")
() =
- let _, _, _ = dt1, dt2, cookies_filename in
+ let _, _, _, _ = dt1, dt2, cookies_filename, accept_client_values in
cookie_gc_period := gc_period;
cookie_pool_size_min := pool_min;
cookie_pool_size_max := pool_max;
View
@@ -52,6 +52,7 @@ let cookie_dt2 = ref Time.infinity (* Fixed deadline *)
(*let cookie_max_external_cookies = ref 25*)
(*let cookie_rotate_cookies = ref true*)
let cookies_txt_filename = ref ""
+let cookie_accept_client_values = ref false
type expiration_callback = (string -> string -> unit)
let cookie_expiration_callback =
@@ -186,9 +187,7 @@ let check_cookie_timer () =
let abbrev s = if String.length s < 5 then s else String.sub s 0 5
-let create hr =
- let ic = get_cookie_string () in
- let ec = get_cookie_string () in
+let create_aux ic ec hr =
let dt1 = Time.add hr.HST.hr_timestamp !cookie_dt1 in
let dt2 = Time.add hr.HST.hr_timestamp !cookie_dt2 in
Hashtbl.add to_longcook (ec,ic) (dt1,dt2);
@@ -197,6 +196,16 @@ let create hr =
(Time.in_seconds dt1) (Time.in_seconds dt2)#<End>;
{ hr with HST.hr_ec = ec; hr_ic = ic; hr_dt2 = dt2; }
+let create hr =
+ let ic = get_cookie_string () in
+ let ec = get_cookie_string () in
+ create_aux ic ec hr
+
+let create_with_client_values hr =
+ let ic = hr.HST.hr_ic in
+ let ec = hr.HST.hr_ec in
+ create_aux ic ec hr
+
let split_cookie str =
List.map (fun x -> let a, b = String.split_char '=' x in ((String.trim a), b)) (String.slice ';' str)
@@ -224,17 +233,24 @@ let gc_cookies sched now =
let get_internal hr =
try
if String.length hr.HST.hr_ec <> cookie_len || String.length hr.HST.hr_ic <> cookie_len then raise Not_found;
- let (dt1,dt2) = Hashtbl.find to_longcook (hr.HST.hr_ec,hr.HST.hr_ic) in
- if hr.HST.hr_timestamp > dt1 || hr.HST.hr_timestamp > dt2
- then
- let hr = create hr in
- #<If$minlevel 10>Logger.debug "get_internal: expired new={ec='%s' ic='%s'}"
- (abbrev hr.HST.hr_ec) (abbrev hr.HST.hr_ic)#<End>;
+ let hr_ec_ic = hr.HST.hr_ec,hr.HST.hr_ic in
+ if !cookie_accept_client_values && not (Hashtbl.mem to_longcook hr_ec_ic) then
+ let hr = create_with_client_values hr in
+ #<If$minlevel 10>Logger.debug "get_internal: not found but create_with_client_values={ec='%s' ic='%s'}"
+ (abbrev hr.HST.hr_ec) (abbrev hr.HST.hr_ic)#<End>;
hr
else
- (#<If$minlevel 10>Logger.debug "get_internal: found ec=%s ic=%s"
- (abbrev hr.HST.hr_ec) (abbrev hr.HST.hr_ic)#<End>;
- { hr with HST.hr_dt2 = dt2 })
+ let (dt1,dt2) = Hashtbl.find to_longcook hr_ec_ic in
+ if hr.HST.hr_timestamp > dt1 || hr.HST.hr_timestamp > dt2
+ then
+ let hr = create hr in
+ #<If$minlevel 10>Logger.debug "get_internal: expired new={ec='%s' ic='%s'}"
+ (abbrev hr.HST.hr_ec) (abbrev hr.HST.hr_ic)#<End>;
+ hr
+ else
+ (#<If$minlevel 10>Logger.debug "get_internal: found ec=%s ic=%s"
+ (abbrev hr.HST.hr_ec) (abbrev hr.HST.hr_ic)#<End>;
+ { hr with HST.hr_dt2 = dt2 })
with Not_found ->
let hr = create hr in
#<If$minlevel 10>Logger.debug "get_internal: not found new={ec='%s' ic='%s'}"
@@ -319,7 +335,7 @@ let load_cookies () =
end
let init_cookies ~sched
- ?(gc_period=100) ?(pool_min=100) ?(pool_max=10000) ?(timer_interval=1)
+ ?(gc_period=100) ?(accept_client_values=false) ?(pool_min=100) ?(pool_max=10000) ?(timer_interval=1)
?(rate_max=5.0) ?(period_max=5) ?(rate_ultimate=10.0) ?(period_ultimate=100)
?(expires_short=Time.seconds 5) ?(expires_long=Time.seconds 50) ?(dt1=Time.days 10) ?(dt2=Time.infinity)
?(max_external_cookies=25) ?(rotate_cookies=true) ?(cookies_filename="")
@@ -328,6 +344,7 @@ let init_cookies ~sched
let _, _, _, _, _, _, _ =
period_max, rate_ultimate, period_ultimate, expires_short, expires_long, max_external_cookies, rotate_cookies in
cookie_gc_period := gc_period;
+ cookie_accept_client_values := accept_client_values;
cookie_pool_size_min := pool_min;
cookie_pool_size_max := pool_max;
cookie_timer_interval := timer_interval;
@@ -351,6 +368,3 @@ let init_cookies ~sched
cookie_timer_functions := (gc_cookies sched)::!cookie_timer_functions;
Scheduler.timer sched (Time.seconds timer_interval) check_cookie_timer;
if !cookies_txt_filename <> "" then (load_cookies(); at_exit save_cookies)
-
-
-
View
@@ -500,6 +500,7 @@ type options =
cachetype : string;
server_send_buffer_size: int;
cookie_gc_period: int;
+ cookie_accept_client_values: bool;
cookie_pool_size_min: int;
cookie_pool_size_max: int;
cookie_timer_interval: int;
@@ -587,6 +588,7 @@ let default_options =
cachetype = "public";
server_send_buffer_size = 1024;
cookie_gc_period = 100;
+ cookie_accept_client_values = false;
cookie_pool_size_min = 100;
cookie_pool_size_max = 10000;
cookie_timer_interval = 1;
@@ -691,6 +693,10 @@ let spec_args name =
ServerArg.func ServerArg.int (fun o i -> { o with cookie_gc_period = i }),
"<int>", (sprintf "Cookie GC period in requests (default: %d)" default_options.cookie_gc_period);
+ p"cookie-accept-client-values",
+ ServerArg.func ServerArg.unit (fun o () -> { o with cookie_accept_client_values = true }),
+ "", (sprintf "WARNING: Only with long cookies. Accept cookie values provided by the client instead of generating new one when they aren't found on the server cookie table (default: %b)" default_options.cookie_accept_client_values);
+
p"cookie-pool-size-min",
ServerArg.func ServerArg.int (fun o i -> { o with cookie_pool_size_min = i }),
"<int>", (sprintf "Cookie pool size minimum (default: %d)" default_options.cookie_pool_size_min);
@@ -854,6 +860,7 @@ let make (name:string) (opt:options) (sched:Scheduler.t) : t =
HSCm.use_long_cookies := opt.long_cookies;
(if !HSCm.use_long_cookies then CookieLong.init_cookies else Cookie2.init_cookies)
~sched ~gc_period:opt.cookie_gc_period
+ ~accept_client_values:opt.cookie_accept_client_values
~pool_min:opt.cookie_pool_size_min
~pool_max:opt.cookie_pool_size_max
~timer_interval:opt.cookie_timer_interval

0 comments on commit b429b69

Please sign in to comment.