Viewing file:  apol.tcl (696.67 KB) -rw-r--r--
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
#!/usr/bin/awish
##############################################################
#
# apol: SE Linux Policy Analysis Tools
#
# Copyright (C) 2002-2005 Tresys Technology, LLC
# see file 'COPYING' for use and warranty information
#
#
# TCL/TK GUI for SE Linux policy analysis
# Requires tcl and tk 8.3+, with BWidgets
#
# Question/comments to: selinux@tresys.com
#
# This tools is designed to analysis selinux policies.
#
# See the assoicated help file for more information.
#
##############################################################
namespace eval Apol_Types {
variable opts
set opts(types) 1
set opts(typeattribs) 1
set opts(typealiases) 1
set opts(attribs) 0
set opts(attribtypes) 0
set opts(attribtypeattribs) 0
set opts(usesrchstr) 0
set opts(show_files) 0
set opts(incl_context) 0
set opts(incl_class) 0
variable srchstr ""
variable typelist ""
variable attriblist ""
variable progressmsg ""
variable progress_indicator -1
variable alistbox
variable tlistbox
variable resultsbox
variable types_select
variable typeattribs
variable typealiases
variable attribs_select
variable a_types
variable a_typeattribs
variable sString
variable sEntry
variable fc_incl_context
variable fc_incl_class
variable fc_files_select
variable progressDlg .progress_Dlg
variable types_menu_callbacks ""
variable attribs_menu_callbacks ""
}
proc Apol_Types::open { } {
variable typelist
variable attriblist
set rt [catch {set typelist [apol_GetNames types]} err]
if {$rt != 0} {
return -code error $err
}
set typelist [lsort $typelist]
set rt [catch {set attriblist [apol_GetNames attribs]} err]
if {$rt != 0} {
return -code error $err
}
set attriblist [lsort $attriblist]
return 0
}
proc Apol_Types::close { } {
Apol_Types::init_options
set Apol_Types::srchstr ""
set Apol_Types::typelist ""
set Apol_Types::attriblist ""
$Apol_Types::resultsbox configure -state normal
$Apol_Types::resultsbox delete 0.0 end
ApolTop::makeTextBoxReadOnly $Apol_Types::resultsbox
return 0
}
proc Apol_Types::free_call_back_procs { } {
variable types_menu_callbacks
variable attribs_menu_callbacks
set types_menu_callbacks ""
set attribs_menu_callbacks ""
return 0
}
proc Apol_Types::init_options { } {
variable types_select
variable typeattribs
variable typealiases
variable attribs_select
variable a_types
variable a_typeattribs
variable sString
variable sEntry
variable opts
set opts(types) 1
set opts(typeattribs) 1
set opts(typealiases) 1
set opts(attribs) 0
set opts(attribtypes) 0
set opts(attribtypeattribs) 0
set opts(usesrchstr) 0
set opts(show_files) 0
set opts(incl_context) 0
set opts(incl_class) 0
Apol_Types::enable_disable_incl_attribs $a_typeattribs
Apol_Types::enable_disable_checkbuttons $typeattribs $typealiases 1
Apol_Types::enable_disable_checkbuttons $a_typeattribs $a_types 2
if {$ApolTop::libsefs == 1} {
}
Apol_Types::_useSearch $sEntry
return 0
}
proc Apol_Types::set_Focus_to_Text {} {
focus $Apol_Types::resultsbox
return 0
}
proc Apol_Types::on_show_more_info_button_clicked {which} {
if {$which == "type"} {
set lb $Apol_Types::tlistbox
} else {
set lb $Apol_Types::alistbox
}
set sel [$lb curselection]
if {$sel != ""} {
Apol_Types::popupTypeInfo $which [$lb get $sel]
}
}
proc Apol_Types::popupTypeInfo {which ta} {
if {$ta == ""} {
return
}
ApolTop::setBusyCursor
set info_fc ""
set index_file_loaded 0
set rt [catch {set info_ta [apol_GetSingleTypeInfo 0 0 $ta]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
ApolTop::resetBusyCursor
return -1
}
if {$ApolTop::libsefs == 1} {
if {[Apol_File_Contexts::is_db_loaded]} {
set rt [catch {set info_fc [Apol_File_Contexts::get_fc_files_for_ta $which $ta]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "$err. \n\nIf you need to load an index file, go to the File Context tab."
ApolTop::resetBusyCursor
return -1
}
set index_file_loaded 1
}
}
ApolTop::resetBusyCursor
set w .ta_infobox
set rt [catch {destroy $w} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
toplevel $w
wm title $w "$ta"
wm protocol $w WM_DELETE_WINDOW " "
wm withdraw $w
set top_f [frame $w.top_f]
set bot_f [frame $w.bot_f]
set notebook [NoteBook $top_f.nb]
set ta_info_tab [$notebook insert end ta_info_tab]
if {$ApolTop::libsefs == 1} {
set fc_info_tab [$notebook insert end fc_info_tab -text "Files"]
}
if {$which == "type"} {
$notebook itemconfigure ta_info_tab -text "Attributes"
} else {
$notebook itemconfigure ta_info_tab -text "Types"
}
set s_ta [ScrolledWindow [$notebook getframe ta_info_tab].s_ta -scrollbar both -auto both]
set f_ta [text [$s_ta getframe].f -font {helvetica 10} -wrap none -width 35 -height 10 -bg white]
$s_ta setwidget $f_ta
if {$ApolTop::libsefs == 1} {
if {$which != "type"} {
set lbl [Label [$notebook getframe fc_info_tab].lbl \
-text "Files labeled with types that are members of this attribute:" \
-justify left]
}
set s_fc [ScrolledWindow [$notebook getframe fc_info_tab].s_fc -scrollbar both -auto both]
set f_fc [text [$s_fc getframe].f -font {helvetica 10} -wrap none -width 35 -height 10 -bg white]
$s_fc setwidget $f_fc
}
set b_close [Button $bot_f.b_close -text "Close" -command "catch {destroy $w}" -width 10]
pack $top_f -side top -anchor nw -fill both -expand yes
pack $bot_f -side bottom -anchor sw -fill x
pack $b_close -side bottom -anchor center -fill x -expand yes -padx 2 -pady 2
pack $s_ta -fill both -expand yes
$notebook compute_size
pack $notebook -fill both -expand yes -padx 4 -pady 4
$notebook raise [$notebook page 0]
$f_ta insert 0.0 $info_ta
$f_ta configure -state disabled
if {$ApolTop::libsefs == 1} {
if {$which != "type"} {
pack $lbl -side top -side top -anchor nw
}
pack $s_fc -fill both -expand yes -side top
if {$index_file_loaded} {
if {$info_fc != ""} {
set num 0
foreach item $info_fc {
foreach {ctxt class path} $item {}
$f_fc insert end "$ctxt\t $class\t $path\n"
incr num
}
$f_fc insert 1.0 "Number of files: $num\n\n"
} else {
$f_fc insert end "No files found."
}
} else {
$f_fc insert 0.0 "No index file is loaded. If you would like to load an index file, go to the File Context tab."
}
$f_fc configure -state disabled
}
wm geometry $w 400x400
wm deiconify $w
wm protocol $w WM_DELETE_WINDOW "destroy $w"
return 0
}
proc Apol_Types::destroy_progressDlg {} {
variable progressDlg
if {[winfo exists $progressDlg]} {
destroy $progressDlg
}
ApolTop::resetBusyCursor
return 0
}
proc Apol_Types::display_progressDlg {} {
variable progressDlg
set Apol_Types::progressmsg "Searching...This may take a while."
set progressBar [ProgressDlg $Apol_Types::progressDlg \
-parent $ApolTop::mainframe \
-textvariable Apol_Types::progressmsg \
-variable Apol_Types::progress_indicator \
-maximum 3 \
-width 45]
ApolTop::setBusyCursor
update
return 0
}
proc Apol_Types::search { str case_Insensitive regExpr srch_Direction } {
variable resultsbox
ApolTop::textSearch $resultsbox $str $case_Insensitive $regExpr $srch_Direction
return 0
}
proc Apol_Types::searchTypes {} {
variable opts
variable srchstr
if {$opts(usesrchstr) && $srchstr == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "No regular expression provided!"
return
}
Apol_Types::display_progressDlg
set rt [catch {set results [apol_GetTypeInfo $opts(types) $opts(typeattribs) \
$opts(attribs) $opts(attribtypes) $opts(attribtypeattribs) \
$opts(typealiases) $opts(usesrchstr) $srchstr \
$opts(show_files) $opts(incl_context) $opts(incl_class)]} err]
if {$rt != 0} {
Apol_Types::destroy_progressDlg
tk_messageBox -icon error -type ok -title "Error" \
-message "$err \n\nNote:If you need to load an index file, go to the File Context tab."
return
} else {
$Apol_Types::resultsbox configure -state normal
$Apol_Types::resultsbox delete 0.0 end
$Apol_Types::resultsbox insert end $results
ApolTop::makeTextBoxReadOnly $Apol_Types::resultsbox
}
Apol_Types::destroy_progressDlg
return 0
}
proc Apol_Types::_useSearch { entry } {
if { $Apol_Types::opts(usesrchstr) } {
$entry config -state normal -background white
} else {
$entry config -state disabled -background $ApolTop::default_bg_color
}
return 0
}
proc Apol_Types::enable_disable_checkbuttons { b1 b2 opt } {
switch $opt \
"1" {
set status $Apol_Types::opts(types)
} \
"2" {
set status $Apol_Types::opts(attribs)
} \
"3" {
set status $Apol_Types::opts(show_files)
} \
default {
puts "Invalid option for num argument: $num\n"
}
if {$status} {
$b1 configure -state normal
$b2 configure -state normal
} else {
$b1 deselect
$b2 deselect
$b1 configure -state disabled
$b2 configure -state disabled
}
return 0
}
proc Apol_Types::enable_disable_incl_attribs { cb } {
if { $Apol_Types::opts(attribtypes) } {
$cb configure -state normal
} else {
$cb configure -state disabled
$cb deselect
}
}
proc Apol_Types::goto_line { line_num } {
variable resultsbox
ApolTop::goto_line $line_num $resultsbox
return 0
}
proc Apol_Types::create {nb} {
variable tlistbox
variable alistbox
variable resultsbox
variable srchstr
variable types_select
variable typeattribs
variable typealiases
variable attribs_select
variable a_types
variable a_typeattribs
variable sString
variable sEntry
variable opts
variable types_menu_callbacks
variable attribs_menu_callbacks
variable fc_incl_context
variable fc_incl_class
variable fc_files_select
set frame [$nb insert end $ApolTop::types_tab -text "Types"]
set topf [frame $frame.topf]
set pw1 [PanedWindow $topf.pw -side top]
set pane [$pw1 add ]
set spane [$pw1 add -weight 5]
set pw2 [PanedWindow $pane.pw -side left]
set tpane [$pw2 add -weight 3]
set apane [$pw2 add ]
set tbox [TitleFrame $tpane.tbox -text "Types"]
set abox [TitleFrame $apane.abox -text "Attributes"]
set obox [TitleFrame $spane.obox -text "Search Options"]
set rbox [TitleFrame $spane.rbox -text "Search Results"]
pack $obox -pady 2 -padx 2 -fill x -anchor n
pack $tbox -padx 2 -side left -fill both -expand yes
pack $abox -padx 2 -side left -fill both -expand yes
pack $rbox -pady 2 -padx 2 -fill both -expand yes
pack $pw1 -fill both -expand yes
pack $pw2 -fill both -expand yes
pack $topf -fill both -expand yes
set sw_t [ScrolledWindow [$tbox getframe].sw -auto both]
set tlistbox [listbox [$sw_t getframe].lb -height 18 -width 20 -highlightthickness 0 \
-listvar Apol_Types::typelist -bg white]
$sw_t setwidget $tlistbox
set t_button [Button [$tbox getframe].t_button -text "Show Type Info" \
-command {Apol_Types::on_show_more_info_button_clicked type} \
-width 10]
set sw_a [ScrolledWindow [$abox getframe].sw -auto both]
set alistbox [listbox [$sw_a getframe].lb -height 7 -width 20 -highlightthickness 0 \
-listvar Apol_Types::attriblist -bg white]
$sw_a setwidget $alistbox
set a_button [Button [$abox getframe].a_button -text "Show Attribute Info" \
-command {Apol_Types::on_show_more_info_button_clicked attrib} \
-width 10]
menu .popupMenu_types
set types_menu_callbacks [lappend types_menu_callbacks {"Show Type Info" "Apol_Types::popupTypeInfo type"}]
menu .popupMenu_attribs
set attribs_menu_callbacks [lappend attribs_menu_callbacks {"Show Attribute Info" "Apol_Types::popupTypeInfo attrib"}]
bindtags $tlistbox [linsert [bindtags $tlistbox] 3 tlist_Tag]
bindtags $alistbox [linsert [bindtags $alistbox] 3 alist_Tag]
bind tlist_Tag <Double-ButtonPress-1> { Apol_Types::popupTypeInfo "type" [$Apol_Types::tlistbox get active]}
bind alist_Tag <Double-ButtonPress-1> { Apol_Types::popupTypeInfo "attrib" [$Apol_Types::alistbox get active]}
bind tlist_Tag <Button-3> { ApolTop::popup_listbox_Menu \
%W %x %y .popupMenu_types $Apol_Types::types_menu_callbacks \
$Apol_Types::tlistbox}
bind alist_Tag <Button-3> { ApolTop::popup_listbox_Menu \
%W %x %y .popupMenu_attribs $Apol_Types::attribs_menu_callbacks \
$Apol_Types::alistbox}
bind tlist_Tag <<ListboxSelect>> { focus -force $Apol_Types::tlistbox}
bind alist_Tag <<ListboxSelect>> { focus -force $Apol_Types::alistbox}
set ofm [$obox getframe]
set fm_attribs_select [frame $ofm.ao -relief sunken -borderwidth 1]
set fm_sString [frame $ofm.so -relief sunken -borderwidth 1]
if {$ApolTop::libsefs == 1} {
}
set okbox [frame $ofm.okbox]
set fm_types_select [frame $ofm.to -relief sunken -borderwidth 1]
pack $t_button $a_button -side bottom -fill x -anchor sw -padx 2 -pady 2
pack $okbox -side right -anchor n -fill both -expand yes -padx 5
pack $fm_types_select -side left -anchor n -padx 5 -fill y
pack $fm_attribs_select -side left -anchor nw -fill y -padx 5
if {$ApolTop::libsefs == 1} {
}
pack $fm_sString -side left -anchor n -fill both -expand yes -padx 5
pack $sw_t -fill both -expand yes
pack $sw_a -fill both -expand yes
set typeattribs [checkbutton $fm_types_select.typeattribs -text "Include Attribs" \
-variable Apol_Types::opts(typeattribs) -padx 10]
set typealiases [checkbutton $fm_types_select.typealiases -text "Use Aliases" \
-variable Apol_Types::opts(typealiases) -padx 10]
set types_select [checkbutton $fm_types_select.type -text "Show Types" -variable Apol_Types::opts(types) \
-command "Apol_Types::enable_disable_checkbuttons $typeattribs $typealiases 1"]
set a_typeattribs [checkbutton $fm_attribs_select.typeattribs -text "Include Type Attribs" \
-variable Apol_Types::opts(attribtypeattribs) -padx 10 \
-offvalue 0 \
-onvalue 1]
set a_types [checkbutton $fm_attribs_select.types -text "Include Types" \
-variable Apol_Types::opts(attribtypes) \
-padx 10 \
-offvalue 0 \
-command "Apol_Types::enable_disable_incl_attribs $a_typeattribs" \
-onvalue 1]
set attribs_select [checkbutton $fm_attribs_select.type -text "Show Attributes" \
-variable Apol_Types::opts(attribs) \
-command "Apol_Types::enable_disable_checkbuttons $a_types $a_typeattribs 2"]
if {$ApolTop::libsefs == 1} {
}
set sEntry [Entry $fm_sString.entry -textvariable Apol_Types::srchstr -width 40 \
-helptext "Enter a regular expression string for which to search"]
set sString [checkbutton $fm_sString.cb -variable Apol_Types::opts(usesrchstr) -text "Search Using Regular Expression" \
-command "Apol_Types::_useSearch $sEntry"]
button $okbox.ok -text OK -width 6 -command { Apol_Types::searchTypes }
set sw [ScrolledWindow [$rbox getframe].sw -auto none]
set resultsbox [text [$sw getframe].text -bg white -wrap none -state disabled]
$sw setwidget $resultsbox
pack $types_select $typeattribs $typealiases -anchor w
pack $attribs_select $a_types $a_typeattribs -anchor w
if {$ApolTop::libsefs == 1} {
}
pack $sString -side top -anchor nw
pack $sEntry -expand yes -padx 5 -pady 5 -fill x
pack $okbox.ok -side top -padx 5 -pady 5 -anchor se
pack $sw -side left -expand yes -fill both
Apol_Types::init_options
return $frame
}
namespace eval Apol_TE {
variable opts
set opts(teallow) 1
set opts(neverallow) 1
set opts(clone) 0
set opts(auallow) 0
set opts(audeny) 0
set opts(ttrans) 1
set opts(tmember) 0
set opts(tchange) 0
set opts(audont) 0
set opts(use_1st_list) 0
set opts(use_2nd_list) 0
set opts(use_3rd_list) 0
set opts(which_1) source
set opts(indirect_1) 0
set opts(indirect_2) 0
set opts(indirect_3) 0
set opts(src_tilda_sel) 0
set opts(src_subtract_sel) 0
set opts(tgt_tilda_sel) 0
set opts(tgt_subtract_sel) 0
set opts(dflt_tilda_sel) 0
set opts(dflt_subtract_sel) 0
variable ta1 ""
variable ta2 ""
variable ta3 ""
variable allow_regex 1
variable allow_syntactic 0
variable show_enabled_rules 1
variable ta1_opt "both"
variable ta2_opt "both"
variable teallow
variable neverallow
variable auallow
variable audeny
variable audont
variable ttrans
variable tmember
variable tchange
variable clone
variable source_list
variable target_list
variable dflt_type_list
variable global_asSource
variable global_any
variable use_1st_list
variable use_2nd_list
variable use_3rd_list
variable incl_indirect1
variable incl_indirect2
variable list_types_1
variable list_attribs_1
variable list_types_2
variable list_attribs_2
variable src_list_type_1 1
variable src_list_type_2 0
variable tgt_list_type_1 1
variable tgt_list_type_2 0
variable ta_state_Array
variable objslistbox
variable permslistbox
variable b_clearReverse
variable b_reverseSel
set opts(perm_union) union
set opts(perm_select) selected
set opts(perms_tilda) 0
variable selObjectsList ""
variable selPermsList ""
variable objectslist ""
variable permslist ""
variable master_permlist ""
variable cb_RegExp
variable cb_show_enabled_rules
variable cb_tag_enabled_rules
variable cb_tag_disabled_rules
variable notebook_searchOpts
variable notebook_results
variable popupTab_Menu
variable updateButton
variable new_tab_name ""
variable totalTabCount 10
variable currTabCount 0
variable pageNums 0
variable emptyTabID "Apol_Emptytab"
variable tabName "Apol_ResultsTab"
variable tabText "Results "
variable pageID ""
variable results ""
variable tab_deleted_flag 0
variable optionsArray
variable tab_menu_callbacks ""
variable cp_TabID "ClassPermsTab"
variable ta_TabID "TypesAttibsTab"
variable m_use_tgt_ta "Use Target Type/Attrib"
variable m_disable_tgt_ta "Target Type/Attrib (Disabled)"
variable m_disable_dflt_type "Default Type (Disabled)"
variable m_use_dflt_type "Use Default Type"
variable m_use_src_ta "Use Source Type/Attrib"
variable m_disable_src_ta "Source Type/Attrib (Disabled)"
variable m_incl_indirect "Include Indirect Matches"
variable m_ta_tab "Types/Attributes"
variable m_obj_perms_tab "Classes/Permissions"
variable disabled_rule_tag DISABLE_RULE
variable enabled_rule_tag ENABLE_RULE
variable disabled_cond_expr_tag D_COND_EXPR
variable enabled_cond_expr_tag E_COND_EXPR
variable disabled_rule_tag_text "Disabled"
variable enabled_rule_tag_text "Enabled"
variable tag_enabled_rules 0
variable tag_disabled_rules 0
variable orig_cursor ""
}
proc Apol_TE::goto_line { line_num } {
variable notebook_results
if { [$notebook_results pages] != "" } {
if {[string is integer -strict $line_num] != 1} {
tk_messageBox -icon error \
-type ok \
-title "Invalid line number" \
-message "$line_num is not a valid line number"
return 0
}
set raisedPage [ $notebook_results raise ]
if {$raisedPage != $Apol_TE::emptyTabID} {
ApolTop::goto_line $line_num $Apol_TE::optionsArray($raisedPage,textbox)
}
}
return 0
}
proc Apol_TE::search { str case_Insensitive regExpr srch_Direction } {
variable notebook_results
if { [$notebook_results pages] != "" } {
set raisedPage [ $notebook_results raise ]
if {$raisedPage != $Apol_TE::emptyTabID} {
ApolTop::textSearch $Apol_TE::optionsArray($raisedPage,textbox) $str $case_Insensitive $regExpr $srch_Direction
}
}
return 0
}
proc Apol_TE::select_all_options { } {
variable opts
set opts(teallow) 1
set opts(neverallow) 1
set opts(auallow) 1
set opts(audont) 1
set opts(ttrans) 1
set opts(tchange) 1
Apol_TE::on_rule_selection
}
proc Apol_TE::enable_disable_conditional_widgets {enable} {
variable show_enabled_rules
variable cb_show_enabled_rules
variable cb_tag_enabled_rules
variable cb_tag_disabled_rules
if {!$enable} {
$cb_show_enabled_rules configure -state disabled
$cb_show_enabled_rules deselect
$cb_tag_enabled_rules configure -state disabled
$cb_tag_disabled_rules configure -state disabled
} else {
$cb_show_enabled_rules configure -state normal
$cb_tag_enabled_rules configure -state normal
if {$show_enabled_rules} {
$cb_tag_disabled_rules configure -state disabled
} else {
$cb_tag_disabled_rules configure -state normal
}
}
return 0
}
proc Apol_TE::enable_disable_tag_disabled_rules_cb {} {
variable show_enabled_rules
variable cb_tag_disabled_rules
if {$show_enabled_rules} {
$cb_tag_disabled_rules deselect
$cb_tag_disabled_rules configure -state disabled
} else {
$cb_tag_disabled_rules configure -state normal
}
return 0
}
proc Apol_TE::on_configure_enabled_rule_tags_checkbutton {} {
ApolTop::setBusyCursor
Apol_TE::configure_enabled_rule_tags
ApolTop::resetBusyCursor
return 0
}
proc Apol_TE::on_configure_disabled_rule_tags_checkbutton {} {
ApolTop::setBusyCursor
Apol_TE::configure_disabled_rule_tags
ApolTop::resetBusyCursor
return 0
}
proc Apol_TE::insert_disabled_cond_expr_HyperLink { tb start end } {
$tb tag add $Apol_TE::disabled_cond_expr_tag $start $end
return 0
}
proc Apol_TE::insert_enabled_cond_expr_HyperLink { tb start end } {
$tb tag add $Apol_TE::enabled_cond_expr_tag $start $end
return 0
}
proc Apol_TE::configure_disabled_cond_expr_HyperLinks {tb} {
$tb tag configure $Apol_TE::disabled_cond_expr_tag -foreground red -underline 1
return 0
}
proc Apol_TE::configure_enabled_cond_expr_HyperLinks {tb} {
$tb tag configure $Apol_TE::enabled_cond_expr_tag -foreground green -underline 1
return 0
}
proc Apol_TE::configure_enabled_rule_tags {} {
variable notebook_results
set raised_Page [$notebook_results raise]
if {$raised_Page == $Apol_TE::emptyTabID} {
return -1
}
set tb $Apol_TE::optionsArray($raised_Page,textbox)
set tag_ranges [$tb tag ranges $Apol_TE::enabled_rule_tag]
$tb configure -state normal
if {$Apol_TE::tag_enabled_rules} {
for {set i 0} {$i < [llength $tag_ranges]} {incr i} {
incr i
$tb insert [lindex $tag_ranges $i] " \["
set startIdx [$tb index "[lindex $tag_ranges $i] + 2 char"]
$tb insert $startIdx "$Apol_TE::enabled_rule_tag_text"
set endIdx [$tb index "$startIdx + [string length $Apol_TE::enabled_rule_tag_text] char"]
$tb insert $endIdx "\]"
Apol_TE::insert_enabled_cond_expr_HyperLink $tb $startIdx $endIdx
}
Apol_TE::configure_enabled_cond_expr_HyperLinks $tb
} else {
for {set i 0} {$i < [llength $tag_ranges]} {incr i} {
set line [lindex [split [lindex $tag_ranges $i] "."] 0]
$tb delete [lindex $tag_ranges $i] $line.end
$tb insert [lindex $tag_ranges $i] " "
$tb tag add $Apol_TE::enabled_rule_tag [lindex $tag_ranges $i] $line.end
incr i
}
}
$tb configure -state disabled
return 0
}
proc Apol_TE::configure_disabled_rule_tags {} {
variable notebook_results
set raised_Page [$notebook_results raise]
if {$raised_Page == $Apol_TE::emptyTabID} {
return
}
set tb $Apol_TE::optionsArray($raised_Page,textbox)
set tag_ranges [$tb tag ranges $Apol_TE::disabled_rule_tag]
$tb configure -state normal
if {$Apol_TE::tag_disabled_rules} {
for {set i 0} {$i < [llength $tag_ranges]} {incr i} {
incr i
$tb insert [lindex $tag_ranges $i] " \["
set startIdx [$tb index "[lindex $tag_ranges $i] + 2 char"]
$tb insert $startIdx "$Apol_TE::disabled_rule_tag_text"
set endIdx [$tb index "$startIdx + [string length $Apol_TE::disabled_rule_tag_text] char"]
$tb insert $endIdx "\]"
Apol_TE::insert_disabled_cond_expr_HyperLink $tb $startIdx $endIdx
}
Apol_TE::configure_disabled_cond_expr_HyperLinks $tb
} else {
for {set i 0} {$i < [llength $tag_ranges]} {incr i} {
set line [lindex [split [lindex $tag_ranges $i] "."] 0]
$tb delete [lindex $tag_ranges $i] $line.end
$tb tag remove $Apol_TE::disabled_rule_tag [lindex $tag_ranges $i] $line.end
$tb insert [lindex $tag_ranges $i] " "
$tb tag add $Apol_TE::disabled_rule_tag [lindex $tag_ranges $i] $line.end
incr i
}
}
$tb configure -state disabled
return 0
}
proc Apol_TE::remove_conditional_tags { tb } {
$tb tag remove $Apol_TE::disabled_rule_tag 0.0 end
$tb tag remove $Apol_TE::enabled_rule_tag 0.0 end
$tb tag remove $Apol_TE::disabled_cond_expr_tag 0.0 end
$tb tag remove $Apol_TE::enabled_cond_expr_tag 0.0 end
return 0
}
proc Apol_TE::searchTErules { whichButton } {
variable opts
variable ta1
variable ta2
variable ta3
variable objslistbox
variable permslistbox
variable selObjectsList
variable selPermsList
variable totalTabCount
variable currTabCount
variable notebook_results
variable allow_regex
variable show_enabled_rules
variable ta1_opt
variable ta2_opt
if { $whichButton == "newTab" && $currTabCount >= $totalTabCount } {
tk_messageBox -icon error -type ok -title "Attention" \
-message "You have reached the maximum amount of tabs. Please delete a tab and try again."
return
}
if {$allow_regex && $opts(use_1st_list) && $ta1 == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "No regular expression provided for Source Type/Attrib!"
return
}
if {$allow_regex && $opts(use_2nd_list) && $ta2 == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "No regular expression provided for Target Type/Attrib!"
return
}
if {$allow_regex && $opts(use_3rd_list) && $ta3 == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "No regular expression provided for Default Type!"
return
}
set selObjectsList [Apol_TE::get_Selected_ListItems $objslistbox]
if {!$opts(teallow) && !$opts(neverallow) && !$opts(auallow) && !$opts(audont)} {
set selPermsList ""
} else {
set selPermsList [Apol_TE::get_Selected_ListItems $permslistbox]
}
ApolTop::setBusyCursor
set rt [catch {set results [apol_SearchTErules $opts(teallow) $opts(neverallow) \
$opts(clone) $opts(auallow) $opts(audeny) $opts(audont) $opts(ttrans) \
$opts(tmember) $opts(tchange) $opts(use_1st_list) $opts(indirect_1) \
$ta1 $opts(which_1) $opts(use_2nd_list) $opts(indirect_2) \
$ta2 $opts(use_3rd_list) $opts(indirect_3) $ta3 $selObjectsList $selPermsList\
$allow_regex $ta1_opt $ta2_opt $show_enabled_rules]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
ApolTop::resetBusyCursor
return
}
switch $whichButton {
newTab {
$Apol_TE::updateButton configure -state normal
set raisedPage [Apol_TE::create_New_ResultsTab $results]
Apol_TE::set_OptionsArray $raisedPage $selObjectsList $selPermsList
}
updateTab {
set raisedPage [ $notebook_results raise ]
$Apol_TE::optionsArray($raisedPage,textbox) configure -state normal
Apol_TE::remove_conditional_tags $Apol_TE::optionsArray($raisedPage,textbox)
Apol_PolicyConf::remove_HyperLink_tags $Apol_TE::optionsArray($raisedPage,textbox)
$Apol_TE::optionsArray($raisedPage,textbox) delete 0.0 end
Apol_TE::insertTERules $Apol_TE::optionsArray($raisedPage,textbox) $results
ApolTop::makeTextBoxReadOnly $Apol_TE::optionsArray($raisedPage,textbox)
Apol_TE::set_OptionsArray $raisedPage $selObjectsList $selPermsList
}
default {
return -code error
}
}
ApolTop::resetBusyCursor
return 0
}
proc Apol_TE::initialize {} {
variable notebook_searchOpts
set raisedPage [$notebook_searchOpts raise [$notebook_searchOpts page 0]]
Apol_TE::set_Indicator $raisedPage
Apol_TE::create_empty_resultsTab
Apol_TE::enable_disable_syntactic_search_widgets $Apol_TE::allow_syntactic
Apol_TE::on_rule_selection
}
proc Apol_TE::insertTERules { tb results } {
variable show_enabled_rules
variable tag_enabled_rules
variable tag_disabled_rules
variable show_enabled_rules
set num [expr { [llength $results] / 4 }]
set num_cond 0
set num_disabled 0
set num_enabled 0
for {set x 0} {$x < [llength $results]} {incr x} {
set start_line_pos [$tb index insert]
set line_num [lindex [split $start_line_pos "."] 0]
set rule [lindex $results $x]
incr x
set lineno [lindex $results $x]
incr x
set is_conditional [lindex $results $x]
incr x
set enabled [lindex $results $x]
if {![ApolTop::is_binary_policy]} {
$tb insert end "($lineno"
set endIdx [$tb index insert]
Apol_PolicyConf::insertHyperLink $tb $line_num.1 $endIdx
$tb insert end ") "
}
set start_line_pos [$tb index insert]
$tb insert end "$rule"
set cur_line_pos [$tb index insert]
$tb insert end " "
set end_line_pos [$tb index insert]
if {$is_conditional} {
incr num_cond
if {!$enabled} {
incr num_disabled
$tb tag add $Apol_TE::disabled_rule_tag $cur_line_pos $end_line_pos
} else {
incr num_enabled
$tb tag add $Apol_TE::enabled_rule_tag $cur_line_pos $end_line_pos
}
}
$tb insert end "\n"
}
if {$num_cond} {
if {!$show_enabled_rules} {
$tb insert 0.0 "Number of disabled conditional rules: $num_disabled\n\n"
$tb insert 0.0 "Number of enabled conditional rules: $num_enabled\n"
} else {
$tb insert 0.0 "Number of enabled conditional rules: $num_enabled\n\n"
}
$tb insert 0.0 "$num rules match the search criteria\n"
} else {
$tb insert 0.0 "$num rules match the search criteria\n\n"
}
Apol_PolicyConf::configure_HyperLinks $tb
if {$tag_enabled_rules} {
Apol_TE::configure_enabled_rule_tags
}
if {$tag_disabled_rules} {
Apol_TE::configure_disabled_rule_tags
}
return 0
}
proc Apol_TE::set_OptionsArray { raisedPage selObjectsList selPermsList } {
variable optionsArray
variable opts
variable ta1
variable ta2
variable ta3
variable permslist
variable allow_regex
variable src_list_type_1
variable src_list_type_2
variable tgt_list_type_1
variable tgt_list_type_2
variable show_enabled_rules
variable tag_enabled_rules
variable tag_disabled_rules
array unset optionsArray $raisedPage
set optionsArray($raisedPage,teallow) $opts(teallow)
set optionsArray($raisedPage,neverallow) $opts(neverallow)
set optionsArray($raisedPage,clone) $opts(clone)
set optionsArray($raisedPage,auallow) $opts(auallow)
set optionsArray($raisedPage,audeny) $opts(audeny)
set optionsArray($raisedPage,audont) $opts(audont)
set optionsArray($raisedPage,ttrans) $opts(ttrans)
set optionsArray($raisedPage,tmember) $opts(tmember)
set optionsArray($raisedPage,tchange) $opts(tchange)
set optionsArray($raisedPage,use_1st_list) $opts(use_1st_list)
set optionsArray($raisedPage,indirect_1) $opts(indirect_1)
set optionsArray($raisedPage,ta1) $ta1
set optionsArray($raisedPage,which_1) $opts(which_1)
set optionsArray($raisedPage,use_2nd_list) $opts(use_2nd_list)
set optionsArray($raisedPage,indirect_2) $opts(indirect_2)
set optionsArray($raisedPage,ta2) $ta2
set optionsArray($raisedPage,use_3rd_list) $opts(use_3rd_list)
set optionsArray($raisedPage,indirect_3) $opts(indirect_3)
set optionsArray($raisedPage,ta3) $ta3
set optionsArray($raisedPage,selObjectsList) $selObjectsList
set optionsArray($raisedPage,selPermsList) $selPermsList
set optionsArray($raisedPage,ta1) $ta1
set optionsArray($raisedPage,ta2) $ta2
set optionsArray($raisedPage,ta3) $ta3
set optionsArray($raisedPage,perm_union) $opts(perm_union)
set optionsArray($raisedPage,perm_select) $opts(perm_select)
set optionsArray($raisedPage,permslist) $permslist
set optionsArray($raisedPage,allow_regex) $allow_regex
set optionsArray($raisedPage,src_list_type_1) $src_list_type_1
set optionsArray($raisedPage,src_list_type_2) $src_list_type_2
set optionsArray($raisedPage,tgt_list_type_1) $tgt_list_type_1
set optionsArray($raisedPage,tgt_list_type_2) $tgt_list_type_2
set optionsArray($raisedPage,show_enabled_rules) $show_enabled_rules
set optionsArray($raisedPage,tag_enabled_rules) $tag_enabled_rules
set optionsArray($raisedPage,tag_disabled_rules) $tag_disabled_rules
return 0
}
proc Apol_TE::create_empty_resultsTab { } {
variable notebook_results
variable currTabCount
variable pageNums
variable totalTabCount
if {$currTabCount >= $totalTabCount} {
tk_messageBox -icon error -type ok -title "Attention" \
-message "You have reached the maximum amount of tabs. Please delete a tab and try again."
return -1
}
incr currTabCount
incr pageNums
$notebook_results insert end $Apol_TE::emptyTabID -text "Empty Tab"
$notebook_results compute_size
set raisedPage [$notebook_results raise $Apol_TE::emptyTabID]
return 0
}
proc Apol_TE::create_New_ResultsTab { results } {
variable notebook_results
variable currTabCount
variable pageNums
variable tabName
variable tabText
variable totalTabCount
variable optionsArray
if {$currTabCount >= $totalTabCount} {
tk_messageBox -icon error -type ok -title "Attention" \
-message "You have reached the maximum amount of tabs. Please delete a tab and try again."
return -1
}
incr currTabCount
incr pageNums
$notebook_results insert end $tabName$pageNums -text $tabText$pageNums
set sw [ScrolledWindow [$notebook_results getframe $tabName$pageNums].sw -auto none]
set resultsbox [text [$sw getframe].resultsbox -bg white -wrap none -font $ApolTop::text_font]
$sw setwidget $resultsbox
pack $sw -side left -expand yes -fill both
set raisedPage [$notebook_results raise $tabName$pageNums]
set optionsArray($raisedPage,textbox) $resultsbox
$resultsbox delete 0.0 end
Apol_TE::insertTERules $resultsbox $results
ApolTop::makeTextBoxReadOnly $resultsbox
return $raisedPage
}
proc Apol_TE::display_rename_tab_Dlg {pageID} {
variable new_tab_name
global tcl_platform
if {$pageID == $Apol_TE::emptyTabID} {
tk_messageBox -icon error -type ok -title "Rename Error" -message "Cannot rename the empty tab."
return -1
}
set rename_tab_Dlg [toplevel .rename_tab_Dlg]
wm withdraw $rename_tab_Dlg
wm title $rename_tab_Dlg "Rename results tab"
wm protocol $rename_tab_Dlg WM_DELETE_WINDOW " "
if {$tcl_platform(platform) == "windows"} {
wm resizable $rename_tab_Dlg 0 0
} else {
bind $rename_tab_Dlg <Configure> "wm geometry $rename_tab_Dlg {}"
}
set new_tab_name ""
set rename_tab_entryBox [entry $rename_tab_Dlg.gotoDlg_entryBox -bg white -textvariable Apol_TE::new_tab_name -width 10 ]
set lbl_goto [label $rename_tab_Dlg.lbl_goto -text "Tab name:"]
set b_ok [button $rename_tab_Dlg.ok -text "OK" -width 6 \
-command "Apol_TE::rename_ResultsTab $pageID; destroy $rename_tab_Dlg"]
set b_cancel [button $rename_tab_Dlg.cancel -text "Cancel" -width 6 -command "destroy $rename_tab_Dlg"]
pack $lbl_goto $rename_tab_entryBox -side left -padx 5 -pady 5 -anchor nw
pack $b_ok $b_cancel -side left -padx 5 -pady 5 -anchor ne
wm deiconify $rename_tab_Dlg
focus $rename_tab_entryBox
bind $rename_tab_Dlg <Return> "Apol_TE::rename_ResultsTab $pageID; destroy $rename_tab_Dlg"
wm transient $rename_tab_Dlg $ApolTop::mainframe
grab $rename_tab_Dlg
wm protocol $rename_tab_Dlg WM_DELETE_WINDOW "destroy $rename_tab_Dlg"
return 0
}
proc Apol_TE::rename_ResultsTab {pageID} {
variable notebook_results
variable new_tab_name
if {$pageID == ""} {
return -1
} elseif {$new_tab_name == ""} {
tk_messageBox -icon error -type ok -title "Rename Error" -message "Must provide a tab name."
return -1
} elseif {$pageID == $Apol_TE::emptyTabID} {
tk_messageBox -icon error -type ok -title "Rename Error" -message "Cannot rename the empty tab."
return -1
}
$notebook_results itemconfigure $pageID -text $new_tab_name
return 0
}
proc Apol_TE::delete_ResultsTab { pageID } {
variable notebook_results
variable currTabCount
variable tab_deleted_flag
variable optionsArray
# Do not delete the emtpy tab!!
if { [$notebook_results index $Apol_TE::emptyTabID] != [$notebook_results index $pageID]} {
set prevPageIdx [expr [$notebook_results index $pageID] - 1]
$notebook_results delete $pageID
array unset optionsArray($pageID)
set currTabCount [expr $currTabCount - 1]
set tab_deleted_flag 1
set raisedPage [$notebook_results raise [$notebook_results page 0]]
$Apol_TE::updateButton configure -state disabled
}
return 0
}
proc Apol_TE::resetObjs_Selections {selObjectsList} {
variable objslistbox
set objectsCount [$objslistbox index end]
$objslistbox selection clear 0 end
for { set idx 0 } { $idx != $objectsCount} { incr idx } {
foreach sel_item $selObjectsList {
set object [$objslistbox get $idx]
if { $sel_item == $object } {
$objslistbox selection set $idx
} else {
continue
}
}
}
}
proc Apol_TE::resetPerms_Selections {selPermsList} {
variable permslistbox
set permsCount [$permslistbox index end]
$permslistbox selection clear 0 end
for { set idx 0 } { $idx != $permsCount} { incr idx } {
foreach sel_item $selPermsList {
set perm [$permslistbox get $idx]
if { $sel_item == $perm } {
$permslistbox selection set $idx
} else {
continue
}
}
}
}
proc Apol_TE::resetObjsPerms_Selections {selObjectsList selPermsList} {
variable permslistbox
Apol_TE::resetObjs_Selections $selObjectsList
Apol_TE::resetPerms_Selections $selPermsList
if {$selObjectsList != "" || $Apol_TE::opts(perm_select) == "all"} {
$permslistbox configure -bg white
} else {
$permslistbox configure -bg $ApolTop::default_bg_color
}
return 0
}
proc Apol_TE::set_Indicator { pageID } {
variable notebook_searchOpts
variable opts
variable objslistbox
variable permslistbox
variable cp_TabID
variable ta_TabID
if { $pageID == $cp_TabID } {
$notebook_searchOpts itemconfigure $cp_TabID -text $Apol_TE::m_obj_perms_tab
set objText [$notebook_searchOpts itemcget $cp_TabID -text]
set selObjectsList [Apol_TE::get_Selected_ListItems $objslistbox]
set selPermsList [Apol_TE::get_Selected_ListItems $permslistbox]
if { $selObjectsList != "" || $selPermsList != "" } {
append objText " *"
$notebook_searchOpts itemconfigure $cp_TabID -text $objText
} else {
$notebook_searchOpts itemconfigure $cp_TabID -text $Apol_TE::m_obj_perms_tab
}
} else {
$notebook_searchOpts itemconfigure $ta_TabID -text $Apol_TE::m_ta_tab
set taText [$notebook_searchOpts itemcget $ta_TabID -text]
if { $opts(use_1st_list) || $opts(use_2nd_list) || $opts(use_3rd_list) } {
append taText " *"
$notebook_searchOpts itemconfigure $ta_TabID -text $taText
} else {
$notebook_searchOpts itemconfigure $ta_TabID -text $Apol_TE::m_ta_tab
}
}
set objText ""
set taText ""
set selObjectsList ""
set selPermsList ""
return 0
}
proc Apol_TE::set_Widget_SearchOptions { pageID } {
variable opts
variable optionsArray
variable ta1
variable ta2
variable ta3
variable permslist
variable allow_regex
variable notebook_results
variable src_list_type_1
variable src_list_type_2
variable tgt_list_type_1
variable tgt_list_type_2
variable tab_deleted_flag
variable show_enabled_rules
variable tag_enabled_rules
variable tag_disabled_rules
set pageID [ApolTop::get_tabname $pageID]
set raised [$notebook_results raise]
if { $raised == $pageID && $tab_deleted_flag == 0 } {
return
}
if { $pageID == $Apol_TE::emptyTabID } {
Apol_TE::reset_search_criteria
$Apol_TE::updateButton configure -state disabled
return
}
$Apol_TE::updateButton configure -state normal
set opts(teallow) $optionsArray($pageID,teallow)
set opts(neverallow) $optionsArray($pageID,neverallow)
set opts(clone) $optionsArray($pageID,clone)
set opts(auallow) $optionsArray($pageID,auallow)
set opts(audeny) $optionsArray($pageID,audeny)
set opts(audont) $optionsArray($pageID,audont)
set opts(ttrans) $optionsArray($pageID,ttrans)
set opts(tmember) $optionsArray($pageID,tmember)
set opts(tchange) $optionsArray($pageID,tchange)
set opts(use_1st_list) $optionsArray($pageID,use_1st_list)
set opts(indirect_1) $optionsArray($pageID,indirect_1)
set opts(which_1) $optionsArray($pageID,which_1)
set opts(use_2nd_list) $optionsArray($pageID,use_2nd_list)
set opts(indirect_2) $optionsArray($pageID,indirect_2)
set opts(use_3rd_list) $optionsArray($pageID,use_3rd_list)
set opts(indirect_3) $optionsArray($pageID,indirect_3)
set opts(perm_union) $optionsArray($pageID,perm_union)
set opts(perm_select) $optionsArray($pageID,perm_select)
set permslist $optionsArray($pageID,permslist)
set selObjectsList $optionsArray($pageID,selObjectsList)
set selPermsList $optionsArray($pageID,selPermsList)
set allow_regex $optionsArray($pageID,allow_regex)
set src_list_type_1 $optionsArray($pageID,src_list_type_1)
set src_list_type_2 $optionsArray($pageID,src_list_type_2)
set tgt_list_type_1 $optionsArray($pageID,tgt_list_type_1)
set tgt_list_type_2 $optionsArray($pageID,tgt_list_type_2)
set show_enabled_rules $optionsArray($pageID,show_enabled_rules)
set tag_enabled_rules $optionsArray($pageID,tag_enabled_rules)
set tag_disabled_rules $optionsArray($pageID,tag_disabled_rules)
Apol_TE::populate_ta_list 1
Apol_TE::populate_ta_list 2
set ta1 $optionsArray($pageID,ta1)
set ta2 $optionsArray($pageID,ta2)
set ta3 $optionsArray($pageID,ta3)
Apol_TE::resetObjsPerms_Selections $selObjectsList $selPermsList
Apol_TE::enable_listbox $Apol_TE::source_list 1 $Apol_TE::list_types_1 $Apol_TE::list_attribs_1
Apol_TE::enable_listbox $Apol_TE::target_list 2 $Apol_TE::list_types_2 $Apol_TE::list_attribs_2
Apol_TE::defaultType_Enable_Disable
Apol_TE::change_tgt_dflt_state
Apol_TE::enable_disable_tag_disabled_rules_cb
Apol_TE::set_Indicator [$Apol_TE::notebook_searchOpts page 0]
Apol_TE::set_Indicator [$Apol_TE::notebook_searchOpts page 1]
Apol_TE::set_Focus_to_Text $pageID
return 0
}
proc Apol_TE::get_Selected_ListItems { listname } {
set indicesList [$listname curselection]
set length [llength $indicesList]
if { $indicesList != "" } {
for {set i 0} {$i < $length} {incr i} {
set listItem_Index [lindex $indicesList $i]
set item [$listname get $listItem_Index]
lappend itemsList $item
}
} else {
return ""
}
return $itemsList
}
proc Apol_TE::get_results_raised_tab {} {
variable notebook_results
return [$notebook_results raise]
}
proc Apol_TE::open { } {
variable objectslist
variable permslist
variable master_permlist
variable src_list_type_1
variable src_list_type_2
variable tgt_list_type_1
variable tgt_list_type_2
variable cb_RegExp
variable ta_state_Array
variable objslistbox
set ta_state_Array($Apol_TE::list_types_1) $src_list_type_1
set ta_state_Array($Apol_TE::list_attribs_1) $src_list_type_2
set ta_state_Array($Apol_TE::list_types_2) $tgt_list_type_1
set ta_state_Array($Apol_TE::list_attribs_2) $tgt_list_type_2
Apol_TE::populate_ta_list 1
Apol_TE::populate_ta_list 2
$Apol_TE::dflt_type_list configure -values $Apol_Types::typelist
if {$ApolTop::contents(classes) == 1} {
set rt [catch {set objectslist [apol_GetNames classes]} err]
if {$rt != 0} {
return -code error $err
}
set objectslist [lsort $objectslist]
if {$objectslist != ""} {
$objslistbox configure -bg white
}
}
if {$ApolTop::contents(perms) == 1} {
set rt [catch {set master_permlist [apol_GetNames perms]} err]
if {$rt != 0} {
return -code error $err
}
set master_permlist [lsort $master_permlist]
set permslist $master_permlist
}
Apol_TE::configure_perms_section
Apol_TE::on_rule_selection
return 0
}
proc Apol_TE::close { } {
variable opts
variable source_list
variable target_list
variable list_types_1
variable list_attribs_1
variable list_types_2
variable list_attribs_2
variable results
variable ta_state_Array
Apol_TE::reset_search_criteria
Apol_TE::close_All_ResultsTabs
set Apol_TE::objectslist ""
set Apol_TE::permslist ""
set Apol_TE::master_permlist ""
$Apol_TE::permslistbox configure -bg $ApolTop::default_bg_color
$Apol_TE::objslistbox configure -bg $ApolTop::default_bg_color
array unset ta_state_Array
return 0
}
proc Apol_TE::free_call_back_procs { } {
variable tab_menu_callbacks
set tab_menu_callbacks ""
return 0
}
proc Apol_TE::reset_search_criteria { } {
variable source_list
variable target_list
variable list_types_1
variable list_attribs_1
variable list_types_2
variable list_attribs_2
variable objslistbox
variable permslistbox
variable allow_syntactic
Apol_TE::reinitialize_default_search_options
Apol_TE::enable_listbox $source_list 1 $list_types_1 $list_attribs_1
Apol_TE::enable_listbox $target_list 2 $list_types_2 $list_attribs_2
Apol_TE::enable_disable_syntactic_search_widgets $allow_syntactic
Apol_TE::defaultType_Enable_Disable
Apol_TE::change_tgt_dflt_state
$Apol_TE::b_union configure -state disabled
$Apol_TE::b_intersection configure -state disabled
set objText [$Apol_TE::notebook_searchOpts itemcget $Apol_TE::cp_TabID -text]
set taText [$Apol_TE::notebook_searchOpts itemcget $Apol_TE::ta_TabID -text]
if { $objText != $Apol_TE::m_obj_perms_tab } {
$Apol_TE::notebook_searchOpts itemconfigure $Apol_TE::cp_TabID -text $Apol_TE::m_obj_perms_tab
}
if { $taText != $Apol_TE::m_ta_tab } {
$Apol_TE::notebook_searchOpts itemconfigure $Apol_TE::ta_TabID -text $Apol_TE::m_ta_tab
}
$objslistbox selection clear 0 end
$permslistbox selection clear 0 end
return 0
}
proc Apol_TE::reinitialize_default_search_options { } {
variable opts
variable ta1_opt
variable ta2_opt
variable source_list
variable target_list
variable list_types_2
variable list_attribs_2
set opts(teallow) 1
set opts(neverallow) 1
set opts(clone) 0
set opts(auallow) 0
set opts(audeny) 0
set opts(ttrans) 1
set opts(tmember) 0
set opts(tchange) 0
set opts(audont) 0
set opts(use_1st_list) 0
set opts(use_2nd_list) 0
set opts(use_3rd_list) 0
set opts(which_1) source
set opts(indirect_1) 0
set opts(indirect_2) 0
set opts(indirect_3) 0
set opts(src_tilda_sel) 0
set opts(src_subtract_sel) 0
set opts(tgt_tilda_sel) 0
set opts(tgt_subtract_sel) 0
set opts(dflt_tilda_sel) 0
set opts(dflt_subtract_sel) 0
set opts(perm_union) union
set opts(perm_select) selected
set Apol_TE::allow_regex 1
set Apol_TE::allow_syntactic 0
set Apol_TE::show_enabled_rules 1
set Apol_TE::src_list_type_1 1
set Apol_TE::src_list_type_2 0
set Apol_TE::tgt_list_type_1 1
set Apol_TE::tgt_list_type_2 0
set ta1_opt "types"
set ta2_opt "types"
set Apol_TE::ta1 ""
set Apol_TE::ta2 ""
set Apol_TE::ta3 ""
set Apol_TE::selObjectsList ""
set Apol_TE::selPermsList ""
set Apol_TE::tag_enabled_rules 0
set Apol_TE::tag_disabled_rules 0
return 0
}
proc Apol_TE::close_All_ResultsTabs { } {
variable optionsArray
variable notebook_results
variable currTabCount
array unset optionsArray
set tabList [$notebook_results pages 1 $currTabCount]
foreach tab $tabList {
$notebook_results delete $tab
}
$notebook_results raise $Apol_TE::emptyTabID
$Apol_TE::updateButton configure -state disabled
set Apol_TE::pageNums 0
set Apol_TE::currTabCount 0
set Apol_TE::pageID ""
set Apol_TE::results ""
return 0
}
proc Apol_TE::populate_ta_list { list } {
variable incl_indirect1
variable incl_indirect2
variable src_list_type_1
variable src_list_type_2
variable tgt_list_type_1
variable tgt_list_type_2
variable ta1_opt
variable ta2_opt
variable ta_state_Array
variable cb_src_subtract
variable cb_tgt_subtract
variable cb_dflt_subtract
variable allow_syntactic
if { $list == 1 } {
if { $src_list_type_1 == 1 && $src_list_type_2 == 1} {
set ta1_opt "both"
set ta_state_Array($Apol_TE::list_types_1) 1
set ta_state_Array($Apol_TE::list_attribs_1) 1
} elseif { $src_list_type_1 == 1 && $src_list_type_2 == 0 } {
set ta1_opt "types"
set ta_state_Array($Apol_TE::list_types_1) 1
set ta_state_Array($Apol_TE::list_attribs_1) 0
} elseif { $src_list_type_1 == 0 && $src_list_type_2 == 1 } {
set ta1_opt "attribs"
set ta_state_Array($Apol_TE::list_types_1) 0
set ta_state_Array($Apol_TE::list_attribs_1) 1
} elseif { $src_list_type_1 == 0 && $src_list_type_2 == 0} {
if { $ta_state_Array($Apol_TE::list_types_1) == 1 } {
$Apol_TE::list_types_1 invoke
} elseif { $ta_state_Array($Apol_TE::list_attribs_1) == 1 } {
$Apol_TE::list_attribs_1 invoke
}
}
set subtract_cb $cb_src_subtract
set which $ta1_opt
set uselist $Apol_TE::source_list
set ta Apol_TE::ta1
set cBox $incl_indirect1
set useStatus $Apol_TE::opts(use_1st_list)
} elseif { $list == 2 } {
if { $tgt_list_type_1 == 1 && $tgt_list_type_2 == 1} {
set ta2_opt "both"
set ta_state_Array($Apol_TE::list_types_2) 1
set ta_state_Array($Apol_TE::list_attribs_2) 1
} elseif { $tgt_list_type_1 == 1 && $tgt_list_type_2 == 0 } {
set ta2_opt "types"
set ta_state_Array($Apol_TE::list_types_2) 1
set ta_state_Array($Apol_TE::list_attribs_2) 0
} elseif { $tgt_list_type_1 == 0 && $tgt_list_type_2 == 1 } {
set ta2_opt "attribs"
set ta_state_Array($Apol_TE::list_types_2) 0
set ta_state_Array($Apol_TE::list_attribs_2) 1
} elseif { $tgt_list_type_1 == 0 && $tgt_list_type_2 == 0} {
if { $ta_state_Array($Apol_TE::list_types_2) == 1 } {
$Apol_TE::list_types_2 invoke
} elseif { $ta_state_Array($Apol_TE::list_attribs_2) == 1 } {
$Apol_TE::list_attribs_2 invoke
}
}
set subtract_cb $cb_tgt_subtract
set which $ta2_opt
set uselist $Apol_TE::target_list
set ta Apol_TE::ta2
set cBox $incl_indirect2
set useStatus $Apol_TE::opts(use_2nd_list)
} elseif { $list == 3 } {
set subtract_cb $cb_dflt_subtract
set which $Apol_RBAC::opts(list_type)
set uselist $Apol_RBAC::list_tgt
set ta Apol_TE::ta3
set useStatus $Apol_TE::opts(use_3rd_list)
} else {
return -code error
}
switch $which {
types {
$uselist configure -values $Apol_Types::typelist
if { $useStatus } {
if {!$allow_syntactic} {
$cBox configure -state normal
} else {
$subtract_cb configure -state normal
}
}
}
attribs {
$uselist configure -values $Apol_Types::attriblist
if {!$allow_syntactic} {
$cBox configure -state disabled
$cBox deselect
} else {
$subtract_cb configure -state disabled
}
}
both {
set bothlist [concat $Apol_Types::typelist $Apol_Types::attriblist]
set bothlist [lsort -dictionary $bothlist]
$uselist configure -values $bothlist
if {!$allow_syntactic} {
$cBox configure -state disabled
$cBox deselect
} else {
$subtract_cb configure -state disabled
}
}
roles {
$uselist configure -values $Apol_Roles::role_list
}
default {
$uselist configure -values ""
if {!$allow_syntactic} {
$cBox configure -state normal
}
}
}
if {$allow_syntactic} {
Apol_TE::insert_star_into_types_attribs_list $uselist
}
return 0
}
proc Apol_TE::insert_star_into_types_attribs_list {combobox} {
if {[ApolTop::is_policy_open]} {
set tmp_list [$combobox cget -values]
set idx [lsearch -exact $tmp_list "*"]
if {$idx == -1} {
set tmp_list [linsert $tmp_list 0 "*"]
$combobox configure -values $tmp_list
}
}
return 0
}
proc Apol_TE::insert_star_into_perms_list {perms_list_1} {
if {[ApolTop::is_policy_open] && [Apol_TE::get_Selected_ListItems $Apol_TE::objslistbox] != ""} {
upvar #0 $perms_list_1 perms_list
set idx [lsearch -exact $perms_list "*"]
if {$idx == -1} {
set perms_list [linsert $perms_list 0 "*"]
}
}
return 0
}
proc Apol_TE::remove_star_from_types_attribs_list {combobox} {
if {[ApolTop::is_policy_open]} {
set tmp_list [$combobox cget -values]
set idx [lsearch -exact $tmp_list "*"]
if {$idx != -1} {
set tmp_list [lreplace $tmp_list $idx $idx]
}
$combobox configure -values $tmp_list
}
return 0
}
proc Apol_TE::remove_star_from_permissions_list {perms_list_1} {
if {[ApolTop::is_policy_open]} {
upvar #0 $perms_list_1 perms_list
set idx [lsearch -exact $perms_list "*"]
if {$idx != -1} {
set perms_list [lreplace $perms_list $idx $idx]
}
}
return 0
}
proc Apol_TE::configure_perms_section { } {
variable opts
variable permslist
variable objslistbox
variable permslistbox
variable master_permlist
variable cb_perms_tilda
if {!$opts(teallow) && !$opts(neverallow) && !$opts(auallow) && !$opts(audont)} {
return 0
}
ApolTop::enable_tkListbox $permslistbox
set objectsList [Apol_TE::get_Selected_ListItems $objslistbox]
if { $Apol_TE::opts(perm_select) == "all" } {
$Apol_TE::b_union configure -state disabled
$Apol_TE::b_intersection configure -state disabled
set permslist $master_permlist
if {$permslist != ""} {
$permslistbox configure -bg white
}
if {$Apol_TE::allow_syntactic} {
Apol_TE::insert_star_into_perms_list Apol_TE::permslist
}
} elseif { $Apol_TE::opts(perm_select) == "selected" && $objectsList != ""} {
$Apol_TE::permslistbox selection clear 0 end
$cb_perms_tilda configure -state disabled
$Apol_TE::b_union configure -state normal
$Apol_TE::b_intersection configure -state normal
if { $Apol_TE::opts(perm_union) == "union"} {
set rt [catch {set permslist [lsort [apol_GetPermsByClass $objectsList 1]]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
}
} else {
set rt [catch {set permslist [lsort [apol_GetPermsByClass $objectsList 0]]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
}
}
if {$permslist != ""} {
$permslistbox configure -bg white
}
if {$Apol_TE::allow_syntactic} {
Apol_TE::insert_star_into_perms_list Apol_TE::permslist
}
} else {
$Apol_TE::permslistbox selection clear 0 end
set permslist ""
$permslistbox configure -bg $ApolTop::default_bg_color
if { $Apol_TE::opts(perm_select) == "selected" } {
$Apol_TE::b_union configure -state disabled
$Apol_TE::b_intersection configure -state disabled
}
$cb_perms_tilda configure -state disabled
return
}
return 0
}
proc Apol_TE::enable_listbox { cBox list_number b1 b2 } {
variable global_asSource
variable global_any
variable incl_indirect1
variable incl_indirect2
variable opts
variable cb_src_tilda
variable cb_src_subtract
variable cb_tgt_tilda
variable cb_tgt_subtract
variable allow_syntactic
variable source_list
variable target_list
Apol_TE::set_Indicator [$Apol_TE::notebook_searchOpts raise]
if { $list_number == 1 } {
set which list1
} elseif {$list_number == 2} {
set which list2
} else {
return -code error
}
switch $which {
list1 {
if { $Apol_TE::opts(use_1st_list) } {
if { $Apol_TE::opts(which_1) == "source"} {
$cBox configure -state normal -entrybg white
$b1 configure -state normal
$b2 configure -state normal
$Apol_TE::global_asSource configure -state normal
$Apol_TE::global_any configure -state normal
$Apol_TE::incl_indirect1 configure -state normal
} else {
$cBox configure -state normal -entrybg white
$b1 configure -state normal
$b2 configure -state normal
$Apol_TE::global_asSource configure -state normal
$Apol_TE::global_any configure -state normal
Apol_TE::change_tgt_dflt_state
}
if {$Apol_TE::src_list_type_1 == 0 && $Apol_TE::src_list_type_2 == 1} {
$incl_indirect1 configure -state disabled
$incl_indirect1 deselect
}
if {$Apol_TE::src_list_type_1 == 1 && $Apol_TE::src_list_type_2 == 1} {
$incl_indirect1 configure -state disabled
$incl_indirect1 deselect
}
if {$allow_syntactic} {
$cb_src_tilda configure -state normal
$cb_src_subtract configure -state normal
$incl_indirect1 configure -state disabled
$incl_indirect1 deselect
Apol_TE::insert_star_into_types_attribs_list $source_list
} else {
$cb_src_tilda configure -state disabled
$cb_src_subtract configure -state disabled
Apol_TE::remove_star_from_types_attribs_list $source_list
}
} else {
$cBox configure -state disabled -entrybg $ApolTop::default_bg_color
selection clear -displayof $cBox
$b1 configure -state disabled
$b2 configure -state disabled
$cb_src_tilda configure -state disabled
$cb_src_subtract configure -state disabled
$Apol_TE::global_asSource configure -state disabled
$Apol_TE::global_any configure -state disabled
$incl_indirect1 configure -state disabled
$incl_indirect1 deselect
Apol_TE::change_tgt_dflt_state
}
}
list2 {
if { $Apol_TE::opts(use_2nd_list) } {
$cBox configure -state normal -entrybg white
$b1 configure -state normal
$b2 configure -state normal
$Apol_TE::incl_indirect2 configure -state normal
if {$Apol_TE::tgt_list_type_1 == 0 && $Apol_TE::tgt_list_type_2 == 1} {
$incl_indirect2 configure -state disabled
$incl_indirect2 deselect
}
if {$Apol_TE::tgt_list_type_1 == 1 && $Apol_TE::tgt_list_type_2 == 1} {
$incl_indirect2 configure -state disabled
$incl_indirect2 deselect
}
if {$allow_syntactic} {
$cb_tgt_tilda configure -state normal
$cb_tgt_subtract configure -state normal
$incl_indirect2 configure -state disabled
$incl_indirect2 deselect
Apol_TE::insert_star_into_types_attribs_list $target_list
} else {
$cb_tgt_tilda configure -state disabled
$cb_tgt_subtract configure -state disabled
Apol_TE::remove_star_from_types_attribs_list $target_list
}
Apol_TE::populate_ta_list 2
} else {
$cBox configure -state disabled -entrybg $ApolTop::default_bg_color
selection clear -displayof $cBox
$b1 configure -state disabled
$b2 configure -state disabled
$cb_tgt_tilda configure -state disabled
$cb_tgt_subtract configure -state disabled
$incl_indirect2 configure -state disabled
$incl_indirect2 deselect
}
}
default {
return -code error
}
}
return 0
}
proc Apol_TE::is_only_type_rules_selected { } {
set bool1 [expr ($Apol_TE::opts(ttrans) == 1 || $Apol_TE::opts(tmember) == 1 || $Apol_TE::opts(tchange) == 1)]
set bool2 [expr ($Apol_TE::opts(ttrans) == 1 && $Apol_TE::opts(tmember) == 1 && $Apol_TE::opts(tchange) == 1)]
set bool3 [expr ($Apol_TE::opts(teallow) == 0 && $Apol_TE::opts(neverallow) == 0 && \
$Apol_TE::opts(auallow) == 0 && $Apol_TE::opts(audeny) == 0 && \
$Apol_TE::opts(audont) == 0 && $Apol_TE::opts(clone) == 0)]
set bool [expr ( ($bool1 || $bool2) && $bool3 )]
return $bool
}
proc Apol_TE::defaultType_Enable_Disable { } {
variable dflt_type_list
variable use_3rd_list
variable dflt_type_list
Apol_TE::set_Indicator [$Apol_TE::notebook_searchOpts raise]
if {$Apol_TE::opts(use_3rd_list) } {
$Apol_TE::dflt_type_list configure -state normal -entrybg white
} else {
$Apol_TE::dflt_type_list configure -state disabled -entrybg $ApolTop::default_bg_color
selection clear -displayof $Apol_TE::dflt_type_list
}
set bool [Apol_TE::is_only_type_rules_selected]
if { $bool } {
if { $Apol_TE::opts(use_1st_list) && $Apol_TE::opts(which_1) == "source"} {
$Apol_TE::use_3rd_list configure -state normal -text $Apol_TE::m_use_dflt_type
} elseif { !$Apol_TE::opts(use_1st_list) } {
$Apol_TE::use_3rd_list configure -state normal -text $Apol_TE::m_use_dflt_type
}
} else {
$Apol_TE::dflt_type_list configure -state disabled -entrybg $ApolTop::default_bg_color
selection clear -displayof $Apol_TE::dflt_type_list
$Apol_TE::use_3rd_list configure -state disabled -text $Apol_TE::m_disable_dflt_type
$Apol_TE::use_3rd_list deselect
}
return 0
}
proc Apol_TE::change_tgt_dflt_state { } {
variable source_list
variable target_list
variable dflt_type_list
variable use_1st_list
variable use_2nd_list
variable use_3rd_list
variable list_types_1
variable list_attribs_1
variable list_types_2
variable list_attribs_2
variable global_asSource
variable global_any
set bool [Apol_TE::is_only_type_rules_selected]
if { $Apol_TE::opts(use_1st_list) == 1 && $Apol_TE::opts(which_1) == "either" } {
$Apol_TE::dflt_type_list configure -state disabled -entrybg $ApolTop::default_bg_color
selection clear -displayof $Apol_TE::dflt_type_list
$Apol_TE::use_3rd_list configure -state disabled -text $Apol_TE::m_disable_dflt_type
$Apol_TE::use_3rd_list deselect
$Apol_TE::target_list configure -state disabled -entrybg $ApolTop::default_bg_color
selection clear -displayof $Apol_TE::target_list
$Apol_TE::use_2nd_list configure -state disabled -text $Apol_TE::m_disable_tgt_ta
$Apol_TE::use_2nd_list deselect
$Apol_TE::incl_indirect2 configure -state disabled
$Apol_TE::incl_indirect2 deselect
$Apol_TE::list_types_2 configure -state disabled
$Apol_TE::list_attribs_2 configure -state disabled
} elseif { $Apol_TE::opts(use_1st_list) == 1 && $bool && $Apol_TE::opts(which_1) == "source"} {
$Apol_TE::use_3rd_list configure -state normal -text $Apol_TE::m_use_dflt_type
$Apol_TE::use_2nd_list configure -state normal -text $Apol_TE::m_use_tgt_ta
} else {
$Apol_TE::use_2nd_list configure -state normal -text $Apol_TE::m_use_tgt_ta
if { $bool } {
$Apol_TE::use_3rd_list configure -state normal -text $Apol_TE::m_use_dflt_type
}
}
return 0
}
proc Apol_TE::reverseSelection {listname} {
variable cb_perms_tilda
variable permslistbox
set indicesList [$listname curselection]
if { $indicesList != "" } {
set elementCount [$listname index end]
for { set idx 0 } { $idx != $elementCount} { incr idx } {
foreach selectedItem_Index $indicesList {
if { $selectedItem_Index == $idx } {
$listname selection clear $idx
break
} else {
$listname selection set $idx
}
}
}
} else {
return
}
if {[Apol_TE::get_Selected_ListItems $permslistbox] == ""} {
$cb_perms_tilda configure -state disabled
}
return 0
}
proc Apol_TE::load_query_options {file_channel parentDlg} {
variable opts
variable ta1
variable ta2
variable ta3
variable objslistbox
variable permslistbox
variable permslist
variable selObjectsList
variable selPermsList
variable show_enabled_rules
set query_options ""
while {[eof $file_channel] != 1} {
gets $file_channel line
set tline [string trim $line]
if {$tline == "" || [string compare -length 1 $tline "#"] == 0} {
continue
}
set query_options [lappend query_options $tline]
}
if {$query_options == ""} {
return -code error "No query parameters were found."
}
set query_options [split [join $query_options " "] " :"]
set opts(teallow) [lindex $query_options 0]
set opts(neverallow) [lindex $query_options 1]
set opts(clone) [lindex $query_options 2]
set opts(auallow) [lindex $query_options 3]
set opts(audeny) [lindex $query_options 4]
set opts(audont) [lindex $query_options 5]
set opts(ttrans) [lindex $query_options 6]
set opts(tmember) [lindex $query_options 7]
set opts(tchange) [lindex $query_options 8]
set opts(use_1st_list) [lindex $query_options 9]
set opts(indirect_1) [lindex $query_options 10]
set opts(which_1) [lindex $query_options 11]
set opts(use_2nd_list) [lindex $query_options 12]
set opts(indirect_2) [lindex $query_options 13]
set opts(use_3rd_list) [lindex $query_options 14]
set opts(indirect_3) [lindex $query_options 15]
set opts(perm_union) [lindex $query_options 16]
set opts(perm_select) [lindex $query_options 17]
set Apol_TE::src_list_type_1 [lindex $query_options 18]
set Apol_TE::src_list_type_2 [lindex $query_options 19]
set Apol_TE::tgt_list_type_1 [lindex $query_options 20]
set Apol_TE::tgt_list_type_2 [lindex $query_options 21]
set Apol_TE::allow_regex [lindex $query_options 22]
if {[lindex $query_options 23] != "\{\}"} {
set ta1 [string trim [lindex $query_options 23] "\{\}"]
}
if {[lindex $query_options 24] != "\{\}"} {
set ta2 [string trim [lindex $query_options 24] "\{\}"]
}
if {[lindex $query_options 25] != "\{\}"} {
set ta3 [string trim [lindex $query_options 25] "\{\}"]
}
set i 26
set invalid_perms ""
if {[lindex $query_options $i] != "\{\}"} {
set split_list [split [lindex $query_options $i] "\{"]
if {[llength $split_list] == 1} {
if {[lsearch -exact $Apol_TE::master_permlist [lindex $query_options $i]] != -1} {
set permslist [lappend permslist [lindex $query_options $i]]
} else {
set invalid_perms [lappend invalid_perms [lindex $query_options $i]]
}
} else {
if {[lsearch -exact $Apol_TE::master_permlist [lindex $split_list 1]] != -1} {
set permslist [lappend permslist [lindex $split_list 1]]
} else {
set invalid_perms [lappend invalid_perms [lindex $split_list 1]]
}
incr i
while {[llength [split [lindex $query_options $i] "\}"]] == 1} {
if {[lsearch -exact $Apol_TE::master_permlist [lindex $query_options $i]] != -1} {
set permslist [lappend permslist [lindex $query_options $i]]
} else {
set invalid_perms [lappend invalid_perms [lindex $query_options $i]]
}
incr i
}
set end_element [lindex [split [lindex $query_options $i] "\}"] 0]
if {[lsearch -exact $Apol_TE::master_permlist $end_element] != -1} {
set permslist [lappend permslist $end_element]
} else {
set invalid_perms [lappend invalid_perms $end_element]
}
}
}
if {$invalid_perms != ""} {
foreach perm $invalid_perms {
set perm_str [append perm_str "$perm\n"]
}
tk_messageBox -icon warning -type ok -title "Invalid Permissions" \
-message "The following permissions do not exist in the currently \
loaded policy and were ignored.\n\n$perm_str" \
-parent $parentDlg
}
incr i
if {[lindex $query_options $i] != "\{\}"} {
set split_list [split [lindex $query_options $i] "\{"]
if {[llength $split_list] == 1} {
set selObjectsList [lappend selObjectsList [lindex $query_options $i]]
} else {
set selObjectsList [lappend selObjectsList [lindex $split_list 1]]
incr i
while {[llength [split [lindex $query_options $i] "\}"]] == 1} {
set selObjectsList [lappend selObjectsList [lindex $query_options $i]]
incr i
}
set end_element [lindex [split [lindex $query_options $i] "\}"] 0]
set selObjectsList [lappend selObjectsList $end_element]
}
}
incr i
if {[lindex $query_options $i] != "\{\}"} {
set split_list [split [lindex $query_options $i] "\{"]
if {[llength $split_list] == 1} {
set selPermsList [lappend selPermsList [lindex $query_options $i]]
} else {
set selPermsList [lappend selPermsList [lindex $split_list 1]]
incr i
while {[llength [split [lindex $query_options $i] "\}"]] == 1} {
set selPermsList [lappend selPermsList [lindex $query_options $i]]
incr i
}
set end_element [lindex [split [lindex $query_options $i] "\}"] 0]
set selPermsList [lappend selPermsList $end_element]
}
}
incr i
while {$i != [llength $query_options]} {
switch -exact -- [lindex $query_options $i] {
"show_enabled_rules" {
incr i
set Apol_TE::show_enabled_rules [lindex $query_options $i]
}
"tag_enabled_rules" {
incr i
set Apol_TE::tag_enabled_rules [lindex $query_options $i]
}
"tag_disabled_rules" {
incr i
set Apol_TE::tag_disabled_rules [lindex $query_options $i]
}
default {
puts "Error: Unknown query option name encountered ([lindex $query_options $i])."
break
}
}
incr i
}
Apol_TE::populate_ta_list 1
Apol_TE::populate_ta_list 2
Apol_TE::enable_listbox $Apol_TE::source_list 1 $Apol_TE::list_types_1 $Apol_TE::list_attribs_1
Apol_TE::enable_listbox $Apol_TE::target_list 2 $Apol_TE::list_types_2 $Apol_TE::list_attribs_2
Apol_TE::defaultType_Enable_Disable
Apol_TE::change_tgt_dflt_state
Apol_TE::on_rule_selection
Apol_TE::resetObjsPerms_Selections $selObjectsList $selPermsList
Apol_TE::configure_perms_section
Apol_TE::set_Indicator [$Apol_TE::notebook_searchOpts page 0]
Apol_TE::set_Indicator [$Apol_TE::notebook_searchOpts page 1]
return 0
}
proc Apol_TE::save_query_options {file_channel query_file} {
variable opts
variable ta1
variable ta2
variable ta3
variable objslistbox
variable permslistbox
variable allow_regex
variable permslist
variable src_list_type_1
variable src_list_type_2
variable tgt_list_type_1
variable tgt_list_type_2
set selObjectsList [Apol_TE::get_Selected_ListItems $objslistbox]
set selPermsList [Apol_TE::get_Selected_ListItems $permslistbox]
set options [list \
$opts(teallow) \
$opts(neverallow) \
$opts(clone) \
$opts(auallow) \
$opts(audeny) \
$opts(audont) \
$opts(ttrans) \
$opts(tmember) \
$opts(tchange) \
$opts(use_1st_list) \
$opts(indirect_1) \
$opts(which_1) \
$opts(use_2nd_list) \
$opts(indirect_2) \
$opts(use_3rd_list) \
$opts(indirect_3) \
$opts(perm_union) \
$opts(perm_select) \
$src_list_type_1 \
$src_list_type_2 \
$tgt_list_type_1 \
$tgt_list_type_2 \
$allow_regex \
$ta1 $ta2 $ta3 \
$permslist \
$selObjectsList \
$selPermsList \
"show_enabled_rules:$Apol_TE::show_enabled_rules" \
"tag_enabled_rules:$Apol_TE::tag_enabled_rules" \
"tag_disabled_rules:$Apol_TE::tag_disabled_rules"]
puts $file_channel "$options"
return 0
}
proc Apol_TE::set_Focus_to_Text { tab } {
variable notebook_results
if {$tab == $Apol_TE::emptyTabID} {
return
}
if {[array exists Apol_TE::optionsArray] && [winfo exists $Apol_TE::optionsArray($tab,textbox)] } {
focus $Apol_TE::optionsArray($tab,textbox)
}
return 0
}
proc Apol_TE::enable_RegExpr { which } {
variable allow_regex
variable source_list
variable target_list
variable dflt_type_list
if { $Apol_TE::allow_regex == 1 } {
if { $which == 1 } {
set Apol_TE::ta1 "^$Apol_TE::ta1$"
set ta $source_list
} elseif { $which == 2 } {
set Apol_TE::ta2 "^$Apol_TE::ta2$"
set ta $target_list
} elseif { $which == 3 } {
set Apol_TE::ta3 "^$Apol_TE::ta3$"
set ta $dflt_type_list
}
selection clear -displayof $ta
}
focus -force .
return 0
}
proc Apol_TE::clear_perms_selection {} {
variable cb_perms_tilda
$cb_perms_tilda configure -state disabled
$Apol_TE::permslistbox selection clear 0 end
Apol_TE::set_Indicator [$Apol_TE::notebook_searchOpts raise]
return 0
}
proc Apol_TE::on_perms_selection {} {
variable cb_perms_tilda
variable permslistbox
if {[Apol_TE::get_Selected_ListItems $permslistbox] != ""} {
$cb_perms_tilda configure -state normal
} else {
$cb_perms_tilda configure -state disabled
}
Apol_TE::set_Indicator [$Apol_TE::notebook_searchOpts raise]
return 0
}
proc Apol_TE::createObjsClassesTab {notebook_objects_tab} {
variable opts
variable objslistbox
variable permslistbox
variable b_union
variable b_intersection
variable b_allPerms
variable b_selObjsPerms
variable cb_perms_tilda
variable b_clearReverse
variable b_reverseSel
set fm_objs [frame $notebook_objects_tab.objectsFrame -relief flat -borderwidth 1]
set fm_objs_frame [TitleFrame $fm_objs.objs_frame -text "Object Classes"]
set fm_perms_frame [TitleFrame $fm_objs.perms_frame -text "Allow and Audit Rule Permissions"]
set fm_perm_buttons [frame [$fm_perms_frame getframe].perm_buttonsFrame -relief flat -borderwidth 1]
set fm_permissions [frame [$fm_perms_frame getframe].permissionsFrame -relief flat -borderwidth 1]
set fm_permissions_bot [frame $fm_permissions.bottomf -relief flat -borderwidth 1]
set fm_permissions_mid [frame $fm_permissions.middlef -relief flat -borderwidth 1]
set fm_tilda [frame $fm_permissions.fm_tilda -relief flat -borderwidth 1]
set fm_perm_buttons_bot [frame $fm_perm_buttons.botf -relief flat -borderwidth 1]
pack $fm_objs -side left -anchor n -padx 2 -fill both -expand yes
pack $fm_objs_frame -padx 2 -side left -fill y -anchor nw
pack $fm_perms_frame -padx 2 -side left -fill both -expand yes -anchor nw
pack $fm_perm_buttons -side left -anchor n -padx 2 -fill both -expand yes
pack $fm_permissions -side left -anchor n -padx 2 -fill y -expand yes
pack $fm_perm_buttons_bot -side bottom -anchor nw -fill y -expand yes
pack $fm_permissions_mid -side top -anchor n -fill both -expand yes
pack $fm_tilda -side top -anchor n -fill x -pady 2
pack $fm_permissions_bot -side bottom -anchor n -fill both -expand yes
set clearSelectButton [button [$fm_objs_frame getframe].clear -text "Clear" -width 6 \
-command {
$Apol_TE::objslistbox selection clear 0 end
Apol_TE::configure_perms_section
Apol_TE::set_Indicator [$Apol_TE::notebook_searchOpts raise]}]
set sw_objs [ScrolledWindow [$fm_objs_frame getframe].sw -auto both]
set objslistbox [listbox [$sw_objs getframe].lb -height 5 -highlightthickness 0 \
-listvar Apol_TE::objectslist -selectmode multiple -exportselection 0]
$sw_objs setwidget $objslistbox
bindtags $objslistbox [linsert [bindtags $objslistbox] 3 objects_list_Tag]
bind objects_list_Tag <<ListboxSelect>> {
Apol_TE::configure_perms_section
Apol_TE::set_Indicator [$Apol_TE::notebook_searchOpts raise] }
set b_allPerms [radiobutton $fm_perm_buttons.allPerms -text "Show all permissions" \
-variable Apol_TE::opts(perm_select) -value all \
-command { Apol_TE::configure_perms_section }]
set b_selObjsPerms [radiobutton $fm_perm_buttons.selObjsPerms -text "Only show permissions for\nselected object classes" \
-justify left -variable Apol_TE::opts(perm_select) -value selected \
-command { Apol_TE::configure_perms_section }]
set b_union [radiobutton $fm_perm_buttons_bot.union -text "Union" \
-variable Apol_TE::opts(perm_union) -value union -state disabled \
-command { Apol_TE::configure_perms_section }]
set b_intersection [radiobutton $fm_perm_buttons_bot.intersection -text "Intersection" \
-variable Apol_TE::opts(perm_union) -value intersection -state disabled \
-command { Apol_TE::configure_perms_section }]
set sw_perms [ScrolledWindow $fm_permissions_mid.sw -auto both]
set permslistbox [listbox [$sw_perms getframe].lb -height 5 -highlightthickness 0 \
-listvar Apol_TE::permslist -selectmode multiple -exportselection 0]
$sw_perms setwidget $permslistbox
set cb_perms_tilda [checkbutton $fm_tilda.cb_perms_tilda -text "~" -font bold \
-variable Apol_TE::opts(perms_tilda) \
-offvalue 0 \
-onvalue 1]
bindtags $permslistbox [linsert [bindtags $permslistbox] 3 perms_list_Tag]
bind perms_list_Tag <<ListboxSelect>> {Apol_TE::on_perms_selection}
set b_clearReverse [button $fm_permissions_bot.clear -text "Clear" -width 6 -anchor center \
-command {Apol_TE::clear_perms_selection}]
set b_reverseSel [button $fm_permissions_bot.reverse -text "Reverse" -width 6 -anchor center \
-command { Apol_TE::reverseSelection $Apol_TE::permslistbox }]
pack $sw_objs -fill both -expand yes
pack $clearSelectButton -side bottom -pady 2
pack $b_allPerms $b_selObjsPerms -side top -anchor nw -pady 2 -padx 2
pack $b_union -side top -anchor nw -padx 18
pack $b_intersection -side top -anchor nw -padx 18
pack $sw_perms -side bottom -fill both -expand yes
pack $b_clearReverse $b_reverseSel -side left -pady 2 -padx 1 -anchor center -fill x -expand yes
return 0
}
proc Apol_TE::enable_disable_syntactic_search_widgets {enable} {
variable cb_src_tilda
variable cb_src_subtract
variable cb_tgt_tilda
variable cb_tgt_subtract
variable incl_indirect1
variable incl_indirect2
variable source_list
variable target_list
variable dflt_type_list
variable opts
variable permslist
variable cb_perms_tilda
variable permslistbox
if {$enable} {
if {$opts(use_1st_list)} {
$cb_src_tilda configure -state normal
$cb_src_subtract configure -state normal
$incl_indirect1 configure -state disabled
$incl_indirect1 deselect
Apol_TE::insert_star_into_types_attribs_list $source_list
}
if {$opts(use_2nd_list)} {
$cb_tgt_tilda configure -state normal
$cb_tgt_subtract configure -state normal
$incl_indirect2 configure -state disabled
$incl_indirect2 deselect
Apol_TE::insert_star_into_types_attribs_list $target_list
}
if {[Apol_TE::get_Selected_ListItems $permslistbox] == ""} {
$cb_perms_tilda configure -state disabled
} else {
$cb_perms_tilda configure -state normal
}
Apol_TE::insert_star_into_perms_list Apol_TE::permslist
} else {
if {$opts(use_1st_list)} {
$cb_src_tilda configure -state disabled
$cb_src_subtract configure -state disabled
$incl_indirect1 configure -state normal
Apol_TE::remove_star_from_types_attribs_list $source_list
}
if {$opts(use_2nd_list)} {
$cb_tgt_tilda configure -state disabled
$cb_tgt_subtract configure -state disabled
$incl_indirect2 configure -state normal
Apol_TE::remove_star_from_types_attribs_list $target_list
}
if {$opts(use_3rd_list)} {
Apol_TE::remove_star_from_types_attribs_list $dflt_type_list
}
$cb_perms_tilda configure -state disabled
Apol_TE::remove_star_from_permissions_list Apol_TE::permslist
}
return 0
}
proc Apol_TE::enable_disable_attrib_checkbox {enable which} {
variable list_attribs_1
variable list_attribs_2
if {$enable} {
if {$which == 1} {
$list_attribs_1 configure -state disabled
} else {
$list_attribs_2 configure -state disabled
}
} else {
if {$which == 1} {
$list_attribs_1 configure -state normal
} else {
$list_attribs_2 configure -state normal
}
}
return 0
}
proc Apol_TE::createTypesAttribsTab {notebook_ta_tab} {
variable opts
variable source_list
variable target_list
variable dflt_type_list
variable use_1st_list
variable use_2nd_list
variable use_3rd_list
variable incl_indirect1
variable incl_indirect2
variable list_types_1
variable list_attribs_1
variable list_types_2
variable list_attribs_2
variable global_asSource
variable global_any
variable cb_src_tilda
variable cb_src_subtract
variable cb_tgt_tilda
variable cb_tgt_subtract
set fm_src [frame $notebook_ta_tab.ta1 -relief flat -borderwidth 1]
set fm_top1 [frame $fm_src.top -relief flat -borderwidth 1]
set fm_bottom1 [frame $fm_src.bottom -relief sunken -borderwidth 2]
set fm_inner [frame $fm_bottom1.fm_inner -relief flat -borderwidth 1]
set fm_incl_cBox [frame $fm_inner.fm_incl_cBox -relief flat -borderwidth 1]
set fm_src_radio_buttons [frame $fm_inner.fm_src_radio_buttons -relief flat -borderwidth 1]
set fm_inner_ta [frame $fm_inner.fm_inner_ta -relief ridge -borderwidth 3]
set fm_syntactic_1 [frame $fm_inner.fm_syntactic_1 -relief flat -borderwidth 1]
set fm_ta_buttons [frame $fm_inner_ta.fm_inner_top -relief flat -borderwidth 1]
set fm_comboBox [frame $fm_inner_ta.fm_inner_bottom -relief flat -borderwidth 1]
pack $fm_src -side left -anchor nw -padx 2 -fill both -expand yes
pack $fm_top1 -side top -anchor w -fill both
pack $fm_bottom1 -side bottom -fill both -expand yes
pack $fm_inner -padx 5 -fill x
pack $fm_incl_cBox -anchor nw
pack $fm_src_radio_buttons -anchor center
pack $fm_inner_ta -pady 5 -fill x -expand yes
pack $fm_syntactic_1 -anchor nw -side bottom
pack $fm_ta_buttons -side top -padx 5
pack $fm_comboBox -side bottom -padx 5 -pady 5 -fill x
set fm_tgt [frame $notebook_ta_tab.ta2 -relief flat -borderwidth 1]
set fm_top2 [frame $fm_tgt.top -relief flat -borderwidth 1]
set fm_bottom2 [frame $fm_tgt.bottom -relief sunken -borderwidth 2]
set fm_inner2 [frame $fm_bottom2.fm_inner -relief flat -borderwidth 1]
set fm_incl_cBox2 [frame $fm_inner2.fm_incl_cBox2 -relief flat -borderwidth 1]
set fm_src_radio_buttons2 [frame $fm_inner2.fm_src_radio_buttons -relief flat -borderwidth 1]
set fm_inner_ta2 [frame $fm_inner2.fm_inner_ta2 -relief ridge -borderwidth 3]
set fm_syntactic_2 [frame $fm_inner2.fm_syntactic_2 -relief flat -borderwidth 1]
set fm_ta_buttons2 [frame $fm_inner_ta2.fm_inner_top -relief flat -borderwidth 1]
set fm_comboBox2 [frame $fm_inner_ta2.fm_inner_bottom -relief flat -borderwidth 1]
pack $fm_tgt -side left -anchor nw -padx 2 -fill both -expand yes
pack $fm_top2 -side top -anchor w -fill both
pack $fm_bottom2 -side bottom -fill both -expand yes
pack $fm_inner2 -padx 5 -fill x
pack $fm_incl_cBox2 -fill x -ipady 10.5
pack $fm_src_radio_buttons2 -anchor center
pack $fm_inner_ta2 -pady 5 -anchor s -side top -fill x -expand yes
pack $fm_syntactic_2 -anchor nw -side bottom -fill x
pack $fm_ta_buttons2 -side top -padx 5
pack $fm_comboBox2 -side bottom -padx 5 -pady 5 -fill x
set fm_dflt [frame $notebook_ta_tab.ta3 -relief flat -borderwidth 1]
set fm_top3 [frame $fm_dflt.top -relief flat -borderwidth 1]
set fm_bottom3 [frame $fm_dflt.bottom -relief sunken -borderwidth 2]
set fm_inner3 [frame $fm_bottom3.fm_inner -relief flat -borderwidth 1]
set fm_incl_cBox3 [frame $fm_inner3.fm_incl_cBox2 -relief flat -borderwidth 1]
set fm_src_radio_buttons3 [frame $fm_inner3.fm_src_radio_buttons -relief flat -borderwidth 1]
set fm_inner_ta3 [frame $fm_inner3.fm_inner_ta2 -relief ridge -borderwidth 3]
set fm_syntactic_3 [frame $fm_inner3.fm_syntactic_3 -relief flat -borderwidth 1]
set fm_ta_buttons3 [frame $fm_inner_ta3.fm_inner_top -relief flat -borderwidth 1]
set fm_comboBox3 [frame $fm_inner_ta3.fm_inner_bottom -relief flat -borderwidth 1]
pack $fm_dflt -side left -anchor nw -padx 2 -fill both -expand yes
pack $fm_top3 -side top -anchor w -fill both
pack $fm_bottom3 -side bottom -fill both -expand yes
pack $fm_inner3 -padx 5 -fill x
pack $fm_incl_cBox3 -fill x -ipady 10.5
pack $fm_src_radio_buttons3 -anchor center -ipady 10.5
pack $fm_inner_ta3 -pady 5 -anchor s -side top -fill x -expand yes
pack $fm_syntactic_3 -anchor nw -side bottom -fill x
pack $fm_ta_buttons3 -side top -padx 5 -ipady 10
pack $fm_comboBox3 -side bottom -padx 5 -pady 5 -fill x
set source_list [ComboBox $fm_comboBox.cb \
-textvariable Apol_TE::ta1 -helptext "Type or select a type or attribute" \
-modifycmd {Apol_TE::enable_RegExpr 1} ]
bindtags $source_list.e [linsert [bindtags $source_list.e] 3 source_list_Tag]
bind source_list_Tag <KeyPress> { ApolTop::_create_popup $Apol_TE::source_list %W %K }
set list_types_1 [checkbutton $fm_ta_buttons.list_types_1 -text "Types" \
-variable Apol_TE::src_list_type_1 \
-command "Apol_TE::populate_ta_list 1"]
set list_attribs_1 [checkbutton $fm_ta_buttons.list_attribs_1 -text "Attribs" \
-variable Apol_TE::src_list_type_2 \
-command "Apol_TE::populate_ta_list 1"]
set global_asSource [radiobutton $fm_src_radio_buttons.source_1 -text "As source" -variable Apol_TE::opts(which_1) \
-value source \
-command "Apol_TE::change_tgt_dflt_state"]
set global_any [radiobutton $fm_src_radio_buttons.any_1 -text "Any" -variable Apol_TE::opts(which_1) \
-value either \
-command "Apol_TE::change_tgt_dflt_state"]
set use_1st_list [checkbutton $fm_top1.use_1st_list -text $Apol_TE::m_use_src_ta \
-variable Apol_TE::opts(use_1st_list) \
-command "Apol_TE::enable_listbox $source_list 1 $list_types_1 $list_attribs_1" \
-offvalue 0 \
-onvalue 1 ]
set incl_indirect1 [checkbutton $fm_incl_cBox.incl_indirect -text $Apol_TE::m_incl_indirect \
-variable Apol_TE::opts(indirect_1) \
-onvalue 1 \
-offvalue 0]
set cb_src_tilda [checkbutton $fm_syntactic_1.cb_src_tilda -text "~" -font bold \
-variable Apol_TE::opts(src_tilda_sel) \
-onvalue 1 \
-offvalue 0]
set cb_src_subtract [checkbutton $fm_syntactic_1.cb_src_subtract -text "-" -font bold \
-variable Apol_TE::opts(src_subtract_sel) \
-onvalue 1 \
-offvalue 0 \
-command {Apol_TE::enable_disable_attrib_checkbox $Apol_TE::opts(src_subtract_sel) 1}]
set target_list [ComboBox $fm_comboBox2.cb \
-textvariable Apol_TE::ta2 -helptext "Type or select a type or attribute" \
-modifycmd {Apol_TE::enable_RegExpr 2} ]
bindtags $target_list.e [linsert [bindtags $target_list.e] 3 target_list_Tag]
bind target_list_Tag <KeyPress> { ApolTop::_create_popup $Apol_TE::target_list %W %K }
set list_types_2 [checkbutton $fm_ta_buttons2.list_types_2 -text "Types" \
-variable Apol_TE::tgt_list_type_1 \
-command "Apol_TE::populate_ta_list 2" ]
set list_attribs_2 [checkbutton $fm_ta_buttons2.list_attribs_2 -text "Attribs" \
-variable Apol_TE::tgt_list_type_2 \
-command "Apol_TE::populate_ta_list 2" ]
set use_2nd_list [checkbutton $fm_top2.use_2nd_list -text $Apol_TE::m_disable_tgt_ta \
-variable Apol_TE::opts(use_2nd_list) \
-offvalue 0 \
-onvalue 1 \
-command "Apol_TE::enable_listbox $target_list 2 $list_types_2 $list_attribs_2"]
set incl_indirect2 [checkbutton $fm_incl_cBox2.incl_indirect -text $Apol_TE::m_incl_indirect \
-variable Apol_TE::opts(indirect_2) \
-onvalue 1 \
-offvalue 0]
set cb_tgt_tilda [checkbutton $fm_syntactic_2.cb_tgt_tilda -text "~" -font bold \
-variable Apol_TE::opts(tgt_tilda_sel) \
-onvalue 1 \
-offvalue 0]
set cb_tgt_subtract [checkbutton $fm_syntactic_2.cb_tgt_subtract -text "-" -font bold \
-variable Apol_TE::opts(tgt_subtract_sel) \
-onvalue 1 \
-offvalue 0 \
-command {Apol_TE::enable_disable_attrib_checkbox $Apol_TE::opts(tgt_subtract_sel) 2}]
set dflt_type_list [ComboBox $fm_comboBox3.cb -helptext "Third type search parameter" \
-textvariable Apol_TE::ta3 -helptext "Type or select a type" \
-modifycmd {Apol_TE::enable_RegExpr 3} ]
bindtags $dflt_type_list.e [linsert [bindtags $dflt_type_list.e] 3 dflt_type_list_Tag]
bind dflt_type_list_Tag <KeyPress> { ApolTop::_create_popup $Apol_TE::dflt_type_list %W %K }
set use_3rd_list [checkbutton $fm_top3.use_3rd_list -text $Apol_TE::m_disable_dflt_type \
-variable Apol_TE::opts(use_3rd_list) \
-offvalue 0 \
-onvalue 1 \
-command "Apol_TE::defaultType_Enable_Disable" ]
pack $use_3rd_list -side top -anchor nw
pack $dflt_type_list -anchor w -fill x -expand yes
pack $use_2nd_list -side top -anchor nw
pack $incl_indirect2 -side top -anchor w
pack $list_types_2 $list_attribs_2 -side left
pack $target_list -anchor w -expand yes -fill x
pack $use_1st_list -side top -anchor nw
pack $incl_indirect1 -side top -anchor w
pack $global_asSource $global_any -side left -anchor center
pack $list_types_1 $list_attribs_1 -side left -anchor center
pack $source_list -anchor w -expand yes -fill x -side bottom
Apol_TE::enable_listbox $source_list 1 $list_types_1 $list_attribs_1
Apol_TE::enable_listbox $target_list 2 $list_types_2 $list_attribs_2
Apol_TE::defaultType_Enable_Disable
Apol_TE::change_tgt_dflt_state
return 0
}
proc Apol_TE::enable_disable_permissions_section {enable} {
variable objslistbox
variable permslistbox
variable b_union
variable b_intersection
variable b_allPerms
variable b_selObjsPerms
variable cb_perms_tilda
variable b_clearReverse
variable b_reverseSel
if {!$enable} {
ApolTop::disable_tkListbox $permslistbox
$b_union configure -state disabled
$b_intersection configure -state disabled
$b_allPerms configure -state disabled
$b_selObjsPerms configure -state disabled
$cb_perms_tilda configure -state disabled
$cb_perms_tilda deselect
$b_clearReverse configure -state disabled
$b_reverseSel configure -state disabled
} else {
if {[Apol_TE::get_Selected_ListItems $objslistbox] == ""} {
if {$Apol_TE::opts(perm_select) == "all"} {
ApolTop::enable_tkListbox $permslistbox
} else {
ApolTop::disable_tkListbox $permslistbox
}
$b_union configure -state disabled
$b_intersection configure -state disabled
$cb_perms_tilda configure -state disabled
} else {
ApolTop::enable_tkListbox $permslistbox
$b_union configure -state normal
$b_intersection configure -state normal
$cb_perms_tilda configure -state normal
set selPermsList [Apol_TE::get_Selected_ListItems $permslistbox]
Apol_TE::configure_perms_section
Apol_TE::resetPerms_Selections $selPermsList
Apol_TE::set_Indicator [$Apol_TE::notebook_searchOpts raise]
}
$b_allPerms configure -state normal
$b_selObjsPerms configure -state normal
$b_clearReverse configure -state normal
$b_reverseSel configure -state normal
}
return 0
}
proc Apol_TE::on_rule_selection {} {
variable opts
if {$opts(teallow) || $opts(neverallow) || $opts(auallow) || $opts(audont)} {
Apol_TE::enable_disable_permissions_section 1
} else {
Apol_TE::enable_disable_permissions_section 0
}
Apol_TE::defaultType_Enable_Disable
return 0
}
proc Apol_TE::create {nb} {
variable notebook_searchOpts
variable teallow
variable neverallow
variable auallow
variable audeny
variable audont
variable ttrans
variable tmember
variable tchange
variable clone
variable notebook_results
variable currTabCount
variable pageNums
variable tabName
variable tabText
variable results
variable popupTab_Menu
variable updateButton
variable cb_RegExp
variable tab_menu_callbacks
variable cb_show_enabled_rules
variable cb_tag_enabled_rules
variable cb_tag_disabled_rules
set frame [$nb insert end $ApolTop::terules_tab -text "TE Rules"]
set pw2 [PanedWindow $frame.pw2 -side left -weights available]
$pw2 add -minsize 250
$pw2 add
set topf [frame [$pw2 getframe 0].topf]
set bottomf [frame [$pw2 getframe 1].bottomf]
set pw1 [PanedWindow $topf.pw1 -side top -weights available]
$pw1 add -minsize 225
$pw1 add -weight 3
set tbox [TitleFrame [$pw1 getframe 0].tbox -text "Rule Selection"]
set other_opts_box [TitleFrame [$pw1 getframe 0].other_opts_box -text "Search Options"]
set obox [frame [$pw1 getframe 1].obox]
set dbox [TitleFrame $bottomf.dbox -text "Type Enforcement Rules Display"]
pack $pw2 -fill both -expand yes
pack $pw1 -fill both -expand yes
pack $topf -fill both -expand yes
pack $bottomf -fill both -expand yes
set frame_search $obox
set bBox [frame $frame_search.bBox]
pack $bBox -side right -anchor ne -fill y -padx 5
pack $obox -side right -anchor w -fill both -padx 5 -expand yes
pack $other_opts_box -side bottom -anchor nw -fill both -padx 5 -expand yes
pack $tbox -side top -anchor nw -fill both -padx 5 -expand yes
pack $dbox -side left -fill both -expand yes -anchor e -padx 5 -pady 5
set fm_rules [$tbox getframe]
set optsfm [frame $fm_rules.optsfm]
set tefm [frame $optsfm.tefm]
set ttfm [frame $optsfm.ttfm]
set buttonsfm [frame $optsfm.buttonsfm]
set enabled_fm [frame [$other_opts_box getframe].enabled_fm]
set bFrame [frame [$dbox getframe].bFrame -relief sunken -bd 1]
set teallow [checkbutton $tefm.teallow -text "allow" -variable Apol_TE::opts(teallow) \
-command "Apol_TE::on_rule_selection"]
set neverallow [checkbutton $tefm.neverallow -text "neverallow" -variable Apol_TE::opts(neverallow) \
-command "Apol_TE::on_rule_selection" ]
set auallow [checkbutton $tefm.auallow -text "auditallow" -variable Apol_TE::opts(auallow) \
-command "Apol_TE::on_rule_selection" ]
set audont [checkbutton $tefm.audont -text "dontaudit" -variable Apol_TE::opts(audont) \
-command "Apol_TE::on_rule_selection" ]
set ttrans [checkbutton $ttfm.ttrans -text "type_trans" -variable Apol_TE::opts(ttrans) \
-command "Apol_TE::on_rule_selection"]
set tmember [checkbutton $ttfm.tmember -text "type_member" -variable Apol_TE::opts(tmember) \
-command "Apol_TE::on_rule_selection"]
set tchange [checkbutton $ttfm.tchange -text "type_change" -variable Apol_TE::opts(tchange) \
-command "Apol_TE::on_rule_selection" ]
set clone [checkbutton $ttfm.clone -text "clone" -variable Apol_TE::opts(clone) \
-command "Apol_TE::on_rule_selection" ]
set selectAll [Button $buttonsfm.selectAll -text "Select All" \
-command {Apol_TE::select_all_options}]
set cb_show_enabled_rules [checkbutton $enabled_fm.cb_show_enabled_rules -text "Only search for enabled rules" \
-variable Apol_TE::show_enabled_rules -onvalue 1 -offvalue 0 \
-command Apol_TE::enable_disable_tag_disabled_rules_cb]
set cb_tag_enabled_rules [checkbutton $enabled_fm.cb_tag_enabled_rules -text "Mark enabled conditional rules" \
-variable Apol_TE::tag_enabled_rules -onvalue 1 -offvalue 0 \
-command Apol_TE::on_configure_enabled_rule_tags_checkbutton]
set cb_tag_disabled_rules [checkbutton $enabled_fm.cb_tag_disabled_rules -text "Mark disabled conditional rules" \
-variable Apol_TE::tag_disabled_rules -onvalue 1 -offvalue 0 -state disabled \
-command Apol_TE::on_configure_disabled_rule_tags_checkbutton]
set cb_fm [frame $enabled_fm.cb_fm]
set cb_RegExp [checkbutton $cb_fm.cb_RegExp -text "Enable Regular Expressions" \
-variable Apol_TE::allow_regex -onvalue 1 -offvalue 0]
set cb_syntactic [checkbutton $cb_fm.cb_syntactic -text "Enable Syntactic Search" \
-variable Apol_TE::allow_syntactic -onvalue 1 -offvalue 0 \
-command {Apol_TE::enable_disable_syntactic_search_widgets $Apol_TE::allow_syntactic}]
set notebook_searchOpts [NoteBook $frame_search.nb]
set notebook_ta_tab [$notebook_searchOpts insert end $Apol_TE::ta_TabID -text $Apol_TE::m_ta_tab]
set notebook_objects_tab [$notebook_searchOpts insert end $Apol_TE::cp_TabID -text $Apol_TE::m_obj_perms_tab]
Apol_TE::createTypesAttribsTab $notebook_ta_tab
Apol_TE::createObjsClassesTab $notebook_objects_tab
set newButton [button $bBox.new -text "New" -width 6 -command { Apol_TE::searchTErules newTab }]
set updateButton [button $bBox.upDate -text "Update" -width 6 -state disabled \
-command { Apol_TE::searchTErules updateTab }]
set popupTab_Menu [menu .popupTab_Menu -tearoff 0]
set tab_menu_callbacks [lappend tab_menu_callbacks {"Delete Tab" "Apol_TE::delete_ResultsTab"}]
set tab_menu_callbacks [lappend tab_menu_callbacks {"Rename Tab" "Apol_TE::display_rename_tab_Dlg"}]
set notebook_results [NoteBook [$dbox getframe].nb_results]
$notebook_results bindtabs <Button-3> {ApolTop::popup_Tab_Menu \
%W %x %y $Apol_TE::popupTab_Menu $Apol_TE::tab_menu_callbacks}
$notebook_results bindtabs <Button-1> {Apol_TE::set_Widget_SearchOptions}
set bClose [button $bFrame.bClose -text "Close Tab" -command {
set raisedPage [$Apol_TE::notebook_results raise]
Apol_TE::delete_ResultsTab $raisedPage }]
pack $bFrame -side bottom -anchor center -fill x -padx 4 -pady 1
pack $bClose -side bottom -anchor center -fill x -padx 1 -pady 1
pack $newButton $updateButton -side top -pady 5 -anchor se
pack $cb_fm -side bottom -anchor nw
pack $cb_RegExp -side top -anchor nw
pack $cb_show_enabled_rules $cb_tag_enabled_rules $cb_tag_disabled_rules -side top -anchor nw
pack $teallow $neverallow $auallow $audont -anchor w
pack $ttrans $tchange -anchor w
pack $selectAll -fill x -side left -anchor nw
pack $tefm $ttfm $buttonsfm -side left -anchor nw
pack $enabled_fm -side top -pady 6 -anchor nw -fill both
pack $optsfm -side top -fill x -expand yes -anchor nw
$notebook_searchOpts compute_size
pack $notebook_searchOpts -fill both -expand yes -padx 4
pack $notebook_results -fill both -expand yes -padx 4
Apol_TE::initialize
return $frame
}
namespace eval Apol_Roles {
variable opts
set opts(roles) 1
set opts(useType) 0
set opts(showSelection) all
variable srchstr ""
variable role_list ""
variable types_list ""
variable selected_attribute ""
variable attrib_sel 0
variable resultsbox
variable rlistbox
variable combo_types
variable combo_attribute
variable cb_attrib
variable cb_type
variable menu_callbacks ""
}
proc Apol_Roles::open { } {
variable role_list
set rt [catch {set role_list [apol_GetNames roles]} err]
if {$rt != 0} {
return -code error $err
}
set role_list [lsort $role_list]
Apol_Roles::enable_type_list
$Apol_Roles::combo_types configure -values $Apol_Types::typelist
$Apol_Roles::combo_attribute configure -values $Apol_Types::attriblist
return 0
}
proc Apol_Roles::close { } {
variable opts
variable combo_types
variable combo_attribute
variable cb_attrib
variable cb_type
set opts(roles) 1
set opts(useType) 0
set Apol_Roles::attrib_sel 0
set opts(showSelection) all
set Apol_Roles::srchstr ""
set Apol_Roles::role_list ""
set Apol_Roles::types_list ""
set Apol_Roles::selected_attribute ""
set Apol_Roles::role_list ""
$Apol_Roles::combo_types configure -values ""
$Apol_Roles::combo_attribute configure -values ""
$Apol_Roles::resultsbox configure -state normal
$Apol_Roles::resultsbox delete 0.0 end
ApolTop::makeTextBoxReadOnly $Apol_Roles::resultsbox
set Apol_Roles::types_list ""
Apol_Roles::enable_type_list
return
}
proc Apol_Roles::free_call_back_procs { } {
variable menu_callbacks
set menu_callbacks ""
return 0
}
proc Apol_Roles::set_Focus_to_Text {} {
focus $Apol_Roles::resultsbox
return 0
}
proc Apol_Roles::popupRoleInfo {which role} {
set rt [catch {set info [apol_GetSingleRoleInfo $role 1]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
set w .role_infobox
set rt [catch {destroy $w} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
toplevel $w
wm title $w "$role"
wm protocol $w WM_DELETE_WINDOW " "
wm withdraw $w
set sf [ScrolledWindow $w.sf -scrollbar both -auto both]
set f [text [$sf getframe].f -font {helvetica 10} -wrap none -width 35 -height 10]
$sf setwidget $f
set b1 [button $w.close -text Close -command "catch {destroy $w}" -width 10]
pack $b1 -side bottom -anchor s -padx 5 -pady 5
pack $sf -fill both -expand yes
$f insert 0.0 $info
wm geometry $w +50+50
wm deiconify $w
$f configure -state disabled
wm protocol $w WM_DELETE_WINDOW "destroy $w"
return 0
}
proc Apol_Roles::search { str case_Insensitive regExpr srch_Direction } {
variable resultsbox
ApolTop::textSearch $resultsbox $str $case_Insensitive $regExpr $srch_Direction
return 0
}
proc Apol_Roles::searchRoles {} {
variable opts
variable resultsbox
if {$opts(showSelection) == "names"} {
set name_only 1
} else {
set name_only 0
}
set rt [catch {set results [apol_GetRolesByType $name_only $opts(useType) \
$Apol_Roles::types_list]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
} else {
$resultsbox configure -state normal
$resultsbox delete 0.0 end
$resultsbox insert end $results
ApolTop::makeTextBoxReadOnly $resultsbox
}
return
}
proc Apol_Roles::enable_attrib_list {combo_box cb_value} {
if {$cb_value} {
$combo_box configure -state normal -entrybg white
} else {
$combo_box configure -state disabled -entrybg $ApolTop::default_bg_color
}
Apol_Roles::change_types_list
return 0
}
proc Apol_Roles::enable_type_list {} {
variable combo_types
variable combo_attribute
variable attrib_sel
variable cb_attrib
variable opts
if {$opts(useType)} {
$combo_types configure -state normal -entrybg white
$cb_attrib configure -state normal
if {$attrib_sel} {
$combo_attribute configure -state normal -entrybg white
} else {
$combo_attribute configure -state disabled -entrybg $ApolTop::default_bg_color
}
Apol_Roles::change_types_list
} else {
$combo_types configure -state disabled -entrybg $ApolTop::default_bg_color
$combo_attribute configure -state disabled -entrybg $ApolTop::default_bg_color
$cb_attrib configure -state disabled
$cb_attrib deselect
}
return 0
}
proc Apol_Roles::change_types_list { } {
variable selected_attribute
variable combo_types
variable attrib_sel
if {$attrib_sel && $selected_attribute != ""} {
set rt [catch {set attrib_typesList [apol_GetAttribTypesList $selected_attribute]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
set attrib_typesList [lsort $attrib_typesList]
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_types configure -values $attrib_typesList
} else {
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_types configure -values $attrib_typesList
}
selection clear -displayof $combo_types
return 0
}
proc Apol_Roles::goto_line { line_num } {
variable resultsbox
ApolTop::goto_line $line_num $resultsbox
return 0
}
proc Apol_Roles::create {nb} {
variable rlistbox
variable resultsbox
variable srchstr
variable opts
variable types_list
variable combo_types
variable combo_attribute
variable cb_attrib
variable cb_type
variable menu_callbacks
set frame [$nb insert end $ApolTop::roles_tab -text "Roles"]
set topf [frame $frame.topf]
set pw1 [PanedWindow $topf.pw -side top]
set pane [$pw1 add ]
set spane [$pw1 add -weight 5]
set pw2 [PanedWindow $pane.pw -side left]
set rpane [$pw2 add -weight 3]
set rolebox [TitleFrame $rpane.rolebox -text "Roles"]
set s_optionsbox [TitleFrame $spane.obox -text "Search Options"]
set resultsbox [TitleFrame $spane.rbox -text "Search Results"]
pack $topf -fill both -expand yes
pack $pw1 -fill both -expand yes
pack $pw2 -fill both -expand yes
pack $s_optionsbox -padx 2 -fill both
pack $rolebox -padx 2 -side left -fill both -expand yes
pack $resultsbox -pady 2 -padx 2 -fill both -anchor n -side bottom -expand yes
set sw_r [ScrolledWindow [$rolebox getframe].sw -auto both]
set rlistbox [listbox [$sw_r getframe].lb -height 18 -width 20 -highlightthickness 0 \
-listvar Apol_Roles::role_list -bg white]
$sw_r setwidget $rlistbox
menu .popupMenu_roles
set menu_callbacks [lappend menu_callbacks {"Display Role Info" "Apol_Roles::popupRoleInfo role"}]
bindtags $rlistbox [linsert [bindtags $rlistbox] 3 rlist_Tag]
bind rlist_Tag <Double-Button-1> { Apol_Roles::popupRoleInfo "role" [$Apol_Roles::rlistbox get active]}
bind rlist_Tag <Button-3> { ApolTop::popup_listbox_Menu \
%W %x %y .popupMenu_roles $Apol_Roles::menu_callbacks \
$Apol_Roles::rlistbox}
bind rlist_Tag <<ListboxSelect>> { focus -force $Apol_Roles::rlistbox}
set ofm [$s_optionsbox getframe]
set l_innerFrame [LabelFrame $ofm.to \
-relief sunken -borderwidth 1]
set c_innerFrame [LabelFrame $ofm.co \
-relief sunken -borderwidth 1]
set r_innerFrame [frame $ofm.ro \
-relief flat -borderwidth 1]
set lfm [$l_innerFrame getframe]
set cfm [$c_innerFrame getframe]
set rfm $r_innerFrame
set combo_types [ComboBox $cfm.combo_types -width 30 -textvariable Apol_Roles::types_list \
-helptext "Type or select a type"]
set cb_type [checkbutton $cfm.cb -variable Apol_Roles::opts(useType) -text "Search Using Type" \
-command {Apol_Roles::enable_type_list}]
bindtags $combo_types.e [linsert [bindtags $combo_types.e] 3 listTag]
bind listTag <KeyPress> { ApolTop::_create_popup $Apol_Roles::combo_types %W %K }
set combo_attribute [ComboBox $cfm.combo_attribute \
-textvariable Apol_Roles::selected_attribute \
-modifycmd {Apol_Roles::change_types_list} \
-exportselection 0]
set cb_attrib [checkbutton $cfm.cb_attrib -text "Filter types to select using attribute:" \
-variable Apol_Roles::attrib_sel \
-offvalue 0 -onvalue 1 \
-command {Apol_Roles::enable_attrib_list $Apol_Roles::combo_attribute $Apol_Roles::attrib_sel}]
Apol_Roles::enable_type_list
radiobutton $lfm.names_only -text "Names Only" -variable Apol_Roles::opts(showSelection) -value names
radiobutton $lfm.all_info -text "All Information" -variable Apol_Roles::opts(showSelection) -value all
button $rfm.ok -text OK -width 6 -command {Apol_Roles::searchRoles}
set sw_d [ScrolledWindow [$resultsbox getframe].sw -auto none]
set resultsbox [text [$sw_d getframe].text -bg white -wrap none -state disabled]
$sw_d setwidget $resultsbox
pack $r_innerFrame -side right -fill both -expand yes -anchor ne
pack $l_innerFrame -side left -fill both -anchor n
pack $c_innerFrame -side right -expand yes -anchor nw -padx 5
pack $rfm.ok -side top -anchor e -pady 5 -padx 5
pack $lfm.names_only $lfm.all_info -side top -anchor nw -pady 5 -padx 5
pack $cb_type -side top -anchor nw -padx 10
pack $combo_types -anchor w -padx 10
pack $cb_attrib -expand yes -anchor nw -padx 15
pack $combo_attribute -fill x -expand yes -padx 25
pack $sw_r -fill both -expand yes
pack $sw_d -side left -expand yes -fill both
return $frame
}
namespace eval Apol_RBAC {
variable opts
set opts(allow) 1
set opts(transition) 0
set opts(use_src_list) 0
set opts(use_tgt_list) 0
set opts(use_dflt_list) 0
set opts(list_type) types
set opts(which_1) source
variable src_role ""
variable tgt_selection ""
variable dflt_role ""
variable list_src
variable list_tgt
variable list_dflt_role
variable global_asSource
variable global_any
variable list_types
variable list_attribs
variable list_roles
variable use_src_list
variable use_dflt_role
variable use_tgt_list
variable resultsbox
variable m_use_tgt_role "Target Role"
variable m_use_tgt_ta "Target Type/Attrib"
variable m_disable_tgt "Target"
variable m_disable_dflt_role "Default Role"
variable m_use_dflt_role "Default Role"
variable m_use_src_role "Source Role"
}
proc Apol_RBAC::search { str case_Insensitive regExpr srch_Direction } {
variable resultsbox
ApolTop::textSearch $resultsbox $str $case_Insensitive $regExpr $srch_Direction
return 0
}
proc Apol_RBAC::set_Focus_to_Text {} {
focus $Apol_RBAC::resultsbox
return 0
}
proc Apol_RBAC::searchRoles {} {
variable opts
variable resultsbox
variable src_role
variable tgt_selection
variable list_dflt_role
if {$opts(list_type) == "roles"} {
set tgt_is_role 1
} else {
set tgt_is_role 0
}
set rt [catch {set results [apol_GetRoleRules $opts(allow) $opts(transition) \
$opts(use_src_list) $Apol_RBAC::src_role $opts(which_1) \
$opts(use_tgt_list) $Apol_RBAC::tgt_selection $tgt_is_role \
$opts(use_dflt_list) $Apol_RBAC::dflt_role]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
} else {
$resultsbox configure -state normal
$resultsbox delete 0.0 end
if {$results == ""} {
$resultsbox insert end "0 rules match the search criteria."
} else {
$resultsbox insert end $results
}
ApolTop::makeTextBoxReadOnly $resultsbox
}
}
proc Apol_RBAC::open { } {
variable opts
$Apol_RBAC::list_src configure -values $Apol_Roles::role_list
$Apol_RBAC::list_tgt configure -values $Apol_Types::typelist
$Apol_RBAC::list_dflt_role configure -values $Apol_Roles::role_list
return 0
}
proc Apol_RBAC::close { } {
Apol_RBAC::init_options
$Apol_RBAC::list_src configure -values ""
$Apol_RBAC::list_tgt configure -values ""
$Apol_RBAC::list_dflt_role configure -values ""
$Apol_RBAC::resultsbox configure -state normal
$Apol_RBAC::resultsbox delete 0.0 end
ApolTop::makeTextBoxReadOnly $Apol_RBAC::resultsbox
return
}
proc Apol_RBAC::free_call_back_procs { } {
return 0
}
proc Apol_RBAC::init_options { } {
variable list_src
variable list_tgt
variable list_dflt_role
variable opts
set opts(allow) 1
set opts(transition) 0
set opts(use_src_list) 0
set opts(use_tgt_list) 0
set opts(use_dflt_list) 0
set opts(list_type) types
set opts(which_1) source
set Apol_RBAC::src_role ""
set Apol_RBAC::tgt_selection ""
set Apol_RBAC::dflt_role ""
Apol_RBAC::enable_disable_tgt
Apol_RBAC::enable_disable_tgt_dflt_sections
Apol_RBAC::useSearch $list_src 1
Apol_RBAC::useSearch $list_tgt 2
Apol_RBAC::useSearch $list_dflt_role 3
return
}
proc Apol_RBAC::useSearch { entry list_number } {
variable global_asSource
variable global_any
variable list_types
variable list_attribs
variable list_both
if { $list_number == 1 } {
set which list1
} elseif {$list_number == 2} {
set which list2
} elseif {$list_number == 3} {
set which list3
} else {
return -code error
}
switch $which {
list1 {
if { $Apol_RBAC::opts(use_src_list) } {
if { $Apol_RBAC::opts(which_1) == "source"} {
$entry configure -state normal -entrybg white
$Apol_RBAC::global_asSource configure -state normal
$Apol_RBAC::global_any configure -state normal
} else {
$entry configure -state normal -entrybg white
$Apol_RBAC::global_asSource configure -state normal
$Apol_RBAC::global_any configure -state normal
Apol_RBAC::enable_disable_tgt_dflt_sections
}
} else {
$entry configure -state disabled -entrybg $ApolTop::default_bg_color
$Apol_RBAC::global_asSource configure -state disabled
$Apol_RBAC::global_any configure -state disabled
Apol_RBAC::enable_disable_tgt_dflt_sections
}
}
list2 {
if { $Apol_RBAC::opts(use_tgt_list) } {
if { $Apol_RBAC::opts(allow) } {
$entry configure -state normal -entrybg white
$Apol_RBAC::use_tgt_list configure -text $Apol_RBAC::m_use_tgt_role \
-state normal
$Apol_RBAC::list_types configure -state disabled
$Apol_RBAC::list_attribs configure -state disabled
$Apol_RBAC::list_roles configure -state normal
$Apol_RBAC::list_roles invoke
} elseif { $Apol_RBAC::opts(transition) } {
$entry configure -state normal -entrybg white
$Apol_RBAC::use_tgt_list configure -text $Apol_RBAC::m_use_tgt_ta \
-state normal
$Apol_RBAC::list_roles configure -state disabled
$Apol_RBAC::list_attribs configure -state normal
$Apol_RBAC::list_types configure -state normal
$Apol_RBAC::list_types invoke
} else {
$entry configure -state normal -entrybg white
$Apol_RBAC::list_types configure -state normal
$Apol_RBAC::list_attribs configure -state normal
$Apol_RBAC::list_roles configure -state normal
}
} else {
$entry configure -state disabled -entrybg $ApolTop::default_bg_color
$Apol_RBAC::list_types configure -state disabled
$Apol_RBAC::list_attribs configure -state disabled
$Apol_RBAC::list_roles configure -state disabled
}
}
list3 {
if { $Apol_RBAC::opts(use_dflt_list) } {
$entry configure -state normal -entrybg white
} else {
$entry configure -state disabled -entrybg $ApolTop::default_bg_color
}
}
default {
return -code error
}
}
return 0
}
proc Apol_RBAC::enable_disable_tgt { } {
variable opts
variable list_tgt
variable list_types
variable list_attribs
variable list_roles
variable use_tgt_list
if { $Apol_RBAC::opts(use_tgt_list) } {
if { $Apol_RBAC::opts(allow) && $Apol_RBAC::opts(transition) } {
$Apol_RBAC::use_tgt_list deselect
$Apol_RBAC::list_tgt configure -state disabled
$Apol_RBAC::list_types configure -state disabled
$Apol_RBAC::list_attribs configure -state disabled
$Apol_RBAC::list_roles configure -state disabled
$Apol_RBAC::use_tgt_list configure -text $Apol_RBAC::m_disable_tgt -state disabled
$Apol_RBAC::use_dflt_role configure -state disabled \
-text $Apol_RBAC::m_disable_dflt_role
$Apol_RBAC::use_dflt_role deselect
} elseif { $Apol_RBAC::opts(allow) } {
$Apol_RBAC::use_tgt_list deselect
$Apol_RBAC::use_tgt_list configure -text $Apol_RBAC::m_use_tgt_role -state normal
$Apol_RBAC::list_tgt configure -state disabled
$Apol_RBAC::list_types configure -state disabled
$Apol_RBAC::list_attribs configure -state disabled
$Apol_RBAC::list_roles configure -state disabled
$Apol_RBAC::list_dflt_role configure -state disabled
$Apol_RBAC::use_dflt_role configure -state disabled \
-text $Apol_RBAC::m_disable_dflt_role
$Apol_RBAC::use_dflt_role deselect
} elseif { $Apol_RBAC::opts(transition) } {
$Apol_RBAC::use_tgt_list deselect
$Apol_RBAC::use_tgt_list configure -text $Apol_RBAC::m_use_tgt_ta -state normal
$Apol_RBAC::list_tgt configure -state disabled
$Apol_RBAC::list_roles configure -state disabled
$Apol_RBAC::list_attribs configure -state disabled
$Apol_RBAC::list_types configure -state disabled
} else {
$Apol_RBAC::use_tgt_list deselect
$Apol_RBAC::use_tgt_list configure -text $Apol_RBAC::m_disable_tgt -state disabled
$Apol_RBAC::list_tgt configure -state disabled
$Apol_RBAC::list_roles configure -state disabled
$Apol_RBAC::list_attribs configure -state disabled
$Apol_RBAC::list_types configure -state disabled
$Apol_RBAC::use_dflt_role configure -state disabled \
-text $Apol_RBAC::m_disable_dflt_role
$Apol_RBAC::use_dflt_role deselect
}
} else {
if { $Apol_RBAC::opts(allow) && $Apol_RBAC::opts(transition) } {
$Apol_RBAC::list_tgt configure -state disabled
$Apol_RBAC::list_types configure -state disabled
$Apol_RBAC::list_attribs configure -state disabled
$Apol_RBAC::list_roles configure -state disabled
$Apol_RBAC::use_tgt_list configure -text $Apol_RBAC::m_disable_tgt -state disabled
$Apol_RBAC::use_dflt_role configure -state disabled \
-text $Apol_RBAC::m_disable_dflt_role
$Apol_RBAC::use_dflt_role deselect
} elseif { $Apol_RBAC::opts(allow) } {
$Apol_RBAC::use_tgt_list configure -text $Apol_RBAC::m_use_tgt_role -state normal
$Apol_RBAC::list_tgt configure -state disabled
$Apol_RBAC::list_types configure -state disabled
$Apol_RBAC::list_attribs configure -state disabled
$Apol_RBAC::list_roles configure -state disabled
$Apol_RBAC::list_dflt_role configure -state disabled
$Apol_RBAC::use_dflt_role configure -state disabled \
-text $Apol_RBAC::m_disable_dflt_role
$Apol_RBAC::use_dflt_role deselect
} elseif { $Apol_RBAC::opts(transition) } {
$Apol_RBAC::use_tgt_list configure -text $Apol_RBAC::m_use_tgt_ta -state normal
$Apol_RBAC::list_tgt configure -state disabled
$Apol_RBAC::list_roles configure -state disabled
$Apol_RBAC::list_attribs configure -state disabled
$Apol_RBAC::list_types configure -state disabled
} else {
$Apol_RBAC::use_tgt_list configure -text $Apol_RBAC::m_disable_tgt -state disabled
$Apol_RBAC::list_tgt configure -state disabled
$Apol_RBAC::list_roles configure -state disabled
$Apol_RBAC::list_attribs configure -state disabled
$Apol_RBAC::list_types configure -state disabled
$Apol_RBAC::use_dflt_role configure -state disabled \
-text $Apol_RBAC::m_disable_dflt_role
$Apol_RBAC::use_dflt_role deselect
}
}
}
proc Apol_RBAC::enable_disable_tgt_dflt_sections { } {
variable list_tgt
variable list_dflt_role
variable list_types
variable list_attribs
variable list_roles
variable use_dflt_role
variable use_tgt_list
if { $Apol_RBAC::opts(use_src_list) == 1 } {
if { $Apol_RBAC::opts(which_1) == "any" } {
$Apol_RBAC::list_dflt_role configure -state disabled
$Apol_RBAC::use_dflt_role configure -state disabled \
-text $Apol_RBAC::m_disable_dflt_role
$Apol_RBAC::use_dflt_role deselect
$Apol_RBAC::list_tgt configure -state disabled
$Apol_RBAC::use_tgt_list configure -state disabled -text $Apol_RBAC::m_disable_tgt
$Apol_RBAC::use_tgt_list deselect
$Apol_RBAC::list_types configure -state disabled
$Apol_RBAC::list_attribs configure -state disabled
$Apol_RBAC::list_roles configure -state disabled
} elseif { $Apol_RBAC::opts(which_1) == "source" } {
$Apol_RBAC::use_dflt_role configure -state normal \
-text $Apol_RBAC::m_use_dflt_role
Apol_RBAC::enable_disable_tgt
}
} else {
$Apol_RBAC::use_dflt_role configure -state normal -text $Apol_RBAC::m_use_dflt_role
Apol_RBAC::enable_disable_tgt
}
}
proc Apol_RBAC::goto_line { line_num } {
variable resultsbox
ApolTop::goto_line $line_num $resultsbox
return 0
}
proc Apol_RBAC::populate_listbox { cBox } {
$cBox configure -text ""
switch $Apol_RBAC::opts(list_type) {
types {
$cBox configure -values $Apol_Types::typelist
}
attribs {
$cBox configure -values $Apol_Types::attriblist
}
both {
set bothlist [concat $Apol_Types::typelist $Apol_Types::attriblist]
set bothlist [lsort -dictionary $bothlist]
$cBox configure -values $bothlist
}
roles {
$cBox configure -values $Apol_Roles::role_list
}
default {
$cBox configure -values ""
}
}
return 0
}
proc Apol_RBAC::create {nb} {
variable opts
variable resultsbox
variable list_src
variable list_tgt
variable list_dflt_role
variable global_asSource
variable global_any
variable use_src_list
variable list_types
variable list_attribs
variable list_roles
variable use_dflt_role
variable use_tgt_list
global tcl_platform
set frame [$nb insert end $ApolTop::rbac_tab -text "RBAC Rules"]
set pw1 [PanedWindow $frame.pw1 -side left -weights available]
$pw1 add -minsize 110
$pw1 add -weight 4
set topf [frame [$pw1 getframe 0].topf]
set bottomf [frame [$pw1 getframe 1].bottomf]
pack $pw1 -fill both -expand yes
pack $topf -fill both -expand yes
pack $bottomf -fill both -expand yes
set pw2 [PanedWindow $topf.pw2 -side top -weights available]
$pw2 add -minsize 110
$pw2 add -weight 6
set obox [TitleFrame [$pw2 getframe 1].obox -text "Search Criteria"]
set tbox [TitleFrame [$pw2 getframe 0].tbox -text "Rule Selection"]
set dbox [TitleFrame $bottomf.dbox -text "RBAC Rules Display"]
pack $pw2 -fill both -expand yes
pack $obox -side right -anchor w -fill both -padx 5 -expand yes
pack $tbox -side left -anchor w -fill both -padx 5 -expand yes
pack $dbox -side left -fill both -expand yes -anchor e -pady 5 -padx 5
set fm [$tbox getframe]
set optsfm [frame $fm.optsfm]
set frame [$obox getframe]
set fm_buttons [frame $frame.ta4 -relief flat -borderwidth 1]
set fm_src [frame $frame.src_role \
-relief flat -borderwidth 1]
set fm_tgt [frame $frame.tgt \
-relief flat -borderwidth 1]
set fm_dflt_role [frame $frame.dflt_role \
-relief flat -borderwidth 1]
pack $fm_buttons -side right -anchor e -padx 5 -fill both
pack $fm_src -side left -anchor nw -padx 5 -fill x -padx 5
pack $fm_tgt -side left -fill x -anchor nw -padx 5
pack $fm_dflt_role -side left -anchor n -fill x -padx 5
checkbutton $optsfm.allow -text "Allow" -variable Apol_RBAC::opts(allow) \
-command "Apol_RBAC::enable_disable_tgt_dflt_sections" -offvalue 0 -onvalue 1
checkbutton $optsfm.trans -text "Transition" -variable Apol_RBAC::opts(transition) \
-command "Apol_RBAC::enable_disable_tgt_dflt_sections" -offvalue 0 -onvalue 1
set list_src [ComboBox $fm_src.cb -helptext "First role search parameter" \
-textvariable Apol_RBAC::src_role -helptext "Type or select a role" ]
bindtags $list_src.e [linsert [bindtags $list_src.e] 3 list_src_Tag]
bind list_src_Tag <KeyPress> { ApolTop::_create_popup $Apol_RBAC::list_src %W %K }
set global_asSource [radiobutton $fm_src.source_1 -text "As source" \
-variable Apol_RBAC::opts(which_1) \
-value source \
-command "Apol_RBAC::enable_disable_tgt_dflt_sections"]
set global_any [radiobutton $fm_src.any -text "Any " \
-variable Apol_RBAC::opts(which_1) \
-value any \
-command "Apol_RBAC::enable_disable_tgt_dflt_sections"]
set use_src_list [checkbutton $fm_src.use_src_list -text $Apol_RBAC::m_use_src_role \
-variable Apol_RBAC::opts(use_src_list) \
-command "Apol_RBAC::useSearch $list_src 1"]
set list_tgt [ComboBox $fm_tgt.cb2 -helptext "Target search parameter" \
-textvariable Apol_RBAC::tgt_selection -helptext "Type or select a type/attribute/role" ]
bindtags $list_tgt.e [linsert [bindtags $list_tgt.e] 3 list_tgt_Tag]
bind list_tgt_Tag <KeyPress> { ApolTop::_create_popup $Apol_RBAC::list_tgt %W %K }
set use_tgt_list [checkbutton $fm_tgt.use_3 -text $Apol_RBAC::m_disable_tgt \
-variable Apol_RBAC::opts(use_tgt_list) \
-command "Apol_RBAC::useSearch $list_tgt 2" ]
set list_types [radiobutton $fm_tgt.list_types -text "Types" \
-variable Apol_RBAC::opts(list_type) -value types \
-command {Apol_RBAC::populate_listbox $Apol_RBAC::list_tgt} ]
set list_attribs [radiobutton $fm_tgt.list_attribs -text "Attribs" \
-variable Apol_RBAC::opts(list_type) -value attribs \
-command {Apol_RBAC::populate_listbox $Apol_RBAC::list_tgt } ]
set list_roles [radiobutton $fm_tgt.list_roles -text "Roles" \
-variable Apol_RBAC::opts(list_type) -value roles \
-command {Apol_RBAC::populate_listbox $Apol_RBAC::list_tgt} ]
set list_dflt_role [ComboBox $fm_dflt_role.cb3 -helptext "First role search parameter" \
-textvariable Apol_RBAC::dflt_role -helptext "Type or select a role" ]
bindtags $list_dflt_role.e [linsert [bindtags $list_dflt_role.e] 3 list_dflt_role_Tag]
bind list_dflt_role_Tag <KeyPress> { ApolTop::_create_popup $Apol_RBAC::list_dflt_role %W %K }
set use_dflt_role [checkbutton $fm_dflt_role.use_3 -text $Apol_RBAC::m_disable_dflt_role \
-variable Apol_RBAC::opts(use_dflt_list) \
-command "Apol_RBAC::useSearch $list_dflt_role 3" ]
set sw [ScrolledWindow [$dbox getframe].sw -auto none]
set resultsbox [text [$sw getframe].text -bg white -wrap none -state disabled]
$sw setwidget $resultsbox
button $fm_buttons.ok -text OK -width 6 -command {Apol_RBAC::searchRoles}
pack $optsfm.allow $optsfm.trans -anchor nw -side top -pady 1
pack $optsfm -side left -fill x -expand yes -anchor nw
pack $fm_buttons.ok -side top -pady 5 -anchor se
pack $use_src_list -anchor w
pack $list_src -anchor w -expand yes -fill x -padx 5
pack $global_asSource $global_any -side left -ipady 5 -fill y -expand yes
pack $use_tgt_list -anchor w -side top
pack $list_tgt -anchor w -expand yes -fill x -padx 5
pack $list_types $list_attribs $list_roles -side left -pady 7 -fill y -expand yes
pack $use_dflt_role -anchor w
pack $list_dflt_role -anchor w -expand yes -fill x -padx 5
pack $sw -side left -expand yes -fill both
Apol_RBAC::init_options
return $frame
}
namespace eval Apol_Users {
variable opts
set opts(useRole) 0
set opts(showSelection) all
variable srchstr ""
variable role_1ist ""
variable users_list ""
variable menu_callbacks ""
variable resultsbox
variable users_listbox
variable role_combo_box
}
proc Apol_Users::search { str case_Insensitive regExpr srch_Direction } {
variable resultsbox
ApolTop::textSearch $resultsbox $str $case_Insensitive $regExpr $srch_Direction
return 0
}
proc Apol_Users::set_Focus_to_Text {} {
focus $Apol_Users::resultsbox
return 0
}
proc Apol_Users::searchUsers {} {
variable opts
variable resultsbox
if {$opts(showSelection) == "names"} {
set name_only 1
} else {
set name_only 0
}
set rt [catch {set results [apol_GetUsersByRole $name_only $opts(useRole) \
$Apol_Users::role_list]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
} else {
$resultsbox configure -state normal
$resultsbox delete 0.0 end
$resultsbox insert end $results
ApolTop::makeTextBoxReadOnly $resultsbox
}
return 0
}
proc Apol_Users::open { } {
variable role_list
variable users_list
set rt [catch {set users_list [apol_GetNames users]} err]
if {$rt != 0} {
return -code error $err
}
set users_list [lsort $users_list]
$Apol_Users::role_combo_box configure -values $Apol_Roles::role_list
return 0
}
proc Apol_Users::close { } {
set Apol_Users::role_list ""
set Apol_Users::users_list ""
$Apol_Users::role_combo_box configure -values ""
$Apol_Users::resultsbox configure -state normal
$Apol_Users::resultsbox delete 0.0 end
ApolTop::makeTextBoxReadOnly $Apol_Users::resultsbox
return 0
}
proc Apol_Users::free_call_back_procs { } {
variable menu_callbacks
set menu_callbacks ""
return 0
}
proc Apol_Users::popupUserInfo {which user} {
set rt [catch {set info [apol_UserRoles $user]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
set w .user_infobox
set rt [catch {destroy $w} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
catch {destroy $w}
toplevel $w
wm title $w "$user"
wm protocol $w WM_DELETE_WINDOW " "
wm withdraw $w
set sf [ScrolledWindow $w.sf -scrollbar both -auto both]
set f [text [$sf getframe].f -font {helvetica 10} -wrap none -width 35 -height 10]
$sf setwidget $f
set b1 [button $w.close -text Close -command "catch {destroy $w}" -width 10]
pack $b1 -side bottom -anchor s -padx 5 -pady 5
pack $sf -fill both -expand yes
set user_count [llength $info]
$f insert end "$user ($user_count roles)\n\t"
foreach role $info {
$f insert end "$role\n\t"
}
wm geometry $w +50+50
wm deiconify $w
$f configure -state disabled
wm protocol $w WM_DELETE_WINDOW "destroy $w"
return 0
}
proc Apol_Users::enable_role_list { entry } {
variable role_combo_box
if { $Apol_Users::opts(useRole) } {
$entry configure -state normal -entrybg white
} else {
$entry configure -state disabled -entrybg $ApolTop::default_bg_color
set $Apol_Users::role_list ""
ComboBox::_unmapliste $role_combo_box
}
return 0
}
proc Apol_Users::goto_line { line_num } {
variable resultsbox
ApolTop::goto_line $line_num $resultsbox
return 0
}
proc Apol_Users::create {nb} {
variable opts
variable users_listbox
variable resultsbox
variable srchstr
variable role_combo_box
variable menu_callbacks
set frame [$nb insert end $ApolTop::users_tab -text "Users"]
set topf [frame $frame.topf]
set pw1 [PanedWindow $topf.pw -side top]
set pane [$pw1 add ]
set spane [$pw1 add -weight 5]
set pw2 [PanedWindow $pane.pw -side left]
set rpane [$pw2 add -weight 3]
set userbox [TitleFrame $rpane.userbox -text "Users"]
set s_optionsbox [TitleFrame $spane.obox -text "Search Options"]
set resultsbox [TitleFrame $spane.rbox -text "Search Results"]
pack $topf -fill both -expand yes
pack $pw1 -fill both -expand yes
pack $pw2 -fill both -expand yes
pack $s_optionsbox -padx 2 -fill both
pack $userbox -padx 2 -side left -fill both -expand yes
pack $resultsbox -pady 2 -padx 2 -fill both -anchor n -side bottom -expand yes
set sw_r [ScrolledWindow [$userbox getframe].sw -auto both]
set users_listbox [listbox [$sw_r getframe].lb -height 18 -width 20 -highlightthickness 0 \
-listvar Apol_Users::users_list -bg white]
$sw_r setwidget $users_listbox
menu .popupMenu_users
set menu_callbacks [lappend menu_callbacks {"Display User Info" "Apol_Users::popupUserInfo users"}]
bindtags $users_listbox [linsert [bindtags $users_listbox] 3 ulist_Tag]
bind ulist_Tag <Double-Button-1> { Apol_Users::popupUserInfo "users" [$Apol_Users::users_listbox get active]}
bind ulist_Tag <Button-3> { ApolTop::popup_listbox_Menu \
%W %x %y .popupMenu_users $Apol_Users::menu_callbacks \
$Apol_Users::users_listbox}
bind ulist_Tag <<ListboxSelect>> { focus -force $Apol_Users::users_listbox}
set ofm [$s_optionsbox getframe]
set l_innerFrame [LabelFrame $ofm.to \
-relief sunken -borderwidth 1]
set c_innerFrame [LabelFrame $ofm.co \
-relief sunken -borderwidth 1]
set r_innerFrame [frame $ofm.ro \
-relief flat -borderwidth 1]
set lfm [$l_innerFrame getframe]
set cfm [$c_innerFrame getframe]
set rfm $r_innerFrame
set role_combo_box [ComboBox $cfm.combo -width 30 -textvariable Apol_Users::role_list \
-helptext "Type or select a role"]
$role_combo_box configure -state disabled
bindtags $role_combo_box.e [linsert [bindtags $role_combo_box.e] 3 rolesTag]
bind rolesTag <KeyPress> { ApolTop::_create_popup $Apol_Users::role_combo_box %W %K }
radiobutton $lfm.names_only -text "Names Only" -variable Apol_Users::opts(showSelection) -value names
radiobutton $lfm.all_info -text "All Information" -variable Apol_Users::opts(showSelection) -value all
checkbutton $cfm.cb -variable Apol_Users::opts(useRole) -text "Search Using Roles" \
-command "Apol_Users::enable_role_list $role_combo_box"
button $rfm.ok -text OK -width 6 -command {Apol_Users::searchUsers}
set sw_d [ScrolledWindow [$resultsbox getframe].sw -auto none]
set resultsbox [text [$sw_d getframe].text -bg white -wrap none -state disabled]
$sw_d setwidget $resultsbox
pack $r_innerFrame -side right -fill both -expand yes -anchor ne
pack $l_innerFrame -side left -fill both -anchor n
pack $c_innerFrame -side right -expand yes -anchor nw -padx 5 -fill y
pack $rfm.ok -side top -anchor e -pady 5 -padx 5
pack $lfm.names_only $lfm.all_info -side top -anchor nw -pady 5 -padx 5
pack $cfm.cb -side top -anchor nw -padx 10 -pady 5
pack $role_combo_box -anchor w -pady 10 -padx 10
pack $sw_r -fill both -expand yes
pack $sw_d -side left -expand yes -fill both
return $frame
}
namespace eval Apol_Initial_SIDS {
variable opts
set opts(user) ""
set opts(role) ""
set opts(type) ""
variable attribute_selected ""
variable user_cb_value 0
variable role_cb_value 0
variable type_cb_value 0
variable attribute_cb_value 0
variable sids_list ""
variable resultsbox
variable init_sids_listbox
variable user_combo_box
variable role_combo_box
variable type_combo_box
variable attribute_combo_box
variable cb_attrib
variable menu_callbacks ""
}
proc Apol_Initial_SIDS::search { str case_Insensitive regExpr srch_Direction } {
variable resultsbox
ApolTop::textSearch $resultsbox $str $case_Insensitive $regExpr $srch_Direction
return 0
}
proc Apol_Initial_SIDS::set_Focus_to_Text {} {
focus $Apol_Initial_SIDS::resultsbox
return 0
}
proc Apol_Initial_SIDS::searchSIDs {} {
variable opts
set user ""
set role ""
set type ""
if {$Apol_Initial_SIDS::user_cb_value && $opts(user) == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "You must provide a user."
return -1
} elseif {$Apol_Initial_SIDS::user_cb_value} {
set user $opts(user)
}
if {$Apol_Initial_SIDS::role_cb_value && $opts(role) == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "You must provide a role."
return -1
} elseif {$Apol_Initial_SIDS::role_cb_value} {
set role $opts(role)
}
if {$Apol_Initial_SIDS::type_cb_value && $opts(type) == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "You must provide a type."
return -1
} elseif {$Apol_Initial_SIDS::type_cb_value} {
set type $opts(type)
}
set rt [catch {set results [apol_SearchInitialSIDs $user $role $type]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
} else {
$Apol_Initial_SIDS::resultsbox configure -state normal
$Apol_Initial_SIDS::resultsbox delete 0.0 end
$Apol_Initial_SIDS::resultsbox insert end $results
ApolTop::makeTextBoxReadOnly $Apol_Initial_SIDS::resultsbox
}
return 0
}
proc Apol_Initial_SIDS::open { } {
variable sids_list
set rt [catch {set sids_list [apol_GetNames initial_sids]} err]
if {$rt != 0} {
return -code error $err
}
set sids_list [lsort $sids_list]
$Apol_Initial_SIDS::user_combo_box configure -values $Apol_Users::users_list
$Apol_Initial_SIDS::role_combo_box configure -values $Apol_Roles::role_list
$Apol_Initial_SIDS::type_combo_box configure -values $Apol_Types::typelist
$Apol_Initial_SIDS::attribute_combo_box configure -values $Apol_Types::attriblist
ApolTop::change_comboBox_state $Apol_Initial_SIDS::user_cb_value $Apol_Initial_SIDS::user_combo_box
ApolTop::change_comboBox_state $Apol_Initial_SIDS::role_cb_value $Apol_Initial_SIDS::role_combo_box
ApolTop::change_comboBox_state $Apol_Initial_SIDS::type_cb_value $Apol_Initial_SIDS::type_combo_box
ApolTop::change_comboBox_state $Apol_Initial_SIDS::attribute_cb_value $Apol_Initial_SIDS::attribute_combo_box
$Apol_Initial_SIDS::cb_attrib configure -state disabled
return 0
}
proc Apol_Initial_SIDS::close { } {
set Apol_Initial_SIDS::sids_list ""
set Apol_Initial_SIDS::user_cb_value 0
set Apol_Initial_SIDS::role_cb_value 0
set Apol_Initial_SIDS::type_cb_value 0
set Apol_Initial_SIDS::attribute_cb_value 0
$Apol_Initial_SIDS::user_combo_box configure -values ""
$Apol_Initial_SIDS::role_combo_box configure -values ""
$Apol_Initial_SIDS::type_combo_box configure -values ""
$Apol_Initial_SIDS::attribute_combo_box configure -values ""
$Apol_Initial_SIDS::resultsbox configure -state normal
$Apol_Initial_SIDS::resultsbox delete 0.0 end
ApolTop::makeTextBoxReadOnly $Apol_Initial_SIDS::resultsbox
ApolTop::change_comboBox_state $Apol_Initial_SIDS::user_cb_value $Apol_Initial_SIDS::user_combo_box
ApolTop::change_comboBox_state $Apol_Initial_SIDS::role_cb_value $Apol_Initial_SIDS::role_combo_box
ApolTop::change_comboBox_state $Apol_Initial_SIDS::type_cb_value $Apol_Initial_SIDS::type_combo_box
ApolTop::change_comboBox_state $Apol_Initial_SIDS::attribute_cb_value $Apol_Initial_SIDS::attribute_combo_box
return 0
}
proc Apol_Initial_SIDS::free_call_back_procs { } {
variable menu_callbacks
set menu_callbacks ""
return 0
}
proc Apol_Initial_SIDS::popupSIDInfo {sid} {
set rt [catch {set info [apol_GetInitialSIDInfo $sid]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
set w .user_infobox
set rt [catch {destroy $w} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
catch {destroy $w}
toplevel $w
wm title $w "$sid Context"
wm protocol $w WM_DELETE_WINDOW " "
wm withdraw $w
set sf [ScrolledWindow $w.sf -scrollbar both -auto both]
set f [text [$sf getframe].f -font {helvetica 10} -wrap none -width 35 -height 10]
$sf setwidget $f
set b1 [button $w.close -text Close -command "catch {destroy $w}" -width 10]
pack $b1 -side bottom -anchor s -padx 5 -pady 5
pack $sf -fill both -expand yes
set user_count [llength $info]
$f insert end "$sid:\n"
$f insert end " $info\n"
wm geometry $w +50+50
wm deiconify $w
$f configure -state disabled
wm protocol $w WM_DELETE_WINDOW "destroy $w"
return 0
}
proc Apol_Initial_SIDS::enable_types_widgets {} {
ApolTop::change_comboBox_state $Apol_Initial_SIDS::type_cb_value $Apol_Initial_SIDS::type_combo_box
ApolTop::change_comboBox_state $Apol_Initial_SIDS::attribute_cb_value $Apol_Initial_SIDS::attribute_combo_box
if {$Apol_Initial_SIDS::type_cb_value} {
$Apol_Initial_SIDS::cb_attrib configure -state normal
} else {
ApolTop::change_comboBox_state 0 $Apol_Initial_SIDS::attribute_combo_box
$Apol_Initial_SIDS::cb_attrib configure -state disabled
}
return 0
}
proc Apol_Initial_SIDS::change_types_list { } {
variable type_combo_box
variable attribute_selected
$type_combo_box configure -text ""
if {$Apol_Initial_SIDS::attribute_cb_value && $attribute_selected != "" } {
set rt [catch {set attrib_typesList [apol_GetAttribTypesList $attribute_selected]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
set attrib_typesList [lsort $attrib_typesList]
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$type_combo_box configure -values $attrib_typesList
} else {
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$type_combo_box configure -values $attrib_typesList
}
return 0
}
proc Apol_Initial_SIDS::goto_line { line_num } {
variable resultsbox
ApolTop::goto_line $line_num $resultsbox
return 0
}
proc Apol_Initial_SIDS::create {nb} {
variable opts
variable init_sids_listbox
variable resultsbox
variable user_combo_box
variable role_combo_box
variable type_combo_box
variable attribute_combo_box
variable cb_attrib
variable menu_callbacks
set frame [$nb insert end $ApolTop::initial_sids_tab -text "Initial SIDs"]
set topf [frame $frame.topf]
set pw1 [PanedWindow $topf.pw -side top]
set pane [$pw1 add ]
set spane [$pw1 add -weight 5]
set pw2 [PanedWindow $pane.pw -side left]
set rpane [$pw2 add -weight 3]
set sids_box [TitleFrame $rpane.sids_box -text "Initial SIDs"]
set s_optionsbox [TitleFrame $spane.obox -text "Search Options"]
set rslts_frame [TitleFrame $spane.rbox -text "Search Results"]
pack $topf -fill both -expand yes
pack $pw1 -fill both -expand yes
pack $pw2 -fill both -expand yes
pack $s_optionsbox -padx 2 -fill both
pack $sids_box -padx 2 -side left -fill both -expand yes
pack $rslts_frame -pady 2 -padx 2 -fill both -anchor n -side bottom -expand yes
set sw_r [ScrolledWindow [$sids_box getframe].sw -auto both]
set init_sids_listbox [listbox [$sw_r getframe].lb -height 18 -highlightthickness 0 \
-listvar Apol_Initial_SIDS::sids_list -bg white]
$sw_r setwidget $init_sids_listbox
menu .popupMenu_sids
set menu_callbacks [lappend menu_callbacks {"Display Initial SID Context" "Apol_Initial_SIDS::popupSIDInfo"}]
bindtags $init_sids_listbox [linsert [bindtags $init_sids_listbox] 3 sidlist_Tag]
bind sidlist_Tag <Double-Button-1> {Apol_Initial_SIDS::popupSIDInfo [$Apol_Initial_SIDS::init_sids_listbox get active]}
bind sidlist_Tag <Button-3> {ApolTop::popup_listbox_Menu \
%W %x %y .popupMenu_sids $Apol_Initial_SIDS::menu_callbacks \
$Apol_Initial_SIDS::init_sids_listbox}
bind sidlist_Tag <<ListboxSelect>> {focus -force $Apol_Initial_SIDS::init_sids_listbox}
set ofm [$s_optionsbox getframe]
set l_innerFrame [LabelFrame $ofm.to -relief sunken -bd 1]
set c_innerFrame [LabelFrame $ofm.co -relief sunken -bd 1]
set r_innerFrame [LabelFrame $ofm.ro -relief sunken -bd 1]
set buttons_f [LabelFrame $ofm.buttons_f]
set user_combo_box [ComboBox [$l_innerFrame getframe].user_combo_box \
-textvariable Apol_Initial_SIDS::opts(user) \
-helptext "Type or select a user" \
-entrybg $ApolTop::default_bg_color]
set role_combo_box [ComboBox [$c_innerFrame getframe].role_combo_box \
-textvariable Apol_Initial_SIDS::opts(role) \
-helptext "Type or select a role" \
-entrybg $ApolTop::default_bg_color]
set type_combo_box [ComboBox [$r_innerFrame getframe].type_combo_box \
-textvariable Apol_Initial_SIDS::opts(type) \
-helptext "Type or select a type" \
-entrybg $ApolTop::default_bg_color]
set attribute_combo_box [ComboBox [$r_innerFrame getframe].attribute_combo_box \
-textvariable Apol_Initial_SIDS::attribute_selected \
-entrybg $ApolTop::default_bg_color \
-modifycmd {Apol_Initial_SIDS::change_types_list}]
$user_combo_box configure -state disabled
$role_combo_box configure -state disabled
$type_combo_box configure -state disabled
$attribute_combo_box configure -state disabled
bindtags $user_combo_box.e [linsert [bindtags $user_combo_box.e] 3 sid_user_Tag]
bind sid_user_Tag <KeyPress> {ApolTop::_create_popup $Apol_Initial_SIDS::user_combo_box %W %K}
bindtags $role_combo_box.e [linsert [bindtags $role_combo_box.e] 3 sid_role_Tag]
bind sid_role_Tag <KeyPress> {ApolTop::_create_popup $Apol_Initial_SIDS::role_combo_box %W %K}
bindtags $type_combo_box.e [linsert [bindtags $type_combo_box.e] 3 sid_type_Tag]
bind sid_type_Tag <KeyPress> {ApolTop::_create_popup $Apol_Initial_SIDS::type_combo_box %W %K}
bindtags $attribute_combo_box.e [linsert [bindtags $attribute_combo_box.e] 3 sid_attrib_Tag]
bind sid_attrib_Tag <KeyPress> {ApolTop::_create_popup $Apol_Initial_SIDS::attribute_combo_box %W %K}
set cb_user [checkbutton [$l_innerFrame getframe].cb_user \
-variable Apol_Initial_SIDS::user_cb_value -text "Search Using User" \
-onvalue 1 -offvalue 0 \
-command {ApolTop::change_comboBox_state $Apol_Initial_SIDS::user_cb_value $Apol_Initial_SIDS::user_combo_box}]
set cb_role [checkbutton [$c_innerFrame getframe].cb_role \
-variable Apol_Initial_SIDS::role_cb_value -text "Search Using Role" \
-onvalue 1 -offvalue 0 \
-command {ApolTop::change_comboBox_state $Apol_Initial_SIDS::role_cb_value $Apol_Initial_SIDS::role_combo_box}]
set cb_attrib [checkbutton [$r_innerFrame getframe].cb_attrib \
-text "Filter types to select using attribute:" \
-variable Apol_Initial_SIDS::attribute_cb_value \
-offvalue 0 -onvalue 1 \
-command {ApolTop::change_comboBox_state $Apol_Initial_SIDS::attribute_cb_value $Apol_Initial_SIDS::attribute_combo_box
Apol_Initial_SIDS::change_types_list}]
set cb_type [checkbutton [$r_innerFrame getframe].cb_type \
-variable Apol_Initial_SIDS::type_cb_value -text "Search Using Type" \
-onvalue 1 -offvalue 0 \
-command "Apol_Initial_SIDS::enable_types_widgets"]
$cb_attrib configure -state disabled
set ok_button [button [$buttons_f getframe].ok -text OK -width 6 -command {Apol_Initial_SIDS::searchSIDs}]
set sw_d [ScrolledWindow [$rslts_frame getframe].sw -auto none]
set resultsbox [text [$sw_d getframe].text -bg white -wrap none -state disabled]
$sw_d setwidget $resultsbox
pack $ok_button -side top -anchor e -pady 5 -padx 5
pack $buttons_f -side right -expand yes -fill both -anchor nw -padx 4 -pady 4
pack $r_innerFrame -side right -fill both -anchor nw -padx 4 -pady 4
pack $l_innerFrame $c_innerFrame -side left -fill both -anchor nw -padx 4 -pady 4
pack $cb_user $cb_role $cb_type -side top -anchor nw
pack $user_combo_box $role_combo_box $type_combo_box -side top -fill x -anchor nw -padx 4
pack $cb_attrib -side top -anchor nw -padx 15
pack $attribute_combo_box -side top -fill x -anchor nw -padx 25 -pady 2
pack $sw_r -fill both -expand yes
pack $sw_d -side left -expand yes -fill both
return $frame
}
namespace eval Apol_File_Contexts {
variable opts
set opts(user) ""
set opts(class) ""
set opts(type) ""
set opts(regEx_user) 0
set opts(regEx_type) 0
set opts(regEx_path) 0
variable attribute_selected ""
variable user_cb_value 0
variable class_cb_value 0
variable type_cb_value 0
variable path_cb_value 0
variable progressmsg ""
variable progress_indicator -1
variable db_loaded 0
variable show_ctxt 1
variable show_class 1
variable resultsbox
variable lbl_status
variable user_combo_box
variable objclass_combo_box
variable type_combo_box
variable progressDlg .progress_Dlg
variable entry_dir
variable entry_fn
variable entry_path
variable create_button
variable load_button
variable create_fc_dlg .fc_db_create_Dlg
variable info_button_text { \
"This tab allows you to create and load a file context index. \n \
The file context index is an on-disk database which contains \n \
the labeling information for an entire filesystem. Once an \n \
index has been created you can query the database by enabling \n \
and selecting a user, type, object class or path. A query can \n \
also use regular expressions, if this is enabled. \n\n \
The results of the context query show the number of results \n \
followed by a list of the matching files. The first field is \n \
the full context followed by the object class of the file and \n \
lastly the path.\n"}
}
proc Apol_File_Contexts::display_analysis_info {} {
set info_Dlg .info_Dlg_fc
if { [winfo exists $info_Dlg] } {
destroy $info_Dlg
}
toplevel $info_Dlg
wm protocol $info_Dlg WM_DELETE_WINDOW " "
wm withdraw $info_Dlg
wm title $info_Dlg "Analysis Description"
set topf [frame $info_Dlg.topf]
set botf [frame $info_Dlg.botf]
set sw [ScrolledWindow $topf.sw -auto none]
set descrp_text [text $sw.descrp_text -height 5 -width 20 -font $ApolTop::text_font \
-bg white -wrap word]
$sw setwidget $descrp_text
set b_ok [button $botf.b_ok -text "OK" -width 6 -command "destroy $info_Dlg"]
pack $topf -side top -fill both -expand yes -padx 5 -pady 5
pack $botf -side bottom -anchor center
pack $b_ok -side left -anchor center -pady 2
pack $sw -side top -anchor nw -expand yes -fill both
set txt ""
foreach item $Apol_File_Contexts::info_button_text {
set txt [append txt $item]
}
$descrp_text insert 0.0 $txt
$descrp_text config -state disable
set width 600
set height 440
wm geom $info_Dlg ${width}x${height}
wm deiconify $info_Dlg
wm protocol $info_Dlg WM_DELETE_WINDOW "destroy $info_Dlg"
}
proc Apol_File_Contexts::search { str case_Insensitive regExpr srch_Direction } {
variable resultsbox
ApolTop::textSearch $resultsbox $str $case_Insensitive $regExpr $srch_Direction
return 0
}
proc Apol_File_Contexts::set_Focus_to_Text {} {
focus $Apol_File_Contexts::resultsbox
return 0
}
proc Apol_File_Contexts::is_db_loaded {} {
return $Apol_File_Contexts::db_loaded
}
proc Apol_File_Contexts::init_vars {} {
variable opts
set opts(user) ""
set opts(class) ""
set opts(type) ""
set opts(regEx_user) 0
set opts(regEx_type) 0
set opts(regEx_path) 0
set Apol_File_Contexts::attribute_selected ""
set Apol_File_Contexts::user_cb_value 0
set Apol_File_Contexts::class_cb_value 0
set Apol_File_Contexts::type_cb_value 0
set Apol_File_Contexts::progressmsg ""
set Apol_File_Contexts::progress_indicator -1
set Apol_File_Contexts::db_loaded 0
set Apol_File_Contexts::show_ctxt 1
set Apol_File_Contexts::show_class 1
set Apol_File_Contexts::path_cb_value 0
return 0
}
proc Apol_File_Contexts::populate_combo_boxes {} {
variable user_combo_box
variable objclass_combo_box
variable type_combo_box
set rt [catch {set types [apol_FC_Index_DB_Get_Items types]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "Error getting types from file context database: $err.\n"
return
}
$type_combo_box configure -values $types
set rt [catch {set users [apol_FC_Index_DB_Get_Items users]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "Error getting users from file context database: $err.\n"
return
}
$user_combo_box configure -values $users
set rt [catch {set classes [apol_FC_Index_DB_Get_Items classes]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "Error getting object classes from file context database: $err.\n"
return
}
$objclass_combo_box configure -values [lsort $classes]
return 0
}
proc Apol_File_Contexts::open { } {
return 0
}
proc Apol_File_Contexts::clear_combo_box_values { } {
variable user_combo_box
variable objclass_combo_box
variable type_combo_box
$user_combo_box configure -values "" -text ""
$type_combo_box configure -values "" -text ""
$objclass_combo_box configure -values "" -text ""
}
proc Apol_File_Contexts::initialize { } {
variable entry_path
Apol_File_Contexts::change_status_label ""
Apol_File_Contexts::init_vars
Apol_File_Contexts::clear_combo_box_values
ApolTop::change_comboBox_state $Apol_File_Contexts::user_cb_value $Apol_File_Contexts::user_combo_box
ApolTop::change_comboBox_state $Apol_File_Contexts::type_cb_value $Apol_File_Contexts::type_combo_box
ApolTop::change_comboBox_state $Apol_File_Contexts::class_cb_value $Apol_File_Contexts::objclass_combo_box
$entry_path delete 0 end
Apol_File_Contexts::configure_file_path_entry_widget $Apol_File_Contexts::path_cb_value
$Apol_File_Contexts::resultsbox configure -state normal
$Apol_File_Contexts::resultsbox delete 0.0 end
ApolTop::makeTextBoxReadOnly $Apol_File_Contexts::resultsbox
}
proc Apol_File_Contexts::close { } {
Apol_File_Contexts::close_fc_db
Apol_File_Contexts::initialize
return 0
}
proc Apol_File_Contexts::get_fc_files_for_ta {which ta} {
set types_list ""
set results ""
if {$which == "type"} {
set types_list [lappend types_list $ta]
} else {
set rt [catch {set attrib_typesList [apol_GetAttribTypesList $ta]} err]
if {$rt != 0} {
return -code error $err
}
foreach type $attrib_typesList {
if {$type != "self"} {
set types_list [lappend types_list $type]
}
}
set types_list $attrib_typesList
}
set rt [catch {set results [apol_Search_FC_Index_DB 1 $types_list 0 "" 0 "" 0 "" 0 0 0]} err]
if {$rt != 0} {
return -code error $err
}
set return_list ""
set sz [llength $results]
for {set i 0} {$i < $sz} {incr i} {
set path [lindex $results $i]
incr i
set ctxt [lindex $results $i]
incr i
set class [lindex $results $i]
set return_list [lappend return_list [list $ctxt $class $path]]
}
return $return_list
}
proc Apol_File_Contexts::search_fc_database { } {
variable opts
variable user_cb_value
variable class_cb_value
variable type_cb_value
variable path_cb_value
variable resultsbox
variable entry_path
variable db_loaded
variable show_ctxt
variable show_class
if {$type_cb_value && $opts(type) == ""} {
tk_messageBox -icon error -type ok -title "Error" \
-message "You must specify a type!"
return
}
if {$user_cb_value && $opts(user) == ""} {
tk_messageBox -icon error -type ok -title "Error" \
-message "You must specify a user!"
return
}
if {$class_cb_value && $opts(class) == ""} {
tk_messageBox -icon error -type ok -title "Error" \
-message "You must specify a class!"
return
}
if {$path_cb_value && [$entry_path get] == ""} {
tk_messageBox -icon error -type ok -title "Error" \
-message "You must specify a path!"
return
}
ApolTop::setBusyCursor
set rt [catch {set results [apol_Search_FC_Index_DB \
$type_cb_value [list $opts(type)] \
$user_cb_value [list $opts(user)] \
$class_cb_value [list $opts(class)] \
$path_cb_value [list [$entry_path get]] \
$opts(regEx_user) $opts(regEx_type) $opts(regEx_path)]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
ApolTop::resetBusyCursor
return
}
$resultsbox configure -state normal
$resultsbox delete 0.0 end
set sz [llength $results]
set num 0
for {set i 0} {$i < $sz} {incr i} {
set path [lindex $results $i]
incr i
set ctxt [lindex $results $i]
incr i
set class [lindex $results $i]
if {$show_ctxt} {$resultsbox insert end "$ctxt\t "}
if {$show_class} {$resultsbox insert end "$class\t "}
$resultsbox insert end "$path\n"
incr num
}
$resultsbox insert 1.0 "FILES FOUND ($num):\n\n"
ApolTop::makeTextBoxReadOnly $resultsbox
ApolTop::resetBusyCursor
return 0
}
proc Apol_File_Contexts::display_create_db_dlg {} {
variable entry_dir
variable entry_fn
variable create_fc_dlg
variable b1_create_dlg
variable b2_create_dlg
set w $create_fc_dlg
set rt [catch {destroy $w} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
}
toplevel $w
wm title $w "Create Index File"
wm protocol $w WM_DELETE_WINDOW " "
wm withdraw $w
set t_frame [frame $w.t_frame]
set f1 [frame $t_frame.f1]
set f2 [frame $t_frame.f2]
set f3 [frame $t_frame.f3]
set lbl_fn [Label $f1.lbl_fn -justify left -text "Save file:"]
set lbl_dir [Label $f1.lbl_dir -justify left -text "Directory to index:"]
set entry_dir [entry $f2.entry_path -width 30 -bg white]
set browse_dir [button $f3.button1 -text "Browse" -width 8 -command {
set txt [$Apol_File_Contexts::entry_dir get]
if {[string is space $txt]} {
set txt "/"
} elseif {![file isdirectory $txt]} {
set txt [file dirname $txt]
}
set dir_n [tk_chooseDirectory \
-title "Select Directory to Index..." \
-parent $ApolTop::mainframe \
-initialdir $txt]
if {$dir_n != ""} {
$Apol_File_Contexts::entry_dir delete 0 end
$Apol_File_Contexts::entry_dir insert end $dir_n
}
}]
set entry_fn [entry $f2.entry_fn -width 30 -bg white]
set browse_fn [button $f3.button2 -text "Browse" -width 8 -command {
set txt [$Apol_File_Contexts::entry_fn get]
if {[string is space $txt]} {
set dir_name "/"
set init_file "/"
} elseif {![file isdirectory $txt]} {
set dir_name [file dirname $txt]
set init_file $txt
} else {
set dir_name $txt
set init_file ""
}
set file_n [tk_getSaveFile \
-title "Select File to Save..." \
-parent $ApolTop::mainframe \
-initialdir $dir_name \
-initialfile $init_file]
if {$file_n != ""} {
$Apol_File_Contexts::entry_fn delete 0 end
$Apol_File_Contexts::entry_fn insert end $file_n
}
}]
$entry_dir insert end "/"
set b_frame [frame $w.b_frame]
set b1_create_dlg [button $b_frame.create -text Create \
-command {Apol_File_Contexts::create_fc_db $Apol_File_Contexts::create_fc_dlg} \
-width 10]
set b2_create_dlg [button $b_frame.close1 -text Cancel \
-command {catch {
destroy $Apol_File_Contexts::create_fc_dlg; grab release $Apol_File_Contexts::create_fc_dlg}} \
-width 10]
pack $b_frame -side bottom -expand yes -anchor center
pack $t_frame -side top -fill both -expand yes
pack $f1 $f2 $f3 -side left -anchor nw -padx 5 -pady 5
pack $b1_create_dlg $b2_create_dlg -side left -anchor nw -padx 5 -pady 5
pack $lbl_fn $lbl_dir -anchor nw -side top -pady 6
pack $entry_fn $entry_dir -anchor nw -side top -expand yes -pady 5
pack $browse_fn $browse_dir -anchor nw -side top -expand yes -pady 3
wm geometry $w +50+50
wm deiconify $w
grab $w
wm protocol $w WM_DELETE_WINDOW "destroy $w"
}
proc Apol_File_Contexts::destroy_progressDlg {} {
variable progressDlg
if {[winfo exists $progressDlg]} {
destroy $progressDlg
}
ApolTop::resetBusyCursor
return 0
}
proc Apol_File_Contexts::display_progressDlg {} {
variable progressDlg
set Apol_File_Contexts::progressmsg "Creating index file...This may take a while."
set progressBar [ProgressDlg $Apol_File_Contexts::progressDlg \
-parent $ApolTop::mainframe \
-textvariable Apol_File_Contexts::progressmsg \
-variable Apol_File_Contexts::progress_indicator \
-maximum 3 \
-width 45]
ApolTop::setBusyCursor
update
return 0
}
proc Apol_File_Contexts::create_and_load_fc_db {fname dir_str} {
set rt [catch {apol_Create_FC_Index_File $fname $dir_str} err]
if {$rt != 0} {
return -code error "Error while creating the index file: $err"
}
set rt [catch {apol_Load_FC_Index_File $fname} err]
if {$rt != 0} {
return -code error \
"The index file was created successfully, however, there was an error while loading: $err"
}
Apol_File_Contexts::initialize
set Apol_File_Contexts::db_loaded 1
Apol_File_Contexts::change_status_label $fname
Apol_File_Contexts::populate_combo_boxes
}
proc Apol_File_Contexts::create_fc_db {dlg} {
variable entry_dir
variable entry_fn
variable b1_create_dlg
variable b2_create_dlg
$b1_create_dlg configure -state disabled
$b2_create_dlg configure -state disabled
set fname [$entry_fn get]
set dir_str [$entry_dir get]
Apol_File_Contexts::display_progressDlg
set rt [catch {Apol_File_Contexts::create_and_load_fc_db $fname $dir_str} err]
Apol_File_Contexts::destroy_progressDlg
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "$err\nSee stderr for more information."
$b1_create_dlg configure -state normal
$b2_create_dlg configure -state normal
return
}
catch {destroy $dlg}
grab release $dlg
}
proc Apol_File_Contexts::load_fc_db { } {
variable db_loaded
set db_file [tk_getOpenFile -title "Select Index File to Load..." -parent $ApolTop::mainframe]
if {$db_file != ""} {
set rt [catch {apol_Load_FC_Index_File $db_file} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message \
"Error loading file context database: $err\nSee stderr for more information."
return -1
}
Apol_File_Contexts::initialize
set db_loaded 1
Apol_File_Contexts::change_status_label $db_file
Apol_File_Contexts::populate_combo_boxes
return 1
}
return 0
}
proc Apol_File_Contexts::close_fc_db { } {
variable db_loaded
set rt [catch {apol_Close_FC_Index_DB} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "Error closing file context database: $err.\n"
return
}
set db_loaded 0
return 0
}
proc Apol_File_Contexts::change_status_label {index_file} {
variable lbl_status
if {$index_file == ""} {
set Apol_File_Contexts::index_status "No Index File Loaded"
$lbl_status configure -fg red
} else {
set Apol_File_Contexts::index_status "$index_file"
$lbl_status configure -fg black
}
return 0
}
proc Apol_File_Contexts::goto_line { line_num } {
variable resultsbox
ApolTop::goto_line $line_num $resultsbox
return 0
}
proc Apol_File_Contexts::on_modify_combo_box_value { which } {
variable user_combo_box
variable type_combo_box
switch -exact -- $which \
"user" {
if {$Apol_File_Contexts::opts(regEx_user)} {
set Apol_File_Contexts::opts(user) "^$Apol_File_Contexts::opts(user)$"
selection clear -displayof $user_combo_box
}
} \
"type" {
if {$Apol_File_Contexts::opts(regEx_type)} {
set Apol_File_Contexts::opts(type) "^$Apol_File_Contexts::opts(type)$"
selection clear -displayof $type_combo_box
}
} \
default {
puts "Invalid option $which.\n"
}
return 0
}
proc Apol_File_Contexts::configure_file_path_entry_widget {enable} {
variable entry_path
if {$enable} {
$entry_path configure -state normal
} else {
$entry_path configure -state disabled
}
}
proc Apol_File_Contexts::create {nb} {
variable resultsbox
variable lbl_status
variable user_combo_box
variable objclass_combo_box
variable type_combo_box
variable entry_path
variable create_button
variable load_button
set frame [$nb insert end $ApolTop::file_contexts_tab -text "File Contexts"]
set topf [frame $frame.topf]
set pw [PanedWindow $topf.pw -side left]
set options_pane [$pw add -minsize 220 -weight 2]
set results_pane [$pw add -weight 4 -minsize 130]
set pw2 [PanedWindow $options_pane.pw2 -side top -weights extra]
set search_opts [$pw2 add -weight 1 -minsize 170]
set search_criteria [$pw2 add -weight 5 -minsize 170]
set s_optionsbox [TitleFrame $search_opts.obox -text "Search Options"]
set s_criteriabox [TitleFrame $search_criteria.cbox -text "Search Criteria"]
set rslts_frame [TitleFrame $results_pane.rbox -text "Matching Files"]
set ofm [$s_criteriabox getframe]
set l_innerFrame [LabelFrame $ofm.to -relief sunken -bd 1]
set c_innerFrame [LabelFrame $ofm.co -relief sunken -bd 1]
set r_innerFrame [LabelFrame $ofm.ro -relief sunken -bd 1]
set path_innerFrame [LabelFrame $ofm.po -relief sunken -bd 1]
set buttons_f [LabelFrame $ofm.buttons_f]
set user_combo_box [ComboBox [$l_innerFrame getframe].user_combo_box \
-textvariable Apol_File_Contexts::opts(user) \
-helptext "Type or select a user" \
-entrybg $ApolTop::default_bg_color \
-modifycmd {Apol_File_Contexts::on_modify_combo_box_value user}]
set type_combo_box [ComboBox [$c_innerFrame getframe].type_combo_box \
-textvariable Apol_File_Contexts::opts(type) \
-helptext "Type or select a type" \
-entrybg $ApolTop::default_bg_color \
-modifycmd {Apol_File_Contexts::on_modify_combo_box_value type}]
set objclass_combo_box [ComboBox [$r_innerFrame getframe].objclass_combo_box \
-textvariable Apol_File_Contexts::opts(class) \
-helptext "Type or select an object class" \
-entrybg $ApolTop::default_bg_color -editable 0]
$user_combo_box configure -state disabled
$type_combo_box configure -state disabled
$objclass_combo_box configure -state disabled
bindtags $user_combo_box.e [linsert [bindtags $user_combo_box.e] 3 fc_user_Tag]
bind fc_user_Tag <KeyPress> {ApolTop::_create_popup $Apol_File_Contexts::user_combo_box %W %K}
bindtags $objclass_combo_box.e [linsert [bindtags $objclass_combo_box.e] 3 fc_role_Tag]
bind fc_role_Tag <KeyPress> {ApolTop::_create_popup $Apol_File_Contexts::objclass_combo_box %W %K}
bindtags $type_combo_box.e [linsert [bindtags $type_combo_box.e] 3 fc_type_Tag]
bind fc_type_Tag <KeyPress> {ApolTop::_create_popup $Apol_File_Contexts::type_combo_box %W %K}
set cb_user [checkbutton [$l_innerFrame getframe].cb_user \
-variable Apol_File_Contexts::user_cb_value -text "Search Using User" \
-onvalue 1 -offvalue 0 \
-command {ApolTop::change_comboBox_state $Apol_File_Contexts::user_cb_value $Apol_File_Contexts::user_combo_box}]
set cb_type [checkbutton [$c_innerFrame getframe].cb_type \
-variable Apol_File_Contexts::type_cb_value -text "Search Using Type" \
-onvalue 1 -offvalue 0 \
-command {ApolTop::change_comboBox_state $Apol_File_Contexts::type_cb_value $Apol_File_Contexts::type_combo_box}]
set cb_objclass [checkbutton [$r_innerFrame getframe].cb_objclass \
-variable Apol_File_Contexts::class_cb_value -text "Search Using Object Class" \
-onvalue 1 -offvalue 0 \
-command {ApolTop::change_comboBox_state $Apol_File_Contexts::class_cb_value $Apol_File_Contexts::objclass_combo_box}]
set cb_path [checkbutton [$path_innerFrame getframe].cb_path \
-variable Apol_File_Contexts::path_cb_value -text "Search Using File Path" \
-onvalue 1 -offvalue 0 \
-command {Apol_File_Contexts::configure_file_path_entry_widget $Apol_File_Contexts::path_cb_value}]
set cb_regEx_user [checkbutton [$l_innerFrame getframe].cb_regEx_user \
-variable Apol_File_Contexts::opts(regEx_user) \
-text "Enable regular expressions"]
set cb_regEx_type [checkbutton [$c_innerFrame getframe].cb_regEx_type \
-variable Apol_File_Contexts::opts(regEx_type) \
-text "Enable regular expressions" \
-onvalue 1 -offvalue 0]
set cb_regEx_path [checkbutton [$path_innerFrame getframe].cb_regEx_path \
-variable Apol_File_Contexts::opts(regEx_path) \
-text "Enable regular expressions" \
-onvalue 1 -offvalue 0]
set cb_show_ctxt [checkbutton [$s_optionsbox getframe].cb_show_ctxt \
-variable Apol_File_Contexts::show_ctxt \
-text "Show context" \
-onvalue 1 -offvalue 0]
set cb_show_class [checkbutton [$s_optionsbox getframe].cb_show_class \
-variable Apol_File_Contexts::show_class \
-text "Show object class" \
-onvalue 1 -offvalue 0]
set status_frame [TitleFrame $options_pane.status_frame -text "File Context Index"]
set stat_frame [frame [$status_frame getframe].stat_frame]
set db_buttons_f [frame [$status_frame getframe].db_buttons_f]
set entry_path [entry [$path_innerFrame getframe].entry_path -width 40 -bg white -state disabled]
set lbl_stat_title [Label $stat_frame.lbl_stat_title -text "Loaded Index:"]
set lbl_status [Label $stat_frame.lbl_status -textvariable Apol_File_Contexts::index_status]
Apol_File_Contexts::change_status_label ""
set ok_button [button [$buttons_f getframe].ok -text OK -width 6 -command {Apol_File_Contexts::search_fc_database}]
set create_button [button $db_buttons_f.create -text "Create and Load" -width 15 \
-state normal \
-command {Apol_File_Contexts::display_create_db_dlg}]
set load_button [button $db_buttons_f.load -text "Load" -width 8 \
-state normal \
-command {Apol_File_Contexts::load_fc_db}]
set help_button [button [$buttons_f getframe].help -text "Info" -width 6 \
-command {Apol_File_Contexts::display_analysis_info}]
set sw_d [ScrolledWindow [$rslts_frame getframe].sw -auto none]
set resultsbox [text [$sw_d getframe].text -bg white -wrap none -state disabled]
$sw_d setwidget $resultsbox
pack $topf -fill both -expand yes
pack $status_frame -side top -anchor nw -fill x -pady 3
pack $pw -fill both -expand yes
pack $pw2 -fill both -expand yes
pack $s_optionsbox -padx 2 -fill both -expand yes
pack $s_criteriabox -padx 2 -fill both -expand yes
pack $rslts_frame -pady 2 -padx 2 -fill both -anchor n -side bottom -expand yes
pack $db_buttons_f $stat_frame -side left -anchor nw -padx 4 -pady 4
pack $ok_button $help_button -side top -anchor e -pady 2 -padx 5
pack $buttons_f -side right -expand yes -fill both -anchor nw -padx 4 -pady 4
pack $l_innerFrame $r_innerFrame -side left -fill both -anchor nw -padx 4 -pady 4
pack $c_innerFrame $path_innerFrame -side left -fill both -expand yes -anchor nw -padx 4 -pady 4
pack $cb_show_ctxt $cb_show_class -side top -anchor nw -padx 4 -pady 4
pack $create_button $load_button -side left -padx 2 -pady 2 -anchor nw
pack $lbl_stat_title $lbl_status -side left -anchor nw -padx 2 -pady 4
pack $cb_user $cb_type $cb_objclass $cb_path -side top -anchor nw
pack $entry_path -side top -anchor nw -padx 10 -pady 4
pack $user_combo_box $type_combo_box $objclass_combo_box -side top -fill x -anchor nw -padx 4
pack $cb_regEx_user $cb_regEx_type $cb_regEx_path -side top -anchor nw -padx 4 -pady 4
pack $sw_d -side left -expand yes -fill both
return $frame
}
namespace eval Apol_Cond_Bools {
variable search_opts
set search_opts(boolean) ""
set search_opts(default_state) 1
set search_opts(curr_state) 1
variable cond_bools_list ""
variable cond_bools_value_array
variable cond_bools_dflt_value_array
variable enable_bool_combo_box 0
variable use_regEx 0
variable resultsbox
variable cond_bools_listbox
variable bool_combo_box
variable cb_RegExp
}
proc Apol_Cond_Bools::cond_bool_search_bools {} {
variable search_opts
variable cond_bools_value_array
variable cond_bools_dflt_value_array
variable cond_bools_list
variable resultsbox
variable use_regEx
if {[ApolTop::is_policy_open]} {
set results ""
set search_opts(boolean) [string trim $search_opts(boolean)]
if {$Apol_Cond_Bools::enable_bool_combo_box && $search_opts(boolean) == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "No boolean variable provided!"
return -1
}
if {$Apol_Cond_Bools::enable_bool_combo_box && !$use_regEx} {
if {![Apol_Cond_Bools::cond_bool_is_valid_boolean $search_opts(boolean)]} {
tk_messageBox -icon error -type ok -title "Error" -message "Invalid boolean variable!"
return -1
}
set results [append results "$search_opts(boolean)"]
if {$search_opts(default_state)} {
if {$cond_bools_dflt_value_array($search_opts(boolean))} {
set results [append results " Default State: True"]
} else {
set results [append results " Default State: False"]
}
}
if {$search_opts(curr_state)} {
if {$cond_bools_value_array($search_opts(boolean))} {
set results [append results " Current State: True"]
} else {
set results [append results " Current State: False"]
}
}
set results [append results "\n"]
} else {
foreach bool $cond_bools_list {
if {$use_regEx} {
set rt [catch {set match [regexp $search_opts(boolean) $bool]} err]
if {$rt != 0} {
tk_messageBox \
-icon error \
-type ok \
-title "Error" \
-message $err
return -1
}
if {$match} {
set results [append results "$bool"]
} else {
continue
}
} else {
set results [append results "$bool"]
}
if {$search_opts(default_state)} {
if {$cond_bools_dflt_value_array($bool)} {
set results [append results " Default State: True"]
} else {
set results [append results " Default State: False"]
}
}
if {$search_opts(curr_state)} {
if {$cond_bools_value_array($bool)} {
set results [append results " Current State: True"]
} else {
set results [append results " Current State: False"]
}
}
set results [append results "\n"]
}
}
$resultsbox configure -state normal
$resultsbox delete 0.0 end
$resultsbox insert end $results
ApolTop::makeTextBoxReadOnly $resultsbox
} else {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened!"
return -1
}
return 0
}
proc Apol_Cond_Bools::enable_RegExpr { } {
variable bool_combo_box
if {$Apol_Cond_Bools::use_regEx} {
set Apol_Cond_Bools::search_opts(boolean) "^$Apol_Cond_Bools::search_opts(boolean)$"
selection clear -displayof $bool_combo_box
}
focus -force .
return 0
}
proc Apol_Cond_Bools::cond_bool_is_valid_boolean {boolean} {
variable cond_bools_value_array
set items [array names cond_bools_value_array]
if {$items != ""} {
foreach item $items {
if {[string equal $boolean $item]} {
return 1
}
}
}
return 0
}
proc Apol_Cond_Bools::cond_bool_reset_variables { } {
variable search_opts
variable cond_bools_list
variable enable_bool_combo_box
variable cond_bools_value_array
variable cond_bools_dflt_value_array
set search_opts(boolean) ""
set search_opts(show_rules) ""
set search_opts(default_state) 1
set search_opts(curr_state) 1
set cond_bools_list ""
set enable_bool_combo_box 0
array unset cond_bools_value_array
array unset cond_bools_dflt_value_array
return 0
}
proc Apol_Cond_Bools::cond_bool_set_bool_values_to_policy_defaults {} {
variable cond_bools_dflt_value_array
variable cond_bools_value_array
array set cond_bools_value_array [array get cond_bools_dflt_value_array]
return 0
}
proc Apol_Cond_Bools::cond_bool_set_bool_value {bool_name} {
set rt [catch {apol_Cond_Bool_SetBoolValue \
$bool_name \
$Apol_Cond_Bools::cond_bools_value_array($bool_name)} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
return 0
}
proc Apol_Cond_Bools::cond_bool_embed_buttons {widget bool_name} {
set rb_frame [frame $widget.rb_frame:$bool_name -bd 0 -bg white]
set rb_true [radiobutton $rb_frame.rb_true:$bool_name -bg white \
-variable Apol_Cond_Bools::cond_bools_value_array($bool_name) \
-command "Apol_Cond_Bools::cond_bool_set_bool_value $bool_name" \
-value 1 -highlightthickness 0 -text "True"]
set rb_false [radiobutton $rb_frame.rb_false:$bool_name -bg white \
-variable Apol_Cond_Bools::cond_bools_value_array($bool_name) \
-command "Apol_Cond_Bools::cond_bool_set_bool_value $bool_name" \
-value 0 -highlightthickness 0 -text "False"]
pack $rb_frame -side left -anchor nw
pack $rb_true $rb_false -side left -anchor nw -padx 2
return $rb_frame
}
proc Apol_Cond_Bools::cond_bool_init_state { } {
Apol_Cond_Bools::cond_bool_change_comboBox_state \
$Apol_Cond_Bools::enable_bool_combo_box
return 0
}
proc Apol_Cond_Bools::cond_bool_remove_listbox_items { } {
variable cond_bools_listbox
foreach item [$cond_bools_listbox items] {
set window [$cond_bools_listbox itemcget $item -window]
if { [winfo exists $window] } {
destroy $window
}
}
$cond_bools_listbox delete [$cond_bools_listbox items]
return 0
}
proc Apol_Cond_Bools::cond_bool_insert_listbox_items { } {
variable cond_bools_listbox
variable cond_bools_list
foreach bool_name $cond_bools_list {
$cond_bools_listbox insert end $bool_name -text " - $bool_name" \
-window [Apol_Cond_Bools::cond_bool_embed_buttons \
$Apol_Cond_Bools::cond_bools_listbox $bool_name]
}
$cond_bools_listbox configure -redraw 1
$cond_bools_listbox.c xview moveto 0
update idletasks
$cond_bools_listbox configure -padx [winfo reqwidth [$cond_bools_listbox itemcget [$cond_bools_listbox items 0] -window]]
return 0
}
proc Apol_Cond_Bools::cond_bool_initialize_vars { } {
variable cond_bools_list
variable cond_bools_value_array
variable cond_bools_dflt_value_array
set rt [catch {set cond_bools_list [apol_GetNames cond_bools]} err]
if {$rt != 0} {
return -code error $err
}
set cond_bools_list [lsort $cond_bools_list]
foreach bool_name $cond_bools_list {
set rt [catch {set cond_bools_value_array($bool_name) [apol_Cond_Bool_GetBoolValue $bool_name]} err]
if {$rt != 0} {
return -code error $err
}
set cond_bools_dflt_value_array($bool_name) $cond_bools_value_array($bool_name)
}
return 0
}
proc Apol_Cond_Bools::cond_bool_change_comboBox_state {enable} {
variable cb_RegExp
ApolTop::change_comboBox_state \
$Apol_Cond_Bools::enable_bool_combo_box \
$Apol_Cond_Bools::bool_combo_box
if {$enable} {
$cb_RegExp configure -state normal
} else {
$cb_RegExp configure -state disabled
$cb_RegExp deselect
}
return 0
}
proc Apol_Cond_Bools::search { str case_Insensitive regExpr srch_Direction } {
variable resultsbox
ApolTop::textSearch $resultsbox $str $case_Insensitive $regExpr $srch_Direction
return 0
}
proc Apol_Cond_Bools::goto_line { line_num } {
variable resultsbox
ApolTop::goto_line $line_num $resultsbox
return 0
}
proc Apol_Cond_Bools::set_Focus_to_Text {} {
focus $Apol_Cond_Bools::resultsbox
return 0
}
proc Apol_Cond_Bools::open { } {
set rt [catch {Apol_Cond_Bools::cond_bool_initialize_vars} err]
if {$rt != 0} {
return -code error $err
}
$Apol_Cond_Bools::bool_combo_box configure -values $Apol_Cond_Bools::cond_bools_list
if {$Apol_Cond_Bools::cond_bools_list != ""} {
Apol_Cond_Bools::cond_bool_insert_listbox_items
}
return 0
}
proc Apol_Cond_Bools::close { } {
Apol_Cond_Bools::cond_bool_reset_variables
Apol_Cond_Bools::cond_bool_remove_listbox_items
Apol_Cond_Bools::cond_bool_change_comboBox_state \
$Apol_Cond_Bools::enable_bool_combo_box
$Apol_Cond_Bools::resultsbox configure -state normal
$Apol_Cond_Bools::resultsbox delete 0.0 end
ApolTop::makeTextBoxReadOnly $Apol_Cond_Bools::resultsbox
return 0
}
proc Apol_Cond_Bools::free_call_back_procs { } {
return 0
}
proc Apol_Cond_Bools::create {nb} {
variable bool_combo_box
variable cond_bools_listbox
variable resultsbox
variable cb_RegExp
set frame [$nb insert end $ApolTop::cond_bools_tab -text "Booleans"]
set topf [frame $frame.topf]
set pw1 [PanedWindow $topf.pw -side top]
set pane [$pw1 add ]
set spane [$pw1 add -weight 5]
set pw2 [PanedWindow $pane.pw -side left]
set rpane [$pw2 add -weight 3]
set cond_bools_box [TitleFrame $rpane.cond_bools_box -text "Booleans"]
set s_optionsbox [TitleFrame $spane.obox -text "Search Options"]
set rslts_frame [TitleFrame $spane.rbox -text "Search Results"]
pack $topf -fill both -expand yes
pack $pw1 -fill both -expand yes
pack $pw2 -fill both -expand yes
pack $s_optionsbox -padx 2 -fill both
pack $cond_bools_box -padx 2 -side left -fill both -expand yes
pack $rslts_frame -pady 2 -padx 2 -fill both -anchor n -side bottom -expand yes
set sw_r [ScrolledWindow [$cond_bools_box getframe].sw -auto both]
set cond_bools_listbox [ListBox [$cond_bools_box getframe].cond_bools_listbox \
-relief sunken -borderwidth 2 -bg white \
-selectmode none -deltay 25 \
-width 25 -highlightthickness 0 \
-redraw 0]
$sw_r setwidget $cond_bools_listbox
set button_defaults [button [$cond_bools_box getframe].button_defaults \
-text "Reset to policy defaults" \
-command {Apol_Cond_Bools::cond_bool_set_bool_values_to_policy_defaults}]
set ofm [$s_optionsbox getframe]
set l_innerFrame [LabelFrame $ofm.l_innerFrame]
set c_innerFrame [LabelFrame $ofm.c_innerFrame]
set buttons_f [LabelFrame $ofm.buttons_f]
set cb_bools_default_state [checkbutton $c_innerFrame.default_state \
-variable Apol_Cond_Bools::search_opts(default_state) \
-text "Show default state" \
-onvalue 1 -offvalue 0]
set cb_bools_curr_state [checkbutton $c_innerFrame.curr_state \
-variable Apol_Cond_Bools::search_opts(curr_state) \
-text "Show current state" \
-onvalue 1 -offvalue 0]
set bool_combo_box [ComboBox [$l_innerFrame getframe].bool_combo_box \
-textvariable Apol_Cond_Bools::search_opts(boolean) \
-helptext "Type or select a boolean variable" \
-entrybg $ApolTop::default_bg_color \
-modifycmd {Apol_Cond_Bools::enable_RegExpr}]
set cb_enable_bool_combo_box [checkbutton [$l_innerFrame getframe].cb_enable_bool_combo_box \
-variable Apol_Cond_Bools::enable_bool_combo_box \
-onvalue 1 -offvalue 0 -text "Search using boolean variable" \
-command {Apol_Cond_Bools::cond_bool_change_comboBox_state \
$Apol_Cond_Bools::enable_bool_combo_box}]
set cb_RegExp [checkbutton [$l_innerFrame getframe].cb_RegExp \
-text "Enable Regular Expressions" \
-variable Apol_Cond_Bools::use_regEx \
-onvalue 1 -offvalue 0]
bindtags $bool_combo_box.e [linsert [bindtags $bool_combo_box.e] 3 bool_vars_combo_box_Tag]
bind bool_vars_combo_box_Tag <KeyPress> { ApolTop::_create_popup $Apol_Cond_Bools::bool_combo_box %W %K }
set ok_button [button [$buttons_f getframe].ok -text "Search for Booleans" -width 15 -command {Apol_Cond_Bools::cond_bool_search_bools}]
set sw_d [ScrolledWindow [$rslts_frame getframe].sw -auto none]
set resultsbox [text [$sw_d getframe].text -bg white -wrap none -state disabled]
$sw_d setwidget $resultsbox
pack $button_defaults -side bottom -pady 2 -anchor center
pack $ok_button -side top -anchor e -pady 5 -padx 5
pack $buttons_f -side right -expand yes -fill both -anchor nw -padx 4 -pady 4
pack $l_innerFrame $c_innerFrame -side left -fill y -anchor nw -padx 4 -pady 4
pack $cb_enable_bool_combo_box $bool_combo_box -side top -anchor nw -fill x
pack $cb_RegExp -side top -anchor nw
pack $cb_bools_default_state $cb_bools_curr_state -side top -anchor nw
pack $sw_r -fill both -expand yes
pack $sw_d -side left -expand yes -fill both
Apol_Cond_Bools::cond_bool_init_state
return $frame
}
namespace eval Apol_Cond_Rules {
variable search_opts
set search_opts(boolean) ""
set search_opts(incl_teallow) 1
set search_opts(incl_teaudit) 0
set search_opts(incl_ttrans) 0
set search_opts(allow_regex) 0
variable enable_bool_combo_box 0
variable resultsbox
variable cond_bools_listbox
variable bool_combo_box
variable cb_regex
variable bool_combo_box
variable cb_enable_bool_combo_box
}
proc Apol_Cond_Rules::cond_rules_render_rules {resultsbox results num_rules list_idx_1} {
upvar 1 $list_idx_1 list_idx
for {set j 0} {$j < $num_rules} {incr j} {
incr list_idx
$resultsbox insert end " "
if {![ApolTop::is_binary_policy]} {
set lineno [lindex $results $list_idx]
$resultsbox insert end "\["
set start_idx [$resultsbox index insert]
$resultsbox insert end "$lineno"
set end_idx [$resultsbox index insert]
Apol_PolicyConf::insertHyperLink $resultsbox $start_idx $end_idx
$resultsbox insert end "\]"
}
incr list_idx
set rule [lindex $results $list_idx]
$resultsbox insert end " $rule "
incr list_idx
if {[lindex $results $list_idx]} {
$resultsbox insert end "\[enabled\]"
} else {
$resultsbox insert end "\[disabled\]"
}
$resultsbox insert end "\n"
}
}
proc Apol_Cond_Rules::cond_rules_search {} {
variable search_opts
variable cond_bools_list
variable resultsbox
variable enable_bool_combo_box
if {$enable_bool_combo_box && $search_opts(boolean) == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "No boolean variable provided!"
return -1
} elseif {$enable_bool_combo_box && $search_opts(boolean) != ""} {
set bool_name $search_opts(boolean)
} else {
set bool_name ""
}
set rt [catch {set results [apol_SearchConditionalRules \
$bool_name \
$search_opts(allow_regex) \
$search_opts(incl_teallow) \
$search_opts(incl_teaudit) \
$search_opts(incl_ttrans) \
$enable_bool_combo_box]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
} else {
$resultsbox configure -state normal
$resultsbox delete 0.0 end
$resultsbox insert end "Found the following expressions in Reverse Polish Notation:\n"
set rule_selected [expr ($search_opts(incl_teallow) || \
$search_opts(incl_teaudit) || \
$search_opts(incl_ttrans))]
set len [llength $results]
if {$len > 0} {
set counter 1
for {set list_idx 0} {$list_idx < $len} {incr list_idx} {
set cond_expr [lindex $results $list_idx]
$resultsbox insert end "\nconditional expression $counter: \[ $cond_expr \]\n\n"
if {$rule_selected} {
$resultsbox insert end "TRUE list:\n"
}
incr list_idx
set num_av_access [lindex $results $list_idx]
if {$search_opts(incl_teallow)} {
Apol_Cond_Rules::cond_rules_render_rules \
$resultsbox $results $num_av_access list_idx
}
incr list_idx
set num_av_audit [lindex $results $list_idx]
if {$search_opts(incl_teaudit)} {
Apol_Cond_Rules::cond_rules_render_rules \
$resultsbox $results $num_av_audit list_idx
}
incr list_idx
set num_ttrans [lindex $results $list_idx]
if {$search_opts(incl_ttrans)} {
Apol_Cond_Rules::cond_rules_render_rules \
$resultsbox $results $num_ttrans list_idx
}
if {$rule_selected} {
$resultsbox insert end "\n\nFALSE list:\n"
}
incr list_idx
set num_av_access [lindex $results $list_idx]
if {$search_opts(incl_teallow)} {
Apol_Cond_Rules::cond_rules_render_rules \
$resultsbox $results $num_av_access list_idx
}
incr list_idx
set num_av_audit [lindex $results $list_idx]
if {$search_opts(incl_teaudit)} {
Apol_Cond_Rules::cond_rules_render_rules \
$resultsbox $results $num_av_audit list_idx
}
incr list_idx
set num_ttrans [lindex $results $list_idx]
if {$search_opts(incl_ttrans)} {
Apol_Cond_Rules::cond_rules_render_rules \
$resultsbox $results $num_ttrans list_idx
}
$resultsbox insert end "\n"
incr counter
}
Apol_PolicyConf::configure_HyperLinks $resultsbox
} else {
$resultsbox insert end "\nNo conditional expressions found."
}
ApolTop::makeTextBoxReadOnly $resultsbox
}
return 0
}
proc Apol_Cond_Rules::cond_rules_reset_variables { } {
variable search_opts
variable enable_bool_combo_box
set search_opts(boolean) ""
set search_opts(incl_teallow) 1
set search_opts(incl_teaudit) 0
set search_opts(incl_ttrans) 0
set search_opts(allow_regex) 0
set enable_bool_combo_box 0
return 0
}
proc Apol_Cond_Rules::search { str case_Insensitive regExpr srch_Direction } {
variable resultsbox
ApolTop::textSearch $resultsbox $str $case_Insensitive $regExpr $srch_Direction
return 0
}
proc Apol_Cond_Rules::goto_line { line_num } {
variable resultsbox
ApolTop::goto_line $line_num $resultsbox
return 0
}
proc Apol_Cond_Rules::set_Focus_to_Text {} {
focus $Apol_Cond_Rules::resultsbox
return 0
}
proc Apol_Cond_Rules::open { } {
set cond_bools_list [apol_GetNames cond_bools]
set rt [catch {set cond_bools_list [apol_GetNames cond_bools]} err]
if {$rt != 0} {
return -code error $err
}
set cond_bools_list [lsort $cond_bools_list]
$Apol_Cond_Rules::bool_combo_box configure -values $cond_bools_list
return 0
}
proc Apol_Cond_Rules::close { } {
Apol_Cond_Rules::cond_rules_reset_variables
$Apol_Cond_Rules::bool_combo_box configure -values ""
Apol_Cond_Rules::cond_rules_enable_bool_combo_box
$Apol_Cond_Rules::resultsbox configure -state normal
$Apol_Cond_Rules::resultsbox delete 0.0 end
ApolTop::makeTextBoxReadOnly $Apol_Cond_Rules::resultsbox
return 0
}
proc Apol_Cond_Rules::free_call_back_procs { } {
return 0
}
proc Apol_Cond_Rules::cond_rules_enable_bool_combo_box {} {
variable cb_regex
ApolTop::change_comboBox_state $Apol_Cond_Rules::enable_bool_combo_box \
$Apol_Cond_Rules::bool_combo_box
if {$Apol_Cond_Rules::enable_bool_combo_box} {
$cb_regex configure -state normal
} else {
$cb_regex configure -state disabled
$cb_regex deselect
}
return 0
}
proc Apol_Cond_Rules::create {nb} {
variable bool_combo_box
variable resultsbox
variable cb_regex
variable cb_enable_bool_combo_box
set frame [$nb insert end $ApolTop::cond_rules_tab -text "Conditional Expressions"]
set pw1 [PanedWindow $frame.pw1 -side left -weights available]
$pw1 add -minsize 110
$pw1 add -weight 3
set topf [frame [$pw1 getframe 0].topf]
set bottomf [frame [$pw1 getframe 1].bottomf]
pack $pw1 -fill both -expand yes
pack $topf -fill both -expand yes
pack $bottomf -fill both -expand yes
set pw2 [PanedWindow $topf.pw2 -side top -weights available]
$pw2 add -minsize 225
$pw2 add -weight 3
set obox [TitleFrame [$pw2 getframe 1].obox -text "Search Options"]
set rules_box [TitleFrame [$pw2 getframe 0].rules_box -text "Rule Selection"]
set dbox [TitleFrame $bottomf.dbox -text "Conditional Expressions Display"]
pack $pw2 -fill both -expand yes
pack $obox -side right -anchor w -fill both -padx 5 -expand yes
pack $rules_box -side left -anchor w -fill both -padx 5 -expand yes
pack $dbox -side left -fill both -expand yes -anchor e -pady 5 -padx 5
set ofm [$obox getframe]
set rules_fm [frame [$rules_box getframe].tefm]
set l_innerFrame [LabelFrame $ofm.l_innerFrame]
set c_innerFrame [LabelFrame $ofm.c_innerFrame]
set buttons_f [LabelFrame $ofm.buttons_f]
set rule_lbl [label $rules_fm.rules_lbl -text "Select rules to display within expression(s):"]
set rules_inner_left_fm [frame $rules_fm.rules_inner_left_fm]
set teallow [checkbutton $rules_inner_left_fm.teallow \
-text "Allow" \
-variable Apol_Cond_Rules::search_opts(incl_teallow) \
-onvalue 1 -offvalue 0]
set auallow [checkbutton $rules_inner_left_fm.auallow \
-text "Auditallow and dontaudit" \
-variable Apol_Cond_Rules::search_opts(incl_teaudit) \
-onvalue 1 -offvalue 0]
set ttrans [checkbutton $rules_inner_left_fm.ttrans \
-text "Type transition and type change" \
-variable Apol_Cond_Rules::search_opts(incl_ttrans) \
-onvalue 1 -offvalue 0]
set bool_combo_box [ComboBox [$l_innerFrame getframe].bool_combo_box \
-textvariable Apol_Cond_Rules::search_opts(boolean) \
-helptext "Type or select a boolean variable" \
-entrybg $ApolTop::default_bg_color]
set cb_enable_bool_combo_box [checkbutton [$l_innerFrame getframe].cb_enable_bool_combo_box \
-variable Apol_Cond_Rules::enable_bool_combo_box \
-onvalue 1 -offvalue 0 -text "Search using boolean variable" \
-command {Apol_Cond_Rules::cond_rules_enable_bool_combo_box}]
set cb_regex [checkbutton [$c_innerFrame getframe].cb_regex \
-variable Apol_Cond_Rules::search_opts(allow_regex) \
-onvalue 1 -offvalue 0 -text "Use regular expression" \
-state disabled]
bindtags $bool_combo_box.e [linsert [bindtags $bool_combo_box.e] 3 bool_combo_box_Tag]
bind bool_combo_box_Tag <KeyPress> { ApolTop::_create_popup $Apol_Cond_Rules::bool_combo_box %W %K }
set ok_button [button [$buttons_f getframe].ok -text OK -width 6 -command {Apol_Cond_Rules::cond_rules_search}]
set sw_d [ScrolledWindow [$dbox getframe].sw -auto none]
set resultsbox [text [$sw_d getframe].text -bg white -wrap none -state disabled]
$sw_d setwidget $resultsbox
pack $ok_button -side top -anchor e -pady 5 -padx 5
pack $buttons_f -side right -expand yes -fill both -anchor nw -padx 4 -pady 4
pack $l_innerFrame $c_innerFrame -side left -fill y -anchor nw -padx 4 -pady 4
pack $cb_enable_bool_combo_box $bool_combo_box -side top -anchor nw -fill x
pack $cb_regex -side top -anchor nw
pack $sw_d -side left -expand yes -fill both
pack $rules_fm -side left -anchor nw
pack $rule_lbl -side top -anchor nw -fill both -expand yes -pady 2
pack $rules_inner_left_fm -side left -anchor nw -fill both -expand yes -padx 4
pack $teallow $auallow $ttrans -anchor nw -side top
return $frame
}
namespace eval Apol_Class_Perms {
variable opts
set opts(show_classes1) 1
set opts(show_comm_perms1) 0
set opts(show_perms1) 0
set opts(show_classes2) 0
set opts(show_comm_perms2) 0
set opts(show_perms2) 0
set opts(show_classes3) 0
set opts(show_comm_perms3) 0
set opts(show_perms3) 0
set opts(usesrchstr) 0
variable class_list ""
variable common_perms_list ""
variable perms_list ""
variable srchstr ""
variable class_listbox
variable common_listbox
variable perms_listbox
variable show_classes1
variable show_classes2
variable show_classes3
variable show_comm_perms1
variable show_comm_perms2
variable show_comm_perms3
variable show_perms1
variable show_perms2
variable show_perms3
variable resultsbox
variable sString
variable sEntry
variable objs_menu_callbacks ""
variable common_perms_menu_callbacks ""
variable perms_menu_callbacks ""
}
proc Apol_Class_Perms::open { } {
variable class_list
variable common_perms_list
variable perms_list
if {$ApolTop::contents(classes) == 1} {
set rt [catch {set class_list [apol_GetNames classes]} err]
if {$rt != 0} {
return -code error $err
}
set class_list [lsort $class_list]
}
if {$ApolTop::contents(perms) == 1} {
set rt [catch {set common_perms_list [apol_GetNames common_perms]} err]
if {$rt != 0} {
return -code error $err
}
set common_perms_list [lsort $common_perms_list]
set rt [catch {set perms_list [apol_GetNames perms]} err]
if {$rt != 0} {
return -code error $err
}
set perms_list [lsort $perms_list]
}
return 0
}
proc Apol_Class_Perms::close { } {
variable class_list ""
variable common_perms_list ""
variable perms_list ""
variable srchstr ""
Apol_Class_Perms::init_options
set class_list ""
set common_perms_list ""
set perms_list ""
set srchstr ""
$Apol_Class_Perms::resultsbox configure -state normal
$Apol_Class_Perms::resultsbox delete 0.0 end
ApolTop::makeTextBoxReadOnly $Apol_Class_Perms::resultsbox
return 0
}
proc Apol_Class_Perms::free_call_back_procs { } {
variable objs_menu_callbacks
variable common_perms_menu_callbacks
variable perms_menu_callbacks
set objs_menu_callbacks ""
set common_perms_menu_callbacks ""
set perms_menu_callbacks ""
return 0
}
proc Apol_Class_Perms::set_Focus_to_Text {} {
focus $Apol_Class_Perms::resultsbox
return 0
}
proc Apol_Class_Perms::enable_disable_widgets { } {
variable opts
variable show_classes1
variable show_classes2
variable show_classes3
variable show_comm_perms1
variable show_comm_perms2
variable show_comm_perms3
variable show_perms1
variable show_perms2
variable show_perms3
variable sString
variable sEntry
$sString configure -state normal
if { $opts(show_classes1) } {
$show_perms1 configure -state normal
if { $opts(show_perms1) } {
$show_comm_perms1 configure -state normal
} else {
$show_comm_perms1 configure -state disabled
$show_comm_perms1 deselect
}
} else {
$show_perms1 configure -state disabled
$show_comm_perms1 configure -state disabled
$show_perms1 deselect
$show_comm_perms1 deselect
}
if { $opts(show_comm_perms2) } {
$show_perms2 configure -state normal
$show_classes2 configure -state normal
} else {
$show_perms2 configure -state disabled
$show_classes2 configure -state disabled
$show_perms2 deselect
$show_classes2 deselect
}
if { $opts(show_perms3) } {
$show_classes3 configure -state normal
$show_comm_perms3 configure -state normal
} else {
$show_classes3 configure -state disabled
$show_comm_perms3 configure -state disabled
$show_classes3 deselect
$show_comm_perms3 deselect
}
if { !$opts(show_classes1) && !$opts(show_comm_perms2) && !$opts(show_perms3) } {
$sString deselect
$sString configure -state disabled
}
Apol_Class_Perms::useSearch $sEntry
update
return 0
}
proc Apol_Class_Perms::goto_line { line_num } {
variable resultsbox
ApolTop::goto_line $line_num $resultsbox
return 0
}
proc Apol_Class_Perms::init_options { } {
variable show_classes1
variable show_classes2
variable show_classes3
variable show_comm_perms1
variable show_comm_perms2
variable show_comm_perms3
variable show_perms1
variable show_perms2
variable show_perms3
variable sString
variable sEntry
variable opts
set opts(show_classes1) 1
set opts(show_comm_perms1) 0
set opts(show_perms1) 0
set opts(show_classes2) 0
set opts(show_comm_perms2) 0
set opts(show_perms2) 0
set opts(show_classes3) 0
set opts(show_comm_perms3) 0
set opts(show_perms3) 0
set opts(usesrchstr) 0
Apol_Class_Perms::enable_disable_widgets
return 0
}
proc Apol_Class_Perms::popupInfo {which name} {
set rt [catch {set info [apol_GetSingleClassPermInfo $name $which]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
set w .class_perms_infobox
set rt [catch {destroy $w} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
toplevel $w
wm title $w "$name"
wm withdraw $w
set sf [ScrolledWindow $w.sf -scrollbar both -auto both]
set f [text [$sf getframe].f -font {helvetica 10} -wrap none -width 35 -height 10]
$sf setwidget $f
set b1 [button $w.close -text Close -command "catch {destroy $w}" -width 10]
pack $b1 -side bottom -anchor s -padx 5 -pady 5
pack $sf -fill both -expand yes
$f insert 0.0 $info
wm geometry $w +50+50
wm deiconify $w
$f configure -state disabled
wm protocol $w WM_DELETE_WINDOW "destroy $w"
return 0
}
proc Apol_Class_Perms::search { str case_Insensitive regExpr srch_Direction } {
variable resultsbox
ApolTop::textSearch $resultsbox $str $case_Insensitive $regExpr $srch_Direction
return 0
}
proc Apol_Class_Perms::search_Class_Perms {} {
variable opts
variable srchstr
if {$opts(usesrchstr) && $srchstr == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "No regular expression provided!"
return
}
if { !$opts(show_classes1) && !$opts(show_comm_perms2) && !$opts(show_perms3) } {
tk_messageBox -icon error -type ok -title "Error" -message "No search criteria provided!"
return
}
set rt [catch {set results [apol_GetClassPermInfo $opts(show_classes1) $opts(show_perms1) \
$opts(show_comm_perms1) $opts(show_comm_perms2) $opts(show_perms2) $opts(show_classes2) \
$opts(show_perms3) $opts(show_classes3) $opts(show_comm_perms3) $opts(usesrchstr) \
$srchstr]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
} else {
$Apol_Class_Perms::resultsbox configure -state normal
$Apol_Class_Perms::resultsbox delete 0.0 end
$Apol_Class_Perms::resultsbox insert end $results
ApolTop::makeTextBoxReadOnly $Apol_Class_Perms::resultsbox
}
return 0
}
proc Apol_Class_Perms::useSearch { entry } {
if { $Apol_Class_Perms::opts(usesrchstr) } {
$entry config -state normal -background white
} else {
$entry config -state disabled -background $ApolTop::default_bg_color
}
return 0
}
proc Apol_Class_Perms::create {nb} {
variable class_listbox
variable common_listbox
variable perms_listbox
variable show_classes1
variable show_classes2
variable show_classes3
variable show_comm_perms1
variable show_comm_perms2
variable show_comm_perms3
variable show_perms1
variable show_perms2
variable show_perms3
variable sString
variable sEntry
variable resultsbox
variable opts
variable objs_menu_callbacks
variable common_perms_menu_callbacks
variable perms_menu_callbacks
set frame [$nb insert end $ApolTop::class_perms_tab -text "Classes/Perms"]
set topf [frame $frame.topf]
set pw1 [PanedWindow $topf.pw -side top]
set pane [$pw1 add ]
set search_pane [$pw1 add -weight 5]
set pw2 [PanedWindow $pane.pw -side left]
set class_pane [$pw2 add -weight 2]
set common_pane [$pw2 add ]
set perms_pane [$pw2 add -weight 3]
global tcl_platform
set classes_box [TitleFrame $class_pane.tbox -text "Object Classes"]
set common_box [TitleFrame $common_pane.abox -text "Common Permissions"]
set perms_box [TitleFrame $perms_pane.abox -text "Permissions"]
set options_box [TitleFrame $search_pane.obox -text "Search Options"]
set results_box [TitleFrame $search_pane.rbox -text "Search Results"]
pack $options_box -pady 2 -padx 2 -fill x -anchor n
pack $classes_box -padx 2 -side left -fill both -expand yes
pack $common_box -padx 2 -side left -fill both -expand yes
pack $perms_box -padx 2 -side left -fill both -expand yes
pack $results_box -pady 2 -padx 2 -fill both -expand yes
pack $pw1 -fill both -expand yes
pack $pw2 -fill both -expand yes
pack $topf -fill both -expand yes
set sw_class [ScrolledWindow [$classes_box getframe].sw -auto both]
set class_listbox [listbox [$sw_class getframe].lb -height 10 -width 20 -highlightthickness 0 \
-listvar Apol_Class_Perms::class_list -bg white]
$sw_class setwidget $class_listbox
set sw_common [ScrolledWindow [$common_box getframe].sw -auto both]
set common_listbox [listbox [$sw_common getframe].lb -height 5 -width 20 -highlightthickness 0 \
-listvar Apol_Class_Perms::common_perms_list -bg white]
$sw_common setwidget $common_listbox
set sw_perms [ScrolledWindow [$perms_box getframe].sw -auto both]
set perms_listbox [listbox [$sw_perms getframe].lb -height 10 -width 20 -highlightthickness 0 \
-listvar Apol_Class_Perms::perms_list -bg white]
$sw_perms setwidget $perms_listbox
menu .popupMenu_classes
set objs_menu_callbacks [lappend objs_menu_callbacks {"Display Object Class Info" "Apol_Class_Perms::popupInfo class"}]
menu .popupMenu_common_perms
set common_perms_menu_callbacks [lappend common_perms_menu_callbacks {"Display Common Permission Info" "Apol_Class_Perms::popupInfo common_perm"}]
menu .popupMenu_perms
set perms_menu_callbacks [lappend perms_menu_callbacks {"Display Permission Info" "Apol_Class_Perms::popupInfo perm"}]
bindtags $class_listbox [linsert [bindtags $class_listbox] 3 classlist_Tag]
bindtags $common_listbox [linsert [bindtags $common_listbox] 3 comlist_Tag]
bindtags $perms_listbox [linsert [bindtags $perms_listbox] 3 permlist_Tag]
bind classlist_Tag <Double-Button-1> { Apol_Class_Perms::popupInfo "class" [$Apol_Class_Perms::class_listbox get active]}
bind comlist_Tag <Double-Button-1> { Apol_Class_Perms::popupInfo "common_perm" [$Apol_Class_Perms::common_listbox get active]}
bind permlist_Tag <Double-Button-1> { Apol_Class_Perms::popupInfo "perm" [$Apol_Class_Perms::perms_listbox get active]}
bind classlist_Tag <Button-3> { ApolTop::popup_listbox_Menu \
%W %x %y .popupMenu_classes $Apol_Class_Perms::objs_menu_callbacks \
$Apol_Class_Perms::class_listbox}
bind comlist_Tag <Button-3> { ApolTop::popup_listbox_Menu \
%W %x %y .popupMenu_common_perms $Apol_Class_Perms::common_perms_menu_callbacks \
$Apol_Class_Perms::common_listbox}
bind permlist_Tag <Button-3> { ApolTop::popup_listbox_Menu \
%W %x %y .popupMenu_perms $Apol_Class_Perms::perms_menu_callbacks \
$Apol_Class_Perms::perms_listbox}
bind classlist_Tag <<ListboxSelect>> { focus -force $Apol_Class_Perms::class_listbox}
bind comlist_Tag <<ListboxSelect>> { focus -force $Apol_Class_Perms::common_listbox}
bind permlist_Tag <<ListboxSelect>> { focus -force $Apol_Class_Perms::perms_listbox}
pack $sw_class -fill both -expand yes
pack $sw_common -fill both -expand yes
pack $sw_perms -fill both -expand yes
set opts_fm [$options_box getframe]
set fm_classes_select [frame $opts_fm.class -relief sunken -borderwidth 1]
set fm_comm_perms_select [frame $opts_fm.common -relief sunken -borderwidth 1]
set fm_perms_select [frame $opts_fm.perms -relief sunken -borderwidth 1]
set fm_sString [frame $opts_fm.so -relief flat -borderwidth 1]
set okbox [frame $opts_fm.okbox]
pack $okbox -side right -anchor n -fill both -expand yes -padx 5
pack $fm_classes_select -side left -anchor n -padx 5 -pady 2 -fill y
pack $fm_comm_perms_select -side left -anchor n -fill y -pady 2
pack $fm_perms_select -side left -anchor n -fill y -padx 5 -pady 2
pack $fm_sString -side left -anchor n -fill both -expand yes -padx 5
set show_classes1 [checkbutton $fm_classes_select.show_classes1 -text "Object Classes" \
-variable Apol_Class_Perms::opts(show_classes1) \
-command { Apol_Class_Perms::enable_disable_widgets }]
set show_perms1 [checkbutton $fm_classes_select.show_perms1 -text "Include Perms" \
-variable Apol_Class_Perms::opts(show_perms1) -padx 10 \
-command { Apol_Class_Perms::enable_disable_widgets }]
set show_comm_perms1 [checkbutton $fm_classes_select.show_comm_perms1 -text "Expand Common Perms" \
-variable Apol_Class_Perms::opts(show_comm_perms1) -padx 10]
set show_comm_perms2 [checkbutton $fm_comm_perms_select.show_comm_perms2 -text "Common Permissions" \
-variable Apol_Class_Perms::opts(show_comm_perms2) \
-command { Apol_Class_Perms::enable_disable_widgets }]
set show_perms2 [checkbutton $fm_comm_perms_select.show_perms2 -text "Include Perms" \
-variable Apol_Class_Perms::opts(show_perms2) -padx 10]
set show_classes2 [checkbutton $fm_comm_perms_select.show_classes2 -text "Object Classes" \
-variable Apol_Class_Perms::opts(show_classes2) -padx 10]
set show_perms3 [checkbutton $fm_perms_select.show_perms3 -text "Permissions" \
-variable Apol_Class_Perms::opts(show_perms3) \
-command { Apol_Class_Perms::enable_disable_widgets }]
set show_classes3 [checkbutton $fm_perms_select.show_classes3 -text "Object Classes" \
-variable Apol_Class_Perms::opts(show_classes3) -padx 10]
set show_comm_perms3 [checkbutton $fm_perms_select.show_comm_perms3 -text "Common Perms" \
-variable Apol_Class_Perms::opts(show_comm_perms3) -padx 10]
set sEntry [Entry $fm_sString.entry -textvariable Apol_Class_Perms::srchstr -width 40 \
-helptext "Enter a regular expression"]
set sString [checkbutton $fm_sString.cb -variable Apol_Class_Perms::opts(usesrchstr) \
-text "Search using regular expression" \
-command "Apol_Class_Perms::useSearch $sEntry"]
button $okbox.ok -text OK -width 6 -command { Apol_Class_Perms::search_Class_Perms }
set sw [ScrolledWindow [$results_box getframe].sw -auto none]
set resultsbox [text [$sw getframe].text -bg white -wrap none -state disabled]
$sw setwidget $resultsbox
pack $show_classes1 $show_perms1 $show_comm_perms1 -anchor w
pack $show_comm_perms2 $show_perms2 $show_classes2 -anchor w
pack $show_perms3 $show_classes3 $show_comm_perms3 -anchor w
pack $sString -side top -anchor w -expand yes
pack $sEntry -fill x -anchor center -expand yes
pack $okbox.ok -side top -padx 5 -pady 5 -anchor se
pack $sw -side left -expand yes -fill both
Apol_Class_Perms::init_options
return $frame
}
namespace eval Apol_PolicyConf {
variable textbox_policyConf
variable policy_conf_wrap_proc "Apol_PolicyConf::wrap_proc_policy_conf"
variable orig_cursor ""
variable mod_disabled 1
variable lineno_tag LINENO
variable selected_tag SELECTED
}
proc Apol_PolicyConf::wrap_proc_policy_conf { cmd args } {
switch $cmd {
insert -
delete {
if { $Apol_PolicyConf::mod_disabled == 1 } {
return 0
}
}
mark {
if { [string compare -length 10 $args "set insert"] == 0 } {
uplevel "::${Apol_PolicyConf::textbox_policyConf}_" $cmd $args
set lpos [$Apol_PolicyConf::textbox_policyConf index insert]
Apol_PolicyConf::update_positionStatus $lpos
return
}
}
}
# don't use a return after this!
uplevel "::${Apol_PolicyConf::textbox_policyConf}_" $cmd $args
}
proc Apol_PolicyConf::set_Focus_to_Text {} {
focus $Apol_PolicyConf::textbox_policyConf
set ApolTop::policyConf_lineno "Line [$Apol_PolicyConf::textbox_policyConf index insert]"
return 0
}
proc Apol_PolicyConf::update_positionStatus { pos } {
if { [catch {scan $pos" %d.%d" line col} err ] } {
puts stderr "update_positionStatus: Problem scanning position ($pos): $err"
return -1
}
set ApolTop::policyConf_lineno "Line $line"
return 0
}
proc Apol_PolicyConf::create {nb} {
variable textbox_policyConf
set frame [$nb insert end $ApolTop::policy_conf_tab -text "policy.conf"]
set sw [ScrolledWindow $frame.sw -auto none]
set textbox_policyConf [text [$sw getframe].text -bg white -wrap none]
$sw setwidget $textbox_policyConf
rename $textbox_policyConf "::${textbox_policyConf}_"
rename $Apol_PolicyConf::policy_conf_wrap_proc "::$textbox_policyConf"
pack $sw -side left -expand yes -fill both
return 0
}
proc Apol_PolicyConf::open { file } {
Apol_PolicyConf::display_policy_conf $file
return 0
}
proc Apol_PolicyConf::close { } {
variable textbox_policyConf
variable mod_disabled
set mod_disabled 0
$textbox_policyConf delete 0.0 end
set mod_disabled 1
return 0
}
proc Apol_PolicyConf::free_call_back_procs { } {
return 0
}
proc Apol_PolicyConf::display_policy_conf { path } {
variable textbox_policyConf
variable mod_disabled
set mod_disabled 0
$textbox_policyConf delete 0.0 end
if {[ApolTop::is_binary_policy]} {
$textbox_policyConf insert end "<Binary policy is not available>"
} else {
if { [file exists $path] } {
if { [file readable $path] } {
set file_channel [::open $path r]
set data [read $file_channel]
::close $file_channel
$textbox_policyConf insert end $data
} else {
$textbox_policyConf insert end "<policy.conf file exists but is not readable>"
}
} else {
$textbox_policyConf insert end "<policy.conf file does not exist>"
}
}
set mod_disabled 1
$textbox_policyConf see 0.0
$textbox_policyConf mark set insert 1.0
return 0
}
proc Apol_PolicyConf::search { str case_Insensitive regExpr srch_Direction } {
variable textbox_policyConf
ApolTop::textSearch $textbox_policyConf $str $case_Insensitive $regExpr $srch_Direction
set ApolTop::policyConf_lineno "Line [$textbox_policyConf index insert]"
return 0
}
proc Apol_PolicyConf::goto_line { line_num } {
variable textbox_policyConf
ApolTop::goto_line $line_num $textbox_policyConf
return 0
}
proc Apol_PolicyConf::insertHyperLink { tb start end } {
$tb tag add $Apol_PolicyConf::lineno_tag $start $end
return 0
}
proc Apol_PolicyConf::remove_HyperLink_tags { tb } {
$tb tag remove $Apol_PolicyConf::lineno_tag 0.0 end
$tb tag remove $Apol_PolicyConf::selected_tag 0.0 end
return 0
}
proc Apol_PolicyConf::configure_HyperLinks { tb } {
$tb tag configure $Apol_PolicyConf::lineno_tag -foreground blue -underline 1
$tb tag bind $Apol_PolicyConf::lineno_tag <Button-1> "Apol_PolicyConf::findInPolicyConf %W %x %y"
$tb tag bind $Apol_PolicyConf::lineno_tag <Enter> { set Apol_PolicyConf::orig_cursor [%W cget -cursor]; %W configure -cursor hand2 }
$tb tag bind $Apol_PolicyConf::lineno_tag <Leave> { %W configure -cursor $Apol_PolicyConf::orig_cursor }
return 0
}
proc Apol_PolicyConf::findInPolicyConf { tb x y } {
set line_num [eval $tb get [$tb tag prevrange $Apol_PolicyConf::lineno_tag "@$x,$y + 1 char"]]
$ApolTop::notebook raise $ApolTop::policy_conf_tab
Apol_PolicyConf::goto_line $line_num
set ranges [$tb tag prevrange $Apol_PolicyConf::lineno_tag "@$x,$y + 1 char"]
$tb tag add $Apol_PolicyConf::selected_tag [lindex $ranges 0] [lindex $ranges 1]
$tb tag configure $Apol_PolicyConf::selected_tag -foreground red -underline 1
return 0
}
namespace eval Apol_Perms_Map {
variable perms_mappings_lb
variable class_listbox
variable b_save
variable b_saveas_Dflt
variable perm_mappings_Dlg
set perm_mappings_Dlg .perm_mappings_Dlg
variable saveChanges_Dialog
set saveChanges_Dialog .saveChanges_Dialog
variable mls_classes_list ""
variable undefined_perm_classes ""
variable mls_base_perms_array
variable perm_weights_array
variable selinux_perms_array
variable mls_read "r"
variable mls_write "w"
variable mls_both "b"
variable mls_none "n"
variable mls_unknown "u"
variable edit_flag 0
variable saved_flag 0
variable loaded_pmap ""
variable edited_pmap ""
variable title_display ""
variable is_mls_loaded 0
variable dflt_pmap_flg 0
variable system_dflt_flg 0
variable user_default_pmap "[file join "$::env(HOME)" ".apol_perm_mapping"]"
variable sys_dflt_pmap_dir ""
variable dflt_pmap_display "User Default Permission Map"
variable sys_dflt_pmap_display "System Default Permission Map (Read-Only)"
variable warning_return_val "-2"
variable saveChanges_Dialog_ans ""
variable selected_class_idx "-1"
variable perm_map_id "apol_perm_mapping_ver"
variable perm_map_dflt "apol_perm_mapping"
variable undefined_tag UNDEFINED
variable spinbox_pathname ""
variable default_weight 1
}
proc Apol_Perms_Map::determine_loaded_pmap { } {
variable dflt_pmap_flg
variable system_dflt_flg
variable loaded_pmap
variable user_default_pmap
variable sys_dflt_pmap_dir
variable title_display
variable is_mls_loaded
set sys_dflt_pmap_dir [ApolTop::get_install_dir]
set Apol_Perms_Map::edit_flag 0
if {[string equal $loaded_pmap $user_default_pmap]} {
set dflt_pmap_flg 1
set system_dflt_flg 0
set title_display $Apol_Perms_Map::dflt_pmap_display
} elseif {[string equal [file dirname $loaded_pmap] $sys_dflt_pmap_dir]} {
set system_dflt_flg 1
set dflt_pmap_flg 0
set title_display $Apol_Perms_Map::sys_dflt_pmap_display
} elseif {$is_mls_loaded} {
set dflt_pmap_flg 0
set system_dflt_flg 0
set title_display "Permission map generated from $Apol_Perms_Map::loaded_pmap"
} else {
set dflt_pmap_flg 0
set system_dflt_flg 0
set title_display $Apol_Perms_Map::loaded_pmap
}
return 0
}
proc Apol_Perms_Map::set_to_edited_state {} {
variable b_save
variable b_saveas_Dflt
variable dflt_pmap_flg
variable system_dflt_flg
if {!$system_dflt_flg} {
$b_save configure -state normal
}
if {!$dflt_pmap_flg} {
$b_saveas_Dflt configure -state normal
}
set Apol_Perms_Map::edit_flag 1
set Apol_Perms_Map::saved_flag 0
return 0
}
proc Apol_Perms_Map::set_to_unedited_state {} {
variable b_save
variable b_saveas_Dflt
variable dflt_pmap_flg
variable system_dflt_flg
if {$dflt_pmap_flg} {
$b_saveas_Dflt configure -state disabled
} else {
$b_saveas_Dflt configure -state normal
}
$b_save configure -state disabled
set Apol_Perms_Map::edit_flag 0
return 0
}
proc Apol_Perms_Map::save_pmap_as_dflt_Dlg {parentDlg} {
variable title_display
variable user_default_pmap
variable system_dflt_flg
variable dflt_pmap_flg
variable saved_flag
variable edited_pmap
variable edit_flag
if {$user_default_pmap != ""} {
if {$edit_flag} {
set rt [catch {Apol_Perms_Map::write_edited_pmap_to_file $user_default_pmap} err]
} else {
set rt [catch {Apol_Perms_Map::save_permission_map $user_default_pmap} err]
}
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err" -parent $parentDlg
return -1
}
set dflt_pmap_flg 1
set system_dflt_flg 0
set saved_flag 1
set edited_pmap $user_default_pmap
set edit_flag 0
set title_display $Apol_Perms_Map::dflt_pmap_display
if { [winfo exists $Apol_Perms_Map::perm_mappings_Dlg] } {
wm title $Apol_Perms_Map::perm_mappings_Dlg "Edit Permissions Mappings: $Apol_Perms_Map::title_display"
}
Apol_Perms_Map::set_to_unedited_state
}
return 0
}
proc Apol_Perms_Map::save_pmap_as_Dlg {parentDlg} {
variable title_display
variable edited_pmap
variable dflt_pmap_flg
variable system_dflt_flg
variable saved_flag
variable edit_flag
variable user_default_pmap
set pmap_file ""
set types {
{"All files" *}
}
set pmap_file [tk_getSaveFile -title "Save As?" -filetypes $types -parent $parentDlg]
if {$pmap_file != ""} {
if {$pmap_file == $user_default_pmap} {
set rt [Apol_Perms_Map::save_pmap_as_dflt_Dlg $parentDlg]
if {$rt != 0} {
return -1
}
} else {
if {$edit_flag} {
set rt [catch {Apol_Perms_Map::write_edited_pmap_to_file $pmap_file} err]
} else {
set rt [catch {Apol_Perms_Map::save_permission_map $pmap_file} err]
}
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
set edit_flag 0
set dflt_pmap_flg 0
set system_dflt_flg 0
set saved_flag 1
set edited_pmap $pmap_file
set title_display $pmap_file
wm title $Apol_Perms_Map::perm_mappings_Dlg "Edit Permissions Mappings: $Apol_Perms_Map::title_display"
Apol_Perms_Map::set_to_unedited_state
}
} else {
return 1
}
return 0
}
proc Apol_Perms_Map::save_perm_map_Dlg {parentDlg} {
variable title_display
variable user_default_pmap
variable dflt_pmap_display
variable b_save
variable edit_flag
variable saved_flag
variable edited_pmap
if {!$edit_flag} {
return 0
}
if {$title_display == $dflt_pmap_display} {
set fileName $user_default_pmap
} else {
set fileName $edited_pmap
}
set rt [catch {Apol_Perms_Map::load_pmap_changes} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
set rt [catch {Apol_Perms_Map::save_permission_map $fileName} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
$b_save configure -state disabled
set edit_flag 0
set saved_flag 1
set edited_pmap $fileName
return 0
}
proc Apol_Perms_Map::close_Dlg {} {
variable edit_flag
if {$edit_flag} {
set ans [tk_messageBox -icon question -type yesno -title "Exit Perm Map Editor?" \
-parent $Apol_Perms_Map::perm_mappings_Dlg \
-message "There were unsaved changes to the perm map. \
Exit without saving changes to the perm map?"]
if {$ans == "no"} {
return
}
}
set Apol_Perms_Map::selected_class_idx "-1"
set saved_flag 0
if {[winfo exists $Apol_Perms_Map::perm_mappings_Dlg]} {
destroy $Apol_Perms_Map::perm_mappings_Dlg
}
return 0
}
proc Apol_Perms_Map::free_perms_mappings_vars { } {
variable mls_base_perms_array
variable perm_weights_array
variable selinux_perms_array
variable mls_classes_list
variable undefined_perm_classes
set mls_classes_list ""
set undefined_perm_classes ""
array unset mls_base_perms_array
array unset perm_weights_array
array unset selinux_perms_array
return 0
}
proc Apol_Perms_Map::init_perms_mappings_vars { } {
variable mls_base_perms_array
variable selinux_perms_array
variable mls_classes_list
variable loaded_pmap
variable undefined_perm_classes
variable perm_weights_array
variable default_weight
set rt [catch {set pmap_loaded [Apol_Perms_Map::is_pmap_loaded]} err]
if {$rt != 0} {
return -code error $err
}
if {!$pmap_loaded} {
return -code error "Permission mappings are not loaded!"
}
Apol_Perms_Map::free_perms_mappings_vars
set rt [catch {set perm_map [Apol_Perms_Map::get_perm_map]} err]
if {$rt != 0} {
return -code error $err
}
set num_classes [lindex $perm_map 0]
if {$num_classes < 1} {
return -code error "There were no classes retrieved from the permission map."
}
set perm_map [lreplace $perm_map 0 0]
set i 0
for {set j 0} {$j < $num_classes} {incr j} {
set undefined_flg 0
set class [lindex $perm_map $i]
set mls_classes_list [lappend mls_classes_list $class]
incr i
set num_perms [lindex $perm_map $i]
set se_perms ""
for {set k 0} {$k < $num_perms} {incr k} {
incr i
set se_perm [lindex $perm_map $i]
set se_perms [lappend se_perms $se_perm]
incr i
set mls_perm [lindex $perm_map $i]
set mls_base_perms_array($class,$se_perm) $mls_perm
incr i
if {!$undefined_flg && [Apol_Perms_Map::is_mls_perm_undefined $mls_base_perms_array($class,$se_perm)]} {
set undefined_flg 1
set undefined_perm_classes [lappend undefined_perm_classes $class]
}
if {[Apol_Perms_Map::is_mls_perm_undefined $mls_base_perms_array($class,$se_perm)]} {
set perm_weights_array($class,$se_perm) $default_weight
} else {
set perm_weight [lindex $perm_map $i]
set perm_weights_array($class,$se_perm) $perm_weight
}
}
set selinux_perms_array($class) [lsort $se_perms]
incr i
}
set mls_classes_list [lsort $mls_classes_list]
return 0
}
proc Apol_Perms_Map::change_perm_weighting {} {
variable perm_weights_array
variable spinbox_pathname
set spin_path $spinbox_pathname
if {$spin_path == ""} {
puts "Could not get spinbox pathname."
return -1
}
set spin_value [expr [$spin_path getvalue] + 1]
if {$spin_value == -1} {
puts "Spin value not found in the range of values"
return -1
}
set idx [string last ":" $spin_path]
if {$idx == -1} {
tk_messageBox -icon error -type ok -title "Error" \
-message "Error determinig class permission."
return -1
}
set perm [string range $spin_path [expr $idx + 1] end]
set tmp_str [string range $spin_path 0 [expr $idx - 1]]
set idx [string last ":" $tmp_str]
if {$idx == -1 } {
tk_messageBox -icon error -type ok -title "Error" \
-message "Error determinig class."
return -1
}
set class [string range $tmp_str [expr $idx + 1] end]
set perm_weights_array($class,$perm) $spin_value
Apol_Perms_Map::set_to_edited_state
return 0
}
proc Apol_Perms_Map::embed_mls_perms_widgets {list_b class selinux_perm} {
variable perm_weights_array
set frame [frame $list_b.f:$selinux_perm -bd 0 -bg white]
set lbl_frame [frame $frame.lbl_frame:$selinux_perm -width 20 -bd 1 -bg white]
set lbl1 [label $lbl_frame.lbl1:$selinux_perm -bg white -justify left -width 20 -anchor nw]
set lbl2 [label $lbl_frame.lbl2:$selinux_perm -bg white -justify left -width 5 -text "--->"]
set cb_frame [frame $frame.cb_frame:$selinux_perm -width 10 -bd 1 -bg white]
set spin_frame [frame $frame.spin_frame:$selinux_perm -width 10 -bd 0 -bg white]
set cb_read [radiobutton $cb_frame.read:$selinux_perm -bg white -value $Apol_Perms_Map::mls_read -text "Read" \
-highlightthickness 0 \
-variable Apol_Perms_Map::mls_base_perms_array($class,$selinux_perm) \
-command Apol_Perms_Map::set_to_edited_state]
set cb_write [radiobutton $cb_frame.write:$selinux_perm -bg white -value $Apol_Perms_Map::mls_write -text "Write" \
-highlightthickness 0 \
-variable Apol_Perms_Map::mls_base_perms_array($class,$selinux_perm) \
-command Apol_Perms_Map::set_to_edited_state]
set cb_both [radiobutton $cb_frame.both:$selinux_perm -bg white -value $Apol_Perms_Map::mls_both -text "Both" \
-highlightthickness 0 \
-variable Apol_Perms_Map::mls_base_perms_array($class,$selinux_perm) \
-command Apol_Perms_Map::set_to_edited_state]
set cb_none [radiobutton $cb_frame.none:$selinux_perm -bg white -value $Apol_Perms_Map::mls_none -text "None" \
-highlightthickness 0 \
-variable Apol_Perms_Map::mls_base_perms_array($class,$selinux_perm) \
-command Apol_Perms_Map::set_to_edited_state]
set lbl_weight [Label $spin_frame.lbl_weight:$class:$selinux_perm -bg white \
-text "Weight:" \
-padx 10]
set spinbox_weight [SpinBox $spin_frame.spinbox_weight:$class:$selinux_perm -bg white \
-range [list 1 10 1] \
-editable 0 -entrybg white -width 6 \
-helptext "Specify a weight (importance) for the permission" \
-modifycmd {Apol_Perms_Map::change_perm_weighting}]
$spinbox_weight setvalue @[expr $perm_weights_array($class,$selinux_perm) - 1]
bind $spinbox_weight <Enter> {set Apol_Perms_Map::spinbox_pathname %W}
bind $spinbox_weight <Leave> {set Apol_Perms_Map::spinbox_pathname ""}
pack $frame -side left -anchor nw -expand yes
pack $lbl_frame $cb_frame -side left -anchor nw -expand yes
pack $spin_frame -side left -padx 15 -anchor nw
pack $lbl1 $lbl2 -side left -anchor nw
pack $cb_read $cb_write $cb_both $cb_none -side left -anchor nw
pack $lbl_weight $spinbox_weight -side left -anchor nw
$frame configure -height 8
if {[Apol_Perms_Map::is_mls_perm_undefined $Apol_Perms_Map::mls_base_perms_array($class,$selinux_perm)]} {
$lbl1 configure -text "$selinux_perm *" -fg red
} else {
$lbl1 configure -text "$selinux_perm"
}
return $frame
}
proc Apol_Perms_Map::clear_perms_text {} {
variable perms_mappings_lb
$perms_mappings_lb configure -state normal
foreach emb_win [$perms_mappings_lb window names] {
if { [winfo exists $emb_win] } {
set rt [catch {destroy $emb_win} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "$err"
return -1
}
}
}
$perms_mappings_lb delete 1.0 end
return 0
}
proc Apol_Perms_Map::render_perm_mappings {} {
variable perm_mappings_Dlg
variable perms_mappings_lb
variable selinux_perms_array
variable selected_class_idx
variable class_listbox
set selected_class_idx [$class_listbox curselection]
if {$selected_class_idx == ""} {
return -1
}
set class_name [$class_listbox get $selected_class_idx]
if {$class_name == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "Empty class provided."
return -1
}
Apol_Perms_Map::clear_perms_text
update idletasks
set class_name [string trimright $class_name " *"]
set selinux_perms_list $selinux_perms_array($class_name)
foreach selinux_perm $selinux_perms_list {
$perms_mappings_lb window create end -window [Apol_Perms_Map::embed_mls_perms_widgets $perms_mappings_lb $class_name $selinux_perm]
$perms_mappings_lb insert end "\n\n"
}
$perms_mappings_lb tag configure $Apol_Perms_Map::undefined_tag -foreground red
$perms_mappings_lb configure -state disabled
return 0
}
proc Apol_Perms_Map::refresh_perm_mappings { } {
variable selected_class_idx
set sel_idx [$Apol_Perms_Map::class_listbox curselection]
Apol_Perms_Map::free_perms_mappings_vars
set rt [catch {Apol_Perms_Map::init_perms_mappings_vars} err]
if {$rt != 0} {
return -code error $err
}
if {$sel_idx != ""} {
set rt [catch {Apol_Perms_Map::render_perm_mappings} err]
if {$rt != 0} {
return -code error $err
}
$Apol_Perms_Map::class_listbox selection set [$Apol_Perms_Map::class_listbox index $sel_idx]
set selected_class_idx [$Apol_Perms_Map::class_listbox curselection]
}
return 0
}
proc Apol_Perms_Map::indicate_undef_perm_classes {class_listbox} {
variable mls_classes_list
variable undefined_perm_classes
foreach undef_class $undefined_perm_classes {
set idx [lsearch -exact $mls_classes_list $undef_class]
if {$idx != -1} {
set mls_classes_list [lreplace $mls_classes_list $idx $idx "[lindex $mls_classes_list $idx] *"]
}
}
foreach undef_class $undefined_perm_classes {
set idx [lsearch -exact $mls_classes_list "$undef_class *"]
if {$idx != -1} {
$class_listbox itemconfigure $idx -foreground red
}
}
return 0
}
proc Apol_Perms_Map::render_pmap_Dlg { } {
variable perm_mappings_Dlg
variable perms_mappings_lb
variable mls_classes_list
variable class_listbox
variable dflt_pmap_flg
variable system_dflt_flg
variable title_display
variable b_save
variable b_saveas_Dflt
variable undefined_perm_classes
if {[winfo exists $perm_mappings_Dlg]} {
raise $perm_mappings_Dlg
focus -force $perm_mappings_Dlg
return 0
}
toplevel $perm_mappings_Dlg
wm withdraw $perm_mappings_Dlg
wm title $perm_mappings_Dlg "Edit Permissions Mappings: $Apol_Perms_Map::title_display"
wm protocol $perm_mappings_Dlg WM_DELETE_WINDOW " "
set topf [frame $perm_mappings_Dlg.topf]
set pw1 [PanedWindow $topf.pw -side top]
set pane [$pw1 add ]
set search_pane [$pw1 add -weight 3]
set pw2 [PanedWindow $pane.pw -side left]
set class_pane [$pw2 add -weight 2]
set classes_box [TitleFrame $class_pane.tbox -text "Object Classes"]
set results_box [TitleFrame $search_pane.rbox -text "Permission Mappings"]
pack $classes_box -padx 2 -side left -fill both -expand yes
pack $results_box -pady 2 -padx 2 -fill both -expand yes
pack $pw1 -fill both -expand yes
pack $pw2 -fill both -expand yes
pack $topf -fill both -expand yes -padx 10 -pady 10
set sw_class [ScrolledWindow [$classes_box getframe].sw -auto none]
set class_listbox [listbox [$sw_class getframe].lb -height 10 -width 20 -highlightthickness 0 \
-bg white -selectmode single -exportselection 0 -listvar Apol_Perms_Map::mls_classes_list]
if {$undefined_perm_classes != ""} {
set rlbl_frame [frame [$results_box getframe].rlbl_frame]
set rlbl_1 [label $rlbl_frame.rlbl_1 -text "*" -font $ApolTop::text_font -fg red]
set rlbl_2 [label $rlbl_frame.rlbl_2 -text " - Undefined permission mapping(s)" -font $ApolTop::text_font]
}
$sw_class setwidget $class_listbox
bindtags $class_listbox [linsert [bindtags $class_listbox] 3 permMap_list_Tag]
bind permMap_list_Tag <<ListboxSelect>> {Apol_Perms_Map::render_perm_mappings}
pack $sw_class -fill both -expand yes -side top
if {$undefined_perm_classes != ""} {
pack $rlbl_frame -side bottom -anchor nw -padx 5
pack $rlbl_1 -side left -anchor nw
pack $rlbl_2 -side left -anchor nw -fill x -expand yes
}
set sw_list [ScrolledWindow [$results_box getframe].sw_c -auto none]
set perms_mappings_lb [text [$results_box getframe].perms_mappings_lb \
-cursor $ApolTop::prevCursor \
-bg white -font $ApolTop::text_font]
$sw_list setwidget $perms_mappings_lb
set botf [frame $perm_mappings_Dlg.botf]
set b_exit [button $botf.b_exit -text "Exit" -width 8 -command {Apol_Perms_Map::close_Dlg}]
set b_save [button $botf.b_save -text "Save and Load Changes" -width 20 -command {Apol_Perms_Map::save_perm_map_Dlg $Apol_Perms_Map::perm_mappings_Dlg}]
set b_saveas [button $botf.b_saveas -text "Save As..." -width 8 -command {Apol_Perms_Map::save_pmap_as_Dlg $Apol_Perms_Map::perm_mappings_Dlg}]
set b_saveas_Dflt [button $botf.b_saveas_Dflt -text "Save As User Default" -width 16 -command {Apol_Perms_Map::save_pmap_as_dflt_Dlg $Apol_Perms_Map::perm_mappings_Dlg}]
pack $sw_list -fill both -expand yes
pack $b_save $b_saveas $b_saveas_Dflt $b_exit -side left -padx 5 -pady 5 -anchor center -expand yes
pack $botf -side left -expand yes -anchor center
set width 800
set height 600
wm geom $perm_mappings_Dlg ${width}x${height}
wm deiconify $perm_mappings_Dlg
focus $perm_mappings_Dlg
wm protocol $perm_mappings_Dlg WM_DELETE_WINDOW "Apol_Perms_Map::close_Dlg"
return 0
}
proc Apol_Perms_Map::read_next_line {file_channel line_num elements} {
upvar 1 $file_channel f
upvar 1 $line_num line_no
upvar 1 $elements line_elements
while {[eof $f] != 1} {
gets $f line
incr line_no
if {[eof $f] && $line == ""} {
return -1
}
set tline [string trim $line]
if {[string compare -length 1 $tline "#"] == 0 && [eof $f] != 1} {
continue
} elseif {[string compare -length 1 $tline "#"] == 0 && [eof $f]} {
return -1
}
set line_elements [split $tline]
break
}
for {set i 0} {$i < [llength $line_elements]} {incr i} {
if {[lindex $line_elements $i] == "" || [string is space [lindex $line_elements $i]]} {
set line_elements [lreplace $line_elements $i $i]
}
}
set i 0
foreach element $line_elements {
if {[string equal $element ""] || [string is space $element]} {
set idx [lsearch -exact $line_elements $element]
set line_elements [lreplace $line_elements $idx $idx]
}
incr i
}
return 0
}
proc Apol_Perms_Map::reformat_line {elements reformatted_flag} {
upvar 1 $elements line_elements
upvar 1 $reformatted_flag string_reformatted
set tline [join $line_elements]
set line_elements [split $tline ":"]
if {$line_elements != ""} {
for {set i 0} {$i < [llength $line_elements]} {incr i} {
set line_elements [lreplace $line_elements $i $i [string trim [lindex $line_elements $i]]]
}
set tline [join $line_elements " : "]
}
set line_elements [split $tline "\{"]
if {$line_elements != ""} {
for {set i 0} {$i < [llength $line_elements]} {incr i} {
set line_elements [lreplace $line_elements $i $i [string trim [lindex $line_elements $i]]]
}
set tline [join $line_elements " \{ "]
}
set line_elements [split $tline "\}"]
if {$line_elements != ""} {
for {set i 0} {$i < [llength $line_elements]} {incr i} {
set line_elements [lreplace $line_elements $i $i [string trim [lindex $line_elements $i]]]
}
set tline [join $line_elements " \} "]
}
set line_elements [split $tline]
for {set i 0} {$i < [llength $line_elements]} {incr i} {
if {[lindex $line_elements $i] == ""} {
set line_elements [lreplace $line_elements $i $i]
}
}
set string_reformatted 1
return 0
}
proc Apol_Perms_Map::parse_mls_perm {identifier se_perm elements_list file_channel line_num perm_map_list reformatted} {
variable mls_read
variable mls_write
variable mls_both
variable mls_none
variable mls_unknown
upvar 1 $elements_list line_elements
upvar 1 $file_channel f
upvar 1 $line_num line_no
upvar 1 $perm_map_list perm_map
upvar 1 $reformatted string_reformatted
while {1} {
if {[llength $line_elements] >= 1} {
if {!$string_reformatted} {
Apol_Perms_Map::reformat_line "line_elements" "string_reformatted"
}
if {[lindex $line_elements 0] != "\{"} {
switch [lindex $line_elements 0] {
"read" {
lappend perm_map "$se_perm $mls_read"
}
"write" {
lappend perm_map "$se_perm $mls_write"
}
"none" {
lappend perm_map "$se_perm $mls_none"
}
default {
puts "Warning:Unknown mls base permission [lindex $line_elements 0] encountered at line: $line_no."
lappend perm_map "$se_perm $mls_unknown"
}
}
set line_elements [lreplace $line_elements 0 0]
} else {
set line_elements [lreplace $line_elements 0 0]
set first_mls_flag 0
set sec_mls_flag 0
while {1} {
if {[llength $line_elements] >= 1} {
if {[lindex $line_elements 0] == "\}"} {
if {$first_mls_flag && $sec_mls_flag} {
lappend perm_map "$se_perm $mls_both"
} elseif {$first_mls_flag} {
switch $first_perm {
"read" {
lappend perm_map "$se_perm $mls_read"
}
"write" {
lappend perm_map "$se_perm $mls_write"
}
"none" {
lappend perm_map "$se_perm $mls_none"
}
default {
puts "Warning:Unknown mls base permission [lindex $line_elements 0] encountered at line: $line_no."
lappend perm_map "$se_perm $mls_unknown"
}
}
} else {
lappend perm_map "$se_perm $mls_none"
}
set line_elements [lreplace $line_elements 0 0]
break
}
if {$first_mls_flag && $sec_mls_flag} {
puts "Error at line: $line_no. Expected a close brace, but got \'[lindex $line_elements 0].\'"
return -1
}
if {!$first_mls_flag} {
set first_perm [lindex $line_elements 0]
set line_elements [lreplace $line_elements 0 0]
set first_mls_flag 1
}
if {$first_mls_flag && !$sec_mls_flag} {
if {$first_perm == "read" || $first_perm == "write"} {
if {[lindex $line_elements 0] == "read" || [lindex $line_elements 0] == "write"} {
if {[lindex $line_elements 0] == $first_perm} {
puts "Duplicate mls base permission [lindex $line_elements 0] encountered."
return -1
}
set line_elements [lreplace $line_elements 0 0]
set sec_mls_flag 1
} else {
puts "At line: $line_no, unknown mls base permission [lindex $line_elements 0] encountered."
return -1
}
} else {
puts "At line: $line_no, incorrect mls base permission [lindex $line_elements 0]."
return -1
}
}
} else {
if {[eof $f]} {
puts "End of file reached before parsing mls base permission."
return -1
}
set rt [Apol_Perms_Map::read_next_line "f" "line_no" "line_elements"]
if {$rt != 0} {
return -1
}
}
if {[eof $f] && [llength $line_elements] < 1} {
puts "End of file reached before parsing mls base permission."
return -1
}
}
}
break
} else {
if {[eof $f]} {
puts "End of file reached before parsing mls base permission."
return -1
}
set rt [Apol_Perms_Map::read_next_line "f" "line_no" "line_elements"]
if {$rt != 0} {
return -1
}
set string_reformatted 0
}
if {[eof $f] && [llength $line_elements] < 1} {
puts "End of file reached before parsing mls base permission."
return -1
}
}
return 0
}
proc Apol_Perms_Map::parse_permission_mapping {identifier elements file_channel line_num statement_array} {
upvar 1 $elements line_elements
upvar 1 $file_channel f
upvar 1 $line_num line_no
upvar 1 $statement_array array_var
set string_reformatted 0
set perm_map ""
while {1} {
if {[llength $line_elements] >= 1} {
if {[lindex $line_elements 0] == "\{"} {
set line_elements [lreplace $line_elements 0 0]
break
} else {
return 1
}
} else {
set rt [Apol_Perms_Map::read_next_line "f" "line_no" "line_elements"]
if {$rt == -1} {
return 2
}
}
}
while {1} {
if {[llength $line_elements] >= 1} {
if {[lindex $line_elements 0] == "\}"} {
break
}
if {!$string_reformatted} {
Apol_Perms_Map::reformat_line "line_elements" "string_reformatted"
}
if {[lindex $line_elements 0] != ""} {
set se_perm [lindex $line_elements 0]
set line_elements [lreplace $line_elements 0 0]
} else {
puts "Error: encountered an empty selinux permission at line : $line_no"
return -1
}
while {1} {
if {[llength $line_elements] >= 1} {
if {[string equal [lindex $line_elements 0] ":"]} {
set line_elements [lreplace $line_elements 0 0]
break
} else {
puts "Syntax error found at line: $line_no. Expected a colon, \
but got \"[lindex $line_elements 0]\""
return -1
}
} else {
if {[eof $f]} {
puts "End of file reached before parsing mls base permission."
return -1
}
set rt [Apol_Perms_Map::read_next_line "f" "line_no" "line_elements"]
if {$rt != 0} {
return -1
}
}
if {[eof $f] && [llength $line_elements] < 1} {
puts "End of file reached before parsing mls base permission."
return -1
}
}
set rt [Apol_Perms_Map::parse_mls_perm $identifier $se_perm "line_elements" "f" "line_no" "perm_map" "string_reformatted"]
if {$rt != 0} {
return -1
}
set array_var($identifier) $perm_map
} else {
if {[eof $f]} {
puts "End of file reached before parsing selinux permission."
return -1
}
set rt [Apol_Perms_Map::read_next_line "f" "line_no" "line_elements"]
if {$rt != 0} {
return -1
}
}
if {[eof $f] && [llength $line_elements] < 1} {
puts "End of file reached before parsing selinux permission."
return -1
}
}
return 0
}
proc Apol_Perms_Map::write_mls_base_perm_map_file {classes pmap_file {mls_file ""}} {
upvar 1 $classes class_info
set access [list WRONLY CREAT TRUNC]
set rt [catch {set f [::open $pmap_file $access]} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {set polversion [apol_GetPolicyVersionString]} err]
if {$rt != 0} {
return -code error $err
}
if {$mls_file == ""} {
puts $f "# Auto-generated on [clock format [clock seconds] -format "%b %d, %Y %I:%M:%S %p" -gmt 0]"
} else {
puts $f "# Auto-generated from $mls_file on [clock format [clock seconds] -format "%b %d, %Y %I:%M:%S %p" -gmt 0]"
}
puts $f "\n"
puts $f "# Policy version: $polversion"
puts $f "# Number of object classes."
puts $f "[array size class_info]"
puts $f "\n"
if {[array exists class_info]} {
set classes [array names class_info]
foreach class $classes {
set perms_list $class_info($class)
set num_perms [llength $perms_list]
puts $f "class $class $num_perms"
foreach perm $perms_list {
set split_perms [split [string trim $perm] " "]
if {[Apol_Perms_Map::is_mls_perm_undefined [lindex $split_perms 1]]} {
puts $f [eval format {"%18.18s %5.5s"} "#$perm"]
} else {
puts $f [eval format {"%18.18s %5.5s"} $perm]
}
}
puts $f "\n"
}
}
::close $f
return 0
}
proc Apol_Perms_Map::write_edited_pmap_to_file {pmap_file} {
variable mls_classes_list
variable mls_base_perms_array
variable perm_weights_array
variable selinux_perms_array
set access [list WRONLY CREAT TRUNC]
set rt [catch {set f [::open $pmap_file $access]} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {set polversion [apol_GetPolicyVersionString]} err]
if {$rt != 0} {
return -code error $err
}
puts $f "# Auto-generated on [clock format [clock seconds] -format "%b %d, %Y %I:%M:%S %p" -gmt 0]"
puts $f "\n"
puts $f "# Policy version: $polversion"
puts $f "# Number of object classes."
puts $f "[llength $mls_classes_list]"
puts $f "\n"
if {![array exists mls_base_perms_array] || ![array exists perm_weights_array] || ![array exists selinux_perms_array]} {
return -code error "Missing necessary perm map information. Cannot save changes."
}
foreach class $mls_classes_list {
set class [string trimright $class " *"]
set perms_list $selinux_perms_array($class)
set num_perms [llength $perms_list]
puts $f "class $class $num_perms"
foreach perm $perms_list {
if {[Apol_Perms_Map::is_mls_perm_undefined $mls_base_perms_array($class,$perm)]} {
puts $f [eval format {"%18.18s %5.5s %5.5s"} "#$perm" "$mls_base_perms_array($class,$perm)" "$perm_weights_array($class,$perm)"]
} else {
puts $f [eval format {"%18.18s %5.5s %5.5s"} "$perm" "$mls_base_perms_array($class,$perm)" "$perm_weights_array($class,$perm)"]
}
}
puts $f "\n"
}
::close $f
return 0
}
proc Apol_Perms_Map::create_tmp_file {} {
set chars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
set num_chars 8
set num_tries 8
set fn_prefix "/tmp/apol-"
set mypid [pid]
for {set i 0} {$i < $num_tries} {incr i} {
set fn $fn_prefix
for {set j 0} {$j < $num_chars} {incr j} {
append fn [string index $chars [expr ([clock clicks] ^ $mypid) % 62]]
}
if {[file exists $fn]} {
after 1
} else {
return $fn
}
}
# If we're here we failed to create the file!
puts stderr "Failed to create a unique temporary file with prefix $fn_prefix"
return -code error "Failed to create a unique temporary file with prefix $fn_prefix"
}
proc Apol_Perms_Map::is_mls_perm_undefined {mls_perm} {
variable mls_read
variable mls_write
variable mls_both
variable mls_none
variable mls_unknown
if {[string equal $mls_perm $mls_unknown]} {
return 1
} else {
switch -exact -- $mls_perm \
$mls_read {
return 0
} \
$mls_write {
return 0
} \
$mls_both {
return 0
} \
$mls_none {
return 0
} \
default {
return 1
}
return 1
}
# Should not get here!!
return -code error "Problem determining mls base perm!!"
}
proc Apol_Perms_Map::is_pmap_loaded {} {
set rt [catch {set pmap_loaded [apol_IsPermMapLoaded]} err]
if {$rt != 0} {
return -code error $err
}
return $pmap_loaded
}
proc Apol_Perms_Map::get_perm_map {} {
set perm_map ""
set rt [catch {set pmap_loaded [Apol_Perms_Map::is_pmap_loaded]} err]
if {$rt != 0} {
return -code error $err
}
if {!$pmap_loaded} {
return -code error "Permission mappings are not loaded."
}
set rt [catch {set perm_map [apol_GetPermMap]} err]
if {$rt != 0} {
return -code error $err
}
return $perm_map
}
proc Apol_Perms_Map::get_weight_for_class_perm {obj_class selinux_perm} {
variable perm_weights_array
if {[array exists perm_weights_array]} {
return $perm_weights_array($obj_class,$selinux_perm)
} else {
return ""
}
}
proc Apol_Perms_Map::load_perm_map_from_mls {mls_file save_file} {
variable warning_return_val
variable loaded_pmap
if {[file exists $mls_file] == 0 } {
return -code error "$mls_file does not exist. Cannot generate permisson map file."
}
set rt [catch {set f [::open $mls_file r]} err]
if {$rt != 0} {
return -code error "Cannot open $mls_file file ($rt: $err)"
}
set line_no 0
set line_elements ""
set rt [Apol_Perms_Map::read_next_line "f" "line_no" "line_elements"]
if {$rt != 0} {
puts "End of file reached before parsing first valid class/common statment."
return -code error "Parsing error. See stdout for more information."
}
while {1} {
if {[string equal [lindex $line_elements 0] "common"] || [string equal [lindex $line_elements 0] "COMMON"] || [string equal [lindex $line_elements 0] "class"] || [string equal [lindex $line_elements 0] "CLASS"]} {
set statement_type [string tolower [lindex $line_elements 0]]
set line_elements [lreplace $line_elements 0 0]
# this is an error, because we have not yet gathered the identifier!
if {[eof $f] && [llength $line_elements] < 1} {
puts "Error: End of file reached before gathering identifier."
return -code error "Parsing error. See stdout for more information."
}
while {1} {
if {[llength $line_elements] >= 1} {
set tline [join $line_elements]
set line_elements [split $tline "\{"]
if {$line_elements != ""} {
for {set i 0} {$i < [llength $line_elements]} {incr i} {
set line_elements [lreplace $line_elements $i $i [string trim [lindex $line_elements $i]]]
}
set tline [join $line_elements " \{ "]
}
set line_elements [split $tline]
for {set i 0} {$i < [llength $line_elements]} {incr i} {
if {[lindex $line_elements $i] == ""} {
set line_elements [lreplace $line_elements $i $i]
}
}
if {[string equal [lindex $line_elements 0] "\{"]} {
puts "Error: Open bracket reached before finding an identifier."
return -code error "Parsing error. See stdout for more information."
} elseif {[lindex $line_elements 0] != ""} {
set identifier [lindex $line_elements 0]
set line_elements [lreplace $line_elements 0 0]
break
} else {
puts "Error: Could not determine the identifier for this $statement_type statement."
return -code error "Parsing error. See stdout for more information."
}
} else {
set rt [Apol_Perms_Map::read_next_line "f" "line_no" "line_elements"]
if {$rt != 0} {
puts "End of file reached before parsing identifier for $statement_type."
return -code error "Parsing error. See stdout for more information."
}
}
}
if {$statement_type == "common"} {
set common_perms($identifier) ""
if {[eof $f] && [llength $line_elements] < 1} {
break
}
set rt [Apol_Perms_Map::parse_permission_mapping $identifier "line_elements" "f" "line_no" "common_perms"]
if {$rt == 1} {
continue
} elseif {$rt == 2} {
break
} elseif {$rt != 0} {
puts "Error: Error parsing line: $line_no"
return -code error "Parsing error. See stdout for more information."
}
} elseif {$statement_type == "class"} {
set class_info($identifier) ""
if {[eof $f] && [llength $line_elements] < 1} {
break
}
set rt [Apol_Perms_Map::parse_permission_mapping $identifier "line_elements" "f" "line_no" "class_info"]
if {$rt == 1} {
continue
} elseif {$rt == 2} {
break
} elseif {$rt != 0} {
puts "Error: Error parsing line: $line_no"
return -code error "Parsing error. See stdout for more information."
}
} else {
puts "Determined wrong statement type while trying to set permission map info."
return -code error "Parsing error. See stdout for more information."
}
}
set line_elements ""
if {[eof $f] && $line_elements == ""} {
break
}
set rt [Apol_Perms_Map::read_next_line "f" "line_no" "line_elements"]
if {$rt == -1} {
break
}
}
if {[array exists common_perms]} {
foreach class [array names class_info] {
set rt [catch {set valid_common_perm [apol_GetClassCommonPerm $class]} err]
if {$rt != 0} {
puts "Error retrieving common permissions for $class: $err"
} else {
if {$valid_common_perm != ""} {
set perms_list $class_info($class)
set common_perm [array names common_perms "$valid_common_perm"]
if {$common_perm != ""} {
set comm_perms $common_perms($common_perm)
set perms_list [concat $comm_perms $perms_list]
set class_info($class) $perms_list
}
}
}
}
array unset common_perms
}
if {[array exists class_info]} {
set rt [catch {Apol_Perms_Map::write_mls_base_perm_map_file "class_info" $save_file} err]
array unset class_info
if {$rt != 0} {
return -code error $err
}
} else {
return -code error "No class information was found, so could not load perm map from the mls file."
}
::close $f
if {[file exists $save_file]} {
set rt [catch {Apol_Perms_Map::load_perm_mappings $save_file} msg]
if {$rt != 0} {
if {$rt == $warning_return_val} {
return -code $warning_return_val $msg
} else {
return -code error $msg
}
}
} else {
return -code error "Could not load temporary permission map file ($save_file). File does not exist."
}
return 0
}
proc Apol_Perms_Map::load_default_perm_map {} {
variable loaded_pmap
variable warning_return_val
variable user_default_pmap
if {![file exists $user_default_pmap]} {
set rt [catch {set policy_version [apol_GetPolicyVersionNumber]} err]
if {$rt != 0} {
return -code error $err
}
set default_flg 0
if {$policy_version && $policy_version >= 12} {
set rt [catch {set pmap_file [apol_GetDefault_PermMap "$Apol_Perms_Map::perm_map_id$policy_version"]} err]
} else {
set rt [catch {set pmap_file [apol_GetDefault_PermMap $Apol_Perms_Map::perm_map_dflt]} err]
set default_flg 1
}
if {$rt != 0} {
return -code error $err
}
if {$pmap_file == ""} {
if {!$default_flg} {
set rt [catch {set pmap_file [apol_GetDefault_PermMap $Apol_Perms_Map::perm_map_dflt]} err]
if {$rt != 0} {
return -code error $err
}
if {$pmap_file == ""} {
return -code error "Could not locate system default perm map. You must explicitly load a perm map. See Advanced menu."
}
}
return -code error "Could not locate system default perm map. You must explicitly load a perm map. See Advanced menu."
}
set pmap_file [file nativename $pmap_file]
set rt [catch {Apol_Perms_Map::load_perm_mappings $pmap_file} msg]
if {$rt != 0} {
if {$rt == $warning_return_val} {
return -code $warning_return_val $msg
} else {
return -code error $msg
}
}
set loaded_pmap $pmap_file
} else {
set pmap_file [file nativename $user_default_pmap]
set rt [catch {Apol_Perms_Map::load_perm_mappings $pmap_file} msg]
if {$rt != 0} {
if {$rt == $warning_return_val} {
return -code $warning_return_val $msg
} else {
set ans [tk_messageBox \
-icon question \
-type yesno \
-parent $ApolTop::mainframe \
-title "Load system default permission map?" \
-message "Your default permission map ($user_default_pmap) is corrupted.\n\nWould you \
like to copy to your default permission map with the system default permission map and then load?"]
if {$ans == "yes"} {
set user_dflt_dir [file dirname $user_default_pmap]
set rt [catch {file copy -force $pmap_file $user_dflt_dir} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {file rename -force [file join $user_dflt_dir [file tail $pmap_file]] $user_default_pmap} err]
if {$rt != 0} {
return -code error $err
}
set pmap_file [file nativename $user_default_pmap]
set rt [catch {Apol_Perms_Map::load_perm_mappings $pmap_file} msg]
if {$rt != 0} {
if {$rt == $warning_return_val} {
return -code $warning_return_val $msg
} else {
return -code error $msg
}
}
} else {
return -code error $msg
}
}
}
set loaded_pmap $pmap_file
}
return 0
}
proc Apol_Perms_Map::load_perm_mappings {pmap_file} {
variable loaded_pmap
variable edited_pmap
variable edit_flag
variable warning_return_val
if {$pmap_file != ""} {
set warn 0
set rt [catch {apol_LoadPermMap $pmap_file} msg]
if {$rt != 0} {
if {$rt == -2} {
set warn 1
} else {
return -code error $msg
}
}
set loaded_pmap $pmap_file
set edited_pmap $pmap_file
ApolTop::configure_edit_pmap_menu_item 1
set rt [catch {Apol_Perms_Map::init_perms_mappings_vars} err]
if {$rt != 0} {
return -code error $err
}
if {$warn} {
return -code $warning_return_val $msg
}
}
return 0
}
proc Apol_Perms_Map::save_permission_map {filename} {
set rt [catch {apol_SavePermMap $filename} err]
if {$rt != 0} {
return -code error $err
}
return 0
}
proc Apol_Perms_Map::load_pmap_changes {} {
if { [catch {set tmpfilename [Apol_Perms_Map::create_tmp_file]} err] } {
return -code error $err
}
set rt [catch {Apol_Perms_Map::write_edited_pmap_to_file $tmpfilename} err]
if {$rt != 0} {
file delete $tmpfilename
return -code error $err
}
set rt [catch {apol_UpdatePermMap $tmpfilename} err]
if {$rt != 0} {
file delete $tmpfilename
return -code error $err
}
file delete $tmpfilename
return 0
}
proc Apol_Perms_Map::load_perm_map_fileDlg {parentDlg} {
variable warning_return_val
variable is_mls_loaded
set pmap_file ""
set types {
{"All files" *}
}
set pmap_file [tk_getOpenFile -filetypes $types -title "Select Perm Map to Load..." -parent $parentDlg]
if {$pmap_file != ""} {
set rt [catch {Apol_Perms_Map::load_perm_mappings $pmap_file} err]
if {$rt != 0} {
if {$rt == $warning_return_val} {
tk_messageBox -icon warning -type ok -title "Warning" -message "$err"
} else {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
}
set is_mls_loaded 0
if {[winfo exists $Apol_Perms_Map::perm_mappings_Dlg]} {
Apol_Perms_Map::close_Dlg
Apol_Perms_Map::display_perm_mappings_Dlg
}
}
return 0
}
proc Apol_Perms_Map::load_perm_map_mlsDlg {parentDlg} {
variable warning_return_val
variable loaded_pmap
variable is_mls_loaded
variable title_display
set types {
{"All files" *}
}
set mls_file [tk_getOpenFile -filetypes $types -title "Select mls file to convert from..." \
-initialfile "mls" -initialdir [file dirname $ApolTop::filename] -parent $parentDlg]
if {$mls_file == ""} {
return -1
}
# create a temp file channel with WRONLY access only!
if { [catch {set tmpfilename [Apol_Perms_Map::create_tmp_file]} err] } {
tk_messageBox -icon error -type ok -title "Error" -message "$err" -parent $parentDlg
return -1
}
if {$tmpfilename == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "$err" -parent $parentDlg
return -1
}
set rt [catch {Apol_Perms_Map::load_perm_map_from_mls $mls_file $tmpfilename} err]
if {$rt != 0} {
if {$rt == $warning_return_val} {
tk_messageBox -icon warning -type ok -title "Warning" -message "$err" -parent $parentDlg
} else {
if {[file exists $tmpfilename]} {
file delete $tmpfilename
}
tk_messageBox -icon error -type ok -title "Error" -message "$err" -parent $parentDlg
return -1
}
}
if {[file exists $tmpfilename]} {
file delete $tmpfilename
}
set loaded_pmap $mls_file
set is_mls_loaded 1
if {[winfo exists $Apol_Perms_Map::perm_mappings_Dlg]} {
Apol_Perms_Map::close_Dlg
Apol_Perms_Map::display_perm_mappings_Dlg
}
return 0
}
proc Apol_Perms_Map::load_default_perm_map_Dlg {parentDlg} {
variable warning_return_val
variable is_mls_loaded
set rt [catch {Apol_Perms_Map::load_default_perm_map} err]
if {$rt != 0} {
if {$rt == $warning_return_val} {
tk_messageBox -icon warning -type ok -title "Warning" -message "$err"
} else {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
}
set is_mls_loaded 0
if {[winfo exists $Apol_Perms_Map::perm_mappings_Dlg]} {
Apol_Perms_Map::close_Dlg
Apol_Perms_Map::display_perm_mappings_Dlg
}
return 0
}
proc Apol_Perms_Map::display_perm_mappings_Dlg { } {
variable class_listbox
variable edit_flag
variable saved_flag
if {$saved_flag || [expr $edit_flag && !$saved_flag]} {
set rt [catch {Apol_Perms_Map::init_perms_mappings_vars} err]
if {$rt != 0} {
return -code error $err
}
}
Apol_Perms_Map::determine_loaded_pmap
set rt [catch {Apol_Perms_Map::render_pmap_Dlg} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
Apol_Perms_Map::indicate_undef_perm_classes $class_listbox
Apol_Perms_Map::set_to_unedited_state
return 0
}
proc Apol_Perms_Map::close {parentDlg} {
variable edit_flag
variable perm_mappings_Dlg
variable perms_mappings_lb
variable selected_class_idx
Apol_Perms_Map::free_perms_mappings_vars
set edit_flag 0
set selected_class_idx "-1"
if {[winfo exists $perm_mappings_Dlg]} {
if {[winfo exists $perms_mappings_lb]} {
$perms_mappings_lb delete 1.0 end
}
destroy $perm_mappings_Dlg
}
if {[winfo exists $Apol_Perms_Map::perm_mappings_Dlg]} {
destroy $Apol_Perms_Map::perm_mappings_Dlg
}
return 0
}
namespace eval Apol_Analysis {
variable results_notebook
variable analysis_listbox
variable opts_frame
variable newButton
variable updateButton
variable bClose
variable popupTab_Menu
variable descrp_text
variable info_Dlg
set info_Dlg .info_Dlg
variable analysis_modules ""
variable curr_analysis_module ""
variable raised_tab_analysis_type ""
variable new_tab_name ""
variable totalTabCount 10
variable currTabCount 0
variable pageNums 0
variable tabName "Apol_ResultsTab"
variable emptyTabID "Apol_Emptytab"
variable tabText "Results "
variable pageID ""
variable results ""
variable enableUpdate 0
variable initTab 0
variable tab_deleted_flag 0
variable keepmodselect 0
variable analysis_results_array
variable tab_menu_callbacks ""
}
proc Apol_Analysis::mod_select { mod_name } {
variable opts_frame
variable curr_analysis_module
variable analysis_listbox
variable raised_tab_analysis_type
variable results_notebook
variable updateButton
variable newButton
if { $mod_name == $curr_analysis_module } {
return
}
$analysis_listbox selection set $mod_name
set curr_analysis_module $mod_name
Apol_Analysis::clear_options_frame $opts_frame
Apol_Analysis::display_mod_options $mod_name $opts_frame
set tab_frame [$results_notebook index $Apol_Analysis::emptyTabID]
$results_notebook raise [$results_notebook page $tab_frame]
$updateButton configure -state disabled
$newButton configure -state normal
if { [winfo exists $Apol_Analysis::info_Dlg] } {
set descriptive_text [Apol_Analysis::get_analysis_info $curr_analysis_module]
$Apol_Analysis::descrp_text config -state normal
$Apol_Analysis::descrp_text delete 0.0 end
$Apol_Analysis::descrp_text insert 0.0 $descriptive_text
$Apol_Analysis::descrp_text config -state disabled
raise $Apol_Analysis::info_Dlg
}
return 0
}
proc Apol_Analysis::free_call_back_procs { } {
variable tab_menu_callbacks
set tab_menu_callbacks ""
return 0
}
proc Apol_Analysis::delete_ResultsTab { pageID } {
variable results_notebook
variable currTabCount
variable tab_deleted_flag
variable analysis_results_array
variable curr_analysis_module
variable opts_frame
variable updateButton
variable bClose
variable keepmodselect
if { [$results_notebook index $Apol_Analysis::emptyTabID] != [$results_notebook index $pageID] } {
$bClose configure -state disabled
update
set prevPageIdx [expr [$results_notebook index $pageID] - 1]
set results_frame [Apol_Analysis::get_results_frame $pageID]
Apol_Analysis::clear_results_frame $results_frame $pageID
$results_notebook delete $pageID
set currTabCount [expr $currTabCount - 1]
array unset analysis_results_array "$pageID,*"
set raised [$results_notebook raise [$results_notebook page 0]]
$updateButton configure -state disabled
set tab_deleted_flag 1
Apol_Analysis::switch_results_tab $raised
set tab_deleted_flag 0
$bClose configure -state normal
}
update
return 0
}
proc Apol_Analysis::close_All_ResultsTabs { } {
variable analysis_results_array
variable results_notebook
variable currTabCount
set tabList [$results_notebook pages]
foreach tab $tabList {
if {![string equal $tab $Apol_Analysis::emptyTabID]} {
set results_frame [Apol_Analysis::get_results_frame $tab]
Apol_Analysis::clear_results_frame $results_frame $tab
}
$results_notebook delete $tab
}
set Apol_Analysis::pageNums 0
set Apol_Analysis::currTabCount 0
set Apol_Analysis::pageID ""
set Apol_Analysis::results ""
set Apol_Analysis::initTab 0
set Apol_Analysis::enableUpdate 0
array unset analysis_results_array
return 0
}
proc Apol_Analysis::clear_results_frame {results_frame tabID} {
variable analysis_results_array
set curr_analysis_module $analysis_results_array($tabID,mod_name)
set query_options $analysis_results_array($tabID,query)
set rt [catch {${curr_analysis_module}::free_results_data $query_options} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "Error freeing results tab data."
return -1
}
destroy $results_frame
return 0
}
proc Apol_Analysis::create_results_frame { parent } {
set tmp [frame $parent.results_frame]
pack $tmp -side left -fill both -anchor nw -expand yes
return $tmp
}
proc Apol_Analysis::get_results_frame { tabID } {
variable results_notebook
set parent [$results_notebook getframe $tabID]
return "$parent.results_frame"
}
proc Apol_Analysis::create_New_ResultsTab { } {
variable results_notebook
variable currTabCount
variable totalTabCount
variable pageNums
variable tabName
variable tabText
variable updateButton
variable bClose
if { $currTabCount >= $totalTabCount } {
tk_messageBox -icon error -type ok -title "Attention" \
-message "You have reached the maximum amount of tabs. Please delete a tab and try again."
return ""
}
incr currTabCount
incr pageNums
set resultNums [expr $pageNums-1]
$results_notebook insert end $tabName$pageNums -text $tabText$resultNums
set tab_frame [$results_notebook getframe $tabName$pageNums]
set results_frame [Apol_Analysis::create_results_frame $tab_frame]
if { $Apol_Analysis::initTab == 0 } {
$results_notebook compute_size
set Apol_Analysis::initTab 1
}
set newPageIdx [expr $currTabCount - 1]
set raisedPage [$results_notebook raise [$results_notebook page $newPageIdx]]
$updateButton configure -state normal
$bClose configure -state normal
return $results_frame
}
proc Apol_Analysis::create_empty_resultsTab { } {
variable results_notebook
variable currTabCount
variable totalTabCount
variable pageNums
variable tabName
variable tabText
variable updateButton
if { $currTabCount >= $totalTabCount } {
tk_messageBox -icon error -type ok -title "Attention" \
-message "You have reached the maximum amount of tabs. Please delete a tab and try again."
return ""
}
incr currTabCount
incr pageNums
$results_notebook insert end $Apol_Analysis::emptyTabID -text "Empty Tab"
set tab_frame [$results_notebook getframe $Apol_Analysis::emptyTabID]
set results_frame [Apol_Analysis::create_results_frame $tab_frame]
if { $Apol_Analysis::initTab == 0 } {
$results_notebook compute_size
set Apol_Analysis::initTab 1
}
set newPageIdx [expr $currTabCount - 1]
set raisedPage [$results_notebook raise [$results_notebook page $newPageIdx]]
$updateButton configure -state disabled
return $results_frame
}
proc Apol_Analysis::display_rename_tab_Dlg {pageID} {
variable new_tab_name
global tcl_platform
if {$pageID == $Apol_Analysis::emptyTabID} {
tk_messageBox -icon error -type ok -title "Rename Error" -message "Cannot rename the empty tab."
return -1
}
set rename_tab_Dlg [toplevel .rename_tab_Dlg]
wm protocol $rename_tab_Dlg WM_DELETE_WINDOW " "
wm withdraw $rename_tab_Dlg
wm title $rename_tab_Dlg "Rename results tab"
if {$tcl_platform(platform) == "windows"} {
wm resizable $rename_tab_Dlg 0 0
} else {
bind $rename_tab_Dlg <Configure> "wm geometry $rename_tab_Dlg {}"
}
set new_tab_name ""
set rename_tab_entryBox [entry $rename_tab_Dlg.gotoDlg_entryBox -bg white -textvariable Apol_Analysis::new_tab_name -width 10 ]
set lbl_goto [label $rename_tab_Dlg.lbl_goto -text "Tab name:"]
set b_ok [button $rename_tab_Dlg.ok -text "OK" -width 6 \
-command "Apol_Analysis::rename_ResultsTab $pageID; destroy $rename_tab_Dlg"]
set b_cancel [button $rename_tab_Dlg.cancel -text "Cancel" -width 6 -command "destroy $rename_tab_Dlg"]
pack $lbl_goto $rename_tab_entryBox -side left -padx 5 -pady 5 -anchor nw
pack $b_ok $b_cancel -side left -padx 5 -pady 5 -anchor ne
wm deiconify $rename_tab_Dlg
focus $rename_tab_entryBox
bind $rename_tab_Dlg <Return> "Apol_Analysis::rename_ResultsTab $pageID; destroy $rename_tab_Dlg"
wm protocol $rename_tab_Dlg WM_DELETE_WINDOW "destroy $rename_tab_Dlg"
return 0
}
proc Apol_Analysis::rename_ResultsTab {pageID} {
variable results_notebook
variable new_tab_name
if {$pageID == ""} {
return -1
} elseif {$new_tab_name == ""} {
tk_messageBox -icon error -type ok -title "Rename Error" -message "Must provide a tab name."
return -1
} elseif {$pageID == $Apol_Analysis::emptyTabID} {
tk_messageBox -icon error -type ok -title "Rename Error" -message "Cannot rename the empty tab."
return -1
}
$results_notebook itemconfigure $pageID -text $new_tab_name
return 0
}
proc Apol_Analysis::create_options_frame { parent } {
set tmp [frame $parent.inner_opt_frame]
pack $tmp -side left -fill both -anchor nw -expand yes
return $tmp
}
proc Apol_Analysis::clear_options_frame { opts_frame } {
set parent [winfo parent $opts_frame]
destroy $opts_frame
Apol_Analysis::create_options_frame $parent
return 0
}
proc Apol_Analysis::switch_results_tab { tabID } {
variable opts_frame
variable opts_frame
variable analysis_results_array
variable results_notebook
variable tab_deleted_flag
variable curr_analysis_module
variable raised_tab_analysis_type
variable updateButton
variable newButton
variable bClose
variable tabName
set tabID [ApolTop::get_tabname $tabID]
if { $tabID == $Apol_Analysis::emptyTabID } {
if { $curr_analysis_module != [$Apol_Analysis::analysis_listbox selection get]} {
Apol_Analysis::clear_options_frame $opts_frame
Apol_Analysis::display_mod_options $curr_analysis_module $opts_frame
}
$results_notebook raise $tabID
$updateButton configure -state disabled
$newButton configure -state normal
return 0
}
$updateButton configure -state normal
$bClose configure -state normal
set raised [$results_notebook raise]
if { $raised == $tabID && $tab_deleted_flag == 0 } {
return 0
}
if { $curr_analysis_module != $analysis_results_array($tabID,mod_name) } {
set curr_analysis_module $analysis_results_array($tabID,mod_name)
$Apol_Analysis::analysis_listbox selection set $curr_analysis_module
Apol_Analysis::clear_options_frame $opts_frame
Apol_Analysis::display_mod_options $curr_analysis_module $opts_frame
}
set raised_tab_analysis_type $curr_analysis_module
$results_notebook raise $tabID
Apol_Analysis::set_display_to_results_state $curr_analysis_module $analysis_results_array($tabID,query)
Apol_Analysis::set_Focus_to_Text $tabID
}
proc Apol_Analysis::set_Focus_to_Text { tab } {
variable results_notebook
variable analysis_results_array
if {$tab == $Apol_Analysis::emptyTabID} {
return
}
if {[array exists analysis_results_array]} {
set curr_analysis_module $analysis_results_array($tab,mod_name)
set txt [${curr_analysis_module}::get_results_raised_tab]
focus $txt
}
return 0
}
proc Apol_Analysis::store_current_results_state { raisedPage } {
variable curr_analysis_module
variable analysis_results_array
set query_options [Apol_Analysis::get_current_results_state]
array unset analysis_results_array "$raisedPage,*"
set analysis_results_array($raisedPage,query) $query_options
set analysis_results_array($raisedPage,mod_name) $curr_analysis_module
return 0
}
proc Apol_Analysis::display_new_content { } {
return 0
}
proc Apol_Analysis::display_mod_options { mod_name opts_frame } {
${mod_name}::display_mod_options $opts_frame
}
proc Apol_Analysis::reset_results_options { } {
return 0
}
proc Apol_Analysis::close_results_tab { } {
return 0
}
proc Apol_Analysis::remove_from_content_array { } {
return 0
}
proc Apol_Analysis::remove_tab { } {
return 0
}
proc Apol_Analysis::get_current_results_state { } {
variable curr_analysis_module
return [${curr_analysis_module}::get_current_results_state]
}
proc Apol_Analysis::save_query_options {file_channel query_file} {
variable curr_analysis_module
variable apol_analysis_query_id
set rt [catch {${curr_analysis_module}::save_query_options $curr_analysis_module $file_channel $query_file} err]
if {$rt != 0} {
return -code error $err
}
return 0
}
proc Apol_Analysis::load_query_options {file_channel parentDlg} {
variable curr_analysis_module
variable analysis_listbox
while {[eof $file_channel] != 1} {
gets $file_channel line
set tline [string trim $line]
if {[string compare -length 1 $tline "#"] == 0 || $tline == ""} {
continue
}
break
}
set module_name $tline
if {[lsearch -exact [$analysis_listbox items] $module_name] != -1} {
if {![string equal $curr_analysis_module $module_name]} {
Apol_Analysis::mod_select $module_name
}
set rt [catch {${module_name}::load_query_options $file_channel $parentDlg} err]
if {$rt != 0} {
return -code error $err
}
} else {
return -code error "The specified query is not a valid analysis module."
}
return 0
}
proc Apol_Analysis::set_display_to_results_state { mod_name query_options } {
variable analysis_listbox
$analysis_listbox selection set $mod_name
${mod_name}::set_display_to_results_state $query_options
return 0
}
proc Apol_Analysis::register_analysis_modules { mod_name desc_name } {
variable analysis_modules
set item_list [list $mod_name "$desc_name" ]
set analysis_modules [lappend analysis_modules $item_list]
return 0
}
proc Apol_Analysis::get_analysis_info {mod_name} {
set d_text [${mod_name}::get_analysis_info]
return $d_text
}
proc Apol_Analysis::get_results_raised_tab {} {
variable results_notebook
return [$results_notebook raise]
}
proc Apol_Analysis::display_analysis_info {} {
variable info_Dlg
variable curr_analysis_module
variable descrp_text
if { [winfo exists $info_Dlg] } {
destroy $info_Dlg
}
set descriptive_text [Apol_Analysis::get_analysis_info $curr_analysis_module]
toplevel $info_Dlg
wm protocol $info_Dlg WM_DELETE_WINDOW " "
wm withdraw $info_Dlg
wm title $info_Dlg "Analysis Description"
set topf [frame $info_Dlg.topf]
set botf [frame $info_Dlg.botf]
set sw [ScrolledWindow $topf.sw -auto none]
set descrp_text [text $sw.descrp_text -height 5 -width 20 -font $ApolTop::text_font \
-bg white -wrap word]
$sw setwidget $descrp_text
set b_ok [button $botf.b_ok -text "OK" -width 6 -command "destroy $Apol_Analysis::info_Dlg"]
pack $topf -side top -fill both -expand yes -padx 5 -pady 5
pack $botf -side bottom -anchor center
pack $b_ok -side left -anchor center -pady 2
pack $sw -side top -anchor nw -expand yes -fill both
$descrp_text insert 0.0 $descriptive_text
$descrp_text config -state disable
set width 600
set height 440
wm geom $info_Dlg ${width}x${height}
wm deiconify $info_Dlg
wm protocol $info_Dlg WM_DELETE_WINDOW "destroy $Apol_Analysis::info_Dlg"
return 0
}
proc Apol_Analysis::do_analysis { which } {
variable results_notebook
variable totalTabCount
variable currTabCount
variable enableUpdate
variable curr_analysis_module
variable raised_tab_analysis_type
variable analysis_listbox
variable keepmodselect
if { $curr_analysis_module == "" } {
tk_messageBox -icon error -type ok -title "Error" \
-message "You must select an analysis type."
return -1
}
set prev_raisedTab [$results_notebook raise]
ApolTop::setBusyCursor
switch $which {
new_analysis {
$Apol_Analysis::newButton configure -state disabled
update
if { $enableUpdate == 0 } {
$Apol_Analysis::updateButton configure -state normal
set enableUpdate 1
}
set results_frame [Apol_Analysis::create_New_ResultsTab]
}
update_analysis {
$Apol_Analysis::updateButton configure -state disabled
update
set results_frame [Apol_Analysis::get_results_frame [$results_notebook raise]]
set parent [winfo parent $results_frame]
Apol_Analysis::clear_results_frame $results_frame [$results_notebook raise]
Apol_Analysis::create_results_frame $parent
}
default {
ApolTop::resetBusyCursor
return -1
}
}
if {$results_frame != ""} {
ApolTop::disable_DeleteWindow_event
set rt [catch {${curr_analysis_module}::do_analysis $results_frame} err]
ApolTop::enable_DeleteWindow_event
if {$rt != 0 && $which == "new_analysis"} {
puts $err
ApolTop::resetBusyCursor
$Apol_Analysis::newButton configure -state normal
$Apol_Analysis::updateButton configure -state disabled
$results_notebook delete [$results_notebook raise]
set currTabCount [expr $currTabCount - 1]
Apol_Analysis::switch_results_tab $prev_raisedTab
return -1
} elseif {$rt != 0} {
set prev_Tab [$results_notebook pages \
[expr [$results_notebook index $prev_raisedTab] - 1]]
if {$prev_raisedTab != $Apol_Analysis::emptyTabID} {
$results_notebook delete $prev_raisedTab
set currTabCount [expr $currTabCount - 1]
Apol_Analysis::switch_results_tab $prev_Tab
}
}
set raised_tab_analysis_type $curr_analysis_module
Apol_Analysis::store_current_results_state [$results_notebook raise]
}
ApolTop::resetBusyCursor
$Apol_Analysis::newButton configure -state normal
$Apol_Analysis::updateButton configure -state normal
return 0
}
proc Apol_Analysis::order_analysis_listbox { analysis_listbox } {
set labels ""
foreach module [$analysis_listbox items] {
lappend labels "{[$analysis_listbox itemcget $module -text]} {$module}"
}
set labels [lsort -dictionary $labels]
set module_List ""
foreach module $labels {
lappend module_List [lindex $module end]
}
$analysis_listbox reorder $module_List
return 0
}
proc Apol_Analysis::configure_analysis_listbox { analysis_modules analysis_listbox } {
foreach mod_name $analysis_modules {
$analysis_listbox insert end [lindex $mod_name 0] \
-text [lindex $mod_name 1]
}
$analysis_listbox configure -redraw 1
return 0
}
proc Apol_Analysis::initialize { } {
variable analysis_modules
variable analysis_listbox
foreach mod_name $analysis_modules {
set mod_name [lindex $mod_name 0]
${mod_name}::initialize
}
Apol_Analysis::configure_analysis_listbox $analysis_modules $analysis_listbox
$analysis_listbox selection set [$analysis_listbox items 0]
if { [$analysis_listbox selection get] != "" } {
Apol_Analysis::mod_select [$analysis_listbox selection get]
}
return 0
}
proc Apol_Analysis::reset_to_initial_state { } {
$Apol_Analysis::updateButton configure -state disabled
Apol_Analysis::close_All_ResultsTabs
set Apol_Analysis::raised_tab_analysis_type ""
Apol_Analysis::create_empty_resultsTab
return 0
}
proc Apol_Analysis::open { } {
variable analysis_listbox
set selected_module [$analysis_listbox selection get]
if {$selected_module != ""} {
set rt [catch {${selected_module}::open} err]
if {$rt != 0} {
return -code error $err
}
}
return 0
}
proc Apol_Analysis::close { } {
variable analysis_modules
variable analysis_listbox
foreach mod_name $analysis_modules {
set mod_name [lindex $mod_name 0]
if {[$analysis_listbox selection get] == $mod_name} {
${mod_name}::close
}
}
Apol_Analysis::reset_to_initial_state
return 0
}
proc Apol_Analysis::discard_analysis_modules { } {
variable analysis_modules
set analysis_modules ""
return 0
}
proc Apol_Analysis::goto_line { line_num } {
return 0
}
proc Apol_Analysis::search { str case_Insensitive regExpr srch_Direction } {
return 0
}
proc Apol_Analysis::create { nb } {
variable results_notebook
variable analysis_listbox
variable opts_frame
variable newButton
variable updateButton
variable bClose
variable popupTab_Menu
variable tab_menu_callbacks
set frame [$nb insert end $ApolTop::analysis_tab -text "Analysis"]
set analysis_top_pane [PanedWindow $frame.pw1 -side left -weights available]
$analysis_top_pane add -weight 1
$analysis_top_pane add
set analysis_top_f [frame [$analysis_top_pane getframe 0].topf]
set botf [frame [$analysis_top_pane getframe 1].botf]
set pw2 [PanedWindow $analysis_top_f.pw -side top -weights available]
$pw2 add -weight 1
$pw2 add -weight 3
set t_left_f [TitleFrame [$pw2 getframe 0].t_left_f -text "Analysis Type"]
set title_opts_f [TitleFrame [$pw2 getframe 1].opts_frame -text "Analysis Options"]
set buttons_f [frame $analysis_top_f.buttons_f]
set b_title_f [TitleFrame $botf.b_title_f -text "Analysis Results"]
set b_topf [frame [$b_title_f getframe].b_topf]
set b_botf [frame [$b_title_f getframe].b_botf -relief sunken -bd 1]
pack $buttons_f -side right -fill y -anchor ne -padx 2 -pady 2
pack $analysis_top_pane -fill both -expand yes
pack $pw2 -fill both -expand 1
pack $analysis_top_f -side top -fill both -expand 1
pack $botf -side top -fill both -expand yes
pack $title_opts_f -side right -fill both -anchor ne -expand yes -padx 2
pack $t_left_f -side left -anchor nw -fill both -expand yes
pack $b_title_f -side left -fill both -anchor n -expand yes
pack $b_topf -side top -fill both -anchor nw -expand yes
pack $b_botf -side bottom -anchor center -fill x -padx 4 -pady 1
set newButton [button $buttons_f.new -text "New" \
-width 6 \
-command {Apol_Analysis::do_analysis "new_analysis"}]
set updateButton [button $buttons_f.upDate -text "Update" \
-width 6 \
-command {Apol_Analysis::do_analysis "update_analysis"} \
-state disabled]
set infoButton [button $buttons_f.infoButton -text "Info" \
-width 6 \
-command {Apol_Analysis::display_analysis_info}]
pack $newButton $updateButton $infoButton -side top -pady 5 -anchor ne
set opts_frame [Apol_Analysis::create_options_frame [$title_opts_f getframe]]
set sw_t [ScrolledWindow [$t_left_f getframe].sw -auto none]
set analysis_listbox [ListBox $sw_t.analysis_listbox \
-relief flat -borderwidth 0 -bg white \
-height 10 -highlightthickness 2 -width 25 -padx 0 \
-redraw 0 -selectmode single]
$sw_t setwidget $analysis_listbox
$analysis_listbox bindText <ButtonPress-1> { Apol_Analysis::mod_select }
set popupTab_Menu [menu .analysis_popup_Menu -tearoff 0]
set tab_menu_callbacks [lappend tab_menu_callbacks {"Delete Tab" "Apol_Analysis::delete_ResultsTab"}]
set tab_menu_callbacks [lappend tab_menu_callbacks {"Rename Tab" "Apol_Analysis::display_rename_tab_Dlg"}]
set results_notebook [NoteBook $b_topf.nb_results]
$results_notebook bindtabs <Button-3> {ApolTop::popup_Tab_Menu \
%W %x %y $Apol_Analysis::popupTab_Menu $Apol_Analysis::tab_menu_callbacks}
$results_notebook bindtabs <Button-1> {Apol_Analysis::switch_results_tab}
set bClose [button $b_botf.bClose -text "Close Tab" -command {
Apol_Analysis::delete_ResultsTab [$Apol_Analysis::results_notebook raise] }]
pack $bClose -side bottom -anchor center -fill x -padx 1 -pady 1
$results_notebook compute_size
pack $results_notebook -fill both -expand yes -padx 4
pack $sw_t -fill both -expand yes
Apol_Analysis::initialize
Apol_Analysis::create_empty_resultsTab
return $frame
}
namespace eval Apol_Analysis_dta {
variable combo_domain
variable combo_attribute
variable cb_attrib
variable entry_frame
variable forward_options_Dlg
set forward_options_Dlg .forward_options_Dlg
variable adv_frame
variable b_forward_options
variable cb_filters
variable progressDlg
set progressDlg .progress
variable progressmsg ""
variable progress_indicator -1
variable display_type ""
variable display_attribute ""
variable display_attrib_sel 0
variable display_direction "forward"
variable endtype_sel 0
variable end_type ""
variable use_filters 0
variable type_state ""
variable attribute_state ""
variable attrib_selected_state 0
variable direction_state "forward"
variable endtype_sel_state 0
variable end_type_state ""
variable use_filters_state 0
variable dta_tree ""
variable dta_info_text ""
variable f_opts
variable b_incl_all_perms
variable b_excl_all_perms
variable title_tag TITLE
variable title_type_tag TITLE_TYPE
variable subtitle_tag SUBTITLES
variable rules_tag RULES
variable counters_tag COUNTERS
variable types_tag TYPE
variable disabled_rule_tag DISABLE_RULE
variable excluded_tag " (Excluded)"
Apol_Analysis::register_analysis_modules "Apol_Analysis_dta" "Domain Transition"
variable descriptive_text "\n\nA forward domain transition analysis will determine all (target) \
domains to which a given (source) domain may transition. For a forward domain \
transition to be allowed, three forms of access must be granted:\n\n\ \
\t(1) source domain must have process transition permission for target domain,\n\
\t(2) source domain must have file execute permission for some entrypoint type, and\n\
\t(3) target domain must have file entrypoint permission for the same entrypoint type.\n\nA \
reverse domain transition analysis will determine all (source) domains that can transition to \
a given (target) domain. For a reverse domain transition to be allowed, three forms of access must be granted:\n\n\
\t(1) target domain must have process transition permission from the source domain,\n\
\t(2) target domain must have file entrypoint permission to some entrypoint type, and\n\
\t(3) source domain must have file execute permission to the same entrypoint type.\n\n\The \
results are presented in tree form. You can open target children domains to \
perform another domain transition analysis on that domain.\n\nFor additional \
help on this topic select \"Domain Transition Analysis\" from the help menu."
variable dta_root_text_f "\n\nThis tab provides the results of a forward domain transition analysis\
starting from the source domain type above. The results of this analysis are presented in tree form with the root\
of the tree (this node) being the start point for the analysis.\n\nEach child node in the tree represents\
a TARGET DOMAIN TYPE. A target domain type is a domain to which the source domain may transition. You can\
follow the domain transition tree by opening each subsequent generation of children in the tree.\n\nNOTE: For any\
given generation, if the parent and the child are the same, you cannot open the child. This avoids cyclic analyses.\n\nThe\
criteria that defines an allowed domain transition are:\n\n1) There must be at least one rule that allows TRANSITION\
access for PROCESS objects between the SOURCE and TARGET domain types.\n\n2) There must be at least one FILE TYPE that\
allows the TARGET type ENTRYPOINT access for FILE objects.\n\n3) There must be at least one FILE TYPE that meets\
criterion 2) above and allows the SOURCE type EXECUTE access for FILE objects.\n\nThe information window shows\
all the rules and file types that meet these criteria for each target domain type.\n\nFUTURE NOTE: In the future\
we also plan to show the type_transition rules that provide for a default domain transitions. While such rules\
cause a domain transition to occur by default, they do not allow it. Thus, associated type_transition rules\
are not truly part of the definition of allowed domain transitions."
variable dta_root_text_r "\n\nThis tab provides the results of a reverse domain transition analysis\
given the target domain type above. The results of this analysis are presented in tree form with the root\
of the tree (this node) being the target point of the analysis.\n\nEach child node in the tree represents\
a source DOMAIN TYPE. A source domain type is a domain that can transition to the target domain. You can\
follow the domain transition tree by opening each subsequent generation of children in the tree.\n\nNOTE: For any\
given generation, if the parent and the child are the same, you cannot open the child. This avoids cyclic analyses.\n\nThe\
criteria that defines an allowed domain transition are:\n\n1) There must be at least one rule that allows TRANSITION\
access for PROCESS objects between the SOURCE and TARGET domain types.\n\n2) There must be at least one FILE TYPE that\
allows the TARGET type ENTRYPOINT access for FILE objects.\n\n3) There must be at least one FILE TYPE that meets\
criterion 2) above and allows the SOURCE type EXECUTE access for FILE objects.\n\nThe information window shows\
all the rules and file types that meet these criteria for each source domain type.\n\nFUTURE NOTE: In the future\
we also plan to show the type_transition rules that provide for a default domain transitions. While such rules\
cause a domain transition to occur by default, they do not allow it. Thus, associated type_transition rules\
are not truly part of the definition of allowed domain transitions."
}
proc Apol_Analysis_dta::forward_options_update_dialog {path_name} {
variable f_opts
if {[array exists f_opts] && \
[array names f_opts "$path_name,name"] != "" &&
[winfo exists $f_opts($path_name,name)]} {
Apol_Analysis_dta::forward_options_set_widgets_to_default_state $path_name
raise $f_opts($path_name,name)
focus -force $f_opts($path_name,name)
if {$f_opts($path_name,class_selected_idx) != "-1"} {
$f_opts($path_name,class_listbox) selection set \
[$f_opts($path_name,class_listbox) index \
$f_opts($path_name,class_selected_idx)]
Apol_Analysis_dta::forward_options_display_permissions $path_name
}
}
}
proc Apol_Analysis_dta::forward_options_disable_perms_textbox {path_name} {
variable f_opts
Apol_Analysis_dta::forward_options_clear_perms_text $path_name
$f_opts($path_name,perms_box) configure -state disabled
}
proc Apol_Analysis_dta::forward_options_configure_class_perms_section {path_name} {
variable f_opts
variable b_incl_all_perms
variable b_excl_all_perms
if {[$f_opts($path_name,lbox_incl) get 0 end] == ""} {
$f_opts($path_name,class_listbox) selection clear 0 end
ApolTop::disable_tkListbox $f_opts($path_name,class_listbox)
bind $f_opts($path_name,class_listbox) <<ListboxSelect>> ""
Apol_Analysis_dta::forward_options_disable_perms_textbox $path_name
$b_incl_all_perms configure -state disabled
$b_excl_all_perms configure -state disabled
} else {
ApolTop::enable_tkListbox $f_opts($path_name,class_listbox)
bind $f_opts($path_name,class_listbox) <<ListboxSelect>> "Apol_Analysis_dta::forward_options_display_permissions $path_name"
$b_incl_all_perms configure -state normal
$b_excl_all_perms configure -state normal
$f_opts($path_name,class_listbox) selection set 0
Apol_Analysis_dta::forward_options_display_permissions $path_name
}
}
proc Apol_Analysis_dta::forward_options_include_types {remove_list_1 \
add_list_1 \
remove_lbox \
add_lbox \
master_incl_types_list_1 \
master_excl_types_list_1 \
path_name} {
upvar #0 $remove_list_1 remove_list
upvar #0 $add_list_1 add_list
upvar #0 $master_incl_types_list_1 master_incl_types_list
upvar #0 $master_excl_types_list_1 master_excl_types_list
set type_indices [$remove_lbox curselection]
if {$type_indices != ""} {
set tmp_list ""
foreach idx $type_indices {
set tmp_list [lappend tmp_list [$remove_lbox get $idx]]
}
foreach type $tmp_list {
set idx [lsearch -exact $remove_list $type]
if {$idx != -1} {
set remove_list [lreplace $remove_list $idx $idx]
set add_list [lappend add_list $type]
set add_list [lsort $add_list]
}
set master_incl_types_list [lappend master_incl_types_list $type]
set idx [lsearch -exact $master_excl_types_list $type]
if {$idx != -1} {
set master_excl_types_list [lreplace $master_excl_types_list $idx $idx]
}
}
$remove_lbox selection clear 0 end
}
Apol_Analysis_dta::forward_options_configure_class_perms_section $path_name
}
proc Apol_Analysis_dta::forward_options_exclude_types {remove_list_1 \
add_list_1 \
remove_lbox \
add_lbox \
master_incl_types_list_1 \
master_excl_types_list_1 \
path_name} {
upvar #0 $remove_list_1 remove_list
upvar #0 $add_list_1 add_list
upvar #0 $master_incl_types_list_1 master_incl_types_list
upvar #0 $master_excl_types_list_1 master_excl_types_list
set type_indices [$remove_lbox curselection]
if {$type_indices != ""} {
set tmp_list ""
foreach idx $type_indices {
set tmp_list [lappend tmp_list [$remove_lbox get $idx]]
}
foreach type $tmp_list {
set idx [lsearch -exact $remove_list $type]
if {$idx != -1} {
set remove_list [lreplace $remove_list $idx $idx]
set add_list [lappend add_list $type]
set add_list [lsort $add_list]
}
set master_excl_types_list [lappend master_excl_types_list $type]
set idx [lsearch -exact $master_incl_types_list $type]
if {$idx != -1} {
set master_incl_types_list [lreplace $master_incl_types_list $idx $idx]
}
}
$remove_lbox selection clear 0 end
}
Apol_Analysis_dta::forward_options_configure_class_perms_section $path_name
}
proc Apol_Analysis_dta::forward_options_configure_combo_state {cb_selected_1 combo_box lbox which_list path_name} {
variable f_opts
upvar #0 $cb_selected_1 cb_selected
if {$cb_selected} {
$combo_box configure -state normal -entrybg white
if {$which_list == "incl"} {
Apol_Analysis_dta::forward_options_filter_types_using_attrib \
Apol_Analysis_dta::f_opts($path_name,incl_attrib_combo_value) \
$lbox \
Apol_Analysis_dta::f_opts($path_name,master_incl_types_list)
} else {
Apol_Analysis_dta::forward_options_filter_types_using_attrib \
Apol_Analysis_dta::f_opts($path_name,excl_attrib_combo_value) \
$lbox \
Apol_Analysis_dta::f_opts($path_name,master_excl_types_list)
}
} else {
$combo_box configure -state disabled -entrybg $ApolTop::default_bg_color
if {$which_list == "incl"} {
set [$lbox cget -listvar] \
[lsort $Apol_Analysis_dta::f_opts($path_name,master_incl_types_list)]
} elseif {$which_list == "excl"} {
set [$lbox cget -listvar] \
[lsort $Apol_Analysis_dta::f_opts($path_name,master_excl_types_list)]
} else {
tk_messageBox -icon error -type ok -title "Error" \
-message "Invalid paremeter ($which_list) \
to Apol_Analysis_dta::forward_options_configure_combo_state. \
Must be either 'incl' or 'excl'"
return -1
}
}
return 0
}
proc Apol_Analysis_dta::forward_options_filter_types_using_attrib {attribute_1 lbox non_filtered_types_1} {
upvar #0 $attribute_1 attribute
upvar #0 $non_filtered_types_1 non_filtered_types
if {$attribute != ""} {
$lbox delete 0 end
set rt [catch {set attrib_types [apol_GetAttribTypesList $attribute]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
if {$non_filtered_types != ""} {
for {set i 0} {$i < [llength $non_filtered_types]} {incr i} {
set idx [lsearch -exact $attrib_types [lindex $non_filtered_types $i]]
if {$idx != -1} {
$lbox insert end [lindex $non_filtered_types $i]
}
}
}
}
return 0
}
proc Apol_Analysis_dta::forward_options_include_exclude_permissions {which path_name} {
variable f_opts
if {[ApolTop::is_policy_open]} {
if {[string equal $which "include"] == 0 && [string equal $which "exclude"] == 0} {
puts "Tcl error: wrong 'which' argument sent to \
Apol_Analysis_dta::forward_options_include_exclude_permissions. \
Must be either 'include' or 'exclude'."
return -1
}
set objs [$f_opts($path_name,class_listbox) curselection]
foreach object_class_idx $objs {
set object_class [$f_opts($path_name,class_listbox) get $object_class_idx]
set idx [string first $Apol_Analysis_dta::excluded_tag $object_class]
if {$idx != -1} {
set object_class [string range $object_class 0 [expr $idx - 1]]
}
set rt [catch {set perms_list [apol_GetPermsByClass $object_class 1]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
foreach perm $perms_list {
set f_opts($path_name,perm_status_array,$object_class,$perm) $which
}
if {$object_class_idx != ""} {
set items [$f_opts($path_name,class_listbox) get 0 end]
if {[string equal $which "exclude"]} {
$f_opts($path_name,class_listbox) itemconfigure \
$object_class_idx -foreground gray
set [$f_opts($path_name,class_listbox) cget -listvar] \
[lreplace $items $object_class_idx \
$object_class_idx \
"$object_class$Apol_Analysis_dta::excluded_tag"]
} else {
$f_opts($path_name,class_listbox) itemconfigure \
$object_class_idx \
-foreground $f_opts($path_name,select_fg_orig)
set [$f_opts($path_name,class_listbox) cget -listvar] \
[lreplace $items $object_class_idx \
$object_class_idx "$object_class"]
}
}
if {$f_opts($path_name,class_selected_idx) == $object_class_idx} {
set obj [$f_opts($path_name,class_listbox) get $object_class_idx]
$f_opts($path_name,permissions_title_frame) configure \
-text "Permissions for $obj:"
}
}
}
return 0
}
proc Apol_Analysis_dta::forward_options_change_obj_state_on_perm_select {path_name} {
variable f_opts
set num_excluded 0
if {$f_opts($path_name,class_selected_idx) != "-1"} {
set class_sel [$f_opts($path_name,class_listbox) get $f_opts($path_name,class_selected_idx)]
set idx [string first $Apol_Analysis_dta::excluded_tag $class_sel]
if {$idx != -1} {
set class_sel [string range $class_sel 0 [expr $idx - 1]]
}
set class_elements [array get f_opts "$path_name,perm_status_array,$class_sel,*"]
if {$class_elements != ""} {
set num_perms_for_class [expr [llength $class_elements] / 2]
set len [llength $class_elements]
for {set i 0} {$i < $len} {incr i} {
incr i
if {[string equal [lindex $class_elements $i] "exclude"]} {
incr num_excluded
}
}
set items [$f_opts($path_name,class_listbox) get 0 end]
if {$num_excluded == $num_perms_for_class} {
$f_opts($path_name,class_listbox) itemconfigure \
$f_opts($path_name,class_selected_idx) -foreground gray
set [$f_opts($path_name,class_listbox) cget -listvar] \
[lreplace $items $f_opts($path_name,class_selected_idx) \
$f_opts($path_name,class_selected_idx) \
"$class_sel$Apol_Analysis_dta::excluded_tag"]
} else {
$f_opts($path_name,class_listbox) itemconfigure \
$f_opts($path_name,class_selected_idx) \
-foreground $f_opts($path_name,select_fg_orig)
set [$f_opts($path_name,class_listbox) cget -listvar] \
[lreplace $items $f_opts($path_name,class_selected_idx) \
$f_opts($path_name,class_selected_idx) "$class_sel"]
}
$f_opts($path_name,permissions_title_frame) configure \
-text "Permissions for [$f_opts($path_name,class_listbox) get \
$f_opts($path_name,class_selected_idx)]:"
}
}
return 0
}
proc Apol_Analysis_dta::forward_options_embed_perm_buttons {list_b class perm path_name} {
variable f_opts
set frame [frame $list_b.f:$class:$perm -bd 0 -bg white]
set lbl_frame [frame $frame.lbl_frame:$class:$perm -width 20 -bd 1 -bg white]
set cb_frame [frame $frame.cb_frame:$class:$perm -width 10 -bd 0 -bg white]
set lbl1 [label $lbl_frame.lbl1:$class:$perm -bg white -justify left -width 20 \
-anchor nw -text $perm]
set lbl2 [label $lbl_frame.lbl2:$class:$perm -bg white -justify left -width 5 -text "--->"]
set cb_include [radiobutton $cb_frame.cb_include:$class:$perm -bg white \
-value include -text "Include" \
-highlightthickness 0 \
-variable Apol_Analysis_dta::f_opts($path_name,perm_status_array,$class,$perm) \
-command "Apol_Analysis_dta::forward_options_change_obj_state_on_perm_select \
$path_name"]
set cb_exclude [radiobutton $cb_frame.cb_exclude:$class:$perm -bg white \
-value exclude -text "Exclude" \
-highlightthickness 0 \
-variable Apol_Analysis_dta::f_opts($path_name,perm_status_array,$class,$perm) \
-command "Apol_Analysis_dta::forward_options_change_obj_state_on_perm_select \
$path_name"]
pack $frame -side left -anchor nw -expand yes -pady 10
pack $lbl_frame $cb_frame -side left -anchor nw -expand yes
pack $lbl1 $lbl2 -side left -anchor nw
pack $cb_include $cb_exclude -side left -anchor nw
return $frame
}
proc Apol_Analysis_dta::forward_options_clear_perms_text {path_name} {
variable f_opts
$f_opts($path_name,perms_box) configure -state normal
set names [$f_opts($path_name,perms_box) window names]
foreach emb_win $names {
if { [winfo exists $emb_win] } {
set rt [catch {destroy $emb_win} err]
if {$rt != 0} {
tk_messageBox \
-icon error \
-type ok \
-title "Error" \
-message "$err"
return -1
}
}
}
$f_opts($path_name,perms_box) delete 1.0 end
$f_opts($path_name,perms_box) configure -state disabled
return 0
}
proc Apol_Analysis_dta::render_permissions {path_name} {
variable f_opts
set class_idx [$f_opts($path_name,class_listbox) curselection]
if {$class_idx == ""} {
return 0
}
focus -force $f_opts($path_name,class_listbox)
set class_name [$f_opts($path_name,class_listbox) get $class_idx]
$f_opts($path_name,permissions_title_frame) configure -text "Permissions for $class_name:"
Apol_Analysis_dta::forward_options_clear_perms_text $path_name
update
set idx [string first $Apol_Analysis_dta::excluded_tag $class_name]
if {$idx != -1} {
set class_name [string range $class_name 0 [expr $idx - 1]]
}
set rt [catch {set perms_list [apol_GetPermsByClass $class_name 1]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "$err"
return -1
}
set perms_list [lsort $perms_list]
$f_opts($path_name,perms_box) configure -state normal
foreach perm $perms_list {
if {[array names f_opts "$path_name,perm_status_array,$class_name,$perm"] == ""} {
set f_opts($path_name,perm_status_array,$class_name,$perm) include
}
$f_opts($path_name,perms_box) window create end -window \
[Apol_Analysis_dta::forward_options_embed_perm_buttons \
$f_opts($path_name,perms_box) $class_name $perm $path_name]
$f_opts($path_name,perms_box) insert end "\n"
}
$f_opts($path_name,perms_box) configure -state disabled
}
proc Apol_Analysis_dta::forward_options_display_permissions {path_name} {
variable f_opts
if {[$f_opts($path_name,class_listbox) get 0 end] == "" || \
[llength [$f_opts($path_name,class_listbox) curselection]] > 1} {
return
}
bind $f_opts($path_name,class_listbox) <<ListboxSelect>> ""
set f_opts($path_name,class_selected_idx) [$f_opts($path_name,class_listbox) curselection]
event generate $f_opts($path_name,perms_box) <<Rendering>> -when now
update idletasks
bind $f_opts($path_name,class_listbox) <<ListboxSelect>> "Apol_Analysis_dta::forward_options_display_permissions $path_name"
}
proc Apol_Analysis_dta::forward_options_initialize_objs_and_perm_filters {path_name} {
variable f_opts
set f_opts($path_name,class_list) $Apol_Class_Perms::class_list
foreach class $f_opts($path_name,class_list) {
set rt [catch {set perms_list [apol_GetPermsByClass $class 1]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
foreach perm $perms_list {
set f_opts($path_name,perm_status_array,$class,$perm) include
}
}
return 0
}
proc Apol_Analysis_dta::forward_options_initialize_vars {path_name} {
variable f_opts
if {$f_opts($path_name,filter_vars_init) == 0} {
Apol_Analysis_dta::forward_options_initialize_objs_and_perm_filters $path_name
set f_opts($path_name,master_excl_types_list) $Apol_Types::typelist
set idx [lsearch -exact $f_opts($path_name,master_excl_types_list) "self"]
if {$idx != -1} {
set f_opts($path_name,master_excl_types_list) \
[lreplace $f_opts($path_name,master_excl_types_list) \
$idx $idx]
}
set f_opts($path_name,master_incl_types_list) ""
set f_opts($path_name,filtered_incl_types) $f_opts($path_name,master_incl_types_list)
set f_opts($path_name,filtered_excl_types) $f_opts($path_name,master_excl_types_list)
set f_opts($path_name,filter_vars_init) 1
}
return 0
}
proc Apol_Analysis_dta::forward_options_set_widgets_to_default_state {path_name} {
variable f_opts
$f_opts($path_name,combo_incl) configure -values $Apol_Types::attriblist
$f_opts($path_name,combo_excl) configure -values $Apol_Types::attriblist
$f_opts($path_name,combo_excl) configure -text $f_opts($path_name,excl_attrib_combo_value)
$f_opts($path_name,combo_incl) configure -text $f_opts($path_name,incl_attrib_combo_value)
set f_opts($path_name,select_fg_orig) [$f_opts($path_name,class_listbox) cget -foreground]
set class_lbox_idx 0
foreach class $f_opts($path_name,class_list) {
set idx [string first $Apol_Analysis_dta::excluded_tag $class]
if {$idx != -1} {
set class [string range $class 0 [expr $idx - 1]]
}
set num_excluded 0
set class_perms [array names f_opts "$path_name,perm_status_array,$class,*"]
foreach element $class_perms {
if {[string equal $f_opts($element) "exclude"]} {
incr num_excluded
}
}
if {$num_excluded == [llength $class_perms]} {
set [$f_opts($path_name,class_listbox) cget -listvar] \
[lreplace $f_opts($path_name,class_list) $class_lbox_idx $class_lbox_idx \
"$class$Apol_Analysis_dta::excluded_tag"]
$f_opts($path_name,class_listbox) itemconfigure $class_lbox_idx -foreground gray
} else {
set [$f_opts($path_name,class_listbox) cget -listvar] \
[lreplace $f_opts($path_name,class_list) $class_lbox_idx $class_lbox_idx "$class"]
$f_opts($path_name,class_listbox) itemconfigure $class_lbox_idx \
-foreground $f_opts($path_name,select_fg_orig)
}
incr class_lbox_idx
}
update
Apol_Analysis_dta::forward_options_configure_combo_state \
Apol_Analysis_dta::f_opts($path_name,incl_attrib_cb_sel) \
$f_opts($path_name,combo_incl) \
$f_opts($path_name,lbox_incl) \
incl \
$path_name
Apol_Analysis_dta::forward_options_configure_combo_state \
Apol_Analysis_dta::f_opts($path_name,excl_attrib_cb_sel) \
$f_opts($path_name,combo_excl) \
$f_opts($path_name,lbox_excl) \
excl \
$path_name
Apol_Analysis_dta::forward_options_configure_class_perms_section $path_name
}
proc Apol_Analysis_dta::forward_options_destroy_all_dialogs_on_open {} {
variable f_opts
set dlgs [array get f_opts "*,name"]
set length [llength $dlgs]
for {set i 0} {$i < $length} {incr i} {
incr i
Apol_Analysis_dta::forward_options_destroy_dialog [lindex $dlgs $i]
Apol_Analysis_dta::forward_options_destroy_object [lindex $dlgs $i]
}
array unset f_opts
return 0
}
proc Apol_Analysis_dta::forward_options_destroy_dialog {path_name} {
variable f_opts
if {[winfo exists $path_name]} {
destroy $path_name
unset f_opts($path_name,lbox_incl)
unset f_opts($path_name,lbox_excl)
unset f_opts($path_name,combo_incl)
unset f_opts($path_name,combo_excl)
unset f_opts($path_name,class_listbox)
unset f_opts($path_name,perms_box)
unset f_opts($path_name,permissions_title_frame)
}
return 0
}
proc Apol_Analysis_dta::forward_options_create_object {path_name} {
variable f_opts
set f_opts($path_name,name) $path_name
set f_opts($path_name,filtered_incl_types) ""
set f_opts($path_name,filtered_excl_types) ""
set f_opts($path_name,master_incl_types_list) ""
set f_opts($path_name,master_excl_types_list) ""
set f_opts($path_name,class_list) ""
set f_opts($path_name,incl_attrib_combo_value) ""
set f_opts($path_name,excl_attrib_combo_value) ""
set f_opts($path_name,incl_attrib_cb_sel) 0
set f_opts($path_name,excl_attrib_cb_sel) 0
set f_opts($path_name,filter_vars_init) 0
set f_opts($path_name,class_selected_idx) -1
set rt [catch {Apol_Analysis_dta::forward_options_initialize_vars $path_name} err]
if {$rt != 0} {
puts "Error: $err"
return -1
}
return 0
}
proc Apol_Analysis_dta::forward_options_copy_object {path_name new_object} {
variable f_opts
upvar 1 $new_object object
if {![array exists f_opts] || [array names f_opts "$path_name,name"] == ""} {
Apol_Analysis_dta::forward_options_create_object $path_name
}
array set object [array get f_opts "$path_name,*"]
return 0
}
proc Apol_Analysis_dta::forward_options_destroy_object {path_name} {
variable f_opts
if {[array exists f_opts] && [array names f_opts "$path_name,name"] != ""} {
array unset f_opts "$path_name,perm_status_array,*"
unset f_opts($path_name,filtered_incl_types)
unset f_opts($path_name,filtered_excl_types)
unset f_opts($path_name,master_incl_types_list)
unset f_opts($path_name,master_excl_types_list)
unset f_opts($path_name,class_list)
unset f_opts($path_name,incl_attrib_combo_value)
unset f_opts($path_name,excl_attrib_combo_value)
unset f_opts($path_name,incl_attrib_cb_sel)
unset f_opts($path_name,excl_attrib_cb_sel)
unset f_opts($path_name,filter_vars_init)
unset f_opts($path_name,class_selected_idx)
unset f_opts($path_name,name)
}
return 0
}
proc Apol_Analysis_dta::forward_options_refresh_dialog {path_name} {
if {[array exists f_opts] && \
[array names f_opts "$path_name,name"] != ""} {
Apol_Analysis_dta::forward_options_destroy_object $path_name
Apol_Analysis_dta::forward_options_create_object $path_name
Apol_Analysis_dta::forward_options_update_dialog $path_name
}
}
proc Apol_Analysis_dta::forward_options_select_all_lbox_items {lbox} {
$lbox selection set 0 end
return 0
}
proc Apol_Analysis_dta::forward_options_clear_all_lbox_items {lbox} {
$lbox selection clear 0 end
return 0
}
proc Apol_Analysis_dta::forward_options_create_dialog {path_name title_txt} {
variable f_opts
variable b_incl_all_perms
variable b_excl_all_perms
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened!"
return -1
}
if {[array exists f_opts] && \
[array names f_opts "$path_name,name"] != ""} {
if {[winfo exists $f_opts($path_name,name)]} {
raise $f_opts($path_name,name)
focus $f_opts($path_name,name)
return 0
}
} else {
Apol_Analysis_dta::forward_options_create_object $path_name
}
toplevel $f_opts($path_name,name)
wm withdraw $f_opts($path_name,name)
wm title $f_opts($path_name,name) $title_txt
wm protocol $f_opts($path_name,name) WM_DELETE_WINDOW " "
set close_frame [frame $f_opts($path_name,name).close_frame -relief sunken -bd 1]
set topf [frame $f_opts($path_name,name).topf]
set pw1 [PanedWindow $topf.pw1 -side left -weights available]
$pw1 add -weight 2
$pw1 add -weight 2
pack $close_frame -side bottom -anchor center -pady 2
pack $pw1 -fill both -expand yes
pack $topf -fill both -expand yes -padx 10 -pady 10
set objs_frame [TitleFrame [$pw1 getframe 1].objs_frame -text "Filter target domains by object class access:"]
set types_frame [TitleFrame [$pw1 getframe 0].types_frame -text "Filter target domains by object type(s) access:"]
set top_lbl [Label [$objs_frame getframe].top_lbl -justify left -font $ApolTop::dialog_font \
-text "Configure the query to search for transitions to domains with access to specific object classes:"]
set bot_lbl [Label [$types_frame getframe].bot_lbl -justify left -font $ApolTop::dialog_font \
-text "Configure the query to search for transitions to domains with access to specific object types:"]
pack $top_lbl $bot_lbl -side top -anchor nw -pady 3
set pw1 [PanedWindow [$objs_frame getframe].pw -side top -weights available]
set pane [$pw1 add]
set search_pane [$pw1 add]
set pw2 [PanedWindow $pane.pw -side left -weights available]
set class_pane [$pw2 add]
set classes_box [TitleFrame $class_pane.tbox -text "Object Classes:" -bd 0]
set f_opts($path_name,permissions_title_frame) [TitleFrame $search_pane.rbox -text "Permissions:" -bd 0]
set sw_class [ScrolledWindow [$classes_box getframe].sw -auto none]
set f_opts($path_name,class_listbox) [listbox [$sw_class getframe].lb \
-height 10 -highlightthickness 0 \
-bg white -selectmode extended \
-listvar Apol_Analysis_dta::f_opts($path_name,class_list) \
-exportselection 0]
$sw_class setwidget $f_opts($path_name,class_listbox)
set sw_list [ScrolledWindow [$f_opts($path_name,permissions_title_frame) getframe].sw_c -auto none]
set f_opts($path_name,perms_box) [text [$f_opts($path_name,permissions_title_frame) getframe].perms_box \
-cursor $ApolTop::prevCursor \
-bg white -font $ApolTop::text_font]
$sw_list setwidget $f_opts($path_name,perms_box)
bind $f_opts($path_name,perms_box) <<Rendering>> \
"Apol_Analysis_dta::render_permissions $path_name"
set bframe [frame [$f_opts($path_name,permissions_title_frame) getframe].bframe]
set b_incl_all_perms [Button $bframe.b_incl_all_perms -text "Include All Perms" \
-helptext "Select this to include all permissions for the selected object in the query." \
-command "Apol_Analysis_dta::forward_options_include_exclude_permissions \
include $path_name"]
set b_excl_all_perms [Button $bframe.b_excl_all_perms -text "Exclude All Perms" \
-helptext "Select this to exclude all permissions for the selected object from the query." \
-command "Apol_Analysis_dta::forward_options_include_exclude_permissions \
exclude $path_name"]
bind $f_opts($path_name,class_listbox) <<ListboxSelect>> \
"Apol_Analysis_dta::forward_options_display_permissions $path_name"
bind $f_opts($path_name,class_listbox) <Double-Button-1> ""
bind $f_opts($path_name,class_listbox) <Triple-Button-1> ""
bind $f_opts($path_name,class_listbox) <Quadruple-Button-1> ""
pack $classes_box -padx 2 -side left -fill both -expand yes
pack $f_opts($path_name,permissions_title_frame) -pady 2 -padx 2 -fill both -expand yes
pack $pw1 -fill both -expand yes
pack $pw2 -fill both -expand yes
pack $b_excl_all_perms -side right -anchor nw -pady 2 -expand yes -fill x
pack $b_incl_all_perms -side left -anchor nw -pady 2 -expand yes -fill x
pack $topf -fill both -expand yes -padx 10 -pady 10
pack $sw_class -fill both -expand yes -side top
pack $bframe -side bottom -fill both -anchor sw -pady 2
pack $sw_list -fill both -expand yes -side top
set include_f [TitleFrame [$types_frame getframe].include_f -text "Include these types:" -bd 0]
set middle_f [frame [$types_frame getframe].middle_f]
set exclude_f [TitleFrame [$types_frame getframe].exclude_f -text "Exclude these types:" -bd 0]
set b_incl_f [frame [$include_f getframe].b_incl_f]
set b_excl_f [frame [$exclude_f getframe].b_excl_f]
set buttons_incl_f [frame $b_incl_f.buttons_incl_f]
set buttons_excl_f [frame $b_excl_f.buttons_excl_f]
set sw_incl [ScrolledWindow [$include_f getframe].sw_incl]
set sw_excl [ScrolledWindow [$exclude_f getframe].sw_excl]
set f_opts($path_name,lbox_incl) [listbox [$sw_incl getframe].lbox_incl -height 6 \
-highlightthickness 0 -listvar Apol_Analysis_dta::f_opts($path_name,filtered_incl_types) \
-selectmode extended -bg white -exportselection 0]
set f_opts($path_name,lbox_excl) [listbox [$sw_excl getframe].lbox_excl -height 6 \
-highlightthickness 0 -listvar Apol_Analysis_dta::f_opts($path_name,filtered_excl_types) \
-selectmode extended -bg white -exportselection 0]
$sw_incl setwidget $f_opts($path_name,lbox_incl)
$sw_excl setwidget $f_opts($path_name,lbox_excl)
bind $f_opts($path_name,lbox_incl) <<ListboxSelect>> "focus -force $f_opts($path_name,lbox_incl)"
bind $f_opts($path_name,lbox_excl) <<ListboxSelect>> "focus -force $f_opts($path_name,lbox_excl)"
bind $f_opts($path_name,lbox_incl) <KeyPress> "ApolTop::tklistbox_select_on_key_callback \
$Apol_Analysis_dta::f_opts($path_name,lbox_incl) \
Apol_Analysis_dta::f_opts($path_name,filtered_incl_types) \
%K"
bind $f_opts($path_name,lbox_excl) <KeyPress> "ApolTop::tklistbox_select_on_key_callback \
$Apol_Analysis_dta::f_opts($path_name,lbox_excl) \
Apol_Analysis_dta::f_opts($path_name,filtered_excl_types) \
%K"
set include_bttn [Button $middle_f.include_bttn -text "<--" \
-helptext "Include this type in the query" -width 8 \
-command "Apol_Analysis_dta::forward_options_include_types \
Apol_Analysis_dta::f_opts($path_name,filtered_excl_types) \
Apol_Analysis_dta::f_opts($path_name,filtered_incl_types) \
$Apol_Analysis_dta::f_opts($path_name,lbox_excl) \
$Apol_Analysis_dta::f_opts($path_name,lbox_incl) \
Apol_Analysis_dta::f_opts($path_name,master_incl_types_list) \
Apol_Analysis_dta::f_opts($path_name,master_excl_types_list) \
$path_name"]
set exclude_bttn [Button $middle_f.exclude_bttn -text "-->" \
-helptext "Exclude this type from the query" -width 8 \
-command "Apol_Analysis_dta::forward_options_exclude_types \
Apol_Analysis_dta::f_opts($path_name,filtered_incl_types) \
Apol_Analysis_dta::f_opts($path_name,filtered_excl_types) \
$Apol_Analysis_dta::f_opts($path_name,lbox_incl) \
$Apol_Analysis_dta::f_opts($path_name,lbox_excl) \
Apol_Analysis_dta::f_opts($path_name,master_incl_types_list) \
Apol_Analysis_dta::f_opts($path_name,master_excl_types_list) \
$path_name"]
set b_incl_all_sel [Button $buttons_incl_f.b_incl_all_sel -text "Select All" \
-command "Apol_Analysis_dta::forward_options_select_all_lbox_items \
$Apol_Analysis_dta::f_opts($path_name,lbox_incl)"]
set b_incl_all_clear [Button $buttons_incl_f.b_incl_all_clear -text "Unselect" \
-command "Apol_Analysis_dta::forward_options_clear_all_lbox_items \
$Apol_Analysis_dta::f_opts($path_name,lbox_incl)"]
set b_excl_all_sel [Button $buttons_excl_f.b_excl_all_sel -text "Select All" \
-command "Apol_Analysis_dta::forward_options_select_all_lbox_items \
$Apol_Analysis_dta::f_opts($path_name,lbox_excl)"]
set b_excl_all_clear [Button $buttons_excl_f.b_excl_all_clear -text "Unselect" \
-command "Apol_Analysis_dta::forward_options_clear_all_lbox_items \
$Apol_Analysis_dta::f_opts($path_name,lbox_excl)"]
set f_opts($path_name,combo_incl) [ComboBox $b_incl_f.combo_incl \
-editable 0 \
-textvariable Apol_Analysis_dta::f_opts($path_name,incl_attrib_combo_value) \
-entrybg $ApolTop::default_bg_color \
-modifycmd "Apol_Analysis_dta::forward_options_filter_types_using_attrib \
Apol_Analysis_dta::f_opts($path_name,incl_attrib_combo_value) \
$Apol_Analysis_dta::f_opts($path_name,lbox_incl) \
Apol_Analysis_dta::f_opts($path_name,master_incl_types_list)"]
set f_opts($path_name,combo_excl) [ComboBox [$exclude_f getframe].combo_excl \
-editable 0 \
-textvariable Apol_Analysis_dta::f_opts($path_name,excl_attrib_combo_value) \
-entrybg $ApolTop::default_bg_color \
-modifycmd "Apol_Analysis_dta::forward_options_filter_types_using_attrib \
Apol_Analysis_dta::f_opts($path_name,excl_attrib_combo_value) \
$Apol_Analysis_dta::f_opts($path_name,lbox_excl) \
Apol_Analysis_dta::f_opts($path_name,master_excl_types_list)"]
set cb_incl_attrib [checkbutton $b_incl_f.cb_incl_attrib \
-text "Filter included type(s) by attribute:" \
-variable Apol_Analysis_dta::f_opts($path_name,incl_attrib_cb_sel) \
-offvalue 0 -onvalue 1 \
-command "Apol_Analysis_dta::forward_options_configure_combo_state \
Apol_Analysis_dta::f_opts($path_name,incl_attrib_cb_sel) \
$Apol_Analysis_dta::f_opts($path_name,combo_incl) \
$Apol_Analysis_dta::f_opts($path_name,lbox_incl) \
incl \
$path_name"]
set cb_excl_attrib [checkbutton [$exclude_f getframe].cb_excl_attrib \
-text "Filter excluded type(s) by attribute:" \
-variable Apol_Analysis_dta::f_opts($path_name,excl_attrib_cb_sel) \
-offvalue 0 -onvalue 1 \
-command "Apol_Analysis_dta::forward_options_configure_combo_state \
Apol_Analysis_dta::f_opts($path_name,excl_attrib_cb_sel) \
$Apol_Analysis_dta::f_opts($path_name,combo_excl) \
$Apol_Analysis_dta::f_opts($path_name,lbox_excl) \
excl \
$path_name"]
set close_bttn [Button $close_frame.close_bttn -text "Close" -width 8 \
-command "Apol_Analysis_dta::forward_options_destroy_dialog $f_opts($path_name,name)"]
pack $close_bttn -side left -anchor center
pack $b_excl_f -side bottom -anchor center -pady 2
pack $buttons_excl_f -side bottom -anchor center -pady 2
pack $b_excl_all_sel $b_excl_all_clear -side left -anchor center -expand yes -pady 2
pack $sw_excl -side top -anchor nw -fill both -expand yes -pady 2 -padx 6
pack $cb_excl_attrib -side top -anchor center -padx 6
pack $f_opts($path_name,combo_excl) -side top -anchor center -pady 2 -padx 15
pack $b_incl_f -side bottom -anchor center -pady 2
pack $buttons_incl_f -side bottom -anchor center -pady 2
pack $b_incl_all_sel $b_incl_all_clear -side left -anchor center -expand yes -pady 2
pack $sw_incl -side top -anchor nw -fill both -expand yes -pady 2 -padx 6
pack $cb_incl_attrib -side top -anchor center -padx 6
pack $f_opts($path_name,combo_incl) -side top -anchor center -pady 2 -padx 15
pack $include_bttn $exclude_bttn -side top -pady 2 -anchor center
pack $include_f $exclude_f -side left -anchor nw -fill both -expand yes
pack $middle_f -side left -anchor center -after $include_f -padx 5 -expand yes
pack $objs_frame $types_frame -side top -anchor nw -padx 5 -pady 2 -expand yes -fill both
set width 780
set height 750
wm geom $f_opts($path_name,name) ${width}x${height}
wm deiconify $f_opts($path_name,name)
focus $f_opts($path_name,name)
Apol_Analysis_dta::forward_options_set_widgets_to_default_state $path_name
wm protocol $f_opts($path_name,name) WM_DELETE_WINDOW \
"Apol_Analysis_dta::forward_options_destroy_dialog $path_name"
return 0
}
proc Apol_Analysis_dta::close { } {
Apol_Analysis_dta::reset_variables
$Apol_Analysis_dta::combo_attribute configure -values ""
$Apol_Analysis_dta::combo_domain configure -values ""
$Apol_Analysis_dta::combo_attribute configure -state disabled -entrybg $ApolTop::default_bg_color
Apol_Analysis_dta::configure_widgets_for_dta_direction
Apol_Analysis_dta::config_attrib_comboBox_state
Apol_Analysis_dta::config_endtype_state
Apol_Analysis_dta::forward_options_destroy_all_dialogs_on_open
}
proc Apol_Analysis_dta::open { } {
Apol_Analysis_dta::populate_ta_list
Apol_Analysis_dta::change_types_list
return 0
}
proc Apol_Analysis_dta::initialize { } {
return 0
}
proc Apol_Analysis_dta::get_analysis_info { } {
return $Apol_Analysis_dta::descriptive_text
}
proc Apol_Analysis_dta::get_results_raised_tab {} {
return $Apol_Analysis_dta::dta_info_text
}
proc Apol_Analysis_dta::display_mod_options { opts_frame } {
variable f_opts
Apol_Analysis_dta::reset_variables
Apol_Analysis_dta::forward_options_refresh_dialog \
$Apol_Analysis_dta::forward_options_Dlg
Apol_Analysis_dta::create_options $opts_frame
Apol_Analysis_dta::configure_widgets_for_dta_direction
Apol_Analysis_dta::populate_ta_list
Apol_Analysis_dta::config_endtype_state
if {[ApolTop::is_policy_open]} {
set Apol_Analysis_dta::display_attrib_sel 0
Apol_Analysis_dta::config_attrib_comboBox_state
Apol_Analysis_dta::change_types_list
}
return 0
}
proc Apol_Analysis_dta::load_dta_advanced_query_options {query_options curr_idx path_name parentDlg} {
variable f_opts
Apol_Analysis_dta::forward_options_destroy_object $path_name
Apol_Analysis_dta::forward_options_create_object $path_name
set f_opts($path_name,master_excl_types_list) ""
# Now we begin our gory parsing! Hold onto your seat!
set i $curr_idx
if {[lindex $query_options $i] != "\{\}"} {
set split_list [split [lindex $query_options $i] "\{"]
set perm_status_list [lappend perm_status_list [lindex $split_list 1]]
set i [expr $i + 1]
while {[llength [split [lindex $query_options $i] "\}"]] == 1} {
set perm_status_list [lappend perm_status_list [lindex $query_options $i]]
incr i
}
set perm_status_list [lappend perm_status_list [lindex [split [lindex $query_options $i] "\}"] 0]]
for {set j 0} {$j < [llength $perm_status_list]} {incr j} {
set elements [split [lindex $perm_status_list $j] ","]
set class_name [lindex $elements 0]
if {[lsearch -exact $f_opts($path_name,class_list) "$class_name"] == -1} {
puts "Invalid class: $class_name.....ignoring."
continue
}
set perm [lindex $elements 1]
set rt [catch {set perms_list [apol_GetPermsByClass $class_name 1]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message $err \
-parent $parentDlg
}
if {[lsearch -exact $perms_list $perm] == -1} {
puts "Invalid permission: $perm.....ignoring."
continue
}
set element [lindex $perm_status_list $j]
incr j
set val [lindex $perm_status_list $j]
set str "$path_name,perm_status_array,$element"
set f_opts($str) $val
}
}
incr i
set invalid_types ""
if {[lindex $query_options $i] != "\{\}"} {
set split_list [split [lindex $query_options $i] "\{"]
if {[llength $split_list] == 1} {
if {[lsearch -exact $Apol_Types::typelist [lindex $query_options $i]] != -1} {
set f_opts($path_name,master_excl_types_list) [lindex $query_options $i]
} else {
set invalid_types [lappend invalid_types [lindex $query_options $i]]
}
} else {
if {[lsearch -exact $Apol_Types::typelist [lindex $split_list 1]] != -1} {
set f_opts($path_name,master_excl_types_list) [lappend f_opts($path_name,master_excl_types_list) \
[lindex $split_list 1]]
} else {
set invalid_types [lappend invalid_types [lindex $split_list 1]]
}
set i [expr $i + 1]
while {[llength [split [lindex $query_options $i] "\}"]] == 1} {
if {[lsearch -exact $Apol_Types::typelist [lindex $query_options $i]] != -1} {
set f_opts($path_name,master_excl_types_list) [lappend f_opts($path_name,master_excl_types_list) \
[lindex $query_options $i]]
} else {
set invalid_types [lappend invalid_types [lindex $query_options $i]]
}
incr i
}
set end_element [lindex [split [lindex $query_options $i] "\}"] 0]
if {[lsearch -exact $Apol_Types::typelist $end_element] != -1} {
set f_opts($path_name,master_excl_types_list) [lappend f_opts($path_name,master_excl_types_list) $end_element]
} else {
set invalid_types [lappend invalid_types $end_element]
}
set idx [lsearch -exact $f_opts($path_name,master_excl_types_list) "self"]
if {$idx != -1} {
set f_opts($path_name,master_excl_types_list) [lreplace $f_opts($path_name,master_excl_types_list) \
$idx $idx]
}
}
}
if {$invalid_types != ""} {
puts "The following types do not exist in the currently \
loaded policy and were ignored:\n\n"
foreach type $invalid_types {
puts "$type\n"
}
}
foreach type $Apol_Types::typelist {
if {$type != "self"} {
set idx [lsearch -exact $f_opts($path_name,master_excl_types_list) $type]
if {$idx == -1} {
set f_opts($path_name,master_incl_types_list) \
[lappend f_opts($path_name,master_incl_types_list) $type]
}
}
}
set f_opts($path_name,filtered_incl_types) $f_opts($path_name,master_incl_types_list)
set f_opts($path_name,filtered_excl_types) $f_opts($path_name,master_excl_types_list)
incr i
if {[lindex $query_options $i] != "\{\}"} {
set tmp [string trim [lindex $query_options $i] "\{\}"]
if {[lsearch -exact $Apol_Types::attriblist $tmp] != -1} {
set f_opts($path_name,incl_attrib_combo_value) $tmp
} else {
tk_messageBox -icon warning -type ok -title "Warning" \
-message "The specified attribute $tmp does not exist in the currently \
loaded policy. It will be ignored." \
-parent $parentDlg
}
}
incr i
if {[lindex $query_options $i] != "\{\}"} {
set tmp [string trim [lindex $query_options $i] "\{\}"]
if {[lsearch -exact $Apol_Types::attriblist $tmp] != -1} {
set f_opts($path_name,excl_attrib_combo_value) $tmp
} else {
tk_messageBox -icon warning -type ok -title "Warning" \
-message "The specified attribute $tmp does not exist in the currently \
loaded policy. It will be ignored." \
-parent $parentDlg
}
}
incr i
set f_opts($path_name,incl_attrib_cb_sel) [lindex $query_options $i]
incr i
set f_opts($path_name,excl_attrib_cb_sel) [lindex $query_options $i]
return $i
}
proc Apol_Analysis_dta::parse_name_value_pairs {query_options curr_idx} {
variable endtype_sel_state
variable end_type_state
variable use_filters_state
set i $curr_idx
while {$i != [llength $query_options]} {
set tmp [string trim [lindex $query_options $i] "\{\}"]
switch -exact -- $tmp {
"End_Type_Bool" {
incr i
set endtype_sel_state [lindex $query_options $i]
}
"End_Type_String" {
incr i
if {[lindex $query_options $i] != "\{\}"} {
set tmp [string trim [lindex $query_options $i] "\{\}"]
set end_type_state $tmp
}
}
"Use_Filters_Bool" {
incr i
set use_filters_state [lindex $query_options $i]
}
default {
puts "Error: Unknown query option name encountered ([lindex $query_options $i])."
}
}
incr i
}
return $i
}
proc Apol_Analysis_dta::load_query_options { file_channel parentDlg } {
variable type_state
variable attribute_state
variable attrib_selected_state
variable direction_state
variable f_opts
variable forward_options_Dlg
set query_options ""
set query_options_tmp ""
set path_name $forward_options_Dlg
while {[eof $file_channel] != 1} {
gets $file_channel line
set tline [string trim $line]
if {$tline == "" || [string compare -length 1 $tline "#"] == 0} {
continue
}
set query_options_tmp [lappend query_options_tmp $tline]
}
if {$query_options_tmp == ""} {
return -code error "No query parameters were found."
}
set query_options_tmp [split [join $query_options_tmp " "] " "]
set query_options [ApolTop::strip_list_of_empty_items $query_options_tmp]
if {$query_options == ""} {
return -code error "No query parameters were found."
}
if {[lindex $query_options 0] != "\{\}"} {
set tmp [string trim [lindex $query_options 0] "\{\}"]
if {[lsearch -exact $Apol_Types::typelist $tmp] != -1} {
set type_state $tmp
} else {
tk_messageBox -icon warning -type ok -title "Warning" \
-message "The specified type starting source domain type $tmp does not exist in the currently \
loaded policy. It will be ignored." \
-parent $parentDlg
}
}
if {[lindex $query_options 1] != "\{\}"} {
set tmp [string trim [lindex $query_options 1] "\{\}"]
if {[lsearch -exact $Apol_Types::attriblist $tmp] != -1} {
set attribute_state $tmp
} else {
tk_messageBox -icon warning -type ok -title "Warning" \
-message "The specified attribute $tmp does not exist in the currently \
loaded policy. It will be ignored." \
-parent $parentDlg
}
}
set attrib_selected_state [lindex $query_options 2]
if {[lindex $query_options 3] != "\{\}"} {
set tmp [string trim [lindex $query_options 3] "\{\}"]
set direction_state $tmp
}
set i 4
if {[lindex $query_options $i]} {
set i 5
set i [Apol_Analysis_dta::load_dta_advanced_query_options $query_options $i $path_name $parentDlg]
}
incr i
Apol_Analysis_dta::parse_name_value_pairs $query_options $i
Apol_Analysis_dta::update_display_variables
Apol_Analysis_dta::configure_widgets_for_dta_direction
Apol_Analysis_dta::config_attrib_comboBox_state
Apol_Analysis_dta::config_endtype_state
if {[lindex $query_options 4]} {
Apol_Analysis_dta::forward_options_update_dialog $path_name
}
if { $attribute_state != "" } {
Apol_Analysis_dta::change_types_list
set Apol_Analysis_dta::display_type $type_state
}
return 0
}
proc Apol_Analysis_dta::save_query_options {module_name file_channel file_name} {
variable display_type
variable display_attribute
variable display_attrib_sel
variable display_direction
variable endtype_sel
variable end_type
variable use_filters
variable f_opts
variable forward_options_Dlg
if {$Apol_Analysis_dta::display_direction == "forward"} {
if {![array exists f_opts] || [array names f_opts "$forward_options_Dlg,name"] == ""} {
Apol_Analysis_dta::forward_options_create_object $forward_options_Dlg
}
set class_perms_list_tmp [array get f_opts "$forward_options_Dlg,perm_status_array,*"]
set class_perms_list ""
set len [llength $class_perms_list_tmp]
set idx [string length "$forward_options_Dlg,perm_status_array,"]
for {set i 0} {$i < $len} {incr i} {
set str [string range [lindex $class_perms_list_tmp $i] $idx end]
incr i
set class_perms_list [lappend class_perms_list $str [lindex $class_perms_list_tmp $i]]
}
set options [list \
$display_type \
$display_attribute \
$display_attrib_sel \
$display_direction \
1 \
$class_perms_list \
$f_opts($forward_options_Dlg,master_excl_types_list) \
$f_opts($forward_options_Dlg,incl_attrib_combo_value) \
$f_opts($forward_options_Dlg,excl_attrib_combo_value) \
$f_opts($forward_options_Dlg,incl_attrib_cb_sel) \
$f_opts($forward_options_Dlg,excl_attrib_cb_sel) \
"End_Type_Bool" \
$endtype_sel \
"End_Type_String" \
$end_type \
"Use_Filters_Bool" \
$use_filters]
} else {
set options [list \
$display_type \
$display_attribute \
$display_attrib_sel \
$display_direction \
0 \
"End_Type_Bool" \
$endtype_sel \
"End_Type_String" \
$end_type \
"Use_Filters_Bool" \
$use_filters]
}
puts $file_channel "$module_name"
puts $file_channel "$options"
return 0
}
proc Apol_Analysis_dta::get_current_results_state { } {
variable display_type
variable display_attribute
variable display_attrib_sel
variable display_direction
variable endtype_sel
variable end_type
variable use_filters
variable dta_tree
variable dta_info_text
variable f_opts
variable forward_options_Dlg
if {![array exists f_opts] || [array names f_opts "$forward_options_Dlg,name"] == ""} {
Apol_Analysis_dta::forward_options_create_object $forward_options_Dlg
}
set class_perms_list [array get f_opts "$forward_options_Dlg,perm_status_array,*"]
set options [list \
$dta_tree \
$dta_info_text \
$display_type \
$display_attribute \
$display_attrib_sel \
$display_direction \
$class_perms_list \
$f_opts($forward_options_Dlg,filtered_incl_types) \
$f_opts($forward_options_Dlg,filtered_excl_types) \
$f_opts($forward_options_Dlg,master_incl_types_list) \
$f_opts($forward_options_Dlg,master_excl_types_list) \
$f_opts($forward_options_Dlg,incl_attrib_combo_value) \
$f_opts($forward_options_Dlg,excl_attrib_combo_value) \
$f_opts($forward_options_Dlg,incl_attrib_cb_sel) \
$f_opts($forward_options_Dlg,excl_attrib_cb_sel) \
$f_opts($forward_options_Dlg,class_selected_idx) \
$endtype_sel \
$end_type \
$use_filters]
return $options
}
proc Apol_Analysis_dta::set_display_to_results_state { query_options } {
variable type_state
variable attribute_state
variable attrib_selected_state
variable direction_state
variable endtype_sel_state
variable end_type_state
variable use_filters_state
variable dta_tree
variable dta_info_text
variable f_opts
variable forward_options_Dlg
set dta_tree [lindex $query_options 0]
set dta_info_text [lindex $query_options 1]
set type_state [lindex $query_options 2]
set attribute_state [lindex $query_options 3]
set attrib_selected_state [lindex $query_options 4]
set direction_state [lindex $query_options 5]
if {![array exists f_opts] || [array names f_opts "$forward_options_Dlg,name"] == ""} {
Apol_Analysis_dta::forward_options_create_object $forward_options_Dlg
}
set obj_perms_list [lindex $query_options 6]
set len [llength $obj_perms_list]
if {$len > 0} {
array unset f_opts "$forward_options_Dlg,perm_status_array,*"
}
for {set i 0} {$i < $len} {incr i} {
set element [lindex $obj_perms_list $i]
incr i
set val [lindex $obj_perms_list $i]
set f_opts($element) $val
}
set f_opts($forward_options_Dlg,filtered_incl_types) [lindex $query_options 7]
set f_opts($forward_options_Dlg,filtered_excl_types) [lindex $query_options 8]
set f_opts($forward_options_Dlg,master_incl_types_list) [lindex $query_options 9]
set f_opts($forward_options_Dlg,master_excl_types_list) [lindex $query_options 10]
set f_opts($forward_options_Dlg,incl_attrib_combo_value) [lindex $query_options 11]
set f_opts($forward_options_Dlg,excl_attrib_combo_value) [lindex $query_options 12]
set f_opts($forward_options_Dlg,incl_attrib_cb_sel) [lindex $query_options 13]
set f_opts($forward_options_Dlg,excl_attrib_cb_sel) [lindex $query_options 14]
set f_opts($forward_options_Dlg,class_selected_idx) [lindex $query_options 15]
set endtype_sel_state [lindex $query_options 16]
set end_type_state [lindex $query_options 17]
set use_filters_state [lindex $query_options 18]
set f_opts($forward_options_Dlg,filter_vars_init) 1
Apol_Analysis_dta::update_display_variables
Apol_Analysis_dta::configure_widgets_for_dta_direction
Apol_Analysis_dta::config_attrib_comboBox_state
Apol_Analysis_dta::config_endtype_state
if { $attribute_state != "" } {
Apol_Analysis_dta::change_types_list
set Apol_Analysis_dta::display_type $type_state
}
if {[winfo exists $Apol_Analysis_dta::forward_options_Dlg]} {
Apol_Analysis_dta::forward_options_update_dialog $forward_options_Dlg
raise $Apol_Analysis_dta::forward_options_Dlg
focus $Apol_Analysis_dta::forward_options_Dlg
}
return 0
}
proc Apol_Analysis_dta::free_results_data {query_options} {
set dta_tree [lindex $query_options 0]
set dta_info_text [lindex $query_options 1]
if {[winfo exists $dta_tree]} {
$dta_tree delete [$dta_tree nodes root]
if {[$dta_tree nodes root] != ""} {
return -1
}
destroy $dta_tree
}
if {[winfo exists $dta_info_text]} {
$dta_info_text delete 0.0 end
destroy $dta_info_text
}
}
proc Apol_Analysis_dta::destroy_progressDlg {} {
variable progressDlg
if {[winfo exists $progressDlg]} {
destroy $progressDlg
}
}
proc Apol_Analysis_dta::display_progressDlg {} {
variable progressDlg
set Apol_Analysis_dta::progressmsg "Performing domain transition analysis..."
set progressBar [ProgressDlg $progressDlg \
-parent $ApolTop::mainframe \
-textvariable Apol_Analysis_dta::progressmsg \
-variable Apol_Analysis_dta::progress_indicator \
-maximum 3 \
-width 45]
update
}
proc Apol_Analysis_dta::do_analysis { results_frame } {
variable display_type
variable display_attribute
variable display_attrib_sel
variable endtype_sel
variable end_type
variable dta_tree
variable dta_info_text
variable f_opts
variable forward_options_Dlg
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened!"
return -code error
}
Apol_Analysis_dta::display_progressDlg
set reverse 0
set num_object_classes 0
set perm_options ""
set types ""
set use_filters 0
if {$Apol_Analysis_dta::display_direction == "forward"} {
if {$Apol_Analysis_dta::use_filters} {
set types $f_opts($forward_options_Dlg,filtered_incl_types)
if {![array exists f_opts] || [array names f_opts "$forward_options_Dlg,name"] == ""} {
Apol_Analysis_dta::forward_options_create_object $forward_options_Dlg
}
foreach class $f_opts($forward_options_Dlg,class_list) {
set perms ""
set idx [string first $Apol_Analysis_dta::excluded_tag $class]
if {$idx == -1} {
set class_elements [array names f_opts "$forward_options_Dlg,perm_status_array,$class,*"]
set class_added 0
foreach element $class_elements {
set perm [lindex [split $element ","] 3]
if {[string equal $f_opts($element) "include"]} {
if {$class_added == 0} {
incr num_object_classes
set perm_options [lappend perm_options $class]
set class_added 1
}
set perms [lappend perms $perm]
}
}
if {$perms != ""} {
set perm_options [lappend perm_options [llength $perms]]
foreach perm $perms {
set perm_options [lappend perm_options $perm]
}
}
}
}
set use_filters 1
}
} else {
set reverse 1
}
set rt [catch {set results [apol_DomainTransitionAnalysis \
$reverse \
$display_type \
$use_filters \
$num_object_classes \
$perm_options \
$types \
$endtype_sel \
$end_type]} err]
Apol_Analysis_dta::destroy_progressDlg
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
set query_args [list \
$reverse \
$display_type \
$use_filters \
$num_object_classes \
$perm_options \
$types \
$endtype_sel \
$end_type]
set dta_tree [Apol_Analysis_dta::create_resultsDisplay $results_frame $reverse]
set rt [catch {Apol_Analysis_dta::create_result_tree_structure $dta_tree $results $query_args} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
return 0
}
proc Apol_Analysis_dta::reset_variables { } {
set Apol_Analysis_dta::display_type ""
set Apol_Analysis_dta::display_attribute ""
set Apol_Analysis_dta::display_attrib_sel 0
set Apol_Analysis_dta::display_direction "forward"
set Apol_Analysis_dta::endtype_sel 0
set Apol_Analysis_dta::end_type ""
set Apol_Analysis_dta::use_filters 0
set Apol_Analysis_dta::type_state ""
set Apol_Analysis_dta::attribute_state ""
set Apol_Analysis_dta::attrib_selected_state 0
set Apol_Analysis_dta::direction_state "forward"
set Apol_Analysis_dta::endtype_sel_state 0
set Apol_Analysis_dta::end_type_state ""
set Apol_Analysis_dta::use_filters_state 0
set Apol_Analysis_dta::dta_tree ""
set Apol_Analysis_dta::dta_info_text ""
return 0
}
proc Apol_Analysis_dta::update_display_variables { } {
variable display_type
variable display_attribute
variable display_attrib_sel
variable display_direction
variable endtype_sel
variable end_type
variable use_filters
set display_type $Apol_Analysis_dta::type_state
set display_attribute $Apol_Analysis_dta::attribute_state
set display_attrib_sel $Apol_Analysis_dta::attrib_selected_state
set display_direction $Apol_Analysis_dta::direction_state
set endtype_sel $Apol_Analysis_dta::endtype_sel_state
set end_type $Apol_Analysis_dta::end_type_state
set use_filters $Apol_Analysis_dta::use_filters_state
}
proc Apol_Analysis_dta::populate_ta_list { } {
variable combo_domain
variable combo_attribute
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_domain configure -values $attrib_typesList
$combo_attribute configure -values $Apol_Types::attriblist
return 0
}
proc Apol_Analysis_dta::change_types_list { } {
variable combo_domain
variable display_attribute
if { $display_attribute != "" } {
set rt [catch {set attrib_typesList [apol_GetAttribTypesList $display_attribute]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
}
set attrib_typesList [lsort $attrib_typesList]
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_domain configure -values $attrib_typesList
} else {
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_domain configure -values $attrib_typesList
}
return 0
}
proc Apol_Analysis_dta::enable_forward_advanced_button { } {
variable b_forward_options
$b_forward_options configure -state normal
}
proc Apol_Analysis_dta::disable_forward_advanced_button { } {
variable b_forward_options
$b_forward_options configure -state disabled
}
proc Apol_Analysis_dta::configure_widgets_for_dta_direction { } {
variable entry_frame
variable cb_attrib
variable cb_filters
variable forward_options_Dlg
if {$Apol_Analysis_dta::display_direction == "forward"} {
$entry_frame configure -text "Select source domain:"
$cb_attrib configure -text "Filter source domains to select using attribute:"
$cb_filters configure -state normal
Apol_Analysis_dta::on_use_filters_button_selected
} else {
$entry_frame configure -text "Select target domain:"
$cb_attrib configure -text "Filter target domains to select using attribute:"
$cb_filters deselect
$cb_filters configure -state disabled
Apol_Analysis_dta::disable_forward_advanced_button
Apol_Analysis_dta::forward_options_destroy_dialog $forward_options_Dlg
}
return 0
}
proc Apol_Analysis_dta::config_attrib_comboBox_state { } {
variable combo_attribute
variable combo_domain
variable display_attrib_sel
if { $display_attrib_sel } {
$combo_attribute configure -state normal -entrybg white
Apol_Analysis_dta::change_types_list
} else {
$combo_attribute configure -state disabled -entrybg $ApolTop::default_bg_color
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_domain configure -values $attrib_typesList
}
return 0
}
proc Apol_Analysis_dta::create_result_tree_structure { dta_tree results_list query_args } {
set home_node [Apol_Analysis_dta::insert_src_type_node $dta_tree $query_args]
set rt [catch {Apol_Analysis_dta::create_target_type_nodes $home_node $dta_tree $results_list} err]
if {$rt != 0} {
return -code error $err
}
Apol_Analysis_dta::treeSelect $Apol_Analysis_dta::dta_tree $Apol_Analysis_dta::dta_info_text $home_node
return 0
}
proc Apol_Analysis_dta::create_target_type_nodes { parent dta_tree results_list } {
if { [file tail [$dta_tree parent $parent]] == [file tail $parent] } {
return
}
if { [file tail [$dta_tree parent $parent]] == [file tail $parent] } {
return
}
if { [$dta_tree nodes $parent] == "" } {
set num_target_domains [lindex $results_list 1]
set start_idx 2
for { set x 0 } { $x < $num_target_domains } { incr x } {
set end_idx [Apol_Analysis_dta::get_target_type_data_end_idx $results_list $start_idx]
if {$end_idx == -1} {
return -code error "Error parsing results for type [lindex $results_list $start_idx].\n"
}
set target_name [lindex $results_list $start_idx]
set target_node "${parent}/${target_name}/"
$dta_tree insert end $parent $target_node -text $target_name \
-open 0 \
-drawcross allways \
-data [lrange $results_list [expr $start_idx +1] $end_idx]
set start_idx [expr $end_idx + 1]
}
set nodes [lsort [$dta_tree nodes $parent]]
$dta_tree reorder $parent $nodes
$dta_tree configure -redraw 1
}
return 0
}
proc Apol_Analysis_dta::do_child_analysis { dta_tree selected_node } {
ApolTop::setBusyCursor
if { [$dta_tree nodes $selected_node] == "" } {
set query_args [$dta_tree itemcget [$dta_tree nodes root] -data]
set start_type [file tail $selected_node]
set rt [catch {set results [apol_DomainTransitionAnalysis \
[lindex $query_args 0] \
$start_type \
[lindex $query_args 2] \
[lindex $query_args 3] \
[lindex $query_args 4] \
[lindex $query_args 5] \
[lindex $query_args 6] \
[lindex $query_args 7]]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message $err
}
set rt [catch {Apol_Analysis_dta::create_target_type_nodes $selected_node $dta_tree $results} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message $err
}
}
ApolTop::resetBusyCursor
return 0
}
proc Apol_Analysis_dta::get_target_type_data_end_idx { results_list idx } {
if {$idx >= [llength $results_list]} {
return -1
}
set len 1
set num_pt [lindex $results_list [expr $idx + $len]]
incr len [expr $num_pt * 3]
incr len
set num_types [lindex $results_list [expr $idx + $len]]
for {set i 0} { $i < $num_types } { incr i } {
incr len 2
set num_ep [lindex $results_list [expr $idx + $len]]
incr len [expr $num_ep * 3]
incr len
set num_ex [lindex $results_list [expr $idx + $len]]
incr len [expr $num_ex * 3]
}
incr len
set num_additional [lindex $results_list [expr $idx + $len]]
incr len [expr $num_additional * 3]
return [expr $len + $idx]
}
proc Apol_Analysis_dta::render_target_type_data { data dta_info_text dta_tree node} {
$dta_info_text configure -state normal
$dta_info_text delete 0.0 end
$dta_info_text configure -wrap none
if { $data == "" } {
$dta_info_text configure -state disabled
return ""
}
set target [$dta_tree itemcget $node -text]
set parent [$dta_tree itemcget [$dta_tree parent $node] -text]
$dta_info_text mark set insert 1.0
set start_idx [$dta_info_text index insert]
$dta_info_text insert end "Domain transition from "
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::title_tag $start_idx $end_idx
set start_idx [$dta_info_text index insert]
if {[lindex [$dta_tree itemcget [$dta_tree nodes root] -data] 0]} {
$dta_info_text insert end $target
} else {
$dta_info_text insert end $parent
}
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::title_type_tag $start_idx $end_idx
set start_idx [$dta_info_text index insert]
$dta_info_text insert end " to "
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::title_tag $start_idx $end_idx
set start_idx [$dta_info_text index insert]
if {[lindex [$dta_tree itemcget [$dta_tree nodes root] -data] 0]} {
$dta_info_text insert end $parent
} else {
$dta_info_text insert end $target
}
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::title_type_tag $start_idx $end_idx
$dta_info_text insert end "\n\n"
set start_idx [$dta_info_text index insert]
set idx 0
set num_pt [lindex $data $idx]
$dta_info_text insert end "Process Transition Rules: "
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::subtitle_tag $start_idx $end_idx
set start_idx $end_idx
$dta_info_text insert end "$num_pt\n"
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::counters_tag $start_idx $end_idx
for {set i 0} { $i < $num_pt } { incr i } {
incr idx
set rule [lindex $data $idx]
incr idx
set lineno [lindex $data $idx]
$dta_info_text insert end "\t"
set start_idx [$dta_info_text index insert]
if {![ApolTop::is_binary_policy]} {
$dta_info_text insert end "($lineno) "
set end_idx [$dta_info_text index insert]
Apol_PolicyConf::insertHyperLink $dta_info_text "$start_idx wordstart + 1c" "$start_idx wordstart + [expr [string length $lineno] + 1]c"
set start_idx $end_idx
}
$dta_info_text insert end "$rule"
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::rules_tag $start_idx $end_idx
incr idx
if {[lindex $data $idx] == 0} {
$dta_info_text insert end " "
set startIdx [$dta_info_text index insert]
$dta_info_text insert end "\[Disabled\]\n"
set endIdx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::disabled_rule_tag $start_idx $end_idx
} else {
$dta_info_text insert end "\n"
}
}
incr idx
set num_types [lindex $data $idx ]
set start_idx $end_idx
$dta_info_text insert end "\nEntry Point File Types: "
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::subtitle_tag $start_idx $end_idx
set start_idx $end_idx
$dta_info_text insert end "$num_types\n"
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::counters_tag $start_idx $end_idx
for {set i 0} { $i < $num_types } { incr i } {
incr idx
set type [lindex $data $idx]
set start_idx $end_idx
$dta_info_text insert end "\t$type\n"
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::types_tag $start_idx $end_idx
incr idx
set num_ep [lindex $data $idx]
set start_idx $end_idx
$dta_info_text insert end "\t\tFile Entrypoint Rules: "
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::subtitle_tag $start_idx $end_idx
set start_idx $end_idx
$dta_info_text insert end "$num_ep\n"
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::counters_tag $start_idx $end_idx
for {set j 0 } { $j < $num_ep } { incr j } {
incr idx
set rule [lindex $data $idx]
incr idx
set lineno [lindex $data $idx]
$dta_info_text insert end "\t\t"
set start_idx [$dta_info_text index insert]
if {![ApolTop::is_binary_policy]} {
$dta_info_text insert end "($lineno) "
set end_idx [$dta_info_text index insert]
Apol_PolicyConf::insertHyperLink $dta_info_text "$start_idx wordstart + 1c" "$start_idx wordstart + [expr [string length $lineno] + 1]c"
set start_idx $end_idx
}
$dta_info_text insert end "$rule"
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::rules_tag $start_idx $end_idx
incr idx
if {[lindex $data $idx] == 0} {
$dta_info_text insert end " "
set startIdx [$dta_info_text index insert]
$dta_info_text insert end "\[Disabled\]\n"
set endIdx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::disabled_rule_tag $start_idx $end_idx
} else {
$dta_info_text insert end "\n"
}
}
incr idx
set num_ex [lindex $data $idx]
set start_idx $end_idx
$dta_info_text insert end "\n\t\tFile Execute Rules: "
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::subtitle_tag $start_idx $end_idx
set start_idx $end_idx
$dta_info_text insert end "$num_ex\n"
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::counters_tag $start_idx $end_idx
for { set j 0 } { $j < $num_ex } { incr j } {
incr idx
set rule [lindex $data $idx]
incr idx
set lineno [lindex $data $idx]
$dta_info_text insert end "\t\t"
set start_idx [$dta_info_text index insert]
if {![ApolTop::is_binary_policy]} {
$dta_info_text insert end "($lineno) "
set end_idx [$dta_info_text index insert]
Apol_PolicyConf::insertHyperLink $dta_info_text "$start_idx wordstart + 1c" "$start_idx wordstart + [expr [string length $lineno] + 1]c"
set start_idx $end_idx
}
$dta_info_text insert end "$rule"
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::rules_tag $start_idx $end_idx
incr idx
if {[lindex $data $idx] == 0} {
$dta_info_text insert end " "
set startIdx [$dta_info_text index insert]
$dta_info_text insert end "\[Disabled\]\n"
set endIdx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::disabled_rule_tag $start_idx $end_idx
} else {
$dta_info_text insert end "\n"
}
}
}
set reverse [lindex [$dta_tree itemcget [$dta_tree nodes root] -data] 0]
if {!$reverse && $Apol_Analysis_dta::use_filters} {
incr idx
set num_additional [lindex $data $idx]
$dta_info_text insert end "\n"
set start_idx [$dta_info_text index insert]
$dta_info_text insert end "The access filters you specified returned the following rules"
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::subtitle_tag $start_idx $end_idx
$dta_info_text insert end ": "
set start_idx [$dta_info_text index insert]
$dta_info_text insert end "$num_additional\n"
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::counters_tag $start_idx $end_idx
for {set j 0 } { $j < $num_additional } { incr j } {
incr idx
set rule [lindex $data $idx]
incr idx
set lineno [lindex $data $idx]
$dta_info_text insert end "\t"
set start_idx [$dta_info_text index insert]
if {![ApolTop::is_binary_policy]} {
$dta_info_text insert end "($lineno) "
set end_idx [$dta_info_text index insert]
Apol_PolicyConf::insertHyperLink $dta_info_text "$start_idx wordstart + 1c" "$start_idx wordstart + [expr [string length $lineno] + 1]c"
set start_idx $end_idx
}
$dta_info_text insert end "$rule"
set end_idx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::rules_tag $start_idx $end_idx
incr idx
if {[lindex $data $idx] == 0} {
$dta_info_text insert end " "
set startIdx [$dta_info_text index insert]
$dta_info_text insert end "\[Disabled\]\n"
set endIdx [$dta_info_text index insert]
$dta_info_text tag add $Apol_Analysis_dta::disabled_rule_tag $start_idx $end_idx
} else {
$dta_info_text insert end "\n"
}
}
}
$dta_info_text configure -state disabled
return 0
}
proc Apol_Analysis_dta::formatInfoText { tb } {
$tb tag configure $Apol_Analysis_dta::title_tag -font {Helvetica 14 bold}
$tb tag configure $Apol_Analysis_dta::title_type_tag -foreground blue -font {Helvetica 14 bold}
$tb tag configure $Apol_Analysis_dta::subtitle_tag -font {Helvetica 11 bold}
$tb tag configure $Apol_Analysis_dta::rules_tag -font $ApolTop::text_font
$tb tag configure $Apol_Analysis_dta::counters_tag -foreground blue -font {Helvetica 11 bold}
$tb tag configure $Apol_Analysis_dta::types_tag -font $ApolTop::text_font
$tb tag configure $Apol_Analysis_dta::disabled_rule_tag -foreground red
Apol_PolicyConf::configure_HyperLinks $tb
}
proc Apol_Analysis_dta::display_root_type_info { source_type dta_info_text dta_tree } {
$dta_info_text configure -state normal
$dta_info_text delete 0.0 end
if {[lindex [$dta_tree itemcget $source_type -data] 0]} {
$dta_info_text insert end "Reverse Domain Transition Analysis: Starting Type: "
} else {
$dta_info_text insert end "Forward Domain Transition Analysis: Starting Type: "
}
$dta_info_text tag add ROOT_TITLE 0.0 end
$dta_info_text tag configure ROOT_TITLE -font {Helvetica 14 bold}
set start_idx [$dta_info_text index insert]
$dta_info_text insert end "$source_type"
set end_idx [$dta_info_text index insert]
$dta_info_text tag add ROOT_TYPE $start_idx $end_idx
$dta_info_text tag configure ROOT_TYPE -font {Helvetica 14 bold} -foreground blue
$dta_info_text configure -wrap word
set start_idx [$dta_info_text index insert]
if {[lindex [$dta_tree itemcget $source_type -data] 0]} {
set root_text $Apol_Analysis_dta::dta_root_text_r
} else {
set root_text $Apol_Analysis_dta::dta_root_text_f
}
$dta_info_text insert end $root_text
$dta_info_text tag add ROOT_TEXT $start_idx end
$dta_info_text tag configure ROOT_TEXT -font $ApolTop::text_font
$dta_info_text configure -state disabled
return 0
}
proc Apol_Analysis_dta::treeSelect { dta_tree dta_info_text node } {
$dta_tree selection set $node
if {$node == [$dta_tree nodes root]} {
Apol_Analysis_dta::display_root_type_info $node $dta_info_text $dta_tree
return
}
Apol_Analysis_dta::render_target_type_data [$dta_tree itemcget $node -data] $dta_info_text $dta_tree $node
Apol_Analysis_dta::formatInfoText $dta_info_text
ApolTop::makeTextBoxReadOnly $dta_info_text
return 0
}
proc Apol_Analysis_dta::insert_src_type_node { dta_tree query_args } {
$dta_tree insert end root [lindex $query_args 1] -text [lindex $query_args 1] \
-open 1 \
-drawcross auto \
-data $query_args
return [$dta_tree nodes root]
}
proc Apol_Analysis_dta::config_endtype_state {} {
variable entry_end
if {$Apol_Analysis_dta::endtype_sel} {
$entry_end configure -state normal -background white
} else {
$entry_end configure -state disabled -background $ApolTop::default_bg_color
}
return 0
}
proc Apol_Analysis_dta::on_use_filters_button_selected {} {
if {$Apol_Analysis_dta::use_filters} {
Apol_Analysis_dta::enable_forward_advanced_button
} else {
Apol_Analysis_dta::disable_forward_advanced_button
}
}
proc Apol_Analysis_dta::create_options { options_frame } {
variable combo_domain
variable combo_attribute
variable cb_attrib
variable entry_frame
variable adv_frame
variable b_forward_options
variable entry_end
variable cb_filters
set left_frame [frame $options_frame.left_frame]
set right_frame [TitleFrame $options_frame.right_frame -text "Optional result filters"]
set radio_frame [TitleFrame $left_frame.radio_frame -text "Select direction:"]
set entry_frame [TitleFrame $left_frame.entry_frame]
set adv_frame [frame [$right_frame getframe].adv_frame]
set endtype_frame [frame [$right_frame getframe].endtype_frame]
set combo_domain [ComboBox [$entry_frame getframe].combo_domain -width 20 \
-helptext "Starting Domain" \
-editable 1 \
-entrybg white \
-textvariable Apol_Analysis_dta::display_type]
set combo_attribute [ComboBox [$entry_frame getframe].combo_attribute \
-textvariable Apol_Analysis_dta::display_attribute \
-modifycmd { Apol_Analysis_dta::change_types_list}]
set cb_attrib [checkbutton [$entry_frame getframe].trans \
-variable Apol_Analysis_dta::display_attrib_sel \
-text "Filter source domains to select using attribute:" \
-offvalue 0 -onvalue 1 \
-command { Apol_Analysis_dta::config_attrib_comboBox_state }]
set radio_forward [radiobutton [$radio_frame getframe].radio_forward -text "Forward" \
-variable Apol_Analysis_dta::display_direction \
-value forward \
-command {Apol_Analysis_dta::configure_widgets_for_dta_direction}]
set radio_reverse [radiobutton [$radio_frame getframe].radio_reverse -text "Reverse" \
-variable Apol_Analysis_dta::display_direction \
-value reverse \
-command {Apol_Analysis_dta::configure_widgets_for_dta_direction}]
set b_forward_options [button $adv_frame.b_forward_options -text "Access filters" \
-command {Apol_Analysis_dta::forward_options_create_dialog \
$Apol_Analysis_dta::forward_options_Dlg \
"Access Filters"}]
set entry_end [Entry $endtype_frame.entry_end \
-helptext "You may enter a regular expression" \
-editable 1 -state disabled \
-textvariable Apol_Analysis_dta::end_type]
set cb_endtype [checkbutton $endtype_frame.cb_endtype \
-text "Filter result types using regular expression:" \
-variable Apol_Analysis_dta::endtype_sel \
-command {Apol_Analysis_dta::config_endtype_state}]
set cb_filters [checkbutton $adv_frame.cb_filters \
-text "Use access filters:" \
-variable Apol_Analysis_dta::use_filters \
-command {Apol_Analysis_dta::on_use_filters_button_selected}]
pack $cb_endtype -side top -anchor nw
pack $entry_end -anchor nw -fill x -expand yes
pack $cb_filters $b_forward_options -side left -anchor nw
pack $left_frame -side left -anchor nw -fill y
pack $right_frame -side right -anchor nw -fill both -expand yes -pady 5 -padx 3
pack $radio_frame -side top -anchor nw -pady 5 -fill x
pack $entry_frame -side top -anchor nw -pady 5 -fill both -expand yes
pack $endtype_frame $adv_frame -side top -anchor nw -pady 5 -padx 2 -fill x
pack $combo_domain -side top -anchor nw -fill x
pack $cb_attrib -padx 15 -side top -anchor nw
pack $combo_attribute -side top -anchor nw -fill x -padx 15
pack $radio_forward $radio_reverse -side left -anchor nw -padx 5 -fill x -expand yes
bindtags $combo_attribute.e [linsert [bindtags $combo_attribute.e] 3 attribs_list_Tag]
bind attribs_list_Tag <KeyPress> { ApolTop::_create_popup $Apol_Analysis_dta::combo_attribute %W %K }
bindtags $combo_domain.e [linsert [bindtags $combo_domain.e] 3 domains_list_Tag]
bind domains_list_Tag <KeyPress> { ApolTop::_create_popup $Apol_Analysis_dta::combo_domain %W %K }
return 0
}
proc Apol_Analysis_dta::create_resultsDisplay {results_frame reverse} {
variable dta_tree
variable dta_info_text
set pw [PanedWindow $results_frame.pw -side top]
set pw_tree [$pw add]
set pw_info [$pw add -weight 5]
if { $reverse } {
set frm_tree [TitleFrame [$pw getframe 0].frm_tree -text "Reverse Domain Transition Tree"]
set frm_info [TitleFrame [$pw getframe 1].frm_info -text "Reverse Domain Transition Information"]
} else {
set frm_tree [TitleFrame [$pw getframe 0].frm_tree -text "Forward Domain Transition Tree"]
set frm_info [TitleFrame [$pw getframe 1].frm_info -text "Forward Domain Transition Information"]
}
set sw_tree [ScrolledWindow [$frm_tree getframe].sw_tree -auto none]
set sw_info [ScrolledWindow [$frm_info getframe].sw_info -auto none]
set dta_tree [Tree [$sw_tree getframe].dta_tree \
-relief flat -borderwidth 0 -width 15 -highlightthickness 0 \
-redraw 0 -bg white -showlines 1 -padx 0 \
-opencmd {Apol_Analysis_dta::do_child_analysis $Apol_Analysis_dta::dta_tree}]
$sw_tree setwidget $dta_tree
set dta_info_text [text [$sw_info getframe].dta_info_text -wrap none -bg white -font $ApolTop::text_font]
$sw_info setwidget $dta_info_text
bind $dta_info_text <Enter> {focus %W}
pack $pw -fill both -expand yes -anchor nw
pack $frm_tree -fill both -expand yes -anchor nw
pack $frm_info -fill both -expand yes
pack $sw_tree -fill both -expand yes
pack $sw_info -fill both -expand yes
$dta_tree bindText <ButtonPress-1> {Apol_Analysis_dta::treeSelect $Apol_Analysis_dta::dta_tree $Apol_Analysis_dta::dta_info_text}
$dta_tree bindText <Double-ButtonPress-1> {Apol_Analysis_dta::treeSelect $Apol_Analysis_dta::dta_tree $Apol_Analysis_dta::dta_info_text}
return $dta_tree
}
namespace eval Apol_Analysis_dirflow {
variable combo_attribute
variable combo_start
variable list_objs
variable info_button_text "\n\nThis analysis generates the results of a Direct Information Flow \
analysis beginning from the starting type selected. The results of \
the analysis are presented in tree form with the root of the tree being \
the start point for the analysis.\n\nEach child node in the tree represents \
a type in the current policy for which there is a direct information flow \
to or from its parent node. If 'in' was selected then the information flow \
is from the child to the parent. If 'out' was selected then information \
flows from the parent to the child.\n\nThe results of the analysis may be \
optionally filtered by object class selection or an end type regular \
expression.\n\nNOTE: For any given generation, if the parent and the child \
are the same, you cannot open the child. This avoids cyclic analyses.\n\nFor \
additional help on this topic select \"Information Flow Analysis\" from the \
help menu."
variable root_text "\n\nThis tab provides the results of a Direct Information Flow analysis beginning \
from the starting type selected above. The results of the analysis are presented \
in tree form with the root of the tree (this node) being the start point for the \
analysis.\n\nEach child node in the tree represents a type in the current policy \
for which there is a direct information flow to or from (depending on your selection \
above) its parent node.\n\nNOTE: For any given generation, if the parent and the child \
are the same, you cannot open the child. This avoids cyclic analyses.\n\n"
variable in_button
variable out_button
variable either_button
variable both_button
variable entry_end
variable cb_attrib
variable sw_objs
variable endtype_sel 0
variable objects_sel 0
variable in_button_sel 0
variable out_button_sel 0
variable either_button_sel 0
variable both_button_sel 0
variable display_attrib_sel 0
variable dirflow_tree ""
variable dirflow_info_text ""
variable start_type ""
variable end_type ""
variable display_attribute ""
variable flow_direction ""
variable title_tag TITLE
variable title_type_tag TITLE_TYPE
variable subtitle_tag SUBTITLES
variable rules_tag RULES
variable counters_tag COUNTERS
variable types_tag TYPE
variable disabled_rule_tag DISABLE_RULE
Apol_Analysis::register_analysis_modules "Apol_Analysis_dirflow" "Direct Information Flow"
}
proc Apol_Analysis_dirflow::initialize { } {
Apol_Analysis_dirflow::reset_variables
if {[ApolTop::is_policy_open]} {
set Apol_Analysis_dirflow::display_attrib_sel 0
Apol_Analysis_dirflow::config_attrib_comboBox_state
Apol_Analysis_dirflow::change_types_list
set Apol_Analysis_dirflow::in_button_sel 1
$Apol_Analysis_dirflow::in_button select
Apol_Analysis_dirflow::in_button_press
set Apol_Analysis_dirflow::objects_sel 0
Apol_Analysis_dirflow::config_objects_list_state
$Apol_Analysis_dirflow::list_objs selection clear 0 end
set Apol_Analysis_dirflow::endtype_sel 0
Apol_Analysis_dirflow::config_endtype_state
}
return 0
}
proc Apol_Analysis_dirflow::get_analysis_info {} {
return $Apol_Analysis_dirflow::info_button_text
}
proc Apol_Analysis_dirflow::get_results_raised_tab {} {
return $Apol_Analysis_dirflow::dirflow_info_text
}
proc Apol_Analysis_dirflow::do_analysis { results_frame } {
variable start_type
variable end_type
variable endtype_sel
variable dirflow_tree
variable dirflow_info_text
variable flow_direction
variable list_objs
variable objects_sel
set selected_objects [Apol_Analysis_dirflow::get_unselected_objects]
set rt [catch {set map_loaded [Apol_Perms_Map::is_pmap_loaded]} err ]
if { $rt != 0 } {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
if { !$map_loaded } {
set rt [catch {Apol_Perms_Map::load_default_perm_map} err]
if { $rt != 0 } {
if {$rt == $Apol_Perms_Map::warning_return_val} {
tk_messageBox -icon warning -type ok -title "Warning" -message "$err"
} else {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
}
}
update idletasks
set rt [catch {set results [apol_DirectInformationFlowAnalysis \
$Apol_Analysis_dirflow::start_type \
$Apol_Analysis_dirflow::flow_direction \
$Apol_Analysis_dirflow::objects_sel \
$selected_objects \
$Apol_Analysis_dirflow::endtype_sel \
$Apol_Analysis_dirflow::end_type] } err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
set query_args [list \
$Apol_Analysis_dirflow::start_type \
$Apol_Analysis_dirflow::flow_direction \
$Apol_Analysis_dirflow::objects_sel \
$selected_objects \
$Apol_Analysis_dirflow::endtype_sel \
$Apol_Analysis_dirflow::end_type]
set dirflow_tree [Apol_Analysis_dirflow::create_resultsDisplay $results_frame]
set rt [catch {Apol_Analysis_dirflow::create_result_tree_structure \
$dirflow_tree \
$results \
$query_args} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
return 0
}
proc Apol_Analysis_dirflow::close { } {
variable list_objs
Apol_Analysis_dirflow::reset_variables
$Apol_Analysis_dirflow::combo_attribute configure -state disabled -entrybg $ApolTop::default_bg_color
$Apol_Analysis_dirflow::combo_attribute configure -values ""
ApolTop::enable_tkListbox $list_objs
$Apol_Analysis_dirflow::list_objs delete 0 end
ApolTop::disable_tkListbox $list_objs
Apol_Analysis_dirflow::config_objects_list_state
set Apol_Analysis_dirflow::endtype_sel 0
Apol_Analysis_dirflow::config_endtype_state
return 0
}
proc Apol_Analysis_dirflow::open { } {
variable in_button
variable cb_attrib
variable list_objs
ApolTop::enable_tkListbox $list_objs
Apol_Analysis_dirflow::populate_ta_list
ApolTop::disable_tkListbox $list_objs
set in_button_sel 1
$in_button select
Apol_Analysis_dirflow::in_button_press
Apol_Analysis_dirflow::config_attrib_comboBox_state
return 0
}
proc Apol_Analysis_dirflow::load_query_options { file_channel parentDlg } {
set query_options ""
set query_options_tmp ""
while {[eof $file_channel] != 1} {
gets $file_channel line
set tline [string trim $line]
if {$tline == "" || [string compare -length 1 $tline "#"] == 0} {
continue
}
set query_options_tmp [lappend query_options_tmp $tline]
}
if {$query_options_tmp == ""} {
return -code error "No query parameters were found."
}
set query_options_tmp [split [join $query_options_tmp " "] " :"]
set query_options [ApolTop::strip_list_of_empty_items $query_options_tmp]
if {$query_options == ""} {
return -code error "No query parameters were found."
}
Apol_Analysis_dirflow::clear_all_button_press
set Apol_Analysis_dirflow::endtype_sel [lindex $query_options 0]
set Apol_Analysis_dirflow::objects_sel [lindex $query_options 1]
set Apol_Analysis_dirflow::in_button_sel [lindex $query_options 2]
set Apol_Analysis_dirflow::out_button_sel [lindex $query_options 3]
set Apol_Analysis_dirflow::either_button_sel [lindex $query_options 4]
set Apol_Analysis_dirflow::both_button_sel [lindex $query_options 5]
if {[lindex $query_options 8] != "\{\}"} {
set Apol_Analysis_dirflow::end_type [string trim [lindex $query_options 8] "\{\}"]
}
if {[lindex $query_options 9] != "\{\}"} {
set tmp [string trim [lindex $query_options 9] "\{\}"]
if {[lsearch -exact $Apol_Types::attriblist $tmp] != -1} {
set Apol_Analysis_dirflow::display_attribute $tmp
set Apol_Analysis_dirflow::display_attrib_sel [lindex $query_options 6]
} else {
tk_messageBox -icon warning -type ok -title "Warning" \
-message "The specified attribute $tmp does not exist in the currently \
loaded policy. It will be ignored." \
-parent $parentDlg
}
}
set Apol_Analysis_dirflow::flow_direction [lindex $query_options 10]
set active_objs ""
if {[lindex $query_options 11] != "\{\}"} {
set split_list [split [lindex $query_options 11] "\{"]
if {[llength $split_list] == 1} {
set active_objs [lappend active_objs [lindex $query_options 11]]
} else {
set active_objs [lappend active_objs [lindex $split_list 1]]
set i 12
while {[llength [split [lindex $query_options $i] "\}"]] == 1} {
set active_objs [lappend active_objs [lindex $query_options $i]]
incr i
}
set end_element [lindex [split [lindex $query_options $i] "\}"] 0]
set active_objs [lappend active_objs $end_element]
}
}
Apol_Analysis_dirflow::config_objects_list_state
set invalid_objs ""
foreach obj $active_objs {
set idx [lsearch -exact [$Apol_Analysis_dirflow::list_objs get 0 end] $obj]
if {$idx != -1} {
$Apol_Analysis_dirflow::list_objs selection set $idx
} else {
set invalid_objs [lappend invalid_objs $obj]
}
}
if {$invalid_objs != ""} {
puts "The following objects do not exist in the currently \
loaded policy and were ignored:\n\n"
foreach obj $invalid_objs {
puts "$obj\n"
}
}
Apol_Analysis_dirflow::config_endtype_state
Apol_Analysis_dirflow::config_attrib_comboBox_state
if {[lindex $query_options 7] != "\{\}"} {
set tmp [string trim [lindex $query_options 7] "\{\}"]
if {[lsearch -exact $Apol_Types::typelist $tmp] != -1} {
set Apol_Analysis_dirflow::start_type $tmp
} else {
tk_messageBox -icon warning -type ok -title "Warning" \
-message "The specified type starting source domain type $tmp does not exist in the currently \
loaded policy. It will be ignored." \
-parent $parentDlg
}
}
return 0
}
proc Apol_Analysis_dirflow::save_query_options {module_name file_channel file_name} {
variable endtype_sel
variable objects_sel
variable in_button_sel
variable out_button_sel
variable either_button_sel
variable both_button_sel
variable display_attrib_sel
variable start_type
variable end_type
variable display_attribute
variable flow_direction
variable list_objs
set sel_obj_names ""
foreach obj_idx [$list_objs curselection] {
set sel_obj_names [lappend sel_obj_names [$list_objs get $obj_idx]]
}
set options [list \
$endtype_sel \
$objects_sel \
$in_button_sel \
$out_button_sel \
$either_button_sel \
$both_button_sel \
$display_attrib_sel \
$start_type \
$end_type \
$display_attribute \
$flow_direction \
$sel_obj_names]
puts $file_channel "$module_name"
puts $file_channel "$options"
return 0
}
proc Apol_Analysis_dirflow::get_current_results_state { } {
variable dirflow_tree
variable dirflow_info_text
variable endtype_sel
variable objects_sel
variable in_button_sel
variable out_button_sel
variable either_button_sel
variable both_button_sel
variable display_attrib_sel
variable start_type
variable end_type
variable display_attribute
variable flow_direction
variable list_objs
set selected_objs [$list_objs curselection]
set options [list \
$dirflow_tree \
$dirflow_info_text \
$endtype_sel \
$objects_sel \
$in_button_sel \
$out_button_sel \
$either_button_sel \
$both_button_sel \
$display_attrib_sel \
$start_type \
$end_type \
$display_attribute \
$flow_direction \
$selected_objs]
return $options
}
proc Apol_Analysis_dirflow::set_display_to_results_state { query_options } {
variable dirflow_tree
variable dirflow_info_text
variable endtype_sel
variable objects_sel
variable in_button_sel
variable out_button_sel
variable either_button_sel
variable both_button_sel
variable display_attrib_sel
variable start_type
variable end_type
variable display_attribute
variable flow_direction
variable list_objs
Apol_Analysis_dirflow::clear_all_button_press
set dirflow_tree [lindex $query_options 0]
set dirflow_info_text [lindex $query_options 1]
set endtype_sel [lindex $query_options 2]
set objects_sel [lindex $query_options 3]
set in_button_sel [lindex $query_options 4]
set out_button_sel [lindex $query_options 5]
set either_button_sel [lindex $query_options 6]
set both_button_sel [lindex $query_options 7]
set display_attrib_sel [lindex $query_options 8]
set end_type [lindex $query_options 10]
set display_attribute [lindex $query_options 11]
set flow_direction [lindex $query_options 12]
set active_objs [lindex $query_options 13]
foreach i $active_objs {
$list_objs selection set $i
}
Apol_Analysis_dirflow::config_objects_list_state
Apol_Analysis_dirflow::config_endtype_state
Apol_Analysis_dirflow::config_attrib_comboBox_state
set start_type [lindex $query_options 9]
return 0
}
proc Apol_Analysis_dirflow::free_results_data {query_options} {
set dirflow_tree [lindex $query_options 12]
set dirflow_info_text [lindex $query_options 13]
if {[winfo exists $dirflow_tree]} {
$dirflow_tree delete [$dirflow_tree nodes root]
if {[$dirflow_tree nodes root] != ""} {
return -1
}
destroy $dirflow_tree
}
if {[winfo exists $dirflow_info_text]} {
$dirflow_info_text delete 0.0 end
destroy $dirflow_info_text
}
return 0
}
proc Apol_Analysis_dirflow::treeSelect {dirflow_tree dirflow_info_text node} {
$dirflow_tree selection set $node
if {$node == [$dirflow_tree nodes root]} {
Apol_Analysis_dirflow::display_root_type_info $node \
$dirflow_info_text $dirflow_tree
} else {
Apol_Analysis_dirflow::render_target_type_data \
[$dirflow_tree itemcget $node -data] \
$dirflow_info_text $dirflow_tree $node
}
Apol_Analysis_dirflow::formatInfoText $dirflow_info_text
ApolTop::makeTextBoxReadOnly $dirflow_info_text
return 0
}
proc Apol_Analysis_dirflow::display_root_type_info { source_type dirflow_info_text dirflow_tree } {
$dirflow_info_text configure -state normal
$dirflow_info_text delete 0.0 end
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end "Direct Information Flow Analysis: Starting type: "
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_tag $startIdx $endIdx
set startIdx $endIdx
$dirflow_info_text insert end $source_type
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_type_tag $startIdx $endIdx
set startIdx $endIdx
$dirflow_info_text configure -wrap word
set start_idx [$dirflow_info_text index insert]
$dirflow_info_text insert end $Apol_Analysis_dirflow::root_text
$dirflow_info_text tag add ROOT_TEXT $start_idx end
$dirflow_info_text tag configure ROOT_TEXT -font $ApolTop::text_font
return 0
}
proc Apol_Analysis_dirflow::render_target_type_data {data dirflow_info_text dirflow_tree node} {
$dirflow_info_text configure -state normal
$dirflow_info_text delete 0.0 end
$dirflow_info_text configure -wrap none
if { $data == "" } {
return ""
}
set cur_end_type [lindex $data 0]
set flow_dir [lindex $data 1]
set num_objs [lindex $data 2]
set curIdx 3
set startIdx [$dirflow_info_text index insert]
set start_type [$dirflow_tree itemcget [$dirflow_tree parent $node] -text]
if {$flow_dir == "both"} {
$dirflow_info_text insert end "Information flows both into and out of "
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_tag $startIdx $endIdx
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end $start_type
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_type_tag $startIdx $endIdx
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end " - \[from/to\] "
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_tag $startIdx $endIdx
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end $cur_end_type
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_type_tag $startIdx $endIdx
set startIdx $endIdx
$dirflow_info_text insert end "\n\nObject classes for "
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
$dirflow_info_text insert end "\[IN/OUT\]"
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_type_tag $startIdx $endIdx
set startIdx $endIdx
$dirflow_info_text insert end " flows:"
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
for {set i 0} {$i<$num_objs} {incr i} {
if {[lindex $data $curIdx] == "1"} {
incr curIdx
$dirflow_info_text insert end "\n\t"
$dirflow_info_text insert end [lindex $data $curIdx]
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::subtitle_tag $startIdx $endIdx
incr curIdx
set num_rules [lindex $data $curIdx]
for {set j 0} {$j<$num_rules} {incr j} {
$dirflow_info_text insert end "\n\t"
set startIdx [$dirflow_info_text index insert]
incr curIdx
set rule [lindex $data $curIdx]
set end_link_idx [string first "\]" [string trim $rule] 0]
set lineno [string range [string trim [string range $rule 0 $end_link_idx]] 1 end-1]
set lineno [string trim $lineno]
set rule [string range $rule [expr $end_link_idx + 1] end]
if {![ApolTop::is_binary_policy]} {
$dirflow_info_text insert end "\[$lineno\]"
Apol_PolicyConf::insertHyperLink $dirflow_info_text "$startIdx wordstart + 1c" "$startIdx wordstart + [expr [string length $lineno] + 1]c"
}
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end " $rule"
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::rules_tag $startIdx $endIdx
incr curIdx
if {[lindex $data $curIdx] == 0} {
$dirflow_info_text insert end " "
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end "\[Disabled\]"
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::disabled_rule_tag $startIdx $endIdx
}
set startIdx [$dirflow_info_text index insert]
}
}
incr curIdx
}
} else {
if { $flow_dir == "in" } {
$dirflow_info_text insert end "Information flows into "
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_tag $startIdx $endIdx
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end $start_type
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_type_tag $startIdx $endIdx
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end " - from "
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_tag $startIdx $endIdx
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end $cur_end_type
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_type_tag $startIdx $endIdx
set startIdx $endIdx
} elseif { $flow_dir == "out" } {
$dirflow_info_text insert end "Information flows out of "
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_tag $startIdx $endIdx
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end $start_type
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_type_tag $startIdx $endIdx
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end " - to "
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_tag $startIdx $endIdx
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end $cur_end_type
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_type_tag $startIdx $endIdx
set startIdx $endIdx
}
$dirflow_info_text insert end "\n\nObject classes for "
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
set flow_dir [string toupper $flow_dir]
$dirflow_info_text insert end $flow_dir
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::title_type_tag $startIdx $endIdx
set startIdx $endIdx
$dirflow_info_text insert end " flows:"
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
for {set i 0} {$i<$num_objs} {incr i} {
if { [lindex $data $curIdx] == "1" } {
incr curIdx
$dirflow_info_text insert end "\n\t"
$dirflow_info_text insert end [lindex $data $curIdx]
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::subtitle_tag $startIdx $endIdx
incr curIdx
set num_rules [lindex $data $curIdx]
for {set j 0} {$j<$num_rules} {incr j} {
$dirflow_info_text insert end "\n\t"
set startIdx [$dirflow_info_text index insert]
incr curIdx
set rule [lindex $data $curIdx]
set end_link_idx [string first "\]" [string trim $rule] 0]
set lineno [string range [string trim [string range $rule 0 $end_link_idx]] 1 end-1]
set lineno [string trim $lineno]
set rule [string range $rule [expr $end_link_idx + 1] end]
if {![ApolTop::is_binary_policy]} {
$dirflow_info_text insert end "\[$lineno\]"
Apol_PolicyConf::insertHyperLink $dirflow_info_text "$startIdx wordstart + 1c" "$startIdx wordstart + [expr [string length $lineno] + 1]c"
}
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end " $rule"
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::rules_tag $startIdx $endIdx
incr curIdx
if {[lindex $data $curIdx] == 0} {
$dirflow_info_text insert end " "
set startIdx [$dirflow_info_text index insert]
$dirflow_info_text insert end "\[Disabled\]"
set endIdx [$dirflow_info_text index insert]
$dirflow_info_text tag add $Apol_Analysis_dirflow::disabled_rule_tag $startIdx $endIdx
}
set startIdx [$dirflow_info_text index insert]
}
}
incr curIdx
}
}
return
}
proc Apol_Analysis_dirflow::formatInfoText { tb } {
$tb tag configure $Apol_Analysis_dirflow::title_tag -font {Helvetica 14 bold}
$tb tag configure $Apol_Analysis_dirflow::title_type_tag -foreground blue -font {Helvetica 14 bold}
$tb tag configure $Apol_Analysis_dirflow::subtitle_tag -font {Helvetica 11 bold}
$tb tag configure $Apol_Analysis_dirflow::rules_tag -font $ApolTop::text_font
$tb tag configure $Apol_Analysis_dirflow::counters_tag -foreground blue -font {Helvetica 11 bold}
$tb tag configure $Apol_Analysis_dirflow::types_tag -font $ApolTop::text_font
$tb tag configure $Apol_Analysis_dirflow::disabled_rule_tag -foreground red
Apol_PolicyConf::configure_HyperLinks $tb
}
proc Apol_Analysis_dirflow::insert_src_type_node { dirflow_tree query_args} {
variable start_type
$dirflow_tree insert end root $start_type \
-text $start_type \
-open 1 \
-drawcross auto \
-data "$query_args"
return [$dirflow_tree nodes root]
}
proc Apol_Analysis_dirflow::create_target_type_nodes { parent dirflow_tree results_list } {
if { [file tail [$dirflow_tree parent $parent]] == [file tail $parent] } {
return 0
}
if { [$dirflow_tree nodes $parent] == "" } {
set num_target_types [lindex $results_list 1]
set curentIdx 2
for { set x 0 } { $x < $num_target_types } { incr x } {
set target_name [lindex $results_list $curentIdx]
set nextIdx [Apol_Analysis_dirflow::parseList_get_index_next_node $curentIdx $results_list]
if {$nextIdx == -1} {
return -code error "Error parsing results. See stdout for more information."
}
set target_node "${parent}/${target_name}/"
$dirflow_tree insert end $parent $target_node \
-text $target_name \
-open 0 \
-drawcross allways \
-data [lrange $results_list $curentIdx [expr $nextIdx-1]]
set curentIdx $nextIdx
}
set nodes [lsort [$dirflow_tree nodes $parent]]
$dirflow_tree reorder $parent $nodes
$dirflow_tree configure -redraw 1
}
return 0
}
proc Apol_Analysis_dirflow::parseList_get_index_next_node { currentIdx results_list } {
incr currentIdx
set direction [lindex $results_list $currentIdx]
incr currentIdx
set num_classes [lindex $results_list $currentIdx]
incr currentIdx
if {$direction == "both"} {
for {set i 0} {$i < $num_classes} {incr i} {
if { [lindex $results_list $currentIdx] == "1" } {
incr currentIdx 2
set num_rules [lindex $results_list $currentIdx]
incr currentIdx [expr $num_rules * 2]
}
incr currentIdx
}
} elseif {$direction == "in" || $direction == "out"} {
for {set i 0} {$i < $num_classes} {incr i} {
if { [lindex $results_list $currentIdx] == "1" } {
incr currentIdx 2
set num_rules [lindex $results_list $currentIdx]
incr currentIdx [expr $num_rules * 2]
}
incr currentIdx
}
} else {
puts "Invalid flow direction ($direction) encountered while parsing results."
return -1
}
return $currentIdx
}
proc Apol_Analysis_dirflow::create_result_tree_structure { dirflow_tree results_list query_args} {
set home_node [Apol_Analysis_dirflow::insert_src_type_node $dirflow_tree \
$query_args]
set rt [catch {Apol_Analysis_dirflow::create_target_type_nodes $home_node \
$dirflow_tree $results_list} err]
if {$rt != 0} {
return -code error $err
}
Apol_Analysis_dirflow::treeSelect \
$Apol_Analysis_dirflow::dirflow_tree \
$Apol_Analysis_dirflow::dirflow_info_text \
$home_node
return 0
}
proc Apol_Analysis_dirflow::do_child_analysis { dirflow_tree selected_node } {
ApolTop::setBusyCursor
if { [$dirflow_tree nodes $selected_node] == "" } {
set query_args [$dirflow_tree itemcget [$dirflow_tree nodes root] -data]
set start_t [file tail $selected_node]
set rt [catch {set results [apol_DirectInformationFlowAnalysis \
$start_t \
[lindex $query_args 1] \
[lindex $query_args 2] \
[lindex $query_args 3] \
[lindex $query_args 4] \
[lindex $query_args 5]] } err]
if {$rt != 0} {
return -code error $err
}
Apol_Analysis_dirflow::create_target_type_nodes $selected_node $dirflow_tree $results
}
ApolTop::resetBusyCursor
return 0
}
proc Apol_Analysis_dirflow::create_resultsDisplay { results_frame } {
variable dirflow_tree
variable dirflow_info_text
set pw [PanedWindow $results_frame.pw -side top]
set pw_tree [$pw add]
set pw_info [$pw add -weight 5]
set frm_tree [TitleFrame [$pw getframe 0].frm_tree -text "Direct Information Flow Tree"]
set frm_info [TitleFrame [$pw getframe 1].frm_info -text "Direct Information Flow Data"]
set sw_tree [ScrolledWindow [$frm_tree getframe].sw_tree -auto none]
set sw_info [ScrolledWindow [$frm_info getframe].sw_info -auto none]
set dirflow_tree [Tree [$sw_tree getframe].dirflow_tree \
-relief flat -borderwidth 0 -highlightthickness 0 \
-redraw 0 -bg white -showlines 1 -padx 0 \
-opencmd {Apol_Analysis_dirflow::do_child_analysis $Apol_Analysis_dirflow::dirflow_tree}]
$sw_tree setwidget $dirflow_tree
set dirflow_info_text [text [$sw_info getframe].dirflow_info_text \
-wrap none \
-bg white \
-font $ApolTop::text_font]
$sw_info setwidget $dirflow_info_text
bind $dirflow_info_text <Enter> {focus %W}
pack $pw -fill both -expand yes -anchor nw
pack $frm_tree -fill both -expand yes -anchor nw
pack $frm_info -fill both -expand yes
pack $sw_tree -fill both -expand yes
pack $sw_info -fill both -expand yes
$dirflow_tree bindText <ButtonPress-1> {
Apol_Analysis_dirflow::treeSelect \
$Apol_Analysis_dirflow::dirflow_tree \
$Apol_Analysis_dirflow::dirflow_info_text}
$dirflow_tree bindText <Double-ButtonPress-1> {
Apol_Analysis_dirflow::treeSelect \
$Apol_Analysis_dirflow::dirflow_tree \
$Apol_Analysis_dirflow::dirflow_info_text}
return $dirflow_tree
}
proc Apol_Analysis_dirflow::get_unselected_objects { } {
variable list_objs
variable objects_sel
set unselected_objects ""
set len [$list_objs size]
if {$objects_sel} {
for {set i 0} {$i < $len} {incr i} {
if {![$list_objs selection includes $i]} {
set unselected_objects [lappend unselected_objects [$list_objs get $i]]
}
}
}
return $unselected_objects
}
proc Apol_Analysis_dirflow::reset_variables { } {
set Apol_Analysis_dirflow::start_type ""
set Apol_Analysis_dirflow::end_type ""
set Apol_Analysis_dirflow::flow_direction ""
set Apol_Analysis_dirflow::dirflow_tree ""
set Apol_Analysis_dirflow::dirflow_info_text ""
set Apol_Analysis_dirflow::in_button_sel 0
set Apol_Analysis_dirflow::out_button_sel 0
set Apol_Analysis_dirflow::either_button_sel 0
set Apol_Analysis_dirflow::both_button_sel 0
set Apol_Analysis_dirflow::endtype_sel 0
set Apol_Analysis_dirflow::objects_sel 0
set Apol_Analysis_dirflow::display_attrib_sel 0
set Apol_Analysis_dirflow::display_attribute ""
return 0
}
proc Apol_Analysis_dirflow::update_display_variables { } {
variable start_type
set start_type $Apol_Analysis_dirflow::start_type
return 0
}
proc Apol_Analysis_dirflow::config_attrib_comboBox_state { } {
variable combo_attribute
variable display_attrib_sel
variable combo_start
if { $display_attrib_sel } {
$combo_attribute configure -state normal -entrybg white
set Apol_Analysis_dirflow::start_type ""
Apol_Analysis_dirflow::change_types_list
} else {
$combo_attribute configure -state disabled -entrybg $ApolTop::default_bg_color
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_start configure -values $attrib_typesList
}
return 0
}
proc Apol_Analysis_dirflow::config_endtype_state { } {
variable entry_end
variable endtype_sel
variable end_type
if { $endtype_sel } {
$entry_end configure -state normal -background white
} else {
$entry_end configure -state disabled -background $ApolTop::default_bg_color
}
return 0
}
proc Apol_Analysis_dirflow::config_objects_list_state { } {
variable list_objs
variable objects_sel
variable sw_objs
if { $objects_sel } {
ApolTop::enable_tkListbox $list_objs
$list_objs configure -selectmode multiple
$list_objs configure -background white
$sw_objs configure -scrollbar vertical
} else {
$list_objs configure -background $ApolTop::default_bg_color
$sw_objs configure -scrollbar none
ApolTop::disable_tkListbox $list_objs
}
return 0
}
proc Apol_Analysis_dirflow::in_button_press { } {
variable out_button
variable in_button
variable either_button
variable both_button
variable flow_direction
set flow_direction "in"
$out_button deselect
$either_button deselect
$both_button deselect
$in_button select
return 0
}
proc Apol_Analysis_dirflow::out_button_press { } {
variable in_button
variable either_button
variable both_button
variable out_button
variable flow_direction
set flow_direction "out"
$in_button deselect
$either_button deselect
$both_button deselect
$out_button select
return 0
}
proc Apol_Analysis_dirflow::either_button_press { } {
variable in_button
variable out_button
variable both_button
variable either_button
variable flow_direction
set flow_direction "either"
$out_button deselect
$in_button deselect
$both_button deselect
$either_button select
return 0
}
proc Apol_Analysis_dirflow::both_button_press { } {
variable in_button
variable out_button
variable either_button
variable flow_direction
variable both_button
set flow_direction "both"
$out_button deselect
$either_button deselect
$in_button deselect
$both_button select
return 0
}
proc Apol_Analysis_dirflow::select_all_button_press { } {
variable list_objs
$list_objs selection set 0 end
return 0
}
proc Apol_Analysis_dirflow::clear_all_button_press { } {
variable list_objs
$list_objs selection clear 0 end
return 0
}
proc Apol_Analysis_dirflow::change_types_list { } {
variable combo_start
variable display_attribute
if { $display_attribute != "" } {
$combo_start configure -text ""
set rt [catch {set attrib_typesList [apol_GetAttribTypesList $display_attribute]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
}
set attrib_typesList [lsort $attrib_typesList]
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_start configure -values $attrib_typesList
} else {
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_start configure -values $attrib_typesList
}
return 0
}
proc Apol_Analysis_dirflow::display_mod_options { opts_frame } {
Apol_Analysis_dirflow::reset_variables
Apol_Analysis_dirflow::create_options $opts_frame
Apol_Analysis_dirflow::populate_ta_list
if {[ApolTop::is_policy_open]} {
set Apol_Analysis_dirflow::display_attrib_sel 0
Apol_Analysis_dirflow::config_attrib_comboBox_state
Apol_Analysis_dirflow::change_types_list
set Apol_Analysis_dirflow::in_button_sel 1
$Apol_Analysis_dirflow::in_button select
Apol_Analysis_dirflow::in_button_press
} else {
Apol_Analysis_dirflow::config_attrib_comboBox_state
}
Apol_Analysis_dirflow::config_endtype_state
Apol_Analysis_dirflow::config_objects_list_state
return 0
}
proc Apol_Analysis_dirflow::populate_ta_list { } {
variable combo_start
variable combo_attribute
variable list_objs
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_start configure -values $attrib_typesList
$combo_attribute configure -values $Apol_Types::attriblist
set len [llength $Apol_Class_Perms::class_list]
for {set i 0} {$i < $len } {incr i} {
set temp [lindex $Apol_Class_Perms::class_list $i]
$list_objs insert end $temp
}
return 0
}
proc Apol_Analysis_dirflow::create_options { options_frame } {
variable combo_attribute
variable combo_start
variable display_attrib_sel
variable display_attribute
variable descriptive_text
variable start_type
variable end_type
variable endtype_sel
variable entry_end
variable list_objs
variable objects_sel
variable in_button_sel
variable out_button_sel
variable either_button_sel
variable both_button_sel
variable in_button
variable out_button
variable either_button
variable both_button
variable cb_attrib
variable sw_objs
set entry_frame [frame $options_frame.entry_frame]
set left_frame [TitleFrame $entry_frame.left_frame -text "Required parameters"]
set right_frame [TitleFrame $entry_frame.right_frame -text "Optional result filters"]
set left [$left_frame getframe]
set right [$right_frame getframe]
set start_attrib_frame [frame $left.start_attrib_frame]
set start_frame [frame $start_attrib_frame.start_frame]
set attrib_frame [frame $start_attrib_frame.attrib_frame]
set object_opt_frame [frame $right.object_opt_frame]
set objcl_frame [frame $object_opt_frame.objcl_frame]
set bttns_frame [frame $object_opt_frame.bttns_frame]
set flowtype_frame [frame $left.flowtype_frame]
set ckbttn_frame [frame $flowtype_frame.ckbttn_frame]
set endtype_frame [frame $right.endtype_frame]
set lbl_start_type [Label $start_frame.lbl_start_type \
-text "Starting type:"]
set combo_start [ComboBox $start_frame.combo_start \
-helptext "You must choose a starting type for information flow" \
-editable 1 \
-textvariable Apol_Analysis_dirflow::start_type \
-entrybg white \
-exportselection 0]
set lbl_flowtype [Label $flowtype_frame.lbl_flowtype \
-text "Flow direction:"]
set in_button [checkbutton $ckbttn_frame.in_button \
-text "In" \
-variable Apol_Analysis_dirflow::in_button_sel \
-offvalue 0 -onvalue 1 \
-command { Apol_Analysis_dirflow::in_button_press }]
set out_button [checkbutton $ckbttn_frame.out_button \
-text "Out" \
-variable Apol_Analysis_dirflow::out_button_sel \
-offvalue 0 -onvalue 1 \
-command { Apol_Analysis_dirflow::out_button_press }]
set either_button [checkbutton $ckbttn_frame.either_button \
-text "Either" \
-variable Apol_Analysis_dirflow::either_button_sel \
-offvalue 0 -onvalue 1 \
-command { Apol_Analysis_dirflow::either_button_press }]
set both_button [checkbutton $ckbttn_frame.both_button \
-text "Both" \
-variable Apol_Analysis_dirflow::both_button_sel \
-offvalue 0 -onvalue 1 \
-command { Apol_Analysis_dirflow::both_button_press }]
set cb_attrib [checkbutton $attrib_frame.cb_attrib \
-text "Filter starting types to select using attribute:" \
-variable Apol_Analysis_dirflow::display_attrib_sel \
-offvalue 0 -onvalue 1 \
-command { Apol_Analysis_dirflow::config_attrib_comboBox_state }]
set combo_attribute [ComboBox $attrib_frame.combo_attribute \
-textvariable Apol_Analysis_dirflow::display_attribute \
-modifycmd { Apol_Analysis_dirflow::change_types_list} \
-exportselection 0]
set clear_all_bttn [button $bttns_frame.clear_all_bttn \
-text "Clear All" \
-command {Apol_Analysis_dirflow::clear_all_button_press} ]
set select_all_bttn [button $bttns_frame.select_all_bttn \
-text "Select All" \
-command {Apol_Analysis_dirflow::select_all_button_press} ]
set cb_endtype [checkbutton $endtype_frame.cb_endtype \
-text "Find end types using regular expression:" \
-variable Apol_Analysis_dirflow::endtype_sel \
-offvalue 0 -onvalue 1 -justify left -wraplength 150 \
-command { Apol_Analysis_dirflow::config_endtype_state }]
set entry_end [Entry $endtype_frame.entry_end \
-helptext "You may choose an optional result type" \
-editable 1 \
-textvariable Apol_Analysis_dirflow::end_type \
-exportselection 0]
set cb_objects [checkbutton $objcl_frame.cb_objects \
-text "Only include rules with selected object classes:" \
-variable Apol_Analysis_dirflow::objects_sel \
-offvalue 0 -onvalue 1 \
-justify left \
-command {Apol_Analysis_dirflow::config_objects_list_state }]
set sw_objs [ScrolledWindow $objcl_frame.sw_objs -auto both]
set list_objs [listbox [$sw_objs getframe].list_objs -height 7 \
-highlightthickness 0 \
-selectmode multiple \
-exportselection 0]
$sw_objs setwidget $list_objs
pack $entry_frame -side left -anchor nw -fill both -padx 5 -expand yes
pack $left_frame $right_frame -side left -anchor nw -fill both -padx 5 -expand yes
pack $left $right -fill both -expand yes
pack $start_attrib_frame $flowtype_frame -side top -anchor nw -fill both -expand yes -pady 5
pack $start_frame $attrib_frame -side top -anchor nw -fill both -expand yes
pack $lbl_flowtype -side top -anchor nw
pack $ckbttn_frame -side left -anchor nw -fill both -expand yes
pack $object_opt_frame $endtype_frame -side left -padx 10 -fill both -expand yes
pack $bttns_frame -side bottom -fill both -expand yes
pack $objcl_frame -side top -expand yes -fill both
pack $select_all_bttn -side left -anchor nw -fill x -expand yes -pady 2
pack $clear_all_bttn -side right -anchor nw -fill x -expand yes -pady 2
pack $cb_objects -side top -anchor nw
pack $sw_objs -fill both -anchor nw -expand yes -fill both
pack $lbl_start_type -side top -anchor nw
pack $combo_start -side left -anchor nw -expand yes -fill x
pack $cb_attrib -side top -anchor nw
pack $combo_attribute -side top -anchor nw -padx 15 -expand yes -fill x
pack $in_button $out_button $either_button $both_button -side left -anchor nw -expand yes -fill x
pack $cb_endtype -side top -anchor nw
pack $entry_end -side left -anchor nw -fill x -expand yes
bindtags $combo_start.e [linsert [bindtags $combo_start.e] 3 start_list_Tag]
bind start_list_Tag <KeyPress> {ApolTop::_create_popup $Apol_Analysis_dirflow::combo_start %W %K}
bindtags $combo_attribute.e [linsert [bindtags $combo_attribute.e] 3 attribs_list_Tag]
bind attribs_list_Tag <KeyPress> { ApolTop::_create_popup $Apol_Analysis_dirflow::combo_attribute %W %K }
bindtags $list_objs [linsert [bindtags $list_objs] 3 list_objs_Tag]
return 0
}
namespace eval Apol_Analysis_fulflow {
variable comment_text
variable combo_attribute
variable combo_start
variable info_button_text "\n\nThis analysis generates the results of a Transitive Information Flow \
analysis beginning from the starting type selected. The results of the \
analysis are presented in tree form with the root of the tree being the \
start point for the analysis.\n\nEach child node in the tree represents \
a type in the current policy for which there is a transitive information \
flow to or from its parent node. If 'flow to' is selected the information \
flows from the child to the parent. If 'flow from' is selected then \
information flows from the parent to the child.\n\nThe results of the \
analysis may be optionally filtered by object classes and/or permissions, \
intermediate types, or an end type regular expression.\n\nNOTE: For any \
given generation, if the parent and the child are the same, you cannot \
open the child. This avoids cyclic analyses.\n\nFor additional help on \
this topic select \"Information Flow Analysis\" from the help menu."
variable root_text "\n\nThis tab provides the results of a Transitive Information Flow analysis \
beginning from the starting type selected above. The results of the analysis \
are presented in tree form with the root of the tree (this node) being the \
start point for the analysis.\n\nEach child node in the tree represents a type \
in the current policy for which there is a transitive information flow to or \
from (depending on your selection above) its parent node.\n\nNOTE: For any \
given generation, if the parent and the child are the same, you cannot open \
the child. This avoids cyclic analyses.\n\n"
variable in_button
variable out_button
variable entry_end
variable cb_attrib
variable find_flows_Dlg
set find_flows_Dlg .find_flows_Dlg
variable find_flows_results_Dlg
set find_flows_results_Dlg .find_flows_results_Dlg
variable progressDlg
set progressDlg .progress
variable f_opts
variable advanced_filter_Dlg
set advanced_filter_Dlg .apol_fulflow_advanced_filter_Dlg
variable time_limit_hr "0"
variable time_limit_min "0"
variable time_limit_sec "30"
variable flow_limit_num "20"
variable time_exp_lbl
variable num_found_lbl
variable find_flows_start 0
variable endtype_sel 0
variable in_button_sel 0
variable out_button_sel 0
variable display_attrib_sel 0
variable fulflow_tree ""
variable fulflow_info_text ""
variable start_type ""
variable end_type ""
variable display_attribute ""
variable flow_direction ""
variable title_tag TITLE
variable title_type_tag TITLE_TYPE
variable subtitle_tag SUBTITLES
variable rules_tag RULES
variable counters_tag COUNTERS
variable types_tag TYPE
variable find_flows_tag FLOWS
variable disabled_rule_tag DISABLE_RULE
variable abort_trans_analysis 0
variable orig_cursor ""
variable excluded_tag " (Excluded)"
variable progressmsg ""
variable progress_indicator -1
variable start_time
Apol_Analysis::register_analysis_modules "Apol_Analysis_fulflow" "Transitive Information Flow"
}
proc Apol_Analysis_fulflow::initialize { } {
Apol_Analysis_fulflow::reset_variables
if {[ApolTop::is_policy_open]} {
set Apol_Analysis_fulflow::display_attrib_sel 0
Apol_Analysis_fulflow::config_attrib_comboBox_state
Apol_Analysis_fulflow::change_types_list
set Apol_Analysis_fulflow::in_button_sel 1
$Apol_Analysis_fulflow::in_button select
Apol_Analysis_fulflow::in_button_press
set Apol_Analysis_fulflow::endtype_sel 0
Apol_Analysis_fulflow::config_endtype_state
}
return 0
}
proc Apol_Analysis_fulflow::get_analysis_info {} {
return $Apol_Analysis_fulflow::info_button_text
}
proc Apol_Analysis_fulflow::get_results_raised_tab {} {
return $Apol_Analysis_fulflow::fulflow_info_text
}
proc Apol_Analysis_fulflow::do_analysis { results_frame } {
variable start_type
variable end_type
variable endtype_sel
variable fulflow_tree
variable fulflow_info_text
variable flow_direction
variable advanced_filter_Dlg
variable f_opts
set rt [catch {Apol_Analysis_fulflow::load_default_perm_map} err]
if {$rt != 0} {
return -code error $err
}
if {![array exists f_opts] || [array names f_opts "$advanced_filter_Dlg,name"] == ""} {
Apol_Analysis_fulflow::advanced_filters_create_object $advanced_filter_Dlg
}
set num_object_classes 0
set perm_options ""
set objects_sel "0"
set filter_types "0"
foreach class $f_opts($advanced_filter_Dlg,class_list) {
set perms ""
set idx [string first $Apol_Analysis_fulflow::excluded_tag $class]
if {$idx == -1} {
set class_elements [array names f_opts "$advanced_filter_Dlg,perm_status_array,$class,*"]
set exclude_perm_added 0
foreach element $class_elements {
set perm [lindex [split $element ","] 3]
if {![string equal $f_opts($element) "exclude"]} {
continue
}
if {$exclude_perm_added == 0} {
incr num_object_classes
set perm_options [lappend perm_options $class]
set exclude_perm_added 1
}
set perms [lappend perms $perm]
}
if {$perms != ""} {
set perm_options [lappend perm_options [llength $perms]]
foreach perm $perms {
set perm_options [lappend perm_options $perm]
}
}
} else {
set class [string range $class 0 [expr $idx - 1]]
set perm_options [lappend perm_options $class]
set perm_options [lappend perm_options 0]
incr num_object_classes
}
}
if {$num_object_classes} {
set objects_sel "1"
}
if {$f_opts($advanced_filter_Dlg,filtered_excl_types) != ""} {
set filter_types "1"
}
Apol_Analysis_fulflow::display_progressDlg
set rt [catch {set results [apol_TransitiveFlowAnalysis \
$start_type \
$flow_direction \
$objects_sel \
$num_object_classes \
$endtype_sel \
$end_type \
$perm_options \
$filter_types \
$f_opts($advanced_filter_Dlg,filtered_excl_types) \
$f_opts($advanced_filter_Dlg,threshhold_cb_value) \
$f_opts($advanced_filter_Dlg,threshhold_value)]} err]
if {$rt != 0} {
Apol_Analysis_fulflow::destroy_progressDlg
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error $err
}
set query_args [list \
$start_type \
$flow_direction \
$objects_sel \
$num_object_classes \
$endtype_sel \
$end_type \
$perm_options \
$filter_types \
$f_opts($advanced_filter_Dlg,filtered_excl_types) \
$f_opts($advanced_filter_Dlg,threshhold_cb_value) \
$f_opts($advanced_filter_Dlg,threshhold_value)]
set fulflow_tree [Apol_Analysis_fulflow::create_resultsDisplay $results_frame]
set rt [catch {Apol_Analysis_fulflow::create_result_tree_structure $fulflow_tree $results $query_args} err]
if {$rt != 0} {
Apol_Analysis_fulflow::destroy_progressDlg
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error $err
}
Apol_Analysis_fulflow::destroy_progressDlg
set Apol_Analysis_fulflow::progress_indicator -1
return 0
}
proc Apol_Analysis_fulflow::close { } {
Apol_Analysis_fulflow::reset_variables
$Apol_Analysis_fulflow::comment_text delete 1.0 end
$Apol_Analysis_fulflow::combo_attribute configure -state disabled \
-entrybg $ApolTop::default_bg_color
$Apol_Analysis_fulflow::combo_attribute configure -values ""
set Apol_Analysis_fulflow::endtype_sel 0
Apol_Analysis_fulflow::config_endtype_state
Apol_Analysis_fulflow::advanced_filters_destroy_dialog $Apol_Analysis_fulflow::advanced_filter_Dlg
Apol_Analysis_fulflow::advanced_filters_destroy_object $Apol_Analysis_fulflow::advanced_filter_Dlg
return 0
}
proc Apol_Analysis_fulflow::open { } {
variable in_button
variable cb_attrib
Apol_Analysis_fulflow::advanced_filters_destroy_all_dialogs_on_open
Apol_Analysis_fulflow::populate_ta_list
set in_button_sel 1
$in_button select
Apol_Analysis_fulflow::in_button_press
Apol_Analysis_fulflow::config_attrib_comboBox_state
return 0
}
proc Apol_Analysis_fulflow::load_advanced_filters_options {query_options curr_idx path_name parentDlg} {
variable f_opts
Apol_Analysis_fulflow::advanced_filters_destroy_object $path_name
Apol_Analysis_fulflow::advanced_filters_create_object $path_name
set i $curr_idx
if {[lindex $query_options $i] != "\{\}"} {
set split_list [split [lindex $query_options $i] "\{"]
set perm_status_list [lappend perm_status_list [lindex $split_list 1]]
set i [expr $i + 1]
while {[llength [split [lindex $query_options $i] "\}"]] == 1} {
set perm_status_list [lappend perm_status_list [lindex $query_options $i]]
incr i
}
set perm_status_list [lappend perm_status_list [lindex [split [lindex $query_options $i] "\}"] 0]]
for {set j 0} {$j < [llength $perm_status_list]} {incr j} {
set elements [split [lindex $perm_status_list $j] ","]
set class_name [lindex $elements 0]
if {[lsearch -exact $f_opts($path_name,class_list) $class_name] == -1} {
puts "Invalid class: $class_name.....ignoring."
continue
}
set perm [lindex $elements 1]
set rt [catch {set perms_list [apol_GetPermsByClass $class_name 1]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message $err \
-parent $parentDlg
}
if {[lsearch -exact $perms_list $perm] == -1} {
puts "Invalid permission: $perm.....ignoring."
continue
}
set element [lindex $perm_status_list $j]
incr j
set val [lindex $perm_status_list $j]
set str "$path_name,perm_status_array,$element"
set f_opts($str) $val
}
}
incr i
set invalid_types ""
if {[lindex $query_options $i] != "\{\}"} {
set split_list [split [lindex $query_options $i] "\{"]
if {[llength $split_list] == 1} {
if {[lsearch -exact $Apol_Types::typelist [lindex $query_options $i]] != -1} {
set f_opts($path_name,master_excl_types_list) [lindex $query_options $i]
} else {
set invalid_types [lappend invalid_types [lindex $query_options $i]]
}
} else {
if {[lsearch -exact $Apol_Types::typelist [lindex $split_list 1]] != -1} {
set f_opts($path_name,master_excl_types_list) [lappend f_opts($path_name,master_excl_types_list) \
[lindex $split_list 1]]
} else {
set invalid_types [lappend invalid_types [lindex $split_list 1]]
}
set i [expr $i + 1]
while {[llength [split [lindex $query_options $i] "\}"]] == 1} {
if {[lsearch -exact $Apol_Types::typelist [lindex $query_options $i]] != -1} {
set f_opts($path_name,master_excl_types_list) [lappend f_opts($path_name,master_excl_types_list) \
[lindex $query_options $i]]
} else {
set invalid_types [lappend invalid_types [lindex $query_options $i]]
}
incr i
}
set end_element [lindex [split [lindex $query_options $i] "\}"] 0]
if {[lsearch -exact $Apol_Types::typelist $end_element] != -1} {
set f_opts($path_name,master_excl_types_list) [lappend f_opts($path_name,master_excl_types_list) \
$end_element]
} else {
set invalid_types [lappend invalid_types $end_element]
}
set idx [lsearch -exact $f_opts($path_name,master_excl_types_list) "self"]
if {$idx != -1} {
set f_opts($path_name,master_excl_types_list) [lreplace $f_opts($path_name,master_excl_types_list) \
$idx $idx]
}
}
}
if {$invalid_types != ""} {
puts "The following types do not exist in the currently \
loaded policy and were ignored:\n\n"
foreach type $invalid_types {
puts "$type\n"
}
}
set tmp_list $f_opts($path_name,master_incl_types_list)
foreach type $tmp_list {
if {$type != "self"} {
set idx [lsearch -exact $f_opts($path_name,master_excl_types_list) $type]
if {$idx != -1} {
set idx [lsearch -exact $f_opts($path_name,master_incl_types_list) $type]
set f_opts($path_name,master_incl_types_list) \
[lreplace $f_opts($path_name,master_incl_types_list) \
$idx $idx]
}
}
}
set f_opts($path_name,filtered_incl_types) $f_opts($path_name,master_incl_types_list)
set f_opts($path_name,filtered_excl_types) $f_opts($path_name,master_excl_types_list)
incr i
if {[lindex $query_options $i] != "\{\}"} {
set tmp [string trim [lindex $query_options $i] "\{\}"]
if {[lsearch -exact $Apol_Types::attriblist $tmp] != -1} {
set f_opts($path_name,incl_attrib_combo_value) $tmp
} else {
tk_messageBox -icon warning -type ok -title "Warning" \
-message "The specified attribute $tmp does not exist in the currently \
loaded policy. It will be ignored." \
-parent $parentDlg
}
}
incr i
if {[lindex $query_options $i] != "\{\}"} {
set tmp [string trim [lindex $query_options $i] "\{\}"]
if {[lsearch -exact $Apol_Types::attriblist $tmp] != -1} {
set f_opts($path_name,excl_attrib_combo_value) $tmp
} else {
tk_messageBox -icon warning -type ok -title "Warning" \
-message "The specified attribute $tmp does not exist in the currently \
loaded policy. It will be ignored." \
-parent $parentDlg
}
}
incr i
set f_opts($path_name,incl_attrib_cb_sel) [lindex $query_options $i]
incr i
set f_opts($path_name,excl_attrib_cb_sel) [lindex $query_options $i]
incr i
if {[string equal [lindex $query_options $i] "threshhold_cb_value"]} {
incr i
set f_opts($path_name,threshhold_cb_value) [lindex $query_options $i]
incr i
}
if {[string equal [lindex $query_options $i] "threshhold_value"]} {
incr i
set f_opts($path_name,threshhold_value) [lindex $query_options $i]
}
Apol_Analysis_fulflow::advanced_filters_update_dialog $path_name
return $i
}
proc Apol_Analysis_fulflow::load_query_options { file_channel parentDlg } {
variable endtype_sel
variable in_button_sel
variable out_button_sel
variable display_attrib_sel
variable start_type
variable end_type
variable display_attribute
variable flow_direction
variable comment_text
variable advanced_filter_Dlg
variable f_opts
set query_options ""
set query_options_tmp ""
set path_name $advanced_filter_Dlg
$comment_text delete 1.0 end
while {[eof $file_channel] != 1} {
gets $file_channel line
set tline [string trim $line]
if {$tline == ""} {
continue
} elseif {[string compare -length 1 $tline "#"] == 0} {
$comment_text insert end "[string range $tline 1 end]\n"
continue
}
set query_options_tmp [lappend query_options_tmp $tline]
}
if {$query_options_tmp == ""} {
return -code error "No query parameters were found."
}
set query_options_tmp [split [join $query_options_tmp " "] " :"]
set query_options [ApolTop::strip_list_of_empty_items $query_options_tmp]
if {$query_options == ""} {
return -code error "No query parameters were found."
}
set endtype_sel [lindex $query_options 0]
set in_button_sel [lindex $query_options 1]
set out_button_sel [lindex $query_options 2]
if {[lindex $query_options 5] != "\{\}"} {
set end_type [string trim [lindex $query_options 5] "\{\}"]
}
if {[lindex $query_options 6] != "\{\}"} {
set tmp [string trim [lindex $query_options 6] "\{\}"]
if {[lsearch -exact $Apol_Types::attriblist $tmp] != -1} {
set display_attribute $tmp
set display_attrib_sel [lindex $query_options 3]
} else {
tk_messageBox -icon warning -type ok -title "Warning" \
-message "The specified attribute $tmp does not exist in the currently\
loaded policy. It will be ignored." \
-parent $parentDlg
}
}
set flow_direction [string trim [lindex $query_options 7] "\{\}"]
set i 8
set i [Apol_Analysis_fulflow::load_advanced_filters_options $query_options \
$i $path_name $parentDlg]
Apol_Analysis_fulflow::config_endtype_state
Apol_Analysis_fulflow::config_attrib_comboBox_state
if {[lindex $query_options 4] != "\{\}"} {
set tmp [string trim [lindex $query_options 4] "\{\}"]
if {[lsearch -exact $Apol_Types::typelist $tmp] != -1} {
set start_type $tmp
} else {
tk_messageBox -icon warning -type ok -title "Warning" \
-message "The specified type starting source domain type $tmp does not exist in the currently \
loaded policy. It will be ignored." \
-parent $parentDlg
}
}
return 0
}
proc Apol_Analysis_fulflow::save_query_options {module_name file_channel file_name} {
variable endtype_sel
variable in_button_sel
variable out_button_sel
variable display_attrib_sel
variable start_type
variable end_type
variable display_attribute
variable flow_direction
variable comment_text
variable combo_start
variable combo_attribute
variable entry_end
variable advanced_filter_Dlg
variable f_opts
if {![array exists f_opts] || [array names f_opts "$advanced_filter_Dlg,name"] == ""} {
Apol_Analysis_fulflow::advanced_filters_create_object $advanced_filter_Dlg
}
set start_type [$combo_start cget -text]
set display_attribute [$combo_attribute cget -text]
set end_type [$entry_end cget -text]
set class_perms_list_tmp [array get f_opts "$advanced_filter_Dlg,perm_status_array,*"]
set class_perms_list ""
set len [llength $class_perms_list_tmp]
set idx [string length "$advanced_filter_Dlg,perm_status_array,"]
for {set i 0} {$i < $len} {incr i} {
set str [string range [lindex $class_perms_list_tmp $i] $idx end]
incr i
set class_perms_list [lappend class_perms_list $str [lindex $class_perms_list_tmp $i]]
}
set options [list \
$endtype_sel \
$in_button_sel \
$out_button_sel \
$display_attrib_sel \
$start_type \
$end_type \
$display_attribute \
$flow_direction \
$class_perms_list \
$f_opts($advanced_filter_Dlg,master_excl_types_list) \
$f_opts($advanced_filter_Dlg,incl_attrib_combo_value) \
$f_opts($advanced_filter_Dlg,excl_attrib_combo_value) \
$f_opts($advanced_filter_Dlg,incl_attrib_cb_sel) \
$f_opts($advanced_filter_Dlg,excl_attrib_cb_sel) \
"threshhold_cb_value:$f_opts($advanced_filter_Dlg,threshhold_cb_value)" \
"threshhold_value:$f_opts($advanced_filter_Dlg,threshhold_value)"]
puts $file_channel "$module_name"
set comments [string trim [$comment_text get 1.0 end]]
foreach comment [split $comments "\n\r"] {
puts $file_channel "#$comment"
}
puts $file_channel "$options"
return 0
}
proc Apol_Analysis_fulflow::get_current_results_state { } {
variable endtype_sel
variable in_button_sel
variable out_button_sel
variable display_attrib_sel
variable start_type
variable end_type
variable display_attribute
variable flow_direction
variable comment_text
variable fulflow_tree
variable fulflow_info_text
variable advanced_filter_Dlg
variable f_opts
if {![array exists f_opts] || [array names f_opts "$advanced_filter_Dlg,name"] == ""} {
Apol_Analysis_fulflow::advanced_filters_create_object $advanced_filter_Dlg
}
set comments "[string trim [$comment_text get 1.0 end]]"
set class_perms_list [array get f_opts "$advanced_filter_Dlg,perm_status_array,*"]
set options [list \
$fulflow_tree \
$fulflow_info_text \
$endtype_sel \
$in_button_sel \
$out_button_sel \
$display_attrib_sel \
$start_type \
$end_type \
$display_attribute \
$flow_direction \
$class_perms_list \
$f_opts($advanced_filter_Dlg,filtered_incl_types) \
$f_opts($advanced_filter_Dlg,filtered_excl_types) \
$f_opts($advanced_filter_Dlg,master_incl_types_list) \
$f_opts($advanced_filter_Dlg,master_excl_types_list) \
$f_opts($advanced_filter_Dlg,incl_attrib_combo_value) \
$f_opts($advanced_filter_Dlg,excl_attrib_combo_value) \
$f_opts($advanced_filter_Dlg,incl_attrib_cb_sel) \
$f_opts($advanced_filter_Dlg,excl_attrib_cb_sel) \
$comments]
return $options
}
proc Apol_Analysis_fulflow::set_display_to_results_state { query_options } {
variable fulflow_tree
variable fulflow_info_text
variable endtype_sel
variable in_button_sel
variable out_button_sel
variable display_attrib_sel
variable start_type
variable end_type
variable display_attribute
variable flow_direction
variable comment_text
variable advanced_filter_Dlg
variable f_opts
set fulflow_tree [lindex $query_options 0]
set fulflow_info_text [lindex $query_options 1]
set endtype_sel [lindex $query_options 2]
set in_button_sel [lindex $query_options 3]
set out_button_sel [lindex $query_options 4]
set display_attrib_sel [lindex $query_options 5]
set end_type [lindex $query_options 7]
set display_attribute [lindex $query_options 8]
set flow_direction [lindex $query_options 9]
if {![array exists f_opts] || [array names f_opts "$advanced_filter_Dlg,name"] == ""} {
Apol_Analysis_fulflow::advanced_filters_create_object $advanced_filter_Dlg
}
set obj_perms_list [lindex $query_options 10]
set len [llength $obj_perms_list]
if {$len > 0} {
array unset f_opts "$advanced_filter_Dlg,perm_status_array,*"
}
for {set i 0} {$i < $len} {incr i} {
set element [lindex $obj_perms_list $i]
incr i
set val [lindex $obj_perms_list $i]
set f_opts($element) $val
}
set f_opts($advanced_filter_Dlg,filtered_incl_types) [lindex $query_options 11]
set f_opts($advanced_filter_Dlg,filtered_excl_types) [lindex $query_options 12]
set f_opts($advanced_filter_Dlg,master_incl_types_list) [lindex $query_options 13]
set f_opts($advanced_filter_Dlg,master_excl_types_list) [lindex $query_options 14]
set f_opts($advanced_filter_Dlg,incl_attrib_combo_value) [lindex $query_options 15]
set f_opts($advanced_filter_Dlg,excl_attrib_combo_value) [lindex $query_options 16]
set f_opts($advanced_filter_Dlg,incl_attrib_cb_sel) [lindex $query_options 17]
set f_opts($advanced_filter_Dlg,excl_attrib_cb_sel) [lindex $query_options 18]
$comment_text delete 1.0 end
$comment_text insert end [lindex $query_options 19]
Apol_Analysis_fulflow::config_endtype_state
Apol_Analysis_fulflow::config_attrib_comboBox_state
set start_type [lindex $query_options 6]
set f_opts($advanced_filter_Dlg,filter_vars_init) 1
if {[winfo exists $advanced_filter_Dlg]} {
set rt [catch {Apol_Analysis_fulflow::advanced_filters_update_dialog $advanced_filter_Dlg} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
raise $advanced_filter_Dlg
focus $advanced_filter_Dlg
}
return 0
}
proc Apol_Analysis_fulflow::free_results_data {query_options} {
set fulflow_tree [lindex $query_options 10]
set fulflow_info_text [lindex $query_options 11]
if {[winfo exists $fulflow_tree]} {
$fulflow_tree delete [$fulflow_tree nodes root]
if {[$fulflow_tree nodes root] != ""} {
return -1
}
destroy $fulflow_tree
}
if {[winfo exists $fulflow_info_text]} {
$fulflow_info_text delete 0.0 end
destroy $fulflow_info_text
}
return 0
}
proc Apol_Analysis_fulflow::display_progressDlg {} {
variable progressDlg
set Apol_Analysis_fulflow::progressmsg "Performing transitive information flow analysis..."
set progressBar [ProgressDlg $progressDlg \
-parent $ApolTop::mainframe \
-textvariable Apol_Analysis_fulflow::progressmsg \
-variable Apol_Analysis_fulflow::progress_indicator \
-maximum 3 \
-width 45]
update
bind $progressBar <<AnalysisStarted>> {
set Apol_Analysis_fulflow::progress_indicator [expr $Apol_Analysis_fulflow::progress_indicator + 1]
}
return 0
}
proc Apol_Analysis_fulflow::destroy_progressDlg {} {
variable progressDlg
if {[winfo exists $progressDlg]} {
destroy $progressDlg
}
return 0
}
proc Apol_Analysis_fulflow::treeSelect {fulflow_tree fulflow_info_text node} {
$fulflow_tree selection set $node
if {$node == [$fulflow_tree nodes root]} {
Apol_Analysis_fulflow::display_root_type_info $node $fulflow_info_text $fulflow_tree
Apol_Analysis_fulflow::formatInfoText $fulflow_info_text
} else {
Apol_Analysis_fulflow::insert_transitive_flows_header $fulflow_info_text $fulflow_tree $node
Apol_Analysis_fulflow::render_information_flows $fulflow_info_text $fulflow_tree $node
Apol_Analysis_fulflow::formatInfoText $fulflow_info_text
}
ApolTop::makeTextBoxReadOnly $fulflow_info_text
return 0
}
proc Apol_Analysis_fulflow::convert_seconds {sec} {
set hours [expr {$sec / 3600}]
set minutes [expr {$sec / 60 - $hours * 60}]
set seconds [expr {$sec - $minutes * 60 - $hours * 3600}]
return [format "%02s:%02s:%02s" $hours $minutes $seconds]
}
proc Apol_Analysis_fulflow::display_find_more_flows_Dlg {} {
variable find_flows_Dlg
variable fulflow_tree
variable find_flows_start
variable find_flows_results_Dlg
if {$find_flows_start} {
tk_messageBox -icon error -type ok -title "Error" -message "You must first abort the current search."
raise $find_flows_results_Dlg
return -1
}
if {[winfo exists $find_flows_Dlg]} {
destroy $find_flows_Dlg
}
set src_node [$fulflow_tree parent [$fulflow_tree selection get]]
set tgt_node [$fulflow_tree selection get]
set Apol_Analysis_fulflow::abort_trans_analysis 0
toplevel $find_flows_Dlg
wm withdraw $find_flows_Dlg
wm title $find_flows_Dlg "Find more flows"
wm protocol $find_flows_Dlg WM_DELETE_WINDOW " "
set topf [frame $find_flows_Dlg.topf]
set nodes_f [frame $topf.nodes_f]
set time_f [frame $topf.time_f]
set path_limit_f [frame $topf.path_limit_f]
set button_f [frame $topf.button_f]
set src_lbl [label $nodes_f.src_lbl -text "Source: [$fulflow_tree itemcget $src_node -text]"]
set tgt_lbl [label $nodes_f.tgt_lbl -text "Target: [$fulflow_tree itemcget $tgt_node -text]"]
set time_lbl [label $time_f.time_lbl -text "Time Limit:"]
set hrs_lbl [label $time_f.hrs_lbl -text "Hour(s)"]
set min_lbl [label $time_f.min_lbl -text "Minute(s)"]
set sec_lbl [label $time_f.sec_lbl -text "Second(s)"]
set time_entry_hour [Entry $time_f.time_entry_hour -editable 1 -width 5 \
-textvariable Apol_Analysis_fulflow::time_limit_hr -bg white]
set time_entry_min [Entry $time_f.time_entry_min -editable 1 -width 5 \
-textvariable Apol_Analysis_fulflow::time_limit_min -bg white]
set time_entry_sec [Entry $time_f.time_entry_sec -editable 1 -width 5 \
-textvariable Apol_Analysis_fulflow::time_limit_sec -bg white]
set path_limit_lbl [label $path_limit_f.path_limit_lbl -text "Limit by these number of flows:"]
set path_limit_entry [Entry $path_limit_f.path_limit_entry -editable 1 -width 5 \
-textvariable Apol_Analysis_fulflow::flow_limit_num -bg white]
set b_find [button $button_f.b_find -text "Find" -width 6 \
-command "Apol_Analysis_fulflow::find_more_flows $src_node $tgt_node"]
set b_cancel [button $button_f.b_cancel -text "Cancel" -width 6 \
-command "destroy $find_flows_Dlg"]
pack $topf -fill both -expand yes -padx 10 -pady 10
pack $nodes_f $time_f $path_limit_f -side top -fill x -padx 2 -pady 2
pack $button_f -side bottom -padx 2 -pady 2 -anchor center
pack $src_lbl $tgt_lbl -side top -padx 2 -pady 2 -anchor nw
pack $time_lbl $time_entry_hour $hrs_lbl $time_entry_min $min_lbl $time_entry_sec $sec_lbl -side left -padx 1 -anchor nw
pack $path_limit_lbl $path_limit_entry -side left -padx 2 -anchor nw
pack $b_find $b_cancel -side left -padx 4 -anchor center
wm deiconify $find_flows_Dlg
focus $find_flows_Dlg
wm protocol $find_flows_Dlg WM_DELETE_WINDOW "destroy $find_flows_Dlg"
return 0
}
proc Apol_Analysis_fulflow::display_find_flows_results_Dlg {time_limit_str flow_limit_num} {
variable find_flows_results_Dlg
variable time_exp_lbl
variable num_found_lbl
if {[winfo exists $find_flows_results_Dlg]} {
destroy $find_flows_results_Dlg
}
toplevel $find_flows_results_Dlg
wm withdraw $find_flows_results_Dlg
wm title $find_flows_results_Dlg "Flow results"
set topf [frame $find_flows_results_Dlg.topf]
set time_f [frame $topf.time_f]
set button_f [frame $topf.button_f]
set num_flows_f [frame $topf.num_flows_f]
set main_lbl [label $topf.time_lbl1 -text "Finding more flows:"]
set time_lbl1 [label $time_f.time_lbl1 -text "Time: "]
set time_exp_lbl [label $time_f.time_exp_lbl]
set time_lbl2 [label $time_f.time_lbl2 -text " elapsed out of $time_limit_str"]
set num_lbl1 [label $num_flows_f.num_lbl1 -text "Flows: found "]
set num_found_lbl [label $num_flows_f.num_found_lbl]
set num_lbl2 [label $num_flows_f.num_lbl2 -text " out of $flow_limit_num"]
set b_abort_transitive [button $button_f.b_abort_transitive -text "Stop" -width 6 \
-command "set Apol_Analysis_fulflow::abort_trans_analysis 1"]
pack $button_f -side bottom -padx 2 -pady 2 -anchor center
pack $topf -fill both -expand yes -padx 10 -pady 10
pack $main_lbl -side top -anchor nw -pady 2
pack $time_f $num_flows_f -side top -padx 15 -pady 2 -anchor nw
pack $b_abort_transitive -side left -fill both -expand yes -anchor center
pack $time_lbl1 $time_exp_lbl $time_lbl2 -side left -expand yes -anchor nw
pack $num_lbl1 $num_found_lbl $num_lbl2 -side left -expand yes -anchor nw
wm deiconify $find_flows_results_Dlg
wm transient $find_flows_results_Dlg $ApolTop::mainframe
catch {grab $find_flows_results_Dlg}
if {[winfo exists $find_flows_results_Dlg]} {
focus $find_flows_results_Dlg
}
update
return 0
}
proc Apol_Analysis_fulflow::find_more_flows_generate_virtual_events {} {
variable find_flows_results_Dlg
bind $find_flows_results_Dlg <<FindMoreFlowsStarted>> {
set elapsed_time [Apol_Analysis_fulflow::convert_seconds \
[expr [clock seconds] - $Apol_Analysis_fulflow::start_time]]
$Apol_Analysis_fulflow::time_exp_lbl configure -text $elapsed_time
}
return 0
}
proc Apol_Analysis_fulflow::find_more_flows {src_node tgt_node} {
variable fulflow_tree
variable time_limit_hr
variable time_limit_min
variable time_limit_sec
variable flow_limit_num
variable progressBar
variable fulflow_info_text
variable time_exp_lbl
variable num_found_lbl
variable find_flows_Dlg
variable find_flows_results_Dlg
variable find_flows_start
variable start_time
set time_limit_str [format "%02s:%02s:%02s" $time_limit_hr $time_limit_min $time_limit_sec]
if {$flow_limit_num == "" && $time_limit_str == "00:00:00"} {
tk_messageBox -icon error -type ok -title "Error" -message "You must specify a time limit."
raise $find_flows_Dlg
focus $find_flows_Dlg
return -1
} elseif {$flow_limit_num < 1} {
tk_messageBox -icon error -type ok -title "Error" -message "Number of flows cannot be less than 1."
raise $find_flows_Dlg
focus $find_flows_Dlg
return -1
}
if {$time_limit_hr != "" && [expr ($time_limit_hr > 24 || $time_limit_hr < 0)]} {
tk_messageBox -icon error -type ok -title "Error" -message "Invalid hours limit input. Must be between 0 and 24 inclusive."
raise $find_flows_Dlg
focus $find_flows_Dlg
return -1
}
if {$time_limit_min != "" && [expr ($time_limit_min > 59 || $time_limit_min < 0)]} {
tk_messageBox -icon error -type ok -title "Error" -message "Invalid minutes limit input. Must between 0-59 inclusive."
raise $find_flows_Dlg
focus $find_flows_Dlg
return -1
}
if {$time_limit_sec != "" && [expr ($time_limit_sec > 59 || $time_limit_sec < 0)]} {
tk_messageBox -icon error -type ok -title "Error" -message "Invalid seconds limit input. Must be between 0-59 inclusive."
raise $find_flows_Dlg
focus $find_flows_Dlg
return -1
}
if {[winfo exists $find_flows_Dlg]} {
destroy $find_flows_Dlg
}
set old_focus [focus]
Apol_Analysis_fulflow::display_find_flows_results_Dlg $time_limit_str $flow_limit_num
set Apol_Analysis_fulflow::abort_trans_analysis 0
set src_data [$fulflow_tree itemcget [$fulflow_tree nodes root] -data]
set src [$fulflow_tree itemcget $src_node -text]
wm protocol $find_flows_results_Dlg WM_DELETE_WINDOW "raise $find_flows_results_Dlg; focus $find_flows_results_Dlg"
set start_time [clock seconds]
set curr_flows_num 0
set find_flows_start 1
$time_exp_lbl configure -text [Apol_Analysis_fulflow::convert_seconds [expr [clock seconds] - $start_time]]
set rt [catch {apol_TransitiveFindPathsStart \
$src \
[lindex $src_data 1] \
[lindex $src_data 2] \
[lindex $src_data 3] \
1 \
"^[$fulflow_tree itemcget $tgt_node -text]$" \
[lindex $src_data 6] \
[lindex $src_data 7] \
[lindex $src_data 8] \
[lindex $src_data 9] \
[lindex $src_data 10]} err]
if {$rt != 0} {
if {[winfo exists $find_flows_results_Dlg]} {
destroy $find_flows_results_Dlg
}
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
while {1} {
set elapsed_time [Apol_Analysis_fulflow::convert_seconds [expr [clock seconds] - $start_time]]
$time_exp_lbl configure -text $elapsed_time
if {$time_limit_str != "00:00:00" && [string equal $time_limit_str $elapsed_time]} {
break
}
set rt [catch {set curr_flows_num [apol_TransitiveFindPathsNext]} err]
if {$rt == -1} {
tk_messageBox -icon error -type ok -title "Error" -message $err
return -1
}
$num_found_lbl configure -text $curr_flows_num
if {$flow_limit_num != "" && $curr_flows_num >= $flow_limit_num} {
break
}
update
if {$Apol_Analysis_fulflow::abort_trans_analysis} {
set find_flows_start 0
if {[winfo exists $find_flows_results_Dlg]} {
grab release $find_flows_results_Dlg
destroy $find_flows_results_Dlg
catch {focus $old_focus}
}
if {$curr_flows_num > 0} {break}
set rt [catch {apol_TransitiveFindPathsAbort} err]
if {$rt != 0} {
tk_messageBox -icon info -type ok -title "Abort Error" -message $err
return -1
}
return -1
}
}
set rt [catch {set results [apol_TransitiveFindPathsGetResults]} err]
if {$rt != 0} {
set find_flows_start 0
if {[winfo exists $find_flows_results_Dlg]} {
destroy $find_flows_results_Dlg
}
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
set num_target_types [lindex $results 0]
if {$num_target_types} {
set nextIdx [Apol_Analysis_fulflow::parseList_get_index_next_node 1 $results]
set data [lrange $results 1 [expr $nextIdx-1]]
$fulflow_tree itemconfigure $tgt_node -data $data
Apol_Analysis_fulflow::insert_more_flows_header $fulflow_info_text $fulflow_tree \
$src_node $tgt_node \
$time_limit_str $elapsed_time \
$flow_limit_num $curr_flows_num
Apol_Analysis_fulflow::render_information_flows $fulflow_info_text $fulflow_tree $tgt_node
Apol_Analysis_fulflow::formatInfoText $fulflow_info_text
}
set find_flows_start 0
if {[winfo exists $find_flows_results_Dlg]} {
grab release $find_flows_results_Dlg
destroy $find_flows_results_Dlg
catch {focus $old_focus}
}
return 0
}
proc Apol_Analysis_fulflow::display_root_type_info { source_type fulflow_info_text fulflow_tree } {
$fulflow_info_text configure -state normal
$fulflow_info_text delete 0.0 end
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "Transitive Information Flow Analysis: Starting type: "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_tag $startIdx $endIdx
set startIdx $endIdx
$fulflow_info_text insert end $source_type
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_type_tag $startIdx $endIdx
set startIdx $endIdx
$fulflow_info_text configure -wrap word
set start_idx [$fulflow_info_text index insert]
$fulflow_info_text insert end $Apol_Analysis_fulflow::root_text
$fulflow_info_text tag add ROOT_TEXT $start_idx end
$fulflow_info_text tag configure ROOT_TEXT -font $ApolTop::text_font
$fulflow_info_text see 1.0
$fulflow_info_text configure -state disabled
return 0
}
proc Apol_Analysis_fulflow::insert_more_flows_header {fulflow_info_text fulflow_tree src_node tgt_node time_limit_str elapsed_time flow_limit_num curr_flows_num} {
$fulflow_info_text configure -state normal
$fulflow_info_text delete 0.0 end
$fulflow_info_text mark set insert 1.0
$fulflow_info_text configure -wrap none
set data [$fulflow_tree itemcget $tgt_node -data]
if {$data == ""} {
$fulflow_info_text configure -state disabled
return ""
}
set query_args [$fulflow_tree itemcget [$fulflow_tree nodes root] -data]
set flow_direction [lindex $query_args 1]
if {$flow_direction == "in"} {
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "More Information Flows to "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end " [$fulflow_tree itemcget $src_node -text]"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_type_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end " from "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "[$fulflow_tree itemcget $tgt_node -text]"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_type_tag $startIdx $endIdx
} elseif {$flow_direction == "out"} {
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "More Information Flows from "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "[$fulflow_tree itemcget $src_node -text]"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_type_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end " to "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "[$fulflow_tree itemcget $tgt_node -text]"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_type_tag $startIdx $endIdx
} else {
puts "Invalid flow direction ($flow_direction) specified!"
return
}
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end " ("
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "Find more flows"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::find_flows_tag $startIdx $endIdx
$fulflow_info_text insert end ")"
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "\n\nTime: $elapsed_time out of $time_limit_str"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::subtitle_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "\n\nApol found the following number of information flows: "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
$fulflow_info_text insert end "$curr_flows_num"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::counters_tag $startIdx $endIdx
set startIdx $endIdx
$fulflow_info_text insert end " out of "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
$fulflow_info_text insert end "$flow_limit_num"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::counters_tag $startIdx $endIdx
$fulflow_info_text configure -state disabled
return 0
}
proc Apol_Analysis_fulflow::insert_transitive_flows_header {fulflow_info_text fulflow_tree node} {
$fulflow_info_text configure -state normal
$fulflow_info_text delete 0.0 end
$fulflow_info_text mark set insert 1.0
$fulflow_info_text configure -wrap none
set data [$fulflow_tree itemcget $node -data]
if {$data == ""} {
$fulflow_info_text configure -state disabled
return
}
set start_type [$fulflow_tree itemcget [$fulflow_tree parent $node] -text]
set startIdx [$fulflow_info_text index insert]
set currentIdx 0
set end_type [lindex $data $currentIdx]
set query_args [$fulflow_tree itemcget [$fulflow_tree nodes root] -data]
set flow_direction [lindex $query_args 1]
if {$flow_direction == "in"} {
$fulflow_info_text insert end "Information flows to "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end $start_type
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_type_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end " from "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end $end_type
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_type_tag $startIdx $endIdx
set startIdx $endIdx
} elseif {$flow_direction == "out"} {
$fulflow_info_text insert end "Information flows from "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end $start_type
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_type_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end " to "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_tag $startIdx $endIdx
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end $end_type
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::title_type_tag $startIdx $endIdx
set startIdx $endIdx
} else {
puts "Invalid flow direction ($flow_direction) specified!"
return
}
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end " ("
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "Find more flows"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::find_flows_tag $startIdx $endIdx
$fulflow_info_text insert end ")"
set currentIdx 1
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "\n\nApol found the following number of information flows: "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
set num_paths [lindex $data $currentIdx]
$fulflow_info_text insert end $num_paths
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::counters_tag $startIdx $endIdx
$fulflow_info_text configure -state disabled
return 0
}
proc Apol_Analysis_fulflow::render_information_flows {fulflow_info_text fulflow_tree node} {
$fulflow_info_text configure -state normal
set data [$fulflow_tree itemcget $node -data]
if {$data == ""} {
$fulflow_info_text configure -state disabled
return
}
set currentIdx 1
set num_paths [lindex $data $currentIdx]
for {set i 0} {$i<$num_paths} {incr i} {
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "\n\nFlow"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
$fulflow_info_text insert end " [expr $i+1] "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::counters_tag $startIdx $endIdx
set startIdx $endIdx
$fulflow_info_text insert end "requires "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
incr currentIdx
set num_flows [lindex $data $currentIdx]
$fulflow_info_text insert end $num_flows
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::counters_tag $startIdx $endIdx
set startIdx $endIdx
$fulflow_info_text insert end " step(s)."
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::subtitle_tag $startIdx $endIdx
for {set j 0} {$j<$num_flows} {incr j} {
$fulflow_info_text insert end "\n\n\tStep "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
$fulflow_info_text insert end [expr $j + 1]
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::counters_tag $startIdx $endIdx
set startIdx $endIdx
$fulflow_info_text insert end ": "
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
$fulflow_info_text insert end "from "
incr currentIdx
$fulflow_info_text insert end [lindex $data $currentIdx]
$fulflow_info_text insert end " to "
incr currentIdx
$fulflow_info_text insert end [lindex $data $currentIdx]
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
incr currentIdx
set num_classes [lindex $data $currentIdx]
for {set k 0} {$k<$num_classes} {incr k} {
incr currentIdx
$fulflow_info_text insert end "\n\t[lindex $data $currentIdx]"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
incr currentIdx
set num_rules [lindex $data $currentIdx]
for {set l 0} {$l<$num_rules} {incr l} {
incr currentIdx
set rule [lindex $data $currentIdx]
$fulflow_info_text insert end "\n\t"
set startIdx [$fulflow_info_text index insert]
set end_link_idx [string first "\]" [string trim $rule] 0]
set lineno [string range [string trim [string range $rule 0 $end_link_idx]] 1 end-1]
set lineno [string trim $lineno]
set rule [string range $rule [expr $end_link_idx + 1] end]
if {![ApolTop::is_binary_policy]} {
$fulflow_info_text insert end "\[$lineno\]"
Apol_PolicyConf::insertHyperLink $fulflow_info_text "$startIdx wordstart + 1c" "$startIdx wordstart + [expr [string length $lineno] + 1]c"
}
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end " $rule"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::rules_tag $startIdx $endIdx
incr currentIdx
if {[lindex $data $currentIdx] == 0} {
$fulflow_info_text insert end " "
set startIdx [$fulflow_info_text index insert]
$fulflow_info_text insert end "\[Disabled\]"
set endIdx [$fulflow_info_text index insert]
$fulflow_info_text tag add $Apol_Analysis_fulflow::disabled_rule_tag $startIdx $endIdx
}
set startIdx [$fulflow_info_text index insert]
}
}
}
}
$fulflow_info_text see 1.0
$fulflow_info_text configure -state disabled
return 0
}
proc Apol_Analysis_fulflow::formatInfoText { tb } {
$tb tag configure $Apol_Analysis_fulflow::title_tag -font {Helvetica 14 bold}
$tb tag configure $Apol_Analysis_fulflow::title_type_tag -foreground blue -font {Helvetica 14 bold}
$tb tag configure $Apol_Analysis_fulflow::subtitle_tag -font {Helvetica 11 bold}
$tb tag configure $Apol_Analysis_fulflow::rules_tag -font $ApolTop::text_font
$tb tag configure $Apol_Analysis_fulflow::counters_tag -foreground blue -font {Helvetica 11 bold}
$tb tag configure $Apol_Analysis_fulflow::types_tag -font $ApolTop::text_font
$tb tag configure $Apol_Analysis_fulflow::find_flows_tag -font {Helvetica 14 bold} -foreground blue -underline 1
$tb tag configure $Apol_Analysis_fulflow::disabled_rule_tag -foreground red
$tb tag bind $Apol_Analysis_fulflow::find_flows_tag <Button-1> "Apol_Analysis_fulflow::display_find_more_flows_Dlg"
$tb tag bind $Apol_Analysis_fulflow::find_flows_tag <Enter> { set Apol_Analysis_fulflow::orig_cursor [%W cget -cursor]; %W configure -cursor hand2 }
$tb tag bind $Apol_Analysis_fulflow::find_flows_tag <Leave> { %W configure -cursor $Apol_Analysis_fulflow::orig_cursor }
Apol_PolicyConf::configure_HyperLinks $tb
}
proc Apol_Analysis_fulflow::insert_src_type_node { fulflow_tree query_args} {
variable start_type
$fulflow_tree insert end root $start_type \
-text $start_type \
-open 1 \
-drawcross auto \
-data $query_args
return [$fulflow_tree nodes root]
}
proc Apol_Analysis_fulflow::create_target_type_nodes { parent fulflow_tree results_list } {
if { [file tail [$fulflow_tree parent $parent]] == [file tail $parent] } {
return
}
if { [$fulflow_tree nodes $parent] == "" } {
set num_target_types [lindex $results_list 1]
set curentIdx 2
for { set x 0 } {$x < $num_target_types} { incr x } {
set target_name [lindex $results_list $curentIdx]
set nextIdx [Apol_Analysis_fulflow::parseList_get_index_next_node $curentIdx $results_list]
if {$nextIdx == -1} {
return -code error "Error parsing results. See stdout for more information."
}
set target_node "${parent}/${target_name}/"
$fulflow_tree insert end $parent $target_node \
-text $target_name \
-open 0 \
-drawcross allways \
-data [lrange $results_list $curentIdx [expr $nextIdx-1]]
set curentIdx $nextIdx
}
set nodes [lsort [$fulflow_tree nodes $parent]]
$fulflow_tree reorder $parent $nodes
$fulflow_tree configure -redraw 1
}
return 0
}
proc Apol_Analysis_fulflow::parseList_get_index_next_node { currentIdx results_list } {
incr currentIdx
set num_paths [lindex $results_list $currentIdx]
if {![string is integer $num_paths]} {
return -1;
}
for {set i 0} {$i < $num_paths} {incr i} {
incr currentIdx
set num_flows [lindex $results_list $currentIdx]
if {![string is integer $num_flows]} {
return -1;
}
for {set j 0} {$j < $num_flows} {incr j} {
incr currentIdx 3
set num_objs [lindex $results_list $currentIdx]
if {![string is integer $num_objs]} {
return -1;
}
for {set k 0} {$k < $num_objs} {incr k} {
incr currentIdx 2
set num_rules [lindex $results_list $currentIdx]
if {![string is integer $num_rules]} {
return -1;
}
incr currentIdx [expr $num_rules * 2]
}
}
}
incr currentIdx
return $currentIdx
}
proc Apol_Analysis_fulflow::create_result_tree_structure { fulflow_tree results_list query_args} {
set home_node [Apol_Analysis_fulflow::insert_src_type_node $fulflow_tree $query_args]
set rt [catch {Apol_Analysis_fulflow::create_target_type_nodes $home_node $fulflow_tree $results_list} err]
if {$rt != 0} {
return -code error $err
}
Apol_Analysis_fulflow::treeSelect \
$Apol_Analysis_fulflow::fulflow_tree $Apol_Analysis_fulflow::fulflow_info_text $home_node
return 0
}
proc Apol_Analysis_fulflow::do_child_analysis { fulflow_tree selected_node } {
ApolTop::setBusyCursor
Apol_Analysis_fulflow::display_progressDlg
if { [$fulflow_tree nodes $selected_node] == "" } {
set query_args [$fulflow_tree itemcget [$fulflow_tree nodes root] -data]
set start_t [file tail $selected_node]
set rt [catch {set results [apol_TransitiveFlowAnalysis \
$start_t \
[lindex $query_args 1] \
[lindex $query_args 2] \
[lindex $query_args 3] \
[lindex $query_args 4] \
[lindex $query_args 5] \
[lindex $query_args 6] \
[lindex $query_args 7] \
[lindex $query_args 8] \
[lindex $query_args 9] \
[lindex $query_args 10]]} err]
if {$rt != 0} {
Apol_Analysis_fulflow::destroy_progressDlg
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
Apol_Analysis_fulflow::create_target_type_nodes $selected_node $fulflow_tree $results
}
Apol_Analysis_fulflow::destroy_progressDlg
ApolTop::resetBusyCursor
return 0
}
proc Apol_Analysis_fulflow::create_resultsDisplay { results_frame } {
variable fulflow_tree
variable fulflow_info_text
set pw [PanedWindow $results_frame.pw -side top]
set pw_tree [$pw add]
set pw_info [$pw add -weight 5]
set frm_tree [TitleFrame [$pw getframe 0].frm_tree -text "Transitive Information Flow Tree"]
set frm_info [TitleFrame [$pw getframe 1].frm_info -text "Transitive Information Flow Data"]
set sw_tree [ScrolledWindow [$frm_tree getframe].sw_tree -auto none]
set sw_info [ScrolledWindow [$frm_info getframe].sw_info -auto none]
set fulflow_tree [Tree [$sw_tree getframe].fulflow_tree \
-relief flat -borderwidth 0 -highlightthickness 0 \
-redraw 0 -bg white -showlines 1 -padx 0 \
-opencmd {Apol_Analysis_fulflow::do_child_analysis $Apol_Analysis_fulflow::fulflow_tree}]
$sw_tree setwidget $fulflow_tree
set fulflow_info_text [text [$sw_info getframe].fulflow_info_text -wrap none -bg white -font $ApolTop::text_font]
$sw_info setwidget $fulflow_info_text
bind $fulflow_info_text <Enter> {focus %W}
pack $pw -fill both -expand yes -anchor nw
pack $frm_tree -fill both -expand yes -anchor nw
pack $frm_info -fill both -expand yes
pack $sw_tree -fill both -expand yes
pack $sw_info -fill both -expand yes
$fulflow_tree bindText <ButtonPress-1> {Apol_Analysis_fulflow::treeSelect \
$Apol_Analysis_fulflow::fulflow_tree $Apol_Analysis_fulflow::fulflow_info_text}
$fulflow_tree bindText <Double-ButtonPress-1> {Apol_Analysis_fulflow::treeSelect \
$Apol_Analysis_fulflow::fulflow_tree $Apol_Analysis_fulflow::fulflow_info_text}
return $fulflow_tree
}
proc Apol_Analysis_fulflow::reset_variables { } {
set Apol_Analysis_fulflow::start_type ""
set Apol_Analysis_fulflow::end_type ""
set Apol_Analysis_fulflow::flow_direction ""
set Apol_Analysis_fulflow::fulflow_tree ""
set Apol_Analysis_fulflow::fulflow_info_text ""
set Apol_Analysis_fulflow::in_button_sel 0
set Apol_Analysis_fulflow::out_button_sel 0
set Apol_Analysis_fulflow::endtype_sel 0
set Apol_Analysis_fulflow::display_attrib_sel 0
set Apol_Analysis_fulflow::display_attribute ""
return 0
}
proc Apol_Analysis_fulflow::update_display_variables { } {
variable start_type
set start_type $Apol_Analysis_fulflow::start_type
return 0
}
proc Apol_Analysis_fulflow::config_attrib_comboBox_state { } {
variable combo_attribute
variable display_attrib_sel
variable combo_start
if { $display_attrib_sel } {
$combo_attribute configure -state normal -entrybg white
set Apol_Analysis_fulflow::start_type ""
Apol_Analysis_fulflow::change_types_list
} else {
$combo_attribute configure -state disabled -entrybg $ApolTop::default_bg_color
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_start configure -values $attrib_typesList
}
return 0
}
proc Apol_Analysis_fulflow::config_endtype_state { } {
variable entry_end
variable endtype_sel
if { $endtype_sel } {
$entry_end configure -state normal -background white
} else {
$entry_end configure -state disabled -background $ApolTop::default_bg_color
}
return 0
}
proc Apol_Analysis_fulflow::in_button_press { } {
variable out_button
variable in_button
variable flow_direction
set flow_direction "in"
$out_button deselect
$in_button select
return 0
}
proc Apol_Analysis_fulflow::out_button_press { } {
variable in_button
variable out_button
variable flow_direction
set flow_direction "out"
$in_button deselect
$out_button select
return 0
}
proc Apol_Analysis_fulflow::select_all_lbox_items {lbox} {
$lbox selection set 0 end
return 0
}
proc Apol_Analysis_fulflow::clear_all_lbox_items {lbox} {
$lbox selection clear 0 end
return 0
}
proc Apol_Analysis_fulflow::change_types_list { } {
variable combo_start
variable display_attribute
if { $display_attribute != "" } {
$combo_start configure -text ""
set rt [catch {set attrib_typesList [apol_GetAttribTypesList $display_attribute]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
}
set attrib_typesList [lsort $attrib_typesList]
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_start configure -values $attrib_typesList
} else {
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_start configure -values $attrib_typesList
}
return 0
}
proc Apol_Analysis_fulflow::display_mod_options { opts_frame } {
Apol_Analysis_fulflow::reset_variables
Apol_Analysis_fulflow::advanced_filters_refresh_dialog \
$Apol_Analysis_fulflow::advanced_filter_Dlg
Apol_Analysis_fulflow::create_options $opts_frame
Apol_Analysis_fulflow::populate_ta_list
if {[ApolTop::is_policy_open]} {
set Apol_Analysis_fulflow::display_attrib_sel 0
Apol_Analysis_fulflow::config_attrib_comboBox_state
Apol_Analysis_fulflow::change_types_list
set Apol_Analysis_fulflow::in_button_sel 1
$Apol_Analysis_fulflow::in_button select
Apol_Analysis_fulflow::in_button_press
} else {
Apol_Analysis_fulflow::config_attrib_comboBox_state
}
Apol_Analysis_fulflow::config_endtype_state
return 0
}
proc Apol_Analysis_fulflow::populate_ta_list { } {
variable combo_start
variable combo_attribute
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_start configure -values $attrib_typesList
$combo_attribute configure -values $Apol_Types::attriblist
return 0
}
proc Apol_Analysis_fulflow::load_default_perm_map {} {
set rt [catch {set map_loaded [Apol_Perms_Map::is_pmap_loaded]} err]
if { $rt != 0 } {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
if {!$map_loaded} {
set rt [catch {Apol_Perms_Map::load_default_perm_map} err]
if { $rt != 0 } {
if {$rt == $Apol_Perms_Map::warning_return_val} {
tk_messageBox -icon warning -type ok -title "Warning" -message "$err"
} else {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
}
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_refresh_dialog {path_name} {
if {[array exists f_opts] && \
[array names f_opts "$path_name,name"] != ""} {
Apol_Analysis_fulflow::advanced_filters_destroy_object $path_name
Apol_Analysis_fulflow::advanced_filters_create_object $path_name
Apol_Analysis_fulflow::advanced_filters_update_dialog $path_name
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_update_dialog {path_name} {
variable f_opts
if {[array exists f_opts] && \
[array names f_opts "$path_name,name"] != "" &&
[winfo exists $f_opts($path_name,name)]} {
set rt [catch {Apol_Analysis_fulflow::advanced_filters_set_widgets_to_default_state \
$path_name} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
raise $f_opts($path_name,name)
focus -force $f_opts($path_name,name)
if {$f_opts($path_name,class_selected_idx) != "-1"} {
$f_opts($path_name,class_listbox) selection set \
[$f_opts($path_name,class_listbox) index \
$f_opts($path_name,class_selected_idx)]
Apol_Analysis_fulflow::advanced_filters_display_permissions $path_name
}
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_include_types {remove_list_1 \
add_list_1 \
remove_lbox \
add_lbox \
master_incl_types_list_1 \
master_excl_types_list_1} {
upvar #0 $remove_list_1 remove_list
upvar #0 $add_list_1 add_list
upvar #0 $master_incl_types_list_1 master_incl_types_list
upvar #0 $master_excl_types_list_1 master_excl_types_list
set type_indices [$remove_lbox curselection]
if {$type_indices != ""} {
set tmp_list ""
foreach idx $type_indices {
set tmp_list [lappend tmp_list [$remove_lbox get $idx]]
}
foreach type $tmp_list {
set idx [lsearch -exact $remove_list $type]
if {$idx != -1} {
set remove_list [lreplace $remove_list $idx $idx]
set add_list [lappend add_list $type]
set add_list [lsort $add_list]
}
set master_incl_types_list [lappend master_incl_types_list $type]
set idx [lsearch -exact $master_excl_types_list $type]
if {$idx != -1} {
set master_excl_types_list [lreplace $master_excl_types_list $idx $idx]
}
}
$remove_lbox selection clear 0 end
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_exclude_types {remove_list_1 \
add_list_1 \
remove_lbox \
add_lbox \
master_incl_types_list_1 \
master_excl_types_list_1} {
upvar #0 $remove_list_1 remove_list
upvar #0 $add_list_1 add_list
upvar #0 $master_incl_types_list_1 master_incl_types_list
upvar #0 $master_excl_types_list_1 master_excl_types_list
set type_indices [$remove_lbox curselection]
if {$type_indices != ""} {
set tmp_list ""
foreach idx $type_indices {
set tmp_list [lappend tmp_list [$remove_lbox get $idx]]
}
foreach type $tmp_list {
set idx [lsearch -exact $remove_list $type]
if {$idx != -1} {
set remove_list [lreplace $remove_list $idx $idx]
set add_list [lappend add_list $type]
set add_list [lsort $add_list]
}
set master_excl_types_list [lappend master_excl_types_list $type]
set idx [lsearch -exact $master_incl_types_list $type]
if {$idx != -1} {
set master_incl_types_list [lreplace $master_incl_types_list $idx $idx]
}
}
$remove_lbox selection clear 0 end
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_configure_adv_combo_state {cb_selected_1 \
combo_box \
lbox \
which_list \
path_name} {
variable f_opts
upvar #0 $cb_selected_1 cb_selected
if {$cb_selected} {
$combo_box configure -state normal -entrybg white
if {$which_list == "incl"} {
Apol_Analysis_fulflow::advanced_filters_filter_types_using_attrib \
Apol_Analysis_fulflow::f_opts($path_name,incl_attrib_combo_value) \
$lbox \
Apol_Analysis_fulflow::f_opts($path_name,master_incl_types_list)
} else {
Apol_Analysis_fulflow::advanced_filters_filter_types_using_attrib \
Apol_Analysis_fulflow::f_opts($path_name,excl_attrib_combo_value) \
$lbox \
Apol_Analysis_fulflow::f_opts($path_name,master_excl_types_list)
}
} else {
$combo_box configure -state disabled -entrybg $ApolTop::default_bg_color
if {$which_list == "incl"} {
set [$lbox cget -listvar] \
[lsort $f_opts($path_name,master_incl_types_list)]
} elseif {$which_list == "excl"} {
set [$lbox cget -listvar] \
[lsort $f_opts($path_name,master_excl_types_list)]
} else {
tk_messageBox -icon error -type ok -title "Error" \
-message "Invalid paremeter ($which_list) to \
Apol_Analysis_fulflow::advanced_filters_configure_adv_combo_state. \
Must be either 'incl' or 'excl'"
return -1
}
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_filter_types_using_attrib {attribute_1 lbox non_filtered_types_1} {
upvar #0 $attribute_1 attribute
upvar #0 $non_filtered_types_1 non_filtered_types
if {$attribute != ""} {
$lbox delete 0 end
set rt [catch {set attrib_types [apol_GetAttribTypesList $attribute]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
if {$non_filtered_types != ""} {
set len [llength $non_filtered_types]
for {set i 0} {$i < $len} {incr i} {
set idx [lsearch -exact $attrib_types [lindex $non_filtered_types $i]]
if {$idx != -1} {
$lbox insert end [lindex $non_filtered_types $i]
}
}
}
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_include_exclude_permissions {which path_name} {
variable f_opts
if {[ApolTop::is_policy_open]} {
if {[string equal $which "include"] == 0 && [string equal $which "exclude"] == 0} {
puts "Tcl error: wrong 'which' argument sent to Apol_Analysis_fulflow::advanced_filters_include_exclude_permissions. Must be either 'include' or 'exclude'."
return -1
}
set objs [$f_opts($path_name,class_listbox) curselection]
foreach object_class_idx $objs {
set object_class [$f_opts($path_name,class_listbox) get $object_class_idx]
set idx [string first $Apol_Analysis_fulflow::excluded_tag $object_class]
if {$idx != -1} {
set object_class [string range $object_class 0 [expr $idx - 1]]
}
set rt [catch {set perms_list [apol_GetPermsByClass $object_class 1]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
foreach perm $perms_list {
set f_opts($path_name,perm_status_array,$object_class,$perm) $which
}
if {$object_class_idx != ""} {
set items [$f_opts($path_name,class_listbox) get 0 end]
if {[string equal $which "exclude"]} {
$f_opts($path_name,class_listbox) itemconfigure $object_class_idx \
-foreground gray
set [$f_opts($path_name,class_listbox) cget -listvar] \
[lreplace $items $object_class_idx $object_class_idx \
"$object_class$Apol_Analysis_fulflow::excluded_tag"]
} else {
$f_opts($path_name,class_listbox) itemconfigure $object_class_idx \
-foreground $f_opts($path_name,select_fg_orig)
set [$f_opts($path_name,class_listbox) cget -listvar] \
[lreplace $items $object_class_idx $object_class_idx \
"$object_class"]
}
}
if {$f_opts($path_name,class_selected_idx) == $object_class_idx} {
$f_opts($path_name,permissions_title_frame) configure \
-text "Permissions for [$f_opts($path_name,class_listbox) get \
$object_class_idx]:"
}
}
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_change_obj_state_on_perm_select {path_name} {
variable f_opts
set num_excluded 0
if {$f_opts($path_name,class_selected_idx) != "-1"} {
set class_sel [$f_opts($path_name,class_listbox) get \
$f_opts($path_name,class_selected_idx)]
set idx [string first $Apol_Analysis_fulflow::excluded_tag $class_sel]
if {$idx != -1} {
set class_sel [string range $class_sel 0 [expr $idx - 1]]
}
set class_elements [array get f_opts "$path_name,perm_status_array,$class_sel,*"]
if {$class_elements != ""} {
set num_perms_for_class [expr {[llength $class_elements] / 2}]
set len [llength $class_elements]
for {set i 0} {$i < $len} {incr i} {
incr i
if {[string equal [lindex $class_elements $i] "exclude"]} {
incr num_excluded
}
}
set items [$f_opts($path_name,class_listbox) get 0 end]
if {$num_excluded == $num_perms_for_class} {
$f_opts($path_name,class_listbox) itemconfigure \
$f_opts($path_name,class_selected_idx) \
-foreground gray
set [$f_opts($path_name,class_listbox) cget -listvar] \
[lreplace $items $f_opts($path_name,class_selected_idx) \
$f_opts($path_name,class_selected_idx) \
"$class_sel$Apol_Analysis_fulflow::excluded_tag"]
} else {
$f_opts($path_name,class_listbox) itemconfigure \
$f_opts($path_name,class_selected_idx) \
-foreground $f_opts($path_name,select_fg_orig)
set [$f_opts($path_name,class_listbox) cget -listvar] \
[lreplace $items $f_opts($path_name,class_selected_idx) \
$f_opts($path_name,class_selected_idx) \
"$class_sel"]
}
$f_opts($path_name,permissions_title_frame) configure \
-text "Permissions for [$f_opts($path_name,class_listbox) get \
$f_opts($path_name,class_selected_idx)]:"
}
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_embed_perm_buttons {list_b class perm path_name} {
variable f_opts
set frame [frame $list_b.f:$class:$perm -bd 0 -bg white]
set lbl_frame [frame $frame.lbl_frame:$class:$perm -width 20 -bd 1 -bg white]
set cb_frame [frame $frame.cb_frame:$class:$perm -width 10 -bd 0 -bg white]
set lbl1 [label $lbl_frame.lbl1:$class:$perm -bg white -justify left -width 20 \
-anchor nw -text $perm]
set lbl2 [label $lbl_frame.lbl2:$class:$perm -bg white -justify left -width 5 -text "--->"]
set cb_include [radiobutton $cb_frame.cb_include:$class:$perm -bg white \
-value include -text "Include" \
-highlightthickness 0 \
-variable Apol_Analysis_fulflow::f_opts($path_name,perm_status_array,$class,$perm) \
-command "Apol_Analysis_fulflow::advanced_filters_change_obj_state_on_perm_select \
$path_name"]
set cb_exclude [radiobutton $cb_frame.cb_exclude:$class:$perm -bg white \
-value exclude -text "Exclude" \
-highlightthickness 0 \
-variable Apol_Analysis_fulflow::f_opts($path_name,perm_status_array,$class,$perm) \
-command "Apol_Analysis_fulflow::advanced_filters_change_obj_state_on_perm_select \
$path_name"]
set lbl_weight [Label $cb_frame.lbl_weight:$class:$perm -bg white \
-text "Perm map weight: [Apol_Perms_Map::get_weight_for_class_perm $class $perm]" \
-padx 10]
pack $frame -side left -anchor nw -expand yes -pady 10
pack $lbl_frame $cb_frame -side left -anchor nw -expand yes
pack $lbl1 $lbl2 -side left -anchor nw
pack $cb_include $cb_exclude $lbl_weight -side left -anchor nw
return $frame
}
proc Apol_Analysis_fulflow::advanced_filters_clear_perms_text {path_name} {
variable f_opts
$f_opts($path_name,perms_box) configure -state normal
set names [$f_opts($path_name,perms_box) window names]
foreach emb_win $names {
if { [winfo exists $emb_win] } {
set rt [catch {destroy $emb_win} err]
if {$rt != 0} {
tk_messageBox \
-icon error \
-type ok \
-title "Error" \
-message "$err"
return -1
}
}
}
$f_opts($path_name,perms_box) delete 1.0 end
$f_opts($path_name,perms_box) configure -state disabled
}
proc Apol_Analysis_fulflow::render_permissions {path_name} {
variable f_opts
set class_idx [$f_opts($path_name,class_listbox) curselection]
if {$class_idx == ""} {
return 0
}
focus -force $f_opts($path_name,class_listbox)
set class_name [$f_opts($path_name,class_listbox) get $class_idx]
$f_opts($path_name,permissions_title_frame) configure -text "Permissions for $class_name:"
Apol_Analysis_fulflow::advanced_filters_clear_perms_text $path_name
update
set idx [string first $Apol_Analysis_fulflow::excluded_tag $class_name]
if {$idx != -1} {
set class_name [string range $class_name 0 [expr $idx - 1]]
}
set rt [catch {set perms_list [apol_GetPermsByClass $class_name 1]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "$err"
return -1
}
set perms_list [lsort $perms_list]
$f_opts($path_name,perms_box) configure -state normal
foreach perm $perms_list {
if {[array names f_opts "$path_name,perm_status_array,$class_name,$perm"] == ""} {
set f_opts($path_name,perm_status_array,$class_name,$perm) include
}
$f_opts($path_name,perms_box) window create end -window \
[Apol_Analysis_fulflow::advanced_filters_embed_perm_buttons \
$f_opts($path_name,perms_box) $class_name $perm $path_name]
$f_opts($path_name,perms_box) insert end "\n"
}
$f_opts($path_name,perms_box) configure -state disabled
}
proc Apol_Analysis_fulflow::advanced_filters_display_permissions {path_name} {
variable f_opts
if {[$f_opts($path_name,class_listbox) get 0 end] == "" || \
[llength [$f_opts($path_name,class_listbox) curselection]] > 1} {
return 0
}
set bind_tag_id [string trim $path_name "."]
bind ${bind_tag_id}_fulflow_object_list_Tag <<ListboxSelect>> ""
set f_opts($path_name,class_selected_idx) [$f_opts($path_name,class_listbox) curselection]
Apol_Analysis_fulflow::render_permissions $path_name
update idletasks
bind ${bind_tag_id}_fulflow_object_list_Tag <<ListboxSelect>> \
"Apol_Analysis_fulflow::advanced_filters_display_permissions $path_name"
}
proc Apol_Analysis_fulflow::advanced_filters_initialize_objs_and_perm_filters {path_name} {
variable f_opts
set f_opts($path_name,class_list) $Apol_Class_Perms::class_list
foreach class $f_opts($path_name,class_list) {
set rt [catch {set perms_list [apol_GetPermsByClass $class 1]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
foreach perm $perms_list {
set f_opts($path_name,perm_status_array,$class,$perm) include
}
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_initialize_vars {path_name} {
variable f_opts
if {$f_opts($path_name,filter_vars_init) == 0} {
Apol_Analysis_fulflow::advanced_filters_initialize_objs_and_perm_filters $path_name
set f_opts($path_name,master_incl_types_list) $Apol_Types::typelist
set idx [lsearch -exact $f_opts($path_name,master_incl_types_list) "self"]
if {$idx != -1} {
set f_opts($path_name,master_incl_types_list) \
[lreplace $f_opts($path_name,master_incl_types_list) \
$idx $idx]
}
set f_opts($path_name,master_excl_types_list) $f_opts($path_name,filtered_excl_types)
set f_opts($path_name,filtered_incl_types) $f_opts($path_name,master_incl_types_list)
set f_opts($path_name,filtered_excl_types) $f_opts($path_name,master_excl_types_list)
set f_opts($path_name,filter_vars_init) 1
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_set_widgets_to_default_state {path_name} {
variable f_opts
$f_opts($path_name,combo_incl) configure -values $Apol_Types::attriblist
$f_opts($path_name,combo_excl) configure -values $Apol_Types::attriblist
$f_opts($path_name,combo_excl) configure -text $f_opts($path_name,excl_attrib_combo_value)
$f_opts($path_name,combo_incl) configure -text $f_opts($path_name,incl_attrib_combo_value)
set f_opts($path_name,select_fg_orig) [$f_opts($path_name,class_listbox) cget -foreground]
set class_lbox_idx 0
foreach class $f_opts($path_name,class_list) {
set idx [string first $Apol_Analysis_fulflow::excluded_tag $class]
if {$idx != -1} {
set class [string range $class 0 [expr $idx - 1]]
}
set num_excluded 0
set class_perms [array names f_opts "$path_name,perm_status_array,$class,*"]
foreach element $class_perms {
if {[string equal $f_opts($element) "exclude"]} {
incr num_excluded
}
}
if {$num_excluded == [llength $class_perms]} {
set [$f_opts($path_name,class_listbox) cget -listvar] \
[lreplace $f_opts($path_name,class_list) $class_lbox_idx \
$class_lbox_idx "$class$Apol_Analysis_fulflow::excluded_tag"]
$f_opts($path_name,class_listbox) itemconfigure $class_lbox_idx \
-foreground gray
} else {
set [$f_opts($path_name,class_listbox) cget -listvar] \
[lreplace $f_opts($path_name,class_list) $class_lbox_idx \
$class_lbox_idx "$class"]
$f_opts($path_name,class_listbox) itemconfigure $class_lbox_idx \
-foreground $f_opts($path_name,select_fg_orig)
}
incr class_lbox_idx
}
Apol_Analysis_fulflow::advanced_filters_configure_adv_combo_state \
Apol_Analysis_fulflow::f_opts($path_name,incl_attrib_cb_sel) \
$f_opts($path_name,combo_incl) \
$f_opts($path_name,lbox_incl) \
incl \
$path_name
Apol_Analysis_fulflow::advanced_filters_configure_adv_combo_state \
Apol_Analysis_fulflow::f_opts($path_name,excl_attrib_cb_sel) \
$f_opts($path_name,combo_excl) \
$f_opts($path_name,lbox_excl) \
excl \
$path_name
set val [expr $f_opts($path_name,threshhold_value) - 1]
$f_opts($path_name,spinbox_threshhold) setvalue @$val
Apol_Analysis_fulflow::advanced_filters_change_spinbox_state \
$path_name
$f_opts($path_name,class_listbox) selection set 0
Apol_Analysis_fulflow::advanced_filters_display_permissions $path_name
}
proc Apol_Analysis_fulflow::advanced_filters_destroy_all_dialogs_on_open {} {
variable f_opts
set dlgs [array names f_opts "*,name"]
set length [llength $dlgs]
for {set i 0} {$i < $length} {incr i} {
incr i
Apol_Analysis_fulflow::advanced_filters_destroy_dialog [lindex $dlgs $i]
Apol_Analysis_fulflow::advanced_filters_destroy_object [lindex $dlgs $i]
}
array unset f_opts
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_destroy_dialog {path_name} {
variable f_opts
if {[winfo exists $path_name]} {
destroy $path_name
unset f_opts($path_name,lbox_incl)
unset f_opts($path_name,lbox_excl)
unset f_opts($path_name,combo_incl)
unset f_opts($path_name,combo_excl)
unset f_opts($path_name,class_listbox)
unset f_opts($path_name,perms_box)
unset f_opts($path_name,permissions_title_frame)
unset f_opts($path_name,spinbox_threshhold)
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_create_object {path_name} {
variable f_opts
set f_opts($path_name,name) $path_name
set f_opts($path_name,filtered_incl_types) ""
set f_opts($path_name,filtered_excl_types) ""
set f_opts($path_name,master_incl_types_list) ""
set f_opts($path_name,master_excl_types_list) ""
set f_opts($path_name,class_list) ""
set f_opts($path_name,incl_attrib_combo_value) ""
set f_opts($path_name,excl_attrib_combo_value) ""
set f_opts($path_name,incl_attrib_cb_sel) 0
set f_opts($path_name,excl_attrib_cb_sel) 0
set f_opts($path_name,threshhold_cb_value) 0
set f_opts($path_name,threshhold_value) 1
set f_opts($path_name,filter_vars_init) 0
set f_opts($path_name,class_selected_idx) -1
set rt [catch {Apol_Analysis_fulflow::advanced_filters_initialize_vars $path_name} err]
if {$rt != 0} {
puts "Error: $err"
return -1
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_copy_object {path_name new_object} {
variable f_opts
upvar 1 $new_object object
if {![array exists f_opts] || [array names f_opts "$path_name,name"] == ""} {
Apol_Analysis_fulflow::advanced_filters_create_object $path_name
}
array set object [array get f_opts "$path_name,*"]
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_destroy_object {path_name} {
variable f_opts
if {[array exists f_opts] && [array names f_opts "$path_name,name"] != ""} {
array unset f_opts "$path_name,perm_status_array,*"
unset f_opts($path_name,filtered_incl_types)
unset f_opts($path_name,filtered_excl_types)
unset f_opts($path_name,master_incl_types_list)
unset f_opts($path_name,master_excl_types_list)
unset f_opts($path_name,class_list)
unset f_opts($path_name,incl_attrib_combo_value)
unset f_opts($path_name,excl_attrib_combo_value)
unset f_opts($path_name,incl_attrib_cb_sel)
unset f_opts($path_name,excl_attrib_cb_sel)
unset f_opts($path_name,threshhold_cb_value)
unset f_opts($path_name,threshhold_value)
unset f_opts($path_name,filter_vars_init)
unset f_opts($path_name,class_selected_idx)
unset f_opts($path_name,name)
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_change_spinbox_state {path_name} {
variable f_opts
if {$f_opts($path_name,threshhold_cb_value)} {
$f_opts($path_name,spinbox_threshhold) configure -state normal -entrybg white
} else {
$f_opts($path_name,spinbox_threshhold) configure -state disabled -entrybg $ApolTop::default_bg_color
}
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_change_threshhold_value {path_name} {
variable f_opts
set f_opts($path_name,threshhold_value) \
[expr [$f_opts($path_name,spinbox_threshhold) getvalue] + 1]
return 0
}
proc Apol_Analysis_fulflow::advanced_filters_create_dialog {path_name title_txt} {
variable f_opts
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened!"
return -1
}
set rt [catch {Apol_Analysis_fulflow::load_default_perm_map} err]
if {$rt != 0} {
return -1
}
if {[array exists f_opts] && \
[array names f_opts "$path_name,name"] != ""} {
if {[winfo exists $f_opts($path_name,name)]} {
raise $f_opts($path_name,name)
focus $f_opts($path_name,name)
return 0
}
} else {
Apol_Analysis_fulflow::advanced_filters_create_object $path_name
}
toplevel $f_opts($path_name,name)
wm withdraw $f_opts($path_name,name)
wm title $f_opts($path_name,name) $title_txt
wm protocol $f_opts($path_name,name) WM_DELETE_WINDOW " "
set close_frame [frame $f_opts($path_name,name).close_frame -relief sunken -bd 1]
set topf [frame $f_opts($path_name,name).topf]
set pw1 [PanedWindow $topf.pw1 -side left -weights available]
$pw1 add -weight 2 -minsize 225
$pw1 add -weight 2 -minsize 225
pack $close_frame -side bottom -anchor center -pady 2
pack $pw1 -fill both -expand yes
pack $topf -fill both -expand yes -padx 10 -pady 10
set objs_frame [TitleFrame [$pw1 getframe 0].objs_frame -text "Filter by object class permissions:"]
set types_frame [TitleFrame [$pw1 getframe 1].types_frame -text "Filter by intermediate types:"]
set pw1 [PanedWindow [$objs_frame getframe].pw -side top -weights available]
set pane [$pw1 add]
set search_pane [$pw1 add]
set pw2 [PanedWindow $pane.pw -side left -weights available]
set class_pane [$pw2 add]
set f_opts($path_name,classes_box) [TitleFrame $class_pane.tbox -text "Object Classes:" -bd 0]
set f_opts($path_name,permissions_title_frame) [TitleFrame $search_pane.rbox \
-text "Permissions:" -bd 0]
set sw_class [ScrolledWindow [$f_opts($path_name,classes_box) getframe].sw -auto none]
set f_opts($path_name,class_listbox) [listbox [$sw_class getframe].lb \
-height 10 -highlightthickness 0 \
-bg white -selectmode extended \
-listvar Apol_Analysis_fulflow::f_opts($path_name,class_list) \
-exportselection 0]
$sw_class setwidget $f_opts($path_name,class_listbox)
set sw_list [ScrolledWindow [$f_opts($path_name,permissions_title_frame) getframe].sw_c -auto none]
set f_opts($path_name,perms_box) [text [$f_opts($path_name,permissions_title_frame) getframe].perms_box \
-cursor $ApolTop::prevCursor \
-bg white -font $ApolTop::text_font]
$sw_list setwidget $f_opts($path_name,perms_box)
set threshhold_frame [frame [$f_opts($path_name,permissions_title_frame) getframe].threshhold_frame]
set f_opts($path_name,spinbox_threshhold) [SpinBox $threshhold_frame.spinbox_threshhold \
-bg white \
-range [list 1 10 1] \
-editable 0 -entrybg white -width 6 \
-helptext "Specify a weight threshhold" \
-modifycmd "Apol_Analysis_fulflow::advanced_filters_change_threshhold_value $path_name"]
set cbutton_threshhold [checkbutton $threshhold_frame.cbutton_threshhold \
-text "Exclude permissions that have weights below this threshold:" \
-variable Apol_Analysis_fulflow::f_opts($path_name,threshhold_cb_value) \
-offvalue 0 -onvalue 1 \
-command "Apol_Analysis_fulflow::advanced_filters_change_spinbox_state \
$path_name"]
set bframe [frame [$f_opts($path_name,permissions_title_frame) getframe].bframe]
set b_incl_all_perms [Button $bframe.b_incl_all_perms -text "Include All Perms" \
-helptext "Select this to include all permissions for the selected object in the query." \
-command "Apol_Analysis_fulflow::advanced_filters_include_exclude_permissions \
include $path_name"]
set b_excl_all_perms [Button $bframe.b_excl_all_perms -text "Exclude All Perms" \
-helptext "Select this to exclude all permissions for the selected object from the query." \
-command "Apol_Analysis_fulflow::advanced_filters_include_exclude_permissions \
exclude $path_name"]
set bind_tag_id [string trim $path_name "."]
bindtags $f_opts($path_name,class_listbox) \
[linsert [bindtags $f_opts($path_name,class_listbox)] 3 \
${bind_tag_id}_fulflow_object_list_Tag]
bind ${bind_tag_id}_fulflow_object_list_Tag \
<<ListboxSelect>> "Apol_Analysis_fulflow::advanced_filters_display_permissions $path_name"
pack $cbutton_threshhold $f_opts($path_name,spinbox_threshhold) -side left -anchor nw -padx 2
pack $threshhold_frame -fill x -anchor nw -side bottom -pady 2
pack $b_excl_all_perms -side right -anchor nw -pady 2 -expand yes -fill x -ipadx 1
pack $b_incl_all_perms -side left -anchor nw -pady 2 -expand yes -fill x -ipadx 2
pack $bframe -side bottom -fill both -anchor sw -pady 2
pack $f_opts($path_name,permissions_title_frame) -pady 2 -padx 2 -fill both -expand yes
pack $f_opts($path_name,classes_box) -padx 2 -side left -fill both -expand yes
pack $sw_class -fill both -expand yes -side top
pack $sw_list -fill both -expand yes -side top
pack $pw2 -fill both -expand yes
pack $pw1 -fill both -expand yes
set include_f [TitleFrame [$types_frame getframe].include_f \
-text "Include these types:" -bd 0]
set middle_f [frame [$types_frame getframe].middle_f]
set exclude_f [TitleFrame [$types_frame getframe].exclude_f \
-text "Exclude these types:" -bd 0]
set b_incl_f [frame [$include_f getframe].b_incl_f]
set b_excl_f [frame [$exclude_f getframe].b_excl_f]
set buttons_incl_f [frame $b_incl_f.buttons_incl_f]
set buttons_excl_f [frame $b_excl_f.buttons_excl_f]
set sw_incl [ScrolledWindow [$include_f getframe].sw_incl]
set sw_excl [ScrolledWindow [$exclude_f getframe].sw_excl]
set f_opts($path_name,lbox_incl) [listbox [$sw_incl getframe].lbox_incl \
-height 6 \
-highlightthickness 0 \
-listvar Apol_Analysis_fulflow::f_opts($path_name,filtered_incl_types) \
-selectmode extended -bg white -exportselection 0]
set f_opts($path_name,lbox_excl) [listbox [$sw_excl getframe].lbox_excl \
-height 6 \
-highlightthickness 0 \
-listvar Apol_Analysis_fulflow::f_opts($path_name,filtered_excl_types) \
-selectmode extended -bg white -exportselection 0]
$sw_incl setwidget $f_opts($path_name,lbox_incl)
$sw_excl setwidget $f_opts($path_name,lbox_excl)
bindtags $f_opts($path_name,lbox_incl) \
[linsert [bindtags $Apol_Analysis_fulflow::f_opts($path_name,lbox_incl)] 3 \
${bind_tag_id}_lbox_incl_Tag]
bindtags $f_opts($path_name,lbox_excl) \
[linsert [bindtags $Apol_Analysis_fulflow::f_opts($path_name,lbox_excl)] 3 \
${bind_tag_id}_lbox_excl_Tag]
bind ${bind_tag_id}_lbox_incl_Tag <<ListboxSelect>> "focus -force $f_opts($path_name,lbox_incl)"
bind ${bind_tag_id}_lbox_excl_Tag <<ListboxSelect>> "focus -force $f_opts($path_name,lbox_excl)"
bind ${bind_tag_id}_lbox_incl_Tag <KeyPress> "ApolTop::tklistbox_select_on_key_callback \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_incl) \
Apol_Analysis_fulflow::f_opts($path_name,filtered_incl_types) \
%K"
bind ${bind_tag_id}_lbox_excl_Tag <KeyPress> "ApolTop::tklistbox_select_on_key_callback \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_excl) \
Apol_Analysis_fulflow::f_opts($path_name,filtered_excl_types) \
%K"
set include_bttn [Button $middle_f.include_bttn -text "<--" \
-command "Apol_Analysis_fulflow::advanced_filters_include_types \
Apol_Analysis_fulflow::f_opts($path_name,filtered_excl_types) \
Apol_Analysis_fulflow::f_opts($path_name,filtered_incl_types) \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_excl) \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_incl) \
Apol_Analysis_fulflow::f_opts($path_name,master_incl_types_list) \
Apol_Analysis_fulflow::f_opts($path_name,master_excl_types_list)" \
-helptext "Include this type in the query" -width 8]
set exclude_bttn [Button $middle_f.exclude_bttn -text "-->" \
-command "Apol_Analysis_fulflow::advanced_filters_exclude_types \
Apol_Analysis_fulflow::f_opts($path_name,filtered_incl_types) \
Apol_Analysis_fulflow::f_opts($path_name,filtered_excl_types) \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_incl) \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_excl) \
Apol_Analysis_fulflow::f_opts($path_name,master_incl_types_list) \
Apol_Analysis_fulflow::f_opts($path_name,master_excl_types_list)" \
-helptext "Exclude this type from the query" -width 8]
set b_incl_all_sel [Button $buttons_incl_f.b_incl_all_sel -text "Select All" \
-command "Apol_Analysis_fulflow::select_all_lbox_items \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_incl)"]
set b_incl_all_clear [Button $buttons_incl_f.b_incl_all_clear -text "Unselect" \
-command "Apol_Analysis_fulflow::clear_all_lbox_items \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_incl)"]
set b_excl_all_sel [Button $buttons_excl_f.b_excl_all_sel -text "Select All" \
-command "Apol_Analysis_fulflow::select_all_lbox_items \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_excl)"]
set b_excl_all_clear [Button $buttons_excl_f.b_excl_all_clear -text "Unselect" \
-command "Apol_Analysis_fulflow::clear_all_lbox_items \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_excl)"]
set f_opts($path_name,combo_incl) [ComboBox $b_incl_f.combo_incl \
-editable 0 \
-textvariable Apol_Analysis_fulflow::f_opts($path_name,incl_attrib_combo_value) \
-entrybg $ApolTop::default_bg_color \
-modifycmd "Apol_Analysis_fulflow::advanced_filters_filter_types_using_attrib \
Apol_Analysis_fulflow::f_opts($path_name,incl_attrib_combo_value) \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_incl) \
Apol_Analysis_fulflow::f_opts($path_name,master_incl_types_list)"]
set f_opts($path_name,combo_excl) [ComboBox [$exclude_f getframe].combo_excl \
-editable 0 \
-textvariable Apol_Analysis_fulflow::f_opts($path_name,excl_attrib_combo_value) \
-entrybg $ApolTop::default_bg_color \
-modifycmd "Apol_Analysis_fulflow::advanced_filters_filter_types_using_attrib \
Apol_Analysis_fulflow::f_opts($path_name,excl_attrib_combo_value) \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_excl) \
Apol_Analysis_fulflow::f_opts($path_name,master_excl_types_list)"]
set cb_incl_attrib [checkbutton $b_incl_f.cb_incl_attrib \
-text "Filter included type(s) by attribute:" \
-variable Apol_Analysis_fulflow::f_opts($path_name,incl_attrib_cb_sel) \
-offvalue 0 -onvalue 1 \
-command "Apol_Analysis_fulflow::advanced_filters_configure_adv_combo_state \
Apol_Analysis_fulflow::f_opts($path_name,incl_attrib_cb_sel) \
$Apol_Analysis_fulflow::f_opts($path_name,combo_incl) \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_incl) \
incl \
$path_name"]
set cb_excl_attrib [checkbutton [$exclude_f getframe].cb_excl_attrib \
-text "Filter excluded type(s) by attribute:" \
-variable Apol_Analysis_fulflow::f_opts($path_name,excl_attrib_cb_sel) \
-offvalue 0 -onvalue 1 \
-command "Apol_Analysis_fulflow::advanced_filters_configure_adv_combo_state \
Apol_Analysis_fulflow::f_opts($path_name,excl_attrib_cb_sel) \
$Apol_Analysis_fulflow::f_opts($path_name,combo_excl) \
$Apol_Analysis_fulflow::f_opts($path_name,lbox_excl) \
excl \
$path_name"]
set close_bttn [Button $close_frame.close_bttn -text "Close" -width 8 \
-command "Apol_Analysis_fulflow::advanced_filters_destroy_dialog $path_name"]
pack $close_bttn -side left -anchor center
pack $b_excl_f -side bottom -anchor center -pady 2
pack $b_incl_f -side bottom -anchor center -pady 2
pack $buttons_excl_f -side bottom -anchor center -pady 2
pack $buttons_incl_f -side bottom -anchor center -pady 2
pack $b_excl_all_sel $b_excl_all_clear -side left -anchor center -expand yes -pady 2
pack $sw_excl -side top -anchor nw -fill both -expand yes -pady 2 -padx 6
pack $cb_excl_attrib -side top -anchor center -padx 6
pack $f_opts($path_name,combo_excl) -side top -anchor center -pady 2 -padx 15
pack $b_incl_all_sel $b_incl_all_clear -side left -anchor center -expand yes -pady 2
pack $sw_incl -side top -anchor nw -fill both -expand yes -pady 2 -padx 6
pack $cb_incl_attrib -side top -anchor center -padx 6
pack $f_opts($path_name,combo_incl) -side top -anchor center -pady 2 -padx 15
pack $include_bttn $exclude_bttn -side top -pady 2 -anchor center
pack $include_f $exclude_f -side left -anchor nw -fill both -expand yes
pack $middle_f -side left -anchor center -after $include_f -padx 5 -expand yes
pack $types_frame $objs_frame -side top -anchor nw -padx 5 -pady 2 -expand yes -fill both
set width 780
set height 750
wm geom $f_opts($path_name,name) ${width}x${height}
wm deiconify $f_opts($path_name,name)
focus $f_opts($path_name,name)
Apol_Analysis_fulflow::advanced_filters_set_widgets_to_default_state $path_name
wm protocol $f_opts($path_name,name) WM_DELETE_WINDOW \
"Apol_Analysis_fulflow::advanced_filters_destroy_dialog $path_name"
return 0
}
proc Apol_Analysis_fulflow::create_options { options_frame } {
variable combo_attribute
variable combo_start
variable display_attrib_sel
variable display_attribute
variable start_type
variable end_type
variable endtype_sel
variable entry_end
variable in_button_sel
variable out_button_sel
variable in_button
variable out_button
variable cb_attrib
variable comment_text
set entry_frame [frame $options_frame.entry_frame]
set left_frame [TitleFrame $entry_frame.left_frame -text "Required parameters"]
set right_frame [frame $entry_frame.right_frame]
set f_frame [TitleFrame $right_frame.f_frame -text "Optional result filters"]
set c_frame [TitleFrame $right_frame.c_frame -text "Query Comments"]
set start_attrib_frame [frame [$left_frame getframe].start_attrib_frame]
set start_frame [frame $start_attrib_frame.start_frame]
set attrib_frame [frame $start_attrib_frame.attrib_frame]
set advanced_f [frame [$f_frame getframe].advanced_f]
set flowtype_frame [frame [$left_frame getframe].flowtype_frame]
set ckbttn_frame [frame $flowtype_frame.ckbttn_frame]
set endtype_frame [frame [$f_frame getframe].endtype_frame]
set lbl_start_type [Label $start_frame.lbl_start_type -text "Starting type:"]
set combo_start [ComboBox $start_frame.combo_start \
-helptext "You must choose a starting type for information flow" \
-editable 1 \
-textvariable Apol_Analysis_fulflow::start_type \
-entrybg white]
set lbl_flowtype [Label $flowtype_frame.lbl_flowtype -text "Flow direction:"]
set in_button [checkbutton $ckbttn_frame.in_button -text "Flow to" \
-variable Apol_Analysis_fulflow::in_button_sel \
-offvalue 0 -onvalue 1 \
-command { Apol_Analysis_fulflow::in_button_press }]
set out_button [checkbutton $ckbttn_frame.out_button -text "Flow from" \
-variable Apol_Analysis_fulflow::out_button_sel \
-offvalue 0 -onvalue 1 \
-command { Apol_Analysis_fulflow::out_button_press }]
set cb_attrib [checkbutton $attrib_frame.cb_attrib -text "Filter starting types to select using attribute:" \
-variable Apol_Analysis_fulflow::display_attrib_sel \
-offvalue 0 -onvalue 1 \
-command { Apol_Analysis_fulflow::config_attrib_comboBox_state }]
set combo_attribute [ComboBox $attrib_frame.combo_attribute \
-textvariable Apol_Analysis_fulflow::display_attribute \
-modifycmd { Apol_Analysis_fulflow::change_types_list}]
set b_advanced_filters [button $advanced_f.b_advanced_filters -text "Advanced Filters" \
-command {Apol_Analysis_fulflow::advanced_filters_create_dialog \
$Apol_Analysis_fulflow::advanced_filter_Dlg \
"Transitive Information Flow Advanced Filters"}]
set cb_endtype [checkbutton $endtype_frame.cb_endtype -text "Find end types using regular expression:" \
-variable Apol_Analysis_fulflow::endtype_sel \
-offvalue 0 -onvalue 1 \
-command {Apol_Analysis_fulflow::config_endtype_state}]
set entry_end [Entry $endtype_frame.entry_end \
-helptext "You may enter a regular expression" \
-editable 1 \
-textvariable Apol_Analysis_fulflow::end_type]
set sw_info [ScrolledWindow [$c_frame getframe].sw_info -auto none]
set comment_text [text [$c_frame getframe].c_text -wrap none -bg white -font $ApolTop::text_font]
$sw_info setwidget $comment_text
pack $entry_frame -side left -anchor nw -fill y -padx 5 -expand yes -fill both
pack $left_frame -side left -anchor nw -padx 5 -expand yes -fill both
pack $right_frame -side left -anchor nw -padx 5 -fill both
pack $f_frame -side top -anchor nw -pady 1 -fill x
pack $c_frame -side bottom -anchor nw -pady 1 -fill both -expand yes
pack $start_attrib_frame $flowtype_frame -side top -anchor nw -fill both -pady 5 -expand yes
pack $start_frame $attrib_frame -side top -anchor nw -fill both -expand yes
pack $lbl_flowtype -side top -anchor nw
pack $ckbttn_frame -side left -anchor nw -expand yes -fill both
pack $endtype_frame -side top -fill x -anchor nw -expand yes
pack $advanced_f -side top -anchor nw
pack $lbl_start_type -side top -anchor nw
pack $combo_start -side left -anchor nw -fill x -expand yes
pack $cb_attrib -side top -anchor nw
pack $combo_attribute -side top -anchor nw -padx 15 -fill x -expand yes
pack $in_button $out_button -side left -anchor nw -expand yes -fill x
pack $cb_endtype -side top -anchor nw -expand yes
pack $entry_end -side left -anchor nw -expand yes -fill x -padx 2
pack $b_advanced_filters -side left -anchor nw -expand yes -pady 5
pack $sw_info -side left -anchor nw -expand yes -fill both
bindtags $combo_start.e [linsert [bindtags $combo_start.e] 3 start_list_Tag]
bind start_list_Tag <KeyPress> {ApolTop::_create_popup $Apol_Analysis_fulflow::combo_start %W %K}
bindtags $combo_attribute.e [linsert [bindtags $combo_attribute.e] 3 attribs_list_Tag]
bind attribs_list_Tag <KeyPress> { ApolTop::_create_popup $Apol_Analysis_fulflow::combo_attribute %W %K }
return 0
}
namespace eval Apol_Analysis_relabel {
variable VERSION 1
variable info_button_text \
"Direct relabel analysis is designed to facilitate querying a \
policy for both potential changes to object labels and relabel \
privileges granted to a subject. These two modes are respectively \
called Object Mode and Subject Mode.\n\n \
OBJECT MODE\n \
In object mode the user specifies a starting or ending type and \
either To, From, or Both. When To is selected all types to which \
the starting type can be relabeled will be displayed. When From \
is selected all types from which the ending type can be relabeled \
will be displayed. Both will, obviously, do both analyses.\n\n \
SUBJECT MODE\n \
In subject mode the user specifies only a subject type. Two lists \
of types will be displayed corresponding to all of the types To \
which the subject can relabel and From which the subject can \
relabel.\n\n \
OPTIONAL RESULT FILTERS\n \
Results may be filtered in several ways. The end types resulting \
from a query may be filtered by regular expression. The Advanced \
Filters provide the option of selecting which object classes to \
include in the analysis and which types to include as subjects \
of relabeling operations. Note, excluded subjects are ignored in \
subject mode because only the selected subject type is used as \
a subject."
variable widget_vars
variable widgets
variable most_recent_results ""
variable advanced_filter_Dlg
set advanced_filter_Dlg .apol_relabel_advanced_filter_Dlg
variable excluded_tag " (Excluded)"
variable title_tag TITLE
variable title_type_tag TITLE_TYPE
variable subtitle_tag SUBTITLES
variable type_tag TYPE
variable top_node TOP_NODE
variable relabelto_perm "relabelto"
variable relabelfrom_perm "relabelfrom"
Apol_Analysis::register_analysis_modules "Apol_Analysis_relabel" "Direct Relabel"
}
proc Apol_Analysis_relabel::initialize { } {
set widget_vars(mode) "to"
set widget_vars(to_mode) 1
set widget_vars(from_mode) 1
return 0
}
proc Apol_Analysis_relabel::get_analysis_info {} {
return $Apol_Analysis_relabel::info_button_text
}
proc Apol_Analysis_relabel::get_results_raised_tab {} {
variable widget_vars
return $widget_vars(rtext)
}
proc Apol_Analysis_relabel::create_widgets_to_display_results {results results_frame} {
variable widget_vars
variable most_recent_results_pw
catch {destroy $results_frame.pw}
set pw [PanedWindow $results_frame.pw -side top -weights available]
set most_recent_results_pw $pw
set lf [$pw add -minsize 150 -weight 1]
set dtf [TitleFrame $lf.dtf]
if {$widget_vars(mode) == "object"} {
if {$widget_vars(to_mode) && $widget_vars(from_mode)} {
set text "Type $widget_vars(start_type) can be relabeled to/from:"
} elseif {$widget_vars(to_mode)} {
set text "Type $widget_vars(start_type) can be relabeled to:"
} else {
set text "Type $widget_vars(start_type) can be relabeled from:"
}
} else {
set text "Subject $widget_vars(start_type) can relabel:"
}
$dtf configure -text $text
set dsw [ScrolledWindow [$dtf getframe].dsw -auto horizontal]
set dtree [Tree [$dsw getframe].dtree -relief flat -width 15 \
-borderwidth 0 -highlightthickness 0 -redraw 1 \
-bg white -showlines 1 -padx 0]
$dsw setwidget $dtree
set widget_vars(current_dtree) $dtree
pack $dsw -expand 1 -fill both
pack $dtf -expand 1 -fill both -side left
set rf [$pw add -weight 3]
set rtf [TitleFrame $rf.rtf -text "Relabeling Results"]
set rsw [ScrolledWindow [$rtf getframe].rsw -auto horizontal]
set widget_vars(rtext) [text $rsw.rtext -wrap none -bg white -font $ApolTop::text_font]
$rsw setwidget $widget_vars(rtext)
Apol_PolicyConf::configure_HyperLinks $widget_vars(rtext)
set widget_vars(current_rtext) $widget_vars(rtext)
pack $rsw -expand 1 -fill both
pack $rtf -expand 1 -fill both
pack $pw -expand 1 -fill both
$dtree insert end root $Apol_Analysis_relabel::top_node \
-text $widget_vars(start_type) -open 1 \
-drawcross auto
if {$results == ""} {
$dtree configure -state disabled
set start_index 0
set text_s ""
$widget_vars(current_rtext) configure -wrap word
set start_index [string length $text_s]
append text_s "Direct Relabel Analysis: "
if {$widget_vars(mode) == "object"} {
if {$widget_vars(to_mode) && $widget_vars(from_mode)} {
append text_s "Starting/Ending Type: "
} elseif {$widget_vars(to_mode) && !$widget_vars(from_mode)} {
append text_s "Starting Type: "
} elseif {!$widget_vars(to_mode) && $widget_vars(from_mode)} {
append text_s "Ending Type: "
} else {
puts "Direction must be to, from, or both for object mode."
return
}
} else {
append text_s "Subject: "
}
set end_index [string length $text_s]
lappend title_tags $start_index $end_index
set start_index [string length $text_s]
append text_s "$widget_vars(start_type)"
set end_index [string length $text_s]
lappend title_type_tags $start_index $end_index
append text_s "\n\n"
append text_s "$widget_vars(start_type)"
set end_index [string length $text_s]
lappend title_type_tags $start_index $end_index
if {$widget_vars(mode) == "object"} {
append text_s " cannot be relabeled "
set start_index [string length $text_s]
if {$widget_vars(to_mode) && $widget_vars(from_mode)} {
append text_s "to/from"
} elseif {$widget_vars(to_mode)} {
append text_s "to"
} else {
append text_s "from"
}
set end_index [string length $text_s]
lappend subtitle_type_tags $start_index $end_index
append text_s " any type."
} else {
append text_s " does not relabel "
set start_index [string length $text_s]
append text_s "to or from"
set end_index [string length $text_s]
lappend subtitle_type_tags $start_index $end_index
append text_s " any type as a subject."
}
$widget_vars(rtext) insert end $text_s
foreach {start_index end_index} $title_type_tags {
$widget_vars(rtext) tag add $Apol_Analysis_relabel::title_type_tag \
"1.0 + $start_index c" "1.0 + $end_index c"
}
foreach {start_index end_index} $subtitle_type_tags {
$widget_vars(rtext) tag add $Apol_Analysis_relabel::subtitle_tag \
"1.0 + $start_index c" "1.0 + $end_index c"
}
foreach {start_index end_index} $title_tags {
$widget_vars(rtext) tag add $Apol_Analysis_relabel::title_tag \
"1.0 + $start_index c" "1.0 + $end_index c"
}
Apol_Analysis_relabel::formatInfoText $widget_vars(rtext)
} else {
$widget_vars(rtext) insert end "This tab provides the results of a relabeling analysis."
if {$widget_vars(mode) == "subject"} {
$dtree insert end $Apol_Analysis_relabel::top_node TO_LIST \
-text "To" -open 1 \
-drawcross auto
$dtree insert end $Apol_Analysis_relabel::top_node FROM_LIST \
-text "From" -open 1 \
-drawcross auto
set from_list [lindex $results 0]
set to_list [lindex $results 1]
foreach datum $from_list {
set domain [lindex $datum 0]
$dtree insert end FROM_LIST from_list:$domain \
-text $domain -open 1 \
-drawcross auto -data [lindex $datum 1]
}
set from_items [lsort -dictionary [$dtree nodes FROM_LIST]]
$dtree reorder FROM_LIST $from_items
foreach datum $to_list {
set domain [lindex $datum 0]
$dtree insert end TO_LIST to_list:$domain \
-text $domain -open 1 \
-drawcross auto -data [lindex $datum 1]
}
set to_items [lsort -dictionary [$dtree nodes TO_LIST]]
$dtree reorder TO_LIST $to_items
$dtree itemconfigure $Apol_Analysis_relabel::top_node \
-data [list [llength $from_items] [llength $to_items]]
$dtree itemconfigure TO_LIST \
-data [llength $to_items]
$dtree itemconfigure FROM_LIST \
-data [llength $from_items]
} else {
foreach result_elem $results {
set domain [lindex $result_elem 0]
$dtree insert end $Apol_Analysis_relabel::top_node $domain \
-text $domain -open 1 \
-drawcross auto -data [lrange $result_elem 1 end]
}
set items [lsort -dictionary [$dtree nodes $Apol_Analysis_relabel::top_node]]
$dtree reorder $Apol_Analysis_relabel::top_node $items
$dtree itemconfigure $Apol_Analysis_relabel::top_node \
-data [llength $items]
}
$dtree configure -selectcommand [namespace code tree_select]
}
$dtree selection set $Apol_Analysis_relabel::top_node
$widget_vars(rtext) configure -state disabled
}
proc Apol_Analysis_relabel::do_analysis {results_frame} {
variable widget_vars
variable most_recent_results
variable advanced_filter_Dlg
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok \
-title "Relabel Analysis Error" \
-message "No current policy file is opened!"
return -code error
}
set objs_list ""
set subj_list ""
if {![array exists widget_vars] || [array names widget_vars "$advanced_filter_Dlg,name"] == ""} {
Apol_Analysis_relabel::adv_options_create_object $advanced_filter_Dlg
}
foreach class $widget_vars($advanced_filter_Dlg,incl_class_list) {
lappend objs_list $class
}
foreach subj $widget_vars($advanced_filter_Dlg,master_excl_subj_list) {
lappend subj_list $subj
}
if {$objs_list == ""} {
tk_messageBox -icon error -type ok \
-title "Relabel Analysis Error" \
-message "You cannot exclude all object classes in the filter!"
return -code error
}
if {[llength $widget_vars($advanced_filter_Dlg,master_incl_subj_list)] == 0} {
tk_messageBox -icon error -type ok \
-title "Relabel Analysis Error" \
-message "You cannot exclude all subject types in the filter!"
return -code error
}
if {$widget_vars(mode) == "object"} {
if {$widget_vars(to_mode) && $widget_vars(from_mode)} {
set mode "both"
} elseif {$widget_vars(to_mode)} {
set mode "to"
} else {
set mode "from"
}
} else {
set mode "subject"
}
if [catch {apol_RelabelAnalysis $widget_vars(start_type) $mode $objs_list \
$subj_list $widget_vars(endtype_sel) $widget_vars(end_type)} results] {
tk_messageBox -icon error -type ok \
-title "Relabel Analysis Error" -message $results
return -code error
}
set most_recent_results $results
Apol_Analysis_relabel::create_widgets_to_display_results $results $results_frame
return 0
}
proc Apol_Analysis_relabel::close { } {
Apol_Analysis_relabel::set_widgets_to_initial_open_state
}
proc Apol_Analysis_relabel::set_widgets_to_initial_open_state { } {
Apol_Analysis_relabel::adv_options_destroy_dialog $Apol_Analysis_relabel::advanced_filter_Dlg
Apol_Analysis_relabel::init_widget_vars
Apol_Analysis_relabel::init_widget_state
}
proc Apol_Analysis_relabel::open { } {
Apol_Analysis_relabel::set_widgets_to_initial_open_state
}
proc Apol_Analysis_relabel::load_query_options {file_channel parentDlg} {
variable VERSION widget_vars
if {[gets $file_channel] > $VERSION} {
return -code error "The specified query version is not allowed."
}
array set Apol_Analysis_relabel::widget_vars [read $file_channel]
Apol_Analysis_relabel::init_widget_state
return 0
}
proc Apol_Analysis_relabel::save_query_options {module_name file_channel file_name} {
variable VERSION
variable widget_vars
puts $file_channel $module_name
puts $file_channel $VERSION
puts $file_channel [array get Apol_Analysis_relabel::widget_vars]
return 0
}
proc Apol_Analysis_relabel::get_current_results_state { } {
variable widget_vars
return [array get Apol_Analysis_relabel::widget_vars]
}
proc Apol_Analysis_relabel::set_display_to_results_state { query_options } {
variable widget_vars
array set Apol_Analysis_relabel::widget_vars $query_options
Apol_Analysis_relabel::init_widget_state
}
proc Apol_Analysis_relabel::free_results_data {query_options} {
}
proc Apol_Analysis_relabel::adv_options_destroy_dialog {path_name} {
if {[winfo exists $path_name]} {
destroy $path_name
}
return 0
}
proc Apol_Analysis_relabel::adv_options_refresh_dialog {path_name} {
if {[array exists widget_vars] && \
[array names widget_vars "$path_name,name"] != ""} {
Apol_Analysis_relabel::adv_options_destroy_object $path_name
Apol_Analysis_relabel::adv_options_create_object $path_name
Apol_Analysis_relabel::adv_options_update_dialog $path_name
}
return 0
}
proc Apol_Analysis_relabel::adv_options_update_dialog {path_name} {
variable widget_vars
if {[array exists widget_vars] && \
[array names widget_vars "$path_name,name"] != "" &&
[winfo exists $widget_vars($path_name,name)]} {
set rt [catch {Apol_Analysis_relabel::adv_options_set_widgets_to_default_state \
$path_name} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
raise $widget_vars($path_name,name)
focus -force $widget_vars($path_name,name)
}
return 0
}
proc Apol_Analysis_relabel::adv_options_change_obj_state_on_perm_select {path_name} {
variable widget_vars
variable widgets
set num_excluded 0
if {$widget_vars($path_name,class_selected_idx) != "-1"} {
set class_sel [$widgets($path_name,class_incl_lb) get \
$widget_vars($path_name,class_selected_idx)]
set idx [string first $Apol_Analysis_relabel::excluded_tag $class_sel]
if {$idx != -1} {
set class_sel [string range $class_sel 0 [expr $idx - 1]]
}
set class_elements [array get widget_vars "$path_name,perm_status_array,$class_sel,*"]
if {$class_elements != ""} {
set num_perms_for_class [expr {[llength $class_elements] / 2}]
for {set i 0} {$i < [llength $class_elements]} {incr i} {
incr i
if {[string equal [lindex $class_elements $i] "exclude"]} {
incr num_excluded
}
}
set items [$widgets($path_name,class_incl_lb) get 0 end]
if {$num_excluded == $num_perms_for_class} {
$widgets($path_name,class_incl_lb) itemconfigure \
$widget_vars($path_name,class_selected_idx) \
-foreground gray
set [$widgets($path_name,class_incl_lb) cget -listvar] \
[lreplace $items $widget_vars($path_name,class_selected_idx) \
$widget_vars($path_name,class_selected_idx) \
"$class_sel$Apol_Analysis_relabel::excluded_tag"]
} else {
$widgets($path_name,class_incl_lb) itemconfigure \
$widget_vars($path_name,class_selected_idx) \
-foreground $widget_vars($path_name,select_fg_orig)
set [$widgets($path_name,class_incl_lb) cget -listvar] \
[lreplace $items $widget_vars($path_name,class_selected_idx) \
$widget_vars($path_name,class_selected_idx) \
"$class_sel"]
}
$widget_vars($path_name,permissions_title_frame) configure \
-text "Permissions for [$widgets($path_name,class_incl_lb) get \
$widget_vars($path_name,class_selected_idx)]:"
}
}
return 0
}
proc Apol_Analysis_relabel::adv_options_embed_perm_buttons {list_b class perm path_name} {
variable widget_vars
set frame [frame $list_b.f:$class:$perm -bd 0 -bg white]
set lbl_frame [frame $frame.lbl_frame:$class:$perm -width 20 -bd 1 -bg white]
set cb_frame [frame $frame.cb_frame:$class:$perm -width 10 -bd 0 -bg white]
set lbl1 [label $lbl_frame.lbl1:$class:$perm -bg white -justify left -width 20 \
-anchor nw -text $perm]
set lbl2 [label $lbl_frame.lbl2:$class:$perm -bg white -justify left -width 5 -text "--->"]
set cb_include [radiobutton $cb_frame.cb_include:$class:$perm -bg white \
-value include -text "Include" \
-highlightthickness 0 \
-variable Apol_Analysis_relabel::widget_vars($path_name,perm_status_array,$class,$perm) \
-command "Apol_Analysis_relabel::adv_options_change_obj_state_on_perm_select \
$path_name"]
set cb_exclude [radiobutton $cb_frame.cb_exclude:$class:$perm -bg white \
-value exclude -text "Exclude" \
-highlightthickness 0 \
-variable Apol_Analysis_relabel::widget_vars($path_name,perm_status_array,$class,$perm) \
-command "Apol_Analysis_relabel::adv_options_change_obj_state_on_perm_select \
$path_name"]
pack $frame -side left -anchor nw -expand yes -pady 10
pack $lbl_frame $cb_frame -side left -anchor nw -expand yes
pack $lbl1 $lbl2 -side left -anchor nw
pack $cb_include $cb_exclude -side left -anchor nw
return $frame
}
proc Apol_Analysis_relabel::adv_options_clear_perms_text {path_name} {
variable widget_vars
$widget_vars($path_name,perms_box) configure -state normal
set names [$widget_vars($path_name,perms_box) window names]
foreach emb_win $names {
if { [winfo exists $emb_win] } {
set rt [catch {destroy $emb_win} err]
if {$rt != 0} {
tk_messageBox \
-icon error \
-type ok \
-title "Error" \
-message "$err"
return -1
}
}
}
$widget_vars($path_name,perms_box) delete 1.0 end
return 0
}
proc Apol_Analysis_relabel::render_permissions {path_name} {
variable widget_vars
variable widgets
set class_idx [$widgets($path_name,class_incl_lb) curselection]
if {$class_idx == ""} {
return 0
}
focus -force $widgets($path_name,class_incl_lb)
set class_name [$widgets($path_name,class_incl_lb) get $class_idx]
$widget_vars($path_name,permissions_title_frame) configure -text "Permissions for $class_name:"
Apol_Analysis_relabel::adv_options_clear_perms_text $path_name
update
set idx [string first $Apol_Analysis_relabel::excluded_tag $class_name]
if {$idx != -1} {
set class_name [string range $class_name 0 [expr $idx - 1]]
}
set rt [catch {set perms_list [apol_GetPermsByClass $class_name 1]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "$err"
return -1
}
set perms_list [lsort $perms_list]
foreach perm $perms_list {
if {[array names widget_vars "$path_name,perm_status_array,$class_name,$perm"] == ""} {
set widget_vars($path_name,perm_status_array,$class_name,$perm) include
}
$widget_vars($path_name,perms_box) window create end -window \
[Apol_Analysis_relabel::adv_options_embed_perm_buttons \
$widget_vars($path_name,perms_box) $class_name $perm $path_name]
$widget_vars($path_name,perms_box) insert end "\n"
}
$widget_vars($path_name,perms_box) configure -state disabled
}
proc Apol_Analysis_relabel::adv_options_display_permissions {path_name} {
variable widget_vars
variable widgets
if {[$widgets($path_name,class_incl_lb) get 0 end] == "" || \
[llength [$widgets($path_name,class_incl_lb) curselection]] > 1} {
return 0
}
bind $widgets($path_name,class_incl_lb) <<ListboxSelect>> ""
set widget_vars($path_name,class_selected_idx) [$widgets($path_name,class_incl_lb) curselection]]
Apol_Analysis_relabel::render_permissions $path_name
update idletasks
bind $widgets($path_name,class_incl_lb) <<ListboxSelect>> "Apol_Analysis_dta::forward_options_display_permissions $path_name"
}
proc Apol_Analysis_relabel::adv_options_set_widgets_to_default_state {path_name} {
variable widget_vars
variable widgets
$widgets($path_name,incl_cmb) configure -values $Apol_Types::attriblist
$widgets($path_name,excl_cmb) configure -values $Apol_Types::attriblist
$widgets($path_name,incl_cmb) configure -text $Apol_Analysis_relabel::widget_vars($path_name,incl_attrib)
$widgets($path_name,excl_cmb) configure -text $Apol_Analysis_relabel::widget_vars($path_name,excl_attrib)
set widget_vars($path_name,select_fg_orig) [$widgets($path_name,class_incl_lb) cget -foreground]
set class_lbox_idx 0
}
proc Apol_Analysis_relabel::adv_options_initialize_objs_and_perm_filters {path_name} {
variable widget_vars
set Apol_Analysis_relabel::widget_vars($path_name,excl_class_list) ""
set tmp_list ""
foreach class $Apol_Class_Perms::class_list {
set rt [catch {set perms_list [apol_GetPermsByClass $class 1]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
set idx1 [lsearch -exact $perms_list $Apol_Analysis_relabel::relabelto_perm]
set idx2 [lsearch -exact $perms_list $Apol_Analysis_relabel::relabelfrom_perm]
if {$idx1 == -1 && $idx2 == -1} {
continue
}
set tmp_list [lappend tmp_list $class]
}
set Apol_Analysis_relabel::widget_vars($path_name,filter_incl_subj) 0
set Apol_Analysis_relabel::widget_vars($path_name,filter_excl_subj) 0
set Apol_Analysis_relabel::widget_vars($path_name,incl_class_list) $tmp_list
set Apol_Analysis_relabel::widget_vars($path_name,excl_subj_list) ""
set Apol_Analysis_relabel::widget_vars($path_name,master_excl_subj_list) ""
set Apol_Analysis_relabel::widget_vars($path_name,incl_subj_list) ""
set Apol_Analysis_relabel::widget_vars($path_name,master_incl_subj_list) ""
foreach type_id $Apol_Types::typelist {
if {$type_id != "self"} {
lappend Apol_Analysis_relabel::widget_vars($path_name,incl_subj_list) $type_id
lappend Apol_Analysis_relabel::widget_vars($path_name,master_incl_subj_list) $type_id
}
}
set Apol_Analysis_relabel::widget_vars($path_name,incl_attrib) ""
set Apol_Analysis_relabel::widget_vars($path_name,excl_attrib) ""
return 0
}
proc Apol_Analysis_relabel::adv_options_create_object {path_name} {
variable widget_vars
variable widgets
set widget_vars($path_name,name) $path_name
set widget_vars($path_name,class_selected_idx) -1
set widget_vars($path_name,filter_vars_init) 1
Apol_Analysis_relabel::adv_options_initialize_objs_and_perm_filters $path_name
}
proc Apol_Analysis_relabel::adv_options_copy_object {path_name new_object} { set rt [catch {set attrib_types [apol_GetAttribTypesList $attribute]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
variable widget_vars
upvar 1 $new_object object
if {![array exists widget_vars] || [array names widget_vars "$path_name,name"] == ""} {
Apol_Analysis_relabel::adv_options_create_object $path_name
}
array set object [array get widget_vars "$path_name,*"]
return 0
}
proc Apol_Analysis_relabel::adv_options_destroy_object {path_name} {
variable widget_vars
if {[array exists widget_vars] && [array names widget_vars "$path_name,name"] != ""} {
array unset widget_vars "$path_name,*"
}
return 0
}
proc Apol_Analysis_relabel::adv_options_incl_excl_classes {path_name remove_list_1 \
add_list_1 \
remove_lbox \
add_lbox } {
upvar #0 $remove_list_1 remove_list
upvar #0 $add_list_1 add_list
set obj_indices [$remove_lbox curselection]
if {$obj_indices != ""} {
set tmp_list ""
foreach idx $obj_indices {
set tmp_list [lappend tmp_list [$remove_lbox get $idx]]
}
foreach class $tmp_list {
set idx [lsearch -exact $remove_list $class]
if {$idx != -1} {
set remove_list [lreplace $remove_list $idx $idx]
set add_list [lappend add_list $class]
set add_list [lsort $add_list]
}
}
$remove_lbox selection clear 0 end
}
return 0
}
proc Apol_Analysis_relabel::adv_options_incl_excl_types {path_name remove_list_1 \
add_list_1 \
remove_lbox \
add_lbox \
master_remove_list_1\
master_add_list_1} {
upvar #0 $remove_list_1 remove_list
upvar #0 $add_list_1 add_list
upvar #0 $master_remove_list_1 master_remove_list
upvar #0 $master_add_list_1 master_add_list
set subj_indices [$remove_lbox curselection]
if {$subj_indices != ""} {
set tmp_list ""
foreach idx $subj_indices {
set tmp_list [lappend tmp_list [$remove_lbox get $idx]]
}
foreach type $tmp_list {
set idx [lsearch -exact $remove_list $type]
if {$idx != -1} {
set remove_list [lreplace $remove_list $idx $idx]
set add_list [lappend add_list $type]
set add_list [lsort $add_list]
}
set idx [lsearch -exact $master_remove_list $type]
if {$idx != -1} {
set master_remove_list [lreplace $master_remove_list $idx $idx]
set master_add_list [lappend master_add_list $type]
set master_add_list [lsort $master_add_list]
}
}
$remove_lbox selection clear 0 end
}
return 0
}
proc Apol_Analysis_relabel::select_all_lbox_items {lbox} {
$lbox selection set 0 end
return 0
}
proc Apol_Analysis_relabel::clear_all_lbox_items {lbox} {
$lbox selection clear 0 end
return 0
}
proc Apol_Analysis_relabel::adv_options_filter_list_by_attrib {filter_list_1 master_list_1 attrib_1 lbox} {
upvar #0 $filter_list_1 filter_list
if {$master_list_1 != ""} {
upvar #0 $master_list_1 master_list
} else {
set master_list ""
}
if {$attrib_1 != ""} {
upvar $attrib_1 attrib
} else {
set attrib ""
}
if {$attrib != ""} {
set rt [catch {set attrib_types [apol_GetAttribTypesList $attrib]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -1
}
if {$master_list != ""} {
$lbox delete 0 end
foreach subj $master_list {
set idx [lsearch -exact $attrib_types $subj]
if {$idx != -1} {
$lbox insert end $subj
}
}
}
} else {
if {$master_list != ""} {
$lbox delete 0 end
foreach subj $master_list {
$lbox insert end $subj
}
}
}
}
proc Apol_Analysis_relabel::adv_objtions_config_combo {combo_box checkboxval which_list path_name} {
upvar #0 $checkboxval checkbox_val
set empty_attrib ""
if {$checkbox_val} {
$combo_box configure -state normal -entrybg white
if {$which_list == "incl"} {
Apol_Analysis_relabel::adv_options_filter_list_by_attrib \
Apol_Analysis_relabel::widget_vars($path_name,incl_subj_list) \
Apol_Analysis_relabel::widget_vars($path_name,master_incl_subj_list) \
Apol_Analysis_relabel::widget_vars($path_name,incl_attrib) \
$Apol_Analysis_relabel::widgets($path_name,subj_incl_lb)
} else {
Apol_Analysis_relabel::adv_options_filter_list_by_attrib \
Apol_Analysis_relabel::widget_vars($path_name,excl_subj_list) \
Apol_Analysis_relabel::widget_vars($path_name,master_excl_subj_list) \
Apol_Analysis_relabel::widget_vars($path_name,excl_attrib) \
$Apol_Analysis_relabel::widgets($path_name,subj_excl_lb)
}
} else {
$combo_box configure -state disabled -entrybg $ApolTop::default_bg_color
if {$which_list == "incl"} {
if {$Apol_Analysis_relabel::widget_vars($path_name,master_incl_subj_list) != ""} {
$Apol_Analysis_relabel::widgets($path_name,subj_incl_lb) delete 0 end
foreach subj \
$Apol_Analysis_relabel::widget_vars($path_name,master_incl_subj_list) {
$Apol_Analysis_relabel::widgets($path_name,subj_incl_lb) \
insert end $subj
}
}
} else {
if {$Apol_Analysis_relabel::widget_vars($path_name,master_excl_subj_list) != ""} {
$Apol_Analysis_relabel::widgets($path_name,subj_excl_lb) delete 0 end
foreach subj \
$Apol_Analysis_relabel::widget_vars($path_name,master_excl_subj_list) {
$Apol_Analysis_relabel::widgets($path_name,subj_excl_lb) \
insert end $subj
}
}
}
}
}
proc Apol_Analysis_relabel::adv_options_create_dialog {path_name title_txt} {
variable widget_vars
variable widgets
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened!"
return -1
}
if {[array exists widget_vars] && \
[array names widget_vars "$path_name,name"] != ""} {
if {[winfo exists $widget_vars($path_name,name)]} {
raise $widget_vars($path_name,name)
focus $widget_vars($path_name,name)
return 0
}
} else {
Apol_Analysis_relabel::adv_options_create_object $path_name
}
toplevel $widget_vars($path_name,name)
wm withdraw $widget_vars($path_name,name)
wm title $widget_vars($path_name,name) $title_txt
wm protocol $widget_vars($path_name,name) WM_DELETE_WINDOW " "
set close_frame [frame $widget_vars($path_name,name).close_frame -relief sunken -bd 1]
set topf [frame $widget_vars($path_name,name).topf]
pack $close_frame -side bottom -anchor center -pady 2
pack $topf -fill both -expand yes -padx 10 -pady 10
set label_frame [frame $topf.label_frame]
set objs_frame [TitleFrame $topf.objs_frame -text "Filter by object classes:"]
set subj_frame [TitleFrame $topf.subj_frame -text "Filter by subject type:"]
set top_lbl [Label $label_frame.top_lbl -justify left -font $ApolTop::dialog_font \
-text "NOTE: The following list of object classes has been filtered to include \
only object classes which have both 'relabelto' and 'relabelfrom' permission."]
set search_pane [frame [$objs_frame getframe].search_pane]
set button_f [frame [$objs_frame getframe].button_f]
set class_pane [frame [$objs_frame getframe].class_pane]
set subj_pane [frame [$subj_frame getframe].subj_pane]
set search_pane2 [frame [$subj_frame getframe].search_pane2]
set button_f2 [frame [$subj_frame getframe].button_f2]
set obj_incl_butn_f [frame [$objs_frame getframe].obj_incl_butn_f]
set obj_excl_butn_f [frame [$objs_frame getframe].obj_excl_butn_f]
set subj_incl_butn_f [frame [$subj_frame getframe].subj_incl_butn_f]
set subj_excl_butn_f [frame [$subj_frame getframe].subj_excl_butn_f]
set attrib_incl_f [frame [$subj_frame getframe].attrib_incl_f]
set attrib_excl_f [frame [$subj_frame getframe].attrib_excl_f]
set incl_classes_box [TitleFrame $class_pane.tbox \
-text "Included Object Classes:" -bd 0]
set excl_classes_box [TitleFrame $search_pane.rbox \
-text "Excluded Object Classes:" -bd 0]
set incl_subj_box [TitleFrame $subj_pane.tbox2 \
-text "Included Subject Types:" -bd 0]
set excl_subj_box [TitleFrame $search_pane2.rbox2 \
-text "Excluded Subject Types:" -bd 0]
set sw_incl_class [ScrolledWindow [$incl_classes_box getframe].sw_incl_class -auto none]
set widgets($path_name,class_incl_lb) [listbox [$sw_incl_class getframe].lb1 \
-height 10 -highlightthickness 0 \
-bg white -selectmode extended \
-listvar Apol_Analysis_relabel::widget_vars($path_name,incl_class_list) \
-exportselection 0]
$sw_incl_class setwidget $widgets($path_name,class_incl_lb)
set sw_excl_class [ScrolledWindow [$excl_classes_box getframe].sw_excl_class -auto none]
set widgets($path_name,class_excl_lb) [listbox [$sw_excl_class getframe].lb2 \
-height 10 -highlightthickness 0 \
-bg white -selectmode extended \
-listvar Apol_Analysis_relabel::widget_vars($path_name,excl_class_list) \
-exportselection 0]
$sw_excl_class setwidget $widgets($path_name,class_excl_lb)
set sw_incl_subj [ScrolledWindow [$incl_subj_box getframe].sw_incl_subj -auto none]
set widgets($path_name,subj_incl_lb) [listbox [$sw_incl_subj getframe].lb3 \
-height 10 -highlightthickness 0 \
-bg white -selectmode extended \
-listvar Apol_Analysis_relabel::widget_vars($path_name,incl_subj_list) \
-exportselection 0]
if {$widget_vars(mode) == "subject"} {
$widgets($path_name,subj_incl_lb) configure -state disabled
}
$sw_incl_subj setwidget $widgets($path_name,subj_incl_lb)
set sw_excl_subj [ScrolledWindow [$excl_subj_box getframe].sw_excl_subj -auto none]
set widgets($path_name,subj_excl_lb) [listbox [$sw_excl_subj getframe].lb4 \
-height 10 -highlightthickness 0 \
-bg white -selectmode extended \
-listvar Apol_Analysis_relabel::widget_vars($path_name,excl_subj_list) \
-exportselection 0]
if {$widget_vars(mode) == "subject"} {
$widgets($path_name,subj_excl_lb) configure -state disabled
}
$sw_excl_subj setwidget $widgets($path_name,subj_excl_lb)
set attrib_incl_cbox [ComboBox $attrib_incl_f.attrib_incl_cbox -editable 1 \
-entrybg white -width 16 -state disabled \
-textvariable Apol_Analysis_relabel::widget_vars($path_name,incl_attrib) \
-modifycmd "Apol_Analysis_relabel::adv_options_filter_list_by_attrib \
Apol_Analysis_relabel::widget_vars($path_name,incl_subj_list) \
Apol_Analysis_relabel::widget_vars($path_name,master_incl_subj_list) \
Apol_Analysis_relabel::widget_vars($path_name,incl_attrib) \
$widgets($path_name,subj_incl_lb)"]
bindtags $attrib_incl_cbox.e [linsert [bindtags $attrib_incl_cbox.e] 3 incl_attrib_cb_tag]
bind incl_attrib_cb_tag <KeyPress> [list ApolTop::_create_popup $attrib_incl_cbox %W %K]
if {$Apol_Analysis_relabel::widget_vars($path_name,filter_incl_subj)} {
$attrib_incl_cbox configure -state normal
}
set attrib_excl_cbox [ComboBox $attrib_excl_f.attrib_excl_cbox -editable 1 \
-entrybg white -width 16 -state disabled \
-textvariable Apol_Analysis_relabel::widget_vars($path_name,excl_attrib) \
-modifycmd "Apol_Analysis_relabel::adv_options_filter_list_by_attrib \
Apol_Analysis_relabel::widget_vars($path_name,excl_subj_list) \
Apol_Analysis_relabel::widget_vars($path_name,master_excl_subj_list) \
Apol_Analysis_relabel::widget_vars($path_name,excl_attrib) \
$widgets($path_name,subj_excl_lb)"]
bindtags $attrib_excl_cbox.e [linsert [bindtags $attrib_excl_cbox.e] 3 excl_attrib_cb_tag]
bind excl_attrib_cb_tag <KeyPress> [list ApolTop::_create_popup $attrib_excl_cbox %W %K]
if {$Apol_Analysis_relabel::widget_vars($path_name,filter_excl_subj)} {
$attrib_excl_cbox configure -state normal
}
set cb_incl_attrib_filter [checkbutton $attrib_incl_f.cb_incl_attrib_filter \
-text "Filter included subject types by attribute" -offvalue 0 -onvalue 1 \
-variable Apol_Analysis_relabel::widget_vars($path_name,filter_incl_subj) \
-command "Apol_Analysis_relabel::adv_objtions_config_combo \
$attrib_incl_cbox \
Apol_Analysis_relabel::widget_vars($path_name,filter_incl_subj) \
incl $path_name"]
set cb_excl_attrib_filter [checkbutton $attrib_excl_f.cb_excl_attrib_filter \
-text "Filter excluded subject types by attribute" -offvalue 0 -onvalue 1 \
-variable Apol_Analysis_relabel::widget_vars($path_name,filter_excl_subj) \
-command "Apol_Analysis_relabel::adv_objtions_config_combo \
$attrib_excl_cbox \
Apol_Analysis_relabel::widget_vars($path_name,filter_excl_subj) \
excl $path_name"]
set widgets($path_name,incl_cmb) $attrib_incl_cbox
set widgets($path_name,excl_cmb) $attrib_excl_cbox
set b_incl_classes [Button $button_f.b_incl_classes -text "<--" \
-helptext "Include the selected object classes in the results." \
-command "Apol_Analysis_relabel::adv_options_incl_excl_classes \
$path_name \
Apol_Analysis_relabel::widget_vars($path_name,excl_class_list) \
Apol_Analysis_relabel::widget_vars($path_name,incl_class_list) \
$Apol_Analysis_relabel::widgets($path_name,class_excl_lb) \
$Apol_Analysis_relabel::widgets($path_name,class_incl_lb)"]
set b_excl_classes [Button $button_f.b_excl_classes -text "-->" \
-helptext "Exclude the selected object classes from the results." \
-command "Apol_Analysis_relabel::adv_options_incl_excl_classes \
$path_name \
Apol_Analysis_relabel::widget_vars($path_name,incl_class_list) \
Apol_Analysis_relabel::widget_vars($path_name,excl_class_list) \
$Apol_Analysis_relabel::widgets($path_name,class_incl_lb) \
$Apol_Analysis_relabel::widgets($path_name,class_excl_lb)"]
set b_incl_subj [Button $button_f2.b_incl_subj -text "<--" \
-helptext "Include the selected subject types in the results." \
-command "Apol_Analysis_relabel::adv_options_incl_excl_types \
$path_name \
Apol_Analysis_relabel::widget_vars($path_name,excl_subj_list) \
Apol_Analysis_relabel::widget_vars($path_name,incl_subj_list) \
$Apol_Analysis_relabel::widgets($path_name,subj_excl_lb) \
$Apol_Analysis_relabel::widgets($path_name,subj_incl_lb) \
Apol_Analysis_relabel::widget_vars($path_name,master_excl_subj_list) \
Apol_Analysis_relabel::widget_vars($path_name,master_incl_subj_list)"]
set b_excl_subj [Button $button_f2.b_excl_subj -text "-->" \
-helptext "Exclude the selected subject types from the results." \
-command "Apol_Analysis_relabel::adv_options_incl_excl_types \
$path_name \
Apol_Analysis_relabel::widget_vars($path_name,incl_subj_list) \
Apol_Analysis_relabel::widget_vars($path_name,excl_subj_list) \
$Apol_Analysis_relabel::widgets($path_name,subj_incl_lb) \
$Apol_Analysis_relabel::widgets($path_name,subj_excl_lb) \
Apol_Analysis_relabel::widget_vars($path_name,master_incl_subj_list) \
Apol_Analysis_relabel::widget_vars($path_name,master_excl_subj_list)"]
set b_incl_subj_sel_all [Button $subj_incl_butn_f.b_incl_subj_sel_all \
-text "Select All" \
-command "Apol_Analysis_relabel::select_all_lbox_items \
$Apol_Analysis_relabel::widgets($path_name,subj_incl_lb)"]
set b_excl_subj_sel_all [Button $subj_excl_butn_f.b_excl_subj_sel_all \
-text "Select All" \
-command "Apol_Analysis_relabel::select_all_lbox_items \
$Apol_Analysis_relabel::widgets($path_name,subj_excl_lb)"]
set b_incl_obj_sel_all [Button $obj_incl_butn_f.b_incl_obj_sel_all \
-text "Select All" \
-command "Apol_Analysis_relabel::select_all_lbox_items \
$Apol_Analysis_relabel::widgets($path_name,class_incl_lb)"]
set b_excl_obj_sel_all [Button $obj_excl_butn_f.b_excl_obj_sel_all \
-text "Select All" \
-command "Apol_Analysis_relabel::select_all_lbox_items \
$Apol_Analysis_relabel::widgets($path_name,class_excl_lb)"]
set b_incl_subj_clear_all [Button $subj_incl_butn_f.b_incl_subj_clear_all \
-text "Unselect" \
-command "Apol_Analysis_relabel::clear_all_lbox_items \
$Apol_Analysis_relabel::widgets($path_name,subj_incl_lb)"]
set b_excl_subj_clear_all [Button $subj_excl_butn_f.b_excl_subj_clear_all \
-text "Unselect" \
-command "Apol_Analysis_relabel::clear_all_lbox_items \
$Apol_Analysis_relabel::widgets($path_name,subj_excl_lb)"]
set b_incl_obj_clear_all [Button $obj_incl_butn_f.b_incl_obj_clear_all \
-text "Unselect" \
-command "Apol_Analysis_relabel::clear_all_lbox_items \
$Apol_Analysis_relabel::widgets($path_name,class_incl_lb)"]
set b_excl_obj_clear_all [Button $obj_excl_butn_f.b_excl_obj_clear_all \
-text "Unselect" \
-command "Apol_Analysis_relabel::clear_all_lbox_items \
$Apol_Analysis_relabel::widgets($path_name,class_excl_lb)"]
if {$widget_vars(mode) == "subject"} {
$subj_frame configure -state disabled
$b_incl_subj_clear_all configure -state disabled
$b_excl_subj_clear_all configure -state disabled
$b_incl_subj_sel_all configure -state disabled
$b_excl_subj_sel_all configure -state disabled
$cb_incl_attrib_filter configure -state disabled
$cb_excl_attrib_filter configure -state disabled
$attrib_incl_cbox configure -state disabled
$attrib_excl_cbox configure -state disabled
$b_incl_subj configure -state disabled
$b_excl_subj configure -state disabled
$incl_subj_box configure -state disabled
$excl_subj_box configure -state disabled
}
pack $b_excl_classes $b_incl_classes -side top -anchor nw -pady 2 -fill x
pack $b_excl_subj $b_incl_subj -side top -anchor nw -pady 2 -fill x
pack $b_incl_subj_sel_all $b_incl_subj_clear_all -side left -anchor nw -padx 4 -fill x
pack $b_excl_subj_sel_all $b_excl_subj_clear_all -side left -anchor nw -pady 2 -fill x
pack $b_incl_obj_sel_all $b_incl_obj_clear_all -side left -anchor nw -pady 2 -fill x
pack $b_excl_obj_sel_all $b_excl_obj_clear_all -side left -anchor nw -pady 2 -fill x
pack $cb_incl_attrib_filter $attrib_incl_cbox -side top -padx 2 -pady 2 -anchor nw -fill x
pack $cb_excl_attrib_filter $attrib_excl_cbox -side top -padx 2 -pady 2 -anchor nw -fill x
pack $obj_incl_butn_f -in $class_pane -side bottom -padx 5 -pady 2 -expand 0
pack $obj_excl_butn_f -in $search_pane -side bottom -padx 5 -pady 2 -expand 0
pack $subj_incl_butn_f -in $subj_pane -side bottom -padx 5 -pady 2 -expand 0
pack $subj_excl_butn_f -in $search_pane2 -side bottom -padx 5 -pady 2 -expand 0
pack $attrib_incl_f -in $subj_pane -side bottom -padx 5 -pady 2 -expand 0
pack $attrib_excl_f -in $search_pane2 -side bottom -padx 5 -pady 2 -expand 0
pack $class_pane -fill both -expand yes -side left -anchor nw
pack $subj_pane -fill both -expand yes -side left -anchor nw
pack $button_f -anchor center -fill x -expand yes -side left -pady 20
pack $button_f2 -anchor center -fill x -expand yes -side left -pady 20
pack $sw_incl_class $sw_excl_class -fill both -expand yes -side left -anchor nw
pack $sw_incl_subj $sw_excl_subj -fill both -expand yes -side left -anchor nw
pack $search_pane -fill both -expand yes -side left -anchor nw
pack $search_pane2 -fill both -expand yes -side left -anchor nw
pack $incl_classes_box $excl_classes_box -side left -pady 2 -padx 2 -fill both -expand yes
pack $incl_subj_box $excl_subj_box -side left -pady 2 -padx 2 -fill both -expand yes
pack $subj_frame -side bottom -anchor nw -padx 5 -pady 2 -expand yes -fill both
pack $objs_frame -side bottom -anchor nw -padx 5 -pady 2 -expand yes -fill both
pack $label_frame -side top -anchor center
pack $top_lbl -side left -anchor nw -fill x -pady 2 -padx 2
set close_bttn [Button $close_frame.close_bttn -text "Close" -width 8 \
-command "Apol_Analysis_relabel::adv_options_destroy_dialog $path_name"]
pack $close_bttn -side left -anchor center
set width 780
set height 750
wm geom $widget_vars($path_name,name) ${width}x${height}
wm deiconify $widget_vars($path_name,name)
focus $widget_vars($path_name,name)
Apol_Analysis_relabel::adv_options_set_widgets_to_default_state $path_name
wm protocol $widget_vars($path_name,name) WM_DELETE_WINDOW \
"Apol_Analysis_relabel::adv_options_destroy_dialog $path_name"
}
proc Apol_Analysis_relabel::change_types_list {type_cmbox attrib_cmbox clear_type} {
upvar #0 [$attrib_cmbox cget -textvariable] attrib
if {$attrib != ""} {
if {$clear_type} {
$type_cmbox configure -text ""
}
set rt [catch {set attrib_typesList [apol_GetAttribTypesList $attrib]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
}
set attrib_typesList [lsort $attrib_typesList]
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$type_cmbox configure -values $attrib_typesList
} else {
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$type_cmbox configure -values $attrib_typesList
}
return 0
}
proc Apol_Analysis_relabel::config_attrib_comboBox_state {checkbttn attrib_cbox type_cbox change_list} {
upvar #0 [$checkbttn cget -variable] cb_val
upvar #0 [$attrib_cbox cget -textvariable] attrib_val
upvar #0 [$type_cbox cget -textvariable] type_val
if {$cb_val} {
$attrib_cbox configure -state normal -entrybg white
if {$change_list} {
Apol_Analysis_tra::change_types_list $type_cbox $attrib_cbox 1
}
} else {
$attrib_cbox configure -state disabled -entrybg $ApolTop::default_bg_color
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$type_cbox configure -values $attrib_typesList
}
return 0
}
proc Apol_Analysis_relabel::config_endtype_state {} {
variable widgets
variable widget_vars
if {$widget_vars(endtype_sel)} {
$widgets(entry_end) configure -state normal -background white
} else {
$widgets(entry_end) configure -state disabled -background $ApolTop::default_bg_color
}
return 0
}
proc Apol_Analysis_relabel::init_widget_state { } {
variable widgets
variable widget_vars
populate_lists
toggle_attributes
Apol_Analysis_relabel::config_endtype_state
if {$widget_vars(mode) == "object"} {
set_mode_object
} else {
set_mode_subject
}
}
proc Apol_Analysis_relabel::init_widget_vars { } {
variable widget_vars
array unset widget_vars
set widget_vars(mode) "object"
set widget_vars(to_mode) 1
set widget_vars(from_mode) 1
set widget_vars(endtype_sel) 0
set widget_vars(end_type) ""
set widget_vars(start_attrib_ch) 0
set widget_vars(start_attrib) ""
set widget_vars(start_type) ""
}
proc Apol_Analysis_relabel::display_mod_options { opts_frame } {
variable widgets
array unset widgets
Apol_Analysis_relabel::init_widget_vars
set option_f [frame $opts_frame.option_f]
set mode_tf [TitleFrame $option_f.mode_tf -text "Mode"]
set mode_obj_f [frame [$mode_tf getframe].mode_obj_f]
set mode_subj_f [frame [$mode_tf getframe].mode_subj_f]
set widgets(objectMode_cb) [radiobutton $mode_obj_f.objectMode_cb \
-text "Object Mode" -value "object" \
-variable Apol_Analysis_relabel::widget_vars(mode) \
-command [namespace code set_mode_object]]
set widgets(subjectMode_cb) [radiobutton $mode_subj_f.subjectMode_cb \
-text "Subject Mode" -value "subject" \
-variable Apol_Analysis_relabel::widget_vars(mode) \
-command [namespace code set_mode_subject]]
set widgets(relabelto_rb) [checkbutton $mode_obj_f.relabelto_rb \
-text "To" \
-variable Apol_Analysis_relabel::widget_vars(to_mode) \
-command [namespace code set_mode_relabelto]]
set widgets(relabelfrom_rb) [checkbutton $mode_obj_f.relabelfrom_rb \
-text "From" \
-variable Apol_Analysis_relabel::widget_vars(from_mode)\
-command [namespace code set_mode_relabelfrom]]
set req_tf [TitleFrame $option_f.req_tf -text "Required parameters"]
set start_f [frame [$req_tf getframe].start_f]
set attrib_f [frame [$req_tf getframe].attrib_frame]
set widgets(start_l) [label $start_f.start_l -anchor w]
set widgets(start_cb) [ComboBox $start_f.start_cb -editable 1 \
-entrybg white -width 16 \
-textvariable Apol_Analysis_relabel::widget_vars(start_type)]
bindtags $widgets(start_cb).e [linsert [bindtags $widgets(start_cb).e] 3 start_cb_tag]
bind start_cb_tag <KeyPress> [list ApolTop::_create_popup $widgets(start_cb) %W %K]
set widgets(start_attrib_cb) [ComboBox $attrib_f.start_attrib_cb \
-editable 1 -entrybg white -width 16 -state disabled \
-vcmd [namespace code [list set_types_list %P]] -validate key \
-textvariable Apol_Analysis_relabel::widget_vars(start_attrib)]
$widgets(start_attrib_cb) configure -modifycmd {Apol_Analysis_tra::change_types_list \
$Apol_Analysis_relabel::widgets(start_cb) $Apol_Analysis_relabel::widgets(start_attrib_cb) 1}
set widgets(start_attrib_ch) \
[checkbutton $attrib_f.start_attrib_ch -anchor w -width 36 \
-variable Apol_Analysis_relabel::widget_vars(start_attrib_ch)]
$widgets(start_attrib_ch) configure \
-command "Apol_Analysis_relabel::config_attrib_comboBox_state \
$widgets(start_attrib_ch) $widgets(start_attrib_cb) $widgets(start_cb) 1"
bindtags $widgets(start_attrib_cb).e [linsert [bindtags $widgets(start_attrib_cb).e] 3 start_attrib_cb_tag]
bind start_attrib_cb_tag <KeyPress> [list ApolTop::_create_popup $widgets(start_attrib_cb) %W %K]
set filter_f [TitleFrame $option_f.filter_f -text "Optional result filters:"]
set endtype_frame [frame [$filter_f getframe].endtype_frame]
set adv_frame [frame [$filter_f getframe].adv_frame]
set widgets(entry_end) [Entry $endtype_frame.entry_end \
-helptext "You may enter a regular expression" \
-editable 1 -state disabled \
-textvariable Apol_Analysis_relabel::widget_vars(end_type)]
set widgets(cb_endtype) [checkbutton $endtype_frame.cb_endtype \
-text "Filter end types using regular expression:" \
-variable Apol_Analysis_relabel::widget_vars(endtype_sel) \
-command {Apol_Analysis_relabel::config_endtype_state}]
set widgets(b_adv_options) [button $adv_frame.b_adv_options -text "Advanced Filters" \
-command {Apol_Analysis_relabel::adv_options_create_dialog \
$Apol_Analysis_relabel::advanced_filter_Dlg \
"Direct Relabel Advanced Filters"}]
pack $widgets(objectMode_cb) -anchor w -side top
pack $widgets(relabelto_rb) $widgets(relabelfrom_rb) -side top -padx 10 -pady 3 -anchor nw
pack $widgets(subjectMode_cb) -anchor w -side top
pack $widgets(start_l) $widgets(start_cb) -side top -expand 0 -fill x
pack $widgets(start_attrib_ch) -expand 0 -fill x
pack $widgets(start_attrib_cb) -padx 15 -expand 0 -fill x
pack $widgets(cb_endtype) -side top -anchor nw
pack $widgets(entry_end) -anchor nw -fill x -expand yes
pack $widgets(b_adv_options) -anchor nw
pack $start_f -expand 0 -fill x
pack $attrib_f -pady 20 -expand 0 -fill x
pack $option_f -fill both -anchor nw -side left -padx 5 -expand 1
pack $mode_tf $req_tf $filter_f -side left -anchor nw -padx 5 -expand 1 -fill both
pack $mode_obj_f $mode_subj_f -side top -anchor nw -fill both
pack $endtype_frame $adv_frame -side top -anchor nw -fill both -pady 4
Apol_Analysis_relabel::init_widget_state
}
proc Apol_Analysis_relabel::set_mode_relabelto {} {
variable widgets
variable widget_vars
if {!$widget_vars(to_mode) && !$widget_vars(from_mode)} {
set widget_vars(to_mode) 1
return
}
if {$widget_vars(to_mode) && $widget_vars(from_mode)} {
Apol_Analysis_relabel::set_mode_relabelboth
} elseif {$widget_vars(to_mode)} {
$widgets(start_l) configure -text "Starting type:"
$widgets(start_attrib_ch) configure -text "Filter starting types to select using attribute:"
} else {
Apol_Analysis_relabel::set_mode_relabelfrom
}
}
proc Apol_Analysis_relabel::set_mode_relabelfrom {} {
variable widgets
variable widget_vars
if {!$widget_vars(to_mode) && !$widget_vars(from_mode)} {
set widget_vars(from_mode) 1
return
}
if {$widget_vars(to_mode) && $widget_vars(from_mode)} {
Apol_Analysis_relabel::set_mode_relabelboth
} elseif {$widget_vars(from_mode)} {
$widgets(start_l) configure -text "Ending type:"
$widgets(start_attrib_ch) configure -text "Filter ending types to select using attribute:"
} else {
Apol_Analysis_relabel::set_mode_relabelto
}
}
proc Apol_Analysis_relabel::set_mode_relabelboth {} {
variable widgets
$widgets(start_l) configure -text "Starting/ending type:"
$widgets(start_attrib_ch) configure -text "Filter starting/ending types to select using attribute:"
}
proc Apol_Analysis_relabel::set_mode_subject {} {
variable widgets
$widgets(start_l) configure -text "Subject:"
$widgets(start_attrib_ch) configure -text "Filter subjects to select using attribute:"
$widgets(relabelto_rb) configure -state disabled
$widgets(relabelfrom_rb) configure -state disabled
}
proc Apol_Analysis_relabel::set_mode_object {} {
variable widgets
variable widget_vars
$widgets(relabelto_rb) configure -state normal
$widgets(relabelfrom_rb) configure -state normal
if {$widget_vars(to_mode) && $widget_vars(from_mode)} {
Apol_Analysis_relabel::set_mode_relabelboth
} elseif {$widget_vars(to_mode) && !$widget_vars(from_mode)} {
Apol_Analysis_relabel::set_mode_relabelto
} else {
Apol_Analysis_relabel::set_mode_relabelfrom
}
}
proc Apol_Analysis_relabel::toggle_attributes {} {
variable widgets
variable widget_vars
if $widget_vars(start_attrib_ch) {
$widgets(start_attrib_cb) configure -state normal -entrybg white
} else {
$widgets(start_attrib_cb) configure -state disabled -entrybg $ApolTop::default_bg_color
$widgets(start_cb) configure -values $Apol_Types::typelist
}
}
proc Apol_Analysis_relabel::set_types_list {start_attrib} {
variable widgets
variable widget_vars
if {$start_attrib == ""} {
set start_attrib $widget_vars(start_attrib)
}
if [catch {apol_GetAttribTypesList $start_attrib} types_list] {
set types_list ""
}
if {[lsearch $types_list $widget_vars(start_type)] == -1} {
set widget_vars(start_type) {}
}
return 1
}
proc Apol_Analysis_relabel::populate_lists {} {
variable widgets
variable widget_vars
$widgets(start_cb) configure -values $Apol_Types::typelist
$widgets(start_attrib_cb) configure -values $Apol_Types::attriblist
if {[lsearch -exact $Apol_Types::typelist $widget_vars(start_type)] == -1} {
set widget_vars(start_type) {}
}
if {[lsearch -exact $Apol_Types::attriblist $widget_vars(start_attrib)] == -1} {
set widget_vars(start_attrib) {}
}
}
proc Apol_Analysis_relabel::formatInfoText { tb } {
$tb tag configure $Apol_Analysis_relabel::title_tag -font {Helvetica 14 bold}
$tb tag configure $Apol_Analysis_relabel::title_type_tag -foreground blue -font {Helvetica 14 bold}
$tb tag configure $Apol_Analysis_relabel::subtitle_tag -font {Helvetica 11 bold}
$tb tag configure $Apol_Analysis_relabel::type_tag -foreground blue -font {Helvetica 12 bold}
}
proc Apol_Analysis_relabel::tree_select {widget node} {
variable widget_vars
if {$node == ""} {
return
}
set data [$widget itemcget $node -data]
$widget_vars(current_rtext) configure -state normal
$widget_vars(current_rtext) delete 1.0 end
set title_tags ""
set subtitle_type_tags ""
set title_type_tags ""
set policy_tags_list ""
set type_tags ""
set line ""
set start_index 0
if {$node == $Apol_Analysis_relabel::top_node} {
$widget_vars(current_rtext) configure -wrap word
set start_index [string length $line]
append line "Direct Relabel Analysis: "
if {$widget_vars(mode) == "object"} {
if {$widget_vars(to_mode) && $widget_vars(from_mode)} {
append line "Starting/Ending Type: "
} elseif {$widget_vars(to_mode) && !$widget_vars(from_mode)} {
append line "Starting Type: "
} elseif {!$widget_vars(to_mode) && $widget_vars(from_mode)} {
append line "Ending Type: "
} else {
puts "Direction must be to, from, or both for object mode."
return
}
} else {
append line "Subject: "
}
set end_index [string length $line]
lappend title_tags $start_index $end_index
set start_index [string length $line]
append line "$widget_vars(start_type)"
set end_index [string length $line]
lappend title_type_tags $start_index $end_index
append line "\n\n"
set start_index [string length $line]
append line "$widget_vars(start_type) "
set end_index [string length $line]
lappend type_tags $start_index $end_index
if {$widget_vars(mode) == "object"} {
append line "can be relabeled "
if {$widget_vars(to_mode) && $widget_vars(from_mode)} {
append line "to and from "
} elseif {$widget_vars(to_mode) && !$widget_vars(from_mode)} {
append line "to "
} elseif {!$widget_vars(to_mode) && $widget_vars(from_mode)} {
append line "from "
} else {
puts "Direction must be to, from or both for object mode."
return
}
set start_index [string length $line]
append line "$data "
set end_index [string length $line]
lappend subtitle_type_tags $start_index $end_index
append line "types.\n\n"
} else {
append line "can relabel "
set start_index [string length $line]
append line "to [lindex $data 1] "
set end_index [string length $line]
lappend subtitle_type_tags $start_index $end_index
append line "type(s) and relabel "
set start_index [string length $line]
append line "from [lindex $data 0] "
set end_index [string length $line]
lappend subtitle_type_tags $start_index $end_index
append line "type(s).\n\n"
}
append line "This tab provides the results of a Direct Relabel Analysis "
if {$widget_vars(mode) == "object"} {
append line "beginning with the "
if {$widget_vars(to_mode) && $widget_vars(from_mode)} {
append line "starting/ending type above. "
} elseif {$widget_vars(to_mode) && !$widget_vars(from_mode)} {
append line "starting type above. "
} elseif {!$widget_vars(to_mode) && $widget_vars(from_mode)} {
append line "ending type above. "
} else {
puts "Direction must be to, from, or both for object mode."
return
}
} else {
append line "for the subject above. "
}
append line "The results of the analysis are presented in tree form with the "
append line "root of the tree (this node) being the starting point for the analysis.\n\n"
if {$widget_vars(mode) == "object"} {
append line "Each child node in the tree represents a type in the current "
append line "policy to/from which relabeling is allowed "
append line "(depending on you selection above)."
} else {
append line "Each child node in the To and From subtrees represents a type "
append line "in th current policy which the chosen subject can relabel. "
}
} elseif {$widget_vars(mode) == "subject"} {
$widget_vars(current_rtext) configure -wrap none
append line "$widget_vars(start_type)"
set end_index [string length $line]
lappend title_type_tags $start_index $end_index
append line " can relabel "
set start_index [string length $line]
if {$node == "TO_LIST"} {
append line "to $data"
set end_index [string length $line]
lappend subtitle_type_tags $start_index $end_index
append line " type(s). Open the subtree of this item to view the list of types."
} elseif {$node == "FROM_LIST"} {
append line "from $data"
set end_index [string length $line]
lappend subtitle_type_tags $start_index $end_index
append line " type(s). Open the subtree of this item to view the list of types."
} else {
set parent [$widget parent $node]
if {$parent == "TO_LIST"} {
append line "to"
set id_end [string length "to_list:"]
} else {
append line "from"
set id_end [string length "from_list:"]
}
set node_str [string range $node $id_end end]
set end_index [string length $line]
lappend subtitle_type_tags $start_index $end_index
set start_index [string length $line]
append line " $node_str"
set end_index [string length $line]
lappend type_tags $start_index $end_index
append line "\n\n"
set rlist ""
foreach item $data {
if {![ApolTop::is_binary_policy]} {
set check [lsearch $rlist [expr [lindex $item 0]]]
if {$check > -1} continue
append line "("
set start_index [expr {[string length $line]}]
append line "[lindex $item 0]"
lappend rlist "[lindex $item 0]"
set end_index [string length $line]
append line ") "
lappend policy_tags_list $start_index $end_index
}
append line "[lindex $item 1]\n"
}
}
append line "\n"
} else {
$widget_vars(current_rtext) configure -wrap none
set start_index [string length $line]
append line "$widget_vars(start_type)"
set end_index [string length $line]
lappend title_type_tags $start_index $end_index
append line " can be relabeled:\n\n"
foreach datum $data {
foreach layer $datum {
foreach {obj obj_info} $layer {
set start_index [string length $line]
append line "$obj:\n"
set end_index [string length $line]
lappend title_tags $start_index $end_index
append line "\n"
foreach thing $obj_info {
foreach {direction subject rule_proof} $thing {
set start_index [string length $line]
if {$widget_vars(to_mode) && $widget_vars(from_mode)} {
if {$direction == "both"} {
append line " to and from "
} elseif {$direction == "to"} {
append line " to "
} else {
append line " from "
}
} elseif {$widget_vars(to_mode)} {
append line " to "
} else {
append line " from "
}
set end_index [string length $line]
lappend subtitle_type_tags $start_index $end_index
set start_index [string length $line]
append line "$node "
set end_index [string length $line]
lappend type_tags $start_index $end_index
append line "by "
set start_index [string length $line]
append line "$subject\n"
set end_index [string length $line]
lappend type_tags $start_index $end_index
foreach rule_set $rule_proof {
foreach {rule_num rule} $rule_set {
append line " "
if {![ApolTop::is_binary_policy]} {
append line "("
set start_index [expr {[string length $line]}]
append line "$rule_num"
set end_index [string length $line]
append line ") "
lappend policy_tags_list $start_index $end_index
}
append line "$rule\n"
}
}
append line "\n"
}
}
}
}
}
}
$widget_vars(current_rtext) insert end $line
if {![ApolTop::is_binary_policy]} {
foreach {start_index end_index} $policy_tags_list {
Apol_PolicyConf::insertHyperLink $widget_vars(current_rtext) \
"1.0 + $start_index c" "1.0 + $end_index c"
}
}
foreach {start_index end_index} $title_tags {
$widget_vars(current_rtext) tag add $Apol_Analysis_relabel::title_tag \
"1.0 + $start_index c" "1.0 + $end_index c"
}
foreach {start_index end_index} $type_tags {
$widget_vars(current_rtext) tag add $Apol_Analysis_relabel::type_tag \
"1.0 + $start_index c" "1.0 + $end_index c"
}
foreach {start_index end_index} $subtitle_type_tags {
$widget_vars(current_rtext) tag add $Apol_Analysis_relabel::subtitle_tag \
"1.0 + $start_index c" "1.0 + $end_index c"
}
foreach {start_index end_index} $title_type_tags {
$widget_vars(current_rtext) tag add $Apol_Analysis_relabel::title_type_tag \
"1.0 + $start_index c" "1.0 + $end_index c"
}
Apol_Analysis_relabel::formatInfoText $widget_vars(current_rtext)
$widget_vars(current_rtext) configure -state disabled
}
namespace eval Apol_Analysis_tra {
variable descriptive_text \
"The types relationship summary analysis in Apol is a convenience \
mechanism to allow a user to quickly do several queries and \
analyses already in present in Apol to understand the \
relationship between two types. This is meant to quickly display \
the relationship between two types and therefore doesn't include \
all of the options present in the standard queries and analyses. \
The analyses are grouped into two categories: Basic and Analysis.\n\n \
The basic group includes several rule searches that can be \n \
performed using the Policy Rules tab.\n\n \
\tCommon Attributes: the attributes common to both types.\n\n \
\tCommon Roles: the roles to which both types are assigned.\n\n \
\tCommon Users: the users allowed associate with roles to which\n \
\t\tboth types are assigned.\n\n \
\tCommon Access to Resources: object types to which both types \n \
\t\thave some access.\n\n \
\tDissimilar Access to Resources: object types to which one type\n \
\t\thas some access but the other type has none.\n\n \
The analysis group includes several other analyses that can be \n \
performed using the Analysis tab. \n\n \
\tDirect Flows Between A and B: direct information flow analysis\n \
\t\tbetween the two types.\n\n \
\tTransitive Flows A->B: transitive information flows from type A to B.\n\n \
\tTransitive Flows B->A: transitive information flows from type B to A.\n\n \
\tDomain Transitions A->B: domain transitions allowed from type A to B.\n\n \
\tDomain Transitions B->A: domain transitions allowed from type B to A.\n\n \
"
variable progressmsg ""
variable progress_indicator -1
variable typeA ""
variable typeB ""
variable attribA ""
variable attribB ""
variable attribA_sel 0
variable attribB_sel 0
variable comm_attribs_sel 1
variable comm_roles_sel 1
variable comm_users_sel 1
variable comm_access_sel 0
variable unique_access_sel 0
variable dta_AB_sel 0
variable dta_BA_sel 0
variable trans_flow_AB_sel 0
variable trans_flow_BA_sel 0
variable dir_flow_sel 0
variable te_rules_sel 0
variable tt_rule_sel 0
variable combo_typeA
variable combo_typeB
variable combo_attribA
variable combo_attribB
variable cb_attribA
variable cb_attribB
variable tra_listbox
variable tra_info_text
variable progressDlg
set progressDlg .progress
variable notebook
variable forward_options_Dlg
set forward_options_Dlg .forward_options_Dlg_tra
variable transflow_options_Dlg
set transflow_options_Dlg .transflow_options_Dlg_tra
variable dirflow_options_Dlg
set dirflow_options_Dlg .dirflow_options_Dlg
variable included_dirflow_objs ""
variable excluded_dirflow_objs ""
variable title_tag TITLE
variable title_type_tag TITLE_TYPE
variable subtitle_tag SUBTITLES
variable rules_tag RULES
variable counters_tag COUNTERS
variable types_tag TYPE
variable disabled_rule_tag DISABLE_RULE
variable basic_TabID "BasicTab"
variable analysis_TabID "AnalysisTab"
variable tab1_label "Basic"
variable tab2_label "Analysis"
Apol_Analysis::register_analysis_modules "Apol_Analysis_tra" "Types Relationship Summary"
}
proc Apol_Analysis_tra::display_dta_options { } {
Apol_Analysis_dta::forward_options_create_dialog \
$Apol_Analysis_tra::forward_options_Dlg \
"Types Relationship Domain Transitions Advanced Options"
return 0
}
proc Apol_Analysis_tra::display_tif_options { } {
Apol_Analysis_fulflow::advanced_filters_create_dialog \
$Apol_Analysis_tra::transflow_options_Dlg \
"Types Relationship Transitive Information Flows Options"
return 0
}
proc Apol_Analysis_tra::dirflow_options_include_exclude_objs {remove_list_1 \
add_list_1 \
remove_lbox \
add_lbox} {
upvar #0 $remove_list_1 remove_list
upvar #0 $add_list_1 add_list
set type_indices [$remove_lbox curselection]
if {$type_indices != ""} {
set tmp_list ""
foreach idx $type_indices {
set tmp_list [lappend tmp_list [$remove_lbox get $idx]]
}
foreach type $tmp_list {
set idx [lsearch -exact $remove_list $type]
if {$idx != -1} {
set remove_list [lreplace $remove_list $idx $idx]
set add_list [lappend add_list $type]
set add_list [lsort $add_list]
}
}
$remove_lbox selection clear 0 end
}
return 0
}
proc Apol_Analysis_tra::select_all_lbox_items {lbox} {
$lbox selection set 0 end
return 0
}
proc Apol_Analysis_tra::clear_all_lbox_items {lbox} {
$lbox selection clear 0 end
return 0
}
proc Apol_Analysis_tra::display_dif_options { } {
variable dirflow_options_Dlg
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened!"
return -1
}
if {[winfo exists $dirflow_options_Dlg]} {
raise $dirflow_options_Dlg
focus -force $dirflow_options_Dlg
return 0
}
toplevel $dirflow_options_Dlg
wm withdraw $dirflow_options_Dlg
wm title $dirflow_options_Dlg \
"Types Relationship Direct Information Flows Options"
wm protocol $dirflow_options_Dlg WM_DELETE_WINDOW " "
set top_frame [TitleFrame $dirflow_options_Dlg.top_frame \
-text "Filter results by object class:"]
set objcl_frame [frame [$top_frame getframe].objcl_frame]
set objcl_frame_1 [frame $objcl_frame.objcl_frame_1]
set objcl_frame_2 [frame $objcl_frame.objcl_frame_2]
set objcl_frame_3 [frame $objcl_frame.objcl_frame_3]
set b_frame_1 [frame $objcl_frame_1.b_frame_1]
set b_frame_3 [frame $objcl_frame_3.b_frame_3]
set lbl_incl [Label $objcl_frame_1.lbl_incl \
-text "Include these objects:"]
set sw_objs_1 [ScrolledWindow $objcl_frame_1.sw_objs_1 -auto both]
set list_objs_1 [listbox [$sw_objs_1 getframe].list_objs_1 \
-height 7 \
-highlightthickness 0 \
-selectmode extended \
-exportselection 0 -bg white \
-listvar Apol_Analysis_tra::included_dirflow_objs]
$sw_objs_1 setwidget $list_objs_1
set lbl_excl [Label $objcl_frame_3.lbl_excl \
-text "Exclude these objects:"]
set sw_objs_2 [ScrolledWindow $objcl_frame_3.sw_objs_2 -auto both]
set list_objs_2 [listbox [$sw_objs_2 getframe].list_objs_2 \
-height 7 \
-highlightthickness 0 \
-selectmode extended \
-exportselection 0 -bg white \
-listvar Apol_Analysis_tra::excluded_dirflow_objs]
$sw_objs_2 setwidget $list_objs_2
bindtags $list_objs_1 \
[linsert [bindtags $list_objs_1] 3 \
list_objs_1_Tag]
bindtags $list_objs_2 \
[linsert [bindtags $list_objs_2] 3 \
list_objs_2_Tag]
bind list_objs_1_Tag <<ListboxSelect>> "focus -force $list_objs_1"
bind list_objs_2_Tag <<ListboxSelect>> "focus -force $list_objs_2"
set include_bttn [Button $objcl_frame_2.include_bttn -text "<--" \
-helptext "Include object(s) in the query" -width 8 \
-command "Apol_Analysis_tra::dirflow_options_include_exclude_objs \
Apol_Analysis_tra::excluded_dirflow_objs \
Apol_Analysis_tra::included_dirflow_objs \
$list_objs_2 \
$list_objs_1"]
set exclude_bttn [Button $objcl_frame_2.exclude_bttn -text "-->" \
-helptext "Exclude object(s) from the query" -width 8 \
-command "Apol_Analysis_tra::dirflow_options_include_exclude_objs \
Apol_Analysis_tra::included_dirflow_objs \
Apol_Analysis_tra::excluded_dirflow_objs \
$list_objs_1 \
$list_objs_2"]
set b_incl_all_sel [Button $b_frame_1.b_incl_all_sel \
-text "Select All" \
-command "Apol_Analysis_tra::select_all_lbox_items $list_objs_1"]
set b_incl_all_clear [Button $b_frame_1.b_incl_all_clear \
-text "Unselect" \
-command "Apol_Analysis_tra::clear_all_lbox_items $list_objs_1"]
set b_excl_all_sel [Button $b_frame_3.b_excl_all_sel \
-text "Select All" \
-command "Apol_Analysis_tra::select_all_lbox_items $list_objs_2"]
set b_excl_all_clear [Button $b_frame_3.b_excl_all_clear \
-text "Unselect" \
-command "Apol_Analysis_tra::clear_all_lbox_items $list_objs_2"]
set button_f [frame $dirflow_options_Dlg.button_f]
set close_bttn [Button $button_f.close_bttn \
-text "Close" \
-width 8 \
-command "destroy $dirflow_options_Dlg"]
pack $b_frame_3 $b_frame_1 -side bottom -anchor center
pack $objcl_frame_3 -side right -anchor nw -fill both -expand yes
pack $objcl_frame_1 -side left -anchor nw -fill both -expand yes
pack $objcl_frame_2 -side top -anchor center -pady 80 -padx 10
pack $button_f -side bottom -anchor center -expand yes -pady 4 -padx 4
pack $objcl_frame -side top -anchor nw -fill both -expand yes -pady 4 -padx 4
pack $top_frame -side left -anchor nw -fill both -expand yes -pady 4 -padx 4
pack $b_incl_all_sel $b_incl_all_clear $b_excl_all_sel $b_excl_all_clear \
-side left -anchor nw -fill x
pack $include_bttn $exclude_bttn -side top -anchor center -fill y
pack $sw_objs_1 $sw_objs_2 -side bottom -anchor nw -fill both -expand yes \
-padx 5 -pady 5
pack $lbl_incl $lbl_excl -side top -anchor nw -padx 5 -pady 2
pack $close_bttn -side left -anchor center
set width 580
set height 300
wm geom $dirflow_options_Dlg ${width}x${height}
wm deiconify $dirflow_options_Dlg
focus $dirflow_options_Dlg
wm protocol $dirflow_options_Dlg WM_DELETE_WINDOW \
"destroy $dirflow_options_Dlg"
return 0
}
proc Apol_Analysis_tra::initialize_widgets_state { } {
variable combo_typeA
variable combo_typeB
variable combo_attribA
variable combo_attribB
variable cb_attribA
variable cb_attribB
variable notebook
$notebook raise [$notebook pages 0]
Apol_Analysis_tra::config_attrib_comboBox_state \
$cb_attribA $combo_attribA $combo_typeA 0
Apol_Analysis_tra::config_attrib_comboBox_state \
$cb_attribB $combo_attribB $combo_typeB 0
Apol_Analysis_tra::configure_tab_label $Apol_Analysis_tra::basic_TabID
Apol_Analysis_tra::configure_tab_label $Apol_Analysis_tra::analysis_TabID
return 0
}
proc Apol_Analysis_tra::initialize { } {
Apol_Analysis_tra::reset_variables
return 0
}
proc Apol_Analysis_tra::do_analysis {results_frame} {
variable tra_listbox
variable typeA
variable typeB
variable comm_attribs_sel
variable comm_roles_sel
variable comm_users_sel
variable comm_access_sel
variable unique_access_sel
variable dta_AB_sel
variable dta_BA_sel
variable trans_flow_AB_sel
variable trans_flow_BA_sel
variable dir_flow_sel
variable te_rules_sel
variable tt_rule_sel
variable excluded_dirflow_objs
variable forward_options_Dlg
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" \
-message "No current policy file is opened!"
return -code error
}
if {$typeA == ""} {
tk_messageBox -icon error -type ok -title "Error" \
-message "Type A cannot be empty!"
return -code error
}
if {$typeB == ""} {
tk_messageBox -icon error -type ok -title "Error" \
-message "Type B cannot be empty!"
return -code error
}
if {!$comm_attribs_sel && !$comm_roles_sel && !$comm_users_sel && !$comm_access_sel && \
!$unique_access_sel && !$dta_AB_sel && !$dta_BA_sel && !$trans_flow_AB_sel && \
!$trans_flow_BA_sel && !$dir_flow_sel && !$te_rules_sel && !$tt_rule_sel} {
tk_messageBox -icon error -type ok -title "Error" \
-message "You did not select any search items."
return -code error
}
set rt [catch {set map_loaded [Apol_Perms_Map::is_pmap_loaded]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "$err"
return -code error
}
set do_trans [expr ($trans_flow_AB_sel || $trans_flow_BA_sel)]
if {[expr (!$map_loaded && ($do_trans || $dir_flow_sel))]} {
set rt [catch {Apol_Perms_Map::load_default_perm_map} err]
if { $rt != 0 } {
if {$rt == $Apol_Perms_Map::warning_return_val} {
tk_messageBox -icon warning -type ok -title "Warning" -message "$err"
} else {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
}
}
Apol_Analysis_tra::display_progressDlg
set dta_object(x) ""
if {$dta_AB_sel || $dta_BA_sel} {
Apol_Analysis_dta::forward_options_copy_object $forward_options_Dlg dta_object
}
set dta_reverse 0
set dta_num_object_classes 0
set dta_perm_options ""
set dta_filter_types 0
set dta_types ""
set dta_objects_sel 0
if {$dta_AB_sel || $dta_BA_sel} {
foreach class $dta_object($forward_options_Dlg,class_list) {
set perms ""
set idx [string first $Apol_Analysis_dta::excluded_tag $class]
if {$idx == -1} {
set class_elements [array names dta_object "$forward_options_Dlg,perm_status_array,$class,*"]
set class_added 0
foreach element $class_elements {
set perm [lindex [split $element ","] 3]
if {[string equal $dta_object($element) "include"]} {
if {$class_added == 0} {
incr dta_num_object_classes
set dta_perm_options [lappend dta_perm_options $class]
set class_added 1
}
set perms [lappend perms $perm]
}
}
if {$perms != ""} {
set dta_perm_options [lappend dta_perm_options [llength $perms]]
foreach perm $perms {
set dta_perm_options [lappend dta_perm_options $perm]
}
}
}
}
set dta_types $Apol_Types::typelist
if {$dta_num_object_classes} {
set dta_objects_sel 1
}
if {$dta_types != ""} {
set dta_filter_types 1
}
}
array unset dta_object
set tif_num_object_classes 0
set tif_perm_options ""
set tif_types ""
set tif_objects_sel 0
set tif_filter_types 0
set filter_dirflow_objs 0
set rt [catch {set results [apol_TypesRelationshipAnalysis \
$typeA \
$typeB \
$comm_attribs_sel \
$comm_roles_sel \
$comm_users_sel \
$comm_access_sel \
$unique_access_sel \
[expr ($dta_AB_sel || $dta_BA_sel)] \
[expr ($trans_flow_AB_sel || $trans_flow_BA_sel)] \
$dir_flow_sel \
$tt_rule_sel \
$te_rules_sel \
$tif_objects_sel \
$tif_num_object_classes \
$tif_perm_options \
$tif_filter_types \
$tif_types \
$dta_objects_sel \
$dta_num_object_classes \
$dta_perm_options \
$dta_filter_types \
$dta_types \
$filter_dirflow_objs \
$excluded_dirflow_objs]} err]
Apol_Analysis_tra::destroy_progressDlg
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
set tra_listbox [Apol_Analysis_tra::create_resultsDisplay $results_frame]
set rt [catch {Apol_Analysis_tra::create_results_list_structure $tra_listbox $results} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return -code error
}
return 0
}
proc Apol_Analysis_tra::listSelect {tra_listbox tra_info_text selected_item} {
variable typeA
variable typeB
$tra_info_text configure -state normal
$tra_info_text delete 0.0 end
$tra_info_text mark set insert 1.0
switch -exact -- $selected_item {
common_attribs {
Apol_Analysis_tra::display_common_attribs \
$tra_listbox \
$tra_info_text \
"Common Attributes" \
[$tra_listbox itemcget $selected_item -data]
}
common_roles {
Apol_Analysis_tra::display_common_attribs \
$tra_listbox \
$tra_info_text \
"Common Roles" \
[$tra_listbox itemcget $selected_item -data]
}
common_users {
Apol_Analysis_tra::display_common_attribs \
$tra_listbox \
$tra_info_text \
"Common Users" \
[$tra_listbox itemcget $selected_item -data]
}
tt_rules {
Apol_Analysis_tra::display_rules \
$tra_listbox \
$tra_info_text \
"Type transition/change rules" \
[$tra_listbox itemcget $selected_item -data]
}
te_rules {
Apol_Analysis_tra::display_rules \
$tra_listbox \
$tra_info_text \
"TE Allow Rules" \
[$tra_listbox itemcget $selected_item -data]
}
common_objects {
$tra_info_text configure -wrap word
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "$typeA"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end " and "
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "$typeB"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end " access \
[$tra_listbox itemcget $selected_item -data] common type(s).\n\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
if {[$tra_listbox itemcget $selected_item -data] > 0} {
$tra_info_text insert end "Open the subtree for this item to see the list of \
common types that can be accessed. You may then select a type from the \
subtree to see the allow rules which provide the access."
}
}
unique_objects {
$tra_info_text configure -wrap word
$tra_info_text insert end "Open the subtree for this item to access individual \
subtrees of types which can be accessed by either "
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "$typeA"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $start_idx $end_idx
$tra_info_text insert end " or "
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "$typeB"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $start_idx $end_idx
$tra_info_text insert end ".\nYou may then select a type from a subtree to see the \
allow rules which provide the access."
}
unique_objects:typeA {
$tra_info_text configure -wrap word
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "$typeA"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end " accesses \
[$tra_listbox itemcget $selected_item -data] type(s) to which "
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "$typeB"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end " does not have access.\n\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
if {[$tra_listbox itemcget $selected_item -data] > 0} {
$tra_info_text insert end "Open the subtree for this item to see the list of types. \
You may then select a type from the subtree to see the allow rules which provide \
the access."
}
}
unique_objects:typeB {
$tra_info_text configure -wrap word
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "$typeB"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end " accesses \
[$tra_listbox itemcget $selected_item -data] type(s) to which "
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "$typeA"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end " does not have access.\n\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
if {[$tra_listbox itemcget $selected_item -data] > 0} {
$tra_info_text insert end "Open the subtree for this item to see the list of types. \
You may then select a type from the subtree to see the allow rules which provide \
the access."
}
}
dir_flows {
Apol_Analysis_tra::display_direct_flows \
$tra_listbox \
$tra_info_text \
[$tra_listbox itemcget $selected_item -data] \
}
trans_flows_A {
Apol_Analysis_tra::display_transitive_flows \
$tra_listbox \
$tra_info_text \
[$tra_listbox itemcget $selected_item -data] \
$Apol_Analysis_tra::typeA
}
trans_flows_B {
Apol_Analysis_tra::display_transitive_flows \
$tra_listbox \
$tra_info_text \
[$tra_listbox itemcget $selected_item -data] \
$Apol_Analysis_tra::typeB
}
dta_analysis_A {
Apol_Analysis_tra::display_dta_info \
$tra_listbox \
$tra_info_text \
[$tra_listbox itemcget $selected_item -data] \
$Apol_Analysis_tra::typeA
}
dta_analysis_B {
Apol_Analysis_tra::display_dta_info \
$tra_listbox \
$tra_info_text \
[$tra_listbox itemcget $selected_item -data] \
$Apol_Analysis_tra::typeB
}
default {
if {[$tra_listbox parent $selected_item] == "unique_objects:typeA" ||
[$tra_listbox parent $selected_item] == "unique_objects:typeB"} {
set idx [string length "unique_objects:"]
set node [string range $selected_item $idx [expr [string length $selected_item] - 1]]
Apol_Analysis_tra::display_unique_object_info \
$tra_listbox \
$tra_info_text \
$node \
[$tra_listbox itemcget $selected_item -data]
} elseif {[$tra_listbox parent $selected_item] == "common_objects"} {
set idx [string length "common_objects:"]
set node [string range $selected_item $idx [expr [string length $selected_item] - 1]]
Apol_Analysis_tra::display_common_object_info \
$tra_listbox \
$tra_info_text \
$node \
[$tra_listbox itemcget $selected_item -data]
} else {
puts "Invalid listbox item element $selected_item"
return -1
}
}
}
ApolTop::makeTextBoxReadOnly $tra_info_text
$tra_listbox selection set $selected_item
Apol_Analysis_tra::formatInfoText $Apol_Analysis_tra::tra_info_text
return 0
}
proc Apol_Analysis_tra::formatInfoText { tb } {
$tb tag configure $Apol_Analysis_tra::title_tag -font {Helvetica 12 bold}
$tb tag configure $Apol_Analysis_tra::title_type_tag -foreground blue -font {Helvetica 12 bold}
$tb tag configure $Apol_Analysis_tra::subtitle_tag -font {Helvetica 11 bold}
$tb tag configure $Apol_Analysis_tra::rules_tag -font $ApolTop::text_font
$tb tag configure $Apol_Analysis_tra::counters_tag -foreground blue -font {Helvetica 11 bold}
$tb tag configure $Apol_Analysis_tra::types_tag -font $ApolTop::text_font
$tb tag configure $Apol_Analysis_tra::disabled_rule_tag -foreground red
Apol_PolicyConf::configure_HyperLinks $tb
}
proc Apol_Analysis_tra::display_common_attribs {tra_listbox tra_info_text header_txt data} {
if { $data == "" } {
$tra_info_text configure -state disabled
return 0
}
set num [lindex $data 0]
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "$header_txt ($num):\n\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
if {$num} {
set itemlist [lrange $data 1 end]
foreach item $itemlist {
$tra_info_text insert end "$item\n"
}
}
return 0
}
proc Apol_Analysis_tra::display_rules {tra_listbox tra_info_text header_txt data} {
if { $data == "" } {
$tra_info_text configure -state disabled
return 0
}
set i 0
set num [lindex $data $i]
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "$header_txt ($num):\n\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
set curr_idx [expr $i + 1]
for {set x 0} {$x < $num} {incr x} {
Apol_Analysis_tra::print_rule $tra_info_text $data $curr_idx 0
incr curr_idx
}
return 0
}
proc Apol_Analysis_tra::print_rule {tra_info_text data curr_idx indent} {
if {$indent} {
$tra_info_text insert end " "
}
set startIdx [$tra_info_text index insert]
set rule [lindex $data $curr_idx]
set end_link_idx [string first "\]" [string trim $rule] 0]
set lineno [string range [string trim [string range $rule 0 $end_link_idx]] 1 end-1]
set lineno [string trim $lineno]
set rule [string range $rule [expr $end_link_idx + 1] end]
if {![ApolTop::is_binary_policy]} {
$tra_info_text insert end "\[$lineno\]"
Apol_PolicyConf::insertHyperLink $tra_info_text "$startIdx wordstart + 1c" "$startIdx wordstart + [expr [string length $lineno] + 1]c"
}
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "$rule\n"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::rules_tag $startIdx $endIdx
return 0
}
proc Apol_Analysis_tra::display_common_object_info {tra_listbox tra_info_text node data} {
variable typeA
variable typeB
if { $data == "" } {
$tra_info_text configure -state disabled
return 0
}
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "$typeA"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $startIdx $endIdx
set startIdx [$tra_info_text index insert]
$tra_info_text insert end " accesses "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $startIdx $endIdx
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "$node"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $startIdx $endIdx
set startIdx [$tra_info_text index insert]
$tra_info_text insert end ":\n\n"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $startIdx $endIdx
set i 0
set num_comm_rules_A [lindex $data $i]
for { set p 0 } { $p < $num_comm_rules_A } { incr p } {
incr i
Apol_Analysis_tra::print_rule $tra_info_text $data $i 0
}
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "\n$typeB"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $startIdx $endIdx
set startIdx [$tra_info_text index insert]
$tra_info_text insert end " accesses "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $startIdx $endIdx
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "$node"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $startIdx $endIdx
set startIdx [$tra_info_text index insert]
$tra_info_text insert end ":\n\n"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $startIdx $endIdx
incr i
set num_comm_rules_B [lindex $data $i]
for { set p 0 } { $p < $num_comm_rules_B } { incr p } {
incr i
Apol_Analysis_tra::print_rule $tra_info_text $data $i 0
}
return 0
}
proc Apol_Analysis_tra::destroy_progressDlg {} {
variable progressDlg
if {[winfo exists $progressDlg]} {
destroy $progressDlg
}
return 0
}
proc Apol_Analysis_tra::display_progressDlg {} {
variable progressDlg
set Apol_Analysis_tra::progressmsg "Performing types relationship analysis..."
set progressBar [ProgressDlg $progressDlg \
-parent $ApolTop::mainframe \
-textvariable Apol_Analysis_tra::progressmsg \
-variable Apol_Analysis_tra::progress_indicator \
-maximum 3 \
-width 45]
update
return 0
}
proc Apol_Analysis_tra::display_unique_object_info {tra_listbox tra_info_text node data} {
if { $data == "" } {
$tra_info_text configure -state disabled
return 0
}
set i 0
set type [lindex $data $i]
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "$type"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end " accesses "
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "$node"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end ":\n\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
incr i
set num_rules_A [lindex $data $i]
for { set p 0 } { $p < $num_rules_A } { incr p } {
incr i
Apol_Analysis_tra::print_rule $tra_info_text $data $i 0
}
return 0
}
proc Apol_Analysis_tra::display_direct_flows {tra_listbox tra_info_text data} {
variable typeA
variable typeB
if { $data == "" } {
$tra_info_text configure -state disabled
return 0
}
set start_type $typeA
set i 0
set num_target_types [lindex $data $i]
if {$num_target_types == 0} {
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "No direct information flows"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
} else {
incr i
set cur_end_type [lindex $data $i]
incr i
set flow_dir [lindex $data $i]
incr i
set num_objs [lindex $data $i]
incr i
set curIdx $i
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "Information flows both into and out of "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $startIdx $endIdx
set startIdx [$tra_info_text index insert]
$tra_info_text insert end $start_type
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $startIdx $endIdx
set startIdx [$tra_info_text index insert]
$tra_info_text insert end " - \[from/to\] "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $startIdx $endIdx
set startIdx [$tra_info_text index insert]
$tra_info_text insert end $cur_end_type
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $startIdx $endIdx
set startIdx $endIdx
for { set x 0 } { $x < $num_target_types } { incr x } {
if {$flow_dir == "both"} {
$tra_info_text insert end "\n\nObject classes for "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
$tra_info_text insert end "\[IN/OUT\]"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $startIdx $endIdx
set startIdx $endIdx
$tra_info_text insert end " flows:"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
for {set i 0} {$i<$num_objs} {incr i} {
if {[lindex $data $curIdx] == "1"} {
incr curIdx
$tra_info_text insert end "\n\t"
$tra_info_text insert end [lindex $data $curIdx]
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
incr curIdx
set num_rules [lindex $data $curIdx]
for {set j 0} {$j<$num_rules} {incr j} {
$tra_info_text insert end "\n\t"
set startIdx [$tra_info_text index insert]
incr curIdx
set rule [lindex $data $curIdx]
set end_link_idx [string first "\]" [string trim $rule] 0]
set lineno [string range [string trim [string range $rule 0 $end_link_idx]] 1 end-1]
set lineno [string trim $lineno]
set rule [string range $rule [expr $end_link_idx + 1] end]
if {![ApolTop::is_binary_policy]} {
$tra_info_text insert end "\[$lineno\]"
Apol_PolicyConf::insertHyperLink $tra_info_text "$startIdx wordstart + 1c" "$startIdx wordstart + [expr [string length $lineno] + 1]c"
}
set startIdx [$tra_info_text index insert]
$tra_info_text insert end " $rule"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::rules_tag $startIdx $endIdx
incr curIdx
if {[lindex $data $curIdx] == 0} {
$tra_info_text insert end " "
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "\[Disabled\]"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::disabled_rule_tag $startIdx $endIdx
}
set startIdx [$tra_info_text index insert]
}
}
incr curIdx
}
} else {
$tra_info_text insert end "\n\nObject classes for "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
set flow_dir [string toupper $flow_dir]
$tra_info_text insert end $flow_dir
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $startIdx $endIdx
set startIdx $endIdx
$tra_info_text insert end " flows:"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
for {set i 0} {$i<$num_objs} {incr i} {
if { [lindex $data $curIdx] == "1" } {
incr curIdx
$tra_info_text insert end "\n\t"
$tra_info_text insert end [lindex $data $curIdx]
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
incr curIdx
set num_rules [lindex $data $curIdx]
for {set j 0} {$j<$num_rules} {incr j} {
$tra_info_text insert end "\n\t"
set startIdx [$tra_info_text index insert]
incr curIdx
set rule [lindex $data $curIdx]
set end_link_idx [string first "\]" [string trim $rule] 0]
set lineno [string range [string trim [string range $rule 0 $end_link_idx]] 1 end-1]
set lineno [string trim $lineno]
set rule [string range $rule [expr $end_link_idx + 1] end]
if {![ApolTop::is_binary_policy]} {
$tra_info_text insert end "\[$lineno\]"
Apol_PolicyConf::insertHyperLink $tra_info_text "$startIdx wordstart + 1c" "$startIdx wordstart + [expr [string length $lineno] + 1]c"
}
set startIdx [$tra_info_text index insert]
$tra_info_text insert end " $rule"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::rules_tag $startIdx $endIdx
incr curIdx
if {[lindex $data $curIdx] == 0} {
$tra_info_text insert end " "
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "\[Disabled\]"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::disabled_rule_tag $startIdx $endIdx
}
set startIdx [$tra_info_text index insert]
}
}
incr curIdx
}
}
}
}
return 0
}
proc Apol_Analysis_tra::display_transitive_flows {tra_listbox tra_info_text data start_type} {
if { $data == "" } {
$tra_info_text configure -state disabled
return 0
}
set i 0
set num_target_types [lindex $data $i]
if {$num_target_types} {
incr i
set end_type [lindex $data $i]
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "Information flows from "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $startIdx $endIdx
set startIdx [$tra_info_text index insert]
$tra_info_text insert end $start_type
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $startIdx $endIdx
set startIdx [$tra_info_text index insert]
$tra_info_text insert end " to "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $startIdx $endIdx
set startIdx [$tra_info_text index insert]
$tra_info_text insert end $end_type
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $startIdx $endIdx
set startIdx $endIdx
} else {
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "No transitive information flows from $start_type"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
}
for { set x 0 } { $x < $num_target_types } { incr x } {
incr i
set currentIdx $i
set num_paths [lindex $data $currentIdx]
$tra_info_text insert end "\n\nApol found the following number of information flows: "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
$tra_info_text insert end $num_paths
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::counters_tag $startIdx $endIdx
for {set j 0} {$j < $num_paths} {incr j} {
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "\n\nFlow"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
$tra_info_text insert end " [expr $j+1] "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::counters_tag $startIdx $endIdx
set startIdx $endIdx
$tra_info_text insert end "requires "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
incr currentIdx
set num_flows [lindex $data $currentIdx]
$tra_info_text insert end $num_flows
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::counters_tag $startIdx $endIdx
set startIdx $endIdx
$tra_info_text insert end " step(s)."
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
for {set k 0} {$k < $num_flows} {incr k} {
$tra_info_text insert end "\n\n\tStep "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
$tra_info_text insert end [expr $k + 1]
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::counters_tag $startIdx $endIdx
set startIdx $endIdx
$tra_info_text insert end ": "
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
$tra_info_text insert end "from "
incr currentIdx
$tra_info_text insert end [lindex $data $currentIdx]
$tra_info_text insert end " to "
incr currentIdx
$tra_info_text insert end [lindex $data $currentIdx]
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
incr currentIdx
set num_classes [lindex $data $currentIdx]
for {set l 0} {$l < $num_classes} {incr l} {
incr currentIdx
$tra_info_text insert end "\n\t[lindex $data $currentIdx]"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $startIdx $endIdx
set startIdx $endIdx
incr currentIdx
set num_rules [lindex $data $currentIdx]
for {set m 0} {$m < $num_rules} {incr m} {
incr currentIdx
set rule [lindex $data $currentIdx]
$tra_info_text insert end "\n\t"
set startIdx [$tra_info_text index insert]
set end_link_idx [string first "\]" [string trim $rule] 0]
set lineno [string range [string trim [string range $rule 0 $end_link_idx]] 1 end-1]
set lineno [string trim $lineno]
set rule [string range $rule [expr $end_link_idx + 1] end]
if {![ApolTop::is_binary_policy]} {
$tra_info_text insert end "\[$lineno\]"
Apol_PolicyConf::insertHyperLink $tra_info_text "$startIdx wordstart + 1c" "$startIdx wordstart + [expr [string length $lineno] + 1]c"
}
set startIdx [$tra_info_text index insert]
$tra_info_text insert end " $rule"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::rules_tag $startIdx $endIdx
incr currentIdx
if {[lindex $data $currentIdx] == 0} {
$tra_info_text insert end " "
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "\[Disabled\]"
set endIdx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::disabled_rule_tag $startIdx $endIdx
}
set startIdx [$tra_info_text index insert]
}
}
}
}
}
return 0
}
proc Apol_Analysis_tra::display_dta_info {tra_listbox tra_info_text data start_type} {
if { $data == "" } {
$tra_info_text configure -state disabled
return 0
}
set idx 0
set num_target_types [lindex $data $idx]
if {![string is integer $num_target_types]} {
puts "Number of target types is not an integer: $num_target_types"
return
}
if {$num_target_types} {
incr idx
set end_type [lindex $data $idx]
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "Domain transition from "
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end $start_type
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end " to "
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
set start_idx [$tra_info_text index insert]
$tra_info_text insert end $end_type
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_type_tag $start_idx $end_idx
} else {
set start_idx [$tra_info_text index insert]
$tra_info_text insert end "No domain transitions"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::title_tag $start_idx $end_idx
}
for { set x 0 } { $x < $num_target_types } { incr x } {
incr idx
$tra_info_text insert end "\n\n"
set start_idx [$tra_info_text index insert]
set num_pt [lindex $data $idx]
if {![string is integer $num_pt]} {
puts "Number of allow rules is not an integer: $num_pt"
return
}
$tra_info_text insert end "TE Allow Rules: "
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $start_idx $end_idx
set start_idx $end_idx
$tra_info_text insert end "$num_pt\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::counters_tag $start_idx $end_idx
for { set i 0 } { $i < $num_pt } { incr i } {
incr idx
set rule [lindex $data $idx]
incr idx
set lineno [lindex $data $idx]
$tra_info_text insert end "\t"
set start_idx [$tra_info_text index insert]
if {![ApolTop::is_binary_policy]} {
$tra_info_text insert end "($lineno) "
set end_idx [$tra_info_text index insert]
Apol_PolicyConf::insertHyperLink $tra_info_text "$start_idx wordstart + 1c" "$start_idx wordstart + [expr [string length $lineno] + 1]c"
set start_idx $end_idx
}
$tra_info_text insert end "$rule"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::rules_tag $start_idx $end_idx
incr idx
if {[lindex $data $idx] == 0} {
$tra_info_text insert end " "
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "\[Disabled\]\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::disabled_rule_tag $start_idx $end_idx
} else {
$tra_info_text insert end "\n"
}
}
incr idx
set num_types [lindex $data $idx]
if {![string is integer $num_types]} {
puts "Number of file types is not an integer: $num_types"
return
}
set start_idx $end_idx
$tra_info_text insert end "\nEntry Point File Types: "
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $start_idx $end_idx
set start_idx $end_idx
$tra_info_text insert end "$num_types\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::counters_tag $start_idx $end_idx
for {set i 0} { $i < $num_types } { incr i } {
incr idx
set type [lindex $data $idx]
set start_idx $end_idx
$tra_info_text insert end "\t$type\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::types_tag $start_idx $end_idx
incr idx
set num_ep [lindex $data $idx]
if {![string is integer $num_ep]} {
puts "Number of entrypoint access rules is not an integer: $num_ep"
return
}
set start_idx $end_idx
$tra_info_text insert end "\t\tFile Entrypoint Rules: "
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $start_idx $end_idx
set start_idx $end_idx
$tra_info_text insert end "$num_ep\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::counters_tag $start_idx $end_idx
for {set j 0} {$j < $num_ep} {incr j} {
incr idx
set rule [lindex $data $idx]
incr idx
set lineno [lindex $data $idx]
$tra_info_text insert end "\t\t"
set start_idx [$tra_info_text index insert]
if {![ApolTop::is_binary_policy]} {
$tra_info_text insert end "($lineno) "
set end_idx [$tra_info_text index insert]
Apol_PolicyConf::insertHyperLink $tra_info_text "$start_idx wordstart + 1c" "$start_idx wordstart + [expr [string length $lineno] + 1]c"
set start_idx $end_idx
}
$tra_info_text insert end "$rule"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::rules_tag $start_idx $end_idx
incr idx
if {[lindex $data $idx] == 0} {
$tra_info_text insert end " "
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "\[Disabled\]\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::disabled_rule_tag $start_idx $end_idx
} else {
$tra_info_text insert end "\n"
}
}
incr idx
set num_ex [lindex $data $idx]
if {![string is integer $num_ex]} {
puts "Number of execute access rules is not an integer: $num_ex"
return
}
set start_idx $end_idx
$tra_info_text insert end "\n\t\tFile Execute Rules: "
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::subtitle_tag $start_idx $end_idx
set start_idx $end_idx
$tra_info_text insert end "$num_ex\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::counters_tag $start_idx $end_idx
for { set j 0 } { $j < $num_ex } { incr j } {
incr idx
set rule [lindex $data $idx]
incr idx
set lineno [lindex $data $idx]
$tra_info_text insert end "\t\t"
set start_idx [$tra_info_text index insert]
if {![ApolTop::is_binary_policy]} {
$tra_info_text insert end "($lineno) "
set end_idx [$tra_info_text index insert]
Apol_PolicyConf::insertHyperLink $tra_info_text "$start_idx wordstart + 1c" "$start_idx wordstart + [expr [string length $lineno] + 1]c"
set start_idx $end_idx
}
$tra_info_text insert end "$rule"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::rules_tag $start_idx $end_idx
incr idx
if {[lindex $data $idx] == 0} {
$tra_info_text insert end " "
set startIdx [$tra_info_text index insert]
$tra_info_text insert end "\[Disabled\]\n"
set end_idx [$tra_info_text index insert]
$tra_info_text tag add $Apol_Analysis_tra::disabled_rule_tag $start_idx $end_idx
} else {
$tra_info_text insert end "\n"
}
}
}
}
$tra_info_text configure -state disabled
return 0
}
proc Apol_Analysis_tra::create_results_list_structure {tra_listbox results_list} {
variable comm_attribs_sel
variable comm_roles_sel
variable comm_users_sel
variable comm_access_sel
variable unique_access_sel
variable dta_AB_sel
variable dta_BA_sel
variable trans_flow_AB_sel
variable trans_flow_BA_sel
variable dir_flow_sel
variable te_rules_sel
variable tt_rule_sel
set typeA [lindex $results_list 0]
set typeB [lindex $results_list 1]
set i 2
set parent "root"
set num_common_attribs [lindex $results_list $i]
set start_idx $i
for { set x 0 } { $x < $num_common_attribs } { incr x } {
incr i
}
if {$comm_attribs_sel} {
$tra_listbox insert end $parent common_attribs \
-text "Common Attributes" \
-open 0 \
-drawcross auto \
-data [lrange $results_list $start_idx $i]
}
incr i
set num_common_roles [lindex $results_list $i]
set start_idx $i
for { set x 0 } { $x < $num_common_roles } { incr x } {
incr i
}
if {$comm_roles_sel} {
$tra_listbox insert end $parent common_roles \
-text "Common Roles" \
-open 0 \
-drawcross auto \
-data [lrange $results_list $start_idx $i]
}
incr i
set num_common_users [lindex $results_list $i]
set start_idx $i
for { set x 0 } { $x < $num_common_users } { incr x } {
incr i
}
if {$comm_users_sel} {
$tra_listbox insert end $parent common_users \
-text "Common Users" \
-open 0 \
-drawcross auto \
-data [lrange $results_list $start_idx $i]
}
incr i
set num_other_tt_rules [lindex $results_list $i]
set start_idx $i
for { set x 0 } { $x < $num_other_tt_rules } { incr x } {
incr i
}
if {$tt_rule_sel} {
$tra_listbox insert end $parent tt_rules \
-text "Type Transition/Change Rules" \
-open 0 \
-drawcross auto \
-data [lrange $results_list $start_idx $i]
}
incr i
set num_te_rules [lindex $results_list $i]
set start_idx $i
for { set x 0 } { $x < $num_te_rules } { incr x } {
incr i
}
if {$te_rules_sel} {
$tra_listbox insert end $parent te_rules \
-text "TE Allow Rules" \
-open 0 \
-drawcross auto \
-data [lrange $results_list $start_idx $i]
}
incr i
set num_comm_objs [lindex $results_list $i]
set start_idx $i
if {$comm_access_sel} {
$tra_listbox insert end $parent common_objects \
-text "Common access to resources" \
-open 0 \
-drawcross auto \
-data $num_comm_objs
}
for { set x 0 } { $x < $num_comm_objs } { incr x } {
incr i
set type [lindex $results_list $i]
incr i
set start_idx $i
set num_rules_A [lindex $results_list $i]
incr i $num_rules_A
incr i
set num_rules_b [lindex $results_list $i]
incr i $num_rules_b
$tra_listbox insert end common_objects "common_objects:$type" \
-text $type \
-open 0 \
-drawcross auto \
-data [lrange $results_list $start_idx $i]
}
incr i
set num_uniqe_objs_A [lindex $results_list $i]
if {$unique_access_sel} {
$tra_listbox insert end $parent unique_objects \
-text "Dissimilar access to resources" \
-open 0 \
-drawcross auto
$tra_listbox insert end unique_objects unique_objects:typeA \
-text $typeA \
-open 0 \
-drawcross auto -data $num_uniqe_objs_A
}
for { set x 0 } { $x < $num_uniqe_objs_A } { incr x } {
incr i
set type [lindex $results_list $i]
incr i
set start_idx $i
set num_rules_A [lindex $results_list $i]
incr i $num_rules_A
if {$unique_access_sel} {
set data [concat $typeA [lrange $results_list $start_idx $i]]
$tra_listbox insert end "unique_objects:typeA" "unique_objects:$type" \
-text $type \
-open 0 \
-drawcross auto \
-data $data
}
}
incr i
set num_uniqe_objs_B [lindex $results_list $i]
if {$unique_access_sel} {
$tra_listbox insert end unique_objects unique_objects:typeB \
-text $typeB \
-open 0 \
-drawcross auto -data $num_uniqe_objs_B
}
for { set x 0 } { $x < $num_uniqe_objs_B } { incr x } {
incr i
set type [lindex $results_list $i]
incr i
set start_idx $i
set num_rules_B [lindex $results_list $i]
incr i $num_rules_B
if {$unique_access_sel} {
set data [concat $typeB [lrange $results_list $start_idx $i]]
$tra_listbox insert end "unique_objects:typeB" "unique_objects:$type" \
-text $type \
-open 0 \
-drawcross auto \
-data $data
}
}
incr i
set start_idx $i
set num_dirflow_target_types [lindex $results_list $i]
set currentIdx [expr $i + 1]
for { set x 0 } { $x < $num_dirflow_target_types } { incr x } {
set nextIdx [Apol_Analysis_dirflow::parseList_get_index_next_node $currentIdx $results_list]
if {$nextIdx == -1} {
return -code error "Error parsing results. See stdout for more information."
}
set currentIdx $nextIdx
}
set i $currentIdx
if {$dir_flow_sel} {
$tra_listbox insert end $parent dir_flows \
-text "Direct Flows Between A and B" \
-open 0 \
-drawcross auto \
-data [lrange $results_list $start_idx $i]
}
set start_idx $i
set num_transflow_types_A [lindex $results_list $i]
set currentIdx [expr $i + 1]
for { set x 0 } { $x < $num_transflow_types_A } { incr x } {
set nextIdx [Apol_Analysis_fulflow::parseList_get_index_next_node $currentIdx $results_list]
if {$nextIdx == -1} {
return -code error "Error parsing Transitive Flow results"
}
set currentIdx $nextIdx
}
set i $currentIdx
if {$trans_flow_AB_sel} {
$tra_listbox insert end $parent trans_flows_A \
-text "Transitive Flows A->B" \
-open 0 \
-drawcross auto \
-data [lrange $results_list $start_idx $i]
}
set start_idx $i
set num_transflow_types_B [lindex $results_list $i]
set currentIdx [expr $i + 1]
for { set x 0 } { $x < $num_transflow_types_B } { incr x } {
set nextIdx [Apol_Analysis_fulflow::parseList_get_index_next_node $currentIdx $results_list]
if {$nextIdx == -1} {
return -code error "Error parsing Transitive Flow results"
}
set currentIdx $nextIdx
}
set i $currentIdx
if {$trans_flow_BA_sel} {
$tra_listbox insert end $parent trans_flows_B \
-text "Transitive Flows B->A" \
-open 0 \
-drawcross auto \
-data [lrange $results_list $start_idx $i]
}
set start_idx $i
set num_dta_types_A [lindex $results_list $i]
set currentIdx [expr $i + 1]
for { set x 0 } { $x < $num_dta_types_A } { incr x } {
set end_idx [Apol_Analysis_dta::get_target_type_data_end_idx $results_list $currentIdx]
if {$end_idx == -1} {
return -code error "Error parsing results for type [lindex $results_list $currentIdx].\nSee stdout for more information."
}
set currentIdx [expr $end_idx + 1]
}
set i $currentIdx
if {$dta_AB_sel} {
$tra_listbox insert end $parent dta_analysis_A \
-text "Domain Transitions A->B" \
-open 0 \
-drawcross auto \
-data [lrange $results_list $start_idx $i]
}
set start_idx $i
set num_dta_types_B [lindex $results_list $i]
set currentIdx [expr $i + 1]
for { set x 0 } { $x < $num_dta_types_B } { incr x } {
set end_idx [Apol_Analysis_dta::get_target_type_data_end_idx $results_list $currentIdx]
if {$end_idx == -1} {
return -code error "Error parsing results for type [lindex $results_list $currentIdx].\nSee stdout for more information."
}
set currentIdx [expr $end_idx + 1]
}
set i $currentIdx
if {$dta_BA_sel} {
$tra_listbox insert end $parent dta_analysis_B \
-text "Domain Transitions B->A" \
-open 0 \
-drawcross auto \
-data [lrange $results_list $start_idx $i]
}
$tra_listbox configure -redraw 1
Apol_Analysis_tra::listSelect $Apol_Analysis_tra::tra_listbox \
$Apol_Analysis_tra::tra_info_text \
[$tra_listbox nodes $parent 0]
return 0
}
proc Apol_Analysis_tra::close { } {
Apol_Analysis_tra::reset_variables
}
proc Apol_Analysis_tra::open { } {
variable attribA
variable attribB
variable combo_typeA
variable combo_typeB
variable combo_attribA
variable combo_attribB
variable cb_attribA
variable cb_attribB
Apol_Analysis_tra::populate_ta_list
Apol_Analysis_tra::initialize_widgets_state
Apol_Analysis_tra::change_types_list $combo_typeA $combo_attribA 1
Apol_Analysis_tra::change_types_list $combo_typeB $combo_attribB 1
}
proc Apol_Analysis_tra::display_mod_options { opts_frame } {
Apol_Analysis_tra::reset_variables
Apol_Analysis_tra::create_options $opts_frame
Apol_Analysis_tra::populate_ta_list
return 0
}
proc Apol_Analysis_tra::get_analysis_info {} {
return $Apol_Analysis_tra::descriptive_text
}
proc Apol_Analysis_tra::get_results_raised_tab {} {
return $Apol_Analysis_tra::tra_info_text
}
proc Apol_Analysis_tra::parse_query_options_list {query_options curr_idx parentDlg} {
variable attribA
variable attribB
variable attribA_sel
variable attribB_sel
variable typeA
variable typeB
variable comm_attribs_sel
variable comm_roles_sel
variable comm_users_sel
variable comm_access_sel
variable unique_access_sel
variable dta_AB_sel
variable dta_BA_sel
variable trans_flow_AB_sel
variable trans_flow_BA_sel
variable dir_flow_sel
variable te_rules_sel
variable tt_rule_sel
variable combo_typeA
variable combo_typeB
variable combo_attribA
variable combo_attribB
variable cb_attribA
variable cb_attribB
Apol_Analysis_tra::reset_variables
set i $curr_idx
while {$i != [llength $query_options]} {
set tmp [string trim [lindex $query_options $i] "\{\}"]
switch -exact -- $tmp {
"typeA" {
incr i
if {[lindex $query_options $i] != "\{\}"} {
set tmp [string trim [lindex $query_options $i] "\{\}"]
set typeA $tmp
}
}
"typeB" {
incr i
if {[lindex $query_options $i] != "\{\}"} {
set tmp [string trim [lindex $query_options $i] "\{\}"]
set typeB $tmp
}
}
"attribA_sel" {
incr i
set attribA_sel [lindex $query_options $i]
}
"attribB_sel" {
incr i
set attribB_sel [lindex $query_options $i]
}
"attribA" {
incr i
if {[lindex $query_options $i] != "\{\}"} {
set tmp [string trim [lindex $query_options $i] "\{\}"]
set attribA $tmp
}
}
"attribB" {
incr i
if {[lindex $query_options $i] != "\{\}"} {
set tmp [string trim [lindex $query_options $i] "\{\}"]
set attribB $tmp
}
}
"comm_attribs_sel" {
incr i
set comm_attribs_sel [lindex $query_options $i]
}
"comm_roles_sel" {
incr i
set comm_roles_sel [lindex $query_options $i]
}
"comm_users_sel" {
incr i
set comm_users_sel [lindex $query_options $i]
}
"comm_access_sel" {
incr i
set comm_access_sel [lindex $query_options $i]
}
"unique_access_sel" {
incr i
set unique_access_sel [lindex $query_options $i]
}
"dta_AB_sel" {
incr i
set dta_AB_sel [lindex $query_options $i]
}
"dta_BA_sel" {
incr i
set dta_BA_sel [lindex $query_options $i]
}
"trans_flow_AB_sel" {
incr i
set trans_flow_AB_sel [lindex $query_options $i]
}
"trans_flow_BA_sel" {
incr i
set trans_flow_BA_sel [lindex $query_options $i]
}
"dir_flow_sel" {
incr i
set dir_flow_sel [lindex $query_options $i]
}
"te_rules_sel" {
incr i
set te_rules_sel [lindex $query_options $i]
}
"tt_rule_sel" {
incr i
set tt_rule_sel [lindex $query_options $i]
}
default {
puts "Error: Unknown query option name encountered ([lindex $query_options $i])."
}
}
incr i
}
Apol_Analysis_tra::config_attrib_comboBox_state \
$cb_attribA $combo_attribA $combo_typeA 0
Apol_Analysis_tra::config_attrib_comboBox_state \
$cb_attribB $combo_attribB $combo_typeB 0
Apol_Analysis_tra::change_types_list $combo_typeA $combo_attribA 0
Apol_Analysis_tra::change_types_list $combo_typeB $combo_attribB 0
return $i
}
proc Apol_Analysis_tra::load_query_options { file_channel parentDlg } {
variable attribA
variable attribB
variable attribA_sel
variable attribB_sel
variable typeA
variable typeB
variable comm_attribs_sel
variable comm_roles_sel
variable comm_users_sel
variable comm_access_sel
variable unique_access_sel
variable dta_AB_sel
variable dta_BA_sel
variable trans_flow_AB_sel
variable trans_flow_BA_sel
variable dir_flow_sel
variable te_rules_sel
variable tt_rule_sel
variable combo_typeA
variable combo_typeB
variable combo_attribA
variable combo_attribB
variable cb_attribA
variable cb_attribB
set query_options_tmp ""
set query_options ""
while {[eof $file_channel] != 1} {
gets $file_channel line
set tline [string trim $line]
if {$tline == ""} {
continue
}
set query_options_tmp [lappend query_options_tmp $tline]
}
if {$query_options_tmp == ""} {
return -code error "No query parameters were found."
}
set query_options_tmp [split [join $query_options_tmp " "] " :"]
set query_options [ApolTop::strip_list_of_empty_items $query_options_tmp]
if {$query_options == ""} {
return -code error "No query parameters were found."
}
Apol_Analysis_tra::parse_query_options_list $query_options 0 $parentDlg
return 0
}
proc Apol_Analysis_tra::get_search_options_list {} {
variable attribA
variable attribB
variable attribA_sel
variable attribB_sel
variable typeA
variable typeB
variable comm_attribs_sel
variable comm_roles_sel
variable comm_users_sel
variable comm_access_sel
variable unique_access_sel
variable dta_AB_sel
variable dta_BA_sel
variable trans_flow_AB_sel
variable trans_flow_BA_sel
variable dir_flow_sel
variable te_rules_sel
variable tt_rule_sel
set options [list \
"typeA:" \
$typeA \
"typeB:" \
$typeB \
"attribA:" \
$attribA \
"attribB:" \
$attribB \
"attribA_sel:" \
$attribA_sel \
"attribB_sel:" \
$attribB_sel \
"comm_attribs_sel:" \
$comm_attribs_sel \
"comm_roles_sel:" \
$comm_roles_sel \
"comm_users_sel:" \
$comm_users_sel \
"comm_access_sel:" \
$comm_access_sel \
"unique_access_sel:" \
$unique_access_sel \
"dta_AB_sel:" \
$dta_AB_sel \
"dta_BA_sel:" \
$dta_BA_sel \
"trans_flow_AB_sel:" \
$trans_flow_AB_sel \
"trans_flow_BA_sel:" \
$trans_flow_BA_sel \
"dir_flow_sel:" \
$dir_flow_sel \
"te_rules_sel:" \
$te_rules_sel \
"tt_rule_sel:" \
$tt_rule_sel]
return $options
}
proc Apol_Analysis_tra::save_query_options {module_name file_channel file_name} {
set options [Apol_Analysis_tra::get_search_options_list]
puts $file_channel "$module_name"
puts $file_channel "$options"
return 0
}
proc Apol_Analysis_tra::get_current_results_state { } {
variable tra_listbox
variable tra_info_text
set options [Apol_Analysis_tra::get_search_options_list]
set options [linsert $options 0 $tra_listbox $tra_info_text]
return $options
}
proc Apol_Analysis_tra::set_display_to_results_state {query_options} {
variable tra_listbox
variable tra_info_text
foreach item $query_options {
set query_options_tmp [lappend query_options_tmp [concat $item]]
}
set query_options_tmp [list $query_options_tmp]
set query_options_tmp [split [join $query_options_tmp " "] " :"]
set query_options_formatted [ApolTop::strip_list_of_empty_items $query_options_tmp]
set parentDlg [ApolTop::get_toplevel_dialog]
set tra_listbox [lindex $query_options_formatted 0]
set tra_info_text [lindex $query_options_formatted 1]
Apol_Analysis_tra::parse_query_options_list $query_options_formatted 2 $parentDlg
Apol_Analysis_tra::configure_tab_label $Apol_Analysis_tra::basic_TabID
Apol_Analysis_tra::configure_tab_label $Apol_Analysis_tra::analysis_TabID
return 0
}
proc Apol_Analysis_tra::free_results_data {query_options} {
set tra_listbox [lindex $query_options 0]
set tra_info_text [lindex $query_options 1]
if {[winfo exists $tra_listbox]} {
$tra_listbox delete [$tra_listbox nodes root]
destroy $tra_listbox
}
if {[winfo exists $tra_info_text]} {
$tra_info_text delete 0.0 end
destroy $tra_info_text
}
return 0
}
proc Apol_Analysis_tra::reset_variables { } {
set Apol_Analysis_tra::attribA_sel 0
set Apol_Analysis_tra::attribB_sel 0
set Apol_Analysis_tra::typeA ""
set Apol_Analysis_tra::typeB ""
set Apol_Analysis_tra::attribA ""
set Apol_Analysis_tra::attribB ""
set Apol_Analysis_tra::comm_attribs_sel 1
set Apol_Analysis_tra::comm_roles_sel 1
set Apol_Analysis_tra::comm_users_sel 1
set Apol_Analysis_tra::comm_access_sel 0
set Apol_Analysis_tra::unique_access_sel 0
set Apol_Analysis_tra::dta_AB_sel 0
set Apol_Analysis_tra::dta_BA_sel 0
set Apol_Analysis_tra::trans_flow_AB_sel 0
set Apol_Analysis_tra::trans_flow_BA_sel 0
set Apol_Analysis_tra::dir_flow_sel 0
set Apol_Analysis_tra::te_rules_sel 0
set Apol_Analysis_tra::tt_rule_sel 0
return 0
}
proc Apol_Analysis_tra::change_types_list {type_cmbox attrib_cmbox clear_type} {
upvar #0 [$attrib_cmbox cget -textvariable] attrib
if {$attrib != ""} {
if {$clear_type} {
$type_cmbox configure -text ""
}
set rt [catch {set attrib_typesList [apol_GetAttribTypesList $attrib]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
}
set attrib_typesList [lsort $attrib_typesList]
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$type_cmbox configure -values $attrib_typesList
} else {
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$type_cmbox configure -values $attrib_typesList
}
return 0
}
proc Apol_Analysis_tra::populate_ta_list { } {
variable combo_typeA
variable combo_typeB
variable combo_attribA
variable combo_attribB
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$combo_typeA configure -values $attrib_typesList
$combo_attribA configure -values $Apol_Types::attriblist
$combo_typeB configure -values $attrib_typesList
$combo_attribB configure -values $Apol_Types::attriblist
return 0
}
proc Apol_Analysis_tra::configure_tab_label {tab} {
variable notebook
variable basic_TabID
variable analysis_TabID
variable comm_attribs_sel
variable comm_roles_sel
variable comm_users_sel
variable comm_access_sel
variable unique_access_sel
variable dta_AB_sel
variable dta_BA_sel
variable trans_flow_AB_sel
variable trans_flow_BA_sel
variable dir_flow_sel
variable te_rules_sel
variable tt_rule_sel
if { $tab == $basic_TabID } {
$notebook itemconfigure $basic_TabID -text $Apol_Analysis_tra::tab1_label
set txt [$notebook itemcget $basic_TabID -text]
if {$comm_attribs_sel || $comm_roles_sel || $comm_users_sel || \
$comm_access_sel || $unique_access_sel || $te_rules_sel || $tt_rule_sel} {
append txt " *"
$notebook itemconfigure $basic_TabID -text $txt
} else {
$notebook itemconfigure $basic_TabID -text $Apol_Analysis_tra::tab1_label
}
} else {
$notebook itemconfigure $analysis_TabID -text $Apol_Analysis_tra::tab2_label
set txt [$notebook itemcget $analysis_TabID -text]
if {$dta_AB_sel || $dta_BA_sel || $trans_flow_AB_sel || $trans_flow_BA_sel || $dir_flow_sel} {
append txt " *"
$notebook itemconfigure $analysis_TabID -text $txt
} else {
$notebook itemconfigure $analysis_TabID -text $Apol_Analysis_tra::tab2_label
}
}
return 0
}
proc Apol_Analysis_tra::config_attrib_comboBox_state {checkbttn attrib_cbox type_cbox change_list} {
upvar #0 [$checkbttn cget -variable] cb_val
upvar #0 [$attrib_cbox cget -textvariable] attrib_val
upvar #0 [$type_cbox cget -textvariable] type_val
if {$cb_val} {
$attrib_cbox configure -state normal -entrybg white
if {$change_list} {
Apol_Analysis_tra::change_types_list $type_cbox $attrib_cbox 1
}
} else {
$attrib_cbox configure -state disabled -entrybg $ApolTop::default_bg_color
set attrib_typesList $Apol_Types::typelist
set idx [lsearch -exact $attrib_typesList "self"]
if {$idx != -1} {
set attrib_typesList [lreplace $attrib_typesList $idx $idx]
}
$type_cbox configure -values $attrib_typesList
}
return 0
}
proc Apol_Analysis_tra::create_resultsDisplay {results_frame} {
variable tra_listbox
variable tra_info_text
set pw [PanedWindow $results_frame.pw -side top]
set pw_tree [$pw add]
set pw_info [$pw add -weight 5]
set frm_tree [TitleFrame [$pw getframe 0].frm_tree -text "Types Relationship Results"]
set frm_info [TitleFrame [$pw getframe 1].frm_info -text "Types Relationship Information"]
set sw_lbox [ScrolledWindow [$frm_tree getframe].sw_lbox -auto none]
set sw_info [ScrolledWindow [$frm_info getframe].sw_info -auto none]
set tra_listbox [Tree [$sw_lbox getframe].tra_listbox \
-relief flat -borderwidth 0 -highlightthickness 0 \
-redraw 0 -bg white -showlines 1 -padx 0]
$sw_lbox setwidget $tra_listbox
set tra_info_text [text [$sw_info getframe].tra_info_text \
-wrap none -bg white -font $ApolTop::text_font]
$sw_info setwidget $tra_info_text
bind $tra_info_text <Enter> {focus %W}
pack $pw -fill both -expand yes -anchor nw
pack $frm_tree -fill both -expand yes -anchor nw
pack $frm_info -fill both -expand yes
pack $sw_lbox -fill both -expand yes
pack $sw_info -fill both -expand yes
$tra_listbox bindText <ButtonPress-1> {Apol_Analysis_tra::listSelect \
$Apol_Analysis_tra::tra_listbox \
$Apol_Analysis_tra::tra_info_text}
$tra_listbox bindText <Double-ButtonPress-1> {Apol_Analysis_tra::listSelect \
$Apol_Analysis_tra::tra_listbox \
$Apol_Analysis_tra::tra_info_text}
return $tra_listbox
}
proc Apol_Analysis_tra::deselect_all_cbs { tab } {
variable basic_TabID
variable analysis_TabID
variable comm_attribs_sel
variable comm_roles_sel
variable comm_users_sel
variable comm_access_sel
variable unique_access_sel
variable dta_AB_sel
variable dta_BA_sel
variable trans_flow_AB_sel
variable trans_flow_BA_sel
variable dir_flow_sel
variable te_rules_sel
variable tt_rule_sel
if { $tab == $basic_TabID } {
set comm_attribs_sel 0
set comm_roles_sel 0
set comm_users_sel 0
set comm_access_sel 0
set unique_access_sel 0
set te_rules_sel 0
set tt_rule_sel 0
} else {
set dta_AB_sel 0
set dta_BA_sel 0
set trans_flow_AB_sel 0
set trans_flow_BA_sel 0
set dir_flow_sel 0
}
Apol_Analysis_tra::configure_tab_label $tab
}
proc Apol_Analysis_tra::select_all_cbs { tab } {
variable basic_TabID
variable analysis_TabID
variable comm_attribs_sel
variable comm_roles_sel
variable comm_users_sel
variable comm_access_sel
variable unique_access_sel
variable dta_AB_sel
variable dta_BA_sel
variable trans_flow_AB_sel
variable trans_flow_BA_sel
variable dir_flow_sel
variable te_rules_sel
variable tt_rule_sel
if { $tab == $basic_TabID } {
set comm_attribs_sel 1
set comm_roles_sel 1
set comm_users_sel 1
set comm_access_sel 1
set unique_access_sel 1
set te_rules_sel 1
set tt_rule_sel 1
} else {
set dta_AB_sel 1
set dta_BA_sel 1
set trans_flow_AB_sel 1
set trans_flow_BA_sel 1
set dir_flow_sel 1
}
Apol_Analysis_tra::configure_tab_label $tab
}
proc Apol_Analysis_tra::create_options { options_frame } {
variable combo_typeA
variable combo_typeB
variable combo_attribA
variable combo_attribB
variable cb_attribA
variable cb_attribB
variable notebook
variable basic_TabID
variable analysis_TabID
set entry_frame [frame $options_frame.entry_frame]
set top_frame [TitleFrame $entry_frame.left_frame \
-text "Required parameters"]
set top [$top_frame getframe]
set types_f [frame $top.types_f]
set ckbttns_f [frame $top.ckbttns_f]
set typeA_frame [frame $types_f.typeA_frame]
set typeB_frame [frame $types_f.typeB_frame]
set type_frame_1 [frame $typeA_frame.type_frame_1]
set type_frame_2 [frame $typeB_frame.type_frame_2]
set attrib_frame_1 [frame $typeA_frame.ckbttns_frame_2]
set attrib_frame_2 [frame $typeB_frame.ckbttns_frame_2]
set notebook [NoteBook $ckbttns_f.nb]
set basic_info_tab [$notebook insert end $basic_TabID -text "Basic"]
set analysis_info_tab [$notebook insert end $analysis_TabID -text "Analysis"]
set lbl_typeA [Label $type_frame_1.lbl_typeA -text "Type A:"]
set lbl_typeB [Label $type_frame_2.lbl_typeB -text "Type B:"]
set lbl_ckbttns [Label $ckbttns_f.lbl_ckbttns \
-text "Search for the following associations between the two types:"]
set combo_typeA [ComboBox $type_frame_1.combo_typeA \
-editable 1 \
-textvariable Apol_Analysis_tra::typeA \
-entrybg white]
set combo_typeB [ComboBox $type_frame_2.combo_typeB \
-editable 1 \
-textvariable Apol_Analysis_tra::typeB \
-entrybg white]
set combo_attribA [ComboBox $attrib_frame_1.combo_attribA \
-editable 1 \
-textvariable Apol_Analysis_tra::attribA \
-entrybg white \
-state disabled]
$combo_attribA configure -modifycmd {Apol_Analysis_tra::change_types_list \
$Apol_Analysis_tra::combo_typeA $Apol_Analysis_tra::combo_attribA 1}
set combo_attribB [ComboBox $attrib_frame_2.combo_attribB \
-editable 1 \
-textvariable Apol_Analysis_tra::attribB \
-entrybg white \
-state disabled]
$combo_attribB configure -modifycmd {Apol_Analysis_tra::change_types_list \
$Apol_Analysis_tra::combo_typeB $Apol_Analysis_tra::combo_attribB 1}
set cb_attribA [checkbutton $attrib_frame_1.cb_attribA \
-text "Filter types to select using attrib:" \
-variable Apol_Analysis_tra::attribA_sel \
-offvalue 0 -onvalue 1]
$cb_attribA configure \
-command "Apol_Analysis_tra::config_attrib_comboBox_state \
$cb_attribA $combo_attribA $combo_typeA 1"
set cb_attribB [checkbutton $attrib_frame_2.cb_attribB \
-text "Filter types to select using attrib:" \
-variable Apol_Analysis_tra::attribB_sel \
-offvalue 0 -onvalue 1]
$cb_attribB configure \
-command "Apol_Analysis_tra::config_attrib_comboBox_state \
$cb_attribB $combo_attribB $combo_typeB 1"
set tab1_frame [$notebook getframe $basic_TabID]
set tab2_frame [$notebook getframe $analysis_TabID]
set tab1_topf [frame $tab1_frame.tab1_topf]
set tab1_botf [frame $tab1_frame.tab1_botf]
set tab2_topf [frame $tab2_frame.tab2_topf]
set tab2_botf [frame $tab2_frame.tab2_botf]
set tab1_lframe [frame $tab1_topf.tab1_lframe]
set tab1_rframe [frame $tab1_topf.tab1_rframe]
set tab2_lframe [frame $tab2_topf.tab2_lframe]
set tab2_rframe [frame $tab2_topf.tab2_rframe]
pack $tab1_lframe $tab1_rframe $tab2_lframe $tab2_rframe -side left -fill both -expand yes -anchor nw
pack $tab1_botf $tab2_botf -side bottom -anchor center
pack $tab1_topf $tab2_topf -side top -anchor nw -fill both -expand yes
set tab1_button1 [Button $tab1_botf.tab1_button1 -text "Select All" \
-helptext "Select All Options" -width 8 \
-command "Apol_Analysis_tra::select_all_cbs $basic_TabID"]
set tab1_button2 [Button $tab1_botf.tab1_button2 -text "Deselect All" \
-helptext "Deselect All Selected Options" -width 8 \
-command "Apol_Analysis_tra::deselect_all_cbs $basic_TabID"]
set tab2_button1 [Button $tab2_botf.tab2_button1 -text "Select All" \
-helptext "Select All Options" -width 8 \
-command "Apol_Analysis_tra::select_all_cbs $analysis_TabID"]
set tab2_button2 [Button $tab2_botf.tab2_button2 -text "Deselect All" \
-helptext "Deselect All Selected Options" -width 8 \
-command "Apol_Analysis_tra::deselect_all_cbs $analysis_TabID"]
set comm_attribs_cb [checkbutton $tab1_lframe.comm_attribs_cb \
-text "Common Attributes" \
-variable Apol_Analysis_tra::comm_attribs_sel \
-command "Apol_Analysis_tra::configure_tab_label $basic_TabID"]
set comm_roles_cb [checkbutton $tab1_lframe.comm_roles_cb \
-text "Common Roles" \
-variable Apol_Analysis_tra::comm_roles_sel \
-command "Apol_Analysis_tra::configure_tab_label $basic_TabID"]
set comm_users_cb [checkbutton $tab1_lframe.comm_users_cb \
-text "Common Users" \
-variable Apol_Analysis_tra::comm_users_sel \
-command "Apol_Analysis_tra::configure_tab_label $basic_TabID"]
set comm_access_cb [checkbutton $tab1_lframe.comm_access_cb \
-text "Common access to resources" \
-variable Apol_Analysis_tra::comm_access_sel \
-command "Apol_Analysis_tra::configure_tab_label $basic_TabID"]
set unique_access_cb [checkbutton $tab1_rframe.unique_access_cb \
-text "Dissimilar access to resources" \
-variable Apol_Analysis_tra::unique_access_sel \
-command "Apol_Analysis_tra::configure_tab_label $basic_TabID"]
set te_rules_cb [checkbutton $tab1_rframe.te_rules_cb \
-text "TE Allow Rules" \
-variable Apol_Analysis_tra::te_rules_sel \
-command "Apol_Analysis_tra::configure_tab_label $basic_TabID"]
set tt_rules_cb [checkbutton $tab1_rframe.tt_rules_cb \
-text "Type Transition/Change Rules" \
-variable Apol_Analysis_tra::tt_rule_sel \
-command "Apol_Analysis_tra::configure_tab_label $basic_TabID"]
set dta_AB_cb [checkbutton $tab2_rframe.dta_AB_cb \
-text "Domain Transitions A->B" \
-variable Apol_Analysis_tra::dta_AB_sel \
-command "Apol_Analysis_tra::configure_tab_label $analysis_TabID"]
set dta_BA_cb [checkbutton $tab2_rframe.dta_BA_cb \
-text "Domain Transitions B->A" \
-variable Apol_Analysis_tra::dta_BA_sel \
-command "Apol_Analysis_tra::configure_tab_label $analysis_TabID"]
set trans_flow_AB_cb [checkbutton $tab2_lframe.trans_flow_AB_cb \
-text "Transitive Flows A->B" \
-variable Apol_Analysis_tra::trans_flow_AB_sel \
-command "Apol_Analysis_tra::configure_tab_label $analysis_TabID"]
set trans_flow_BA_cb [checkbutton $tab2_lframe.trans_flow_BA_cb \
-text "Transitive Flows B->A" \
-variable Apol_Analysis_tra::trans_flow_BA_sel \
-command "Apol_Analysis_tra::configure_tab_label $analysis_TabID"]
set dir_flow_cb [checkbutton $tab2_lframe.dir_flow_cb \
-text "Direct Flows Between A and B" \
-variable Apol_Analysis_tra::dir_flow_sel \
-command "Apol_Analysis_tra::configure_tab_label $analysis_TabID"]
pack $tab1_button1 $tab1_button2 $tab2_button1 $tab2_button2 -anchor nw -side left -fill both -expand yes -padx 2 -pady 2
pack $lbl_typeA $lbl_typeB -side top -anchor nw -padx 2
pack $cb_attribA $cb_attribB -side top -anchor sw -padx 10
pack $combo_typeA $combo_typeB -side left -anchor nw -fill x -expand yes -padx 5
pack $combo_attribA $combo_attribB -side top -anchor sw -padx 10 -fill x -expand yes
pack $notebook -side bottom -anchor nw -fill both -expand yes
pack $entry_frame -side left -anchor nw -fill both -padx 5 -expand yes
pack $top_frame -side left -anchor nw -fill both -padx 5 -expand yes
pack $top -fill both -side top -anchor nw -expand yes
pack $types_f -side top -anchor nw -fill x -expand yes -pady 4
pack $ckbttns_f -side bottom -anchor nw -fill both -pady 8 -expand yes
pack $comm_attribs_cb $comm_roles_cb $comm_users_cb $te_rules_cb $tt_rules_cb \
$comm_access_cb $unique_access_cb -side top -anchor nw -padx 2
pack $dir_flow_cb $trans_flow_AB_cb $trans_flow_BA_cb \
$dta_AB_cb $dta_BA_cb -side top -anchor nw -padx 2
pack $typeA_frame $typeB_frame -side left -anchor nw -expand yes
pack $type_frame_1 $type_frame_2 -side top -anchor nw -fill x -expand yes
pack $attrib_frame_1 $attrib_frame_2 -side bottom -anchor nw -fill x -expand yes -pady 2
pack $lbl_ckbttns -side top -anchor nw -pady 2
bindtags $combo_typeA.e [linsert [bindtags $combo_typeA.e] 3 combo_typeA_Tag]
bind combo_typeA_Tag <KeyPress> \
{ApolTop::_create_popup $Apol_Analysis_tra::combo_typeA %W %K}
bindtags $combo_typeB.e [linsert [bindtags $combo_typeB.e] 3 combo_typeB_Tag]
bind combo_typeB_Tag <KeyPress> \
{ApolTop::_create_popup $Apol_Analysis_tra::combo_typeB %W %K}
bindtags $combo_attribA.e [linsert [bindtags $combo_attribA.e] 3 combo_attribA_Tag]
bind combo_attribA_Tag <KeyPress> \
{ApolTop::_create_popup $Apol_Analysis_tra::combo_attribA %W %K}
bindtags $combo_attribB.e [linsert [bindtags $combo_attribB.e] 3 combo_attribB_Tag]
bind combo_attribB_Tag <KeyPress> \
{ApolTop::_create_popup $Apol_Analysis_tra::combo_attribB %W %K}
Apol_Analysis_tra::initialize_widgets_state
return 0
}
namespace eval ApolTop {
variable bwidget_version ""
variable status ""
variable polversion ""
variable policy_type ""
variable binary_policy_type "binary"
variable source_policy_type "source"
variable filename ""
variable policy_open_option 0
variable policyConf_lineno ""
variable polstats ""
variable gui_ver 2.1
variable copyright_date "2001-2005"
# install_dir is a magical string to be defined via the makefile!
variable apol_install_dir /usr/share/setools
variable recent_files
variable num_recent_files 0
variable most_recent_file -1
variable max_recent_files 5
variable dot_apol_file "[file join "$::env(HOME)" ".apol"]"
variable goto_line_num
variable prevCursor arrow
variable default_bg_color
set default_bg_color [. cget -background]
variable text_font ""
variable title_font ""
variable dialog_font ""
variable general_font ""
variable temp_recent_files ""
variable query_file_ext ".qf"
variable top_width 1000
variable top_height 700
variable libsefs 0
variable helpDlg
set helpDlg .apol_helpDlg
variable searchDlg
set searchDlg .searchDlg
variable goto_Dialog
set goto_Dialog .goto_Dialog
variable options_Dialog
set options_Dialog .options_Dialog
variable mainframe
variable textbox_policyConf
variable searchDlg_entryBox
variable gotoDlg_entryBox
variable notebook
variable components_nb
variable rules_nb
variable searchString ""
variable case_Insensitive 0
variable regExpr 0
variable srch_Direction "down"
variable policy_is_open 0
variable tabName_prefix "Apol_"
variable components_tab "Apol_Components"
variable rules_tab "Apol_Rules"
variable types_tab "Apol_Types"
variable terules_tab "Apol_TE"
variable roles_tab "Apol_Roles"
variable rbac_tab "Apol_RBAC"
variable class_perms_tab "Apol_Class_Perms"
variable users_tab "Apol_Users"
variable initial_sids_tab "Apol_Initial_SIDS"
variable file_contexts_tab "Apol_File_Contexts"
variable cond_bools_tab "Apol_Cond_Bools"
variable cond_rules_tab "Apol_Cond_Rules"
variable policy_conf_tab "Apol_PolicyConf"
variable analysis_tab "Apol_Analysis"
variable tk_msgBox_Wait
variable contents
for {set i 0} {$i<$max_recent_files} {incr i} {
set recent_files($i) ""
}
variable show_fake_attrib_warning 1
}
proc ApolTop::is_policy_open {} {
return $ApolTop::policy_is_open
}
proc ApolTop::get_install_dir {} {
return $ApolTop::apol_install_dir
}
proc ApolTop::get_toplevel_dialog {} {
return $ApolTop::mainframe
}
proc ApolTop::is_binary_policy {} {
if {$ApolTop::policy_type == $ApolTop::binary_policy_type} {
return 1
}
return 0
}
proc ApolTop::load_fc_index_file {} {
set rt [Apol_File_Contexts::load_fc_db]
if {$rt == 1} {
ApolTop::configure_load_index_menu_item 1
}
return 0
}
proc ApolTop::create_fc_index_file {} {
Apol_File_Contexts::display_create_db_dlg
return 0
}
proc ApolTop::load_perm_map_fileDlg {} {
variable mainframe
set rt [Apol_Perms_Map::load_perm_map_fileDlg $mainframe]
if {$rt == 0} {
ApolTop::configure_edit_pmap_menu_item 1
}
return 0
}
proc ApolTop::load_perm_map_mlsDlg {} {
variable mainframe
set rt [Apol_Perms_Map::load_perm_map_mlsDlg $mainframe]
if {$rt == 0} {
ApolTop::configure_edit_pmap_menu_item 1
}
return 0
}
proc ApolTop::load_default_perm_map_Dlg {} {
variable mainframe
set rt [Apol_Perms_Map::load_default_perm_map_Dlg $mainframe]
if {$rt == 0} {
ApolTop::configure_edit_pmap_menu_item 1
}
return 0
}
proc ApolTop::configure_edit_pmap_menu_item {enable} {
variable mainframe
if {$enable} {
[$mainframe getmenu pmap_menu] entryconfigure last -state normal -label "Edit perm map..."
} else {
[$mainframe getmenu pmap_menu] entryconfigure last -state disabled -label "Edit perm map... (Not loaded)"
}
return 0
}
proc ApolTop::configure_load_index_menu_item {enable} {
variable mainframe
if {$enable} {
[$mainframe getmenu fc_index_menu] entryconfigure last -label "Load Index..."
} else {
[$mainframe getmenu fc_index_menu] entryconfigure last -label "Load Index... (Not loaded)"
}
return 0
}
proc ApolTop::strip_list_of_empty_items {list_1} {
global tcl_version
set len [llength $list_1]
set items ""
for {set i 0} {$i < $len} {incr i} {
if {[lindex $list_1 $i] != ""} {
set items [lappend items [lindex $list_1 $i]]
}
}
return $items
}
proc ApolTop::disable_tkListbox { my_list_box } {
global tk_version
if {$tk_version >= "8.4"} {
$my_list_box configure -state disabled
} else {
set class_name [winfo class $my_list_box]
if {$class_name != ""} {
set idx [lsearch -exact [bindtags $my_list_box] $class_name]
if {$idx != -1} {
bindtags $my_list_box [lreplace [bindtags $my_list_box] $idx $idx]
} else {
return
}
} else {
tk_messageBox -parent $ApolTop::mainframe -icon error -type ok -title "Error" -message \
"Could not determine the class name of the widget."
return -1
}
}
return
}
proc ApolTop::enable_tkListbox { my_list_box } {
global tk_version
if { $tk_version >= "8.4"} {
$my_list_box configure -state normal
} else {
set class_name [winfo class $my_list_box]
if {$class_name != ""} {
set idx [lsearch -exact [bindtags $my_list_box] $class_name]
if {$idx != -1} {
return
}
bindtags $my_list_box [linsert [bindtags $my_list_box] 1 $class_name]
} else {
tk_messageBox -parent $ApolTop::mainframe -icon error -type ok -titls "Error" -message \
"Could not determine the class name of the widget."
return -1
}
}
return
}
proc ApolTop::change_comboBox_state {cb_value combo_box} {
selection clear -displayof $combo_box
if {$cb_value} {
$combo_box configure -state normal -entrybg white
} else {
$combo_box configure -state disabled -entrybg $ApolTop::default_bg_color
}
return 0
}
proc ApolTop::popup_listbox_Menu { global x y popup callbacks list_box} {
focus -force $list_box
set selected_item [$list_box get active]
if {$selected_item == ""} {
return
}
set gx [winfo rootx $global]
set gy [winfo rooty $global]
set cmx [expr $gx + $x]
set cmy [expr $gy + $y]
$popup delete 0 end
foreach callback $callbacks {
$popup add command -label "[lindex $callback 0]" -command "[lindex $callback 1] $selected_item"
}
tk_popup $popup $cmx $cmy
return 0
}
proc ApolTop::popup_Tab_Menu { window x y popupMenu callbacks page } {
if {$page == ""} {
return
}
set gx [winfo rootx $window]
set gy [winfo rooty $window]
set cmx [expr $gx + $x]
set cmy [expr $gy + $y]
set page [ApolTop::get_tabname $page]
$popupMenu delete 0 end
foreach callback $callbacks {
$popupMenu add command -label "[lindex $callback 0]" -command "[lindex $callback 1] $page"
}
tk_popup $popupMenu $cmx $cmy
return 0
}
proc ApolTop::get_tabname {tab} {
variable tabName_prefix
set idx [string last ":" $tab]
if {$idx != -1} {
set tab [string range $tab 0 [expr $idx - 1]]
}
set prefix_len [string length $tabName_prefix]
if {[string range $tab 0 $prefix_len] == $tabName_prefix} {
return $tab
}
set tmp $tabName_prefix
set idx [string first "_" $tab]
if {$idx == -1} {
return $tab
}
set tab_fixed [append tmp [string range $tab [expr $idx + 1] end]]
return $tab_fixed
}
proc ApolTop::set_Focus_to_Text { tab } {
variable components_nb
variable rules_nb
variable file_contexts_tab
$ApolTop::mainframe setmenustate Disable_SearchMenu_Tag normal
$ApolTop::mainframe setmenustate Disable_LoadQuery_Tag normal
set ApolTop::policyConf_lineno ""
set tab [ApolTop::get_tabname $tab]
switch -exact -- $tab \
$ApolTop::components_tab {
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag disabled
ApolTop::set_Focus_to_Text [$components_nb raise]
} \
$ApolTop::rules_tab {
ApolTop::set_Focus_to_Text [$rules_nb raise]
} \
$ApolTop::file_contexts_tab {
Apol_File_Contexts::set_Focus_to_Text
} \
$ApolTop::types_tab {
Apol_Types::set_Focus_to_Text
} \
$ApolTop::terules_tab {
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag normal
set raisedPage [Apol_TE::get_results_raised_tab]
if {$raisedPage != ""} {
Apol_TE::set_Focus_to_Text $raisedPage
} else {
focus [$ApolTop::rules_nb getframe $ApolTop::terules_tab]
}
} \
$ApolTop::roles_tab {
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag disabled
Apol_Roles::set_Focus_to_Text
} \
$ApolTop::rbac_tab {
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag disabled
Apol_RBAC::set_Focus_to_Text
} \
$ApolTop::class_perms_tab {
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag disabled
Apol_Class_Perms::set_Focus_to_Text
} \
$ApolTop::users_tab {
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag disabled
Apol_Users::set_Focus_to_Text
} \
$ApolTop::analysis_tab {
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag normal
$ApolTop::mainframe setmenustate Disable_SearchMenu_Tag disabled
set raisedPage [Apol_Analysis::get_results_raised_tab]
if {$raisedPage != ""} {
Apol_Analysis::set_Focus_to_Text $raisedPage
}
} \
$ApolTop::policy_conf_tab {
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag disabled
Apol_PolicyConf::set_Focus_to_Text
} \
$ApolTop::initial_sids_tab {
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag disabled
Apol_Initial_SIDS::set_Focus_to_Text
} \
$ApolTop::cond_bools_tab {
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag disabled
Apol_Cond_Bools::set_Focus_to_Text
} \
$ApolTop::cond_bools_tab {
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag disabled
Apol_Cond_Rules::set_Focus_to_Text
} \
default {
return
}
return 0
}
proc ApolTop::textSearch { w str case_Insensitive regExpr srch_Direction } {
if {$str == ""} {
return 0
}
set case_opt " "
set regExpr_opt " "
set direction_opt " "
if { $case_Insensitive } {
set case_opt "-nocase"
}
if { $regExpr } {
set regExpr_opt "-regexp"
}
if { $srch_Direction == "down" } {
set direction_opt "-forward"
set cur_srch_pos [$w index insert]
} else {
set direction_opt "-backward"
set cur_srch_pos [lindex [$w tag ranges sel] 0]
}
if { $cur_srch_pos == "" } {
set cur_srch_pos "1.0"
}
$w tag remove sel 0.0 end
set cmd "$w search -count cur_srch_pos_length $case_opt $regExpr_opt $direction_opt"
set rt [catch {set cur_srch_pos [eval $cmd {"$str"} $cur_srch_pos] } err]
if { $rt != 0 } {
tk_messageBox -parent $ApolTop::searchDlg -icon error -type ok -title "Search Error" -message \
"$err"
return -1
}
if { $cur_srch_pos == "" } {
set ApolTop::tk_msgBox_Wait \
[tk_messageBox -parent $ApolTop::searchDlg -icon warning -type ok -title "Search Failed" -message \
"Search string not found!"]
vwait ApolTop::tk_msgBox_Wait
} else {
$w mark set insert "$cur_srch_pos + $cur_srch_pos_length char"
$w tag add sel $cur_srch_pos "$cur_srch_pos + $cur_srch_pos_length char"
$w see $cur_srch_pos
}
return 0
}
proc ApolTop::search {} {
variable searchString
variable case_Insensitive
variable regExpr
variable srch_Direction
variable notebook
variable components_nb
variable rules_nb
variable components_tab
variable rules_tab
variable policy_conf_tab
variable analysis_tab
variable file_contexts_tab
set raised_tab [$notebook raise]
switch -- $raised_tab \
$policy_conf_tab {
${policy_conf_tab}::search $searchString $case_Insensitive $regExpr $srch_Direction
} \
$analysis_tab {
${analysis_tab}::search $searchString $case_Insensitive $regExpr $srch_Direction
} \
$rules_tab {
[$rules_nb raise]::search $searchString $case_Insensitive $regExpr $srch_Direction
} \
$components_tab {
[$components_nb raise]::search $searchString $case_Insensitive $regExpr $srch_Direction
} \
$file_contexts_tab {
${file_contexts_tab}::search $searchString $case_Insensitive $regExpr $srch_Direction
} \
default {
puts "Invalid raised tab!"
}
return 0
}
proc ApolTop::getIndexValue { path value } {
set listValues [Widget::getMegawidgetOption $path -values]
return [lsearch -glob $listValues "$value*"]
}
proc ApolTop::_mapliste { path } {
set listb $path.shell.listb
if { [Widget::cget $path -state] == "disabled" } {
return
}
if { [set cmd [Widget::getMegawidgetOption $path -postcommand]] != "" } {
uplevel \#0 $cmd
}
if { ![llength [Widget::getMegawidgetOption $path -values]] } {
return
}
ComboBox::_create_popup $path
ArrowButton::configure $path.a -relief sunken
update
$listb selection clear 0 end
BWidget::place $path.shell [winfo width $path] 0 below $path
wm deiconify $path.shell
raise $path.shell
BWidget::grab local $path
return $listb
}
proc ApolTop::_create_popup { path entryBox key } {
set value [Entry::cget $path.e -text]
set len [string length $value]
if { [string is alpha $key] } {
set idx [ ApolTop::getIndexValue $path $value ]
if { $idx != -1 } {
ApolTop::setSelection $idx $path $entryBox $key
}
}
if { $key == "Return" } {
if {[winfo exists $path.shell.listb] && [winfo viewable $path.shell.listb]} {
set index [$path.shell.listb curselection]
if { $index != -1 } {
if { [ComboBox::setvalue $path @$index] } {
set cmd [Widget::getMegawidgetOption $path -modifycmd]
if { $cmd != "" } {
uplevel \#0 $cmd
}
}
}
ComboBox::_unmapliste $path
focus -force .
}
}
return 0
}
proc ApolTop::tklistbox_select_on_key_callback { path list_items_1 key } {
upvar #0 $list_items_1 list_items
if {$path == ""} {
tk_messageBox \
-icon error \
-type ok \
-title "Error" \
-message "No listbox pathname provided." \
-parent $mainframe
}
if {[string is alpha $key]} {
set low_key_str [string tolower $key]
set matches [lsearch -regexp $list_items "^\[$key$low_key_str\]"]
if {$matches != -1} {
$path selection clear 0 end
$path selection set [lindex $matches 0]
$path see [lindex $matches 0]
}
}
return 0
}
proc ApolTop::setSelection { idx path entryBox key } {
if {$idx != -1} {
set listb [ApolTop::_mapliste $path]
$listb selection set $idx
$listb activate $idx
$listb see $idx
}
return 0
}
proc ApolTop::load_query_info {} {
variable notebook
variable rules_tab
variable terules_tab
variable analysis_tab
variable rules_nb
variable mainframe
set query_file ""
set types {
{"Query files" {$ApolTop::query_file_ext}}
}
set query_file [tk_getOpenFile -filetypes $types -title "Select Query to Load..." \
-defaultextension $ApolTop::query_file_ext -parent $mainframe]
if {$query_file != ""} {
if {[file exists $query_file] == 0 } {
tk_messageBox -icon error -type ok -title "Error" \
-message "File $query_file does not exist." -parent $mainframe
return -1
}
set rt [catch {set f [::open $query_file]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "Cannot open $query_file: $err"
return -1
}
gets $f line
set query_id [string trim $line]
while {[eof $f] != 1} {
if {$query_id == "" || [string compare -length 1 $query_id "#"] == 0} {
gets $f line
set query_id [string trim $line]
continue
}
break
}
switch -- $query_id \
$analysis_tab {
set rt [catch {${analysis_tab}::load_query_options $f $mainframe} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "$err"
return -1
}
$notebook raise $analysis_tab
} \
$terules_tab {
if {[string equal [$rules_nb raise] $ApolTop::terules_tab]} {
set rt [catch {${ApolTop::terules_tab}::load_query_options $f $mainframe} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "$err"
return -1
}
$notebook raise $rules_tab
$rules_nb raise $ApolTop::terules_tab
}
} \
default {
tk_messageBox -icon error -type ok -title "Error" \
-message "Invalid query ID."
}
ApolTop::set_Focus_to_Text [$notebook raise]
::close $f
}
return 0
}
proc ApolTop::save_query_info {} {
variable notebook
variable rules_tab
variable terules_tab
variable analysis_tab
variable rules_nb
variable mainframe
set raised_tab [$notebook raise]
if {![string equal $raised_tab $analysis_tab] && ![string equal $raised_tab $rules_tab]} {
tk_messageBox -icon error -type ok -title "Save Query Error" \
-message "You cannot save a query from this tab! \
You can only save from the Policy Rules->TE Rules tab and the Analysis tab."
return -1
}
if {[string equal $raised_tab $rules_tab] && ![string equal [$rules_nb raise] $terules_tab]} {
tk_messageBox -icon error -type ok -title "Save Query Error" \
-message "You cannot save a query from this tab! \
You can only save from the Policy Rules->TE Rules tab and the Analysis tab."
return -1
}
set query_file ""
set types {
{"Query files" {$ApolTop::query_file_ext}}
}
set query_file [tk_getSaveFile -title "Save Query As?" \
-defaultextension $ApolTop::query_file_ext \
-filetypes $types -parent $mainframe]
if {$query_file != ""} {
set rt [catch {set f [::open $query_file w+]} err]
if {$rt != 0} {
return -code error $err
}
switch -- $raised_tab \
$analysis_tab {
puts $f "$analysis_tab"
set rt [catch {${analysis_tab}::save_query_options $f $query_file} err]
if {$rt != 0} {
::close $f
tk_messageBox -icon error -type ok -title "Save Query Error" \
-message "$err"
return -1
}
} \
$rules_tab {
if {[string equal [$rules_nb raise] $terules_tab]} {
puts $f "$terules_tab"
set rt [catch {${terules_tab}::save_query_options $f $query_file} err]
if {$rt != 0} {
::close $f
tk_messageBox -icon error -type ok -title "Save Query Error" \
-message "$err"
return -1
}
}
} \
default {
::close $f
tk_messageBox -icon error -type ok -title "Save Query Error" \
-message "You cannot save a query from this tab!"
return -1
}
::close $f
}
return 0
}
proc ApolTop::display_searchDlg {} {
variable searchDlg
variable searchDlg_entryBox
global tcl_platform
if { [$ApolTop::notebook raise] == $ApolTop::analysis_tab } {
return
}
if { [winfo exists $searchDlg] } {
raise $searchDlg
focus $searchDlg_entryBox
$searchDlg_entryBox selection range 0 end
return
}
toplevel $searchDlg
wm protocol $searchDlg WM_DELETE_WINDOW " "
wm withdraw $searchDlg
wm title $searchDlg "Find"
if {$tcl_platform(platform) == "windows"} {
wm resizable $ApolTop::searchDlg 0 0
} else {
bind $ApolTop::searchDlg <Configure> { wm geometry $ApolTop::searchDlg {} }
}
set sbox [frame $searchDlg.sbox]
set lframe [frame $searchDlg.lframe]
set rframe [frame $searchDlg.rframe]
set lframe_top [frame $lframe.lframe_top]
set lframe_bot [frame $lframe.lframe_bot]
set lframe_bot_left [frame $lframe_bot.lframe_bot_left]
set lframe_bot_right [frame $lframe_bot.lframe_bot_right]
set lbl_entry [label $lframe_top.lbl_entry -text "Find What:"]
set searchDlg_entryBox [entry $lframe_top.searchDlg_entryBox -bg white -textvariable ApolTop::searchString ]
set b_findNext [button $rframe.b_findNext -text "Find Next" \
-command { ApolTop::search }]
set b_cancel [button $rframe.b_cancel -text "Cancel" \
-command "destroy $searchDlg"]
set cb_case [checkbutton $lframe_bot_left.cb_case -text "Case Insensitive" -variable ApolTop::case_Insensitive]
set cb_regExpr [checkbutton $lframe_bot_left.cb_regExpr -text "Regular Expressions" -variable ApolTop::regExpr]
set directionBox [TitleFrame $lframe_bot_right.directionBox -text "Direction" ]
set dir_up [radiobutton [$directionBox getframe].dir_up -text "Up" -variable ApolTop::srch_Direction \
-value up ]
set dir_down [radiobutton [$directionBox getframe].dir_down -text "Down" -variable ApolTop::srch_Direction \
-value down ]
pack $sbox -expand yes -fill both -padx 5 -pady 5
pack $lframe -expand yes -fill both -padx 5 -pady 5 -side left
pack $rframe -expand yes -fill both -padx 5 -pady 5 -side right
pack $lframe_top -expand yes -fill both -padx 5 -pady 5 -side top
pack $lframe_bot -expand yes -fill both -padx 5 -pady 5 -side bottom
pack $lframe_bot_left -expand yes -fill both -padx 5 -pady 5 -side left
pack $lframe_bot_right -expand yes -fill both -padx 5 -pady 5 -side right
pack $lbl_entry -expand yes -fill both -side left
pack $searchDlg_entryBox -expand yes -fill both -side right
pack $b_findNext $b_cancel -side top -expand yes -fill x
pack $cb_case $cb_regExpr -expand yes -side top -anchor nw
pack $directionBox -side left -expand yes -fill both
pack $dir_up $dir_down -side left -anchor center
wm deiconify $searchDlg
focus $searchDlg_entryBox
$searchDlg_entryBox selection range 0 end
bind $ApolTop::searchDlg <Return> { ApolTop::search }
wm protocol $searchDlg WM_DELETE_WINDOW "destroy $searchDlg"
return 0
}
proc ApolTop::goto_line { line_num textBox } {
variable notebook
if {[string is integer -strict $line_num] != 1} {
tk_messageBox -icon error \
-type ok \
-title "Invalid line number" \
-message "$line_num is not a valid line number"
return 0
}
$textBox tag remove sel 0.0 end
$textBox mark set insert ${line_num}.0
$textBox see ${line_num}.0
$textBox tag add sel $line_num.0 $line_num.end
focus -force $textBox
return 0
}
proc ApolTop::call_tabs_goto_line_cmd { } {
variable goto_line_num
variable notebook
variable components_nb
variable rules_nb
variable components_tab
variable rules_tab
variable policy_conf_tab
variable analysis_tab
variable file_contexts_tab
set raised_tab [$notebook raise]
switch -- $raised_tab \
$policy_conf_tab {
${policy_conf_tab}::goto_line $goto_line_num
} \
$analysis_tab {
${analysis_tab}::goto_line $goto_line_num
} \
$rules_tab {
[$rules_nb raise]::goto_line $goto_line_num
} \
$components_tab {
[$components_nb raise]::goto_line $goto_line_num
} \
$file_contexts_tab {
${file_contexts_tab}::goto_line $goto_line_num
} \
default {
return -code error
}
return 0
}
proc ApolTop::display_options_Dlg { } {
variable options_Dialog
global tcl_platform
if { [winfo exists $options_Dialog] } {
raise $options_Dialog
return 0
}
toplevel $options_Dialog
wm protocol $options_Dialog WM_DELETE_WINDOW " "
wm withdraw $options_Dialog
wm title $options_Dialog "Open Options"
set open_opts_f [TitleFrame $options_Dialog.open_opts_f -text "Open policy options"]
set t_frame [frame [$open_opts_f getframe].t_frame]
set b_frame [frame [$open_opts_f getframe].b_frame]
set lframe [frame $b_frame.lframe]
set rframe [frame $b_frame.rframe]
set lb_textInfo [label $t_frame.lb_textInfo -justify left \
-text "The following are policy options used for opening\
a policy in order to control which parts of the policy are\
loaded.\nPlease note: Conditional booleans and expressions\
will always be loaded. Also, attributes do not apply to a binary\npolicy file.\n"]
set cb_all [radiobutton $lframe.cb_all -text "All" \
-variable ApolTop::policy_open_option -value 0 \
-justify left]
set cb_users [radiobutton $lframe.cb_users -text "Users (includes roles, types and attributes)" \
-variable ApolTop::policy_open_option -value 1 \
-justify left]
set cb_roles [radiobutton $lframe.cb_roles -text "Roles (types and attributes included)" \
-variable ApolTop::policy_open_option -value 2 \
-justify left]
set cb_ta [radiobutton $lframe.cb_ta -text "Types and attributes" \
-variable ApolTop::policy_open_option -value 3 \
-justify left]
set cb_bools [radiobutton $lframe.cb_bools -text "Booleans" \
-variable ApolTop::policy_open_option -value 4 \
-justify left]
set cb_classes_perms [radiobutton $rframe.cb_classes_perms \
-text "Classes and permissions only" \
-variable ApolTop::policy_open_option -value 5 \
-justify left]
set cb_rbac [radiobutton $rframe.cb_rbac -text "RBAC policy (includes roles, role rules,\n\
types, attributes, classes, permissions)" \
-variable ApolTop::policy_open_option -value 6 \
-justify left]
set cb_te [radiobutton $rframe.cb_te -text "TE policy (includes classes, permissions, types,\n\
attributes and TE rules)" \
-variable ApolTop::policy_open_option -value 7 \
-justify left]
set cb_cond [radiobutton $rframe.cb_cond -text "Conditionals (includes conditional TE rules,\
types,\nattributes, classes and permissions)" \
-variable ApolTop::policy_open_option -value 8 \
-justify left]
set cb_sids [radiobutton $rframe.cb_sids -text "Initial SIDs (includes types, attributes, roles, and\n\
users)" \
-variable ApolTop::policy_open_option -value 9 \
-justify left]
set b_ok [button $options_Dialog.b_ok -text "OK" -width 6 -command { destroy $ApolTop::options_Dialog }]
pack $b_ok -side bottom -padx 5 -pady 5 -anchor center
pack $open_opts_f -side left -anchor nw -fill both -expand yes -padx 5 -pady 5
pack $t_frame $b_frame -side top -anchor nw -fill both
pack $lframe $rframe -side left -anchor nw -fill both -expand yes
pack $cb_all $cb_users $cb_roles $cb_ta $cb_classes_perms -side top -anchor nw -expand yes
pack $cb_bools $cb_cond $cb_sids $cb_rbac $cb_te -side top -anchor nw -expand yes
pack $lb_textInfo -side top -anchor nw -fill x
wm deiconify $options_Dialog
wm protocol $options_Dialog WM_DELETE_WINDOW "destroy $options_Dialog"
return 0
}
proc ApolTop::display_goto_line_Dlg { } {
variable notebook
variable goto_Dialog
variable gotoDlg_entryBox
global tcl_platform
if { [$ApolTop::notebook raise] == $ApolTop::analysis_tab } {
return
}
if { [winfo exists $goto_Dialog] } {
raise $goto_Dialog
focus $gotoDlg_entryBox
return 0
}
toplevel $goto_Dialog
wm protocol $goto_Dialog WM_DELETE_WINDOW " "
wm withdraw $goto_Dialog
wm title $goto_Dialog "Goto"
if {$tcl_platform(platform) == "windows"} {
wm resizable $ApolTop::goto_Dialog 0 0
} else {
bind $ApolTop::goto_Dialog <Configure> { wm geometry $ApolTop::goto_Dialog {} }
}
set ApolTop::goto_line_num ""
set gotoDlg_entryBox [entry $goto_Dialog.gotoDlg_entryBox -textvariable ApolTop::goto_line_num -width 10 ]
set lbl_goto [label $goto_Dialog.lbl_goto -text "Goto:"]
set b_ok [button $goto_Dialog.ok -text "OK" -width 6 -command { ApolTop::call_tabs_goto_line_cmd; destroy $ApolTop::goto_Dialog}]
set b_cancel [button $goto_Dialog.cancel -text "Cancel" -width 6 -command { destroy $ApolTop::goto_Dialog }]
pack $lbl_goto $gotoDlg_entryBox -side left -padx 5 -pady 5 -anchor nw
pack $b_ok $b_cancel -side left -padx 5 -pady 5 -anchor ne
wm deiconify $goto_Dialog
focus $gotoDlg_entryBox
bind $ApolTop::goto_Dialog <Return> { ApolTop::call_tabs_goto_line_cmd; destroy $ApolTop::goto_Dialog }
wm protocol $goto_Dialog WM_DELETE_WINDOW "destroy $goto_Dialog"
return 0
}
proc ApolTop::check_libsefs {} {
set rt [catch {set ret [apol_IsLibsefs_BuiltIn]} err]
if {$rt != 0} {
return -code error $err
}
set ApolTop::libsefs $ret
return 0
}
proc ApolTop::create { } {
variable notebook
variable mainframe
variable components_nb
variable rules_nb
variable bwidget_version
set descmenu {
"&File" {} file 0 {
{command "&Open..." {} "Open a new policy" {} -command ApolTop::openPolicy}
{command "&Close" {} "Close an opened polocy" {} -command ApolTop::closePolicy}
{separator}
{command "E&xit" {} "Exit policy analysis tool" {} -command ApolTop::apolExit}
{separator}
{cascad "&Recent files" {} recent 0 {}}
}
"&Search" {} search 0 {
{command "&Find... (C-s)" {Disable_SearchMenu_Tag} "Find" \
{} -command ApolTop::display_searchDlg }
{command "&Goto Line... (C-g)" {Disable_SearchMenu_Tag} "Goto Line" \
{} -command ApolTop::display_goto_line_Dlg }
}
"&Query" {} query 0 {
{command "&Load query..." {Disable_LoadQuery_Tag} "Load query" \
{} -command "ApolTop::load_query_info" }
{command "&Save query..." {Disable_SaveQuery_Tag} "Save query" \
{} -command "ApolTop::save_query_info" }
{separator}
{command "&Policy Summary" {Disable_Summary} "Display summary statics" {} -command ApolTop::popupPolicyStats }
}
"&Advanced" all options 0 {
{cascad "&Permission Mappings" {Perm_Map_Tag} pmap_menu 0 {}}
}
"&Help" {} helpmenu 0 {
{command "&General Help" {all option} "Show help" {} -command {ApolTop::helpDlg "Help" "apol_help.txt"}}
{command "&Domain Transition Analysis" {all option} "Show help" {} -command {ApolTop::helpDlg "Domain Transition Analysis Help" "dta_help.txt"}}
{command "&Information Flow Analysis" {all option} "Show help" {} -command {ApolTop::helpDlg "Information Flow Analysis Help" "iflow_help.txt"}}
{command "&Relabel Analysis" {all option} "Show help" {} -command {ApolTop::helpDlg "Relabel Analysis Help" "file_relabel_help.txt"}}
{command "&Types Relationship Summary Analysis" {all option} "Show help" {} -command {ApolTop::helpDlg "Types Relationship Summary Analysis Help" "types_relation_help.txt"}}
{separator}
{command "&About" {all option} "Show about box" {} -command ApolTop::aboutBox}
}
}
set mainframe [MainFrame .mainframe -menu $descmenu -textvariable ApolTop::status]
[$mainframe getmenu pmap_menu] insert 0 command -label "Edit perm map... (Not loaded)" -command "Apol_Perms_Map::display_perm_mappings_Dlg"
[$mainframe getmenu pmap_menu] insert 0 separator
[$mainframe getmenu pmap_menu] insert 0 command -label "Load Perm Map from MLS file..." -command "ApolTop::load_perm_map_mlsDlg"
[$mainframe getmenu pmap_menu] insert 0 command -label "Load Perm Map from file..." -command "ApolTop::load_perm_map_fileDlg"
[$mainframe getmenu pmap_menu] insert 0 separator
[$mainframe getmenu pmap_menu] insert 0 command -label "Load Default Perm Map" -command "ApolTop::load_default_perm_map_Dlg"
$mainframe addindicator -textvariable ApolTop::policyConf_lineno -width 14
$mainframe addindicator -textvariable ApolTop::polstats -width 88
$mainframe addindicator -textvariable ApolTop::polversion -width 19
$ApolTop::mainframe setmenustate Disable_SearchMenu_Tag disabled
$ApolTop::mainframe setmenustate Perm_Map_Tag disabled
$ApolTop::mainframe setmenustate FC_Index_Tag normal
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag disabled
$ApolTop::mainframe setmenustate Disable_LoadQuery_Tag disabled
$ApolTop::mainframe setmenustate Disable_Summary disabled
set frame [$mainframe getframe]
set notebook [NoteBook $frame.nb]
set components_frame [$notebook insert end $ApolTop::components_tab -text "Policy Components"]
set rules_frame [$notebook insert end $ApolTop::rules_tab -text "Policy Rules"]
if {$ApolTop::libsefs == 1} {
Apol_File_Contexts::create $notebook
}
Apol_Analysis::create $notebook
Apol_PolicyConf::create $notebook
set components_nb [NoteBook $components_frame.components_nb]
set rules_nb [NoteBook $rules_frame.rules_nb]
Apol_Types::create $components_nb
Apol_Class_Perms::create $components_nb
Apol_Roles::create $components_nb
Apol_Users::create $components_nb
Apol_Cond_Bools::create $components_nb
Apol_Initial_SIDS::create $components_nb
Apol_TE::create $rules_nb
Apol_Cond_Rules::create $rules_nb
Apol_RBAC::create $rules_nb
$components_nb compute_size
pack $components_nb -fill both -expand yes -padx 4 -pady 4
$components_nb raise [$components_nb page 0]
$components_nb bindtabs <Button-1> { ApolTop::set_Focus_to_Text }
$rules_nb compute_size
pack $rules_nb -fill both -expand yes -padx 4 -pady 4
$rules_nb raise [$rules_nb page 0]
$rules_nb bindtabs <Button-1> { ApolTop::set_Focus_to_Text }
bind . <Control-s> {ApolTop::display_searchDlg}
bind . <Control-g> {ApolTop::display_goto_line_Dlg}
$notebook compute_size
pack $notebook -fill both -expand yes -padx 4 -pady 4
$notebook raise [$notebook page 0]
$notebook bindtabs <Button-1> { ApolTop::set_Focus_to_Text }
pack $mainframe -fill both -expand yes
return 0
}
proc ApolTop::writeInitFile { } {
variable dot_apol_file
variable num_recent_files
variable recent_files
variable text_font
variable title_font
variable dialog_font
variable general_font
variable policy_open_option
set rt [catch {set f [open $dot_apol_file w+]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "$err"
return
}
puts $f "recent_files"
puts $f $num_recent_files
for {set i 0} {$i < $num_recent_files} {incr i} {
puts $f $recent_files($i)
}
array unset recent_files
puts $f "\n"
puts $f "# Font format: family ?size? ?style? ?style ...?"
puts $f "# Possible values for the style arguments are as follows:"
puts $f "# normal bold roman italic underline overstrike\n#\n#"
puts $f "# NOTE: When configuring fonts, remember to remove the following "
puts $f "# \[window height\] and \[window width\] entries before starting apol. "
puts $f "# Not doing this may cause widgets to be obscured when running apol."
puts $f "\[general_font\]"
if {$general_font == ""} {
puts $f "Helvetica 10"
} else {
puts $f "$general_font"
}
puts $f "\[title_font\]"
if {$title_font == ""} {
puts $f "Helvetica 10 bold italic"
} else {
puts $f "$title_font"
}
puts $f "\[dialog_font\]"
if {$dialog_font == ""} {
puts $f "Helvetica 10"
} else {
puts $f "$dialog_font"
}
puts $f "\[text_font\]"
if {$text_font == ""} {
puts $f "fixed"
} else {
puts $f "$text_font"
}
puts $f "\[window_height\]"
puts $f [winfo height .]
puts $f "\[window_width\]"
puts $f [winfo width .]
puts $f "\[policy_open_option\]"
puts $f $policy_open_option
puts $f "\[show_fake_attrib_warning\]"
puts $f $ApolTop::show_fake_attrib_warning
close $f
return 0
}
proc ApolTop::readInitFile { } {
variable dot_apol_file
variable max_recent_files
variable recent_files
variable text_font
variable title_font
variable dialog_font
variable general_font
variable temp_recent_files
variable top_height
variable top_width
variable policy_open_option
if {[file exists $dot_apol_file] == 0 } {
return
}
set rt [catch {set f [open $dot_apol_file]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "Cannot open .apol file ($rt: $err)"
return
}
set max_recent_flag 0
set recent_files_flag 0
gets $f line
set tline [string trim $line]
while {1} {
if {[eof $f] && $tline == ""} {
break
}
if {[string compare -length 1 $tline "#"] == 0 || [string is space $tline]} {
gets $f line
set tline [string trim $line]
continue
}
switch $tline {
"\[window_height\]" {
gets $f line
set tline [string trim $line]
if {[eof $f] == 1 && $tline == ""} {
puts "EOF reached trying to read window_height."
continue
}
if {[string is integer $tline] != 1} {
puts "window_height was not given as an integer ($line) and is ignored"
break
}
set top_height $tline
}
"\[window_width\]" {
gets $f line
set tline [string trim $line]
if {[eof $f] == 1 && $tline == ""} {
puts "EOF reached trying to read window_width."
continue
}
if {[string is integer $tline] != 1} {
puts "window_width was not given as an integer ($line) and is ignored"
break
}
set top_width $tline
}
"\[title_font\]" {
gets $f line
set tline [string trim $line]
if {[eof $f] == 1 && $tline == ""} {
puts "EOF reached trying to read title font."
continue
}
set title_font $tline
}
"\[dialog_font\]" {
gets $f line
set tline [string trim $line]
if {[eof $f] == 1 && $tline == ""} {
puts "EOF reached trying to read dialog font."
continue
}
set dialog_font $tline
}
"\[text_font\]" {
gets $f line
set tline [string trim $line]
if {[eof $f] == 1 && $tline == ""} {
puts "EOF reached trying to read text font."
continue
}
set text_font $tline
}
"\[general_font\]" {
gets $f line
set tline [string trim $line]
if {[eof $f] == 1 && $tline == ""} {
puts "EOF reached trying to read general font."
continue
}
set general_font $tline
}
"\[policy_open_option\]" {
gets $f line
set tline [string trim $line]
if {[eof $f] == 1 && $tline == ""} {
puts "EOF reached trying to read open policy option."
continue
}
set policy_open_option $tline
}
"\[show_fake_attrib_warning\]" {
gets $f line
set tline [string trim $line]
if {[eof $f] == 1 && $tline == ""} {
puts "EOF reached trying to read show_fake_attrib_warning"
continue
}
set ApolTop::show_fake_attrib_warning $tline
}
"max_recent_files" {
if {$recent_files_flag == 1} {
puts "Key word max_recent_files found after recent file names read; ignored"
gets $ line
continue
}
if {$max_recent_flag == 1} {
puts "Key word max_recent_flag found twice in file!"
continue
}
set max_recent_flag 1
gets $f line
set tline [string trim $line]
if {[eof $f] == 1 && $tline == ""} {
puts "EOF reached trying to read max_recent_file."
continue
}
if {[string is integer $tline] != 1} {
puts "max_recent_files was not given as an integer ($line) and is ignored"
} else {
if {$tline>10} {
set max_recent_files 10
} elseif {$tline < 2} {
set max_recent_files 2
}
else {
set max_recent_files $tline
}
}
}
"recent_files" {
if {$recent_files_flag == 1} {
puts "Key word recent_files found twice in file!"
continue
}
set recent_files_flag 1
gets $f line
set tline [string trim $line]
if {[eof $f] == 1 && $tline == ""} {
puts "EOF reached trying to read num of recent files."
continue
}
if {[string is integer $tline] != 1} {
puts "number of recent files was not given as an integer ($line) and is ignored"
break
} elseif {$tline < 0} {
puts "number of recent was less than 0 and is ignored"
break
}
set num $tline
for {set i 0} {$i<$num} {incr i} {
gets $f line
set tline [string trim $line]
if {[eof $f] == 1 && $tline == ""} {
puts "EOF reached trying to read recent file name $num."
break
}
if {[string is space $tline]} {
continue
}
if {$i >= $max_recent_files} {
continue
}
set temp_recent_files [lappend temp_recent_files $tline]
}
}
default {
puts "Unrecognized line in .apol: $line"
}
}
gets $f line
set tline [string trim $line]
}
close $f
return 0
}
proc ApolTop::addRecent {file} {
variable mainframe
variable recent_files
variable num_recent_files
variable max_recent_files
variable most_recent_file
if {$num_recent_files < $max_recent_files} {
set x $num_recent_files
set less_than_max 1
} else {
set x $max_recent_files
set less_than_max 0
}
for {set i 0} {$i < $x } {incr i} {
if {[string equal $file $recent_files($i)]} {
return
}
}
if {![file exists $file]} {
return
}
if {$num_recent_files < $max_recent_files} {
set recent_files($num_recent_files) $file
[$mainframe getmenu recent] insert $num_recent_files command -label "$recent_files($num_recent_files)" -command "ApolTop::openPolicyFile $recent_files($num_recent_files) 0"
incr num_recent_files
} else {
[$mainframe getmenu recent] delete 0 end
set oldest [expr $max_recent_files - 1]
set recent_files_tmp($most_recent_file) $file
[$mainframe getmenu recent] insert $most_recent_file command -label "$recent_files_tmp($most_recent_file)" -command "ApolTop::openPolicyFile $recent_files_tmp($most_recent_file) 0"
for {set i 0} {$i < [expr $max_recent_files - 1]} {incr i} {
set next [expr $i + 1]
set recent_files_tmp($next) $recent_files($i)
[$mainframe getmenu recent] insert $next command -label "$recent_files_tmp($next)" -command "ApolTop::openPolicyFile $recent_files_tmp($next) 0"
}
array set recent_files [array get recent_files_tmp]
array unset recent_files_tmp
set most_recent_file 0
}
return 0
}
proc ApolTop::helpDlg {title file_name} {
variable contents
variable helpDlg
set helpDlg .apol_helpDlg
if { [winfo exists $helpDlg] } {
destroy $helpDlg
}
toplevel $helpDlg
wm protocol $helpDlg WM_DELETE_WINDOW " "
wm withdraw $helpDlg
wm title $helpDlg "$title"
set hbox [frame $helpDlg.hbox ]
set sw [ScrolledWindow $hbox.sw -auto none]
set resultsbox [text [$sw getframe].text -bg white -wrap none -font $ApolTop::text_font]
$sw setwidget $resultsbox
set okButton [Button $hbox.okButton -text "Close" \
-command "destroy $helpDlg"]
set script_dir [apol_GetScriptDir "$file_name"]
set helpfile "$script_dir/$file_name"
pack $hbox -expand yes -fill both -padx 5 -pady 5
pack $okButton -side bottom
pack $sw -side left -expand yes -fill both
wm deiconify $helpDlg
$resultsbox delete 1.0 end
set rt [catch {set f [open $helpfile]} err]
if {$rt != 0} {
$resultsbox insert end $err
} else {
$resultsbox insert end [read $f]
close $f
}
ApolTop::makeTextBoxReadOnly $resultsbox
wm protocol $helpDlg WM_DELETE_WINDOW "destroy $helpDlg"
return
}
proc ApolTop::makeTextBoxReadOnly {w} {
$w mark set insert 0.0
$w mark set anchor insert
$w configure -state disabled
focus -force $w
return 0
}
proc ApolTop::setBusyCursor {} {
variable prevCursor
set prevCursor [. cget -cursor]
. configure -cursor watch
update idletasks
return
}
proc ApolTop::resetBusyCursor {} {
variable prevCursor
. configure -cursor $prevCursor
update idletasks
return
}
proc ApolTop::popupPolicyStats {} {
variable polversion
variable policy_type
variable contents
set rt [catch {set pstats [apol_GetStats]}]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" \
-message "No policy file currently opened"
return
}
foreach item $pstats {
set rt [scan $item "%s %d" key val]
if {$rt != 2} {
tk_messageBox -icon error -type ok -title "Error" -message "apol_GetStats: $rt"
return
}
set stats($key) $val
}
# (for now, only perms and classes are optionally collected (really a compile time option!)
if {$contents(classes) == 0} {
set classes "not collected"
} else {
set classes $stats(classes)
}
if {$contents(perms) == 0 } {
set perms "not collected"
set common_perms "not collected"
} else {
set common_perms $stats(common_perms)
set perms $stats(perms)
}
set w .polstatsbox
catch {destroy $w}
toplevel $w
label $w.1 -justify left \
-text "Policy Summary Statistics\n "
set labelf [frame $w.labelf]
set left_text "\
Policy Version:\n\
Policy Type:\n\n\
Number of Classes and Permissions\n\
\tObject Classes:\n\
\tCommon Perms:\n\
\tPermissions:\n\n\
Number of Types and Attributes:\n\
\tTypes:\n\
\tAttributes:\n\n\
Number of Type Enforcement Rules:\n\
\tallow:\n\
\tneverallow:\n\
\tclone (pre v.11):\n\
\ttype_transition.:\n\
\ttype_change:\n\
\ttype_member:\n\
\tauditallow:\n\
\tauditdeny:\n\
\tdontaudit:\n\n\
Number of Roles:\n\
\tRoles:\n\n\
Number of RBAC Rules:\n\
\tallow:\n\
\trole_transition:\n\n\
Number of Users:\n\
\tusers:\n\n\
Number of Initial SIDs:\n\
\tSIDs:\n\n\
Number of Booleans:\n\
\tBools:\n"
set right_text "\
$polversion\n\
$policy_type\n\n\
\n\
$classes\n\
$common_perms\n\
$perms\n\n\
\n\
$stats(types)\n\
$stats(attribs)\n\n\
\n\
$stats(teallow)\n\
$stats(neverallow)\n\
$stats(clone)\n\
$stats(tetrans)\n\
$stats(techange)\n\
$stats(temember)\n\
$stats(auditallow)\n\
$stats(auditdeny)\n\
$stats(dontaudit)\n\n\
\n\
$stats(roles)\n\n\
\n\
$stats(roleallow)\n\
$stats(roletrans)\n\n\
\n\
$stats(users)\n\n\
\n\
$stats(sids)\n\n\
\n\
$stats(cond_bools)\n"
set left_label [label $labelf.left -justify left -text $left_text]
set right_label [label $labelf.right -justify left -text $right_text]
button $w.close -text Close -command "catch {destroy $w}" -width 10
pack $w.close -side bottom -anchor center
pack $w.1 -side top -anchor center
pack $labelf -side top -anchor nw -fill both -expand yes -padx 5 -pady 5
pack $left_label $right_label -side left -anchor nw -fill both -expand yes
wm title $w "Policy Summary"
wm iconname $w "policy summary"
wm geometry $w +50+60
return
}
proc ApolTop::showPolicyStats {} {
variable polstats
variable contents
set rt [catch {set pstats [apol_GetStats]}]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title \
-message "No policy file currently opened"
return
}
foreach item $pstats {
set rt [scan $item "%s %d" key val]
if {$rt != 2} {
tk_messageBox -icon error -type ok -title "Error" -message "apol_GetStats: $rt"
return
}
set stats($key) $val
}
set polstats ""
if {$contents(classes) == 1} {
append polstats "Classes: $stats(classes) "
}
if {$contents(perms) == 1} {
append polstats "Perms: $stats(perms) "
}
append polstats "Types: $stats(types) Attribs: $stats(attribs) "
append polstats "TE rules: [expr $stats(teallow) + $stats(neverallow) + \
$stats(auditallow) + $stats(auditdeny) + $stats(clone) + $stats(dontaudit) + \
$stats(tetrans) + $stats(temember) + $stats(techange)] "
append polstats "Roles: $stats(roles)"
append polstats " Users: $stats(users)"
return
}
proc ApolTop::aboutBox {} {
variable gui_ver
variable copyright_date
set lib_ver [apol_GetVersion]
tk_messageBox -icon info -type ok -title "About SELinux Policy Analysis Tool" -message \
"Security Policy Analysis Tool for Security Enhanced Linux \n\nCopyright (c) $copyright_date\nTresys Technology, LLC\nwww.tresys.com/selinux\n\nGUI Version ($gui_ver)\nLib Version ($lib_ver)"
return
}
proc ApolTop::unimplemented {} {
tk_messageBox -icon warning \
-type ok \
-title "Unimplemented" \
-message \
"This command is not currently implemented."
return
}
proc ApolTop::closePolicy {} {
variable contents
variable filename
variable polstats
variable polversion
variable policy_is_open
set polversion ""
set filename ""
set polstats ""
set contents(classes) 0
set contents(perms) 0
set contents(types) 0
set contents(te_tules) 0
set contents(roles) 0
set contents(rbac) 0
set contents(users) 0
array unset contents
wm title . "SE Linux Policy Analysis"
Apol_Perms_Map::close $ApolTop::mainframe
Apol_Class_Perms::close
Apol_Types::close
Apol_TE::close
Apol_Roles::close
Apol_RBAC::close
Apol_Users::close
Apol_Initial_SIDS::close
Apol_Cond_Bools::close
Apol_Cond_Rules::close
Apol_Analysis::close
Apol_PolicyConf::close
ApolTop::set_Focus_to_Text [$ApolTop::notebook raise]
set rt [catch {apol_ClosePolicy} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error closing policy" \
-message "There was an error closing the policy: $err."
}
set policy_is_open 0
$ApolTop::mainframe setmenustate Disable_SearchMenu_Tag disabled
$ApolTop::mainframe setmenustate Perm_Map_Tag disabled
$ApolTop::mainframe setmenustate Disable_SaveQuery_Tag disabled
$ApolTop::mainframe setmenustate Disable_LoadQuery_Tag disabled
$ApolTop::mainframe setmenustate Disable_Summary disabled
ApolTop::enable_non_binary_tabs
ApolTop::enable_disable_conditional_widgets 1
ApolTop::configure_edit_pmap_menu_item 0
return 0
}
proc ApolTop::open_apol_modules {file} {
set rt [catch {Apol_Class_Perms::open} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {Apol_Types::open} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {Apol_TE::open} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {Apol_Roles::open} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {Apol_RBAC::open} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {Apol_Users::open} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {Apol_Initial_SIDS::open} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {Apol_Cond_Bools::open} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {Apol_Cond_Rules::open} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {Apol_Analysis::open} err]
if {$rt != 0} {
return -code error $err
}
set rt [catch {Apol_PolicyConf::open $file} err]
if {$rt != 0} {
return -code error $err
}
return 0
}
proc ApolTop::enable_disable_conditional_widgets {enable} {
set tab [$ApolTop::notebook raise]
switch -exact -- [ApolTop::get_tabname $tab] \
$ApolTop::components_tab {
if {[ApolTop::get_tabname [$ApolTop::components_nb raise]] == $ApolTop::cond_bools_tab} {
if {$enable} {
$ApolTop::components_nb raise $ApolTop::cond_bools_tab
} else {
set name [ApolTop::get_tabname [$ApolTop::components_nb pages 0]]
$ApolTop::components_nb raise $name
}
}
} \
$ApolTop::rules_tab {
if {[ApolTop::get_tabname [$ApolTop::rules_nb raise]] == $ApolTop::cond_rules_tab} {
if {$enable} {
$ApolTop::rules_nb raise $ApolTop::cond_rules_tab
} else {
set name [ApolTop::get_tabname [$ApolTop::rules_nb pages 0]]
$ApolTop::rules_nb raise $name
}
}
} \
default {
}
if {$enable} {
$ApolTop::components_nb itemconfigure $ApolTop::cond_bools_tab -state normal
$ApolTop::rules_nb itemconfigure $ApolTop::cond_rules_tab -state normal
} else {
$ApolTop::components_nb itemconfigure $ApolTop::cond_bools_tab -state disabled
$ApolTop::rules_nb itemconfigure $ApolTop::cond_rules_tab -state disabled
}
Apol_TE::enable_disable_conditional_widgets $enable
return 0
}
proc ApolTop::enable_non_binary_tabs {} {
$ApolTop::components_nb itemconfigure $ApolTop::initial_sids_tab -state normal
$ApolTop::notebook itemconfigure $ApolTop::policy_conf_tab -state normal
}
proc ApolTop::disable_non_binary_tabs {} {
if {[ApolTop::get_tabname [$ApolTop::notebook raise]] == $ApolTop::policy_conf_tab} {
set name [ApolTop::get_tabname [$ApolTop::notebook pages 0]]
$ApolTop::notebook raise $name
}
$ApolTop::components_nb itemconfigure $ApolTop::initial_sids_tab -state disabled
$ApolTop::notebook itemconfigure $ApolTop::policy_conf_tab -state disabled
return 0
}
proc ApolTop::set_initial_open_policy_state {} {
set rt [catch {set version_num [apol_GetPolicyVersionNumber]} err]
if {$rt != 0} {
return -code error $err
}
if {$version_num < 16} {
ApolTop::enable_disable_conditional_widgets 0
}
if {[ApolTop::is_binary_policy]} {
if {$version_num >= 20 } {
if {$ApolTop::show_fake_attrib_warning != 0} {
set fake_attrib_warn .fakeattribDlg
Dialog $fake_attrib_warn -modal local -parent . \
-title "Warning - Attribute Names"
set message_text "Warning: Apol has created fake attribute names because
the names are not preserved in the binary policy format."
set fake_attrib_label [label $fake_attrib_warn.l -text $message_text]
set fake_attrib_ok [button $fake_attrib_warn.b_ok -text "OK" \
-command "destroy $fake_attrib_warn"]
set fake_attrib_show [checkbutton $fake_attrib_warn.show_cb \
-text "Show this message again next time." \
-variable ApolTop::show_fake_attrib_warning]
$fake_attrib_show select
pack $fake_attrib_label -side top -padx 10 -pady 10
pack $fake_attrib_show -side top -pady 10
pack $fake_attrib_ok -side top -padx 10 -pady 10
$fake_attrib_warn draw
}
}
ApolTop::disable_non_binary_tabs
}
ApolTop::set_Focus_to_Text [$ApolTop::notebook raise]
$ApolTop::mainframe setmenustate Perm_Map_Tag normal
$ApolTop::mainframe setmenustate Disable_Summary normal
$ApolTop::mainframe setmenustate Disable_SearchMenu_Tag normal
return 0
}
proc ApolTop::openPolicyFile {file recent_flag} {
variable contents
variable polversion
variable policy_type
variable policy_is_open
variable filename
variable policy_open_option
ApolTop::closePolicy
set file [file nativename $file]
if {![file exists $file]} {
tk_messageBox -icon error \
-type ok \
-title "File Does Not Exist" \
-message "File ($file) does not exist."
return -1
}
if { ![file readable $file] } {
tk_messageBox -icon error \
-type ok \
-title "Permission Problem" \
-message \
"You do not have permission to read $file."
return -1
}
if {[file isdirectory $file]} {
tk_messageBox -icon error \
-type ok \
-title "File is Directory" \
-message \
"$file is a directory."
return -1
}
set orig_Cursor [. cget -cursor]
. configure -cursor watch
update idletasks
set rt [catch {apol_OpenPolicy $file $policy_open_option} err]
if {$rt == 0} {
set filename $file
} elseif {$rt == -6} {
tk_messageBox -icon error -type ok -title "Error with policy file" \
-message "Pre-version 19 MLS is not supported.\n\n$err"
. configure -cursor $orig_Cursor
focus -force .
return -1
} else {
tk_messageBox -icon error -type ok -title "Error with policy file" \
-message "The selected file does not appear to be a valid SE Linux Policy.\n\n$err"
. configure -cursor $orig_Cursor
focus -force .
return -1
}
set rt [catch {set polversion [apol_GetPolicyVersionString]}]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "apol_GetPolicyVersionString: $rt"
return 0
}
set rt [catch {set policy_type [apol_GetPolicyType]}]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "apol_GetPolicyType: $rt"
return 0
}
set polversion [append polversion " \($policy_type)"]
set rt [catch {set con [apol_GetPolicyContents]} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return 0
}
foreach item $con {
set rt [scan $item "%s %d" key val]
if {$rt != 2} {
tk_messageBox -icon error -type ok -title "Error" -message "openPolicy (getting contents): $rt"
return
}
set contents($key) $val
}
ApolTop::showPolicyStats
set rt [catch {ApolTop::open_apol_modules $file} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return $rt
}
set rt [catch {ApolTop::set_initial_open_policy_state} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return $rt
}
set policy_is_open 1
if {$recent_flag == 1} {
ApolTop::addRecent $file
}
. configure -cursor $orig_Cursor
focus -force .
wm title . "SE Linux Policy Analysis - $file"
return 0
}
proc ApolTop::openPolicy {} {
variable filename
variable polversion
set progressval 0
set file ""
set types {
{"All files" *}
{"Policy conf files" {.conf}}
}
if {$filename != ""} {
catch [set file [tk_getOpenFile -filetypes $types -initialdir [file dirname $filename]]]
} else {
catch [set file [tk_getOpenFile -filetypes $types]]
}
if {$file != ""} {
ApolTop::openPolicyFile $file 1
}
return
}
proc ApolTop::free_call_back_procs { } {
Apol_Class_Perms::free_call_back_procs
Apol_Types::free_call_back_procs
Apol_TE::free_call_back_procs
Apol_Roles::free_call_back_procs
Apol_RBAC::free_call_back_procs
Apol_Users::free_call_back_procs
Apol_Initial_SIDS::free_call_back_procs
Apol_Analysis::free_call_back_procs
Apol_PolicyConf::free_call_back_procs
Apol_Cond_Bools::free_call_back_procs
Apol_Cond_Rules::free_call_back_procs
return 0
}
proc ApolTop::apolExit { } {
variable policy_is_open
if {$policy_is_open} {
ApolTop::closePolicy
}
if {$ApolTop::libsefs == 1} {
Apol_File_Contexts::close
}
ApolTop::free_call_back_procs
ApolTop::writeInitFile
exit
}
proc ApolTop::load_recent_files { } {
variable temp_recent_files
variable most_recent_file
variable max_recent_files
set most_recent_file 0
set length [llength $temp_recent_files]
for {set i 0} {$i < $length} {incr i} {
ApolTop::addRecent [lindex $temp_recent_files $i]
}
unset temp_recent_files
return 0
}
proc ApolTop::load_fonts { } {
variable title_font
variable dialog_font
variable general_font
variable text_font
tk scaling -displayof . 1.0
if {$general_font == ""} {
option add *Font "Helvetica 10"
set general_font "Helvetica 10"
} else {
option add *Font $general_font
}
if {$title_font == ""} {
option add *TitleFrame.l.font "Helvetica 10 bold italic"
set title_font "Helvetica 10 bold italic"
} else {
option add *TitleFrame.l.font $title_font
}
if {$dialog_font == ""} {
option add *Dialog*font "Helvetica 10"
set dialog_font "Helvetica 10"
} else {
option add *Dialog*font $dialog_font
}
if {$text_font == ""} {
option add *text*font "fixed"
set text_font "fixed"
} else {
option add *text*font $text_font
}
return 0
}
proc ApolTop::disable_DeleteWindow_event {} {
wm protocol . WM_DELETE_WINDOW { }
}
proc ApolTop::enable_DeleteWindow_event {} {
wm protocol . WM_DELETE_WINDOW "ApolTop::apolExit"
}
proc ApolTop::main {} {
global tk_version
global tk_patchLevel
variable top_width
variable top_height
variable bwidget_version
variable notebook
rename send {}
set rt [catch {set bwidget_version [package require BWidget]} err]
if {$rt != 0 } {
tk_messageBox -icon error -type ok -title "Missing BWidgets package" -message \
"Missing BWidgets package. Ensure that your installed version of \n\
TCL/TK includes BWidgets, which can be found at\n\n\
http://sourceforge.net/projects/tcllib"
exit
}
if {[package vcompare $bwidget_version "1.4.1"] == -1} {
tk_messageBox -icon warning -type ok -title "Package Version" -message \
"This tool requires BWidgets 1.4.1 or later. You may experience problems\
while running the application. It is recommended that you upgrade your BWidgets\
package to version 1.4.1 or greater. See 'Help' for more information."
}
if {[package vcompare $bwidget_version "1.4.1"] && $tk_version == "8.3"} {
tk_messageBox -icon error -type ok -title "Error" -message \
"Your installed Tk version $tk_version includes an incompatible BWidgets $bwidget_version package version. \
This has been known to cause a tk application to crash.\n\nIt is recommended that you either upgrade your \
Tk library to version 8.4 or greater or use BWidgets 1.4.1 instead. See the README for more information."
exit
}
set rt [catch {package require apol} err]
if {$rt != 0 } {
tk_messageBox -icon error -type ok -title "Missing SE Linux package" -message \
"Missing the SE Linux package. This script will not\n\
work correctly using the generic TK wish program. You\n\
must either use the apol executable or the awish\n\
interpreter."
exit
}
wm withdraw .
wm title . "SE Linux Policy Analysis"
ApolTop::enable_DeleteWindow_event
set rt [catch {ApolTop::check_libsefs} err]
if {$rt != 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$err"
return
}
ApolTop::readInitFile
ApolTop::load_fonts
ApolTop::create
ApolTop::load_recent_files
if {[package vcompare $bwidget_version "1.6"] >= 0} {
set ApolTop::top_width [$notebook cget -width]
set ApolTop::top_height [$notebook cget -height]
}
wm geom . ${top_width}x${top_height}
update idletasks
wm deiconify .
raise .
focus -force .
return 0
}
ApolTop::main
|