135 lines
4.3 KiB
OCaml
135 lines
4.3 KiB
OCaml
|
(* Ocsigen
|
|||
|
* http://www.ocsigen.org
|
|||
|
* lwt_lib.ml Copyright (C) 2007 Pierre Clairambault
|
|||
|
* Laboratoire PPS - CNRS Universit<EFBFBD> Paris Diderot
|
|||
|
*
|
|||
|
* This program is free software; you can redistribute it and/or modify
|
|||
|
* it under the terms of the GNU Lesser General Public License as published by
|
|||
|
* the Free Software Foundation, with linking exceptions;
|
|||
|
* either version 2.1 of the License, or (at your option) any later version.
|
|||
|
* See COPYING file for details.
|
|||
|
*
|
|||
|
* 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 Lesser General Public License for more details.
|
|||
|
*
|
|||
|
* You should have received a copy of the GNU Lesser 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.
|
|||
|
*)
|
|||
|
|
|||
|
open Weak
|
|||
|
open Unix
|
|||
|
open Lwt
|
|||
|
|
|||
|
let switch_time = 30.
|
|||
|
|
|||
|
exception Not_in_table
|
|||
|
(* We use a specific Not_in_table exception, because since we're caching
|
|||
|
* threads, we can't for the moment behave differently whether a request
|
|||
|
* is not found in the table or not found as a host.*)
|
|||
|
|
|||
|
|
|||
|
module WeakHashtbl = Make(
|
|||
|
struct
|
|||
|
type t = string * (Unix.host_entry Lwt.t) * float
|
|||
|
let equal = (fun (a,b,c) -> fun (a',b',c') -> a=a')
|
|||
|
let hash = fun (a,b,c) -> Hashtbl.hash a
|
|||
|
end
|
|||
|
)
|
|||
|
|
|||
|
open WeakHashtbl
|
|||
|
|
|||
|
let keeper : (((string*(Unix.host_entry Lwt.t)*float) list) *
|
|||
|
((string*(Unix.host_entry Lwt.t)*float) list)) ref = ref ([],[])
|
|||
|
let cache = create 0
|
|||
|
let dummy_addr : Unix.host_entry =
|
|||
|
{h_name="dummy";
|
|||
|
h_aliases=[||];
|
|||
|
h_addrtype=Unix.PF_INET;
|
|||
|
h_addr_list = [||]}
|
|||
|
|
|||
|
let cache_find d = try
|
|||
|
match (find cache (d,return dummy_addr,0.)) with (_,h,t) -> (h,t)
|
|||
|
with
|
|||
|
|Not_found -> raise Not_in_table
|
|||
|
|e -> raise e
|
|||
|
|
|||
|
let gethostbyname d =
|
|||
|
Lwt.catch
|
|||
|
(fun _ ->
|
|||
|
let (h,t) = cache_find d
|
|||
|
and t' = Unix.time () in
|
|||
|
match (t'>t+.60.) with
|
|||
|
| true ->
|
|||
|
(remove cache) (d,h,t);
|
|||
|
raise_lwt Not_in_table
|
|||
|
| false -> h)
|
|||
|
(function
|
|||
|
| Not_in_table ->
|
|||
|
let t = Unix.time() and
|
|||
|
h = Lwt_preemptive.detach Unix.gethostbyname d in
|
|||
|
let entry = (d,h,t) in
|
|||
|
add cache entry;
|
|||
|
(match !keeper with (a,b) -> keeper:= (entry::a,b));
|
|||
|
h
|
|||
|
| e -> raise_lwt e)
|
|||
|
(* Begin getaddrinfo caching *)
|
|||
|
|
|||
|
|
|||
|
module WeakAddrInfo = Make(
|
|||
|
struct
|
|||
|
type t = string*string*(Unix.getaddrinfo_option list)*((Unix.addr_info list) Lwt.t)*float
|
|||
|
let equal = (fun (h,s,o,i,t) -> fun (h',s',o',i',t') -> (h,s,o)=(h',s',o'))
|
|||
|
let hash = fun (h,s,o,i,t) -> Hashtbl.hash (h,s,o)
|
|||
|
end
|
|||
|
)
|
|||
|
|
|||
|
let keeper6 : (((string*string*(Unix.getaddrinfo_option list)*((Unix.addr_info list) Lwt.t)*float) list) *
|
|||
|
((string*string*(Unix.getaddrinfo_option list)*((Unix.addr_info list) Lwt.t)*float) list)) ref = ref
|
|||
|
([],[])
|
|||
|
|
|||
|
let switch_thread : unit Lwt.t=
|
|||
|
let rec switch_worker () =
|
|||
|
Lwt_unix.sleep switch_time >>= fun () ->
|
|||
|
(match !keeper with (a,b) -> keeper:=([],a));
|
|||
|
(match !keeper6 with (a,b) -> keeper6:=([],a));
|
|||
|
switch_worker ()
|
|||
|
in
|
|||
|
switch_worker()
|
|||
|
|
|||
|
let cache6 = WeakAddrInfo.create 0
|
|||
|
|
|||
|
let cache_find6 d s o = try
|
|||
|
match (WeakAddrInfo.find cache6 (d,s,o,return [],0.)) with (_,_,_,i,t) -> (i,t)
|
|||
|
with
|
|||
|
|Not_found -> raise Not_in_table
|
|||
|
|e -> raise e
|
|||
|
|
|||
|
|
|||
|
let getaddrinfo d s o =
|
|||
|
Lwt.catch
|
|||
|
(fun _ ->
|
|||
|
let (i,t) = cache_find6 d s o
|
|||
|
and t' = Unix.time() in
|
|||
|
match (t'>t+.60.) with
|
|||
|
| true ->
|
|||
|
WeakAddrInfo.remove cache6 (d,s,o,i,t);
|
|||
|
raise_lwt Not_in_table
|
|||
|
| false -> i)
|
|||
|
(function
|
|||
|
| Not_in_table ->
|
|||
|
let t = Unix.time () and
|
|||
|
i = Lwt_preemptive.detach (Unix.getaddrinfo d s) o in
|
|||
|
let entry = (d,s,o,i,t) in
|
|||
|
WeakAddrInfo.add cache6 entry;
|
|||
|
(match !keeper6 with (a,b) -> keeper6 := (entry::a,b));
|
|||
|
i
|
|||
|
| e -> raise_lwt e)
|
|||
|
|
|||
|
|
|||
|
let getnameinfo s l =
|
|||
|
(*VVV <20> impl<70>menter !!! *)
|
|||
|
Lwt_preemptive.detach (Unix.getnameinfo s) l
|