let print_section_goals (print_previous_sections : (Types.atoms_type Types.term_structure list ->
Types.atoms_type Types.term_structure list ->
Types.atoms_type Types.term_structure list -> 'a))
(goals : Types.goals_type list) : unit =
let filename = ref "" in
let secrecy_info = ref [] in
let auth_info = ref [] in
let wauth_info = ref [] in
let secrecy = ref 0 in
let auth = ref 0 in
let wauth = ref 0 in
let ltl = ref 0 in
let print_secret_attack_state xid =
let sk = Globals.string_id#get_name xid in
prout_endline ("attack_state secrecy_of_"^sk^" (MGoal,ASGoal) :=");
prout_endline " iknows(MGoal).";
prout_endline (" secret(MGoal,"^sk^",ASGoal) &");
prout_endline " not(contains(i,ASGoal))";
prout_newline()
in
let print_secret_property xid =
let sk = Globals.string_id#get_name xid in
if !Globals.flag_split then
(filename := (!Globals.output_dir)^(!Globals.output_file)^"-secrecy-"^sk^".if";
prerr_endline ("%% IF output in "^(!filename));
Globals.tmp_channel := open_out !filename;
print_previous_sections [Base(Const(xid))] [] [];
prout_endline "section properties:"; prout_newline ());
prout_endline ("property secrecy_of_"^sk^" (MGoal,ASGoal) :=");
prout_endline (" [] ((secret(MGoal,"^sk^",ASGoal) /\\ iknows(MGoal))");
prout_endline " => contains(i,ASGoal))";
prout_newline();
if !Globals.flag_split then
(prout_newline (); prout_endline "section attack_states:"; prout_newline ();
print_secret_attack_state xid;
Globals.close_out_noerr !Globals.tmp_channel; Globals.tmp_channel:=stdout)
in
let print_authentication_attack_state xid =
let sk = Globals.string_id#get_name xid in
prout_endline ("attack_state authentication_on_"^sk^" (A1Goal,A2Goal,MGoal,SID) :=");
prout_endline (" request(A1Goal,A2Goal,"^sk^",MGoal,SID) &");
prout_endline (" not(witness(A2Goal,A1Goal,"^sk^",MGoal)) &");
prout_endline (" not(equal(A2Goal,i))");
prout_endline ("attack_state replay_protection_on_"^sk^" (A2Goal,A1Goal,MGoal,SID1,SID2) :=");
prout_endline (" request(A1Goal,A2Goal,"^sk^",MGoal,SID1).");
prout_endline (" request(A1Goal,A2Goal,"^sk^",MGoal,SID2) &");
prout_endline (" not(equal(SID1,SID2)) &");
prout_endline (" not(equal(A2Goal,i))");
prout_newline()
in
let print_authentication_property xid =
let sk = Globals.string_id#get_name xid in
if !Globals.flag_split then
(filename := (!Globals.output_dir)^(!Globals.output_file)^"-auth-"^sk^".if";
Globals.tmp_channel := open_out !filename;
prout_endline ("%% IF specification of "^(!Globals.input_file)^"\n");
print_previous_sections [] [Base(Const(xid))] [];
prout_endline "section properties:"; prout_newline ());
prout_endline ("property authentication_on_"^sk^" (A1Goal,A2Goal,MGoal,SID,SID1,SID2) :=");
prout_endline (" [] (((request(A1Goal,A2Goal,"^sk^",MGoal,SID)");
prout_endline (" /\\ ~ equal(A2Goal,i))");
prout_endline (" => witness(A2Goal,A1Goal,"^sk^",MGoal))");
prout_endline (" /\\ ((request(A1Goal,A2Goal,"^sk^",MGoal,SID1)");
prout_endline (" /\\ request(A1Goal,A2Goal,"^sk^",MGoal,SID2)");
prout_endline (" /\\ ~ equal(A2Goal,i))");
prout_endline " => equal(SID1,SID2)))";
prout_newline();
if !Globals.flag_split then
(prout_newline (); prout_endline "section attack_states:"; prout_newline ();
print_authentication_attack_state xid;
Globals.close_out_noerr !Globals.tmp_channel; Globals.tmp_channel:=stdout)
in
let print_weak_authentication_attack_state xid =
let sk = Globals.string_id#get_name xid in
prout_endline ("attack_state weak_authentication_on_"^sk^" (A1Goal,A2Goal,MGoal,SID) :=");
prout_endline (" wrequest(A1Goal,A2Goal,"^sk^",MGoal,SID) &");
prout_endline (" not(witness(A2Goal,A1Goal,"^sk^",MGoal)) &");
prout_endline (" not(equal(A2Goal,i))");
prout_newline()
in
let print_weak_authentication_property xid =
let sk = Globals.string_id#get_name xid in
if !Globals.flag_split then
(filename := (!Globals.output_dir)^(!Globals.output_file)^"-wauth-"^sk^".if";
Globals.tmp_channel := open_out !filename;
prout_endline ("%% IF specification of "^(!Globals.input_file)^"\n");
print_previous_sections [] [] [Base(Const(xid))];
prout_endline "section properties:"; prout_newline ());
prout_endline ("property weak_authentication_on_"^sk^" (A1Goal,A2Goal,MGoal,SID) :=");
prout_endline (" [] ((wrequest(A1Goal,A2Goal,"^sk^",MGoal,SID)");
prout_endline (" /\\ ~ equal(A2Goal,i))");
prout_endline (" => witness(A2Goal,A1Goal,"^sk^",MGoal))");
prout_newline();
if !Globals.flag_split then
(prout_newline (); prout_endline "section attack_states:"; prout_newline ();
print_weak_authentication_attack_state xid;
Globals.close_out_noerr !Globals.tmp_channel; Globals.tmp_channel:=stdout)
in
let print_auth_attack_state s1 s2 xid =
let sk = Globals.string_id#get_name xid in
prout_endline ("attack_state authentication_on_"^sk^" ("
^s2^","^s1^",MGoal,SID) :=");
prout_endline (" request("^s1^","^s2^","
^sk^",MGoal,SID) &");
prout_endline (" not(witness("^s2^","^s1^","
^sk^",MGoal)) &");
prout_endline (" not(equal("^s2^",i))");
prout_endline ("attack_state replay_protection_on_"^sk^" ("
^s2^","^s1^",MGoal,SID1,SID2) :=");
prout_endline (" request("^s1^","^s2^","
^sk^",MGoal,SID1).");
prout_endline (" request("^s1^","^s2^","
^sk^",MGoal,SID2) &");
prout_endline (" not(equal(SID1,SID2)) &");
prout_endline (" not(equal("^s2^",i))");
prout_newline()
in
let print_auth_property s1 s2 xid =
let sk = Globals.string_id#get_name xid in
if !Globals.flag_split then
(filename := (!Globals.output_dir)^(!Globals.output_file)^"-auth-"^(string_of_int !auth)^".if";
Globals.tmp_channel := open_out !filename;
prout_endline ("%% IF specification of "^(!Globals.input_file)^"\n");
print_previous_sections [] [Base(Const(xid))] [];
prout_endline "section properties:"; prout_newline ());
prout_endline ("property authentication_on_"^sk^" ("
^s2^","^s1^",MGoal,SID,SID1,SID2) :=");
prout_endline (" [] (((request("^s1^","^s2^","^sk^",MGoal,SID) /\\ ~ equal(A2Goal,i))");
prout_endline (" => witness("^s2^","^s1^","^sk^",MGoal))");
prout_endline (" /\\ ((request("^s1^","^s2^","^sk^",MGoal,SID1)");
prout_endline (" /\\ request("^s1^","^s2^","^sk^",MGoal,SID2)");
prout_endline (" /\\ ~ equal(A2Goal,i))");
prout_endline " => equal(SID1,SID2)))";
prout_newline();
if !Globals.flag_split then
(prout_newline (); prout_endline "section attack_states:"; prout_newline ();
print_auth_attack_state s1 s2 xid;
Globals.close_out_noerr !Globals.tmp_channel; Globals.tmp_channel:=stdout)
in
let print_weak_auth_attack_state s1 s2 xid =
let sk = Globals.string_id#get_name xid in
prout_endline ("attack_state weak_authentication_on_"^sk^" ("
^s2^","^s1^",MGoal,SID) :=");
prout_endline (" wrequest("^s1^","^s2^","
^sk^",MGoal,SID) &");
prout_endline (" not(witness("^s2^","^s1^","
^sk^",MGoal)) &");
prout_endline (" not(equal("^s2^",i))");
prout_newline()
in
let print_weak_auth_property s1 s2 xid =
let sk = Globals.string_id#get_name xid in
if !Globals.flag_split then
(filename := (!Globals.output_dir)^(!Globals.output_file)^"-wauth-"^(string_of_int !wauth)^".if";
Globals.tmp_channel := open_out !filename;
prout_endline ("%% IF specification of "^(!Globals.input_file)^"\n");
print_previous_sections [] [] [Base(Const(xid))];
prout_endline "section properties:"; prout_newline ());
prout_endline ("property weak_authentication_on_"^sk^" ("^s1^","^s2^",MGoal,SID) :=");
prout_endline (" [] ((wrequest("^s1^","^s2^","^sk^",MGoal,SID)");
prout_endline (" /\\ ~ equal(A2Goal,i))");
prout_endline (" => witness("^s2^","^s1^","^sk^",MGoal))");
prout_newline();
if !Globals.flag_split then
(prout_newline (); prout_endline "section attack_states:"; prout_newline ();
print_weak_auth_attack_state s1 s2 xid;
Globals.close_out_noerr !Globals.tmp_channel; Globals.tmp_channel:=stdout)
in
let print_ltl_attack_states p lvc =
let las = ltl_to_neg_dnf p in
let ltl2 = ref 0 in
List.iter
(fun s ->
incr ltl2;
prout_endline ("attack_state ltl_"^(string_of_int !ltl)^"_"^(string_of_int !ltl2)^" ("
^(list_to_string term_to_string "," lvc)^") :=");
prout_string " ";
let (s1,s2) =
List.partition
(function
Ifnot(_)
| Ifequal(_)
| Ifleq(_) -> false
| _ -> true)
s
in
print_list (if_term_to_string "") ".\n " s1;
if s2 <> [] then
(if s1 <> [] then prout_string " &\n ";
print_list (if_term_to_string "") " &\n " s2);
prout_newline())
las;
prout_newline()
in
let print_ltl_property p lvc =
if !Globals.flag_split then
(filename := (!Globals.output_dir)^(!Globals.output_file)^"-ltl-"^(string_of_int !ltl)^".if";
Globals.tmp_channel := open_out !filename;
prout_endline ("%% IF specification of "^(!Globals.input_file)^"\n");
print_previous_sections [] [] [];
prout_endline "section properties:"; prout_newline ());
prout_string "property ltl_";
prout_int !ltl;
prout_endline (" ("^(list_to_string term_to_string "," lvc)^") :=");
prout_endline (" "^(ltl_formula_to_string p));
prout_newline();
if !Globals.flag_split
&& (is_convertible_property p) then
(prout_newline (); prout_endline "section attack_states:"; prout_newline ();
print_ltl_attack_states p lvc;
Globals.close_out_noerr !Globals.tmp_channel; Globals.tmp_channel:=stdout)
in
if not (!Globals.flag_split) then
(let secrecy_ids = ref [] in
let auth_ids = ref [] in
let wauth_ids = ref [] in
List.iter
(function
Secrecy(lt) -> secrecy_ids:= !secrecy_ids @ (List.map (fun x -> Base(Const x)) lt)
| Auth(_,_,lt)
| Authentication(lt) -> auth_ids:= !auth_ids @ (List.map (fun x -> Base (Const x)) lt)
| Weak_auth(_,_,lt)
| Weak_authentication(lt) -> wauth_ids:= !wauth_ids @ (List.map (fun x -> Base (Const x)) lt)
| LTL_goal(_) -> ())
goals;
print_previous_sections !secrecy_ids !auth_ids !wauth_ids;
prout_endline "section properties:"; prout_newline ());
List.iter
(function
Secrecy(lt) ->
List.iter
(fun xid ->
if (!Globals.flag_split || not (List.mem xid !secrecy_info)) then
(secrecy_info := xid::!secrecy_info;
incr secrecy;
print_secret_property xid))
lt
| Auth(r1,r2,lt) ->
let name_r1 =
Globals.string_id#get_name (find_player_in_role r1)
and name_r2 =
Globals.string_id#get_name (find_player_in_role r2)
in
List.iter
(fun xid ->
if (!Globals.flag_split || not (List.mem xid !auth_info)) then
(auth_info := xid::!auth_info;
incr auth;
print_auth_property name_r1 name_r2 xid))
lt
| Authentication(lt) ->
List.iter
(fun xid ->
if (!Globals.flag_split || not (List.mem xid !auth_info)) then
(auth_info := xid::!auth_info;
incr auth;
print_authentication_property xid))
lt
| Weak_auth(r1,r2,lt) ->
let name_r1 =
Globals.string_id#get_name (find_player_in_role r1)
and name_r2 =
Globals.string_id#get_name (find_player_in_role r2)
in
List.iter
(fun xid ->
if (!Globals.flag_split || not (List.mem xid !wauth_info)) then
(wauth_info := xid::!wauth_info;
incr wauth;
print_weak_auth_property name_r1 name_r2 xid))
lt
| Weak_authentication(lt) ->
List.iter
(fun xid ->
if (!Globals.flag_split || not (List.mem xid !wauth_info)) then
(wauth_info := xid::!wauth_info;
incr wauth;
print_weak_authentication_property xid))
lt
| LTL_goal(s,lvc) ->
incr ltl;
print_ltl_property s (List.filter (function Base(Var(_)) -> true | _ -> false) lvc))
goals;
if (not !Globals.flag_split)
&& (List.exists
(function
LTL_goal(Op1(s),_) -> is_convertible_property s
| _ -> true)
goals) then
(prout_newline ();
prout_endline "section attack_states:";
prout_newline ();
secrecy_info := [];
auth_info := [];
wauth_info := [];
ltl := 0;
List.iter
(function
Secrecy(lt) ->
List.iter
(fun xid ->
if not (List.mem xid !secrecy_info) then
(secrecy_info := xid::!secrecy_info;
incr secrecy;
print_secret_attack_state xid))
lt
| Auth(r1,r2,lt) ->
let name_r1 =
Globals.string_id#get_name (find_player_in_role r1)
and name_r2 =
Globals.string_id#get_name (find_player_in_role r2)
in
List.iter
(fun xid ->
if not (List.mem xid !auth_info) then
(auth_info := xid::!auth_info;
incr auth;
print_auth_attack_state name_r1 name_r2 xid))
lt
| Authentication(lt) ->
List.iter
(fun xid ->
if not (List.mem xid !auth_info) then
(auth_info := xid::!auth_info;
incr auth;
print_authentication_attack_state xid))
lt
| Weak_auth(r1,r2,lt) ->
let name_r1 =
Globals.string_id#get_name (find_player_in_role r1)
and name_r2 =
Globals.string_id#get_name (find_player_in_role r2)
in
List.iter
(fun xid ->
if not (List.mem xid !wauth_info) then
(wauth_info := xid::!wauth_info;
incr wauth;
print_weak_auth_attack_state name_r1 name_r2 xid))
lt
| Weak_authentication(lt) ->
List.iter
(fun xid ->
if not (List.mem xid !wauth_info) then
(wauth_info := xid::!wauth_info;
incr wauth;
print_weak_authentication_attack_state xid))
lt
| LTL_goal(Op1(s),lvc) ->
incr ltl;
if is_convertible_property s then
(print_ltl_attack_states s
(List.filter (function Base(Var(_)) -> true | _ -> false) lvc))
| _ -> ())
goals)