let window_compose_intruder_knowledge (root : Widget.toplevel Widget.widget)
(trace_story : string list ref)
(incomming_events : string list ref)
(insert_lst : string -> string -> unit)
(display_intruder_knowledge : unit -> unit) : unit =
Hashtbl.clear transcript_table_for_intruder;
let root_var = Toplevel.create ~borderwidth:1 ~relief:`Groove root in
Wm.title_set root_var "Compose an intruder knowledge";
let var_button_iFrame = Frame.create ~width:60 root_var in
let assist_iCanvas = Canvas.create ~width:60 ~height:275 ~borderwidth:2 ~relief:`Ridge ~scrollregion:(-5000,0,5000,0) root_var in
let assist_iFrame = Frame.create ~width:60 ~height:278 assist_iCanvas in
let assist_iCanvas_h = Scrollbar.create ~background:defcol ~orient:`Horizontal root_var in
scroll_link_canvas assist_iCanvas_h assist_iCanvas "horizontal";
ignore(Canvas.create_window assist_iCanvas ~window:assist_iFrame ~x:490 ~y:138 ~anchor:`Center);
let lst_iFrame = Frame.create ~width:50 root_var in
let iLabel = Label.create ~text:"Compose :" var_button_iFrame in
let lst_iFrame2 = Frame.create ~width:50 ~height:20 lst_iFrame in
let lst_iFrame2_top = Frame.create ~width:50 ~height:20 lst_iFrame2 in
let iLabel1 = Label.create lst_iFrame2_top ~width:6 ~text:"" ~background:defcol in
let iLabel2 = Entry.create lst_iFrame2_top ~width:30 ~background:selcol in
let iLabel3 = Label.create lst_iFrame2_top ~width:1 ~text:"." ~background:defcol in
let iLabel4 = Entry.create lst_iFrame2_top ~width:30 ~background:selcol in
let lst_iFrame2_down = Frame.create ~width:50 ~height:20 lst_iFrame2 in
let button_add = Button.create lst_iFrame2_top ~text:"Add :" in
let receive_lst = Listbox.create ~width:20 ~height:10 ~background:selcol ~selectmode:`Single lst_iFrame2_down in
let receive_v = Scrollbar.create ~background:defcol ~orient:`Vertical lst_iFrame2_down in
let receive_h = Scrollbar.create ~background:defcol ~orient:`Horizontal lst_iFrame2_down in
scroll_link receive_v receive_lst "vertical";
scroll_link receive_h receive_lst "horizontal";
let confirmFrame = Frame.create root_var in
let viLabel2 = ref "" in
let viLabel4 = ref "" in
let tvi = Textvariable.create () in
Textvariable.set tvi "pair";
let irads = List.map
(fun (t, v) -> (Radiobutton.create ~text:t ~value:v ~variable:tvi ~borderwidth:1 ~command:(fun () -> (
let tmp = Textvariable.get tvi in
if(tmp="pair") then (Label.configure iLabel1 ~text:"" ; Label.configure iLabel3 ~text:"." )
else if(tmp="scrypt") then (Label.configure iLabel1 ~text:"" ; Label.configure iLabel3 ~text:"_" )
else if(tmp="exp") then (Label.configure iLabel1 ~text:"Exp" ; Label.configure iLabel3 ~text:", " )
else if(tmp="xor") then (Label.configure iLabel1 ~text:"Xor" ; Label.configure iLabel3 ~text:", " )
)) var_button_iFrame))
[("Pair", "pair") ; ("Scrypt", "scrypt") ; ("Exp", "exp") ; ("Xor", "xor")] in
match irads with [] -> ();
|[x] -> ();
|(x::y::_) -> Radiobutton.select x;
let lst_iFrame1 = Frame.create ~width:50 lst_iFrame in
let cintruder_knowledge_lst = Listbox.create ~width:20 ~height:10 ~background:clicol ~selectmode:`Single lst_iFrame1 in
let cintruder_knowledge_v = Scrollbar.create ~background:violet ~orient:`Vertical lst_iFrame1 in
let cintruder_knowledge_h = Scrollbar.create ~background:violet ~orient:`Horizontal lst_iFrame1 in
scroll_link cintruder_knowledge_v cintruder_knowledge_lst "vertical";
scroll_link cintruder_knowledge_h cintruder_knowledge_lst "horizontal";
let lst_iFrame3 = Frame.create ~width:50 ~height:20 lst_iFrame in
let cintruder_knowledge_lst3 = Listbox.create ~width:20 ~height:10 ~background:clicol ~selectmode:`Single lst_iFrame3 in
let cintruder_knowledge_v3 = Scrollbar.create ~background:violet ~orient:`Vertical lst_iFrame3 in
let cintruder_knowledge_h3 = Scrollbar.create ~background:violet ~orient:`Horizontal lst_iFrame3 in
scroll_link cintruder_knowledge_v3 cintruder_knowledge_lst3 "vertical";
scroll_link cintruder_knowledge_h3 cintruder_knowledge_lst3 "horizontal";
let display_intruder_knowledge_compose () =
Listbox.delete cintruder_knowledge_lst ~first:(`Num 0) ~last:`End;
Listbox.delete cintruder_knowledge_lst3 ~first:(`Num 0) ~last:`End;
let knowledge = let tmp = decompose(get_value_of_var "x" "set_knowledge") in
if(tmp<>[]) then (cdr tmp)
else []
in
let lt = List.map transcript_sender knowledge in
Listbox.insert cintruder_knowledge_lst ~index:`End ~texts:lt;
Listbox.insert cintruder_knowledge_lst3 ~index:`End ~texts:lt in
let f_widget k =
if(k<>"")
then(
add_in_set "(Intruder_, 0)" k "(Intruder_, 0)" "Set_knowledge" ;
update_intruder_knowledge ();
trace_story := ("add_in_set((Intruder_, 0),"^k^",(Intruder_, 0),Set_knowledge")::(!trace_story);
display_intruder_knowledge_compose ();
)
in
let assist = ref (new box assist_iFrame "" "" "" "" None) in
let button_add_frame = Button.create root_var ~text:"Add knowledge composed with this pattern :"
~command:(fun () -> f_widget (!assist)#get_choice;
display_intruder_knowledge ();
insert_lst "" "";) ~width:68 in
Button.configure button_add ~command:(fun () ->
if(((Entry.get iLabel2)<>"") && ((Entry.get iLabel4)<>""))
then (
let add_k = if ((Textvariable.get tvi)="pair" || (Textvariable.get tvi)="exp" || (Textvariable.get tvi)="xor")
then ((Textvariable.get tvi)^"("^(transcript_sender (!viLabel2))^","^(transcript_sender (!viLabel4))^")")
else ((Textvariable.get tvi)^"("^(transcript_sender (!viLabel4))^","^(transcript_sender (!viLabel2))^")")
in
add_in_set "(Intruder_, 0)" add_k "(Intruder_, 0)" "Set_knowledge";
trace_story := ("add_in_set((Intruder_, 0),"^add_k^",(Intruder_, 0),Set_knowledge)")::(!trace_story);
update_intruder_knowledge ();
display_intruder_knowledge_compose ();
display_intruder_knowledge ();
index_col:=0;
l_entry := [];
(!assist)#init;
insert_lst "" "";
);
);
let buttonOk = Button.create ~text:"Ok" confirmFrame ~command:(fun () -> (
let lock_update = ref false in
if(((Entry.get iLabel2)<>"") && ((Entry.get iLabel4)<>""))
then (
let add_k = if ((Textvariable.get tvi)="pair" || (Textvariable.get tvi)="exp" || (Textvariable.get tvi)="xor")
then ((Textvariable.get tvi)^"("^(transcript_sender (!viLabel2))^","^(transcript_sender (!viLabel4))^")")
else ((Textvariable.get tvi)^"("^(transcript_sender (!viLabel4))^","^(transcript_sender (!viLabel2))^")")
in
add_in_set "(Intruder_, 0)" add_k "(Intruder_, 0)" "Set_knowledge";
trace_story := ("add_in_set((Intruder_, 0),"^add_k^",(Intruder_, 0),Set_knowledge)")::(!trace_story);
lock_update := true
);
let add_k2 = ((!assist)#get_choice) in
if(add_k2<>"")then(
add_in_set "(Intruder_, 0)" add_k2 "(Intruder_, 0)" "Set_knowledge" ;
trace_story := ("add_in_set((Intruder_, 0),"^add_k2^",(Intruder_, 0),Set_knowledge)")::(!trace_story);
lock_update := true
);
if (!lock_update) then (update_intruder_knowledge (); display_intruder_knowledge (); insert_lst "" "");
destroy confirmFrame;
destroy lst_iFrame3;
destroy cintruder_knowledge_v3;
destroy cintruder_knowledge_h3;
destroy cintruder_knowledge_lst3;
destroy lst_iFrame3;
destroy iLabel1;
destroy iLabel2;
destroy iLabel3;
destroy iLabel4;
destroy button_add;
destroy lst_iFrame2_top;
destroy receive_v;
destroy receive_h;
destroy receive_lst;
destroy lst_iFrame2_down;
destroy lst_iFrame2;
destroy cintruder_knowledge_lst;
destroy cintruder_knowledge_h;
destroy cintruder_knowledge_v;
destroy lst_iFrame1;
destroy lst_iFrame;
List.iter destroy irads;
destroy iLabel;
(!assist)#destroy;
destroy button_add_frame;
destroy assist_iFrame;
destroy var_button_iFrame;
destroy root_var;
)) in
let buttonCancel = Button.create ~text:"Cancel" confirmFrame ~command:(fun () -> (
destroy confirmFrame;
destroy buttonOk;
destroy lst_iFrame3;
destroy cintruder_knowledge_v3;
destroy cintruder_knowledge_h3;
destroy cintruder_knowledge_lst3;
destroy lst_iFrame3;
destroy iLabel1;
destroy iLabel2;
destroy iLabel3;
destroy iLabel4;
destroy button_add;
destroy lst_iFrame2_top;
destroy receive_v;
destroy receive_h;
destroy receive_lst;
destroy lst_iFrame2_down;
destroy lst_iFrame2;
destroy cintruder_knowledge_lst;
destroy cintruder_knowledge_h;
destroy cintruder_knowledge_v;
destroy lst_iFrame1;
destroy lst_iFrame;
List.iter destroy irads;
destroy iLabel;
(!assist)#destroy;
destroy button_add_frame;
destroy assist_iFrame;
destroy var_button_iFrame;
destroy root_var;
)) in
let all_actions = ref [] in
List.iter (fun e ->
let (_, ag2, action0) = actionTreatment e in
let action = let decomp = decompose action0 in
if(decomp<>[]) then (car decomp) else ""
in
if("(Intruder_, 0)"<>ag2) then(
let message_receive =
let decomp = decompose action in
if(decomp<>[]) then (transcript_receiver_for_intruder ag2 (caddr decomp)) else "";
in
if(not(List.mem (ag2,message_receive) (!all_actions)) && message_receive<>"")
then(
all_actions:=((ag2,message_receive)::(!all_actions));
Listbox.insert receive_lst ~index:(`Num 0)~texts:[ag2^" can receive : "^message_receive^" - type : "^(transcript_receiver (get_type_of_var_in_state ag2 "x" message_receive))];
);
);
) (!incomming_events);
(
let lock = ref false in
List.iter
(fun (name2,id2,statesL2,actionsL2) ->
let ag2 = (get_name_in_session name2 id2) in
if(ag2<>"(Intruder_, 0)")
then(
let prefix = (ag2^" can receive : ") in
List.iter
(fun (state2,exec2) ->
if(operations_test_treatment_right ag2 state2)
then(
List.iter
(fun (initial2,_,final2) ->
if((findIknows initial2)<>"")
then(
lock:=false;
local_variable_change:=[];
if(state2<>(findState initial2) && match_state ag2 state2 ag2 (findState initial2))
then(ignore(assign_var_of_state ag2 state2 (get_name_in_session name2 id2) (findState initial2)) ; clear_message_story () ; lock:=true; );
if(
(( ( (!exec2)=false || ((findIknows initial2) = "") )
&& (rcv_stack_is_empty ag2 state2)) || (List.mem (findIknows initial2)(get_rcv_stack ag2 state2)))
&& ((!lock) || state2=(findState initial2) || (match_state ag2 state2 ag2 (findState initial2))
|| state2="" ) )
then
(
let ic0 = transcript_receiver_for_intruder ag2 (findIknows initial2) in
let ic = prefix^ic0 in
if(not(List.mem (ag2,ic0) (!all_actions)) && ic0<>"")
then( all_actions:=((ag2,ic0)::(!all_actions));
Listbox.insert receive_lst ~index:(`Num 0)~texts:[ic^" - type : "^(transcript_receiver (get_type_of_var_in_state ag2 (findState initial2) (findIknows initial2)))]);
);
if(!lock) then (previous_message_story () ; remove_local_variable_change() );
)
)actionsL2;
);
)(!statesL2)
)
)(!automate)
);
pack ~side:`Top ~fill:`Y ~expand:false [var_button_iFrame];
pack ~side:`Left ~fill:`X ~expand:true [iLabel];
pack ~side:`Left ~fill:`X ~expand:true irads;
pack ~side:`Left ~fill:`Both ~expand:false [button_add];
pack ~side:`Top ~fill:`Both ~expand:true [lst_iFrame];
pack ~side:`Left ~fill:`Y ~expand:false [lst_iFrame1];
pack ~side:`Left ~fill:`Y [cintruder_knowledge_v];
pack ~side:`Bottom ~fill:`X [cintruder_knowledge_h];
pack ~side:`Top ~fill:`Both ~expand:true [cintruder_knowledge_lst];
pack ~side:`Left ~fill:`Both ~expand:true [lst_iFrame2];
pack ~side:`Top ~fill:`X ~expand:true [lst_iFrame2_top];
pack ~side:`Top ~fill:`Both ~expand:true [lst_iFrame2_down];
pack ~side:`Right ~fill:`Y [receive_v];
pack ~side:`Bottom ~fill:`X [receive_h];
pack ~side:`Top ~fill:`Both ~expand:true [receive_lst];
pack ~side:`Left ~fill:`Both ~expand:false [iLabel1];
pack ~side:`Left ~fill:`Both ~expand:true [iLabel2];
pack ~side:`Left ~fill:`Both ~expand:false [iLabel3];
pack ~side:`Left ~fill:`Both ~expand:true [iLabel4];
pack ~side:`Left ~fill:`Both ~expand:true [lst_iFrame3];
pack ~side:`Right ~fill:`Y [cintruder_knowledge_v3];
pack ~side:`Bottom ~fill:`X [cintruder_knowledge_h3];
pack ~side:`Top ~fill:`Both ~expand:true [cintruder_knowledge_lst3];
pack ~side:`Left ~fill:`Y ~expand:false [lst_iFrame3];
pack ~side:`Bottom ~fill:`X ~expand:false [confirmFrame];
pack ~side:`Left ~fill:`X ~expand:true [buttonOk];
pack ~side:`Left ~fill:`X ~expand:true [buttonCancel];
display_intruder_knowledge_compose ();
let click_i = ref (-1) in
bind cintruder_knowledge_lst
~events:[(`ButtonPressDetail 1)]
~fields:[`MouseY]
~action:(function x ->
let result =
Listbox.nearest
cintruder_knowledge_lst
~y:x.ev_MouseY
in
let select =
match result with
| `Num num -> num
in
if((!click_i)=select)
then(
viLabel2 := Listbox.get cintruder_knowledge_lst ~index:(`Num select);
Entry.delete_range iLabel2 ~start:(`Num 0) ~stop:`End;
Entry.insert iLabel2 ~index:(`Num 0) ~text:(!viLabel2);
click_i := (-1)
)
else click_i := select;
);
bind cintruder_knowledge_lst3
~events:[(`ButtonPressDetail 1)]
~fields:[`MouseY]
~action:(function x ->
let result =
Listbox.nearest
cintruder_knowledge_lst3
~y:x.ev_MouseY
in
let select =
match result with
| `Num num -> num
in
if((!click_i)=select)
then(
viLabel4 := Listbox.get cintruder_knowledge_lst3 ~index:(`Num select);
Entry.delete_range iLabel4 ~start:(`Num 0) ~stop:`End;
Entry.insert iLabel4 ~index:(`Num 0) ~text:(!viLabel4);
click_i := (-1)
)
else click_i := select;
);
bind receive_lst
~events:[(`ButtonPressDetail 1)]
~fields:[`MouseY]
~action:(function x ->
let result =
Listbox.nearest
receive_lst
~y:x.ev_MouseY
in
let select =
match result with
| `Num num -> num
in
if((!click_i)=select)
then(
let receive = List.nth (!all_actions) select in
(!assist)#destroy;
assist := new box assist_iFrame "(Intruder_, 0)" (fst receive) "x" (transcript_receiver_for_intruder (fst receive) (snd receive)) None;
index_col:=0;
l_entry := [];
(!assist)#init;
pack ~side:`Top ~fill:`Y ~expand:false [button_add_frame];
pack ~side:`Top ~fill:`Both ~expand:false [assist_iCanvas];
pack ~side:`Top ~fill:`X [assist_iCanvas_h];
click_i := (-1);
)
else click_i := select;
);