(* $Id: rpc_auth_dh.ml 1553 2011-02-28 00:12:27Z gerd $
* ----------------------------------------------------------------------
*
*)
(* See RFC 2695 *)
open Xdr
open Rtypes
open Rpc
module DS = Crypt_des.Cryptsystem;; (* DS = DES system *)
module DM = Crypt_des.Cryptmodes;; (* DM = DES modes *)
module A = Rpc_key_aux;;
type state =
Init
(* Not yet authenticated *)
| Resynchronize
(* like Init, but resynchronize time first *)
| Auth_fullname_sent of (DS.key * float * int32 * int32)
(* The fullname has been sent to the server. The parameters are the
* conversation key, the time when the key was generated, and the
* timestamp (seconds, microseconds)
*)
| Auth_nickname_sent of (DS.key * float * int32 * int32)
(* The nickname has been sent to the server. The parameters are the
* conversation key, the time when the key was generated, and the
* timestamp (seconds, microseconds)
*)
| Auth_accepted of (DS.key * float * int32)
(* The credentials have been accepted by the server. The parameters
* are the conversation key, the time when the key was generated, and
* the nickname to use for further calls.
*)
let domainname() =
(* Return the NIS domain name. Just calling "domainname" seems to be the
* most portable way.
*)
(* TODO: Better do not invoke an external program here. May be a security
* problem with setuid programs
*)
if Unix.getuid() <> Unix.geteuid() then
failwith "Rpc_auth_dh.domainname (setuid)";
if Unix.getgid() <> Unix.getegid() then
failwith "Rpc_auth_dh.domainname (setgid)";
let f = Unix.open_process_in "domainname" in
try
let name = input_line f in
match Unix.close_process_in f with
Unix.WEXITED 0 ->
name
| _ ->
failwith "Rpc_auth_dh.domainname"
with
End_of_file ->
ignore(Unix.close_process_in f);
failwith "Rpc_auth_dh.domainname"
;;
class client_auth_session proto getdeviation ttl key_lifetime ksconn srv_netname
: Rpc_client.auth_session =
object
val mutable state = Init
val mutable n_failures = 0
val keyserv = lazy (Rpc_key_service.create ?connector:ksconn ())
val ttl = ttl
val key_lifetime = key_lifetime
val mutable current_time_deviation = 0.0
(* positive means: the time of the server is ahead *)
val authdh_cred_type =
Xdr.validate_xdr_type A.xdrt_authdh_cred
val authdh_fullname_verf_type =
Xdr.validate_xdr_type A.xdrt_authdh_fullname_verf
val authdh_nickname_verf_type =
Xdr.validate_xdr_type A.xdrt_authdh_nickname_verf
val authdh_server_verf_type =
Xdr.validate_xdr_type A.xdrt_authdh_server_verf
method auth_protocol = proto
method next_credentials client prog proc xid =
(* Do we need to resynchronize? *)
if state = Resynchronize then begin
match Rpc_client.get_peer_name client with
Unix.ADDR_UNIX _ ->
state <- Init; (* do not resychronize *)
| Unix.ADDR_INET(host,_) ->
current_time_deviation <- getdeviation host;
state <- Init;
end;
(* Do we need a new conversation key? *)
( match state with
Auth_accepted(_,kt,_) ->
if (Unix.time() -. kt) > float key_lifetime then
state <- Init
| _ ->
()
);
(* Protocol implementation: *)
match state with
Resynchronize ->
assert false
| Init
| Auth_fullname_sent(_,_,_,_) (* handle this case for robustness *)
| Auth_nickname_sent(_,_,_,_) -> (* handle this case for robustness *)
(* Send AUTH_DH credentials with fullname: *)
(* First, create a new conversation key. *)
let keyserv = Lazy.force keyserv in
let conv_key = Rpc_key_service.generate keyserv in
assert(String.length conv_key = 8);
let conv_key' = DS.prepare conv_key in
(* Encrypt the timestamp and the ttl value: *)
let _now = Unix.gettimeofday() in
let now = _now +. current_time_deviation -. float (ttl/2) in
let now_secs = Int32.of_float now in
let now_usecs = Int32.of_float
(now *. 1000000.0 -.
Int32.to_float now_secs *. 1000000.0) in
let ttl0 = Int32.of_int ttl in
let ttl1 = Int32.of_int (ttl-1) in
let timestamp = int4_as_string (int4_of_int32 now_secs) ^
int4_as_string (int4_of_int32 now_usecs) ^
int4_as_string (int4_of_int32 ttl0) ^
int4_as_string (int4_of_int32 ttl1) in
assert(String.length timestamp = 16);
let _, t1t2w1w2 =
DM.encrypt_cbc conv_key' (0,0,0,0) timestamp in
let t = String.sub t1t2w1w2 0 8 in
let w1 = String.sub t1t2w1w2 8 4 in
let w2 = String.sub t1t2w1w2 12 4 in
(* Encrypt the conversation key: *)
let enc_conv_key = Rpc_key_service.encrypt
keyserv srv_netname conv_key in
(* Get the client's netname: *)
let clnt_netname,_,_ = Rpc_key_service.net_get keyserv in
(* Pack the result: *)
let fullname = { A.name = clnt_netname;
A.key = enc_conv_key;
A.w1 = w1;
} in
let fullname_verf = { A.full_ts = t;
A.w2 = w2;
} in
let cred = `adn_fullname fullname in
let xdr_cred = A._of_authdh_cred cred in
let xdr_verf = A._of_authdh_fullname_verf fullname_verf in
state <- Auth_fullname_sent(conv_key', _now, now_secs, now_usecs);
("AUTH_DH", Xdr.pack_xdr_value_as_string
xdr_cred authdh_cred_type [],
"AUTH_DH", Xdr.pack_xdr_value_as_string
xdr_verf authdh_fullname_verf_type [],
None,
None
)
(* Note: IMHO, it is wrong that the verifier is not a discriminated
* union like the credential. RFC 2695 is very clear about that.
* However, existing software assumes that the verifier is either
* a fullname verifier or a nickname verifier without discriminator.
* (It took several hours to find this out.)
*)
| Auth_accepted(key,keytime,nickname) ->
(* Send nickname credentials: *)
(* New timestamp: *)
let now = Unix.gettimeofday() +. current_time_deviation -.
float (ttl/2) in
let now_secs = Int32.of_float now in
let now_usecs = Int32.of_float
(now *. 1000000.0 -.
Int32.to_float now_secs *. 1000000.0) in
(* Encrypt the timestamp: *)
let enc_secs = ref Int32.zero in
let enc_usecs = ref Int32.zero in
DS.encrypt_ecb_int32 key now_secs now_usecs enc_secs enc_usecs;
let enc_timestamp = int4_as_string (int4_of_int32 !enc_secs) ^
int4_as_string (int4_of_int32 !enc_usecs) in
(* Pass result: *)
let nickname = { A.nickname = nickname } in
let cred = `adn_nickname nickname in
let nickname_verf = { A.nick_ts = enc_timestamp;
A.w = "\000\000\000\000";
} in
let xdr_cred = A._of_authdh_cred cred in
let xdr_verf = A._of_authdh_nickname_verf nickname_verf in
state <- Auth_nickname_sent(key, keytime, now_secs, now_usecs);
("AUTH_DH", Xdr.pack_xdr_value_as_string
xdr_cred authdh_cred_type [],
"AUTH_DH", Xdr.pack_xdr_value_as_string
xdr_verf authdh_nickname_verf_type [],
None, None
)
method server_rejects clnt xid err =
if err = Auth_too_weak then
`Next
else (
n_failures <- n_failures + 1;
if n_failures >= 3 then raise (Rpc_server err);
match state with
Auth_fullname_sent(_,_,_,_)
| Auth_nickname_sent(_,_,_,_) ->
if err = Auth_rejected_verf then
state <- Resynchronize
else
state <- Init;
`Retry
| _ ->
assert false
)
method server_accepts clnt xid flav data =
let check_verifier key kt secs usecs =
if flav <> "AUTH_DH" then raise(Rpc_server Auth_invalid_resp);
let xdr = Xdr.unpack_xdr_value ~fast:true data authdh_server_verf_type [] in
let verf = A._to_authdh_server_verf xdr in
let enc_ts = verf.A.timestamp_verf in
(* Decrypt the timestamp: *)
let enc_ts_msb = Rtypes.mk_int4
(enc_ts.[0],enc_ts.[1],enc_ts.[2],enc_ts.[3]) in
let enc_ts_lsb = Rtypes.mk_int4
(enc_ts.[4],enc_ts.[5],enc_ts.[6],enc_ts.[7]) in
let ts_secs = ref Int32.zero in
let ts_usecs = ref Int32.zero in
DS.decrypt_ecb_int32
key
(Rtypes.int32_of_int4 enc_ts_msb)
(Rtypes.int32_of_int4 enc_ts_lsb)
ts_secs
ts_usecs;
(* Check that ts_secs = secs - 1: *)
if Int32.pred secs <> !ts_secs || usecs <> !ts_usecs then
raise (Rpc_server Auth_invalid_resp);
(* Ok, the server has been verified. *)
state <- Auth_accepted(key, kt, verf.A.new_nickname)
in
n_failures <- 0;
match state with
Auth_fullname_sent(key,kt,secs,usecs) ->
check_verifier key kt secs usecs
| Auth_nickname_sent(key,kt,secs,usecs) ->
check_verifier key kt secs usecs
| _ ->
assert false
end
let getdeviation peer =
try
Rpc_time.remote_time peer -. Unix.time()
with
Rpc_time.Time_not_available -> 0.0
;;
class client_auth_method ?(ttl = 60)
?(getdeviation = getdeviation)
?(key_lifetime = 3600)
?keyserv
srv_netname
: Rpc_client.auth_method =
object(self)
method name = "AUTH_DH"
method new_session clnt user_opt =
if user_opt <> None then
failwith "Rpc_auth_dh: cannot set user name freely";
let s_opt = ref None in
( object(iself)
initializer
let s =
new client_auth_session
(iself : Rpc_client.auth_protocol)
getdeviation ttl key_lifetime keyserv srv_netname in
s_opt := Some s
method state =
match !s_opt with
| None -> assert false
| Some s -> `Done s
method emit _ = assert false
method receive _ = assert false
method auth_method = (self : #Rpc_client.auth_method :>
Rpc_client.auth_method)
end
)
end
let client_auth_method = new client_auth_method
type session =
{ mutable sess_used : bool;
mutable sess_time_created : float; (* server time *)
mutable sess_ttl : int;
mutable sess_timestamp_secs : float; (* the timestamp from the client *)
mutable sess_timestamp_usecs : int;
mutable sess_sockaddr : Unix.sockaddr option;
mutable sess_key : DS.key;
mutable sess_user : string;
}
let a_key = DS.prepare "XXXXXXXX";;
let empty_session() =
{ sess_used = false;
sess_time_created = 0.0;
sess_ttl = 0;
sess_timestamp_secs = 0.0;
sess_timestamp_usecs = 0;
sess_key = a_key;
sess_sockaddr = None;
sess_user = "";
}
type user_rec = (* for the attack detector *)
{ mutable current_period : int;
mutable failures : int;
}
module CID = struct (* connection_id as ordered type *)
type t = Rpc_server.connection_id
let compare = (Pervasives.compare : t -> t -> int)
end
module CID_Set = Set.Make(CID);;
module TS = struct (* timestamps as ordered type *)
type t = float * int (* seconds, microseconds *)
let compare (a_secs,a_usecs) (b_secs,b_usecs) =
match Pervasives.compare a_secs b_secs with
0 -> Pervasives.compare a_usecs b_usecs
| n -> n
end
module TS_Set = Set.Make(TS);;
let _999999 = Int32.of_string "999999";;
let _max_int = Int32.of_int max_int;;
class server_auth_method ?(max_sessions = 1000)
?(max_ttl = 60)
?(key_lifetime = 3600)
?(attack_detector = true)
?keyserv
()
: Rpc_server.auth_method =
object(self)
method name = "AUTH_DH"
method flavors = [ "AUTH_DH" ]
val ks = lazy (Rpc_key_service.create ?connector:keyserv ())
val max_ttl = max_ttl
val key_lifetime = key_lifetime
val user_recs = Hashtbl.create 100
val attack_detector = attack_detector
val authdh_cred_type =
Xdr.validate_xdr_type A.xdrt_authdh_cred
val authdh_fullname_verf_type =
Xdr.validate_xdr_type A.xdrt_authdh_fullname_verf
val authdh_nickname_verf_type =
Xdr.validate_xdr_type A.xdrt_authdh_nickname_verf
val authdh_server_verf_type =
Xdr.validate_xdr_type A.xdrt_authdh_server_verf
val authdh_timestamp_type =
Xdr.validate_xdr_type A.xdrt_authdh_timestamp
val sessions = Array.init max_sessions (fun _ -> empty_session())
val squeue = Queue.create()
(* The oldest session index first; the youngest last *)
val mutable trusted = CID_Set.empty
(* The trusted set of connection_id *)
val mutable n_trusted = 0
(* length of [trusted] *)
(* In [trusted], the connection IDs of authenticated sessions are
* queued up. The queue grows up to [max_sessions] entries; if further
* connections are accepted, the smallest ID is removed.
*
* It would be much better if we could find out which connections are
* really alive (TODO). Currently, it is possible that existing connections
* are deleted from the queue, and that broken connections are contained
* in the queue. It is only a heuristics to prevent immediate denial
* of service if the server is under attack.
*)
val mutable timestamps = TS_Set.empty
(* Set of authenticated timestamps *)
(* The [timestamps] are stored to prevent replay attacks with
* fullname credentials. A credential with the same timestamp as
* an already accepted credential is rejected.
*)
initializer
Array.iteri
(fun k _ -> Queue.add k squeue)
sessions
method private get_session user key addr =
let k = Queue.take squeue in
Queue.add k squeue;
let s = sessions.(k) in
s.sess_used <- true;
s.sess_time_created <- Unix.time();
s.sess_user <- user;
s.sess_key <- key;
s.sess_sockaddr <- addr;
k, s
method private cleanup_timestamps now =
(* Delete entries from [timestamps] that are too old *)
try
while
let (ts_secs, ts_usecs) as ts = TS_Set.min_elt timestamps in
( ts_secs < now -. float max_ttl ) &&
( timestamps <- TS_Set.remove ts timestamps; true )
do
()
done
with
Not_found ->
()
method peek = `None
method authenticate
srv cnid details pass =
let cred_flav, cred_data = details # credential in
let verf_flav, verf_data = details # verifier in
let peername = details # client_addr in
let protect username f =
(* If there are more than 10 failures in the current period of 10 seconds,
* no more calls are accepted.
* This check is done for every user separetely.
*)
let now = truncate (Unix.time() *. 0.1) in
let user_rec =
try
Hashtbl.find user_recs username
with
Not_found ->
let new_user_rec = { current_period = now; failures = 0 } in
Hashtbl.add user_recs username new_user_rec;
new_user_rec
in
if attack_detector &&
user_rec.current_period = now && user_rec.failures > 10
then
begin
(* Last chance: [cnid] is member of [trusted] *)
if not (CID_Set.mem cnid trusted) then
raise(Rpc_server Auth_bad_cred);
end;
try
f()
with
Rpc_server _ as err ->
(* CHECK: We can ignore Auth_rejected_cred here because it
* indicates a replay attack, and there is already protection
* against this type of attack
*)
if user_rec.current_period <> now then begin
user_rec.current_period <- now;
user_rec.failures <- 0
end;
user_rec.failures <- user_rec.failures + 1;
raise err
in
let pass_successful_result nickindex s seconds =
(* Create the verifier to return: *)
let ts_1 = Int32.pred seconds in
let enc_ts_msb = ref Int32.zero in
let enc_ts_lsb = ref Int32.zero in
DS.encrypt_ecb_int32
s.sess_key
ts_1
(Int32.of_int s.sess_timestamp_usecs)
enc_ts_msb
enc_ts_lsb;
let t =
Rtypes.int4_as_string (Rtypes.int4_of_int32 !enc_ts_msb) ^
Rtypes.int4_as_string (Rtypes.int4_of_int32 !enc_ts_lsb) in
let verf =
{ A.timestamp_verf = t;
A.new_nickname = Int32.of_int nickindex;
} in
let ret_data =
Xdr.pack_xdr_value_as_string
(A._of_authdh_server_verf verf) authdh_server_verf_type [] in
pass(Rpc_server.Auth_positive(s.sess_user,
"AUTH_DH",
ret_data,None,None))
in
let now = Unix.gettimeofday() in
self # cleanup_timestamps now;
(* Unpack credentials: *)
let cred_xdr = Xdr.unpack_xdr_value ~fast:true cred_data authdh_cred_type [] in
let cred = A._to_authdh_cred cred_xdr in
if verf_flav <> "AUTH_DH" then raise(Rpc_server Auth_bad_cred);
if String.length verf_data <> 12 then raise(Rpc_server Auth_bad_cred);
(* Is it a fullname or a nickname? *)
begin match cred with
`adn_fullname fn ->
let clnt_netname = fn.A.name in
(* Decrypt the conversation key: *)
(* TODO: Do this asynchronously *)
let conv_key =
try
Rpc_key_service.decrypt (Lazy.force ks) clnt_netname fn.A.key
with
(* Any problem leads to rejection of the credentials.
* Note: This may be difficult to debug
*)
_ -> raise(Rpc_server Auth_bad_cred)
in
let conv_key' =
try DS.prepare conv_key
with Failure _ -> raise(Rpc_server Auth_bad_cred)
in
(* Decrypt timestamp and ttl value: *)
let t1t2w1w2 = String.sub verf_data 0 8 ^
fn.A.w1 ^
String.sub verf_data 8 4 in
let _,ts_string =
DM.decrypt_cbc conv_key' (0,0,0,0) t1t2w1w2 in
let ts = A._to_authdh_timestamp
(Xdr.unpack_xdr_value ~fast:true ts_string authdh_timestamp_type [])
in
(* Check timestamp and ttl values: *)
protect clnt_netname
(fun () ->
let ttl = ts.A.ttl in
let ttl_1 = ts.A.ttl_1 in
let eff_timestamp_secs =
if ts.A.seconds < Int32.zero then
4294967296.0 +. Int32.to_float ts.A.seconds
else
Int32.to_float ts.A.seconds
in
if ts.A.useconds < Int32.zero || ts.A.useconds > _999999 then
raise(Rpc_server Auth_bad_verf);
let eff_timestamp_usecs = Int32.to_int (ts.A.useconds) in
if TS_Set.mem
(eff_timestamp_secs, eff_timestamp_usecs)
timestamps then raise (Rpc_server Auth_rejected_cred);
if ttl_1 <= Int32.zero || ttl <> Int32.succ ttl_1 then
raise(Rpc_server Auth_bad_cred);
let eff_ttl =
if ttl > _max_int then
max_ttl
else
min max_ttl (Int32.to_int ttl)
in
let eff_timestamp = eff_timestamp_secs +.
(float eff_timestamp_usecs *. 0.000001) in
if eff_timestamp > now || eff_timestamp < now -. float eff_ttl
then raise(Rpc_server Auth_bad_cred);
(* The call is accepted! *)
let nickindex, s =
self # get_session clnt_netname conv_key' peername in
s.sess_ttl <- eff_ttl;
s.sess_timestamp_secs <- eff_timestamp_secs;
s.sess_timestamp_usecs <- eff_timestamp_usecs;
(* Update [trusted] *)
trusted <- CID_Set.add cnid trusted;
if n_trusted >= max_sessions then
trusted <- CID_Set.remove (CID_Set.min_elt trusted) trusted
else
n_trusted <- n_trusted + 1;
(* Update [timestamps] *)
timestamps <- TS_Set.add
(eff_timestamp_secs, eff_timestamp_usecs)
timestamps;
(* Return result: *)
pass_successful_result nickindex s ts.A.seconds
);
| `adn_nickname nn ->
let nn_num = nn.A.nickname in
if nn_num < Int32.zero ||
nn_num >= Int32.of_int(Array.length sessions) then
raise(Rpc_server Auth_bad_cred);
let nickindex = Int32.to_int nn_num in
let s = sessions.(nickindex) in
if not s.sess_used then raise(Rpc_server Auth_bad_cred);
if s.sess_sockaddr <> peername then raise(Rpc_server Auth_bad_cred);
(* Temporarily set session to unused (to prevent brute-force attacks
* on nicknames). If an error occurs, the session remains unused.
*)
s.sess_used <- false;
let verf =
A._to_authdh_nickname_verf
(Xdr.unpack_xdr_value ~fast:true verf_data authdh_nickname_verf_type []) in
let enc_ts = verf.A.nick_ts in
if verf.A.w <> "\000\000\000\000" then
raise(Rpc_server Auth_bad_cred); (* not strictly necessary *)
(* Decrypt enc_ts: *)
let enc_ts_msb = Rtypes.mk_int4
(enc_ts.[0],enc_ts.[1],enc_ts.[2],enc_ts.[3]) in
let enc_ts_lsb = Rtypes.mk_int4
(enc_ts.[4],enc_ts.[5],enc_ts.[6],enc_ts.[7]) in
let ts_secs = ref Int32.zero in
let ts_usecs = ref Int32.zero in
DS.decrypt_ecb_int32
s.sess_key
(Rtypes.int32_of_int4 enc_ts_msb)
(Rtypes.int32_of_int4 enc_ts_lsb)
ts_secs
ts_usecs;
if !ts_usecs < Int32.zero || !ts_usecs > _999999 then
raise(Rpc_server Auth_bad_verf);
(* Check whether timestamp is in the accepted window: *)
if now >= s.sess_time_created +. float key_lifetime then
raise(Rpc_server Auth_rejected_verf); (* session timeout *)
let eff_timestamp_secs =
if !ts_secs < Int32.zero then
4294967296.0 +. Int32.to_float !ts_secs
else
Int32.to_float !ts_secs
in
if TS.compare
(eff_timestamp_secs, Int32.to_int !ts_usecs)
(s.sess_timestamp_secs, s.sess_timestamp_usecs) <= 0 then
raise(Rpc_server Auth_rejected_verf);
(* The same timestamp may arrive again because of retransmissions *)
let eff_timestamp = eff_timestamp_secs +.
(Int32.to_float !ts_usecs *. 0.000001) in
let eff_ttl = s.sess_ttl in
if eff_timestamp > now || eff_timestamp < now -. float eff_ttl
then raise(Rpc_server Auth_rejected_verf);
(* The call is accepted! *)
(* Set session again to used *)
s.sess_used <- true;
s.sess_timestamp_secs <- eff_timestamp_secs;
s.sess_timestamp_usecs <- Int32.to_int !ts_usecs;
pass_successful_result nickindex s !ts_secs
end
end;;
let server_auth_method = new server_auth_method
