(* $Id: netgssapi.ml 1588 2011-04-28 13:59:54Z gerd $ *)
open Printf
type oid = int array
type oid_set = oid list
type credential = < otype : [ `Credential ] >
type context = < otype : [ `Context ]; valid : bool >
type token = string
type interprocess_token = string
type calling_error =
[ `None
| `Inaccessible_read
| `Inaccessible_write
| `Bad_structure
]
type routine_error =
[ `None
| `Bad_mech
| `Bad_name
| `Bad_nametype
| `Bad_bindings
| `Bad_status
| `Bad_mic
| `No_cred
| `No_context
| `Defective_token
| `Defective_credential
| `Credentials_expired
| `Context_expired
| `Failure
| `Bad_QOP
| `Unauthorized
| `Unavailable
| `Duplicate_element
| `Name_not_mn
]
type suppl_status =
[ `Continue_needed
| `Duplicate_token
| `Old_token
| `Unseq_token
| `Gap_token
]
type major_status = calling_error * routine_error * suppl_status list
type minor_status = int32
type name = < otype : [ `Name ] >
type address =
[ `Unspecified of string
| `Local of string
| `Inet of Unix.inet_addr
| `Nulladdr
| `Other of int32 * string
]
type channel_bindings = address * address * string
type cred_usage = [ `Initiate |`Accept | `Both ]
type qop = < otype : [ `QOP ] >
type message = Xdr_mstring.mstring list
type ret_flag =
[ `Deleg_flag | `Mutual_flag | `Replay_flag | `Sequence_flag
| `Conf_flag | `Integ_flag | `Anon_flag | `Prot_ready_flag
| `Trans_flag
]
type req_flag =
[ `Deleg_flag | `Mutual_flag | `Replay_flag | `Sequence_flag
| `Conf_flag | `Integ_flag | `Anon_flag
]
class type gss_api =
object
method provider : string
method no_credential : credential
method no_name : name
method accept_sec_context :
't . context:context option ->
acceptor_cred:credential ->
input_token:token ->
chan_bindings:channel_bindings option ->
out:( src_name:name ->
mech_type:oid ->
output_context:context option ->
output_token:token ->
ret_flags:ret_flag list ->
time_rec:[ `Indefinite | `This of float] ->
delegated_cred:credential ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method acquire_cred :
't . desired_name:name ->
time_req:[`None | `Indefinite | `This of float] ->
desired_mechs:oid_set ->
cred_usage:cred_usage ->
out:( cred:credential ->
actual_mechs:oid_set ->
time_rec:[ `Indefinite | `This of float] ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method add_cred :
't . input_cred:credential ->
desired_name:name ->
desired_mech:oid ->
cred_usage:cred_usage ->
initiator_time_req:[`None | `Indefinite | `This of float] ->
acceptor_time_req:[`None | `Indefinite | `This of float] ->
out:( output_cred:credential ->
actual_mechs:oid_set ->
initiator_time_rec:[ `Indefinite | `This of float] ->
acceptor_time_rec:[ `Indefinite | `This of float] ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method canonicalize_name :
't . input_name:name ->
mech_type:oid ->
out:( output_name:name ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method compare_name :
't . name1:name ->
name2:name ->
out:( name_equal:bool ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method context_time :
't . context:context ->
out:( time_rec:[ `Indefinite | `This of float] ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method delete_sec_context :
't . context:context ->
out:( minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method display_name :
't . input_name:name ->
out:( output_name:string ->
output_name_type:oid ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method display_minor_status :
't . minor_status:minor_status ->
mech_type: oid ->
out:( status_strings: string list ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method export_name :
't . name:name ->
out:( exported_name:string ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method export_sec_context :
't . context:context ->
out:( interprocess_token:interprocess_token ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method get_mic :
't . context:context ->
qop_req:qop option ->
message:message ->
out:( msg_token:token ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method import_name :
't . input_name:string ->
input_name_type:oid ->
out:( output_name:name ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method import_sec_context :
't . interprocess_token:interprocess_token ->
out:( context:context option ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method indicate_mechs :
't . out:( mech_set:oid_set ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method init_sec_context :
't . initiator_cred:credential ->
context:context option ->
target_name:name ->
mech_type:oid ->
req_flags:req_flag list ->
time_rec:float option ->
chan_bindings:channel_bindings option ->
input_token:token option ->
out:( actual_mech_type:oid ->
output_context:context option ->
output_token:token ->
ret_flags:ret_flag list ->
time_rec:[ `Indefinite | `This of float ] ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method inquire_context :
't . context:context ->
out:( src_name:name ->
targ_name:name ->
lifetime_req : [ `Indefinite | `This of float ] ->
mech_type:oid ->
ctx_flags:ret_flag list ->
locally_initiated:bool ->
is_open:bool ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method inquire_cred :
't . cred:credential ->
out:( name:name ->
lifetime: [ `Indefinite | `This of float ] ->
cred_usage:cred_usage ->
mechanisms:oid_set ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method inquire_cred_by_mech :
't . cred:credential ->
mech_type:oid ->
out:( name:name ->
initiator_lifetime: [ `Indefinite | `This of float ] ->
acceptor_lifetime: [ `Indefinite | `This of float ] ->
cred_usage:cred_usage ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method inquire_mechs_for_name :
't . name:name ->
out:( mech_types:oid_set ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method inquire_names_for_mech :
't . mechanism:oid ->
out:( name_types:oid_set ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method process_context_token :
't . context:context ->
token:token ->
out:( minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method unwrap :
't . context:context ->
input_message:message ->
output_message_preferred_type:[ `String | `Memory ] ->
out:( output_message:message ->
conf_state:bool ->
qop_state:qop ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method verify_mic :
't . context:context ->
message:message ->
token:token ->
out:( qop_state:qop ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method wrap :
't . context:context ->
conf_req:bool ->
qop_req:qop option ->
input_message:message ->
output_message_preferred_type:[ `String | `Memory ] ->
out:( conf_state:bool ->
output_message:message ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
method wrap_size_limit :
't . context:context ->
conf_req:bool ->
qop_req:qop option ->
req_output_size:int ->
out:( max_input_size:int ->
minor_status:minor_status ->
major_status:major_status ->
unit ->
't
) -> unit -> 't
end
let string_of_calling_error =
function
| `None -> "-"
| `Inaccessible_read -> "Inaccessible_read"
| `Inaccessible_write -> "Inaccessible_write"
| `Bad_structure -> "Bad_structure"
let string_of_routine_error =
function
| `None -> "-"
| `Bad_mech -> "Bad_mech"
| `Bad_name -> "Bad_name"
| `Bad_nametype -> "Bad_nametype"
| `Bad_bindings -> "Bad_bindings"
| `Bad_status -> "Bad_status"
| `Bad_mic -> "Bad_mic"
| `No_cred -> "No_cred"
| `No_context -> "No_context"
| `Defective_token -> "Defective_token"
| `Defective_credential -> "Defective_credential"
| `Credentials_expired -> "Credentials_expired"
| `Context_expired -> "Context_expired"
| `Failure -> "Failure"
| `Bad_QOP -> "Bad_QOP"
| `Unauthorized -> "Unauthorized"
| `Unavailable -> "Unavailable"
| `Duplicate_element -> "Duplicate_element"
| `Name_not_mn -> "Name_not_mn"
let string_of_suppl_status =
function
| `Continue_needed -> "Continue_needed"
| `Duplicate_token -> "Duplicate_token"
| `Old_token -> "Old_token"
| `Unseq_token -> "Unseq_token"
| `Gap_token -> "Gap_token"
let string_of_major_status (ce,re,sl) =
let x = String.concat "," (List.map string_of_suppl_status sl) in
"<major:" ^ string_of_calling_error ce ^
";" ^ string_of_routine_error re ^
(if x <> "" then ";" ^ x else "") ^
">"
let nt_hostbased_service =
[| 1; 3; 6; 1; 5; 6; 2 |]
let nt_user_name =
[| 1; 2; 840; 113554; 1; 2; 1; 1 |]
let nt_machine_uid_name =
[| 1; 2; 840; 113554; 1; 2; 1; 2 |]
let nt_string_uid_name =
[| 1; 2; 840; 113554; 1; 2; 1; 3 |]
let nt_anonymous =
[| 1; 3; 6; 1; 5; 6; 3 |]
let nt_export_name =
[| 1; 3; 6; 1; 5; 6; 4 |]
let parse_hostbased_service s =
try
let k = String.index s '@' in
(String.sub s 0 k, String.sub s (k+1) (String.length s - k - 1))
with
| Not_found ->
failwith "Netgssapi.parse_hostbased_service"
(* Encodings *)
(* This follows RFC 2078, but additional information about DER
can also be found in ITU-T X.690:
http://www.itu.int/ITU-T/studygroups/com17/languages/X.690-0207.pdf
*)
let oid_to_string oid =
"{" ^ String.concat " " (List.map string_of_int (Array.to_list oid)) ^ "}"
let oid_str_re = Netstring_str.regexp "[ \t\r\n]+\\|{\\|}"
let string_to_oid s =
let rec cont1 l =
match l with
| Netstring_str.Delim "{" :: l' -> cont2 l'
| Netstring_str.Delim "}" :: _ -> raise Not_found
| Netstring_str.Delim _ :: l' -> cont1 l' (* whitespace *)
| _ -> raise Not_found
and cont2 l = (* after "{" *)
match l with
| Netstring_str.Delim "{" :: _ -> raise Not_found
| Netstring_str.Delim "}" :: l' -> cont3 l'
| Netstring_str.Delim _ :: l' -> cont2 l'
| Netstring_str.Text s :: l' -> int_of_string s :: cont2 l'
| _ -> raise Not_found
and cont3 l = (* after "}" *)
match l with
| Netstring_str.Delim ("{" | "}") :: _ -> raise Not_found
| Netstring_str.Delim _ :: l' -> cont3 l'
| [] -> []
| _ -> raise Not_found
in
let l =
Netstring_str.full_split oid_str_re s in
try
Array.of_list(cont1 l)
with
| _ -> failwith "Netgssapi.string_to_oid"
let encode_subidentifier buf n =
(* See 8.19 of ITU.T X.690 *)
let rec encode n =
if n < 128 then
[ Char.chr n ]
else
(Char.chr ((n land 127) lor 128)) :: encode (n lsr 7) in
if n < 0 then failwith "Netgssapi.encode_subidentifier";
let l = encode n in
List.iter (Buffer.add_char buf) l
let decode_subidentifier s cursor =
let n = ref 0 in
let s_len = String.length s in
while !cursor < s_len && s.[ !cursor ] >= '\x80' do
let c = Char.code (s.[ !cursor ]) - 128 in
n := (!n lsl 7) lor c;
incr cursor
done;
if !cursor < s_len then (
let c = Char.code (s.[ !cursor ]) in
n := (!n lsl 7) lor c;
incr cursor;
!n
)
else failwith "Netgssapi.decode_subidentifier"
let encode_definite_length buf n =
(* See 8.1.3 of ITU-T X.690 *)
let rec encode n =
if n < 256 then
[ Char.chr n ]
else
(Char.chr (n land 255)) :: encode (n lsr 8) in
if n < 128 then (
Buffer.add_char buf (Char.chr n)
) else (
let l = encode n in
Buffer.add_char buf (Char.chr (List.length l + 128));
List.iter (Buffer.add_char buf) l
)
let decode_definite_length s cursor =
let s_len = String.length s in
if !cursor < s_len then (
let c = s.[ !cursor ] in
incr cursor;
if c < '\x80' then (
Char.code c
)
else (
let p = Char.code c - 128 in
let n = ref 0 in
for q = 1 to p do
if !cursor < s_len then (
let c = s.[ !cursor ] in
incr cursor;
n := (!n lsl 8) lor Char.code c;
)
else failwith "Netgssapi.decode_definite_length"
done;
!n
)
)
else failwith "Netgssapi.decode_definite_length"
let oid_to_der oid =
match Array.to_list oid with
| [] ->
failwith "Netgssapi.oid_to_der: empty OID"
| [ _ ] ->
failwith "Netgssapi.oid_to_der: invalid OID"
| top :: second :: subids ->
if top < 0 || top > 5 then (* actually only 0..2 possible *)
failwith "Netgssapi.oid_to_der: invalid OID";
if second < 0 || second > 39 then
failwith "Netgssapi.oid_to_der: invalid OID";
let subids_buf = Buffer.create 50 in
List.iter (encode_subidentifier subids_buf) subids;
let buf = Buffer.create 50 in
Buffer.add_char buf '\x06';
encode_definite_length buf (Buffer.length subids_buf + 1);
Buffer.add_char buf (Char.chr (top * 40 + second));
Buffer.add_buffer buf subids_buf;
Buffer.contents buf
let der_to_oid der cursor =
try
let der_len = String.length der in
if !cursor >= der_len then raise Not_found;
let c = der.[ !cursor ] in
incr cursor;
if c <> '\x06' then raise Not_found;
let oid_len = decode_definite_length der cursor in
let lim = !cursor + oid_len in
if lim > der_len then raise Not_found;
if oid_len = 0 then raise Not_found;
let c = Char.code der.[ !cursor ] in
incr cursor;
let top = c / 40 in
let second = c mod 40 in
let oid = ref [ second; top ] in
while !cursor < lim do
let subid = decode_subidentifier der cursor in
oid := subid :: !oid;
done;
if !cursor <> lim then raise Not_found;
Array.of_list (List.rev !oid)
with
| _ -> failwith "Netgssapi.der_to_oid"
let wire_encode_token oid token =
try
let buf = Buffer.create (50 + String.length token) in
Buffer.add_char buf '\x60';
let oid_as_der = oid_to_der oid in
let len = String.length oid_as_der + String.length token in
encode_definite_length buf len;
Buffer.add_string buf oid_as_der;
Buffer.add_string buf token;
Buffer.contents buf
with
| _ -> failwith "Netgssapi.wire_encode_token"
let wire_decode_token s cursor =
try
let s_len = String.length s in
if !cursor > s_len then raise Not_found;
let c = s.[ !cursor ] in
incr cursor;
if c <> '\x60' then raise Not_found;
let len = decode_definite_length s cursor in
let lim = !cursor + len in
if lim > s_len then raise Not_found;
let oid = der_to_oid s cursor in
if !cursor > lim then raise Not_found;
let token = String.sub s !cursor (lim - !cursor) in
cursor := lim;
(oid, token)
with
| _ -> failwith "Netgsspi.wire_decode_token"
let encode_exported_name mech_oid name =
let buf = Buffer.create (50 + String.length name) in
Buffer.add_string buf "\x04\x01";
let mech_oid_der = oid_to_der mech_oid in
let mech_oid_len = String.length mech_oid_der in
if mech_oid_len > 65535 then
failwith "Netgssapi.encode_exported_name: OID too long";
Buffer.add_char buf (Char.chr (mech_oid_len / 256));
Buffer.add_char buf (Char.chr (mech_oid_len mod 256));
Buffer.add_string buf mech_oid_der;
let name_len = String.length name in
let n3 = (name_len lsr 24) land 0xff in
let n2 = (name_len lsr 16) land 0xff in
let n1 = (name_len lsr 8) land 0xff in
let n0 = name_len land 0xff in
Buffer.add_char buf (Char.chr n3);
Buffer.add_char buf (Char.chr n2);
Buffer.add_char buf (Char.chr n1);
Buffer.add_char buf (Char.chr n0);
Buffer.add_string buf name;
Buffer.contents buf
let decode_exported_name s cursor =
try
let s_len = String.length s in
if !cursor + 4 > s_len then raise Not_found;
let c0 = s.[ !cursor ] in
incr cursor;
let c1 = s.[ !cursor ] in
incr cursor;
let c2 = s.[ !cursor ] in
incr cursor;
let c3 = s.[ !cursor ] in
incr cursor;
if c0 <> '\x04' || c1 <> '\x01' then raise Not_found;
let mech_oid_len = (Char.code c2 lsl 8) + Char.code c3 in
let mech_start = !cursor in
if mech_start + mech_oid_len > s_len then raise Not_found;
let mech_oid = der_to_oid s cursor in
if !cursor <> mech_start + mech_oid_len then raise Not_found;
if !cursor + 4 > s_len then raise Not_found;
let n0 = Char.code s.[ !cursor ] in
incr cursor;
let n1 = Char.code s.[ !cursor ] in
incr cursor;
let n2 = Char.code s.[ !cursor ] in
incr cursor;
let n3 = Char.code s.[ !cursor ] in
incr cursor;
let name_len = (n0 lsl 24) lor (n1 lsl 16) lor (n2 lsl 8) lor (n3) in
if !cursor + name_len > s_len then raise Not_found;
let name = String.sub s !cursor name_len in
cursor := !cursor + name_len;
(mech_oid, name)
with
| _ -> failwith "Netgssapi.decode_exported_name"
let encode_seq_nr x =
let n7 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 56)
0xffL) in
let n6 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 48)
0xffL) in
let n5 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 40)
0xffL) in
let n4 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 32)
0xffL) in
let n3 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 24)
0xffL) in
let n2 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 16)
0xffL) in
let n1 = Int64.to_int (Int64.logand (Int64.shift_right_logical x 8)
0xffL) in
let n0 = Int64.to_int (Int64.logand x 0xffL) in
let s = String.create 8 in
s.[0] <- Char.chr n7;
s.[1] <- Char.chr n6;
s.[2] <- Char.chr n5;
s.[3] <- Char.chr n4;
s.[4] <- Char.chr n3;
s.[5] <- Char.chr n2;
s.[6] <- Char.chr n1;
s.[7] <- Char.chr n0;
s
let decode_seq_nr s =
assert(String.length s = 8);
let n7 = Int64.of_int (Char.code s.[0]) in
let n6 = Int64.of_int (Char.code s.[1]) in
let n5 = Int64.of_int (Char.code s.[2]) in
let n4 = Int64.of_int (Char.code s.[3]) in
let n3 = Int64.of_int (Char.code s.[4]) in
let n2 = Int64.of_int (Char.code s.[5]) in
let n1 = Int64.of_int (Char.code s.[6]) in
let n0 = Int64.of_int (Char.code s.[7]) in
Int64.logor
(Int64.shift_left n7 56)
(Int64.logor
(Int64.shift_left n6 48)
(Int64.logor
(Int64.shift_left n5 40)
(Int64.logor
(Int64.shift_left n4 32)
(Int64.logor
(Int64.shift_left n3 24)
(Int64.logor
(Int64.shift_left n2 16)
(Int64.logor
(Int64.shift_left n1 8)
n0))))))
let create_mic_token ~sent_by_acceptor ~acceptor_subkey ~sequence_number
~get_mic ~message =
let header =
sprintf
"\x04\x04%c\xff\xff\xff\xff\xff%s"
(Char.chr ( (if sent_by_acceptor then 1 else 0) lor
(if acceptor_subkey then 4 else 0) ) )
(encode_seq_nr sequence_number) in
let mic =
get_mic (message @ [Xdr_mstring.string_to_mstring header] ) in
header ^ mic
let parse_mic_token_header s =
try
if String.length s < 16 then raise Not_found;
if s.[0] <> '\x04' || s.[1] <> '\x04' then raise Not_found;
if String.sub s 3 5 <> "\xff\xff\xff\xff\xff" then raise Not_found;
let flags = Char.code s.[2] in
if flags land 7 <> flags then raise Not_found;
let sent_by_acceptor = (flags land 1) <> 0 in
let acceptor_subkey = (flags land 4) <> 0 in
let sequence_number = decode_seq_nr (String.sub s 8 8) in
(sent_by_acceptor, acceptor_subkey, sequence_number)
with Not_found -> failwith "Netgssapi.parse_mic_token_header"
let verify_mic_token ~get_mic ~message ~token =
try
ignore(parse_mic_token_header token);
let header = String.sub token 0 16 in
let mic = get_mic (message @ [Xdr_mstring.string_to_mstring header]) in
mic = (String.sub token 16 (String.length token - 16))
with
| _ -> false
let create_wrap_token_conf ~sent_by_acceptor ~acceptor_subkey
~sequence_number ~get_ec ~encrypt_and_sign
~message =
let ec = get_ec (Xdr_mstring.length_mstrings message + 16) in
let header =
sprintf
"\x05\x04%c\xff%c%c\000\000%s"
(Char.chr ( (if sent_by_acceptor then 1 else 0) lor
(if acceptor_subkey then 4 else 0) lor 2 ) )
(Char.chr ((ec lsr 8) land 0xff))
(Char.chr (ec land 0xff))
(encode_seq_nr sequence_number) in
let filler =
String.make ec '\000' in
let encrypted =
encrypt_and_sign (message @
[ Xdr_mstring.string_to_mstring
(filler ^ header)
]
) in
Xdr_mstring.string_to_mstring header :: encrypted
let parse_wrap_token_header m =
try
let l = Xdr_mstring.length_mstrings m in
if l < 16 then raise Not_found;
let s = Xdr_mstring.prefix_mstrings m 16 in
if s.[0] <> '\x05' || s.[1] <> '\x04' then raise Not_found;
if s.[3] <> '\xff' then raise Not_found;
let flags = Char.code s.[2] in
if flags land 7 <> flags then raise Not_found;
let sent_by_acceptor = (flags land 1) <> 0 in
let sealed = (flags land 2) <> 0 in
let acceptor_subkey = (flags land 4) <> 0 in
let sequence_number = decode_seq_nr (String.sub s 8 8) in
(sent_by_acceptor, sealed, acceptor_subkey, sequence_number)
with Not_found -> failwith "Netgssapi.parse_wrap_token_header"
let unwrap_wrap_token_conf ~decrypt_and_verify ~token =
let (_, sealed, _, _) = parse_wrap_token_header token in
if not sealed then
failwith "Netgssapi.unwrap_wrap_token_conf: not sealed";
let s = Xdr_mstring.prefix_mstrings token 16 in
let ec = ((Char.code s.[4]) lsl 8) lor (Char.code s.[5]) in
let rrc = ((Char.code s.[6]) lsl 8) lor (Char.code s.[7]) in
let l_decrypt = Xdr_mstring.length_mstrings token - 16 in
let rrc_eff = rrc mod l_decrypt in
let u =
if rrc = 0 then
Xdr_mstring.shared_sub_mstrings token 16 l_decrypt
else (
Xdr_mstring.shared_sub_mstrings token (rrc_eff+16) (l_decrypt - rrc_eff)
@ Xdr_mstring.shared_sub_mstrings token 16 rrc_eff
) in
(*
let u = String.create l_decrypt in
String.blit token (rrc_eff+16) u 0 (l_decrypt - rrc_eff);
String.blit token 16 u (l_decrypt - rrc_eff) rrc_eff;
*)
let decrypted =
try decrypt_and_verify u
with _ ->
failwith "Netgssapi.unwrap_wrap_token_conf: cannot decrypt" in
let l_decrypted = Xdr_mstring.length_mstrings decrypted in
if l_decrypted < ec + 16 then
failwith "Netgssapi.unwrap_wrap_token_conf: bad EC";
let h1 = Xdr_mstring.prefix_mstrings token 16 in
let h2 =
Xdr_mstring.concat_mstrings
(Xdr_mstring.shared_sub_mstrings decrypted (l_decrypted - 16) 16) in
if h1 <> h2 then
failwith "Netgssapi.unwrap_wrap_token_conf: header integrity mismatch";
Xdr_mstring.shared_sub_mstrings decrypted 0 (l_decrypted - ec - 16)
