File: //usr/bin/apol
#!/bin/sh
# \
exec tclsh "$0" ${1+"$@"}
##############################################################
#
# apol: SELinux Policy Analysis Tools
#
# Copyright (C) 2002-2007 Tresys Technology, LLC
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#
# Question/comments to: setools@tresys.com
#
# This tool is designed to analyze SELinux policies. See the
# assoicated help file for more information.
#
##############################################################
proc tcl_config_init_libraries {} {
global auto_path
lappend auto_path /usr/lib64/setools
print_init "Initializing libqpol... "
package require qpol 1.7
print_init "done.\nInitializing libapol... "
package require apol 4.4
print_init "done.\nInitializing libsefs... "
package require sefs 4.0.4
print_init "done.\nInitializing libapol_tcl... "
package require apol_tcl 4.4
print_init "done.\n"
}
proc tcl_config_get_install_dir {} {
return "/usr/share/setools-3.3"
}
proc tcl_config_init {} {
}
proc tcl_config_get_version {} {
return 3.3.8
}
namespace eval Apol_Analysis {
variable vals
variable widgets
variable tabs
}
proc Apol_Analysis::create {tab_name nb} {
variable vals
variable widgets
set frame [$nb insert end $tab_name -text "Analysis"]
set pw [PanedWindow $frame.pw -side left -weights extra]
set topf [$pw add -weight 0]
set bottomf [$pw add -weight 1]
pack $pw -expand 1 -fill both
set top_leftf [TitleFrame $topf.left -text "Analysis Type"]
set opts_f [TitleFrame $topf.opts -text "Analysis Options"]
set buttons_f [frame $topf.buttons]
pack $top_leftf -side left -expand 0 -fill y -padx 2
pack $opts_f -side left -expand 1 -fill both -padx 2
pack $buttons_f -side right -expand 0 -anchor ne -padx 2
set results_f [TitleFrame $bottomf.r -text "Analysis Results"]
pack $results_f -expand 1 -fill both -padx 2
set widgets(modules) [Apol_Widget::makeScrolledListbox [$top_leftf getframe].m \
-height 8 -width 24 -listvar Apol_Analysis::vals(module_names) -exportselection 0]
$widgets(modules).lb selection set 0
bind $widgets(modules).lb <<ListboxSelect>> Apol_Analysis::_selectModule
pack $widgets(modules) -expand 1 -fill both
set widgets(search_opts) [PagesManager [$opts_f getframe].s]
foreach m $vals(modules) {
${m}::create [$widgets(search_opts) add $m]
}
$widgets(search_opts) compute_size
$widgets(search_opts) raise [lindex $vals(modules) 0]
pack $widgets(search_opts) -expand 1 -fill both
set widgets(new) [button $buttons_f.new -text "New Analysis" -width 12 \
-command [list Apol_Analysis::_analyze new]]
set widgets(update) [button $buttons_f.update -text "Update Analysis" -width 12 -state disabled \
-command [list Apol_Analysis::_analyze update]]
set widgets(reset) [button $buttons_f.reset -text "Reset Criteria" -width 12 \
-command Apol_Analysis::_reset]
set widgets(info) [button $buttons_f.info -text "Info" -width 12 \
-command Apol_Analysis::_info]
pack $widgets(new) $widgets(update) $widgets(reset) $widgets(info) \
-side top -pady 5 -padx 5 -anchor ne
set popupTab_Menu [menu .popup_analysis -tearoff 0]
set tab_menu_callbacks \
[list {"Close Tab" Apol_Analysis::_deleteResults} \
{"Rename Tab" Apol_Analysis::_displayRenameTabDialog}]
set widgets(results) [NoteBook [$results_f getframe].results]
$widgets(results) bindtabs <Button-1> Apol_Analysis::_switchTab
$widgets(results) bindtabs <Button-3> \
[list ApolTop::popup \
%W %x %y $popupTab_Menu $tab_menu_callbacks]
set close [button [$results_f getframe].close -text "Close Tab" \
-command Apol_Analysis::_deleteCurrentResults]
pack $widgets(results) -expand 1 -fill both -padx 4
pack $close -expand 0 -fill x -padx 4 -pady 2
_reinitializeTabs
return $frame
}
proc Apol_Analysis::open {ppath} {
variable vals
foreach m $vals(modules) {
${m}::open
}
}
proc Apol_Analysis::close {} {
variable vals
variable widgets
foreach m $vals(modules) {
${m}::close
}
_reinitializeTabs
}
proc Apol_Analysis::getTextWidget {} {
variable widgets
variable tabs
set curid [$widgets(results) raise]
if {$curid != {}} {
return [$tabs($curid:module)::getTextWidget [$widgets(results) getframe $curid]]
}
return {}
}
proc Apol_Analysis::save_query_options {file_channel query_file} {
variable widgets
set m [$widgets(search_opts) raise]
puts $file_channel $m
${m}::saveQuery $file_channel
}
proc Apol_Analysis::load_query_options {file_channel} {
variable vals
variable widgets
set line {}
while {[gets $file_channel line] >= 0} {
set line [string trim $line]
if {$line == {} || [string index $line 0] == "#"} {
continue
}
break
}
if {$line == {} || [set i [lsearch -exact $vals(modules) $line]] == -1} {
tk_messageBox -icon error -type ok -title "Open Apol Query" -message "The specified query is not a valid analysis module."
return
}
${line}::loadQuery $file_channel
$widgets(modules).lb selection clear 0 end
set module [lindex $vals(modules) $i]
$widgets(search_opts) raise $module
$widgets(modules).lb selection set [lsearch $vals(module_names) $vals($module:name)]
}
proc Apol_Analysis::registerAnalysis {mod_proc mod_name} {
variable vals
lappend vals(modules) $mod_proc
lappend vals(module_names) $mod_name
set vals($mod_proc:name) $mod_name
}
proc Apol_Analysis::createResultTab {short_name criteria} {
variable widgets
variable tabs
set i $tabs(next_result_id)
incr tabs(next_result_id)
set m [$widgets(search_opts) raise]
set id "results$i"
set frame [$widgets(results) insert end $id -text "($i) $short_name"]
$widgets(results) raise $id
set tabs($id:module) $m
set tabs($id:vals) $criteria
return $frame
}
proc Apol_Analysis::setResultTabCriteria {criteria} {
variable widgets
variable tabs
set id [$widgets(results) raise]
if {$id != {}} {
set tabs($id:vals) $criteria
}
}
proc Apol_Analysis::_selectModule {} {
variable vals
variable widgets
variable tabs
focus $widgets(modules).lb
if {[set selection [$widgets(modules).lb curselection]] == {}} {
return
}
set module [lindex $vals(modules) [lindex $selection 0]]
$widgets(search_opts) raise $module
set result_tab [$widgets(results) raise]
if {$result_tab != {} && $tabs($result_tab:module) == $module} {
$widgets(update) configure -state normal
} else {
$widgets(update) configure -state disabled
}
}
proc Apol_Analysis::_analyze {which_button} {
variable vals
variable widgets
variable tabs
$widgets(new) configure -state disabled
$widgets(update) configure -state disabled
set m [$widgets(search_opts) raise]
set retval [Apol_Progress_Dialog::wait "$vals($m:name) Analysis" \
"Performing $vals($m:name) Analysis..." \
{
if {$which_button == "new"} {
${m}::newAnalysis
} else {
set f [$widgets(results) getframe [$widgets(results) raise]]
if {[set retval [${m}::updateAnalysis $f]] != {}} {
_deleteCurrentResults
}
set retval
}
}]
if {$retval != {}} {
tk_messageBox -icon error -type ok -title "$vals($m:name) Analysis" -message "Error while performing analysis:\n\n$retval"
}
if {[$widgets(results) raise] == {}} {
$widgets(update) configure -state disabled
} else {
$widgets(update) configure -state normal
}
$widgets(new) configure -state normal
}
proc Apol_Analysis::_reset {} {
variable vals
variable widgets
set m [$widgets(search_opts) raise]
${m}::reset
}
proc Apol_Analysis::_info {} {
variable vals
variable widgets
set m [$widgets(search_opts) raise]
Apol_Widget::showPopupParagraph $vals(${m}:name) [${m}::getInfo]
}
proc Apol_Analysis::_reinitializeTabs {} {
variable widgets
variable tabs
array set tabs {
next_result_id 1
}
foreach p [$widgets(results) pages 0 end] {
_deleteResults $p
}
}
proc Apol_Analysis::_switchTab {pageID} {
variable vals
variable widgets
variable tabs
$widgets(update) configure -state normal
if {[$widgets(results) raise] == $pageID} {
return
}
$widgets(results) raise $pageID
set cur_search_opts [$widgets(search_opts) raise]
set m $tabs($pageID:module)
${m}::switchTab $tabs($pageID:vals)
$widgets(modules).lb selection clear 0 end
$widgets(modules).lb selection set [lsearch $vals(module_names) $vals(${m}:name)]
$widgets(search_opts) raise $m
}
proc Apol_Analysis::_deleteResults {pageID} {
variable widgets
variable tabs
set curpos [$widgets(results) index $pageID]
$widgets(results) delete $pageID
array unset tabs $pageID:*
array unset tabs $pageID
if {[set next_id [$widgets(results) pages $curpos]] != {}} {
_switchTab $next_id
} elseif {$curpos > 0} {
_switchTab [$widgets(results) pages [expr {$curpos - 1}]]
} else {
$widgets(update) configure -state disabled
}
}
proc Apol_Analysis::_deleteCurrentResults {} {
variable widgets
if {[set curid [$widgets(results) raise]] != {}} {
_deleteResults $curid
}
}
proc Apol_Analysis::_displayRenameTabDialog {pageID} {
variable widgets
variable tabs
set d [Dialog .apol_analysis_tab_rename -homogeneous 1 -spacing 2 -cancel 1 \
-default 0 -modal local -parent . -place center -separator 1 \
-side bottom -title "Rename Results Tab"]
$d add -text "OK" -command [list $d enddialog "ok"]
$d add -text "Cancel" -command [list $d enddialog "cancel"]
set f [$d getframe]
set l [label $f.l -text "Tab name:"]
set tabs(tab:new_name) [$widgets(results) itemcget $pageID -text]
set e [entry $f.e -textvariable Apol_Analysis::tabs(tab:new_name) -width 16 -bg white]
pack $l $e -side left -padx 2
set retval [$d draw]
destroy $d
if {$retval == "ok"} {
$widgets(results) itemconfigure $pageID -text $tabs(tab:new_name)
}
}
namespace eval Apol_Bounds {
variable vals
variable widgets
}
proc Apol_Bounds::create {tab_name nb} {
variable vals
variable widgets
_initializeVars
set frame [$nb insert end $tab_name -text "Bounds Rules"]
set topf [frame $frame.top]
set bottomf [frame $frame.bottom]
pack $topf -expand 0 -fill both -pady 2
pack $bottomf -expand 1 -fill both -pady 2
set rsbox [TitleFrame $topf.rs -ipad 30 -text "Rule Selection"]
set obox [TitleFrame $topf.opts -text "Search Options"]
set dbox [TitleFrame $bottomf.results -text "Bounds Rules Display"]
pack $rsbox -side left -expand 0 -fill both -padx 2
pack $obox -side left -expand 1 -fill both -padx 2
pack $dbox -expand 1 -fill both -padx 2
set rs [$rsbox getframe]
radiobutton $rs.user -text user -value user \
-variable Apol_Bounds::vals(rule_selection)
radiobutton $rs.role -text role -value role \
-variable Apol_Bounds::vals(rule_selection)
radiobutton $rs.type -text type -value type \
-variable Apol_Bounds::vals(rule_selection)
trace add variable Apol_Bounds::vals(rule_selection) write \
[list Apol_Bounds::_ruleChanged]
pack $rs.user $rs.role $rs.type -side top -anchor w
set widgets(options_pm) [PagesManager [$obox getframe].opts]
_userCreate [$widgets(options_pm) add user]
_roleCreate [$widgets(options_pm) add role]
_typeCreate [$widgets(options_pm) add type]
$widgets(options_pm) compute_size
pack $widgets(options_pm) -expand 1 -fill both -side left
$widgets(options_pm) raise type
set ok [button [$obox getframe].ok -text OK -width 6 -command Apol_Bounds::_searchBounds]
pack $ok -side right -padx 5 -pady 5 -anchor ne
set widgets(results) [Apol_Widget::makeSearchResults [$dbox getframe].results]
pack $widgets(results) -expand yes -fill both
return $frame
}
proc Apol_Bounds::open {ppath} {
variable vals
variable widgets
$widgets(user:user_parent) configure -values $Apol_Users::users_list
$widgets(user:user_child) configure -values $Apol_Users::users_list
$widgets(role:role_parent) configure -values $Apol_Roles::role_list
$widgets(role:role_child) configure -values $Apol_Roles::role_list
$widgets(type:type_parent) configure -values $Apol_Types::typelist
$widgets(type:type_child) configure -values $Apol_Types::typelist
set vals(rule_selection) type
}
proc Apol_Bounds::close {} {
variable widgets
_initializeVars
$widgets(user:user_parent) configure -values {}
$widgets(user:user_child) configure -values {}
$widgets(role:role_parent) configure -values {}
$widgets(role:role_child) configure -values {}
$widgets(type:type_parent) configure -values {}
$widgets(type:type_child) configure -values {}
}
proc Apol_Bounds::getTextWidget {} {
variable widgets
}
proc Apol_Bounds::_initializeVars {} {
variable vals
array set vals {
rule_selection type
user_parent:use 0
user_parent:sym {}
user_child:sym {}
user_child:use 0
role_parent:use 0
role_parent:sym {}
role_child:sym {}
role_child:use 0
type_parent:use 0
type_parent:sym {}
type_child:sym {}
type_child:use 0
}
}
proc Apol_Bounds::_userCreate {a_f} {
variable vals
variable widgets
set user_parent [frame $a_f.user_parent]
set user_parent_cb [checkbutton $user_parent.enable -text "Parent user" \
-variable Apol_Bounds::vals(user_parent:use)]
set widgets(user:user_parent) [ComboBox $user_parent.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_Bounds::vals(user_parent:sym) \
-helptext "Select the bounding user" -autopost 1]
trace add variable Apol_Bounds::vals(user_parent:use) write \
[list Apol_Bounds::_toggleCheckbutton $widgets(user:user_parent) {}]
pack $user_parent_cb -side top -anchor w
pack $widgets(user:user_parent) -side top -expand 0 -fill x -padx 4
pack $user_parent -side left -padx 4 -pady 2 -expand 0 -anchor nw
set user_child [frame $a_f.user_child]
set widgets(user:user_child_cb) [checkbutton $user_child.enable -text "Child user" \
-variable Apol_Bounds::vals(user_child:use)]
set widgets(user:user_child) [ComboBox $user_child.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_Bounds::vals(user_child:sym) \
-helptext "Select the bounded user" -autopost 1]
trace add variable Apol_Bounds::vals(user_child:use) write \
[list Apol_Bounds::_toggleCheckbutton $widgets(user:user_child) {}]
pack $widgets(user:user_child_cb) -side top -anchor w
pack $widgets(user:user_child) -side top -expand 0 -fill x -padx 4
pack $user_child -side left -padx 4 -pady 2 -expand 0 -fill y
}
proc Apol_Bounds::_roleCreate {t_f} {
variable vals
variable widgets
set role_parent [frame $t_f.role_parent]
set role_parent_cb [checkbutton $role_parent.enable -text "Parent role" \
-variable Apol_Bounds::vals(role_parent:use)]
set widgets(role:role_parent) [ComboBox $role_parent.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_Bounds::vals(role_parent:sym) \
-helptext "Select the bounding role" -autopost 1]
trace add variable Apol_Bounds::vals(role_parent:use) write \
[list Apol_Bounds::_toggleCheckbutton $widgets(role:role_parent) {}]
pack $role_parent_cb -side top -anchor w
pack $widgets(role:role_parent) -side top -expand 0 -fill x -padx 4
pack $role_parent -side left -padx 4 -pady 2 -expand 0 -anchor nw
set role_child [frame $t_f.role_child]
set widgets(role:role_child_cb) [checkbutton $role_child.enable -text "Child role" \
-variable Apol_Bounds::vals(role_child:use)]
set widgets(role:role_child) [ComboBox $role_child.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_Bounds::vals(role_child:sym) \
-helptext "Select the bounded role" -autopost 1]
trace add variable Apol_Bounds::vals(role_child:use) write \
[list Apol_Bounds::_toggleCheckbutton $widgets(role:role_child) {}]
pack $widgets(role:role_child_cb) -side top -anchor w
pack $widgets(role:role_child) -side top -expand 0 -fill x -padx 4
pack $role_child -side left -padx 4 -pady 2 -expand 0 -fill y
}
proc Apol_Bounds::_typeCreate {b_t} {
variable vals
variable widgets
set type_parent [frame $b_t.type_parent]
set type_parent_cb [checkbutton $type_parent.enable -text "Parent type" \
-variable Apol_Bounds::vals(type_parent:use)]
set widgets(type:type_parent) [ComboBox $type_parent.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_Bounds::vals(type_parent:sym) \
-helptext "Select the bounding type" -autopost 1]
trace add variable Apol_Bounds::vals(type_parent:use) write \
[list Apol_Bounds::_toggleCheckbutton $widgets(type:type_parent) {}]
pack $type_parent_cb -side top -anchor w
pack $widgets(type:type_parent) -side top -expand 0 -fill x -padx 4
pack $type_parent -side left -padx 4 -pady 2 -expand 0 -anchor nw
set type_child [frame $b_t.type_child]
set widgets(type:type_child_cb) [checkbutton $type_child.enable -text "Child type" \
-variable Apol_Bounds::vals(type_child:use)]
set widgets(type:type_child) [ComboBox $type_child.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_Bounds::vals(type_child:sym) \
-helptext "Select the bounded type" -autopost 1]
trace add variable Apol_Bounds::vals(type_child:use) write \
[list Apol_Bounds::_toggleCheckbutton $widgets(type:type_child) {}]
pack $widgets(type:type_child_cb) -side top -anchor w
pack $widgets(type:type_child) -side top -expand 0 -fill x -padx 4
pack $type_child -side left -padx 4 -pady 2 -expand 0 -fill y
}
proc Apol_Bounds::_toggleCheckbutton {cb w name1 name2 ops} {
variable vals
if {$vals($name2)} {
$cb configure -state normal -entrybg white
foreach x $w {
$x configure -state normal
}
} else {
$cb configure -state disabled -entrybg $ApolTop::default_bg_color
foreach x $w {
$x configure -state disabled
}
}
}
proc Apol_Bounds::_ruleChanged {name1 name2 ops} {
variable vals
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
$widgets(options_pm) raise $vals(rule_selection)
}
proc Apol_Bounds::_searchBounds {} {
variable vals
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
return
}
if {$vals(rule_selection) == "user"} {
Apol_Bounds::_searchUserBounds
return
}
if {$vals(rule_selection) == "role"} {
Apol_Bounds::_searchRoleBounds
return
}
if {$vals(rule_selection) == "type" } {
Apol_Bounds::_searchTypeBounds
return
}
}
proc Apol_Bounds::_searchUserBounds {} {
variable vals
variable widgets
set results {}
set bounds {}
set counter 0
set printit 0
set parent_regexp 0
set child_regexp 0
if {$vals(user_parent:use) && $vals(user_parent:sym) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No parent user selected."
} elseif {$vals(user_parent:use)} {
set parent_regexp 1
}
if {$vals(user_child:use) && $vals(user_child:sym) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No child user selected."
} elseif {$vals(user_child:use)} {
set child_regexp 1
}
set q [new_apol_userbounds_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_userbounds_from_void [$v get_element $i]]
set parent [$q get_parent_name $::ApolTop::qpolicy]
set child [$q get_child_name $::ApolTop::qpolicy]
if {$parent != ""} {
if {$parent_regexp == 1 && $parent == $vals(user_parent:sym)} {
set printit 1
}
if {$child_regexp == 1 && $child == $vals(user_child:sym)} {
set printit 1
}
if {$parent_regexp == 0 && $child_regexp == 0} {
set printit 1
}
if {$printit == 1} {
append bounds "userbounds $parent "
append bounds "$child;\n"
set counter [expr $counter + 1]
}
}
set printit 0
}
}
append results "$counter rules match search criteria.\n\n$bounds\n"
Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_Bounds::_searchRoleBounds {} {
variable vals
variable widgets
set results {}
set bounds {}
set counter 0
set printit 0
set parent_regexp 0
set child_regexp 0
if {$vals(role_parent:use) && $vals(role_parent:sym) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No parent role selected."
} elseif {$vals(role_parent:use)} {
set parent_regexp 1
}
if {$vals(role_child:use) && $vals(role_child:sym) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No child role selected."
} elseif {$vals(role_child:use)} {
set child_regexp 1
}
set q [new_apol_rolebounds_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_rolebounds_from_void [$v get_element $i]]
set parent [$q get_parent_name $::ApolTop::qpolicy]
set child [$q get_child_name $::ApolTop::qpolicy]
if {$parent != ""} {
if {$parent_regexp == 1 && $parent == $vals(role_parent:sym)} {
set printit 1
}
if {$child_regexp == 1 && $child == $vals(role_child:sym)} {
set printit 1
}
if {$parent_regexp == 0 && $child_regexp == 0} {
set printit 1
}
if {$printit == 1} {
append bounds "rolebounds $parent "
append bounds "$child;\n"
set counter [expr $counter + 1]
}
}
set printit 0
}
}
append results "$counter rules match search criteria.\n\n$bounds\n"
Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_Bounds::_searchTypeBounds {} {
variable vals
variable widgets
set results {}
set bounds {}
set counter 0
set printit 0
set parent_regexp 0
set child_regexp 0
if {$vals(type_parent:use) && $vals(type_parent:sym) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No parent type selected."
} elseif {$vals(type_parent:use)} {
set parent_regexp 1
}
if {$vals(type_child:use) && $vals(type_child:sym) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No child type selected."
} elseif {$vals(type_child:use)} {
set child_regexp 1
}
set q [new_apol_typebounds_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_typebounds_from_void [$v get_element $i]]
set parent [$q get_parent_name $::ApolTop::qpolicy]
set child [$q get_child_name $::ApolTop::qpolicy]
if {$parent != ""} {
if {$parent_regexp == 1 && $parent == $vals(type_parent:sym)} {
set printit 1
}
if {$child_regexp == 1 && $child == $vals(type_child:sym)} {
set printit 1
}
if {$parent_regexp == 0 && $child_regexp == 0} {
set printit 1
}
if {$printit == 1} {
append bounds "typebounds $parent "
append bounds "$child;\n"
set counter [expr $counter + 1]
}
}
set printit 0
}
}
append results "$counter rules match search criteria.\n\n$bounds\n"
Apol_Widget::appendSearchResultText $widgets(results) $results
}
namespace eval Apol_Class_Perms {
variable class_list {}
variable common_list {}
variable perms_list {}
variable opts
variable widgets
}
proc Apol_Class_Perms::create {tab_name nb} {
variable opts
variable widgets
_initializeVars
set frame [$nb insert end $tab_name -text "Classes/Perms"]
set pw1 [PanedWindow $frame.pw -side top]
set left_pane [$pw1 add -weight 0]
set center_pane [$pw1 add -weight 1]
set class_pane [frame $left_pane.class]
set common_pane [frame $left_pane.common]
set perms_pane [frame $left_pane.perms]
set classes_box [TitleFrame $class_pane.tbox -text "Object Classes"]
set common_box [TitleFrame $common_pane.tbox -text "Common Permissions"]
set perms_box [TitleFrame $perms_pane.tbox -text "Permissions"]
set options_box [TitleFrame $center_pane.obox -text "Search Options"]
set results_box [TitleFrame $center_pane.rbox -text "Search Results"]
pack $classes_box -fill both -expand yes
pack $common_box -fill both -expand yes
pack $perms_box -fill both -expand yes
pack $options_box -padx 2 -fill both -expand 0
pack $results_box -padx 2 -fill both -expand yes
pack $pw1 -fill both -expand yes
pack $class_pane $common_pane -expand 0 -fill both
pack $perms_pane -expand 1 -fill both
set class_listbox [Apol_Widget::makeScrolledListbox [$classes_box getframe].lb -height 8 -width 20 -listvar Apol_Class_Perms::class_list]
Apol_Widget::setListboxCallbacks $class_listbox \
{{"Display Object Class Info" {Apol_Class_Perms::_popupInfo class}}}
pack $class_listbox -fill both -expand yes
set common_listbox [Apol_Widget::makeScrolledListbox [$common_box getframe].lb -height 5 -width 20 -listvar Apol_Class_Perms::common_perms_list]
Apol_Widget::setListboxCallbacks $common_listbox \
{{"Display Common Permission Class Info" {Apol_Class_Perms::_popupInfo common}}}
pack $common_listbox -fill both -expand yes
set perms_listbox [Apol_Widget::makeScrolledListbox [$perms_box getframe].lb -height 10 -width 20 -listvar Apol_Class_Perms::perms_list]
Apol_Widget::setListboxCallbacks $perms_listbox \
{{"Display Permission Info" {Apol_Class_Perms::_popupInfo perm}}}
pack $perms_listbox -fill both -expand yes
set ofm [$options_box getframe]
set classesfm [frame $ofm.classes]
set commonsfm [frame $ofm.commons]
set permsfm [frame $ofm.perms]
pack $classesfm $commonsfm $permsfm -side left -padx 4 -pady 2 -anchor ne
set classes [checkbutton $classesfm.classes -text "Object classes" \
-variable Apol_Class_Perms::opts(classes:show)]
set perms [checkbutton $classesfm.perms -text "Include perms" \
-variable Apol_Class_Perms::opts(classes:perms)]
set commons [checkbutton $classesfm.commons -text "Expand common perms" \
-variable Apol_Class_Perms::opts(classes:commons)]
trace add variable Apol_Class_Perms::opts(classes:show) write \
[list Apol_Class_Perms::_toggleCheckbuttons $perms $commons]
trace add variable Apol_Class_Perms::opts(classes:perms) write \
[list Apol_Class_Perms::_toggleCheckbuttons $commons {}]
pack $classes -anchor w
pack $perms $commons -anchor w -padx 8
set commons [checkbutton $commonsfm.commons -text "Common permissions" \
-variable Apol_Class_Perms::opts(commons:show)]
set perms [checkbutton $commonsfm.perms2 -text "Include perms" \
-variable Apol_Class_Perms::opts(commons:perms) \
-state disabled]
set classes [checkbutton $commonsfm.classes -text "Object classes" \
-variable Apol_Class_Perms::opts(commons:classes) \
-state disabled]
trace add variable Apol_Class_Perms::opts(commons:show) write \
[list Apol_Class_Perms::_toggleCheckbuttons $perms $classes]
pack $commons -anchor w
pack $perms $classes -anchor w -padx 8
set perms [checkbutton $permsfm.prems -text "Permissions" \
-variable Apol_Class_Perms::opts(perms:show)]
set classes [checkbutton $permsfm.classes -text "Object classes" \
-variable Apol_Class_Perms::opts(perms:classes) \
-state disabled]
set commons [checkbutton $permsfm.commons -text "Common perms" \
-variable Apol_Class_Perms::opts(perms:commons) \
-state disabled]
trace add variable Apol_Class_Perms::opts(perms:show) write \
[list Apol_Class_Perms::_toggleCheckbuttons $classes $commons]
pack $perms -anchor w
pack $classes $commons -anchor w -padx 8
set widgets(regexp) [Apol_Widget::makeRegexpEntry $ofm.regexp]
pack $widgets(regexp) -side left -padx 2 -pady 2 -anchor ne
set ok [button $ofm.ok -text OK -width 6 \
-command Apol_Class_Perms::_search]
pack $ok -side right -pady 5 -padx 5 -anchor ne
set widgets(results) [Apol_Widget::makeSearchResults [$results_box getframe].results]
pack $widgets(results) -expand yes -fill both
return $frame
}
proc Apol_Class_Perms::open {ppath} {
set q [new_apol_class_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
variable class_list [lsort [class_vector_to_list $v]]
$v -acquire
$v -delete
set q [new_apol_common_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
variable common_perms_list [lsort [common_vector_to_list $v]]
$v -acquire
$v -delete
set q [new_apol_perm_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
variable perms_list [lsort [str_vector_to_list $v]]
$v -acquire
$v -delete
}
proc Apol_Class_Perms::close {} {
variable class_list {}
variable common_perms_list {}
variable perms_list {}
variable widgets
_initializeVars
Apol_Widget::clearSearchResults $widgets(results)
}
proc Apol_Class_Perms::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_Class_Perms::getClasses {} {
variable class_list
set class_list
}
proc Apol_Class_Perms::getPermsForClass {class_name} {
set qpol_class_datum [new_qpol_class_t $::ApolTop::qpolicy $class_name]
set i [$qpol_class_datum get_perm_iter $::ApolTop::qpolicy]
set perms [iter_to_str_list $i]
$i -acquire
$i -delete
if {[set qpol_common_datum [$qpol_class_datum get_common $::ApolTop::qpolicy]] != "NULL"} {
set i [$qpol_common_datum get_perm_iter $::ApolTop::qpolicy]
set perms [concat $perms [iter_to_str_list $i]]
$i -acquire
$i -delete
}
lsort -dictionary -unique $perms
}
proc Apol_Class_Perms::getClassesForPerm {perm_name} {
set classes_list {}
set i [$::ApolTop::qpolicy get_class_iter $perm_name]
while {![$i end]} {
set qpol_class_datum [qpol_class_from_void [$i get_item]]
lappend classes_list [$qpol_class_datum get_name $::ApolTop::qpolicy]
$i next
}
$i -acquire
$i -delete
set indirect_classes_list {}
set i [$::ApolTop::qpolicy get_common_iter $perm_name]
while {![$i end]} {
set qpol_common_datum [qpol_common_from_void [$i get_item]]
set q [new_apol_class_query_t]
$q set_common $::ApolTop::policy [$qpol_common_datum get_name $::ApolTop::qpolicy]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set indirect_classes_list [concat $indirect_classes_list [class_vector_to_list $v]]
$v -acquire
$v -delete
$i next
}
$i -acquire
$i -delete
list [lsort $classes_list] [lsort -unique $indirect_classes_list]
}
proc Apol_Class_Perms::_initializeVars {} {
variable opts
array set opts {
classes:show 1 classes:perms 1 classes:commons 1
commons:show 0 commons:perms 1 commons:classes 1
perms:show 0 perms:classes 1 perms:commons 1
}
}
proc Apol_Class_Perms::_popupInfo {which name} {
if {$which == "class"} {
set text [_renderClass $name 1 0]
} elseif {$which == "common"} {
set text [_renderCommon $name 1 0]
} else {
set text [_renderPerm $name 1 1]
}
Apol_Widget::showPopupText $name $text
}
proc Apol_Class_Perms::_toggleCheckbuttons {cb1 cb2 name1 name2 op} {
variable opts
variable widgets
if {$opts($name2)} {
$cb1 configure -state normal
if {$name2 == "classes:show"} {
if {$opts(classes:perms)} {
$cb2 configure -state normal
} else {
$cb2 configure -state disabled
}
} elseif {$cb2 != {}} {
$cb2 configure -state normal
}
} else {
$cb1 configure -state disabled
if {$cb2 != {}} {
$cb2 configure -state disabled
}
}
if {!$opts(classes:show) && !$opts(commons:show) && !$opts(perms:show)} {
Apol_Widget::setRegexpEntryState $widgets(regexp) 0
} else {
Apol_Widget::setRegexpEntryState $widgets(regexp) 1
}
}
proc Apol_Class_Perms::_search {} {
variable opts
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
return
}
if {!$opts(classes:show) && !$opts(commons:show) && !$opts(perms:show)} {
tk_messageBox -icon error -type ok -title "Error" -message "No search options provided."
return
}
set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
if {$use_regexp} {
if {$regexp == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No regular expression provided."
return
}
} else {
set regexp {}
}
set results {}
if {$opts(classes:show)} {
if {[set classes_perms $opts(classes:perms)]} {
set classes_commons $opts(classes:commons)
} else {
set classes_commons 0
}
set q [new_apol_class_query_t]
$q set_class $::ApolTop::policy $regexp
$q set_regex $::ApolTop::policy $use_regexp
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set classes_data [class_vector_to_list $v]
$v -acquire
$v -delete
append results "OBJECT CLASSES:\n"
if {$classes_data == {}} {
append results "Search returned no results.\n"
} else {
foreach c [lsort -index 0 $classes_data] {
append results [_renderClass $c $opts(classes:perms) $classes_commons]
}
}
}
if {$opts(commons:show)} {
set q [new_apol_common_query_t]
$q set_common $::ApolTop::policy $regexp
$q set_regex $::ApolTop::policy $use_regexp
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set commons_data [common_vector_to_list $v]
$v -acquire
$v -delete
append results "\nCOMMON PERMISSIONS: \n"
if {$commons_data == {}} {
append results "Search returned no results.\n"
} else {
foreach c [lsort -index 0 $commons_data] {
append results [_renderCommon $c $opts(commons:perms) $opts(commons:classes)]
}
}
}
if {$opts(perms:show)} {
set q [new_apol_perm_query_t]
$q set_perm $::ApolTop::policy $regexp
$q set_regex $::ApolTop::policy $use_regexp
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set perms_data [str_vector_to_list $v]
$v -acquire
$v -delete
append results "\nPERMISSIONS"
if {$opts(perms:classes)} {
append results " (* means class uses permission via a common permission)"
}
append results ":\n"
if {$perms_data == {}} {
append results "Search returned no results.\n"
} else {
foreach p [lsort -index 0 $perms_data] {
append results [_renderPerm $p $opts(perms:classes) $opts(perms:commons)]
}
}
}
Apol_Widget::appendSearchResultText $widgets(results) [string trim $results]
}
proc Apol_Class_Perms::_renderClass {class_name show_perms expand_common} {
set qpol_class_datum [new_qpol_class_t $::ApolTop::qpolicy $class_name]
if {[set qpol_common_datum [$qpol_class_datum get_common $::ApolTop::qpolicy]] == "NULL"} {
set common_name {}
} else {
set common_name [$qpol_common_datum get_name $::ApolTop::qpolicy]
}
set text "$class_name\n"
if {$show_perms} {
set i [$qpol_class_datum get_perm_iter $::ApolTop::qpolicy]
set perms_list [iter_to_str_list $i]
$i -acquire
$i -delete
foreach perm [lsort $perms_list] {
append text " $perm\n"
}
if {$common_name != {}} {
append text " $common_name (common perm)\n"
if {$expand_common} {
set i [$qpol_common_datum get_perm_iter $::ApolTop::qpolicy]
foreach perm [lsort [iter_to_str_list $i]] {
append text " $perm\n"
}
$i -acquire
$i -delete
}
}
append text \n
}
return $text
}
proc Apol_Class_Perms::_renderCommon {common_name show_perms show_classes} {
set qpol_common_datum [new_qpol_common_t $::ApolTop::qpolicy $common_name]
set text "$common_name\n"
if {$show_perms} {
set i [$qpol_common_datum get_perm_iter $::ApolTop::qpolicy]
foreach perm [lsort [iter_to_str_list $i]] {
append text " $perm\n"
}
$i -acquire
$i -delete
}
if {$show_classes} {
append text " Object classes that use this common permission:\n"
set i [$::ApolTop::qpolicy get_class_iter]
set classes_list {}
while {![$i end]} {
set qpol_class_t [qpol_class_from_void [$i get_item]]
set q [$qpol_class_t get_common $::ApolTop::qpolicy]
if {$q != "NULL" && [$q get_name $::ApolTop::qpolicy] == $common_name} {
lappend classes_list [$qpol_class_t get_name $::ApolTop::qpolicy]
}
$i next
}
$i -acquire
$i -delete
foreach class [lsort $classes_list] {
append text " $class\n"
}
}
if {$show_perms || $show_classes} {
append text "\n"
}
return $text
}
proc Apol_Class_Perms::_renderPerm {perm_name show_classes show_commons} {
set text "$perm_name\n"
if {$show_classes} {
append text " object classes:\n"
foreach {classes_list indirect_classes_list} [getClassesForPerm $perm_name] {break}
foreach c $indirect_classes_list {
lappend classes_list ${c}*
}
if {$classes_list == {}} {
append text " <none>\n"
} else {
foreach class [lsort -uniq $classes_list] {
append text " $class\n"
}
}
}
if {$show_commons} {
append text " common permissions:\n"
set commons_list {}
set i [$::ApolTop::qpolicy get_common_iter $perm_name]
while {![$i end]} {
set qpol_common_datum [qpol_common_from_void [$i get_item]]
lappend commons_list [$qpol_common_datum get_name $::ApolTop::qpolicy]
$i next
}
$i -acquire
$i -delete
if {$commons_list == {}} {
append text " <none>\n"
} else {
foreach common [lsort $commons_list] {
append text " $common\n"
}
}
}
if {$show_classes || $show_commons} {
append text "\n"
}
return $text
}
namespace eval Apol_Widget {
variable menuPopup {}
variable infoPopup {}
variable infoPopup2 {}
variable vars
}
proc Apol_Widget::makeScrolledListbox {path args} {
set sw [ScrolledWindow $path -scrollbar both -auto both]
set lb [eval listbox $sw.lb $args -bg white -highlightthickness 0]
$sw setwidget $lb
update
grid propagate $sw 0
bind $lb <<ListboxSelect>> [list focus $lb]
bind $lb <Key> [list Apol_Widget::_listbox_key $lb %K]
return $sw
}
proc Apol_Widget::setListboxCallbacks {path callback_list} {
set lb [getScrolledListbox $path]
bind $lb <Double-Button-1> [eval list Apol_Widget::_listbox_double_click $lb [lindex $callback_list 0 1]]
set lb [getScrolledListbox $path]
bind $lb <Button-3> [list Apol_Widget::_listbox_popup %W %x %y $callback_list $lb]
}
proc Apol_Widget::getScrolledListbox {path} {
return $path.lb
}
proc Apol_Widget::setScrolledListboxState {path newState} {
if {$newState == 0 || $newState == "disabled"} {
$path.lb configure -state disabled
} else {
$path.lb configure -state normal
}
}
proc Apol_Widget::makeTypeCombobox {path args} {
variable vars
array unset vars $path:*
set vars($path:type) ""
set vars($path:attribenable) 0
set vars($path:attrib) ""
set f [frame $path]
set type_box [eval ComboBox $f.tb -helptext {{Type or select a type}} \
-textvariable Apol_Widget::vars($path:type) \
-entrybg white -width 20 -autopost 1 $args]
pack $type_box -side top -expand 1 -fill x
set attrib_width [expr {[$type_box cget -width] - 4}]
set attrib_enable [checkbutton $f.ae \
-anchor w -text "Filter by attribute"\
-variable Apol_Widget::vars($path:attribenable) \
-command [list Apol_Widget::_attrib_enabled $path]]
set attrib_box [ComboBox $f.ab -autopost 1 -entrybg white -width $attrib_width \
-textvariable Apol_Widget::vars($path:attrib)]
trace add variable Apol_Widget::vars($path:attrib) write [list Apol_Widget::_attrib_changed $path]
pack $attrib_enable -side top -expand 0 -fill x -anchor sw -padx 5 -pady 2
pack $attrib_box -side top -expand 1 -fill x -padx 9
_attrib_enabled $path
return $f
}
proc Apol_Widget::resetTypeComboboxToPolicy {path} {
$path.tb configure -values [Apol_Types::getTypes]
$path.ab configure -values [Apol_Types::getAttributes]
}
proc Apol_Widget::clearTypeCombobox {path} {
variable vars
set vars($path:attribenable) 0
set vars($path:attrib) ""
set vars($path:type) ""
$path.tb configure -values {}
$path.ab configure -values {}
_attrib_enabled $path
}
proc Apol_Widget::getTypeComboboxValueAndAttrib {path} {
variable vars
if {$vars($path:attribenable)} {
list [string trim $vars($path:type)] $vars($path:attrib)
} else {
string trim $vars($path:type)
}
}
proc Apol_Widget::setTypeComboboxValue {path type} {
variable vars
if {[llength $type] <= 1} {
set vars($path:type) $type
set vars($path:attribenable) 0
set vars($path:attrib) ""
} else {
set vars($path:type) [lindex $type 0]
set vars($path:attribenable) 1
set vars($path:attrib) [lindex $type 1]
}
_attrib_enabled $path
}
proc Apol_Widget::setTypeComboboxState {path newState} {
variable vars
if {$newState == 0 || $newState == "disabled"} {
$path.tb configure -state disabled
$path.ae configure -state disabled
$path.ab configure -state disabled
} else {
$path.tb configure -state normal
$path.ae configure -state normal
if {$vars($path:attribenable)} {
$path.ab configure -state normal
}
}
}
proc Apol_Widget::makeLevelSelector {path catSize args} {
variable vars
array unset vars $path:*
set vars($path:sens) {}
set vars($path:cats) {}
set f [frame $path]
set sens_box [eval ComboBox $f.sens $args \
-textvariable Apol_Widget::vars($path:sens) \
-entrybg white -width 16 -autopost 1]
trace add variable Apol_Widget::vars($path:sens) write [list Apol_Widget::_sens_changed $path]
pack $sens_box -side top -expand 0 -fill x
set cats_label [label $f.cl -text "Categories:"]
pack $cats_label -side top -anchor sw -pady 2 -expand 0
set cats [makeScrolledListbox $f.cats -width 16 -height $catSize \
-listvariable Apol_Widget::vars($path:cats) \
-selectmode extended -exportselection 0]
pack $cats -side top -expand 1 -fill both
set reset [button $f.reset -text "Clear Categories" \
-command [list [getScrolledListbox $cats] selection clear 0 end]]
pack $reset -side top -anchor center -pady 2
return $f
}
proc Apol_Widget::getLevelSelectorLevel {path} {
variable vars
set apol_level [new_apol_mls_level_t]
set l [Apol_MLS::isSensInPolicy $vars($path:sens)]
if {[ApolTop::is_policy_open]} {
set p $::ApolTop::policy
} else {
set p NULL
}
if {$l == {}} {
$apol_level set_sens $p $vars($path:sens)
} else {
$apol_level set_sens $p $l
}
set sl [getScrolledListbox $path.cats]
set cats {}
foreach idx [$sl curselection] {
$apol_level append_cats $p [$sl get $idx]
}
return $apol_level
}
proc Apol_Widget::setLevelSelectorLevel {path level} {
variable vars
if {$level == "NULL"} {
set sens {}
} else {
set sens [$level get_sens]
}
set sens_list [$path.sens cget -values]
if {$sens != {} && [lsearch -exact $sens_list $sens] != -1} {
set vars($path:sens) $sens
set cats_list $vars($path:cats)
set first_idx -1
set listbox [getScrolledListbox $path.cats]
set cats [str_vector_to_list [$level get_cats]]
foreach cat $cats {
if {[set idx [lsearch -exact $cats_list $cat]] != -1} {
$listbox selection set $idx
if {$first_idx == -1 || $idx < $first_idx} {
set first_idx $idx
}
}
}
incr first_idx -1
$listbox yview scroll $first_idx units
}
}
proc Apol_Widget::resetLevelSelectorToPolicy {path} {
variable vars
set vars($path:sens) {}
if {![ApolTop::is_policy_open]} {
$path.sens configure -values {}
} else {
set level_data {}
set i [$::ApolTop::qpolicy get_level_iter]
while {![$i end]} {
set qpol_level_datum [qpol_level_from_void [$i get_item]]
if {![$qpol_level_datum get_isalias $::ApolTop::qpolicy]} {
set level_name [$qpol_level_datum get_name $::ApolTop::qpolicy]
set level_value [$qpol_level_datum get_value $::ApolTop::qpolicy]
lappend level_data [list $level_name $level_value]
}
$i next
}
$i -acquire
$i -delete
set level_names {}
foreach l [lsort -integer -index 1 $level_data] {
lappend level_names [lindex $l 0]
}
$path.sens configure -values $level_names
}
}
proc Apol_Widget::clearLevelSelector {path} {
variable vars
set vars($path:sens) {}
$path.sens configure -values {}
}
proc Apol_Widget::setLevelSelectorState {path newState} {
if {$newState == 0 || $newState == "disabled"} {
set newState disabled
} else {
set newState normal
}
$path.sens configure -state $newState
$path.cl configure -state $newState
$path.reset configure -state $newState
setScrolledListboxState $path.cats $newState
}
proc Apol_Widget::makeRegexpEntry {path args} {
variable vars
array unset vars $path:*
set vars($path:enable_regexp) 0
set f [frame $path]
set cb [checkbutton $f.cb -text "Search using regular expression" \
-variable Apol_Widget::vars($path:enable_regexp)]
set regexp [eval entry $f.entry $args \
-textvariable Apol_Widget::vars($path:regexp) \
-width 32 -state disabled -bg $ApolTop::default_bg_color]
trace add variable Apol_Widget::vars($path:enable_regexp) write \
[list Apol_Widget::_toggle_regexp_check_button $regexp]
pack $cb -side top -anchor nw
pack $regexp -side top -padx 4 -anchor nw -expand 0 -fill x
return $f
}
proc Apol_Widget::setRegexpEntryState {path newState} {
variable vars
if {$newState == 0 || $newState == "disabled"} {
set vars($path:enable_regexp) 0
$path.cb configure -state disabled
} else {
$path.cb configure -state normal
}
}
proc Apol_Widget::setRegexpEntryValue {path newState newValue} {
variable vars
set old_state [$path.cb cget -state]
set vars($path:enable_regexp) $newState
set vars($path:regexp) $newValue
$path.cb configure -state $old_state
}
proc Apol_Widget::getRegexpEntryState {path} {
return $Apol_Widget::vars($path:enable_regexp)
}
proc Apol_Widget::getRegexpEntryValue {path} {
return $Apol_Widget::vars($path:regexp)
}
proc Apol_Widget::makeSearchResults {path args} {
variable vars
array unset vars $path:*
set sw [ScrolledWindow $path -scrollbar both -auto both]
set tb [eval text $sw.tb $args -bg white -wrap none -state disabled -font $ApolTop::text_font]
set vars($path:cursor) [$tb cget -cursor]
bind $tb <Button-3> [list Apol_Widget::_searchresults_popup %W %x %y]
$tb tag configure linenum -foreground blue -underline 1
$tb tag configure selected -foreground red -underline 1
$tb tag configure enabled -foreground green -underline 1
$tb tag configure disabled -foreground red -underline 1
$tb tag bind linenum <Button-1> [list Apol_Widget::_hyperlink $path %x %y]
$tb tag bind linenum <Enter> [list $tb configure -cursor hand2]
$tb tag bind linenum <Leave> [list $tb configure -cursor $Apol_Widget::vars($path:cursor)]
$sw setwidget $tb
return $sw
}
proc Apol_Widget::clearSearchResults {path} {
$path.tb configure -state normal
$path.tb delete 0.0 end
$path.tb configure -state disabled
}
proc Apol_Widget::copySearchResults {path} {
if {[$path tag ranges sel] != {}} {
set data [$path get sel.first sel.last]
clipboard clear
clipboard append -- $data
}
}
proc Apol_Widget::selectAllSearchResults {path} {
$path tag add sel 1.0 end
}
proc Apol_Widget::appendSearchResultHeader {path header} {
$path.tb configure -state normal
$path.tb insert 1.0 "$header\n"
$path.tb configure -state disabled
}
proc Apol_Widget::appendSearchResultText {path text} {
$path.tb configure -state normal
$path.tb insert end $text
$path.tb configure -state disabled
}
proc Apol_Widget::appendSearchResultRules {path indent rule_list cast} {
set curstate [$path.tb cget -state]
$path.tb configure -state normal
set num_enabled 0
set num_disabled 0
for {set i 0} {$i < [$rule_list get_size]} {incr i} {
set rule [$cast [$rule_list get_element $i]]
$path.tb insert end [string repeat " " $indent]
$path.tb insert end [apol_tcl_rule_render $::ApolTop::policy $rule]
if {[$rule get_cond $::ApolTop::qpolicy] != "NULL"} {
if {[$rule get_is_enabled $::ApolTop::qpolicy]} {
$path.tb insert end " \[" {} "Enabled" enabled "\]"
incr num_enabled
} else {
$path.tb insert end " \[" {} "Disabled" disabled "\]"
incr num_disabled
}
}
$path.tb insert end "\n"
}
$path.tb configure -state $curstate
list [$rule_list get_size] $num_enabled $num_disabled
}
proc Apol_Widget::appendSearchResultSynRules {path indent rule_list cast} {
set curstate [$path.tb cget -state]
$path.tb configure -state normal
set num_enabled 0
set num_disabled 0
if {[ApolTop::is_capable "line numbers"]} {
set do_linenums 1
} else {
set do_linenums 0
}
for {set i 0} {$i < [$rule_list get_size]} {incr i} {
set syn_rule [$cast [$rule_list get_element $i]]
$path.tb insert end [string repeat " " $indent]
if {$do_linenums} {
$path.tb insert end \
"\[" {} \
[$syn_rule get_lineno $::ApolTop::qpolicy] linenum \
"\] " {}
}
$path.tb insert end [apol_tcl_rule_render $::ApolTop::policy $syn_rule]
if {[$syn_rule get_cond $::ApolTop::qpolicy] != "NULL"} {
if {[$syn_rule get_is_enabled $::ApolTop::qpolicy]} {
$path.tb insert end " \[" {} "Enabled" enabled "\]"
incr num_enabled
} else {
$path.tb insert end " \[" {} "Disabled" disabled "\]"
incr num_disabled
}
}
$path.tb insert end "\n"
}
$path.tb configure -state $curstate
list [$rule_list get_size] $num_enabled $num_disabled
}
proc Apol_Widget::showPopupText {title info} {
variable infoPopup
if {![winfo exists $infoPopup]} {
set infoPopup [toplevel .apol_widget_info_popup]
wm withdraw $infoPopup
set sw [ScrolledWindow $infoPopup.sw -scrollbar both -auto horizontal]
set text [text [$sw getframe].text -font {helvetica 10} -wrap none -width 35 -height 10]
$sw setwidget $text
pack $sw -expand 1 -fill both
set b [button $infoPopup.close -text "Close" -command [list destroy $infoPopup]]
pack $b -side bottom -expand 0 -pady 5
wm geometry $infoPopup 250x200+50+50
update
grid propagate $sw 0
}
wm title $infoPopup $title
set text [$infoPopup.sw getframe].text
$text configure -state normal
$text delete 1.0 end
$text insert 0.0 $info
$text configure -state disabled
wm deiconify $infoPopup
raise $infoPopup
}
proc Apol_Widget::showPopupParagraph {title info} {
variable infoPopup2
if {![winfo exists $infoPopup2]} {
set infoPopup2 [Dialog .apol_widget_info_popup2 -modal none -parent . \
-transient false -cancel 0 -default 0 -separator 1]
$infoPopup2 add -text "Close" -command [list destroy $infoPopup2]
set sw [ScrolledWindow [$infoPopup2 getframe].sw -auto both -scrollbar both]
$sw configure -relief sunken
set text [text [$sw getframe].text -font $ApolTop::text_font \
-wrap none -width 75 -height 25 -bg white]
$sw setwidget $text
update
grid propagate $sw 0
pack $sw -expand 1 -fill both -padx 4 -pady 4
$infoPopup2 draw
} else {
raise $infoPopup2
wm deiconify $infoPopup2
}
$infoPopup2 configure -title $title
set text [[$infoPopup2 getframe].sw getframe].text
$text configure -state normal
$text delete 1.0 end
$text insert 0.0 $info
$text configure -state disabled
}
proc Apol_Widget::_listbox_key {listbox key} {
if {[string length $key] == 1} {
set values [set ::[$listbox cget -listvar]]
set x [lsearch $values $key*]
if {$x >= 0} {
set curvalue [$listbox get active]
set curindex [$listbox curselection]
if {$curindex != "" && [string index $curvalue 0] == $key} {
set new_x [expr {$curindex + 1}]
if {[string index [lindex $values $new_x] 0] != $key} {
set new_x $x
}
} else {
set new_x $x
}
$listbox selection clear 0 end
$listbox selection set $new_x
$listbox activate $new_x
$listbox see $new_x
}
event generate $listbox <<ListboxSelect>>
}
}
proc Apol_Widget::_listbox_double_click {listbox callback_func args} {
eval $callback_func $args [$listbox get active]
}
proc Apol_Widget::_listbox_popup {w x y callbacks lb} {
focus $lb
set selected_item [$lb get active]
if {$selected_item == {}} {
return
}
variable menuPopup
if {![winfo exists $menuPopup]} {
set menuPopup [menu .apol_widget_menu_popup -tearoff 0]
}
ApolTop::popup $w $x $y $menuPopup $callbacks $selected_item
}
proc Apol_Widget::_attrib_enabled {path} {
variable vars
if {$vars($path:attribenable)} {
$path.ab configure -state normal
_filter_type_combobox $path $vars($path:attrib)
} else {
$path.ab configure -state disabled
_filter_type_combobox $path ""
}
}
proc Apol_Widget::_attrib_changed {path name1 name2 op} {
variable vars
if {$vars($path:attribenable)} {
_filter_type_combobox $path $vars($name2)
}
}
proc Apol_Widget::_attrib_validate {path} {
}
proc Apol_Widget::_filter_type_combobox {path attribvalue} {
variable vars
if {$attribvalue != {}} {
set typesList {}
if {[Apol_Types::isAttributeInPolicy $attribvalue]} {
set qpol_type_datum [new_qpol_type_t $::ApolTop::qpolicy $attribvalue]
set i [$qpol_type_datum get_type_iter $::ApolTop::qpolicy]
foreach t [iter_to_list $i] {
set t [qpol_type_from_void $t]
lappend typesList [$t get_name $::ApolTop::qpolicy]
}
$i -acquire
$i -delete
}
if {$typesList == {}} {
return
}
} else {
set typesList [Apol_Types::getTypes]
}
if {[lsearch -exact $typesList $vars($path:type)] == -1} {
set vars($path:type) {}
}
$path.tb configure -values [lsort $typesList]
}
proc Apol_Widget::_sens_changed {path name1 name2 op} {
variable vars
[getScrolledListbox $path.cats] selection clear 0 end
set vars($path:cats) {}
set sens [Apol_MLS::isSensInPolicy $vars($path:sens)]
if {$sens != {}} {
set qpol_level_datum [new_qpol_level_t $::ApolTop::qpolicy $sens]
set i [$qpol_level_datum get_cat_iter $::ApolTop::qpolicy]
while {![$i end]} {
set qpol_cat_datum [qpol_cat_from_void [$i get_item]]
lappend vars($path:cats) [$qpol_cat_datum get_name $::ApolTop::qpolicy]
$i next
}
$i -acquire
$i -delete
}
}
proc Apol_Widget::_toggle_regexp_check_button {path name1 name2 op} {
if {$Apol_Widget::vars($name2)} {
$path configure -state normal -bg white
} else {
$path configure -state disabled -bg $ApolTop::default_bg_color
}
}
proc Apol_Widget::_searchresults_popup {path x y} {
if {[ApolTop::is_policy_open]} {
focus $path
variable menuPopup
if {![winfo exists $menuPopup]} {
set menuPopup [menu .apol_widget_menu_popup -tearoff 0]
}
set callbacks {
{"Copy" Apol_Widget::copySearchResults}
{"Select All" Apol_Widget::selectAllSearchResults}
}
ApolTop::popup $path $x $y $menuPopup $callbacks $path
}
}
proc Apol_Widget::_hyperlink {path x y} {
set tb $path.tb
set range [$tb tag prevrange linenum "@$x,$y + 1 char"]
$tb tag add selected [lindex $range 0] [lindex $range 1]
set line_num [$tb get [lindex $range 0] [lindex $range 1]]
ApolTop::showPolicySourceLineNumber $line_num
}
proc Apol_Widget::_render_typeset {typeset} {
if {[llength $typeset] > 1} {
if {[lindex $typeset 0] == "~"} {
set typeset "~\{[lrange $typeset 1 end]\}"
} else {
set typeset "\{$typeset\}"
}
} else {
set typeset
}
}
namespace eval Apol_Cond_Bools {
variable cond_bools_list {}
variable cond_bools_defaults
variable cond_bools_values
variable opts
variable widgets
}
proc Apol_Cond_Bools::create {tab_name nb} {
variable opts
variable widgets
_initializeVars
set frame [$nb insert end $tab_name -text "Booleans"]
set pw [PanedWindow $frame.pw -side top]
set left_pane [$pw add -weight 0]
set right_pane [$pw add -weight 1]
pack $pw -expand 1 -fill both
set cond_bools_box [TitleFrame $left_pane.cond_bools_box -text "Booleans"]
set s_optionsbox [TitleFrame $right_pane.obox -text "Search Options"]
set rslts_frame [TitleFrame $right_pane.rbox -text "Search Results"]
pack $cond_bools_box -expand 1 -fill both
pack $s_optionsbox -padx 2 -fill x -expand 0
pack $rslts_frame -padx 2 -fill both -expand yes
set left_frame [$cond_bools_box getframe]
set sw_b [ScrolledWindow $left_frame.sw -auto both]
set widgets(listbox) [ScrollableFrame $sw_b.listbox -bg white -width 200]
$sw_b setwidget $widgets(listbox)
set button_defaults [button $left_frame.button_defaults \
-text "Reset to Policy Defaults" \
-command Apol_Cond_Bools::_resetAll]
pack $sw_b -side top -expand 1 -fill both
pack $button_defaults -side bottom -pady 2 -expand 0 -fill x
set ofm [$s_optionsbox getframe]
set bool_frame [frame $ofm.bool]
set show_frame [frame $ofm.show]
pack $bool_frame $show_frame -side left -padx 4 -pady 2 -anchor nw
set enable [checkbutton $bool_frame.enable \
-variable Apol_Cond_Bools::opts(enable_bool) \
-text "Boolean"]
set widgets(combo_box) [ComboBox $bool_frame.combo_box \
-textvariable Apol_Cond_Bools::opts(name) \
-helptext "Type or select a boolean variable" \
-state disabled -entrybg white -autopost 1]
set widgets(regexp) [checkbutton $bool_frame.regexp \
-text "Search using regular expression" \
-state disabled \
-variable Apol_Cond_Bools::opts(use_regexp)]
trace add variable Apol_Cond_Bools::opts(enable_bool) write \
[list Apol_Cond_Bools::_toggleSearchBools]
pack $enable -anchor w
pack $widgets(combo_box) $widgets(regexp) -padx 4 -anchor nw -expand 0 -fill x
set show_default [checkbutton $show_frame.show_default \
-variable Apol_Cond_Bools::opts(show_default) \
-text "Show default state"]
set show_current [checkbutton $show_frame.show_current \
-variable Apol_Cond_Bools::opts(show_current) \
-text "Show current state"]
pack $show_default $show_current -anchor w
set ok_button [button $ofm.ok -text "OK" -width 6 \
-command Apol_Cond_Bools::_search]
pack $ok_button -side right -anchor ne -padx 5 -pady 5
set widgets(results) [Apol_Widget::makeSearchResults [$rslts_frame getframe].results]
pack $widgets(results) -expand yes -fill both
return $frame
}
proc Apol_Cond_Bools::open {ppath} {
set q [new_apol_bool_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
variable cond_bools_list [lsort [bool_vector_to_list $v]]
$v -acquire
$v -delete
variable cond_bools_defaults
foreach bool $cond_bools_list {
set b [new_qpol_bool_t $::ApolTop::qpolicy $bool]
set cond_bools_defaults($bool) [$b get_state $::ApolTop::qpolicy]
set frame_bool [string map {. *} $bool]
_insert_listbox_item $bool $cond_bools_defaults($bool) $frame_bool
}
variable widgets
$widgets(listbox) xview moveto 0
$widgets(listbox) yview moveto 0
$widgets(listbox) configure -areaheight 0 -areawidth 0
$widgets(combo_box) configure -values $cond_bools_list
}
proc Apol_Cond_Bools::close {} {
variable widgets
variable cond_bools_list {}
variable cond_bools_defaults
variable cond_bools_values
_initializeVars
$widgets(combo_box) configure -values {}
foreach w [winfo children [$widgets(listbox) getframe]] {
destroy $w
}
[$widgets(listbox) getframe] configure -width 1 -height 1
Apol_Widget::clearSearchResults $widgets(results)
array unset cond_bools_defaults
array unset cond_bools_values
}
proc Apol_Cond_Bools::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_Cond_Bools::getBooleans {} {
variable cond_bools_list
set cond_bools_list
}
proc Apol_Cond_Bools::_initializeVars {} {
variable opts
array set opts {
enable_bool 0
name ""
use_regexp 0
show_default 1
show_current 1
}
}
proc Apol_Cond_Bools::_insert_listbox_item {bool initial_state frame_bool} {
variable widgets
variable cond_bools_values
set cond_bools_values($bool) $initial_state
set subf [$widgets(listbox) getframe]
set rb_true [radiobutton $subf.t:$frame_bool -bg white \
-variable Apol_Cond_Bools::cond_bools_values($bool) \
-value 1 -highlightthickness 0 -text "True"]
set rb_false [radiobutton $subf.f:$frame_bool -bg white \
-variable Apol_Cond_Bools::cond_bools_values($bool) \
-value 0 -highlightthickness 0 -text "False"]
trace add variable Apol_Cond_Bools::cond_bools_values($bool) write \
[list Apol_Cond_Bools::_set_bool_value]
set rb_label [label $subf.l:$frame_bool -bg white -text "- $bool"]
grid $rb_true $rb_false $rb_label -padx 2 -pady 5 -sticky w
}
proc Apol_Cond_Bools::_toggleSearchBools {name1 name2 op} {
variable opts
variable widgets
if {$opts(enable_bool)} {
$widgets(combo_box) configure -state normal
$widgets(regexp) configure -state normal
} else {
$widgets(combo_box) configure -state disabled
$widgets(regexp) configure -state disabled
}
}
proc Apol_Cond_Bools::_set_bool_value {name1 name2 op} {
variable cond_bools_values
set qpol_bool_datum [new_qpol_bool_t $::ApolTop::qpolicy $name2]
$qpol_bool_datum set_state $::ApolTop::qpolicy $cond_bools_values($name2)
}
proc Apol_Cond_Bools::_resetAll {} {
variable cond_bools_defaults
variable cond_bools_values
array set cond_bools_values [array get cond_bools_defaults]
}
proc Apol_Cond_Bools::_search {} {
variable opts
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
return
}
set name [string trim $opts(name)]
if {$opts(enable_bool) && $name == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No boolean variable provided."
return
}
set q [new_apol_bool_query_t]
$q set_bool $::ApolTop::policy $name
$q set_regex $::ApolTop::policy $opts(use_regexp)
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set bools_data [bool_vector_to_list $v]
$v -acquire
$v -delete
set results {}
set results "BOOLEANS:\n"
if {[llength $bools_data] == 0} {
append results "Search returned no results."
} else {
foreach b [lsort $bools_data] {
append results "\n[_renderBool $b $opts(show_default) $opts(show_current)]"
}
}
Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_Cond_Bools::_renderBool {bool_name show_default show_current} {
variable cond_bools_defaults
set qpol_bool_datum [new_qpol_bool_t $::ApolTop::qpolicy $bool_name]
set cur_state [$qpol_bool_datum get_state $::ApolTop::qpolicy]
set text [format "%-28s" $bool_name]
if {$show_default} {
if {$cond_bools_defaults($bool_name)} {
append text " Default State: True "
} else {
append text " Default State: False"
}
}
if {$show_current} {
if {$cur_state} {
append text " Current State: True "
} else {
append text " Current State: False"
}
}
return $text
}
namespace eval Apol_Cond_Rules {
variable vals
variable widgets
}
proc Apol_Cond_Rules::create {tab_name nb} {
variable vals
variable widgets
_initializeVars
set frame [$nb insert end $tab_name -text "Conditional Expressions"]
set topf [frame $frame.top]
set bottomf [frame $frame.bottom]
pack $topf -expand 0 -fill both -pady 2
pack $bottomf -expand 1 -fill both -pady 2
set rules_box [TitleFrame $topf.rules_box -text "Rule Selection"]
set obox [TitleFrame $topf.obox -text "Search Options"]
set dbox [TitleFrame $bottomf.dbox -text "Conditional Expressions Display"]
pack $rules_box -side left -expand 0 -fill both -padx 2
pack $obox -side left -expand 1 -fill both -padx 2
pack $dbox -expand 1 -fill both -padx 2
set fm_rules [$rules_box getframe]
set allow [checkbutton $fm_rules.allow -text "allow" \
-onvalue $::QPOL_RULE_ALLOW -offvalue 0 \
-variable Apol_Cond_Rules::vals(rs:avrule_allow)]
set auditallow [checkbutton $fm_rules.auditallow -text "auditallow" \
-onvalue $::QPOL_RULE_AUDITALLOW -offvalue 0 \
-variable Apol_Cond_Rules::vals(rs:avrule_auditallow)]
set dontaudit [checkbutton $fm_rules.dontaudit -text "dontaudit" \
-onvalue $::QPOL_RULE_DONTAUDIT -offvalue 0 \
-variable Apol_Cond_Rules::vals(rs:avrule_dontaudit)]
set type_transition [checkbutton $fm_rules.type_transition -text "type_trans" \
-onvalue $::QPOL_RULE_TYPE_TRANS -offvalue 0 \
-variable Apol_Cond_Rules::vals(rs:type_transition)]
set type_member [checkbutton $fm_rules.type_member -text "type_member" \
-onvalue $::QPOL_RULE_TYPE_MEMBER -offvalue 0 \
-variable Apol_Cond_Rules::vals(rs:type_member)]
set type_change [checkbutton $fm_rules.type_change -text "type_change" \
-onvalue $::QPOL_RULE_TYPE_CHANGE -offvalue 0 \
-variable Apol_Cond_Rules::vals(rs:type_change)]
grid $allow $type_transition -sticky w -padx 2
grid $auditallow $type_member -sticky w -padx 2
grid $dontaudit $type_change -sticky w -padx 2
set ofm [$obox getframe]
set bool_frame [frame $ofm.bool]
pack $bool_frame -side left -padx 4 -pady 2 -anchor nw
set enable [checkbutton $bool_frame.enable \
-variable Apol_Cond_Rules::vals(enable_bool) \
-text "Boolean"]
set widgets(combo_box) [ComboBox $bool_frame.combo_box \
-textvariable Apol_Cond_Rules::vals(name) \
-helptext "Type or select a boolean variable" \
-state disabled -entrybg white -autopost 1]
set widgets(regexp) [checkbutton $bool_frame.regexp \
-text "Search using regular expression" \
-state disabled \
-variable Apol_Cond_Rules::vals(use_regexp)]
trace add variable Apol_Cond_Rules::vals(enable_bool) write \
[list Apol_Cond_Rules::_toggleSearchBools]
pack $enable -anchor w
pack $widgets(combo_box) $widgets(regexp) -padx 4 -anchor nw -expand 0 -fill x
set ok_button [button $ofm.ok -text OK -width 6 \
-command Apol_Cond_Rules::_search]
pack $ok_button -side right -anchor ne -padx 5 -pady 5
set widgets(results) [Apol_Widget::makeSearchResults [$dbox getframe].results]
pack $widgets(results) -expand yes -fill both
return $frame
}
proc Apol_Cond_Rules::open {ppath} {
variable widgets
$widgets(combo_box) configure -values [Apol_Cond_Bools::getBooleans]
}
proc Apol_Cond_Rules::close {} {
variable widgets
_initializeVars
$widgets(combo_box) configure -values {}
Apol_Widget::clearSearchResults $widgets(results)
}
proc Apol_Cond_Rules::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_Cond_Rules::_initializeVars {} {
variable vals
array set vals [list \
rs:avrule_allow $::QPOL_RULE_ALLOW \
rs:avrule_auditallow $::QPOL_RULE_AUDITALLOW \
rs:avrule_dontaudit $::QPOL_RULE_DONTAUDIT \
rs:type_transition $::QPOL_RULE_TYPE_TRANS \
rs:type_member $::QPOL_RULE_TYPE_MEMBER \
rs:type_change $::QPOL_RULE_TYPE_CHANGE \
enable_bool 0 \
name {} \
use_regexp 0]
}
proc Apol_Cond_Rules::_toggleSearchBools {name1 name2 op} {
variable vals
variable widgets
if {$vals(enable_bool)} {
$widgets(combo_box) configure -state normal
$widgets(regexp) configure -state normal
} else {
$widgets(combo_box) configure -state disabled
$widgets(regexp) configure -state disabled
}
}
proc Apol_Cond_Rules::_search {} {
variable vals
variable widgets
.mainframe.frame.nb.frules.nb.fApol_Cond_Rules.top.obox.f.ok configure -state disabled
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
.mainframe.frame.nb.frules.nb.fApol_Cond_Rules.top.obox.f.ok configure -state normal
return
}
set avrule_selection 0
foreach {key value} [array get vals rs:avrule_*] {
set avrule_selection [expr {$avrule_selection | $value}]
}
set terule_selection 0
foreach {key value} [array get vals rs:type_*] {
set terule_selection [expr {$terule_selection | $value}]
}
if {$avrule_selection == 0 && $terule_selection == 0} {
tk_messageBox -icon error -type ok -title "Error" -message "At least one rule must be selected."
.mainframe.frame.nb.frules.nb.fApol_Cond_Rules.top.obox.f.ok configure -state normal
return
}
set bool_name {}
if {$vals(enable_bool)} {
if {[set bool_name $vals(name)] == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No booleean selected."
.mainframe.frame.nb.frules.nb.fApol_Cond_Rules.top.obox.f.ok configure -state normal
return
}
}
set q [new_apol_cond_query_t]
$q set_bool $::ApolTop::policy $bool_name
if {$vals(use_regexp)} {
$q set_regex $::ApolTop::policy 1
}
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set results [cond_vector_to_list $v]
$v -acquire
$v -delete
if {[llength $results] == 0} {
set text "Search returned no results."
} else {
set text "[llength $results] conditional"
if {[llength $results] != 1} {
append text s
}
append text " match the search criteria. Expressions are in Reverse Polish Notation.\n\n"
}
Apol_Widget::appendSearchResultText $widgets(results) $text
if {![info exists apol_progress]} {
Apol_Progress_Dialog::wait "Conditional Expressions" "Rendering conditionals" \
{
if {[ApolTop::is_capable "syntactic rules"]} {
$::ApolTop::qpolicy build_syn_rule_table
}
set counter 1
set num_results [llength $results]
foreach r [lsort -index 0 $results] {
apol_tcl_set_info_string $::ApolTop::policy "Rendering $counter of $num_results"
set text [_renderConditional $r $avrule_selection $terule_selection $counter]
Apol_Widget::appendSearchResultText $widgets(results) "$text\n\n"
incr counter
}
}
}
.mainframe.frame.nb.frules.nb.fApol_Cond_Rules.top.obox.f.ok configure -state normal
}
proc Apol_Cond_Rules::_renderConditional {cond avrules terules cond_number} {
set cond_expr [apol_cond_expr_render $::ApolTop::policy $cond]
set i [$cond get_av_true_iter $::ApolTop::qpolicy $avrules]
set av_true_vector [new_apol_vector_t $i]
$i -acquire
$i -delete
set i [$cond get_av_false_iter $::ApolTop::qpolicy $avrules]
set av_false_vector [new_apol_vector_t $i]
$i -acquire
$i -delete
set i [$cond get_te_true_iter $::ApolTop::qpolicy $terules]
set te_true_vector [new_apol_vector_t $i]
$i -acquire
$i -delete
set i [$cond get_te_false_iter $::ApolTop::qpolicy $terules]
set te_false_vector [new_apol_vector_t $i]
$i -acquire
$i -delete
variable widgets
set text "conditional expression $cond_number: \[ [join $cond_expr] \]\n"
Apol_Widget::appendSearchResultText $widgets(results) "$text\nTRUE list:\n"
if {![ApolTop::is_capable "syntactic rules"]} {
apol_tcl_avrule_sort $::ApolTop::policy $av_true_vector
Apol_Widget::appendSearchResultRules $widgets(results) 4 $av_true_vector qpol_avrule_from_void
apol_tcl_terule_sort $::ApolTop::policy $te_true_vector
Apol_Widget::appendSearchResultRules $widgets(results) 4 $te_true_vector qpol_terule_from_void
} else {
set syn_avrules [apol_avrule_list_to_syn_avrules $::ApolTop::policy $av_true_vector NULL]
Apol_Widget::appendSearchResultSynRules $widgets(results) 4 $syn_avrules qpol_syn_avrule_from_void
set syn_terules [apol_terule_list_to_syn_terules $::ApolTop::policy $te_true_vector]
Apol_Widget::appendSearchResultSynRules $widgets(results) 4 $syn_terules qpol_syn_terule_from_void
$syn_avrules -acquire
$syn_avrules -delete
$syn_terules -acquire
$syn_terules -delete
}
Apol_Widget::appendSearchResultText $widgets(results) "\nFALSE list:\n"
if {![ApolTop::is_capable "syntactic rules"]} {
apol_tcl_avrule_sort $::ApolTop::policy $av_false_vector
Apol_Widget::appendSearchResultRules $widgets(results) 4 $av_false_vector qpol_avrule_from_void
apol_tcl_terule_sort $::ApolTop::policy $te_false_vector
Apol_Widget::appendSearchResultRules $widgets(results) 4 $te_false_vector qpol_terule_from_void
} else {
set syn_avrules [apol_avrule_list_to_syn_avrules $::ApolTop::policy $av_false_vector NULL]
Apol_Widget::appendSearchResultSynRules $widgets(results) 4 $syn_avrules qpol_syn_avrule_from_void
set syn_terules [apol_terule_list_to_syn_terules $::ApolTop::policy $te_false_vector]
Apol_Widget::appendSearchResultSynRules $widgets(results) 4 $syn_terules qpol_syn_terule_from_void
$syn_avrules -acquire
$syn_avrules -delete
$syn_terules -acquire
$syn_terules -delete
}
$av_true_vector -acquire
$av_true_vector -delete
$av_false_vector -acquire
$av_false_vector -delete
$te_true_vector -acquire
$te_true_vector -delete
$te_false_vector -acquire
$te_false_vector -delete
}
namespace eval Apol_Constraint {
variable vals
variable widgets
variable tabs
variable enabled
variable opts
variable constraint_list {}
variable left_expr_list {}
variable right_expr_list {}
variable mls_enabled {0}
variable match_right_type_names 0
variable statement_count 0
}
proc Apol_Constraint::create {tab_name nb} {
variable vals
variable widgets
_initializeVars
set frame [$nb insert end $tab_name -text "Constraints"]
set pw [PanedWindow $frame.pw -side left -weights extra]
set topf [$pw add -weight 0]
set bottomf [$pw add -weight 1]
pack $pw -expand 1 -fill both
set top_leftf [frame $topf.tl]
set widgets(search_opts) [NoteBook $topf.nb]
set abox [frame $topf.abox]
pack $top_leftf -side left -expand 0 -fill y
pack $widgets(search_opts) -side left -expand 1 -fill both -padx 10
pack $abox -side right -fill y -padx 5
set rsbox [TitleFrame $top_leftf.rsbox -text "Constraint Selection"]
set rbox [TitleFrame $bottomf.rbox -text "Constraint Search Results"]
pack $rsbox -side top -fill both -expand 1
pack $rbox -expand yes -fill both -padx 2
set fm_constraints [$rsbox getframe]
set constrain [checkbutton $fm_constraints.constrain -text "constrain" \
-onvalue 1 -offvalue 0 \
-variable Apol_Constraint::vals(rs:constrain_enabled)]
set mlsconstrain [checkbutton $fm_constraints.mlsconstrain -text "mlsconstrain" \
-onvalue 1 -offvalue 0 \
-variable Apol_Constraint::vals(rs:mlsconstrain_enabled)]
set validatetrans [checkbutton $fm_constraints.validatetrans -text "validatetrans" \
-onvalue 1 -offvalue 0 \
-variable Apol_Constraint::vals(rs:validatetrans_enabled)]
set mlsvalidatetrans [checkbutton $fm_constraints.mlsvalidatetrans -text "mlsvalidatetrans" \
-onvalue 1 -offvalue 0 \
-variable Apol_Constraint::vals(rs:mlsvalidatetrans_enabled)]
grid $constrain -sticky w -padx 10
grid $mlsconstrain -sticky w -padx 10
grid $validatetrans -sticky w -padx 10 -pady {30 0}
grid $mlsvalidatetrans -sticky w -padx 10
_createClassesPermsTab
_createLeftExpressionTab
_createRightExpressionTab
set widgets(new) [button $abox.new -text "New Search" -width 12 \
-command [list Apol_Constraint::_search_constraints new]]
set widgets(update) [button $abox.update -text "Update Search" -width 12 -state disabled \
-command [list Apol_Constraint::_search_constraints update]]
set widgets(reset) [button $abox.reset -text "Reset Criteria" -width 12 \
-command Apol_Constraint::_reset]
pack $widgets(new) $widgets(update) $widgets(reset) \
-side top -pady 5 -padx 5 -anchor ne
$widgets(search_opts) compute_size
set popupTab_Menu [menu .popup_constrain_rules -tearoff 0]
set tab_menu_callbacks \
[list {"Close Tab" Apol_Constraint::_delete_results} \
{"Rename Tab" Apol_Constraint::_display_rename_tab_dialog}]
set widgets(results) [NoteBook [$rbox getframe].results]
$widgets(results) bindtabs <Button-1> Apol_Constraint::_switch_to_tab
$widgets(results) bindtabs <Button-3> \
[list ApolTop::popup \
%W %x %y $popupTab_Menu $tab_menu_callbacks]
set close [button [$rbox getframe].close -text "Close Tab" \
-command Apol_Constraint::_delete_current_results]
pack $widgets(results) -expand 1 -fill both -padx 4
pack $close -expand 0 -fill x -padx 4 -pady 2
_initializeVars
return $frame
}
proc Apol_Constraint::open {ppath} {
variable mls_enabled
if {[ApolTop::is_capable "mls"]} {
set mls_enabled 1
} else {
set mls_enabled 0
}
_initializeVars
_initializeWidgets
_initializeTabs
variable vals
variable enabled
set vals(cp:classes) [Apol_Class_Perms::getClasses]
set enabled(cp:classes) 1
set enabled(cp:perms) 1
}
proc Apol_Constraint::close {} {
_initializeTabs
_initializeWidgets
_initializeVars
set enabled(cp:perms) 1
variable constraint_list {}
variable left_expr_list {}
variable right_expr_list {}
}
proc Apol_Constraint::getTextWidget {} {
variable widgets
variable tabs
if {[$widgets(results) pages] != {}} {
set raisedPage [$widgets(results) raise]
if {$raisedPage != {}} {
return $tabs($raisedPage).tb
}
}
return {}
}
proc Apol_Constraint::save_query_options {file_channel query_file} {
variable vals
foreach {key value} [array get vals] {
if {$key != "cp:classes" && $key != "cp:perms"} {
puts $file_channel "$key $value"
}
}
}
proc Apol_Constraint::load_query_options {file_channel} {
variable vals
variable widgets
variable enabled
_initializeVars
set classes_selected {}
set perms_selected {}
while {[gets $file_channel line] >= 0} {
set line [string trim $line]
if {$line == {} || [string index $line 0] == "#"} {
continue
}
regexp -line -- {^(\S+)( (.+))?} $line -> key --> value
if {$key == "cp:classes_selected"} {
set classes_selected $value
} elseif {$key == "cp:perms_selected"} {
set perms_selected $value
} else {
set vals($key) $value
}
}
_initializeWidgets
set vals(cp:classes) [Apol_Class_Perms::getClasses]
set enabled(cp:classes) 1
set enabled(cp:perms) 1
_toggle_perms_toshow -> -> reset
set unknowns {}
set vals(cp:classes_selected) {}
foreach class $classes_selected {
if {[set i [lsearch $vals(cp:classes) $class]] >= 0} {
$widgets(cp:classes) selection set $i
lappend vals(cp:classes_selected) $class
} else {
lappend unknowns $class
}
}
if {[llength $unknowns] > 0} {
tk_messageBox -icon warning -type ok -title "Open Apol Query" \
-message "The following object classes do not exist in the currently loaded policy and were ignored:\n\n[join $unknowns ", "]" \
-parent .
}
_toggle_perms_toshow {} {} {}
set unknowns {}
set vals(cp:perms_selected) {}
foreach perm $perms_selected {
if {[set i [lsearch $vals(cp:perms) $perm]] >= 0} {
$widgets(cp:perms) selection set $i
lappend vals(cp:perms_selected) $perm
} else {
lappend unknowns $perm
}
}
if {[llength $unknowns] > 0} {
tk_messageBox -icon warning -type ok -title "Open Apol Query" \
-message "The following permissions do not exist in the currently loaded policy and were ignored:\n\n[join $unknowns ", "]" \
-parent $parentDlg
}
}
proc Apol_Constraint::_initializeVars {} {
variable vals
variable mls_enabled
array set vals [list \
rs:constrain_enabled 1 \
rs:mlsconstrain_enabled $mls_enabled \
rs:validatetrans_enabled 1 \
rs:mlsvalidatetrans_enabled $mls_enabled \
kta:left_expr,left_keyword 1 \
kta:right_expr,right_keyword 0 \
kta:right_expr,types 0 \
kta:right_expr,users 0 \
kta:right_expr,roles 0 \
kta:right_expr,attribs 0 \
]
array set vals {
kta:use_left_expr 0
kta:left_expr {}
kta:use_right_expr 0
kta:right_expr {}
kta:right_expr_replace_types 0
cp:classes {}
cp:classes_selected {}
cp:perms {}
cp:perms_selected {}
cp:perms_toshow all
cp:perms_matchall 0
}
variable enabled
array set enabled {
kta:use_left_expr 1
kta:use_right_expr 1
cp:classes 0
cp:perms 0
}
}
proc Apol_Constraint::_initializeTabs {} {
variable widgets
variable tabs
array set tabs {
next_result_id 1
}
foreach p [$widgets(results) pages 0 end] {
_delete_results $p
}
}
proc Apol_Constraint::_initializeWidgets {} {
variable widgets
$widgets(search_opts) raise left_expr_entry
$widgets(search_opts) raise right_expr_entry
$widgets(cp:classes) selection clear 0 end
$widgets(cp:perms) selection clear 0 end
}
proc Apol_Constraint::_createLeftExpressionTab {} {
variable vals
variable widgets
variable enabled
set ta_tab [$widgets(search_opts) insert end left_expr_entry -text "Left Side of Expression"]
set fm_left_expr [frame $ta_tab.left_expr]
grid $fm_left_expr -padx 4 -sticky ewns
foreach i {0} {
grid columnconfigure $ta_tab $i -weight 1 -uniform 1
}
grid rowconfigure $ta_tab 0 -weight 1
_create_expression_box left_expr $fm_left_expr "Keyword" 1 0
$widgets(search_opts) raise left_expr_entry
}
proc Apol_Constraint::_createRightExpressionTab {} {
variable vals
variable widgets
variable enabled
set ta_tab [$widgets(search_opts) insert end right_expr_entry -text "Right Side of Expression"]
set fm_right_expr [frame $ta_tab.right_expr]
grid $fm_right_expr -padx 4 -sticky ewns
foreach i {0} {
grid columnconfigure $ta_tab $i -weight 1 -uniform 1
}
grid rowconfigure $ta_tab 0 -weight 1
_create_expression_box right_expr $fm_right_expr "Select either a keyword, user, role, type or type attribute" 0 1
$widgets(search_opts) raise right_expr_entry
}
proc Apol_Constraint::_create_expression_box {prefix f title left_expr right_expr} {
variable vals
variable widgets
set widgets(kta:use_${prefix}) [checkbutton $f.use -text $title \
-variable Apol_Constraint::vals(kta:use_${prefix})]
pack $widgets(kta:use_${prefix}) -side top -anchor w
trace add variable Apol_Constraint::vals(kta:use_${prefix}) write \
[list Apol_Constraint::_toggle_expression_box $prefix]
set w {}
if {$right_expr} {
set helptext "Select a keyword, user, role, type or type attribute for the right hand side of the constraint expression e.g.: \
\n (left right) \
\n (t1 == mlstrustedobject) \
\n (r1 dom r2) \
\n (r1 != system_r)\n \
\nIf a type or attribute is selected the \"Only direct matches\" box can be used to determine searching as follows:\n \
\n - If selected the type or type attribute identifier will be used for the match.\n \
\n - If unselected and a type is selected: \
\n The type identifier will be used for matching, also any type attributes found within the constraints expression will \
\n be expanded and its list of types searched for a match.\n \
\n - If unselected and an attribute is selected: \
\n The type attribute identifier will be used for matching, also any types found within the constraints expression will \
\n have its associated type attributes searched for a match.\n"
} else {
set helptext "Select a keyword for the left hand side of the constraint expression e.g.: \
\n (left right)\n (r1 == r2)"
}
set widgets(kta:${prefix}) [ComboBox $f.sym \
-state disabled -entrybg $ApolTop::default_bg_color \
-textvariable Apol_Constraint::vals(kta:${prefix}) \
-helptext $helptext -autopost 1]
pack $widgets(kta:${prefix}) -expand 0 -fill x -padx 8
lappend w $widgets(kta:${prefix})
if {$left_expr} {
set ta_frame [frame $f.ta]
pack $ta_frame -expand 0 -anchor center -pady 2
trace add variable Apol_Constraint::vals(kta:${prefix},left_keyword) write \
[list Apol_Constraint::_toggle_left_side $prefix]
pack $widgets(kta:${prefix}) -expand 0 -fill x -padx 8
lappend w $widgets(kta:${prefix})
}
if {$right_expr} {
set ta_frame [frame $f.ta]
pack $ta_frame -expand 0 -anchor w -pady 2
set right_keyword [checkbutton $ta_frame.right_keyword -text "Keyword" -state disabled \
-onvalue 1 -offvalue 0 \
-variable Apol_Constraint::vals(kta:${prefix},right_keyword)]
set users [checkbutton $ta_frame.users -text "Users" -state disabled \
-onvalue 1 -offvalue 0 \
-variable Apol_Constraint::vals(kta:${prefix},users)]
set roles [checkbutton $ta_frame.roles -text "Roles" -state disabled \
-onvalue 1 -offvalue 0 \
-variable Apol_Constraint::vals(kta:${prefix},roles)]
set types [checkbutton $ta_frame.types -text "Types" -state disabled \
-onvalue 1 -offvalue 0 \
-variable Apol_Constraint::vals(kta:${prefix},types)]
set attribs [checkbutton $ta_frame.attribs -text "Attributes" -state disabled \
-onvalue 1 -offvalue 0 \
-variable Apol_Constraint::vals(kta:${prefix},attribs)]
$right_keyword configure -command [list Apol_Constraint::_toggle_kta_pushed $prefix $right_keyword]
$users configure -command [list Apol_Constraint::_toggle_kta_pushed $prefix $users]
$roles configure -command [list Apol_Constraint::_toggle_kta_pushed $prefix $roles]
$types configure -command [list Apol_Constraint::_toggle_kta_pushed $prefix $types]
$attribs configure -command [list Apol_Constraint::_toggle_kta_pushed $prefix $attribs]
trace add variable Apol_Constraint::vals(kta:${prefix},right_keyword) write \
[list Apol_Constraint::_toggle_right_side $prefix]
trace add variable Apol_Constraint::vals(kta:${prefix},users) write \
[list Apol_Constraint::_toggle_right_side $prefix]
trace add variable Apol_Constraint::vals(kta:${prefix},roles) write \
[list Apol_Constraint::_toggle_right_side $prefix]
trace add variable Apol_Constraint::vals(kta:${prefix},types) write \
[list Apol_Constraint::_toggle_right_side $prefix]
trace add variable Apol_Constraint::vals(kta:${prefix},attribs) write \
[list Apol_Constraint::_toggle_right_side $prefix]
pack $right_keyword $users $roles $types $attribs -side left -anchor w -padx 2
lappend w $right_keyword $users $roles $types $attribs
}
set widgets(kta:${prefix}_widgets) $w
trace add variable Apol_Constraint::enabled(kta:use_${prefix}) write \
[list Apol_Constraint::_toggle_left_right_box $prefix]
}
proc Apol_Constraint::_toggle_expression_box {col name1 name2 op} {
variable enabled
set enabled(kta:use_${col}) $enabled(kta:use_${col})
}
proc Apol_Constraint::_toggle_kta_pushed {col cb} {
variable vals
if {($vals(kta:${col},right_keyword) && $vals(kta:${col},attribs)) || \
($vals(kta:${col},right_keyword) && $vals(kta:${col},users)) || \
($vals(kta:${col},right_keyword) && $vals(kta:${col},roles)) || \
($vals(kta:${col},right_keyword) && $vals(kta:${col},types)) || \
($vals(kta:${col},attribs) && $vals(kta:${col},users)) || \
($vals(kta:${col},attribs) && $vals(kta:${col},roles)) || \
($vals(kta:${col},attribs) && $vals(kta:${col},types)) || \
($vals(kta:${col},users) && $vals(kta:${col},roles)) || \
($vals(kta:${col},users) && $vals(kta:${col},types)) || \
($vals(kta:${col},roles) && $vals(kta:${col},types)) } {
tk_messageBox -icon error -type ok -title "Constraint Search" -message "Select either a keyword, user, role, type or type attribute."
$cb deselect
return
}
}
proc Apol_Constraint::_toggle_left_right_box {col name1 name2 op} {
variable vals
variable widgets
variable enabled
if {$enabled(kta:use_${col})} {
$widgets(kta:use_${col}) configure -state normal
} else {
$widgets(kta:use_${col}) configure -state disabled
}
if {$enabled(kta:use_${col}) && $vals(kta:use_${col})} {
foreach w $widgets(kta:${col}_widgets) {
$w configure -state normal
}
$widgets(kta:${col}) configure -entrybg white
} else {
foreach w $widgets(kta:${col}_widgets) {
$w configure -state disabled
}
$widgets(kta:${col}) configure -entrybg $ApolTop::default_bg_color
}
if {($enabled(kta:use_left_expr) && $vals(kta:use_left_expr))} {
$widgets(search_opts) itemconfigure left_expr_entry -text "Left Side of Expression *"
} else {
$widgets(search_opts) itemconfigure left_expr_entry -text "Left Side of Expression"
}
if {($enabled(kta:use_right_expr) && $vals(kta:use_right_expr))} {
$widgets(search_opts) itemconfigure right_expr_entry -text "Right Side of Expression *"
} else {
$widgets(search_opts) itemconfigure right_expr_entry -text "Right Side of Expression"
}
}
proc Apol_Constraint::_toggle_left_side {col name1 name2 op} {
variable vals
variable widgets
set items {}
if {$vals(kta:${col},left_keyword)} {
append items [Apol_Constraint::getLeftKeyword]
}
$widgets(kta:${col}) configure -values $items
}
proc Apol_Constraint::_toggle_right_side {col name1 name2 op} {
variable vals
variable widgets
set items {}
if {$vals(kta:${col},right_keyword)} {
append items [Apol_Constraint::getRightKeyword]
}
if {$vals(kta:${col},users)} {
append items [Apol_Users::getUsers]
}
if {$vals(kta:${col},roles)} {
append items [Apol_Roles::getRoles]
}
if {$vals(kta:${col},types)} {
append items [Apol_Types::getTypes]
}
if {$vals(kta:${col},attribs)} {
append items [Apol_Types::getAttributes]
}
$widgets(kta:${col}) configure -values $items
}
proc Apol_Constraint::getLeftKeyword {} {
variable vals
variable left_expr_list
set left_expr_list {}
if {[ApolTop::is_policy_open]} {
if { $vals(rs:constrain_enabled) == 1 || $vals(rs:mlsconstrain_enabled) == 1 } {
append left_expr_list [Apol_Constraint::_getKeywords "l" new_apol_constraint_query_t]
}
if { $vals(rs:validatetrans_enabled) == 1 || $vals(rs:mlsvalidatetrans_enabled) == 1 } {
append left_expr_list [Apol_Constraint::_getKeywords "l" new_apol_validatetrans_query_t]
}
lsort -unique $left_expr_list
} else {
set left_expr_list ""
}
}
proc Apol_Constraint::getRightKeyword {} {
variable vals
variable right_expr_list
set right_expr_list {}
if {[ApolTop::is_policy_open]} {
if { $vals(rs:constrain_enabled) == 1 || $vals(rs:mlsconstrain_enabled) == 1 } {
append right_expr_list [Apol_Constraint::_getKeywords "r" new_apol_constraint_query_t]
}
if { $vals(rs:validatetrans_enabled) == 1 || $vals(rs:mlsvalidatetrans_enabled) == 1 } {
append right_expr_list [Apol_Constraint::_getKeywords "r" new_apol_validatetrans_query_t]
}
lsort -unique $right_expr_list
} else {
set right_expr_list ""
}
}
proc Apol_Constraint::_createClassesPermsTab {} {
variable vals
variable widgets
variable enabled
set objects_tab [$widgets(search_opts) insert end classperms -text "Classes/Permissions"]
set fm_objs [TitleFrame $objects_tab.objs -text "Object Classes"]
set fm_perms [TitleFrame $objects_tab.perms -text "Permissions"]
pack $fm_objs -side left -expand 0 -fill both -padx 2 -pady 2
pack $fm_perms -side left -expand 1 -fill both -padx 2 -pady 2
set sw [ScrolledWindow [$fm_objs getframe].sw -auto both]
set widgets(cp:classes) [listbox [$sw getframe].lb -height 5 -width 24 \
-highlightthickness 0 -selectmode multiple \
-exportselection 0 -state disabled \
-bg $ApolTop::default_bg_color \
-listvar Apol_Constraint::vals(cp:classes)]
$sw setwidget $widgets(cp:classes)
update
grid propagate $sw 0
bind $widgets(cp:classes) <<ListboxSelect>> \
[list Apol_Constraint::_toggle_cp_select classes]
pack $sw -expand 1 -fill both
set clear [button [$fm_objs getframe].b -text "Clear" -width 6 -state disabled \
-command [list Apol_Constraint::_clear_cp_listbox $widgets(cp:classes) classes]]
pack $clear -expand 0 -pady 2
set widgets(cp:classes_widgets) [list $widgets(cp:classes) $clear]
set f [$fm_perms getframe]
set sw [ScrolledWindow $f.sw -auto both]
set widgets(cp:perms) [listbox [$sw getframe].lb -height 5 -width 24 \
-highlightthickness 0 -selectmode multiple \
-exportselection 0 -bg white \
-listvar Apol_Constraint::vals(cp:perms)]
$sw setwidget $widgets(cp:perms)
update
grid propagate $sw 0
bind $widgets(cp:perms) <<ListboxSelect>> \
[list Apol_Constraint::_toggle_cp_select perms]
set clear [button $f.clear -text "Clear" \
-command [list Apol_Constraint::_clear_cp_listbox $widgets(cp:perms) perms]]
set reverse [button $f.reverse -text "Reverse" \
-command [list Apol_Constraint::_reverse_cp_listbox $widgets(cp:perms)]]
set perm_opts_f [frame $f.perms]
set perm_rb_f [frame $perm_opts_f.rb]
set l [label $perm_rb_f.l -text "Permissions to show:" -state disabled]
set all [radiobutton $perm_rb_f.all -text "All" \
-variable Apol_Constraint::vals(cp:perms_toshow) -value all]
set union [radiobutton $perm_rb_f.union -text "All for selected classes" \
-variable Apol_Constraint::vals(cp:perms_toshow) -value union]
set intersect [radiobutton $perm_rb_f.inter -text "Common to selected classes" \
-variable Apol_Constraint::vals(cp:perms_toshow) -value intersect]
trace add variable Apol_Constraint::vals(cp:perms_toshow) write \
Apol_Constraint::_toggle_perms_toshow
pack $l $all $union $intersect -anchor w
set all_perms [checkbutton $perm_opts_f.all -text "Constraint must have all selected permissions" \
-variable Apol_Constraint::vals(cp:perms_matchall)]
pack $perm_rb_f $all_perms -anchor w -pady 4 -padx 4
grid $sw - $perm_opts_f -sticky nsw
grid $clear $reverse ^ -pady 2 -sticky ew
grid columnconfigure $f 0 -weight 0 -uniform 1 -pad 2
grid columnconfigure $f 1 -weight 0 -uniform 1 -pad 2
grid columnconfigure $f 2 -weight 1
grid rowconfigure $f 0 -weight 1
set widgets(cp:perms_widgets) \
[list $widgets(cp:perms) $clear $reverse $l $all $union $intersect $all_perms]
trace add variable Apol_Constraint::vals(cp:classes_selected) write \
[list Apol_Constraint::_update_cp_tabname]
trace add variable Apol_Constraint::vals(cp:perms_selected) write \
[list Apol_Constraint::_update_cp_tabname]
trace add variable Apol_Constraint::enabled(cp:classes) write \
[list Apol_Constraint::_toggle_enable_cp classes]
trace add variable Apol_Constraint::enabled(cp:perms) write \
[list Apol_Constraint::_toggle_enable_cp perms]
}
proc Apol_Constraint::_toggle_enable_cp {prefix name1 name2 op} {
variable vals
variable widgets
variable enabled
if {$enabled(cp:${prefix})} {
foreach w $widgets(cp:${prefix}_widgets) {
$w configure -state normal
}
$widgets(cp:${prefix}) configure -bg white
} else {
foreach w $widgets(cp:${prefix}_widgets) {
$w configure -state disabled
}
$widgets(cp:${prefix}) configure -bg $ApolTop::default_bg_color
}
set vals(cp:${prefix}_selected) $vals(cp:${prefix}_selected)
}
proc Apol_Constraint::_toggle_perms_toshow {name1 name2 op} {
variable vals
variable widgets
if {$vals(cp:perms_toshow) == "all"} {
if {$op != "update"} {
set vals(cp:perms) $Apol_Class_Perms::perms_list
set vals(cp:perms_selected) {}
}
} elseif {$vals(cp:perms_toshow) == "union"} {
set vals(cp:perms) {}
set vals(cp:perms_selected) {}
foreach class $vals(cp:classes_selected) {
set vals(cp:perms) [lsort -unique -dictionary [concat $vals(cp:perms) [Apol_Class_Perms::getPermsForClass $class]]]
}
} else { ;# intersection
set vals(cp:perms) {}
set vals(cp:perms_selected) {}
set classes {}
foreach i [$widgets(cp:classes) curselection] {
lappend classes [$widgets(cp:classes) get $i]
}
if {$classes == {}} {
return
}
set vals(cp:perms) [Apol_Class_Perms::getPermsForClass [lindex $classes 0]]
foreach class [lrange $classes 1 end] {
set this_perms [Apol_Class_Perms::getPermsForClass $class]
set new_perms {}
foreach p $vals(cp:perms) {
if {[lsearch -exact $this_perms $p] >= 0} {
lappend new_perms $p
}
}
set vals(cp:perms) $new_perms
}
}
}
proc Apol_Constraint::_toggle_cp_select {col} {
variable vals
variable widgets
set items {}
foreach i [$widgets(cp:${col}) curselection] {
lappend items [$widgets(cp:${col}) get $i]
}
set vals(cp:${col}_selected) $items
if {$col == "classes"} {
_toggle_perms_toshow {} {} update
}
}
proc Apol_Constraint::_clear_cp_listbox {lb prefix} {
variable vals
$lb selection clear 0 end
set vals(cp:${prefix}_selected) {}
if {$prefix == "classes"} {
_toggle_perms_toshow {} {} update
}
}
proc Apol_Constraint::_reverse_cp_listbox {lb} {
variable vals
set old_selection [$lb curselection]
set items {}
for {set i 0} {$i < [$lb index end]} {incr i} {
if {[lsearch $old_selection $i] >= 0} {
$lb selection clear $i
} else {
$lb selection set $i
lappend items [$lb get $i]
}
}
set vals(cp:perms_selected) $items
}
proc Apol_Constraint::_update_cp_tabname {name1 name2 op} {
variable vals
variable widgets
variable enabled
if {($enabled(cp:classes) && $vals(cp:classes_selected) > 0) || \
($enabled(cp:perms) && $vals(cp:perms_selected) > 0)} {
$widgets(search_opts) itemconfigure classperms -text "Classes/Permissions *"
} else {
$widgets(search_opts) itemconfigure classperms -text "Classes/Permissions"
}
}
proc Apol_Constraint::_delete_results {pageID} {
variable widgets
variable tabs
set curpos [$widgets(results) index $pageID]
$widgets(results) delete $pageID
array unset tabs $pageID:*
array unset tabs $pageID
if {[set next_id [$widgets(results) pages $curpos]] != {}} {
_switch_to_tab $next_id
} elseif {$curpos > 0} {
_switch_to_tab [$widgets(results) pages [expr {$curpos - 1}]]
} else {
$widgets(update) configure -state disabled
}
}
proc Apol_Constraint::_display_rename_tab_dialog {pageID} {
variable widgets
variable tabs
set d [Dialog .apol_te_tab_rename -homogeneous 1 -spacing 2 -cancel 1 \
-default 0 -modal local -parent . -place center -separator 1 \
-side bottom -title "Rename Results Tab"]
$d add -text "OK" -command [list $d enddialog "ok"]
$d add -text "Cancel" -command [list $d enddialog "cancel"]
set f [$d getframe]
set l [label $f.l -text "Tab name:"]
set tabs(tab:new_name) [$widgets(results) itemcget $pageID -text]
set e [entry $f.e -textvariable Apol_Constraint::tabs(tab:new_name) -width 16 -bg white]
pack $l $e -side left -padx 2
set retval [$d draw]
destroy $d
if {$retval == "ok"} {
$widgets(results) itemconfigure $pageID -text $tabs(tab:new_name)
}
}
proc Apol_Constraint::_delete_current_results {} {
variable widgets
if {[set curid [$widgets(results) raise]] != {}} {
_delete_results $curid
}
}
proc Apol_Constraint::_create_new_results_tab {} {
variable vals
variable widgets
variable tabs
set i $tabs(next_result_id)
incr tabs(next_result_id)
set id "results$i"
set frame [$widgets(results) insert end "$id" -text "Results $i"]
$widgets(results) raise $id
set tabs($id) [Apol_Widget::makeSearchResults $frame.results]
pack $tabs($id) -expand 1 -fill both
set tabs($id:vals) [array get vals]
return $tabs($id)
}
proc Apol_Constraint::_switch_to_tab {pageID} {
variable vals
variable widgets
variable tabs
if {[$Apol_Constraint::widgets(results) raise] == $pageID} {
return
}
$widgets(results) raise $pageID
set cur_search_opts [$widgets(search_opts) raise]
array set tmp_vals $tabs($pageID:vals)
set classes_selected $tmp_vals(cp:classes_selected)
set perms_selected $tmp_vals(cp:perms_selected)
array set vals $tabs($pageID:vals)
_initializeWidgets
set vals(cp:classes_selected) $classes_selected
set vals(cp:perms_selected) $perms_selected
foreach c $classes_selected {
$widgets(cp:classes) selection set [lsearch $vals(cp:classes) $c]
}
foreach p $perms_selected {
$widgets(cp:perms) selection set [lsearch $vals(cp:perms) $p]
}
$widgets(search_opts) raise $cur_search_opts
}
proc Apol_Constraint::_reset {} {
variable enabled
set old_classes_enabled $enabled(cp:classes)
_initializeVars
_initializeWidgets
if {[set enabled(cp:classes) $old_classes_enabled]} {
variable vals
set vals(cp:classes) [Apol_Class_Perms::getClasses]
set enabled(cp:classes) 1
set enabled(cp:perms) 1
}
}
proc Apol_Constraint::_search_constraints {whichButton} {
variable vals
variable widgets
variable enabled
variable tabs
variable statement_count
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Constraint Search" \
-message "No current policy file is opened."
return
}
if { $vals(rs:constrain_enabled) == 0 && \
$vals(rs:mlsconstrain_enabled) == 0 && \
$vals(rs:validatetrans_enabled) == 0 && \
$vals(rs:mlsvalidatetrans_enabled) == 0 } {
tk_messageBox -icon error -type ok -title "Constraint Search" \
-message "At least one constraint must be selected."
return
}
if {$whichButton == "new"} {
set sr [_create_new_results_tab]
} else {
set id [$widgets(results) raise]
set tabs($id:vals) [array get vals]
set sr $tabs($id)
Apol_Widget::clearSearchResults $sr
}
if {$enabled(kta:use_left_expr) && $vals(kta:use_left_expr) && $vals(kta:left_expr) == {}} {
tk_messageBox -icon error -type ok -title "Constraint Search" -message "No left keyword has been selected."
return
}
if {$enabled(kta:use_right_expr) && $vals(kta:use_right_expr) && $vals(kta:right_expr) == {}} {
tk_messageBox -icon error -type ok -title "Constraint Search" -message "No right keyword, type or attribute has been selected."
return
}
set results {}
set header {}
if { $vals(rs:constrain_enabled) == 1 } {
append results [Apol_Constraint::_searchForMatch "constrain" "constrain" new_apol_constraint_query_t]
append header "$statement_count constrain rules match the search criteria.\n"
}
if { $vals(rs:mlsconstrain_enabled) == 1 } {
append results [Apol_Constraint::_searchForMatch "mlsconstrain" "constrain" new_apol_constraint_query_t]
append header "$statement_count mlsconstrain rules match the search criteria.\n"
}
if { $vals(rs:validatetrans_enabled) == 1 } {
append results [Apol_Constraint::_searchForMatch "validatetrans" "validatetrans" new_apol_validatetrans_query_t]
append header "$statement_count validatetrans rules match the search criteria.\n"
}
if { $vals(rs:mlsvalidatetrans_enabled) == 1 } {
append results [Apol_Constraint::_searchForMatch "mlsvalidatetrans" "validatetrans" new_apol_validatetrans_query_t]
append header "$statement_count mlsvalidatetrans match the search criteria.\n"
}
foreach x {new update reset} {
$widgets($x) configure -state disabled
}
Apol_Progress_Dialog::wait "Constraint Rules" "Searching rules" {
Apol_Widget::appendSearchResultText $sr "$header\n"
Apol_Widget::appendSearchResultText $sr $results
}
$widgets(new) configure -state normal
$widgets(reset) configure -state normal
if {[$widgets(results) pages] != {} || $retval == 0} {
$widgets(update) configure -state normal
}
return
}
proc Apol_Constraint::_searchForMatch {statement family command} {
variable vals
variable widgets
variable enabled
variable match_right_type_names
variable statement_count
set statement_count 0
set entries {}
set q [$command]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set constrain_type {}
set perm_list {}
set class_list {}
set expr_type {}
set op {}
set sym_type {}
set match_left_keyword_names 0
set match_left_keyword_attr 0
set match_right_keyword_attr 0
set match_right_type_names 0
set q [qpol_constraint_from_void [$v get_element $i]]
set x [$q get_expr_iter $::ApolTop::qpolicy]
while {![$x end]} {
foreach t [iter_to_list $x] {
set t [qpol_constraint_expr_node_from_void $t]
set sym_type [$t get_sym_type $::ApolTop::qpolicy]
if { $sym_type >= $::QPOL_CEXPR_SYM_L1L2 } {
set constrain_type "mls"
break
}
}
}
append constrain_type $family
$x -acquire
$x -delete
if { $statement != $constrain_type } {
continue
}
set match_class 0
append class_list "\{ "
set class_name [[$q get_class $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
append class_list $class_name
append class_list " \}"
if {($enabled(cp:classes) && $vals(cp:classes_selected) > 0)} {
foreach c $vals(cp:classes_selected) {
if { $c == $class_name } {
set match_class 1
}
}
}
if {($match_class == 0 && $vals(cp:classes_selected) > 0)} {
continue
}
if { $family == "constrain" } {
set x [$q get_perm_iter $::ApolTop::qpolicy]
set match_perm 0
append perm_list "\{ "
foreach perm [iter_to_str_list $x] {
append perm_list "$perm "
if {($enabled(cp:perms) && $vals(cp:perms_selected) > 0)} {
foreach c $vals(cp:perms_selected) {
if { $c == $perm } {
set match_perm 1
}
}
}
}
if {($match_perm == 0 && $vals(cp:perms_selected) > 0)} {
continue
}
append perm_list "\}"
$x -acquire
$x -delete
}
set x [$q get_expr_iter $::ApolTop::qpolicy]
set constraint_expr_counter 0
set array constraint_expr_buf($constraint_expr_counter)
array unset constraint_expr_buf
# Operators: !, &&, ||. The ! applies only to an operand.
# Operands/expressions such as: (r1 == r2), (t1 != name)
while {![$x end]} {
foreach t [iter_to_list $x] {
set t [qpol_constraint_expr_node_from_void $t]
set op [$t get_op $::ApolTop::qpolicy]
set sym_type [$t get_sym_type $::ApolTop::qpolicy]
set expr_type [$t get_expr_type $::ApolTop::qpolicy]
# Now check expression for entry type !, && or ||.
if { $expr_type == $::QPOL_CEXPR_TYPE_NOT } {
set constraint_expr_counter [expr $constraint_expr_counter + 1]
append constraint_expr_buf($constraint_expr_counter) "not"
}
if { $expr_type == $::QPOL_CEXPR_TYPE_AND } {
set constraint_expr_counter [expr $constraint_expr_counter + 1]
append constraint_expr_buf($constraint_expr_counter) "and"
}
if { $expr_type == $::QPOL_CEXPR_TYPE_OR } {
set constraint_expr_counter [expr $constraint_expr_counter + 1]
append constraint_expr_buf($constraint_expr_counter) "or"
}
if { $expr_type == $::QPOL_CEXPR_TYPE_ATTR } {
set constraint_expr_counter [expr $constraint_expr_counter + 1]
set sym_name [Apol_Constraint::_getSym $sym_type]
append constraint_expr_buf($constraint_expr_counter) "( $sym_name "
if {$vals(kta:use_left_expr) == 1 && $vals(kta:left_expr) == $sym_name} {
set match_left_keyword_attr 1
}
set op [$t get_op $::ApolTop::qpolicy]
set op_name [Apol_Constraint::_getOp $op]
if { $op_name == "==" && \
([string compare -length 1 $sym_name "r"] == 0 || \
[string compare -length 1 $sym_name "l"] == 0 || \
[string compare -length 1 $sym_name "h"] == 0) } {
set op_name "eq"
}
append constraint_expr_buf($constraint_expr_counter) $op_name
set sym_type [expr $sym_type | $::QPOL_CEXPR_SYM_TARGET]
set sym_name [Apol_Constraint::_getSym $sym_type]
append constraint_expr_buf($constraint_expr_counter) " $sym_name )"
if {$vals(kta:use_right_expr) == 1 && \
$vals(kta:right_expr) == $sym_name && \
$vals(kta:right_expr,right_keyword) == 1} {
set match_right_keyword_attr 1
}
}
# ( t1 != { unconfined_t init_t } )
if { $expr_type == $::QPOL_CEXPR_TYPE_NAMES } {
set constraint_expr_counter [expr $constraint_expr_counter + 1]
set sym_name [Apol_Constraint::_getSym $sym_type]
append constraint_expr_buf($constraint_expr_counter) "( $sym_name "
if {$vals(kta:use_left_expr) == 1 && \
$vals(kta:left_expr) == $sym_name} {
set match_left_keyword_names 1
}
set op [$t get_op $::ApolTop::qpolicy]
set op_name [Apol_Constraint::_getOp $op]
append constraint_expr_buf($constraint_expr_counter) $op_name
set tmp_list {}
set return_list {}
set n [$t get_names_iter $::ApolTop::qpolicy]
set n_size [[$t get_names_iter $::ApolTop::qpolicy] get_size]
if { $n_size > 0 } {
foreach name [iter_to_str_list $n] {
append tmp_list "$name "
}
if { ([string compare -length 1 $sym_name "t"] == 0 && \
$vals(kta:use_right_expr) == 1) && \
($vals(kta:right_expr,types) == 1 || \
$vals(kta:right_expr,attribs) == 1) } {
set tmp_list [Apol_Constraint::_process_TA $vals(kta:right_expr) $tmp_list]
} elseif { ($vals(kta:use_right_expr) == 1 && \
$vals(kta:right_expr,roles) == 1 && \
[string compare -length 1 $sym_name "r"] == 0) || \
($vals(kta:use_right_expr) == 1 && \
$vals(kta:right_expr,users) == 1 && \
[string compare -length 1 $sym_name "u"] == 0) } {
foreach c $tmp_list {
if { $c == $vals(kta:right_expr) } {
set match_right_type_names 1
set tmp_list $name
continue
}
}
}
} elseif { $n_size == 0 } {
set tmp_list "<empty_set>"
if { [Apol_Constraint::_checkIfEmptyAttr $vals(kta:right_expr)] && \
[string compare -length 1 $sym_name "t"] == 0 } {
set match_right_type_names 1
}
}
if { [llength $tmp_list] > 1 } {
append constraint_expr_buf($constraint_expr_counter) " \{ $tmp_list\} )"
} else {
append constraint_expr_buf($constraint_expr_counter) " $tmp_list )"
}
$n -acquire
$n -delete
}
}
}
$x -acquire
$x -delete
if {($vals(kta:use_left_expr) == 1 && $vals(kta:use_right_expr) == 1) && \
[expr (($match_left_keyword_names | $match_left_keyword_attr) & \
($match_right_keyword_attr | $match_right_type_names))] == 0} {
continue
}
if {($vals(kta:use_left_expr) == 1 && $vals(kta:use_right_expr) == 0) && \
[expr $match_left_keyword_names | $match_left_keyword_attr] == 0} {
continue
}
if {($vals(kta:use_left_expr) == 0 && $vals(kta:use_right_expr) == 1) && \
($vals(kta:right_expr,users) == 1 || \
$vals(kta:right_expr,roles) == 1 || \
$vals(kta:right_expr,attribs) == 1 || \
$vals(kta:right_expr,types) == 1 || \
$vals(kta:right_expr,right_keyword) == 1) && \
[expr $match_right_type_names | $match_right_keyword_attr ] == 0} {
continue
}
set stack {}
foreach entry [lsort -integer [array names constraint_expr_buf]] {
set token $constraint_expr_buf($entry)
switch $token {
"not" - "and" - "or" {
lassign [Apol_Constraint::_pop stack] expr2rec expr2
# The ! is not treated the same as && || as it only
# applies to a single expression i.e. !(expression)
# So just pop the stack and add the !. Should there be
# another ! in the expression, then add brackets.
if { $token == "not" } {
set ans [string compare -length 1 $expr2 "not"]
if { $ans == 0 } {
lappend stack [list 1 "$token \($expr2\)"]
} else {
lappend stack [list 1 "$token$expr2"]
}
continue
} else {
lassign [Apol_Constraint::_pop stack] expr1rec expr1
lappend stack [list 1 "$expr1 $token $expr2"]
}
}
default {
lappend stack [list 2 $token]
}
}
}
if { [array size constraint_expr_buf] == 1 } {
set expression "[lindex $stack end 1];"
} else {
set expression "([lindex $stack end 1]);"
}
set statement_count [expr $statement_count + 1]
append entries "$constrain_type $class_list $perm_list\n $expression\n\n"
}
return $entries
}
proc Apol_Constraint::_pop {stk} {
upvar 1 $stk s
set val [lindex $s end]
set s [lreplace $s end end]
return $val
}
proc Apol_Constraint::_renderAttrib {attrib_name} {
set type_list {}
set qpol_type_datum [new_qpol_type_t $::ApolTop::qpolicy $attrib_name]
set i [$qpol_type_datum get_type_iter $::ApolTop::qpolicy]
foreach t [iter_to_list $i] {
set t [qpol_type_from_void $t]
lappend type_list [$t get_name $::ApolTop::qpolicy]
}
if { $type_list == "" } {
lappend type_list "<empty_set>"
}
$i -acquire
$i -delete
return $type_list
}
proc Apol_Constraint::_renderType {type_name} {
set qpol_type_datum [new_qpol_type_t $::ApolTop::qpolicy $type_name]
set aliases {}
set attribs {}
set i [$qpol_type_datum get_alias_iter $::ApolTop::qpolicy]
set aliases [iter_to_str_list $i]
$i -acquire
$i -delete
set i [$qpol_type_datum get_attr_iter $::ApolTop::qpolicy]
foreach a [iter_to_list $i] {
set a [qpol_type_from_void $a]
lappend attribs [$a get_name $::ApolTop::qpolicy]
}
$i -acquire
$i -delete
return $attribs
}
proc Apol_Constraint::_checkTypeOrAttr {name} {
set type_list {}
set qpol_type_datum [new_qpol_type_t $::ApolTop::qpolicy $name]
set x [$qpol_type_datum get_isattr $::ApolTop::qpolicy ]
if { $x == 1 } {
return "attribute"
} else {
return "type"
}
$x -acquire
$x -delete
}
proc Apol_Constraint::_getKeywords {side command} {
set list {}
set left_list {}
set right_list {}
set q [$command]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set expr_type {}
set sym_type {}
set q [qpol_constraint_from_void [$v get_element $i]]
set x [$q get_expr_iter $::ApolTop::qpolicy]
while {![$x end]} {
foreach t [iter_to_list $x] {
set t [qpol_constraint_expr_node_from_void $t]
set sym_type [$t get_sym_type $::ApolTop::qpolicy]
set expr_type [$t get_expr_type $::ApolTop::qpolicy]
if { $expr_type == $::QPOL_CEXPR_TYPE_ATTR } {
set sym_name [Apol_Constraint::_getSym $sym_type]
append left_list "$sym_name "
set sym_type [expr $sym_type | $::QPOL_CEXPR_SYM_TARGET]
set sym_name [Apol_Constraint::_getSym $sym_type]
append right_list "$sym_name "
}
if { $expr_type == $::QPOL_CEXPR_TYPE_NAMES } {
set sym_name [Apol_Constraint::_getSym $sym_type]
append left_list "$sym_name "
}
}
}
$x -acquire
$x -delete
if {$side == "l"} {
append list $left_list
} else {
append list $right_list
}
}
$v -acquire
$v -delete
return $list
}
proc Apol_Constraint::_process_TA {name search_list} {
variable match_right_type_names
variable vals
foreach ta $search_list {
if { $ta == $name } {
set match_right_type_names 1
return $search_list
}
}
return $search_list
}
proc Apol_Constraint::_getSym {sym_type} {
set symbol {}
if { $sym_type == $::QPOL_CEXPR_SYM_USER } {
append symbol "u1"
}
if { $sym_type == $::QPOL_CEXPR_SYM_ROLE } {
append symbol "r1"
}
if { $sym_type == $::QPOL_CEXPR_SYM_TYPE } {
append symbol "t1"
}
if { $sym_type == $::QPOL_CEXPR_SYM_USER+$::QPOL_CEXPR_SYM_TARGET } {
append symbol "u2"
}
if { $sym_type == $::QPOL_CEXPR_SYM_ROLE+$::QPOL_CEXPR_SYM_TARGET } {
append symbol "r2"
}
if { $sym_type == $::QPOL_CEXPR_SYM_TYPE+$::QPOL_CEXPR_SYM_TARGET } {
append symbol "t2"
}
if { $sym_type == $::QPOL_CEXPR_SYM_USER+$::QPOL_CEXPR_SYM_XTARGET } {
append symbol "u3"
}
if { $sym_type == $::QPOL_CEXPR_SYM_ROLE+$::QPOL_CEXPR_SYM_XTARGET } {
append symbol "r3"
}
if { $sym_type == $::QPOL_CEXPR_SYM_TYPE+$::QPOL_CEXPR_SYM_XTARGET } {
append symbol "t3"
}
if { $sym_type == $::QPOL_CEXPR_SYM_L1L2 } {
append symbol "l1"
}
if { $sym_type == $::QPOL_CEXPR_SYM_L1H2 } {
append symbol "l1"
}
if { $sym_type == $::QPOL_CEXPR_SYM_H1L2 } {
append symbol "h1"
}
if { $sym_type == $::QPOL_CEXPR_SYM_H1H2 } {
append symbol "h1"
}
if { $sym_type == $::QPOL_CEXPR_SYM_L1H1 } {
append symbol "l1"
}
if { $sym_type == $::QPOL_CEXPR_SYM_L2H2 } {
append symbol "l2"
}
if { $sym_type == $::QPOL_CEXPR_SYM_L1L2+$::QPOL_CEXPR_SYM_TARGET } {
append symbol "l2"
}
if { $sym_type == $::QPOL_CEXPR_SYM_L1H2+$::QPOL_CEXPR_SYM_TARGET } {
append symbol "h2"
}
if { $sym_type == $::QPOL_CEXPR_SYM_H1L2+$::QPOL_CEXPR_SYM_TARGET } {
append symbol "l2"
}
if { $sym_type == $::QPOL_CEXPR_SYM_H1H2+$::QPOL_CEXPR_SYM_TARGET } {
append symbol "h2"
}
if { $sym_type == $::QPOL_CEXPR_SYM_L1H1+$::QPOL_CEXPR_SYM_TARGET } {
append symbol "h1"
}
if { $sym_type == $::QPOL_CEXPR_SYM_L2H2+$::QPOL_CEXPR_SYM_TARGET } {
append symbol "h2"
}
if { $symbol == "" } {
append symbol "err_sym_missing"
}
return $symbol
}
proc Apol_Constraint::_getOp {op} {
set entry {}
if { $op == $::QPOL_CEXPR_OP_EQ } {
append entry "=="
}
if { $op == $::QPOL_CEXPR_OP_NEQ } {
append entry "!="
}
if { $op == $::QPOL_CEXPR_OP_DOM } {
append entry "dom"
}
if { $op == $::QPOL_CEXPR_OP_DOMBY } {
append entry "domby"
}
if { $op == $::QPOL_CEXPR_OP_INCOMP } {
append entry "incomp"
}
if { $entry == "" } {
append entry "op_missing"
}
return $entry
}
namespace eval Apol_Context_Dialog {
variable dialog ""
variable vars
}
proc Apol_Context_Dialog::getContext {{defaultContext {}} {defaultAttribute {}} {parent .}} {
variable dialog
variable vars
if {![winfo exists $dialog]} {
_create_dialog $parent
}
set user {}
set role {}
set type {}
set low_level {}
set high_level {}
array set vars [list $dialog:low_enable 0 $dialog:high_enable 0]
if {$defaultContext != {}} {
set user [$defaultContext get_user] #line causing segfault. most likely the entire $defaultContext doesn't exist
set role [$defaultContext get_role]
set type [$defaultContext get_type]
if {$defaultAttribute != {}} {
lappend type $defaultAttribute
}
set range [$defaultContext get_range]
if {$range != "NULL"} {
set low_level [$range get_low]
set high_level [$range get_high]
}
}
$vars($dialog:user_box) configure -values [Apol_Users::getUsers]
set vars($dialog:user) $user
if {$user == {}} {
set vars($dialog:user_enable) 0
} else {
set vars($dialog:user_enable) 1
}
$vars($dialog:role_box) configure -values [Apol_Roles::getRoles]
set vars($dialog:role) $role
if {$role == {}} {
set vars($dialog:role_enable) 0
} else {
set vars($dialog:role_enable) 1
}
Apol_Widget::resetTypeComboboxToPolicy $vars($dialog:type_box)
Apol_Widget::setTypeComboboxValue $vars($dialog:type_box) $type
if {$type == {}} {
set vars($dialog:type_enable) 0
} else {
set vars($dialog:type_enable) 1
}
Apol_Widget::resetLevelSelectorToPolicy $vars($dialog:low_level)
Apol_Widget::resetLevelSelectorToPolicy $vars($dialog:high_level)
if {[ApolTop::is_policy_open] && [ApolTop::is_capable "mls"]} {
if {$low_level != {}} {
set vars($dialog:low_enable) 1
Apol_Widget::setLevelSelectorLevel $vars($dialog:low_level) $low_level
}
if {$high_level != {} && $high_level != "NULL"} {
set vars($dialog:low_enable) 1
set vars($dialog:high_enable) 1
Apol_Widget::setLevelSelectorLevel $vars($dialog:high_level) $high_level
}
$vars($dialog:low_cb) configure -state normal
} else {
set vars($dialog:low_enable) 0
set vars($dialog:high_enable) 0
$vars($dialog:low_cb) configure -state disabled
}
$dialog.bbox _redraw
set retval [$dialog draw]
if {$retval == -1 || $retval == 1} {
return {}
}
set context [_get_context $dialog]
set attribute [lindex [Apol_Widget::getTypeComboboxValueAndAttrib $vars($dialog:type_box)] 1]
list $context $attribute
}
proc Apol_Context_Dialog::_create_dialog {parent} {
variable dialog
variable vars
set dialog [Dialog .context_dialog -modal local -parent $parent \
-separator 1 -homogeneous 1 -title "Select Context"]
array unset vars $dialog:*
set f [$dialog getframe]
set left_f [frame $f.left]
set user_f [frame $left_f.user]
set vars($dialog:user_cb) [checkbutton $user_f.enable -text "User" \
-variable Apol_Context_Dialog::vars($dialog:user_enable)]
set vars($dialog:user_box) [ComboBox $user_f.user -entrybg white \
-width 12 \
-textvariable Apol_Context_Dialog::vars($dialog:user) \
-autopost 1]
trace add variable Apol_Context_Dialog::vars($dialog:user_enable) write \
[list Apol_Context_Dialog::_user_changed $dialog]
pack $vars($dialog:user_cb) -anchor nw
pack $vars($dialog:user_box) -anchor nw -padx 4 -expand 0 -fill x
set role_f [frame $left_f.role]
set vars($dialog:role_cb) [checkbutton $role_f.enable -text "Role" \
-variable Apol_Context_Dialog::vars($dialog:role_enable)]
set vars($dialog:role_box) [ComboBox $role_f.role -entrybg white -width 12 \
-textvariable Apol_Context_Dialog::vars($dialog:role) -autopost 1]
trace add variable Apol_Context_Dialog::vars($dialog:role_enable) write \
[list Apol_Context_Dialog::_role_changed $dialog]
pack $vars($dialog:role_cb) -anchor nw
pack $vars($dialog:role_box) -anchor nw -padx 4 -expand 0 -fill x
set type_f [frame $left_f.type]
set vars($dialog:type_cb) [checkbutton $type_f.enable -text "Type" \
-variable Apol_Context_Dialog::vars($dialog:type_enable)]
set vars($dialog:type_box) [Apol_Widget::makeTypeCombobox $type_f.type]
pack $vars($dialog:type_cb) -anchor nw
pack $vars($dialog:type_box) -anchor nw -padx 4 -expand 0 -fill x
trace add variable Apol_Context_Dialog::vars($dialog:type_enable) write \
[list Apol_Context_Dialog::_type_changed $dialog]
pack $user_f $role_f $type_f -side top -expand 1 -fill x
set mlsbox [TitleFrame $f.mlsbox -text "MLS Range"]
set mls_f [$mlsbox getframe]
set vars($dialog:low_cb) [checkbutton $mls_f.low_cb -text "Single Level" \
-variable Apol_Context_Dialog::vars($dialog:low_enable)]
set vars($dialog:low_level) [Apol_Widget::makeLevelSelector $mls_f.low 8]
trace add variable Apol_Context_Dialog::vars($dialog:low_enable) write \
[list Apol_Context_Dialog::_low_changed $dialog]
set vars($dialog:high_cb) [checkbutton $mls_f.high_cb \
-text "High Level" \
-variable Apol_Context_Dialog::vars($dialog:high_enable)]
set vars($dialog:high_level) [Apol_Widget::makeLevelSelector $mls_f.high 8]
trace add variable Apol_Context_Dialog::vars($dialog:high_enable) write \
[list Apol_Context_Dialog::_high_changed $dialog]
grid $vars($dialog:low_cb) $vars($dialog:high_cb) -sticky w
grid $vars($dialog:low_level) $vars($dialog:high_level) -sticky nsew
grid columnconfigure $mls_f 0 -weight 1 -uniform 1 -pad 2
grid columnconfigure $mls_f 1 -weight 1 -uniform 1 -pad 2
grid rowconfigure $mls_f 1 -weight 1
pack $left_f $mlsbox -side left -expand 1 -fill both
$dialog add -text "OK" -command [list Apol_Context_Dialog::_okay $dialog]
$dialog add -text "Cancel"
}
proc Apol_Context_Dialog::_okay {dialog} {
variable vars
set context [new_apol_context_t]
if {[ApolTop::is_policy_open]} {
set p $::ApolTop::policy
} else {
set p NULL
}
if {$vars($dialog:user_enable)} {
if {[set user $vars($dialog:user)] == {}} {
tk_messageBox -icon error -type ok -title "Could Not Validate Context" \
-message "No user was selected."
return
}
$context set_user $p $user
}
if {$vars($dialog:role_enable)} {
if {[set role $vars($dialog:role)] == {}} {
tk_messageBox -icon error -type ok -title "Could Not Validate Context" \
-message "No role was selected."
return
}
$context set_role $p $role
}
if {$vars($dialog:type_enable)} {
set type [lindex [Apol_Widget::getTypeComboboxValueAndAttrib $vars($dialog:type_box)] 0]
if {$type == {}} {
tk_messageBox -icon error -type ok -title "Could Not Validate Context" \
-message "No type was selected."
return
}
$context set_type $p $type
}
if {$vars($dialog:low_enable)} {
set range [_get_range $dialog]
if {$range == {}} {
tk_messageBox -icon error -type ok -title "Could Not Validate Context" \
-message "No level was selected."
return
}
$context set_range $p $range
}
if {![ApolTop::is_policy_open] || [$context validate_partial $p] <= 0} {
tk_messageBox -icon error -type ok -title "Could Not Validate Context" \
-message "The selected context is not valid for the current policy."
return
} else {
$dialog enddialog 0
}
$context -acquire
$context -delete
}
proc Apol_Context_Dialog::_get_context {dialog} {
variable vars
set context [new_apol_context_t]
if {[ApolTop::is_policy_open]} {
set p $::ApolTop::policy
} else {
set p NULL
}
if {$vars($dialog:user_enable)} {
$context set_user $p $vars($dialog:user)
}
if {$vars($dialog:role_enable)} {
$context set_role $p $vars($dialog:role)
}
if {$vars($dialog:type_enable)} {
set type [lindex [Apol_Widget::getTypeComboboxValueAndAttrib $vars($dialog:type_box)] 0]
$context set_type $p $type
}
set range [_get_range $dialog]
if {$range != {}} {
$context set_range $p $range
}
return $context
}
proc Apol_Context_Dialog::_get_range {dialog} {
variable vars
if {!$vars($dialog:low_enable)} {
return {}
}
if {[ApolTop::is_policy_open]} {
set p $::ApolTop::policy
} else {
set p NULL
}
set range [new_apol_mls_range_t]
$range set_low $p [Apol_Widget::getLevelSelectorLevel $vars($dialog:low_level)]
if {$vars($dialog:high_enable)} {
$range set_high $p [Apol_Widget::getLevelSelectorLevel $vars($dialog:high_level)]
}
return $range
}
proc Apol_Context_Dialog::_user_changed {dialog name1 name2 op} {
variable vars
if {$vars($dialog:user_enable)} {
$vars($dialog:user_box) configure -state normal
} else {
$vars($dialog:user_box) configure -state disabled
}
}
proc Apol_Context_Dialog::_role_changed {dialog name1 name2 op} {
variable vars
if {$vars($dialog:role_enable)} {
$vars($dialog:role_box) configure -state normal
} else {
$vars($dialog:role_box) configure -state disabled
}
}
proc Apol_Context_Dialog::_type_changed {dialog name1 name2 op} {
variable vars
if {$vars($dialog:type_enable)} {
Apol_Widget::setTypeComboboxState $vars($dialog:type_box) 1
} else {
Apol_Widget::setTypeComboboxState $vars($dialog:type_box) 0
}
}
proc Apol_Context_Dialog::_low_changed {dialog name1 name2 op} {
variable vars
if {$vars($dialog:low_enable)} {
$vars($dialog:high_cb) configure -state normal
Apol_Widget::setLevelSelectorState $vars($dialog:low_level) 1
if {$vars($dialog:high_enable)} {
Apol_Widget::setLevelSelectorState $vars($dialog:high_level) 1
}
} else {
$vars($dialog:high_cb) configure -state disabled
Apol_Widget::setLevelSelectorState $vars($dialog:low_level) 0
Apol_Widget::setLevelSelectorState $vars($dialog:high_level) 0
}
}
proc Apol_Context_Dialog::_high_changed {dialog name1 name2 op} {
variable vars
if {$vars($dialog:high_enable)} {
$vars($dialog:low_cb) configure -text "Low Level"
Apol_Widget::setLevelSelectorState $vars($dialog:high_level) 1
} else {
$vars($dialog:low_cb) configure -text "Single Level"
Apol_Widget::setLevelSelectorState $vars($dialog:high_level) 0
}
}
namespace eval Apol_Widget {
variable vars
}
proc Apol_Widget::makeContextSelector {path rangeMatchText {enableText "Context"} args} {
variable vars
array unset vars $path:*
set vars($path:context) {}
set vars($path:attribute) {}
set vars($path:context_rendered) {}
set vars($path:search_type) $::APOL_QUERY_EXACT
set f [frame $path]
set context_frame [frame $f.context]
set context2_frame [frame $f.context2]
pack $context_frame $context2_frame -side left -expand 0 -anchor nw
if {$enableText != {}} {
set vars($path:enable) 0
set context_cb [checkbutton $context_frame.enable -text $enableText \
-variable Apol_Widget::vars($path:enable)]
pack $context_cb -side top -expand 0 -anchor nw
trace add variable Apol_Widget::vars($path:enable) write [list Apol_Widget::_toggle_context_selector $path $context_cb]
}
set context_display [eval Entry $context_frame.display -textvariable Apol_Widget::vars($path:context_rendered) -width 26 -editable 0 $args]
set context_button [button $context_frame.button -text "Select Context..." -state disabled -command [list Apol_Widget::_show_context_dialog $path]]
trace add variable Apol_Widget::vars($path:context) write [list Apol_Widget::_update_context_display $path]
set vars($path:context) {} ;# this will invoke the display function
pack $context_display -side top -expand 1 -fill x -anchor nw
pack $context_button -side top -expand 0 -anchor ne
if {$enableText != {}} {
pack configure $context_display -padx 4
pack configure $context_button -padx 4
}
set range_label [label $context2_frame.label -text "MLS range matching:" \
-state disabled]
set range_exact [radiobutton $context2_frame.exact -text "Exact matches" \
-state disabled -value $::APOL_QUERY_EXACT \
-variable Apol_Widget::vars($path:search_type)]
set range_subset [radiobutton $context2_frame.subset -text "$rangeMatchText containing range" \
-state disabled -value $::APOL_QUERY_SUB \
-variable Apol_Widget::vars($path:search_type)]
set range_superset [radiobutton $context2_frame.superset -text "$rangeMatchText within range" \
-state disabled -value $::APOL_QUERY_SUPER \
-variable Apol_Widget::vars($path:search_type)]
pack $range_label $range_exact $range_subset $range_superset \
-side top -expand 0 -anchor nw
return $f
}
proc Apol_Widget::setContextSelectorState {path newState} {
if {$newState == 0 || $newState == "disabled"} {
set new_state disabled
} else {
set new_state normal
}
foreach w {display button} {
$path.context.$w configure -state $new_state
}
if {![ApolTop::is_capable "mls"]} {
set new_state disabled
}
foreach w {label exact subset superset} {
$path.context2.$w configure -state $new_state
}
}
proc Apol_Widget::clearContextSelector {path} {
set Apol_Widget::vars($path:context) {}
set Apol_Widget::vars($path:attribute) {}
set Apol_Widget::vars($path:search_type) $::APOL_QUERY_EXACT
catch {set Apol_Widget::vars($path:enable) 0}
}
proc Apol_Widget::getContextSelectorState {path} {
return $Apol_Widget::vars($path:enable)
}
proc Apol_Widget::getContextSelectorValue {path} {
variable vars
list $vars($path:context) $vars($path:search_type) $vars($path:attribute)
}
proc Apol_Widget::_toggle_context_selector {path cb name1 name2 op} {
if {$Apol_Widget::vars($path:enable)} {
Apol_Widget::setContextSelectorState $path normal
} else {
Apol_Widget::setContextSelectorState $path disabled
}
}
proc Apol_Widget::_show_context_dialog {path} {
variable vars
$path.context.button configure -state disabled
set new_context [Apol_Context_Dialog::getContext $vars($path:context) $vars($path:attribute)]
if {$new_context != {}} {
set vars($path:context) [lindex $new_context 0]
set vars($path:attribute) [lindex $new_context 1]
}
$path.context.button configure -state normal
}
proc Apol_Widget::_update_context_display {path name1 name2 op} {
variable vars
set display $path.context.display
if {$vars($path:context) == {}} {
set context_str "*:*:*"
if {[ApolTop::is_policy_open] && [ApolTop::is_capable "mls"]} {
append context_str ":*"
}
} else {
set context_str [$vars($path:context) render $::ApolTop::policy]
}
set vars($path:context_rendered) $context_str
$display configure -helptext $vars($path:context_rendered)
}
namespace eval Apol_DefaultObjects {
variable vals
variable widgets
variable mls_enabled {0}
variable statement_count
}
proc Apol_DefaultObjects::create {tab_name nb} {
variable vals
variable widgets
_initializeVars
set frame [$nb insert end $tab_name -text "Default Object Rules"]
set topf [frame $frame.top]
set bottomf [frame $frame.bottom]
pack $topf -expand 0 -fill both -pady 2
pack $bottomf -expand 1 -fill both -pady 2
set rsbox [TitleFrame $topf.rs -ipad 30 -text "Rule Selection"]
set obox [TitleFrame $topf.opts -text "Search Options"]
set dbox [TitleFrame $bottomf.results -text "Default Object Rules Display"]
pack $rsbox -side left -expand 0 -fill both -padx 2
pack $obox -side left -expand 1 -fill both -padx 2
pack $dbox -expand 1 -fill both -padx 2
set rs [$rsbox getframe]
checkbutton $rs.default_user -text "default_user" -onvalue 1 -offvalue 0 \
-variable Apol_DefaultObjects::vals(default_user_enabled)
trace add variable Apol_DefaultObjects::vals(default_user_enabled) write \
[list Apol_DefaultObjects::_ruleChanged]
checkbutton $rs.default_role -text "default_role" -onvalue 1 -offvalue 0 \
-variable Apol_DefaultObjects::vals(default_role_enabled)
trace add variable Apol_DefaultObjects::vals(default_role_enabled) write \
[list Apol_DefaultObjects::_ruleChanged]
checkbutton $rs.default_type -text "default_type" -onvalue 1 -offvalue 0 \
-variable Apol_DefaultObjects::vals(default_type_enabled)
trace add variable Apol_DefaultObjects::vals(default_type_enabled) write \
[list Apol_DefaultObjects::_ruleChanged]
checkbutton $rs.default_range -text "default_range" -onvalue 1 -offvalue 0 \
-variable Apol_DefaultObjects::vals(default_range_enabled)
trace add variable Apol_DefaultObjects::vals(default_range_enabled) write \
[list Apol_DefaultObjects::_ruleChanged]
pack $rs.default_user $rs.default_role $rs.default_type $rs.default_range -side top -anchor w
set widgets(options_pm) [PagesManager [$obox getframe].opts]
_defaultObjectCreate [$widgets(options_pm) add default_object]
$widgets(options_pm) compute_size
pack $widgets(options_pm) -expand 1 -fill both -side left
$widgets(options_pm) raise default_object
set ok [button [$obox getframe].ok -text OK -width 6 -command Apol_DefaultObjects::_searchDefaultObjects]
pack $ok -side right -padx 5 -pady 5 -anchor ne
set widgets(results) [Apol_Widget::makeSearchResults [$dbox getframe].results]
pack $widgets(results) -expand yes -fill both
return $frame
}
proc Apol_DefaultObjects::open {ppath} {
variable vals
variable widgets
variable mls_enabled
if {[ApolTop::is_capable "mls"]} {
set mls_enabled 1
} else {
set mls_enabled 0
}
$widgets(default_object:class) configure -values [Apol_Class_Perms::getClasses]
$widgets(default_object:default) configure -values {"source" "target"}
$widgets(default_object:range) configure -values {"low" "high" "low_high"}
set vals(default_range_enabled) $mls_enabled
set vals(default_type_enabled) [ApolTop::is_capable "default_type"]
}
proc Apol_DefaultObjects::close {} {
variable widgets
variable mls_enabled
_initializeVars
$widgets(default_object:class) configure -values {}
$widgets(default_object:default) configure -values {}
$widgets(default_object:range) configure -values {}
set mls_enabled 0
}
proc Apol_DefaultObjects::getTextWidget {} {
variable widgets
}
proc Apol_DefaultObjects::_initializeVars {} {
variable vals
array set vals {
class:use 0
class:sym {}
default:sym {}
default:use 0
range:sym {}
range:use 0
default_user_enabled 1
default_role_enabled 1
default_type_enabled 1
default_range_enabled 0
}
}
proc Apol_DefaultObjects::_defaultObjectCreate {r_c} {
variable vals
variable widgets
set class [frame $r_c.class]
set class_cb [checkbutton $class.enable -text "Object class" \
-variable Apol_DefaultObjects::vals(class:use)]
set widgets(default_object:class) [ComboBox $class.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_DefaultObjects::vals(class:sym)]
trace add variable Apol_DefaultObjects::vals(class:use) write \
[list Apol_DefaultObjects::_toggleCheckbutton $widgets(default_object:class) {}]
pack $class_cb -side top -anchor w
pack $widgets(default_object:class) -side top -expand 0 -fill x -padx 4
pack $class -side left -padx 4 -pady 2 -expand 0 -anchor nw
set default [frame $r_c.default]
set widgets(default_object:default_cb) [checkbutton $default.enable -text "Default" \
-variable Apol_DefaultObjects::vals(default:use)]
set widgets(default_object:default) [ComboBox $default.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_DefaultObjects::vals(default:sym)]
trace add variable Apol_DefaultObjects::vals(default:use) write \
[list Apol_DefaultObjects::_toggleCheckbutton $widgets(default_object:default) {}]
pack $widgets(default_object:default_cb) -side top -anchor w
pack $widgets(default_object:default) -side top -expand 0 -fill x -padx 4
pack $default -side left -padx 4 -pady 2 -expand 0 -fill y
set range [frame $r_c.range]
set widgets(default_object:range_cb) [checkbutton $range.enable -text "Range" \
-variable Apol_DefaultObjects::vals(range:use)]
set widgets(default_object:range) [ComboBox $range.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_DefaultObjects::vals(range:sym)]
trace add variable Apol_DefaultObjects::vals(range:use) write \
[list Apol_DefaultObjects::_toggleCheckbutton $widgets(default_object:range) {}]
pack $widgets(default_object:range_cb) -side top -anchor w
pack $widgets(default_object:range) -side top -expand 0 -fill x -padx 4
pack $range -side left -padx 4 -pady 2 -expand 0 -fill y
}
proc Apol_DefaultObjects::_toggleCheckbutton {cb w name1 name2 ops} {
variable vals
variable mls_enabled
if {$name2 == "range:use" && $mls_enabled == 0 || $vals(default_range_enabled) == 0} {
set vals(range:use) 0
$cb configure -state disabled
}
if {$vals($name2)} {
$cb configure -state normal -entrybg white
foreach x $w {
$x configure -state normal
}
} else {
$cb configure -state disabled -entrybg $ApolTop::default_bg_color
foreach x $w {
$x configure -state disabled
}
}
}
proc Apol_DefaultObjects::_ruleChanged {name1 name2 ops} {
variable vals
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
if {$vals(default_user_enabled) == 0} {
set vals(user:use) 0
}
if {$vals(default_role_enabled) == 0} {
set vals(role:use) 0
}
if {$vals(default_type_enabled) == 0} {
set vals(type:use) 0
}
if {$vals(default_range_enabled) == 0} {
set vals(range:use) 0
}
}
proc Apol_DefaultObjects::_searchDefaultObjects {} {
variable vals
variable widgets
variable statement_count
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
}
if {$vals(class:use) == 1 && $vals(class:sym) == {}} {
tk_messageBox -icon error -type ok -title "Default object Rule Search" -message "No class selected."
return
}
if {$vals(default:use) == 1 && $vals(default:sym) == {}} {
tk_messageBox -icon error -type ok -title "Default object Rule Search" -message "No default selected."
return
}
if {$vals(range:use) == 1 && $vals(range:sym) == {}} {
tk_messageBox -icon error -type ok -title "Default object Rule Search" -message "No range selected."
return
}
set results {}
set header {}
set print_results {}
if {$vals(default_user_enabled) == 1} {
append results [Apol_DefaultObjects::searchForDefault "user" get_user_default]
append header "$statement_count default_user rules match the search criteria.\n"
}
if {$vals(default_role_enabled) == 1} {
append results [Apol_DefaultObjects::searchForDefault "role" get_role_default]
append header "$statement_count default_role rules match the search criteria.\n"
}
if {$vals(default_type_enabled) == 1} {
append results [Apol_DefaultObjects::searchForDefault "type" get_type_default]
append header "$statement_count default_type rules match the search criteria.\n"
}
if {$vals(default_range_enabled) == 1} {
append results [Apol_DefaultObjects::searchDefaultRange "range" get_range_default]
append header "$statement_count default_range rules match the search criteria.\n"
}
append print_results "$header\n$results"
Apol_Widget::appendSearchResultText $widgets(results) $print_results
}
proc Apol_DefaultObjects::searchForDefault {type type_cmd} {
variable vals
variable widgets
variable statement_count
set results {}
set printit 0
set class_regexp 0
set default_regexp 0
set statement_count 0
if {$vals(class:use)} {
set class_regexp 1
}
if {$vals(default:use)} {
set default_regexp 1
}
set q [new_apol_default_object_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_default_object_from_void [$v get_element $i]]
set class [$q get_class $::ApolTop::qpolicy]
set default [$q $type_cmd $::ApolTop::qpolicy]
if {$default != ""} {
if {$class_regexp == 1 && $class == $vals(class:sym) && $default_regexp == 1 && $default == $vals(default:sym)} {
set printit 1
} elseif {$class_regexp == 1 && $class == $vals(class:sym) && $default_regexp == 0} {
set printit 1
} elseif {$default_regexp == 1 && $default == $vals(default:sym) && $class_regexp == 0} {
set printit 1
} elseif {$class_regexp == 0 && $default_regexp == 0} {
set printit 1
}
if {$printit == 1} {
append results "default_$type $class $default;\n"
set statement_count [expr $statement_count + 1]
}
}
set printit 0
}
}
return "$results\n"
}
proc Apol_DefaultObjects::searchDefaultRange {type type_cmd} {
variable vals
variable widgets
variable statement_count
set results {}
set printit 0
set class_regexp 0
set default_regexp 0
set range_regexp 0
set statement_count 0
if {$vals(class:use)} {
set class_regexp 1
}
if {$vals(default:use)} {
set default_regexp 1
}
if {$vals(range:use)} {
set range_regexp 1
}
set q [new_apol_default_object_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_default_object_from_void [$v get_element $i]]
set class [$q get_class $::ApolTop::qpolicy]
set default [$q $type_cmd $::ApolTop::qpolicy]
if {$default != ""} {
set entries [split $default " "]
lassign $entries src_tgt range
if {$class_regexp == 1 && $class == $vals(class:sym) && $default_regexp == 1 && \
$src_tgt== $vals(default:sym) && $range_regexp == 1 && $range == $vals(range:sym)} {
set printit 1
} elseif {$class_regexp == 1 && $class == $vals(class:sym) && $default_regexp == 0 && $range_regexp == 0} {
set printit 1
} elseif {$class_regexp == 0 && $default_regexp == 1 && $src_tgt == $vals(default:sym) && $range_regexp == 0} {
set printit 1
} elseif {$class_regexp == 0 && $default_regexp == 0 && $range_regexp == 1 && $range == $vals(range:sym)} {
set printit 1
} elseif {$class_regexp == 0 && $default_regexp == 1 && $src_tgt == $vals(default:sym) && \
$range_regexp == 1 && $range == $vals(range:sym)} {
set printit 1
} elseif {$class_regexp == 1 && $class == $vals(class:sym) && $default_regexp == 0 && \
$range_regexp == 1 && $range == $vals(range:sym)} {
set printit 1
} elseif {$class_regexp == 0 && $default_regexp == 0 && $range_regexp == 0} {
set printit 1
}
if {$printit == 1} {
append results "default_$type $class $default;\n"
set statement_count [expr $statement_count + 1]
}
}
set printit 0
}
}
return "$results\n"
}
namespace eval Apol_Analysis_directflow {
variable vals
variable widgets
Apol_Analysis::registerAnalysis "Apol_Analysis_directflow" "Direct Information Flow"
}
proc Apol_Analysis_directflow::create {options_frame} {
variable vals
variable widgets
_reinitializeVals
set dir_tf [TitleFrame $options_frame.mode -text "Direction"]
pack $dir_tf -side left -padx 2 -pady 2 -expand 0 -fill y
set dir_in [radiobutton [$dir_tf getframe].in -text In \
-value $::APOL_INFOFLOW_IN \
-variable Apol_Analysis_directflow::vals(dir)]
set dir_out [radiobutton [$dir_tf getframe].out -text Out \
-value $::APOL_INFOFLOW_OUT \
-variable Apol_Analysis_directflow::vals(dir)]
set dir_either [radiobutton [$dir_tf getframe].either -text Either \
-value $::APOL_INFOFLOW_EITHER \
-variable Apol_Analysis_directflow::vals(dir)]
set dir_both [radiobutton [$dir_tf getframe].both -text Both \
-value $::APOL_INFOFLOW_BOTH \
-variable Apol_Analysis_directflow::vals(dir)]
pack $dir_in $dir_out $dir_either $dir_both -anchor w
set req_tf [TitleFrame $options_frame.req -text "Required Parameters"]
pack $req_tf -side left -padx 2 -pady 2 -expand 0 -fill y
set l [label [$req_tf getframe].l -text "Starting type"]
pack $l -anchor w
set widgets(type) [Apol_Widget::makeTypeCombobox [$req_tf getframe].type]
pack $widgets(type)
set filter_tf [TitleFrame $options_frame.filter -text "Optional Result Filters"]
pack $filter_tf -side left -padx 2 -pady 2 -expand 1 -fill both
set class_f [frame [$filter_tf getframe].class]
pack $class_f -side left -anchor nw
set class_enable [checkbutton $class_f.enable -text "Filter by object class" \
-variable Apol_Analysis_directflow::vals(classes:enable)]
pack $class_enable -anchor w
set widgets(classes) [Apol_Widget::makeScrolledListbox $class_f.classes \
-height 6 -width 24 \
-listvar Apol_Analysis_directflow::vals(classes:all_classes) \
-selectmode multiple -exportselection 0]
set classes_lb [Apol_Widget::getScrolledListbox $widgets(classes)]
bind $classes_lb <<ListboxSelect>> \
[list Apol_Analysis_directflow::_selectClassesListbox $classes_lb]
pack $widgets(classes) -padx 4 -expand 0 -fill both
trace add variable Apol_Analysis_directflow::vals(classes:enable) write \
Apol_Analysis_directflow::_toggleClasses
Apol_Widget::setScrolledListboxState $widgets(classes) disabled
set classes_bb [ButtonBox $class_f.bb -homogeneous 1 -spacing 4]
$classes_bb add -text "Include All" \
-command [list Apol_Analysis_directflow::_includeAll $classes_lb]
$classes_bb add -text "Exclude All" \
-command [list Apol_Analysis_directflow::_excludeAll $classes_lb]
pack $classes_bb -pady 4
set widgets(regexp) [Apol_Widget::makeRegexpEntry [$filter_tf getframe].end]
$widgets(regexp).cb configure -text "Filter result types using regular expression"
pack $widgets(regexp) -side left -anchor nw -padx 8
}
proc Apol_Analysis_directflow::open {} {
variable vals
variable widgets
Apol_Widget::resetTypeComboboxToPolicy $widgets(type)
set vals(classes:all_classes) [Apol_Class_Perms::getClasses]
set vals(classes:selected) $vals(classes:all_classes)
Apol_Widget::setScrolledListboxState $widgets(classes) normal
set classes_lb [Apol_Widget::getScrolledListbox $widgets(classes)]
$classes_lb selection set 0 end
_toggleClasses {} {} {}
}
proc Apol_Analysis_directflow::close {} {
variable widgets
_reinitializeVals
_reinitializeWidgets
Apol_Widget::clearTypeCombobox $widgets(type)
}
proc Apol_Analysis_directflow::getInfo {} {
return "This 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.
\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.
\nThe results of the analysis may be optionally filtered by object class
selection or an end type regular expression.
\nNOTE: For any given generation, if the parent and the child are the
same, the child cannot be opened. This avoids cyclic analyses.
\nFor additional help on this topic select \"Information Flow Analysis\"
from the help menu."
}
proc Apol_Analysis_directflow::newAnalysis {} {
if {[set rt [_checkParams]] != {}} {
return $rt
}
set results [_analyze]
set f [_createResultsDisplay]
_renderResults $f $results
$results -acquire
$results -delete
return {}
}
proc Apol_Analysis_directflow::updateAnalysis {f} {
if {[set rt [_checkParams]] != {}} {
return $rt
}
set results [_analyze]
_clearResultsDisplay $f
_renderResults $f $results
$results -acquire
$results -delete
return {}
}
proc Apol_Analysis_directflow::reset {} {
_reinitializeVals
_reinitializeWidgets
}
proc Apol_Analysis_directflow::switchTab {query_options} {
variable vals
variable widgets
array set vals $query_options
_reinitializeWidgets
}
proc Apol_Analysis_directflow::saveQuery {channel} {
variable vals
variable widgets
foreach {key value} [array get vals] {
puts $channel "$key $value"
}
set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(type)]
puts $channel "type [lindex $type 0]"
puts $channel "type:attrib [lindex $type 1]"
set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
puts $channel "regexp:enable $use_regexp"
puts $channel "regexp $regexp"
}
proc Apol_Analysis_directflow::loadQuery {channel} {
variable vals
set classes {}
while {[gets $channel line] >= 0} {
set line [string trim $line]
if {$line == {} || [string index $line 0] == "#"} {
continue
}
set key {}
set value {}
regexp -line -- {^(\S+)( (.+))?} $line -> key --> value
switch -- $key {
classes:selected {
set classes $value
}
default {
set vals($key) $value
}
}
}
open
set vals(classes:selected) {}
foreach c $classes {
set i [lsearch [Apol_Class_Perms::getClasses] $c]
if {$i >= 0} {
lappend vals(classes:selected) $c
}
}
set vals(classes:selected) [lsort $vals(classes:selected)]
_reinitializeWidgets
}
proc Apol_Analysis_directflow::getTextWidget {tab} {
return [$tab.right getframe].res.tb
}
proc Apol_Analysis_directflow::appendResultsNodes {tree parent_node results} {
_createResultsNodes $tree $parent_node $results 0
}
proc Apol_Analysis_directflow::_reinitializeVals {} {
variable vals
set vals(dir) $::APOL_INFOFLOW_IN
array set vals {
type {} type:attrib {}
classes:enable 0
classes:selected {}
regexp:enable 0
regexp {}
}
set vals(classes:all_classes) [Apol_Class_Perms::getClasses]
}
proc Apol_Analysis_directflow::_reinitializeWidgets {} {
variable vals
variable widgets
if {$vals(type:attrib) != {}} {
Apol_Widget::setTypeComboboxValue $widgets(type) [list $vals(type) $vals(type:attrib)]
} else {
Apol_Widget::setTypeComboboxValue $widgets(type) $vals(type)
}
Apol_Widget::setRegexpEntryValue $widgets(regexp) $vals(regexp:enable) $vals(regexp)
Apol_Widget::setScrolledListboxState $widgets(classes) enabled
set classes_lb [Apol_Widget::getScrolledListbox $widgets(classes)]
$classes_lb selection clear 0 end
foreach c $vals(classes:selected) {
set i [lsearch $vals(classes:all_classes) $c]
$classes_lb selection set $i $i
}
_toggleClasses {} {} {}
}
proc Apol_Analysis_directflow::_toggleClasses {name1 name2 op} {
variable vals
variable widgets
if {$vals(classes:enable)} {
Apol_Widget::setScrolledListboxState $widgets(classes) enabled
} else {
Apol_Widget::setScrolledListboxState $widgets(classes) disabled
}
}
proc Apol_Analysis_directflow::_selectClassesListbox {lb} {
variable vals
for {set i 0} {$i < [$lb index end]} {incr i} {
set t [$lb get $i]
if {[$lb selection includes $i]} {
lappend vals(classes:selected) $t
} else {
if {[set j [lsearch $vals(classes:selected) $t]] >= 0} {
set vals(classes:selected) [lreplace $vals(classes:selected) $j $j]
}
}
}
set vals(classes:selected) [lsort -uniq $vals(classes:selected)]
focus $lb
}
proc Apol_Analysis_directflow::_includeAll {lb} {
variable vals
$lb selection set 0 end
set vals(classes:selected) $vals(classes:all_classes)
}
proc Apol_Analysis_directflow::_excludeAll {lb} {
variable vals
$lb selection clear 0 end
set vals(classes:selected) {}
}
proc Apol_Analysis_directflow::_checkParams {} {
variable vals
variable widgets
if {![ApolTop::is_policy_open]} {
return "No current policy file is opened."
}
set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(type)]
if {[lindex $type 0] == {}} {
return "No type was selected."
}
if {![Apol_Types::isTypeInPolicy [lindex $type 0]]} {
return "[lindex $type 0] is not a type within the policy."
}
set vals(type) [lindex $type 0]
set vals(type:attrib) [lindex $type 1]
set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
if {$use_regexp && $regexp == {}} {
return "No regular expression provided."
}
set vals(regexp:enable) $use_regexp
set vals(regexp) $regexp
if {$vals(classes:enable) && $vals(classes:selected) == {}} {
return "At least one object class must be included."
}
if {![Apol_Perms_Map::is_pmap_loaded]} {
if {![ApolTop::openDefaultPermMap]} {
return "This analysis requires that a permission map is loaded."
}
apol_tcl_clear_info_string
}
return {} ;# all parameters passed, now ready to do search
}
proc Apol_Analysis_directflow::_analyze {} {
variable vals
set classes {}
if {$vals(classes:enable)} {
foreach c $vals(classes:selected) {
foreach p [Apol_Class_Perms::getPermsForClass $c] {
lappend classes $c $p
}
}
}
if {$vals(regexp:enable)} {
set regexp $vals(regexp)
} else {
set regexp {}
}
set q [new_apol_infoflow_analysis_t]
$q set_mode $::ApolTop::policy $::APOL_INFOFLOW_MODE_DIRECT
$q set_dir $::ApolTop::policy $vals(dir)
$q set_type $::ApolTop::policy $vals(type)
foreach {c p} $classes {
$q append_class_perm $::ApolTop::policy $c $p
}
$q set_result_regex $::ApolTop::policy $regexp
set results [$q run $::ApolTop::policy]
$q -acquire
$q -delete
return $results
}
proc Apol_Analysis_directflow::_analyzeMore {tree node} {
set new_start [$tree itemcget $node -text]
if {[$tree itemcget [$tree parent $node] -text] == $new_start} {
return {}
}
set g [lindex [$tree itemcget top -data] 0]
$g do_more $::ApolTop::policy $new_start
}
proc Apol_Analysis_directflow::_createResultsDisplay {} {
variable vals
set f [Apol_Analysis::createResultTab "Direct Flow" [array get vals]]
set tree_tf [TitleFrame $f.left -text "Direct Information Flow Tree"]
pack $tree_tf -side left -expand 0 -fill y -padx 2 -pady 2
set sw [ScrolledWindow [$tree_tf getframe].sw -auto both]
set tree [Tree [$sw getframe].tree -width 24 -redraw 1 -borderwidth 0 \
-highlightthickness 0 -showlines 1 -padx 0 -bg white]
$sw setwidget $tree
pack $sw -expand 1 -fill both
set res_tf [TitleFrame $f.right -text "Direct Information Flow Results"]
pack $res_tf -side left -expand 1 -fill both -padx 2 -pady 2
set res [Apol_Widget::makeSearchResults [$res_tf getframe].res]
$res.tb tag configure title -font {Helvetica 14 bold}
$res.tb tag configure title_type -foreground blue -font {Helvetica 14 bold}
$res.tb tag configure subtitle -font {Helvetica 10 bold}
$res.tb tag configure subtitle_dir -foreground blue -font {Helvetica 10 bold}
pack $res -expand 1 -fill both
$tree configure -selectcommand [list Apol_Analysis_directflow::_treeSelect $res]
$tree configure -opencmd [list Apol_Analysis_directflow::_treeOpen $tree]
return $f
}
proc Apol_Analysis_directflow::_treeSelect {res tree node} {
if {$node != {}} {
$res.tb configure -state normal
$res.tb delete 0.0 end
set data [$tree itemcget $node -data]
if {[string index $node 0] == "x"} {
_renderResultsDirectFlow $res $tree $node [lindex $data 1]
} else {
eval $res.tb insert end [lindex $data 1]
}
$res.tb configure -state disabled
}
}
proc Apol_Analysis_directflow::_treeOpen {tree node} {
foreach {is_expanded results} [$tree itemcget $node -data] {break}
if {[string index $node 0] == "x" && !$is_expanded} {
Apol_Progress_Dialog::wait "Direct Information Flow Analysis" \
"Performing Direct Information Flow Analysis..." \
{
set new_results [_analyzeMore $tree $node]
$tree itemconfigure $node -data [list 1 $results]
if {$new_results != {}} {
_createResultsNodes $tree $node $new_results 1
$new_results -acquire
$new_results -delete
}
}
}
}
proc Apol_Analysis_directflow::_clearResultsDisplay {f} {
variable vals
set tree [[$f.left getframe].sw getframe].tree
set res [$f.right getframe].res
$tree delete [$tree nodes root]
Apol_Widget::clearSearchResults $res
Apol_Analysis::setResultTabCriteria [array get vals]
}
proc Apol_Analysis_directflow::_renderResults {f results} {
variable vals
set graph_handler [$results extract_graph]
$graph_handler -acquire ;# let Tcl's GC destroy graph when this tab closes
set results_list [$results extract_result_vector]
set tree [[$f.left getframe].sw getframe].tree
set res [$f.right getframe].res
$tree insert end root top -text $vals(type) -open 1 -drawcross auto
set top_text [_renderTopText]
$tree itemconfigure top -data [list $graph_handler $top_text]
_createResultsNodes $tree top $results_list 1
$tree selection set top
$tree opentree top 0
$tree see top
$results_list -acquire
$results_list -delete
}
proc Apol_Analysis_directflow::_renderTopText {} {
variable vals
set top_text [list "Direct Information Flow Analysis: Starting type: " title]
lappend top_text $vals(type) title_type \
"\n\n" title \
"This 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.
\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.
\nNOTE: For any given generation, if the parent and the child are the
same, you cannot open the child. This avoids cyclic analyses."
}
proc Apol_Analysis_directflow::_createResultsNodes {tree parent_node results do_expand} {
set all_targets {}
set info_list [infoflow_result_vector_to_list $results]
set results_processed 0
foreach r $info_list {
apol_tcl_set_info_string $::ApolTop::policy "Processing result $results_processed of [llength $info_list]"
if {$do_expand} {
set target [[$r get_end_type] get_name $::ApolTop::qpolicy]
} else {
set target [[[lindex $info_list 0] get_end_type] get_name $::ApolTop::qpolicy]
}
set flow_dir [$r get_dir]
set step0 [apol_infoflow_step_from_void [[$r get_steps] get_element 0]]
set rules [$step0 get_rules]
lappend all_targets $target
foreach r [avrule_vector_to_list $rules] {
set class [[$r get_object_class $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
lappend classes($target) $class
lappend classes($target:$class) $r
}
set dir($target:$flow_dir) 1
incr results_processed
}
set all_targets [lsort -uniq $all_targets]
apol_tcl_set_info_string $::ApolTop::policy "Displaying [llength $all_targets] result(s)"
update idle
foreach t $all_targets {
if {[info exists dir(${t}:${::APOL_INFOFLOW_BOTH})] ||
([info exists dir(${t}:${::APOL_INFOFLOW_IN})] &&
[info exists dir(${t}:${::APOL_INFOFLOW_OUT})])} {
set flow_dir "both"
} elseif {[info exists dir(${t}:${::APOL_INFOFLOW_IN})]} {
set flow_dir "in"
} else {
set flow_dir "out"
}
set rules {}
foreach c [lsort -uniq $classes($t)] {
lappend rules [list $c [lsort -uniq $classes($t:$c)]]
}
set data [list $flow_dir $rules]
$tree insert end $parent_node x\#auto -text $t -drawcross allways \
-data [list 0 $data]
}
}
proc Apol_Analysis_directflow::_renderResultsDirectFlow {res tree node data} {
set parent_name [$tree itemcget [$tree parent $node] -text]
set name [$tree itemcget $node -text]
foreach {flow_dir classes} $data {break}
switch -- $flow_dir {
both {
$res.tb insert end "Information flows both into and out of " title \
$parent_name title_type \
" from/to " title \
$name title_type
}
in {
$res.tb insert end "Information flows into " title \
$parent_name title_type \
" from " title \
$name title_type
}
out {
$res.tb insert end "Information flows out of " title \
$parent_name title_type \
" to " title \
$name title_type
}
}
$res.tb insert end "\n\n" title_type \
"Objects classes for " subtitle \
[string toupper $flow_dir] subtitle_dir \
" flows:\n" subtitle
foreach c $classes {
foreach {class_name rules} $c {break}
$res.tb insert end " " {} \
$class_name\n subtitle
set v [new_apol_vector_t]
foreach r $rules {
$v append $r
}
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 12 $v qpol_avrule_from_void
$v -acquire
$v -delete
}
}
namespace eval Apol_Analysis_domaintrans {
variable vals
variable widgets
Apol_Analysis::registerAnalysis "Apol_Analysis_domaintrans" "Domain Transition"
}
proc Apol_Analysis_domaintrans::create {options_frame} {
variable vals
variable widgets
_reinitializeVals
set dir_tf [TitleFrame $options_frame.dir -text "Direction"]
pack $dir_tf -side left -padx 2 -pady 2 -expand 0 -fill y
set dir_forward [radiobutton [$dir_tf getframe].forward -text "Forward" \
-variable Apol_Analysis_domaintrans::vals(dir) \
-value $::APOL_DOMAIN_TRANS_DIRECTION_FORWARD]
set dir_reverse [radiobutton [$dir_tf getframe].reverse -text "Reverse" \
-variable Apol_Analysis_domaintrans::vals(dir) \
-value $::APOL_DOMAIN_TRANS_DIRECTION_REVERSE]
pack $dir_forward $dir_reverse -anchor w
trace add variable Apol_Analysis_domaintrans::vals(dir) write \
Apol_Analysis_domaintrans::_toggleDirection
set req_tf [TitleFrame $options_frame.req -text "Required Parameters"]
pack $req_tf -side left -padx 2 -pady 2 -expand 0 -fill y
set l [label [$req_tf getframe].l -textvariable Apol_Analysis_domaintrans::vals(type:label)]
pack $l -anchor w
set widgets(type) [Apol_Widget::makeTypeCombobox [$req_tf getframe].type]
pack $widgets(type)
set filter_tf [TitleFrame $options_frame.filter -text "Optional Result Filters"]
pack $filter_tf -side left -padx 2 -pady 2 -expand 1 -fill both
set access_f [frame [$filter_tf getframe].access]
pack $access_f -side left -anchor nw
set widgets(access_enable) [checkbutton $access_f.enable -text "Use access filters" \
-variable Apol_Analysis_domaintrans::vals(access:enable)]
pack $widgets(access_enable) -anchor w
set widgets(access) [button $access_f.b -text "Access Filters" \
-command Apol_Analysis_domaintrans::_createAccessDialog \
-state disabled]
pack $widgets(access) -anchor w -padx 4
trace add variable Apol_Analysis_domaintrans::vals(access:enable) write \
Apol_Analysis_domaintrans::_toggleAccessSelected
set widgets(regexp) [Apol_Widget::makeRegexpEntry [$filter_tf getframe].end]
$widgets(regexp).cb configure -text "Filter result types using regular expression"
pack $widgets(regexp) -side left -anchor nw -padx 8
}
proc Apol_Analysis_domaintrans::open {} {
variable vals
variable widgets
Apol_Widget::resetTypeComboboxToPolicy $widgets(type)
set vals(targets:inc) [Apol_Types::getTypes]
set vals(targets:inc_displayed) [Apol_Types::getTypes]
foreach c [Apol_Class_Perms::getClasses] {
set vals(classes:$c) [Apol_Class_Perms::getPermsForClass $c]
set vals(classes:$c:enable) 1
}
}
proc Apol_Analysis_domaintrans::close {} {
variable widgets
_reinitializeVals
_reinitializeWidgets
Apol_Widget::clearTypeCombobox $widgets(type)
}
proc Apol_Analysis_domaintrans::getInfo {} {
return "A 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, multiple forms of access must
be granted:
\n (1) source domain must have process transition permission for
target domain,
(2) source domain must have file execute permission for some
entrypoint type,
(3) target domain must have file entrypoint permission for the
same entrypoint type, and,
(4) for policies version 15 or later, either a type_transition
rule or a setexec permission for the source domain.
\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 (1) target domain must have process transition permission from the
source domain,
(2) target domain must have file entrypoint permission to some
entrypoint type, and
(3) source domain must have file execute permission to the same
entrypoint type.
\nThe results are presented in tree form. Open target children domains
to perform another domain transition analysis on that domain.
\nFor additional help on this topic select \"Domain Transition Analysis\"
from the Help menu."
}
proc Apol_Analysis_domaintrans::newAnalysis {} {
if {[set rt [_checkParams]] != {}} {
return $rt
}
set results [_analyze]
set f [_createResultsDisplay]
_renderResults $f $results
$results -acquire
$results -delete
return {}
}
proc Apol_Analysis_domaintrans::updateAnalysis {f} {
variable vals
if {[set rt [_checkParams]] != {}} {
return $rt
}
if {$vals(dir) == $::APOL_DOMAIN_TRANS_DIRECTION_FORWARD} {
$f.left configure -text "Forward Domain Transition"
} else {
$f.left configure -text "Reverse Domain Transition"
}
set results [_analyze]
_clearResultsDisplay $f
_renderResults $f $results
$results -acquire
$results -delete
return {}
}
proc Apol_Analysis_domaintrans::reset {} {
_reinitializeVals
_reinitializeWidgets
}
proc Apol_Analysis_domaintrans::switchTab {query_options} {
variable vals
variable widgets
array set vals $query_options
if {$vals(type:attrib) != {}} {
Apol_Widget::setTypeComboboxValue $widgets(type) [list $vals(type) $vals(type:attrib)]
} else {
Apol_Widget::setTypeComboboxValue $widgets(type) $vals(type)
}
Apol_Widget::setRegexpEntryValue $widgets(regexp) $vals(regexp:enable) $vals(regexp)
}
proc Apol_Analysis_domaintrans::saveQuery {channel} {
variable vals
variable widgets
foreach {key value} [array get vals] {
switch -- $key {
targets:inc_displayed -
classes:perms_displayed -
search:regexp -
search:object_types -
search:classperm_perms {
}
default {
puts $channel "$key $value"
}
}
}
set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(type)]
puts $channel "type [lindex $type 0]"
puts $channel "type:attrib [lindex $type 1]"
set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
puts $channel "regexp:enable $use_regexp"
puts $channel "regexp $regexp"
}
proc Apol_Analysis_domaintrans::loadQuery {channel} {
variable vals
set targets_inc {}
while {[gets $channel line] >= 0} {
set line [string trim $line]
if {$line == {} || [string index $line 0] == "#"} {
continue
}
set key {}
set value {}
regexp -line -- {^(\S+)( (.+))?} $line -> key --> value
if {$key == "targets:inc"} {
lappend targets_inc $value
} elseif {[regexp -- {^classes:(.+)} $key -> class]} {
set c($class) $value
} else {
set vals($key) $value
}
}
open
set vals(targets:inc) {}
foreach s $targets_inc {
set i [lsearch [Apol_Types::getTypes] $s]
if {$i >= 0} {
lappend vals(targets:inc) $s
}
}
foreach class_key [array names c] {
if {[regexp -- {^([^:]+):enable} $class_key -> class]} {
if {[lsearch [Apol_Class_Perms::getClasses] $class] >= 0} {
set vals(classes:$class:enable) $c($class_key)
}
} else {
set class $class_key
set old_p $vals(classes:$class)
set new_p {}
foreach p $c($class) {
if {[lsearch $old_p $p] >= 0} {
lappend new_p $p
}
}
set vals(classes:$class) [lsort -uniq $new_p]
}
}
_reinitializeWidgets
}
proc Apol_Analysis_domaintrans::getTextWidget {tab} {
return [$tab.right getframe].res.tb
}
proc Apol_Analysis_domaintrans::appendResultsNodes {tree parent_node results} {
_createResultsNodes $tree $parent_node $results $::APOL_DOMAIN_TRANS_DIRECTION_FORWARD
}
proc Apol_Analysis_domaintrans::_reinitializeVals {} {
variable vals
set vals(dir) $::APOL_DOMAIN_TRANS_DIRECTION_FORWARD
array set vals {
type:label "Source domain"
type {} type:attrib {}
regexp:enable 0
regexp {}
access:enable 0
targets:inc {} targets:inc_displayed {}
targets:attribenable 0 targets:attrb {}
}
array unset vals classes:*
array unset vals search:*
foreach c [Apol_Class_Perms::getClasses] {
set vals(classes:$c) [Apol_Class_Perms::getPermsForClass $c]
set vals(classes:$c:enable) 1
}
}
proc Apol_Analysis_domaintrans::_reinitializeWidgets {} {
variable vals
variable widgets
if {$vals(type:attrib) != {}} {
Apol_Widget::setTypeComboboxValue $widgets(type) [list $vals(type) $vals(type:attrib)]
} else {
Apol_Widget::setTypeComboboxValue $widgets(type) $vals(type)
}
Apol_Widget::setRegexpEntryValue $widgets(regexp) $vals(regexp:enable) $vals(regexp)
}
proc Apol_Analysis_domaintrans::_toggleDirection {name1 name2 op} {
variable vals
if {$vals(dir) == $::APOL_DOMAIN_TRANS_DIRECTION_FORWARD} {
set vals(type:label) "Source domain"
} else {
set vals(type:label) "Target domain"
}
_maybeEnableAccess
}
proc Apol_Analysis_domaintrans::_toggleAccessSelected {name1 name2 op} {
_maybeEnableAccess
}
proc Apol_Analysis_domaintrans::_maybeEnableAccess {} {
variable vals
variable widgets
if {$vals(dir) == $::APOL_DOMAIN_TRANS_DIRECTION_FORWARD} {
$widgets(access_enable) configure -state normal
if {$vals(access:enable)} {
$widgets(access) configure -state normal
} else {
$widgets(access) configure -state disabled
}
} else {
$widgets(access_enable) configure -state disabled
$widgets(access) configure -state disabled
}
}
proc Apol_Analysis_domaintrans::_createAccessDialog {} {
variable widgets
$widgets(access) configure -state disabled
destroy .domaintrans_adv
set d [Dialog .domaintrans_adv -modal local -separator 1 -title "Domain Transition Access Filter" -parent .]
$d add -text "Close"
_createAccessTargets [$d getframe]
_createAccessClasses [$d getframe]
$d draw
$widgets(access) configure -state normal
}
proc Apol_Analysis_domaintrans::_createAccessTargets {f} {
variable vals
set type_f [frame $f.targets]
pack $type_f -side left -expand 0 -fill both -padx 4 -pady 4
set l1 [label $type_f.l1 -text "Included Object Types"]
pack $l1 -anchor w
set targets [Apol_Widget::makeScrolledListbox $type_f.targets -height 10 -width 24 \
-listvar Apol_Analysis_domaintrans::vals(targets:inc_displayed) \
-selectmode extended -exportselection 0]
set targets_lb [Apol_Widget::getScrolledListbox $targets]
bind $targets_lb <<ListboxSelect>> \
[list Apol_Analysis_domaintrans::_selectTargetListbox $targets_lb]
pack $targets -expand 0 -fill both
set bb [ButtonBox $type_f.bb -homogeneous 1 -spacing 4]
$bb add -text "Include All" \
-command [list Apol_Analysis_domaintrans::_includeAllItems $targets_lb targets]
$bb add -text "Ignore All" \
-command [list Apol_Analysis_domaintrans::_ignoreAllItems $targets_lb targets]
pack $bb -pady 4
set attrib [frame $type_f.a]
pack $attrib
set attrib_enable [checkbutton $attrib.ae -anchor w \
-text "Filter by attribute" \
-variable Apol_Analysis_domaintrans::vals(targets:attribenable)]
set attrib_box [ComboBox $attrib.ab -autopost 1 -entrybg white -width 16 \
-values $Apol_Types::attriblist \
-textvariable Apol_Analysis_domaintrans::vals(targets:attrib)]
$attrib_enable configure -command \
[list Apol_Analysis_domaintrans::_attribEnabled $attrib_box $targets_lb]
trace remove variable Apol_Analysis_domaintrans::vals(targets:attrib) write \
[list Apol_Analysis_domaintrans::_attribChanged $targets_lb]
trace add variable Apol_Analysis_domaintrans::vals(targets:attrib) write \
[list Apol_Analysis_domaintrans::_attribChanged $targets_lb]
pack $attrib_enable -side top -expand 0 -fill x -anchor sw -padx 5 -pady 2
pack $attrib_box -side top -expand 1 -fill x -padx 10
_attribEnabled $attrib_box $targets_lb
if {[set anchor [lindex [lsort [$targets_lb curselection]] 0]] != {}} {
$targets_lb selection anchor $anchor
$targets_lb see $anchor
}
}
proc Apol_Analysis_domaintrans::_selectTargetListbox {lb} {
variable vals
for {set i 0} {$i < [$lb index end]} {incr i} {
set t [$lb get $i]
if {[$lb selection includes $i]} {
lappend vals(targets:inc) $t
} else {
if {[set j [lsearch $vals(targets:inc) $t]] >= 0} {
set vals(targets:inc) [lreplace $vals(targets:inc) $j $j]
}
}
}
set vals(targets:inc) [lsort -uniq $vals(targets:inc)]
focus $lb
}
proc Apol_Analysis_domaintrans::_includeAllItems {lb varname} {
variable vals
$lb selection set 0 end
set displayed [$lb get 0 end]
set vals($varname:inc) [lsort -uniq [concat $vals($varname:inc) $displayed]]
}
proc Apol_Analysis_domaintrans::_ignoreAllItems {lb varname} {
variable vals
$lb selection clear 0 end
set displayed [$lb get 0 end]
set inc {}
foreach t $vals($varname:inc) {
if {[lsearch $displayed $t] == -1} {
lappend inc $t
}
}
set vals($varname:inc) $inc
}
proc Apol_Analysis_domaintrans::_attribEnabled {cb lb} {
variable vals
if {$vals(targets:attribenable)} {
$cb configure -state normal
_filterTypeLists $vals(targets:attrib) $lb
} else {
$cb configure -state disabled
_filterTypeLists "" $lb
}
}
proc Apol_Analysis_domaintrans::_attribChanged {lb name1 name2 op} {
variable vals
if {$vals(targets:attribenable)} {
_filterTypeLists $vals(targets:attrib) $lb
}
}
proc Apol_Analysis_domaintrans::_filterTypeLists {attrib lb} {
variable vals
$lb selection clear 0 end
if {$attrib != ""} {
set vals(targets:inc_displayed) {}
set qpol_type_datum [new_qpol_type_t $::ApolTop::qpolicy $attrib]
set i [$qpol_type_datum get_type_iter $::ApolTop::qpolicy]
while {![$i end]} {
set t [qpol_type_from_void [$i get_item]]
lappend vals(targets:inc_displayed) [$t get_name $::ApolTop::qpolicy]
$i next
}
$i -acquire
$i -delete
set vals(targets:inc_displayed) [lsort $vals(targets:inc_displayed)]
} else {
set vals(targets:inc_displayed) [Apol_Types::getTypes]
}
foreach t $vals(targets:inc) {
if {[set i [lsearch $vals(targets:inc_displayed) $t]] >= 0} {
$lb selection set $i $i
}
}
}
proc Apol_Analysis_domaintrans::_createAccessClasses {f} {
variable vals
variable widgets
set lf [frame $f.left]
pack $lf -side left -expand 0 -fill both -padx 4 -pady 4
set l1 [label $lf.l -text "Included Object Classes"]
pack $l1 -anchor w
set rf [frame $f.right]
pack $rf -side left -expand 0 -fill both -padx 4 -pady 4
set l2 [label $rf.l]
pack $l2 -anchor w
set vals(classes:all_classes) [Apol_Class_Perms::getClasses]
set classes [Apol_Widget::makeScrolledListbox $lf.classes -height 10 -width 24 \
-listvar Apol_Analysis_domaintrans::vals(classes:all_classes) \
-selectmode extended -exportselection 0]
set classes_lb [Apol_Widget::getScrolledListbox $classes]
pack $classes -expand 1 -fill both
set cbb [ButtonBox $lf.cbb -homogeneous 1 -spacing 4]
$cbb add -text "Include All" \
-command [list Apol_Analysis_domaintrans::_includeAllClasses $classes_lb]
$cbb add -text "Ignore All" \
-command [list Apol_Analysis_domaintrans::_ignoreAllClasses $classes_lb]
pack $cbb -pady 4 -expand 0
set perms [Apol_Widget::makeScrolledListbox $rf.perms -height 10 -width 24 \
-listvar Apol_Analysis_domaintrans::vals(classes:perms_displayed) \
-selectmode extended -exportselection 0]
set perms_lb [Apol_Widget::getScrolledListbox $perms]
pack $perms -expand 1 -fill both
set pbb [ButtonBox $rf.pbb -homogeneous 1 -spacing 4]
$pbb add -text "Include All" \
-command [list Apol_Analysis_domaintrans::_includeAllPerms $classes_lb $perms_lb]
$pbb add -text "Ignore All" \
-command [list Apol_Analysis_domaintrans::_ignoreAllPerms $classes_lb $perms_lb]
pack $pbb -pady 4 -expand 0
bind $classes_lb <<ListboxSelect>> \
[list Apol_Analysis_domaintrans::_selectClassListbox $l2 $classes_lb $perms_lb]
bind $perms_lb <<ListboxSelect>> \
[list Apol_Analysis_domaintrans::_selectPermListbox $classes_lb $perms_lb]
foreach class_key [array names vals classes:*:enable] {
if {$vals($class_key)} {
regexp -- {^classes:([^:]+):enable} $class_key -> class
set i [lsearch [Apol_Class_Perms::getClasses] $class]
$classes_lb selection set $i $i
}
}
if {[set anchor [lindex [lsort [$classes_lb curselection]] 0]] != {}} {
$classes_lb selection anchor $anchor
$classes_lb see $anchor
}
set vals(classes:perms_displayed) {}
_selectClassListbox $l2 $classes_lb $perms_lb
}
proc Apol_Analysis_domaintrans::_selectClassListbox {perm_label lb plb} {
variable vals
for {set i 0} {$i < [$lb index end]} {incr i} {
set c [$lb get $i]
set vals(classes:$c:enable) [$lb selection includes $i]
}
if {[set class [$lb get anchor]] == {}} {
$perm_label configure -text "Permissions"
return
}
$perm_label configure -text "Permissions for $class"
set vals(classes:perms_displayed) [Apol_Class_Perms::getPermsForClass $class]
$plb selection clear 0 end
foreach p $vals(classes:$class) {
set i [lsearch $vals(classes:perms_displayed) $p]
$plb selection set $i
}
if {[set anchor [lindex [lsort [$plb curselection]] 0]] != {}} {
$plb selection anchor $anchor
$plb see $anchor
}
focus $lb
}
proc Apol_Analysis_domaintrans::_includeAllClasses {lb} {
variable vals
$lb selection set 0 end
foreach c [Apol_Class_Perms::getClasses] {
set vals(classes:$c:enable) 1
}
}
proc Apol_Analysis_domaintrans::_ignoreAllClasses {lb} {
variable vals
$lb selection clear 0 end
foreach c [Apol_Class_Perms::getClasses] {
set vals(classes:$c:enable) 0
}
}
proc Apol_Analysis_domaintrans::_selectPermListbox {lb plb} {
variable vals
set class [$lb get anchor]
set p {}
foreach i [$plb curselection] {
lappend p [$plb get $i]
}
set vals(classes:$class) $p
focus $plb
}
proc Apol_Analysis_domaintrans::_includeAllPerms {lb plb} {
variable vals
set class [$lb get anchor]
$plb selection set 0 end
set vals(classes:$class) $vals(classes:perms_displayed)
}
proc Apol_Analysis_domaintrans::_ignoreAllPerms {lb plb} {
variable vals
set class [$lb get anchor]
$plb selection clear 0 end
set vals(classes:$class) {}
}
proc Apol_Analysis_domaintrans::_checkParams {} {
variable vals
variable widgets
if {![ApolTop::is_policy_open]} {
return "No current policy file is opened."
}
set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(type)]
if {[lindex $type 0] == {}} {
return "No type was selected."
}
if {![Apol_Types::isTypeInPolicy [lindex $type 0]]} {
return "[lindex $type 0] is not a type within the policy."
}
set vals(type) [lindex $type 0]
set vals(type:attrib) [lindex $type 1]
set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
if {$use_regexp && $regexp == {}} {
return "No regular expression provided."
}
set vals(regexp:enable) $use_regexp
set vals(regexp) $regexp
if {$vals(dir) == $::APOL_DOMAIN_TRANS_DIRECTION_FORWARD && $vals(access:enable)} {
set classperm_pairs {}
foreach class [Apol_Class_Perms::getClasses] {
if {$vals(classes:$class:enable) == 0} {
continue
}
if {$vals(classes:$class) == {}} {
return "No permissions were selected for class $class."
}
foreach perm $vals(classes:$class) {
lappend classperm_pairs [list $class $perm]
}
}
if {$vals(targets:inc) == {}} {
return "No object types were selected."
}
if {$classperm_pairs == {}} {
return "No object classes were selected."
}
set vals(search:object_types) $vals(targets:inc)
set vals(search:classperm_pairs) $classperm_pairs
} else {
set vals(search:object_types) {}
set vals(search:classperm_pairs) {}
}
if {$vals(regexp:enable)} {
set vals(search:regexp) $vals(regexp)
} else {
set vals(search:regexp) {}
}
return {} ;# all parameters passed, now ready to do search
}
proc Apol_Analysis_domaintrans::_analyze {} {
variable vals
$::ApolTop::policy reset_domain_trans_table
set q [new_apol_domain_trans_analysis_t]
$q set_direction $::ApolTop::policy $vals(dir)
$q set_start_type $::ApolTop::policy $vals(type)
$q set_result_regex $::ApolTop::policy $vals(search:regexp)
foreach o $vals(search:object_types) {
$q append_access_type $::ApolTop::policy $o
}
foreach {cp_pair} $vals(search:classperm_pairs) {
$q append_class $::ApolTop::policy [lindex $cp_pair 0]
$q append_perm $::ApolTop::policy [lindex $cp_pair 1]
}
apol_tcl_set_info_string $::ApolTop::policy "Building domain transition table..."
$::ApolTop::policy build_domain_trans_table
apol_tcl_set_info_string $::ApolTop::policy "Performing Domain Transition Analysis..."
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
return $v
}
proc Apol_Analysis_domaintrans::_analyzeMore {tree node analysis_args} {
set new_start [$tree itemcget $node -text]
if {[$tree itemcget [$tree parent $node] -text] == $new_start} {
return {}
}
foreach {dir orig_type object_types classperm_pairs regexp} $analysis_args {break}
set q [new_apol_domain_trans_analysis_t]
$q set_direction $::ApolTop::policy $dir
$q set_start_type $::ApolTop::policy $new_start
$q set_result_regex $::ApolTop::policy $regexp
foreach o $object_types {
$q append_access_type $::ApolTop::policy $o
}
foreach {cp_pair} $classperm_pairs {
$q append_class $::ApolTop::policy [lindex $cp_pair 0]
$q append_perm $::ApolTop::policy [lindex $cp_pair 1]
}
$::ApolTop::policy reset_domain_trans_table
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
return $v
}
proc Apol_Analysis_domaintrans::_createResultsDisplay {} {
variable vals
set f [Apol_Analysis::createResultTab "Domain Trans" [array get vals]]
if {$vals(dir) == $::APOL_DOMAIN_TRANS_DIRECTION_FORWARD} {
set tree_title "Forward Domain Transition"
} else {
set tree_title "Reverse Domain Transition"
}
set tree_tf [TitleFrame $f.left -text $tree_title]
pack $tree_tf -side left -expand 0 -fill y -padx 2 -pady 2
set sw [ScrolledWindow [$tree_tf getframe].sw -auto both]
set tree [Tree [$sw getframe].tree -width 24 -redraw 1 -borderwidth 0 \
-highlightthickness 0 -showlines 1 -padx 0 -bg white]
$sw setwidget $tree
pack $sw -expand 1 -fill both
set res_tf [TitleFrame $f.right -text "Domain Transition Results"]
pack $res_tf -side left -expand 1 -fill both -padx 2 -pady 2
set res [Apol_Widget::makeSearchResults [$res_tf getframe].res]
$res.tb tag configure title -font {Helvetica 14 bold}
$res.tb tag configure title_type -foreground blue -font {Helvetica 14 bold}
$res.tb tag configure subtitle -font {Helvetica 10 bold}
$res.tb tag configure num -foreground blue -font {Helvetica 10 bold}
pack $res -expand 1 -fill both
$tree configure -selectcommand [list Apol_Analysis_domaintrans::_treeSelect $res]
$tree configure -opencmd [list Apol_Analysis_domaintrans::_treeOpen $tree]
return $f
}
proc Apol_Analysis_domaintrans::_treeSelect {res tree node} {
if {$node != {}} {
$res.tb configure -state normal
$res.tb delete 0.0 end
set data [$tree itemcget $node -data]
if {[string index $node 0] == "f" || [string index $node 0] == "r"} {
_renderResultsDTA $res $tree $node [lindex $data 1]
} else {
eval $res.tb insert end $data
}
$res.tb configure -state disabled
}
}
proc Apol_Analysis_domaintrans::_treeOpen {tree node} {
foreach {search_crit results} [$tree itemcget $node -data] {break}
if {([string index $node 0] == "f" || [string index $node 0] == "r") && $search_crit != {}} {
set new_results [Apol_Progress_Dialog::wait "Domain Transition Analysis" \
"Performing Domain Transition Analysis..." \
{ _analyzeMore $tree $node $search_crit }]
$tree itemconfigure $node -data [list {} $results]
if {$new_results != {}} {
_createResultsNodes $tree $node $new_results $search_crit
$new_results -acquire
$new_results -delete
}
}
}
proc Apol_Analysis_domaintrans::_clearResultsDisplay {f} {
variable vals
set tree [[$f.left getframe].sw getframe].tree
set res [$f.right getframe].res
$tree delete [$tree nodes root]
Apol_Widget::clearSearchResults $res
Apol_Analysis::setResultTabCriteria [array get vals]
}
proc Apol_Analysis_domaintrans::_renderResults {f results} {
variable vals
set tree [[$f.left getframe].sw getframe].tree
set res [$f.right getframe].res
$tree insert end root top -text $vals(type) -open 1 -drawcross auto
set top_text [_renderTopText]
$tree itemconfigure top -data $top_text
set search_crit [list $vals(dir) $vals(type) $vals(search:object_types) $vals(search:classperm_pairs) $vals(search:regexp)]
_createResultsNodes $tree top $results $search_crit
$tree selection set top
$tree opentree top 0
$tree see top
}
proc Apol_Analysis_domaintrans::_renderTopText {} {
variable vals
if {$vals(dir) == $::APOL_DOMAIN_TRANS_DIRECTION_FORWARD} {
set top_text [list "Forward Domain Transition Analysis: Starting Type: " title]
} else {
set top_text [list "Reverse Domain Transition Analysis: Starting Type: " title]
}
lappend top_text $vals(type) title_type \
"\n\n" title
if {$vals(dir) == $::APOL_DOMAIN_TRANS_DIRECTION_FORWARD} {
lappend top_text \
"This 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.
\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" {}
} else {
lappend top_text \
"This 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.
\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" {}
}
lappend top_text \
"\nNOTE: For any given generation, if the parent and the child are the
same, you cannot open the child. This avoids cyclic analyses.
\nThe criteria that defines an allowed domain transition are:
\n1) There must be at least one rule that allows TRANSITION access for
PROCESS objects between the SOURCE and TARGET domain types.
\n2) There must be at least one FILE TYPE that allows the TARGET type
ENTRYPOINT access for FILE objects.
\n3) There must be at least one FILE TYPE that meets criterion 2) above
and allows the SOURCE type EXECUTE access for FILE objects.
\n4) For modular policies and monolithic policies greater than version
15, there must also be at least one of the following:
a) A type_transition rule for class PROCESS from SOURCE to TARGET
for FILE TYPE, or
b) A rule that allows SETEXEC for SOURCE to itself.
\nThe information window shows all the rules and file types that meet
these criteria for each target domain type." {}
}
proc Apol_Analysis_domaintrans::_createResultsNodes {tree parent_node results search_crit} {
set dir [lindex $search_crit 0]
set dt_list [domain_trans_result_vector_to_list $results]
set results_processed 0
foreach r $dt_list {
apol_tcl_set_info_string $::ApolTop::policy "Processing result $results_processed of [llength $dt_list]"
set source [[$r get_start_type] get_name $::ApolTop::qpolicy]
set target [[$r get_end_type] get_name $::ApolTop::qpolicy]
set intermed [[$r get_entrypoint_type] get_name $::ApolTop::qpolicy]
set proctrans [avrule_vector_to_list [$r get_proc_trans_rules]]
set entrypoint [avrule_vector_to_list [$r get_entrypoint_rules]]
set execute [avrule_vector_to_list [$r get_exec_rules]]
set setexec [avrule_vector_to_list [$r get_setexec_rules]]
set type_trans [terule_vector_to_list [$r get_type_trans_rules]]
set access_list [avrule_vector_to_list [$r get_access_rules]]
if {$dir == $::APOL_DOMAIN_TRANS_DIRECTION_FORWARD} {
set key $target
set node f:\#auto
} else {
set key $source
set node r:\#auto
}
foreach p $proctrans {
lappend types($key) $p
}
if {[info exists types($key:setexec)]} {
set types($key:setexec) [concat $types($key:setexec) $setexec]
} else {
set types($key:setexec) $setexec
}
lappend types($key:inter) $intermed
foreach e $entrypoint {
lappend types($key:inter:$intermed:entry) $e
}
foreach e $execute {
lappend types($key:inter:$intermed:exec) $e
}
if {[info exists types($key:inter:$intermed:type_trans)]} {
set types($key:inter:$intermed:type_trans) [concat $types($key:inter:$intermed:type_trans) $type_trans]
} else {
set types($key:inter:$intermed:type_trans) $type_trans
}
if {[info exists types($key:access)]} {
set types($key:access) [concat $types($key:access) $access_list]
} else {
set types($key:access) $access_list
}
incr results_processed
}
foreach key [lsort [array names types]] {
if {[string first : $key] != -1} {
continue
}
set ep {}
set proctrans [lsort -uniq $types($key)]
set setexec [lsort -uniq $types($key:setexec)]
foreach intermed [lsort -uniq $types($key:inter)] {
lappend ep [list $intermed \
[lsort -uniq $types($key:inter:$intermed:entry)] \
[lsort -uniq $types($key:inter:$intermed:exec)] \
[lsort -uniq $types($key:inter:$intermed:type_trans)]]
}
set access_list [lsort -uniq $types($key:access)]
set data [list $proctrans $setexec $ep $access_list]
$tree insert end $parent_node $node -text $key -drawcross allways \
-data [list $search_crit $data]
}
}
proc Apol_Analysis_domaintrans::_renderResultsDTA {res tree node data} {
set parent_name [$tree itemcget [$tree parent $node] -text]
set name [$tree itemcget $node -text]
foreach {proctrans setexec ep access_list} $data {break}
if {[string index $node 0] == "f"} {
set header [list "Domain transition from " title \
$parent_name title_type \
" to " title \
$name title_type]
} else {
set header [list "Domain transition from " title \
$name title_type \
" to " title \
$parent_name title_type]
}
eval $res.tb insert end $header
$res.tb insert end "\n\n" title_type
$res.tb insert end "Process Transition Rules: " subtitle \
[llength $proctrans] num \
"\n" subtitle
set v [list_to_vector $proctrans]
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 6 $v qpol_avrule_from_void
$v -acquire
$v -delete
if {[llength $setexec] > 0} {
$res.tb insert end "\n" {} \
"Setexec Rules: " subtitle \
[llength $setexec] num \
"\n" subtitle
set v [list_to_vector $setexec]
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 6 $v qpol_avrule_from_void
$v -acquire
$v -delete
}
$res.tb insert end "\nEntry Point File Types: " subtitle \
[llength $ep] num
foreach e [lsort -index 0 $ep] {
foreach {intermed entrypoint execute type_trans} $e {break}
$res.tb insert end "\n $intermed\n" {} \
" " {} \
"File Entrypoint Rules: " subtitle \
[llength $entrypoint] num \
"\n" subtitle
set v [list_to_vector $entrypoint]
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 12 $v qpol_avrule_from_void
$v -acquire
$v -delete
$res.tb insert end "\n" {} \
" " {} \
"File Execute Rules: " subtitle \
[llength $execute] num \
"\n" subtitle
set v [list_to_vector $execute]
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 12 $v qpol_avrule_from_void
$v -acquire
$v -delete
if {[llength $type_trans] > 0} {
$res.tb insert end "\n" {} \
" " {} \
"Type_transition Rules: " subtitle \
[llength $type_trans] num \
"\n" subtitle
set v [list_to_vector $type_trans]
apol_tcl_terule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 12 $v qpol_terule_from_void
$v -acquire
$v -delete
}
}
if {[llength $access_list] > 0} {
$res.tb insert end "\n" {} \
"The access filters you specified returned the following rules: " subtitle \
[llength $access_list] num \
"\n" subtitle
set v [list_to_vector $access_list]
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 6 $v qpol_avrule_from_void
$v -acquire
$v -delete
}
}
namespace eval Apol_File_Contexts {
variable opts
variable widgets
variable info_button_text \
"This tab allows the user to create and open a file context index.
The file context index is an on-disk database which contains the
labeling information for an entire filesystem. Once an index has been
created it can then be queried by user, type, MLS range (if it
contains MLS information), object class, and/or path.\n
The result of the context query is a list of matching files, ordered
by path. The first field is the full SELinux context, assuming that
'Show SELinux file context' is enabled. If 'Show object class' is
enabled, then the next field is the type of file that matched; this
will be one of 'file', 'dir', and so forth. The remaining field is
the full path to the file."
}
proc Apol_File_Contexts::create {tab_name nb} {
variable opts
variable widgets
_initializeVars
set frame [$nb insert end $tab_name -text "File Contexts"]
set status [TitleFrame $frame.status -text "File Context Index"]
set options [TitleFrame $frame.opts -text "Search Options"]
set results [TitleFrame $frame.results -text "Matching Files"]
pack $status $options -expand 0 -fill x -pady 2
pack $results -expand 1 -fill both -pady 2
set status_frame [$status getframe]
set status_buttons [ButtonBox $status_frame.bb -homogeneous 1 -padx 2]
$status_buttons add -text "Create and Open" -command {Apol_File_Contexts::_create_dialog}
$status_buttons add -text "Open" -command {Apol_File_Contexts::_open_database}
pack $status_buttons -side left -anchor nw -padx 2 -pady 4
set status_text [frame $status_frame.t]
pack $status_text -side left -anchor nw -padx 6 -pady 4
label $status_text.l -text "Opened Index:"
set status1 [label $status_text.t -textvariable Apol_File_Contexts::opts(statusText)]
set status2 [label $status_text.t2 -textvariable Apol_File_Contexts::opts(statusText2) -fg red]
trace add variable Apol_File_Contexts::opts(indexFilename) write \
[list Apol_File_Contexts::_changeStatusLabel $status1 $status2]
grid $status_text.l $status1 -sticky w
grid x $status2 -sticky w -pady 2
pack $status -side top -expand 0 -fill x -pady 2 -padx 2
set opts(indexFilename) $opts(indexFilename)
set options_frame [$options getframe]
set show_frame [frame $options_frame.show]
set user_frame [frame $options_frame.user]
set role_frame [frame $options_frame.role]
set type_frame [frame $options_frame.type]
set range_frame [frame $options_frame.range]
set objclass_frame [frame $options_frame.objclass]
set path_frame [frame $options_frame.path]
grid $show_frame $user_frame $role_frame $type_frame $range_frame $objclass_frame $path_frame \
-padx 2 -sticky news
foreach idx {1 2 3 4 5} {
grid columnconfigure $options_frame $idx -uniform 1 -weight 0
}
grid columnconfigure $options_frame 0 -weight 0 -pad 8
grid columnconfigure $options_frame 6 -weight 0
set use_regexp [checkbutton $show_frame.regexp \
-variable Apol_File_Contexts::opts(useRegexp) \
-text "Search using regular expression"]
set show_context [checkbutton $show_frame.context \
-variable Apol_File_Contexts::opts(showContext) \
-text "Show SELinux file context"]
set show_objclass [checkbutton $show_frame.objclass \
-variable Apol_File_Contexts::opts(showObjclass) \
-text "Show object class"]
pack $use_regexp $show_context $show_objclass -side top -anchor nw
checkbutton $user_frame.enable -text "User" \
-variable Apol_File_Contexts::opts(useUser)
set widgets(user) [entry $user_frame.e -width 12 \
-textvariable Apol_File_Contexts::opts(user)]
trace add variable Apol_File_Contexts::opts(useUser) write \
[list Apol_File_Contexts::_toggleEnable $widgets(user)]
pack $user_frame.enable -side top -anchor nw
pack $widgets(user) -side top -anchor nw -padx 4 -expand 0 -fill x
checkbutton $role_frame.enable -text "Role" \
-variable Apol_File_Contexts::opts(useRole)
set widgets(role) [entry $role_frame.e -width 12 \
-textvariable Apol_File_Contexts::opts(role)]
trace add variable Apol_File_Contexts::opts(useRole) write \
[list Apol_File_Contexts::_toggleEnable $widgets(role)]
pack $role_frame.enable -side top -anchor nw
pack $widgets(role) -side top -anchor nw -padx 4 -expand 0 -fill x
checkbutton $type_frame.enable -text "Type" \
-variable Apol_File_Contexts::opts(useType)
set widgets(type) [entry $type_frame.e -width 12 \
-textvariable Apol_File_Contexts::opts(type)]
trace add variable Apol_File_Contexts::opts(useType) write \
[list Apol_File_Contexts::_toggleEnable $widgets(type)]
pack $type_frame.enable -side top -anchor nw
pack $widgets(type) -side top -anchor nw -padx 4 -expand 0 -fill x
checkbutton $objclass_frame.enable -text "Object class" \
-variable Apol_File_Contexts::opts(useObjclass)
set widgets(objclass) [entry $objclass_frame.e -width 12 \
-textvariable Apol_File_Contexts::opts(objclass)]
trace add variable Apol_File_Contexts::opts(useObjclass) write \
[list Apol_File_Contexts::_toggleEnable $widgets(objclass)]
pack $objclass_frame.enable -side top -anchor nw
pack $widgets(objclass) -side top -anchor nw -padx 4 -expand 0 -fill x
set range_cb [checkbutton $range_frame.enable \
-variable Apol_File_Contexts::opts(useRange) -text "MLS range"]
set range_entry [entry $range_frame.e -width 12 \
-textvariable Apol_File_Contexts::opts(range)]
trace add variable Apol_File_Contexts::opts(useRange) write \
[list Apol_File_Contexts::_toggleEnable $range_entry]
trace add variable Apol_File_Contexts::opts(fc_is_mls) write \
[list Apol_File_Contexts::_toggleRange $range_cb $range_entry]
pack $range_cb -side top -anchor nw
pack $range_entry -side top -anchor nw -padx 4 -expand 0 -fill x
checkbutton $path_frame.enable \
-variable Apol_File_Contexts::opts(usePath) -text "File path"
set path_entry [entry $path_frame.path -width 24 \
-textvariable Apol_File_Contexts::opts(path)]
trace add variable Apol_File_Contexts::opts(usePath) write \
[list Apol_File_Contexts::_toggleEnable $path_entry]
pack $path_frame.enable -side top -anchor nw
pack $path_entry -side top -anchor nw -padx 4 -expand 0 -fill x
set bb [ButtonBox $options_frame.bb -orient vertical -homogeneous 1 -pady 2]
$bb add -text OK -width 6 -command {Apol_File_Contexts::_search}
$bb add -text Info -width 6 -command {Apol_File_Contexts::_show_info}
grid $bb -row 0 -column 7 -padx 5 -pady 5 -sticky ne
grid columnconfigure $options_frame 7 -weight 1
set widgets(results) [Apol_Widget::makeSearchResults [$results getframe].results]
pack $widgets(results) -expand yes -fill both
return $frame
}
proc Apol_File_Contexts::open {ppath} {
if {[is_db_loaded]} {
variable opts
$opts(db) associatePolicy $::ApolTop::policy
}
}
proc Apol_File_Contexts::close {} {
_close_database
}
proc Apol_File_Contexts::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_File_Contexts::is_db_loaded {} {
variable opts
if {$opts(db) != {}} {
return 1
}
return 0
}
proc Apol_File_Contexts::get_fc_files_for_ta {which ta} {
set q [new_sefs_query]
if {$which == "type"} {
$q type $ta 0
} else {
$q type $ta 1
}
variable opts
if {[catch {Apol_Progress_Dialog::wait "File Contexts" "Searching database for $ta" \
{
$opts(db) runQuery $q
}} results]} {
tk_messageBox -icon error -type ok -title "File Contexts" -message $results
delete_sefs_query $q
return {}
}
delete_sefs_query $q
return $results
}
proc Apol_File_Contexts::_initializeVars {} {
variable opts
variable widgets
array set opts {
useUser 0 user {}
useRole 0 role {}
useType 0 type {}
useObjclass 0 objclass {}
useRange 0 range {}
usePath 0 path {}
useRegexp 0 showContext 1 showObjclass 1
db {}
fc_is_mls 1
indexFilename {}
}
}
proc Apol_File_Contexts::_show_info {} {
.mainframe.frame.nb.fApol_File_Contexts.opts.f.bb.b1 configure -state disabled
Apol_Widget::showPopupParagraph "File Contexts Information" $Apol_File_Contexts::info_button_text
.mainframe.frame.nb.fApol_File_Contexts.opts.f.bb.b1 configure -state normal
}
proc Apol_File_Contexts::_changeStatusLabel {label1 label2 name1 name2 opt} {
variable opts
if {$opts(db) == {}} {
set opts(statusText) "No Index File Opened"
$label1 configure -fg red
set opts(statusText2) {}
} else {
set opts(statusText) $opts(indexFilename)
$label1 configure -fg black
if {$opts(fc_is_mls)} {
set opts(statusText2) "Database contexts include MLS ranges."
$label2 configure -fg black
} else {
set opts(statusText2) "Database contexts do not include MLS ranges."
$label2 configure -fg red
}
}
}
proc Apol_File_Contexts::_toggleEnable {entry name1 name2 op} {
variable opts
if {$opts($name2)} {
$entry configure -state normal -bg white
} else {
$entry configure -state disabled -bg $ApolTop::default_bg_color
}
}
proc Apol_File_Contexts::_toggleRange {cb entry name1 name2 op} {
variable opts
if {$opts(fc_is_mls)} {
$cb configure -state normal
if {$opts(useRange)} {
$entry configure -state normal -bg white
}
} else {
$cb configure -state disabled
$entry configure -state disabled -bg $ApolTop::default_bg_color
}
}
proc Apol_File_Contexts::_create_dialog {} {
variable opts
set opts(new_filename) $opts(indexFilename)
set opts(new_rootdir) "/"
set d [Dialog .filecontexts_create -title "Create Index File" \
-default 0 -cancel 1 -modal local -parent . -separator 1]
$d add -text "OK" -command [list Apol_File_Contexts::_create_database $d] \
-state disabled
$d add -text "Cancel"
set f [$d getframe]
set file_l [label $f.file_l -justify left -anchor w -text "Save index to:"]
set file_entry [entry $f.file_e -width 30 -bg white -takefocus 1\
-textvariable Apol_File_Contexts::opts(new_filename) \
-validate key \
-vcmd [list Apol_File_Contexts::_validateEntryKey %P $d new_rootdir]]
focus $file_entry
set file_browse [button $f.file_b -text "Browse" -width 8 -takefocus 1 \
-command [list Apol_File_Contexts::_browse_save]]
set root_l [label $f.root_l -justify left -anchor w -text "Directory to index:"]
set root_entry [entry $f.root_e -width 30 -bg white -takefocus 1 \
-textvariable Apol_File_Contexts::opts(new_rootdir) \
-validate key \
-vcmd [list Apol_File_Contexts::_validateEntryKey %P $d new_filename]]
set root_browse [button $f.root_b -text "Browse" -width 8 -takefocus 1 \
-command [list Apol_File_Contexts::_browse_root]]
grid $file_l $file_entry $file_browse -padx 4 -pady 2 -sticky ew
grid $root_l $root_entry $root_browse -padx 4 -pady 2 -sticky ew
grid columnconfigure $f 0 -weight 0
grid columnconfigure $f 1 -weight 1
grid columnconfigure $f 2 -weight 0
$d draw
destroy $d
}
proc Apol_File_Contexts::_browse_save {} {
variable opts
set f [tk_getSaveFile -initialfile $opts(new_filename) \
-parent .filecontexts_create -title "Save Index"]
if {$f != {}} {
set opts(new_filename) $f
}
}
proc Apol_File_Contexts::_browse_root {} {
variable opts
set f [tk_chooseDirectory -initialdir $opts(new_rootdir) \
-parent .filecontexts_create -title "Directory to Index"]
if {$f != {}} {
set opts(new_rootdir) $f
}
}
proc Apol_File_Contexts::_validateEntryKey {newvalue dialog othervar} {
variable opts
if {$newvalue == {} || $opts($othervar) == {}} {
$dialog itemconfigure 0 -state disabled
} else {
$dialog itemconfigure 0 -state normal
}
return 1
}
proc Apol_File_Contexts::_create_database {dialog} {
variable opts
if {[catch {Apol_Progress_Dialog::wait "Create Database" "Scanning $opts(new_rootdir)" \
{
set db [apol_tcl_open_database_from_dir $opts(new_rootdir)]
$db save $opts(new_filename)
set db
} \
} db] || $db == "NULL"} {
tk_messageBox -icon error -type ok -title "Create Database" \
-message [apol_tcl_get_info_string]
return
}
if {$opts(db) != {}} {
delete_sefs_fclist $opts(db)
}
_initializeVars
set opts(db) $db
set opts(fc_is_mls) [$db isMLS]
set opts(indexFilename) $opts(new_filename)
if {[ApolTop::is_policy_open]} {
$opts(db) associatePolicy $::ApolTop::policy
}
$dialog enddialog {}
}
proc Apol_File_Contexts::_open_database {} {
variable opts
set f [tk_getOpenFile -initialfile $opts(indexFilename) -parent . \
-title "Open Database"]
if {$f == {}} {
return
}
if {[catch {Apol_Progress_Dialog::wait "Open Database" "Opening $f" \
{apol_tcl_open_database $f} \
} db] || $db == "NULL"} {
tk_messageBox -icon error -type ok -title "Open Database" \
-message [apol_tcl_get_info_string]
return
}
if {$opts(db) != {}} {
delete_sefs_fclist $opts(db)
}
_initializeVars
set opts(db) $db
set opts(fc_is_mls) [$db isMLS]
set opts(indexFilename) $f
if {[ApolTop::is_policy_open]} {
$opts(db) associatePolicy $::ApolTop::policy
}
}
proc Apol_File_Contexts::_search {} {
variable opts
variable widgets
if {$opts(db) == {}} {
tk_messageBox -icon error -type ok -title "File Contexts" -message "No database opened."
return
}
Apol_Widget::clearSearchResults $widgets(results)
if {$opts(useUser)} {
if {[set user $opts(user)] == {}} {
tk_messageBox -icon error -type ok -title "File Contexts" -message "No user selected."
return
}
} else {
set user {}
}
if {$opts(useRole)} {
if {[set role $opts(role)] == {}} {
tk_messageBox -icon error -type ok -title "File Contexts" -message "No user selected."
return
}
} else {
set role {}
}
if {$opts(useType)} {
if {[set type $opts(type)] == {}} {
tk_messageBox -icon error -type ok -title "File Contexts" -message "No type selected."
return
}
} else {
set type {}
}
if {$opts(fc_is_mls) && $opts(useRange)} {
if {[set range $opts(range)] == {}} {
tk_messageBox -icon error -type ok -title "File Contexts" -message "No MLS range selected."
return
}
} else {
set range {}
}
if {$opts(useObjclass)} {
if {[set objclass $opts(objclass)] == {}} {
tk_messageBox -icon error -type ok -title "File Contexts" -message "No object class selected."
return
}
} else {
set objclass {}
}
if {$opts(usePath)} {
if {[set path $opts(path)] == {}} {
tk_messageBox -icon error -type ok -title "File Contexts" -message "No path selected."
return
}
} else {
set path {}
}
set q [new_sefs_query]
$q user $user
$q role $role
$q type $type 0
$q range $range 0
$q objectClass $objclass
$q path $path
$q regex $opts(useRegexp)
if {[catch {Apol_Progress_Dialog::wait "File Contexts" "Searching database" \
{
set num_results [apol_tcl_query_database $opts(db) $q]
if {$num_results == 0} {
Apol_Widget::appendSearchResultText $widgets(results) "Search returned no results."
} else {
Apol_Widget::appendSearchResultHeader $widgets(results) "FILES FOUND ($num_results):\n\n"
}
}} err]} {
tk_messageBox -icon error -type ok -title "File Contexts" -message $err
}
delete_sefs_query $q
}
proc Apol_File_Contexts::_search_callback {entry} {
variable opts
variable widgets
set text {}
if {$opts(showContext)} {
set context [[$entry context] render NULL]
append text [format "%-40s" $context]
}
if {$opts(showObjclass)} {
set class [apol_objclass_to_str [$entry objectClass]]
append text [format " %-12s" $class]
}
append text " [$entry path]\n"
Apol_Widget::appendSearchResultText $widgets(results) $text
}
proc Apol_File_Contexts::_close_database {} {
variable opts
variable widgets
if {$opts(db) != {}} {
delete_sefs_fclist $opts(db)
}
_initializeVars
Apol_Widget::clearSearchResults $widgets(results)
}
namespace eval Apol_Find {
variable dialog .apol_find_dialog
variable search_string {}
variable case_sensitive 0
variable enable_regexp 0
variable direction "down"
}
proc Apol_Find::find {} {
variable dialog
if {![winfo exists $dialog]} {
_create_dialog
} else {
raise $dialog
variable entry
focus $entry
$entry selection range 0 end
}
}
proc Apol_Find::_create_dialog {} {
variable dialog
Dialog $dialog -title "Find" -separator 0 -parent . \
-side right -default 0 -cancel 1 -modal none -homogeneous 1
set top_frame [frame [$dialog getframe].top]
set bottom_frame [frame [$dialog getframe].bottom]
pack $top_frame -expand 1 -fill both -padx 10 -pady 5
pack $bottom_frame -expand 0 -fill both -padx 10 -pady 5
set entry_label [label $top_frame.l -text "Find:" -anchor e]
variable entry [entry $top_frame.e -bg white \
-textvariable Apol_Find::search_string -width 16]
pack $entry_label -side left -expand 0 -padx 10
pack $entry -side left -expand 1 -fill x
set options_frame [frame $bottom_frame.opts]
pack $options_frame -side left -padx 5
set options_case [checkbutton $options_frame.case -text "Match case" \
-variable Apol_Find::case_sensitive]
set options_regex [checkbutton $options_frame.regex -text "Regular expression" \
-variable Apol_Find::enable_regexp]
pack $options_case -anchor w
pack $options_regex -anchor w
set dir_frame [TitleFrame $bottom_frame.dir -text Direction]
pack $dir_frame -side left
set dir_up [radiobutton [$dir_frame getframe].up -text Up \
-variable Apol_Find::direction -value up]
set dir_down [radiobutton [$dir_frame getframe].down -text Down \
-variable Apol_Find::direction -value down]
pack $dir_up $dir_down -side left
$dialog add -text "Find Next" -command Apol_Find::_do_find
$dialog add -text "Cancel" -command [list destroy $dialog]
focus $entry
$dialog draw
wm resizable $dialog 0 0
}
proc Apol_Find::_do_find {} {
set w [ApolTop::getCurrentTextWidget]
if {$w == {}} {
return
}
variable search_string
variable case_sensitive
variable enable_regexp
variable direction
if {$search_string == {}} {
return
}
set opts {}
if {!$case_sensitive} {
lappend opts "-nocase"
}
if {$enable_regexp} {
lappend opts "-regexp"
}
if {$direction == "down"} {
lappend opts "-forward"
set start_pos [$w index insert]
} else {
lappend opts "-backward"
set start_pos [lindex [$w tag ranges sel] 0]
}
if {$start_pos == {}} {
set start_pos "1.0"
}
$w tag remove sel 0.0 end
variable dialog
if {[catch {eval $w search -count count $opts -- [list $search_string] $start_pos} pos]} {
tk_messageBox -parent $dialog -icon warning -type ok -title "Find" -message \
"Invalid regular expression."
return
}
if {$pos == {}} {
tk_messageBox -parent $dialog -icon warning -type ok -title "Find" -message \
"String not found."
} else {
if {$direction == "down"} {
$w mark set insert "$pos + $count char"
$w see "$pos + $count char"
} else {
$w mark set insert "$pos"
$w see $pos
}
$w tag add sel $pos "$pos + $count char"
}
}
namespace eval Apol_FSContexts {
variable widgets
variable vals
}
proc Apol_FSContexts::create {tab_name nb} {
variable widgets
variable vals
_initializeVars
set frame [$nb insert end $tab_name -text "FS Contexts"]
set pw [PanedWindow $frame.pw -side top -weights extra]
set leftf [$pw add -weight 0]
set rightf [$pw add -weight 1]
pack $pw -fill both -expand yes
set context_box [TitleFrame $leftf.context_f -text "Context Type"]
set context_f [$context_box getframe]
radiobutton $context_f.genfscon -text "genfscon" -value genfscon \
-variable Apol_FSContexts::vals(context_type)
radiobutton $context_f.fsuse -text "fs_use" -value fsuse \
-variable Apol_FSContexts::vals(context_type)
trace add variable Apol_FSContexts::vals(context_type) write \
{Apol_FSContexts::_contextTypeChanged}
pack $context_f.genfscon $context_f.fsuse \
-anchor w -expand 0 -padx 4 -pady 5
pack $context_box -expand 0 -fill x
set widgets(items_tf) [TitleFrame $leftf.items_f -text "GenFS Contexts"]
set widgets(items) [Apol_Widget::makeScrolledListbox [$widgets(items_tf) getframe].items \
-height 20 -width 20 -listvar Apol_FSContexts::vals(items)]
Apol_Widget::setListboxCallbacks $widgets(items) \
{{"Show Context Info" {Apol_FSContexts::_popupContextInfo}}}
pack $widgets(items) -expand 1 -fill both
pack $widgets(items_tf) -expand 1 -fill both
set optsbox [TitleFrame $rightf.optsbox -text "Search Options"]
pack $optsbox -side top -expand 0 -fill both -padx 2
set widgets(options_pm) [PagesManager [$optsbox getframe].pm]
_genfscon_create [$widgets(options_pm) add genfscon]
_fsuse_create [$widgets(options_pm) add fsuse]
$widgets(options_pm) compute_size
pack $widgets(options_pm) -expand 1 -fill both -side left
$widgets(options_pm) raise genfscon
set ok [button [$optsbox getframe].ok -text "OK" -width 6 \
-command Apol_FSContexts::_runSearch]
pack $ok -side right -pady 5 -padx 5 -anchor ne
set resultsbox [TitleFrame $rightf.resultsbox -text "Search Results"]
pack $resultsbox -expand yes -fill both -padx 2
set widgets(results) [Apol_Widget::makeSearchResults [$resultsbox getframe].results]
pack $widgets(results) -side top -expand yes -fill both
return $frame
}
proc Apol_FSContexts::open {ppath} {
variable vals
_genfscon_open
_fsuse_open
set vals(context_type) genfscon
}
proc Apol_FSContexts::close {} {
variable widgets
_initializeVars
Apol_Widget::clearSearchResults $widgets(results)
Apol_Widget::clearContextSelector $widgets(genfscon:context)
Apol_Widget::clearContextSelector $widgets(fsuse:context)
$widgets(genfscon:fs) configure -values {}
$widgets(fsuse:type) configure -values {}
$widgets(fsuse:fs) configure -values {}
}
proc Apol_FSContexts::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_FSContexts::_initializeVars {} {
variable vals
array set vals {
genfscon:items {}
genfscon:fs_enable 0 genfscon:fs {}
genfscon:path_enable 0 genfscon:path {}
fsuse:items {}
fsuse:type_enable 0 fsuse:type {}
fsuse:fs_enable 0 fsuse:fs {}
items {}
context_type genfscon
}
}
proc Apol_FSContexts::_contextTypeChanged {name1 name2 op} {
variable vals
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
if {$vals(context_type) == "genfscon"} {
_genfscon_show
} else {
_fsuse_show
}
}
proc Apol_FSContexts::_popupContextInfo {value} {
variable vals
if {$vals(context_type) == "genfscon"} {
_genfscon_popup $value
} else {
_fsuse_popup $value
}
}
proc Apol_FSContexts::_toggleCheckbutton {path name1 name2 op} {
variable vals
variable widgets
if {$vals($name2)} {
$path configure -state normal
} else {
$path configure -state disabled
}
}
proc Apol_FSContexts::_runSearch {} {
variable vals
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
return
}
if {$vals(context_type) == "genfscon"} {
_genfscon_runSearch
} else {
_fsuse_runSearch
}
}
proc Apol_FSContexts::_genfscon_create {p_f} {
variable widgets
variable vals
set fs [frame $p_f.fs]
set fs_cb [checkbutton $fs.fs_enable -text "Filesystem" \
-variable Apol_FSContexts::vals(genfscon:fs_enable)]
set widgets(genfscon:fs) [ComboBox $fs.fs -entrybg white -width 12 -state disabled \
-textvariable Apol_FSContexts::vals(genfscon:fs) -autopost 1]
trace add variable Apol_FSContexts::vals(genfscon:fs_enable) write \
[list Apol_FSContexts::_toggleCheckbutton $widgets(genfscon:fs)]
pack $fs_cb -side top -anchor w
pack $widgets(genfscon:fs) -side top -expand 0 -fill x -padx 4
set p [frame $p_f.p]
set p_cb [checkbutton $p.p_enable -text "Path" \
-variable Apol_FSContexts::vals(genfscon:path_enable)]
set widgets(genfscon:path) [entry $p.path -bg white -width 24 \
-state disabled \
-textvariable Apol_FSContexts::vals(genfscon:path)]
trace add variable Apol_FSContexts::vals(genfscon:path_enable) write \
[list Apol_FSContexts::_toggleCheckbutton $widgets(genfscon:path)]
pack $p_cb -side top -anchor w
pack $widgets(genfscon:path) -side top -expand 0 -fill x -padx 4
frame $p_f.c
set widgets(genfscon:context) [Apol_Widget::makeContextSelector $p_f.c.context "Contexts"]
pack $widgets(genfscon:context)
pack $fs $p $p_f.c -side left -anchor n -padx 4 -pady 2
}
proc Apol_FSContexts::_genfscon_open {} {
variable vals
set q [new_apol_genfscon_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set genfscons [genfscon_vector_to_list $v]
set vals(genfscon:items) {}
foreach g $genfscons {
lappend vals(genfscon:items) [$g get_name $::ApolTop::qpolicy]
}
set vals(genfscon:items) [lsort -unique $vals(genfscon:items)]
$v -acquire
$v -delete
variable widgets
$widgets(genfscon:fs) configure -values $vals(genfscon:items)
}
proc Apol_FSContexts::_genfscon_show {} {
variable vals
variable widgets
$widgets(items_tf) configure -text "GenFS Contexts"
$widgets(options_pm) raise genfscon
set vals(items) $vals(genfscon:items)
}
proc Apol_FSContexts::_genfscon_popup {fstype} {
set q [new_apol_genfscon_query_t]
$q set_filesystem $::ApolTop::policy $fstype
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set genfscons [genfscon_vector_to_list $v]
set text "genfs filesystem $fstype ([llength $genfscons] context"
if {[llength $genfscons] != 1} {
append text s
}
append text ")"
foreach g [lsort -command _genfscon_sort $genfscons] {
append text "\n [_genfscon_render $g]"
}
Apol_Widget::showPopupText "filesystem $fstype" $text
$v -acquire
$v -delete
}
proc Apol_FSContexts::_genfscon_runSearch {} {
variable vals
variable widgets
if {$vals(genfscon:fs_enable)} {
if {$vals(genfscon:fs) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No filesystem selected."
return
}
set fstype $vals(genfscon:fs_enable)
} else {
set fstype {}
}
if {$vals(genfscon:path_enable)} {
if {$vals(genfscon:path) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No path given."
return
}
set path $vals(genfscon:path)
} else {
set path {}
}
set q [new_apol_genfscon_query_t]
if {[Apol_Widget::getContextSelectorState $widgets(genfscon:context)]} {
foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(genfscon:context)] {break}
$q set_context $::ApolTop::policy $context $range_match
}
$q set_filesystem $::ApolTop::policy $fstype
$q set_path $::ApolTop::policy $path
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set genfscons [genfscon_vector_to_list $v]
set results "GENFSCONS:"
if {[llength $genfscons] == 0} {
append results "\nSearch returned no results."
} else {
foreach g [lsort -command _genfscon_sort $genfscons] {
append results "\n[_genfscon_render $g]"
}
}
Apol_Widget::appendSearchResultText $widgets(results) $results
$v -acquire
$v -delete
}
proc Apol_FSContexts::_genfscon_render {qpol_genfscon_datum} {
apol_genfscon_render $::ApolTop::policy $qpol_genfscon_datum
}
proc Apol_FSContexts::_genfscon_sort {a b} {
set name_a [$a get_name $::ApolTop::qpolicy]
set name_b [$b get_name $::ApolTop::qpolicy]
if {[set z [string compare $name_a $name_b]] != 0} {
return $z
}
set path_a [$a get_path $::ApolTop::qpolicy]
set path_b [$b get_path $::ApolTop::qpolicy]
if {[set z [string compare $path_a $path_b]] != 0} {
return $z
}
return 0
}
proc Apol_FSContexts::_fsuse_create {p_f} {
variable widgets
variable vals
set t [frame $p_f.t]
set type_cb [checkbutton $t.type_enable -text "Statement type" \
-variable Apol_FSContexts::vals(fsuse:type_enable)]
set widgets(fsuse:type) [ComboBox $t.type -entrybg white -width 12 -state disabled \
-textvariable Apol_FSContexts::vals(fsuse:type) -autopost 1]
trace add variable Apol_FSContexts::vals(fsuse:type_enable) write \
[list Apol_FSContexts::_toggleCheckbutton $widgets(fsuse:type)]
pack $type_cb -side top -anchor w
pack $widgets(fsuse:type) -side top -expand 0 -fill x -padx 4
set fs [frame $p_f.fs]
set fs_cb [checkbutton $fs.fs_enable -text "Filesystem" \
-variable Apol_FSContexts::vals(fsuse:fs_enable)]
set widgets(fsuse:fs) [ComboBox $fs.fs -entrybg white -width 12 -state disabled \
-textvariable Apol_FSContexts::vals(fsuse:fs) -autopost 1]
trace add variable Apol_FSContexts::vals(fsuse:fs_enable) write \
[list Apol_FSContexts::_toggleCheckbutton $widgets(fsuse:fs)]
pack $fs_cb -side top -anchor w
pack $widgets(fsuse:fs) -side top -expand 0 -fill x -padx 4
frame $p_f.c
set widgets(fsuse:context) [Apol_Widget::makeContextSelector $p_f.c.context "Contexts"]
pack $widgets(fsuse:context)
pack $t $fs $p_f.c -side left -anchor n -padx 4 -pady 2
}
proc Apol_FSContexts::_fsuse_open {} {
variable vals
set q [new_apol_fs_use_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set fs_uses [lsort -unique [fs_use_vector_to_list $v]]
$v -acquire
$v -delete
set vals(fsuse:items) {}
set behavs {}
foreach f $fs_uses {
lappend vals(fsuse:items) [$f get_name $::ApolTop::qpolicy]
lappend behavs [apol_fs_use_behavior_to_str [$f get_behavior $::ApolTop::qpolicy]]
}
variable widgets
set vals(fsuse:items) [lsort -unique $vals(fsuse:items)]
$widgets(fsuse:type) configure -values [lsort -unique $behavs]
$widgets(fsuse:fs) configure -values $vals(fsuse:items)
}
proc Apol_FSContexts::_fsuse_show {} {
variable vals
variable widgets
$widgets(items_tf) configure -text "fs_use Contexts"
$widgets(options_pm) raise fsuse
set vals(items) $vals(fsuse:items)
}
proc Apol_FSContexts::_fsuse_popup {fs} {
set qpol_fs_use_datum [new_qpol_fs_use_t $::ApolTop::qpolicy $fs]
set text "fs_use $fs\n [_fsuse_render $qpol_fs_use_datum]"
Apol_Widget::showPopupText $fs $text
}
proc Apol_FSContexts::_fsuse_runSearch {} {
variable vals
variable widgets
if {$vals(fsuse:type_enable)} {
if {$vals(fsuse:type) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No fs_use statement type selected."
return
}
set behavior [apol_str_to_fs_use_behavior $vals(fsuse:type)]
if {$behavior < 0} {
tk_messageBox -icon error -type ok -title "Error" -message "$vals(fsuse:type) is not a valid fs_use statement type."
return
}
} else {
set behavior -1
}
if {$vals(fsuse:fs_enable)} {
if {$vals(fsuse:fs) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No filesystem selected."
return
}
set fstype $vals(fsuse:fs)
} else {
set fstype {}
}
set q [new_apol_fs_use_query_t]
if {[Apol_Widget::getContextSelectorState $widgets(fsuse:context)]} {
foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(fsuse:context)] {break}
$q set_context $::ApolTop::policy $context $range_match
}
$q set_filesystem $::ApolTop::policy $fstype
$q set_behavior $::ApolTop::policy $behavior
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set fsuses [fs_use_vector_to_list $v]
$v -acquire
$v -delete
set results "FS_USES:"
if {[llength $fsuses] == 0} {
append results "\nSearch returned no results."
} else {
foreach u [lsort -command _fsuse_sort $fsuses] {
append results "\n[_fsuse_render $u]"
}
}
Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_FSContexts::_fsuse_render {qpol_fs_use_datum} {
apol_fs_use_render $::ApolTop::policy $qpol_fs_use_datum
}
proc Apol_FSContexts::_fsuse_sort {a b} {
set behav_a [apol_fs_use_behavior_to_str [$a get_behavior $::ApolTop::qpolicy]]
set behav_b [apol_fs_use_behavior_to_str [$b get_behavior $::ApolTop::qpolicy]]
if {[set z [string compare $behav_a $behav_b]] != 0} {
return $z
}
set name_a [$a get_name $::ApolTop::qpolicy]
set name_b [$b get_name $::ApolTop::qpolicy]
if {[set z [string compare $name_a $name_b]] != 0} {
return $z
}
return 0
}
namespace eval Apol_Goto {
variable dialog .apol_goto_dialog
variable line_num
}
proc Apol_Goto::goto {} {
variable dialog
if {![winfo exists $dialog]} {
_create_dialog
} else {
raise $dialog
variable entry
focus $entry
$entry selection range 0 end
}
}
proc Apol_Goto::_create_dialog {} {
variable dialog
Dialog $dialog -title "Goto Line" -separator 0 -parent . \
-default 0 -cancel 1 -modal none -homogeneous 1
set top_frame [$dialog getframe]
set entry_label [label $top_frame.l -text "Goto Line:" -anchor e]
variable entry [entry $top_frame.e -bg white \
-textvariable Apol_Goto::line_num -width 10]
pack $entry_label -side left -padx 5 -pady 5
pack $entry -side left -padx 5 -pady 5 -expand 1 -fill x
$dialog add -text "OK" -command [list Apol_Goto::_do_goto]
$dialog add -text "Cancel" -command [list destroy $dialog]
$entry selection range 0 end
focus $entry
$dialog draw
wm resizable $dialog 0 0
}
proc Apol_Goto::_do_goto {} {
set w [ApolTop::getCurrentTextWidget]
if {$w == {}} {
return
}
variable line_num
if {[string is integer -strict $line_num] != 1} {
tk_messageBox -icon error \
-type ok \
-title "Goto Line" \
-message "$line_num is not a valid line number."
} else {
$w tag remove sel 0.0 end
$w mark set insert ${line_num}.0
$w see ${line_num}.0
$w tag add sel $line_num.0 $line_num.end
focus $w
}
variable dialog
destroy $dialog
}
namespace eval Apol_Initial_SIDS {
variable widgets
variable vals
}
proc Apol_Initial_SIDS::create {tab_name nb} {
variable widgets
variable vals
array set vals {
items {}
}
set frame [$nb insert end $tab_name -text "Initial SIDs"]
set pw [PanedWindow $frame.pw -side top -weights extra]
set leftf [$pw add -weight 0]
set rightf [$pw add -weight 1]
pack $pw -fill both -expand yes
set sids_box [TitleFrame $leftf.sids_box -text "Initial SIDs"]
set s_optionsbox [TitleFrame $rightf.obox -text "Search Options"]
set rslts_frame [TitleFrame $rightf.rbox -text "Search Results"]
pack $sids_box -expand 1 -fill both
pack $s_optionsbox -side top -expand 0 -fill both -padx 2
pack $rslts_frame -side top -expand yes -fill both -padx 2
set widgets(items) [Apol_Widget::makeScrolledListbox [$sids_box getframe].lb -width 20 -listvar Apol_Initial_SIDS::vals(items)]
Apol_Widget::setListboxCallbacks $widgets(items) \
{{"Display Initial SID Context" {Apol_Initial_SIDS::_popupSIDInfo}}}
pack $widgets(items) -expand 1 -fill both
set f [frame [$s_optionsbox getframe].c]
set widgets(context) [Apol_Widget::makeContextSelector $f.context "Context"]
pack $widgets(context)
pack $f -side left -anchor n -padx 4 -pady 2
set ok [button [$s_optionsbox getframe].ok -text "OK" -width 6 \
-command Apol_Initial_SIDS::_search]
pack $ok -side right -pady 5 -padx 5 -anchor ne
set widgets(results) [Apol_Widget::makeSearchResults [$rslts_frame getframe].results]
pack $widgets(results) -side top -expand yes -fill both
return $frame
}
proc Apol_Initial_SIDS::open {ppath} {
variable vals
set q [new_apol_isid_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set vals(items) [lsort [isid_vector_to_list $v]]
$v -acquire
$v -delete
}
proc Apol_Initial_SIDS::close {} {
variable vals
variable widgets
set vals(items) {}
Apol_Widget::clearSearchResults $widgets(results)
Apol_Widget::clearContextSelector $widgets(context)
}
proc Apol_Initial_SIDS::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_Initial_SIDS::_popupSIDInfo {sid} {
set text "$sid:\n [_render_isid $sid 1]"
Apol_Widget::showPopupText "$sid Context" $text
}
proc Apol_Initial_SIDS::_search {} {
variable vals
variable widgets
set name {}
set context {}
set range_match 0
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
return
}
set q [new_apol_isid_query_t]
if {[Apol_Widget::getContextSelectorState $widgets(context)]} {
foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(context)] {break}
$q set_context $::ApolTop::policy $context $range_match
}
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set isids [isid_vector_to_list $v]
$v -acquire
$v -delete
set results "INITIAL SIDS:"
if {[llength $isids] == 0} {
append results "\nSearch returned no results."
} else {
foreach i [lsort -dictionary $isids] {
append results "\n[_render_isid $i]"
}
}
Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_Initial_SIDS::_render_isid {isid_name {compact 0}} {
set qpol_isid_datum [new_qpol_isid_t $::ApolTop::qpolicy $isid_name]
set qpol_context [$qpol_isid_datum get_context $::ApolTop::qpolicy]
set context_str [apol_qpol_context_render $::ApolTop::policy $qpol_context]
if {$compact} {
format "sid %s %s" $isid_name $context_str
} else {
format "sid %-16s %s" $isid_name $context_str
}
}
namespace eval Apol_Level_Dialog {
variable dialog ""
variable vars
}
proc Apol_Level_Dialog::getLevel {{defaultLevel {}} {parent .}} {
variable dialog
if {![winfo exists $dialog]} {
_create_dialog $parent
}
set f [$dialog getframe]
Apol_Widget::resetLevelSelectorToPolicy $f.level
if {$defaultLevel != {}} {
Apol_Widget::setLevelSelectorLevel $f.level $defaultLevel
}
$dialog.bbox _redraw
set retval [$dialog draw]
if {$retval == -1 || $retval == 1} {
return {}
}
_get_level $dialog
}
proc Apol_Level_Dialog::_create_dialog {parent} {
variable dialog
variable vars
set dialog [Dialog .level_dialog -modal local -parent $parent \
-separator 1 -homogeneous 1 -title "Select Level"]
array unset vars $dialog:*
set f [$dialog getframe]
set label [label $f.ll -text "Level:"]
set level [Apol_Widget::makeLevelSelector $f.level 12]
pack $label -anchor w
pack $level -expand 1 -fill both
$dialog add -text "OK" -command [list Apol_Level_Dialog::_okay $dialog]
$dialog add -text "Cancel"
}
proc Apol_Level_Dialog::_get_level {dialog} {
return [Apol_Widget::getLevelSelectorLevel [$dialog getframe].level]
}
proc Apol_Level_Dialog::_okay {dialog} {
set level [_get_level $dialog]
if {![ApolTop::is_policy_open] || [$level validate $::ApolTop::policy] != 1} {
tk_messageBox -icon error -type ok -title "Invalid Level" \
-message "The selected level is not valid for the current policy."
} else {
$dialog enddialog 0
}
$level -acquire
$level -delete
}
namespace eval Apol_MLS {
variable widgets
variable vals
}
proc Apol_MLS::create {tab_name nb} {
variable widgets
variable vals
_initializeVars
set frame [$nb insert end $tab_name -text "MLS"]
set pw [PanedWindow $frame.pw -side top -weights extra]
set leftf [$pw add -weight 0]
set rightf [$pw add -weight 1]
pack $pw -fill both -expand yes
set sensbox [TitleFrame $leftf.sensbox -text "Sensitivities"]
set catsbox [TitleFrame $leftf.catsbox -text "Categories"]
pack $sensbox -fill both -expand 0
pack $catsbox -fill both -expand yes
set sensbox [Apol_Widget::makeScrolledListbox [$sensbox getframe].sens \
-height 10 -width 20 -listvar Apol_MLS::vals(senslist)]
Apol_Widget::setListboxCallbacks $sensbox \
{{"Show Sensitivity Info" {Apol_MLS::_popupSensInfo}}}
pack $sensbox -expand 1 -fill both
set catsbox [Apol_Widget::makeScrolledListbox [$catsbox getframe].cats \
-height 16 -width 20 -listvar Apol_MLS::vals(catslist)]
Apol_Widget::setListboxCallbacks $catsbox \
{{"Show Category Info" {Apol_MLS::_popupCatsInfo}}}
pack $catsbox -expand 1 -fill both
set optsbox [TitleFrame $rightf.optsbox -text "Search Options"]
pack $optsbox -side top -expand 0 -fill both -padx 2
set sensf [frame [$optsbox getframe].sensf]
set catsf [frame [$optsbox getframe].catsf]
pack $sensf $catsf -side left -padx 4 -pady 2 -anchor nw
set enable_sens [checkbutton $sensf.enable -text "Sensitivities" \
-variable Apol_MLS::vals(enable_sens)]
set show_cats [checkbutton $sensf.cats -text "Show levels (categories)" \
-variable Apol_MLS::vals(show_cats_too)]
trace add variable Apol_MLS::vals(enable_sens) write \
[list Apol_MLS::_toggleCheckbutton $show_cats]
pack $enable_sens -side top -anchor nw
pack $show_cats -side top -anchor nw -padx 8
set enable_cats [checkbutton $catsf.enable -text "Categories" \
-variable Apol_MLS::vals(enable_cats)]
set show_sens [checkbutton $catsf.cats -text "Show sensitivities" \
-variable Apol_MLS::vals(show_sens_too) -state disabled]
trace add variable Apol_MLS::vals(enable_cats) write \
[list Apol_MLS::_toggleCheckbutton $show_sens]
pack $enable_cats -side top -anchor nw
pack $show_sens -side top -anchor nw -padx 8
set widgets(regexp) [Apol_Widget::makeRegexpEntry [$optsbox getframe].regexpf]
pack $widgets(regexp) -side left -padx 4 -pady 2 -anchor nw
set ok [button [$optsbox getframe].ok -text "OK" -width 6 \
-command Apol_MLS::_search]
pack $ok -side right -pady 5 -padx 5 -anchor ne
set resultsbox [TitleFrame $rightf.resultsbox -text "Search Results"]
pack $resultsbox -expand yes -fill both -padx 2
set widgets(results) [Apol_Widget::makeSearchResults [$resultsbox getframe].results]
pack $widgets(results) -side top -expand yes -fill both
return $frame
}
proc Apol_MLS::open {ppath} {
variable vals
set q [new_apol_level_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set vals(senslist) [lsort [level_vector_to_list $v]]
$v -acquire
$v -delete
set q [new_apol_cat_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set vals(catslist) [lsort [cat_vector_to_list $v]]
$v -acquire
$v -delete
}
proc Apol_MLS::close {} {
variable widgets
_initializeVars
Apol_Widget::clearSearchResults $widgets(results)
}
proc Apol_MLS::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_MLS::isSensInPolicy {sens} {
variable vals
if {![ApolTop::is_policy_open]} {
return {}
}
if {[lsearch $vals(senslist) $sens] >= 0} {
return $sens
}
foreach s $vals(senslist) {
set qpol_level_t [new_qpol_level_t $::ApolTop::qpolicy $s]
set i [$qpol_level_t get_alias_iter $::ApolTop::qpolicy]
set l [iter_to_str_list $i]
$i -acquire
$i -delete
if {[lsearch $l $sens] >= 0} {
return $s
}
}
return {}
}
proc Apol_MLS::_initializeVars {} {
variable vals
array set vals {
senslist {} catslist {}
enable_sens 1 show_cats_too 1
enable_cats 0 show_sens_too 1
}
}
proc Apol_MLS::_toggleCheckbutton {path name1 name2 op} {
variable vals
variable widgets
if {$vals($name2)} {
$path configure -state normal
} else {
$path configure -state disabled
}
if {$vals(enable_sens) == 0 && $vals(enable_cats) == 0} {
Apol_Widget::setRegexpEntryState $widgets(regexp) 0
} else {
Apol_Widget::setRegexpEntryState $widgets(regexp) 1
}
}
proc Apol_MLS::_popupSensInfo {sens} {
Apol_Widget::showPopupText $sens [_renderLevel $sens 1]
}
proc Apol_MLS::_popupCatsInfo {cats} {
Apol_Widget::showPopupText $cats [_renderCats $cats 1]
}
proc Apol_MLS::_renderLevel {level_name show_level} {
set qpol_level_datum [new_qpol_level_t $::ApolTop::qpolicy $level_name]
set i [$qpol_level_datum get_alias_iter $::ApolTop::qpolicy]
set aliases [iter_to_str_list $i]
$i -acquire
$i -delete
set text $level_name
if {[llength $aliases] > 0} {
append text " alias \{$aliases\}"
}
if {$show_level} {
set i [$qpol_level_datum get_cat_iter $::ApolTop::qpolicy]
set num_cats [$i get_size]
$i -acquire
$i -delete
append text " ($num_cats categor"
if {$num_cats == 1} {
append text "y)"
} else {
append text "ies)"
}
set level [new_apol_mls_level_t $::ApolTop::policy $qpol_level_datum]
append text "\n level [$level render $::ApolTop::policy]\n"
$level -acquire
$level -delete
}
return $text
}
proc Apol_MLS::_renderCats {cat_name show_sens} {
set qpol_cat_datum [new_qpol_cat_t $::ApolTop::qpolicy $cat_name]
set i [$qpol_cat_datum get_alias_iter $::ApolTop::qpolicy]
set aliases [iter_to_str_list $i]
$i -acquire
$i -delete
set text $cat_name
if {[llength $aliases] > 0} {
append text " alias \{$aliases\}"
}
if {$show_sens} {
append text "\n"
set q [new_apol_level_query_t]
$q set_cat $::ApolTop::policy $cat_name
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set sens_list {}
for {set i 0} {$i < [$v get_size]} {incr i} {
set qpol_level_datum [qpol_level_from_void [$v get_element $i]]
set level_name [$qpol_level_datum get_name $::ApolTop::qpolicy]
set level_value [$qpol_level_datum get_value $::ApolTop::qpolicy]
lappend sens_list [list $level_name $level_value]
}
$v -acquire
$v -delete
foreach s [lsort -integer -index 1 $sens_list] {
append text " [lindex $s 0]\n"
}
}
return $text
}
proc Apol_MLS::_search {} {
variable vals
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
return
}
if {$vals(enable_sens) == 0 && $vals(enable_cats) == 0} {
tk_messageBox -icon error -type ok -title "Error" -message "No search options provided."
return
}
set results ""
set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
if {$use_regexp} {
set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
if {$regexp == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No regular expression provided."
return
}
} else {
set regexp {}
}
if {$vals(enable_sens)} {
set q [new_apol_level_query_t]
$q set_sens $::ApolTop::policy $regexp
$q set_regex $::ApolTop::policy $use_regexp
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set level_data {}
for {set i 0} {$i < [$v get_size]} {incr i} {
set qpol_level_datum [qpol_level_from_void [$v get_element $i]]
set level_name [$qpol_level_datum get_name $::ApolTop::qpolicy]
set level_value [$qpol_level_datum get_value $::ApolTop::qpolicy]
lappend level_data [list $level_name $level_value]
}
$v -acquire
$v -delete
append results "SENSITIVITIES (ordered by dominance from low to high):"
if {[llength $level_data] == 0} {
append results "\nSearch returned no results."
} else {
foreach l [lsort -integer -index 1 $level_data] {
append results "\n[_renderLevel [lindex $l 0] $vals(show_cats_too)]"
}
}
}
if {$vals(enable_cats)} {
if {$vals(enable_sens)} {
append results "\n\n"
}
set q [new_apol_cat_query_t]
$q set_cat $::ApolTop::policy $regexp
$q set_regex $::ApolTop::policy $use_regexp
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set cats_data {}
for {set i 0} {$i < [$v get_size]} {incr i} {
set qpol_cat_datum [qpol_cat_from_void [$v get_element $i]]
set cat_name [$qpol_cat_datum get_name $::ApolTop::qpolicy]
set cat_value [$qpol_cat_datum get_value $::ApolTop::qpolicy]
lappend cats_data [list $cat_name $cat_value]
}
$v -acquire
$v -delete
append results "CATEGORIES (ordered by appearance within policy):"
if {[llength $cats_data] == 0} {
append results "\nSearch returned no results."
} else {
foreach c [lsort -integer -index 1 $cats_data] {
append results "\n[_renderCats [lindex $c 0] $vals(show_sens_too)]"
}
}
}
Apol_Widget::appendSearchResultText $widgets(results) $results
}
namespace eval Apol_Namespaces {
variable widgets
variable namespace_list {}
}
proc Apol_Namespaces::create {tab_name nb} {
variable widgets
variable namespace_list {}
set frame [$nb insert end $tab_name -text "Policy Namespaces"]
set pw [PanedWindow $frame.pw -side top]
set leftf [$pw add -weight 0]
set rightf [$pw add -weight 1]
pack $pw -fill both -expand yes
set namespaces_box [TitleFrame $leftf.namespaces_box -text "Policy Namespaces"]
pack $namespaces_box -fill both -expand yes
set nlistbox [Apol_Widget::makeScrolledListbox [$namespaces_box getframe].lb \
-width 60 -listvar Apol_Namespaces::namespace_list]
Apol_Widget::setListboxCallbacks $nlistbox \
{{"Show Namespace Users, Roles, Types, Attributes and Classes Info" {Apol_Namespaces::popupNsInfo nfi}}}
pack $nlistbox -expand 1 -fill both
pack $nlistbox -fill both -expand yes
return $frame
}
proc Apol_Namespaces::open {ppath} {
variable namespace_list {}
append list1 "$Apol_Users::users_list $Apol_Roles::role_list $Apol_Types::typelist $Apol_Types::attriblist $Apol_Class_Perms::class_list"
set names [split $list1 " "]
set list1 {}
foreach n $names {
set ns [split $n "."]
set ns [lreplace $ns end end]
set l [string length $ns]
if {$l > 0} {
regsub -all " " $ns "." ns
lappend list1 "$ns"
}
}
set list2 {}
set namespace_list "GLOBAL-NS\n"
lappend list2 [lsort -dictionary -unique $list1]
foreach entry $list2 {
append namespace_list "$entry\n"
}
}
proc Apol_Namespaces::close {} {
variable namespace_list {}
set namespace_list {}
}
proc Apol_Namespaces::getTextWidget {} {
variable widgets
}
proc Apol_Namespaces::popupNsInfo {which ns} {
set w .ns_infobox
destroy $w
set w [Dialog .ns_infobox -cancel 0 -default 0 -modal none -parent . -separator 1 -title $ns]
$w add -text "Close" -command [list destroy $w]
set notebook [NoteBook [$w getframe].nb]
pack $notebook -expand 1 -fill both
set user_info_tab [$notebook insert end user_info_tab -text "Users"]
set role_info_tab [$notebook insert end role_info_tab -text "Roles"]
set type_info_tab [$notebook insert end type_info_tab -text "Types"]
set attrib_info_tab [$notebook insert end attrib_info_tab -text "Attributes"]
set class_info_tab [$notebook insert end class_info_tab -text "Classes"]
set boolean_info_tab [$notebook insert end boolean_info_tab -text "Booleans"]
if {[ApolTop::is_capable "mls"]} {
set sensitivity_info_tab [$notebook insert end sensitivity_info_tab -text "Sensitivities"]
set category_info_tab [$notebook insert end category_info_tab -text "Categories"]
}
set sw [ScrolledWindow [$notebook getframe user_info_tab].sw -scrollbar both -auto both]
set user_text [text [$sw getframe].text -wrap none -font {helvetica 10} -bg white]
$sw setwidget $user_text
pack $sw -expand 1 -fill both
Apol_Namespaces::DisplayMatches $Apol_Users::users_list $user_text $ns "users"
set sw [ScrolledWindow [$notebook getframe role_info_tab].sw -scrollbar both -auto both]
set role_text [text [$sw getframe].text -wrap none -font {helvetica 10} -bg white]
$sw setwidget $role_text
pack $sw -expand 1 -fill both
Apol_Namespaces::DisplayMatches $Apol_Roles::role_list $role_text $ns "roles"
set sw [ScrolledWindow [$notebook getframe type_info_tab].sw -scrollbar both -auto both]
set type_text [text [$sw getframe].text -wrap none -font {helvetica 10} -bg white]
$sw setwidget $type_text
pack $sw -expand 1 -fill both
Apol_Namespaces::DisplayMatches $Apol_Types::typelist $type_text $ns "types"
set sw [ScrolledWindow [$notebook getframe attrib_info_tab].sw -scrollbar both -auto both]
set attrib_text [text [$sw getframe].text -wrap none -font {helvetica 10} -bg white]
$sw setwidget $attrib_text
pack $sw -expand 1 -fill both
Apol_Namespaces::DisplayMatches $Apol_Types::attriblist $attrib_text $ns "attributes"
set sw [ScrolledWindow [$notebook getframe class_info_tab].sw -scrollbar both -auto both]
set class_text [text [$sw getframe].text -wrap none -font {helvetica 10} -bg white]
$sw setwidget $class_text
pack $sw -expand 1 -fill both
Apol_Namespaces::DisplayMatches $Apol_Class_Perms::class_list $class_text $ns "classes"
set sw [ScrolledWindow [$notebook getframe boolean_info_tab].sw -scrollbar both -auto both]
set boolean_text [text [$sw getframe].text -wrap none -font {helvetica 10} -bg white]
$sw setwidget $boolean_text
pack $sw -expand 1 -fill both
Apol_Namespaces::DisplayMatches $Apol_Cond_Bools::cond_bools_list $boolean_text $ns "booleans"
if {[ApolTop::is_capable "mls"]} {
set sw [ScrolledWindow [$notebook getframe sensitivity_info_tab].sw -scrollbar both -auto both]
set sensitivity_text [text [$sw getframe].text -wrap none -font {helvetica 10} -bg white]
$sw setwidget $sensitivity_text
pack $sw -expand 1 -fill both
Apol_Namespaces::DisplayMatches $Apol_MLS::vals(senslist) $sensitivity_text $ns "sensitivities"
set sw [ScrolledWindow [$notebook getframe category_info_tab].sw -scrollbar both -auto both]
set category_text [text [$sw getframe].text -wrap none -font {helvetica 10} -bg white]
$sw setwidget $category_text
pack $sw -expand 1 -fill both
Apol_Namespaces::DisplayMatches $Apol_MLS::vals(catslist) $category_text $ns "categories"
}
$notebook raise [$notebook page 0]
$w draw {} 0 600x400
}
proc Apol_Namespaces::DisplayMatches {item_list display_entry ns text} {
set counter 0
set print_list {}
if {$ns == "GLOBAL-NS"} {
set ns {}
set off_set 0
} else {
set off_set 1
}
set l [string length $ns]
foreach t $item_list {
set i [string compare -length $l $t $ns]
set z [string range $t 0 $l-1]
if {![regexp -nocase {[.]} $t] && $z == $ns && $ns != ""} {
set i 1
}
if {$i == 0} {
set x [string range $t $l+$off_set end]
if {![regexp -nocase {[.]} $x]} {
append print_list " $x\n"
set counter [expr $counter + 1]
}
}
}
if {$counter == 0} {
$display_entry insert end "No entries\n"
} else {
if {$ns == ""} {
set ns "global"
}
$display_entry insert end "$ns namespace ($counter $text)\n$print_list"
}
$display_entry configure -state disabled
}
namespace eval Apol_NetContexts {
variable widgets
variable vals
}
proc Apol_NetContexts::create {tab_name nb} {
variable widgets
variable vals
_initializeVars
set frame [$nb insert end $tab_name -text "Net Contexts"]
set pw [PanedWindow $frame.pw -side top -weights extra]
set leftf [$pw add -weight 0]
set rightf [$pw add -weight 1]
pack $pw -fill both -expand yes
set context_box [TitleFrame $leftf.context_f -text "Context Type"]
set context_f [$context_box getframe]
radiobutton $context_f.portcon -text "portcon" -value portcon \
-variable Apol_NetContexts::vals(context_type)
radiobutton $context_f.netifcon -text "netifcon" -value netifcon \
-variable Apol_NetContexts::vals(context_type)
radiobutton $context_f.nodecon -text "nodecon" -value nodecon \
-variable Apol_NetContexts::vals(context_type)
trace add variable Apol_NetContexts::vals(context_type) write \
{Apol_NetContexts::_contextTypeChanged}
pack $context_f.portcon $context_f.netifcon $context_f.nodecon \
-anchor w -expand 0 -padx 4 -pady 5
pack $context_box -anchor nw -expand 0 -fill x
set widgets(items_tf) [TitleFrame $leftf.items_f -text "Port Contexts"]
set widgets(items) [Apol_Widget::makeScrolledListbox [$widgets(items_tf) getframe].items \
-height 20 -width 20 -listvar Apol_NetContexts::vals(items)]
Apol_Widget::setListboxCallbacks $widgets(items) \
{{"Show Context Info" {Apol_NetContexts::_popupContextInfo}}}
pack $widgets(items) -expand 1 -fill both
pack $widgets(items_tf) -expand 1 -fill both
set optsbox [TitleFrame $rightf.optsbox -text "Search Options"]
pack $optsbox -side top -expand 0 -fill both -padx 2
set widgets(options_pm) [PagesManager [$optsbox getframe].pm]
_portcon_create [$widgets(options_pm) add portcon]
_netifcon_create [$widgets(options_pm) add netifcon]
_nodecon_create [$widgets(options_pm) add nodecon]
$widgets(options_pm) compute_size
pack $widgets(options_pm) -expand 1 -fill both -side left
$widgets(options_pm) raise portcon
set ok [button [$optsbox getframe].ok -text "OK" -width 6 \
-command Apol_NetContexts::_runSearch]
pack $ok -side right -pady 5 -padx 5 -anchor ne
set resultsbox [TitleFrame $rightf.resultsbox -text "Search Results"]
pack $resultsbox -expand yes -fill both -padx 2
set widgets(results) [Apol_Widget::makeSearchResults [$resultsbox getframe].results]
pack $widgets(results) -side top -expand yes -fill both
return $frame
}
proc Apol_NetContexts::open {ppath} {
variable vals
_portcon_open
_netifcon_open
_nodecon_open
set vals(context_type) portcon
}
proc Apol_NetContexts::close {} {
variable widgets
_initializeVars
Apol_Widget::clearSearchResults $widgets(results)
Apol_Widget::clearContextSelector $widgets(portcon:context)
Apol_Widget::clearContextSelector $widgets(netifcon:ifcon)
Apol_Widget::clearContextSelector $widgets(netifcon:msgcon)
Apol_Widget::clearContextSelector $widgets(nodecon:context)
$widgets(portcon:proto) configure -values {}
$widgets(netifcon:dev) configure -values {}
}
proc Apol_NetContexts::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_NetContexts::_initializeVars {} {
variable vals
array set vals {
portcon:items {}
portcon:proto_enable 0 portcon:proto {}
portcon:port_enable 0 portcon:port 0
portcon:hiport_enable 0 portcon:hiport 0
netifcon:items {}
netifcon:dev_enable 0 netifcon:dev {}
nodecon:items {}
nodecon:ip_type ipv4
nodecon:ipv4_addr_enable 0
nodecon:ipv4_addr0 0 nodecon:ipv4_addr1 0
nodecon:ipv4_addr2 0 nodecon:ipv4_addr3 0
nodecon:ipv4_mask_enable 0
nodecon:ipv4_mask0 255 nodecon:ipv4_mask1 255
nodecon:ipv4_mask2 255 nodecon:ipv4_mask3 255
nodecon:ipv6_addr_enable 0 nodecon:ipv6_addr ::
nodecon:ipv6_mask_enable 0 nodecon:ipv6_mask ::
items {}
context_type portcon
}
}
proc Apol_NetContexts::_contextTypeChanged {name1 name2 op} {
variable vals
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
if {$vals(context_type) == "portcon"} {
_portcon_show
} elseif {$vals(context_type) == "netifcon"} {
_netifcon_show
} else {
_nodecon_show
}
}
proc Apol_NetContexts::_popupContextInfo {value} {
variable vals
if {$vals(context_type) == "portcon"} {
_portcon_popup $value
} elseif {$vals(context_type) == "netifcon"} {
_netifcon_popup $value
} else {
_nodecon_popup $value
}
}
proc Apol_NetContexts::_toggleCheckbutton {path name1 name2 op} {
variable vals
variable widgets
if {$vals($name2)} {
$path configure -state normal
} else {
$path configure -state disabled
}
}
proc Apol_NetContexts::_runSearch {} {
variable vals
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
return
}
if {$vals(context_type) == "portcon"} {
_portcon_runSearch
} elseif {$vals(context_type) == "netifcon"} {
_netifcon_runSearch
} else {
_nodecon_runSearch
}
}
proc Apol_NetContexts::_portcon_create {p_f} {
variable widgets
variable vals
frame $p_f.proto
set proto_cb [checkbutton $p_f.proto.proto_enable -text "Protocol" \
-variable Apol_NetContexts::vals(portcon:proto_enable)]
set widgets(portcon:proto) [ComboBox $p_f.proto.proto -entrybg white -width 8 -state disabled \
-textvariable Apol_NetContexts::vals(portcon:proto) -autopost 1]
trace add variable Apol_NetContexts::vals(portcon:proto_enable) write \
[list Apol_NetContexts::_toggleCheckbutton $widgets(portcon:proto)]
pack $proto_cb -side top -anchor w
pack $widgets(portcon:proto) -side top -expand 0 -fill x -padx 4
frame $p_f.port
set low [frame $p_f.port.l]
set port_cb [checkbutton $low.port_enable -text "Single Port" \
-variable Apol_NetContexts::vals(portcon:port_enable)]
set widgets(portcon:port) [spinbox $low.port -bg white -width 8 \
-justify right -state disabled \
-from 0 -to 65535 \
-validate all -vcmd [list Apol_NetContexts::_portcon_limitPort %W %V %P port] \
-textvariable Apol_NetContexts::vals(portcon:port)]
set high [frame $p_f.port.h]
set hiport_cb [checkbutton $high.hiport_enable -text "High Port" \
-state disabled \
-variable Apol_NetContexts::vals(portcon:hiport_enable)]
set widgets(portcon:hiport) [spinbox $high.hiport -bg white -width 8 \
-justify right -state disabled \
-from 0 -to 65535 \
-validate all -vcmd [list Apol_NetContexts::_portcon_limitPort %W %V %P hiport] \
-textvariable Apol_NetContexts::vals(portcon:hiport)]
trace add variable Apol_NetContexts::vals(portcon:port_enable) write \
[list Apol_NetContexts::_portcon_toggleCheckbutton_lowport \
$widgets(portcon:port) $hiport_cb $widgets(portcon:hiport)]
trace add variable Apol_NetContexts::vals(portcon:hiport_enable) write \
[list Apol_NetContexts::_portcon_toggleCheckbutton_hiport $port_cb $widgets(portcon:hiport)]
pack $port_cb -side top -anchor w -expand 0
pack $widgets(portcon:port) -side top -expand 0 -fill x -padx 4
pack $hiport_cb -side top -anchor w -expand 0
pack $widgets(portcon:hiport) -side top -expand 0 -fill x -padx 4
pack $low $high -side left -expand 0 -fill both
frame $p_f.c
set widgets(portcon:context) [Apol_Widget::makeContextSelector $p_f.c.context "Contexts"]
pack $widgets(portcon:context)
pack $p_f.proto $p_f.port $p_f.c -side left -padx 4 -pady 2 -anchor nw
}
proc Apol_NetContexts::_portcon_open {} {
variable vals
set q [new_apol_portcon_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set portcons [portcon_vector_to_list $v]
$v -acquire
$v -delete
set vals(portcon:items) {}
set protos {}
foreach p $portcons {
set low [$p get_low_port $::ApolTop::qpolicy]
set high [$p get_high_port $::ApolTop::qpolicy]
set proto [$p get_protocol $::ApolTop::qpolicy]
if {$low == $high} {
lappend vals(portcon:items) $low
} else {
lappend vals(portcon:items) "$low-$high"
}
lappend protos [apol_protocol_to_str $proto]
}
variable widgets
set vals(portcon:items) [lsort -unique -dictionary $vals(portcon:items)]
$widgets(portcon:proto) configure -values [lsort -unique -dictionary $protos]
}
proc Apol_NetContexts::_portcon_show {} {
variable vals
variable widgets
$widgets(items_tf) configure -text "Port Contexts"
$widgets(options_pm) raise portcon
set vals(items) $vals(portcon:items)
}
proc Apol_NetContexts::_portcon_popup {port} {
foreach {low high} [split $port "-"] {break}
if {$high == {}} {
set high $low
}
set q [new_apol_portcon_query_t]
$q set_low $::ApolTop::policy $low
$q set_high $::ApolTop::policy $high
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set portcons [portcon_vector_to_list $v]
$v -acquire
$v -delete
set text "port $port ([llength $portcons] context"
if {[llength $portcons] != 1} {
append text s
}
append text ")"
foreach p [lsort -command _portcon_sort $portcons] {
append text "\n [_portcon_render $p]"
}
Apol_Widget::showPopupText "port $port" $text
}
proc Apol_NetContexts::_portcon_limitPort {widget command new_port varname} {
variable vals
if {$command == "key"} {
if {$new_port != "" &&
(![string is integer $new_port] || $new_port < 0 || $new_port > 65535)} {
return 0
}
} elseif {$command == "focusout"} {
if {$new_port == ""} {
set vals(portcon:$varname) 0
} elseif {[string length $new_port] > 1} {
set vals(portcon:$varname) [string trimleft $new_port " 0"]
}
$widget config -validate all
}
return 1
}
proc Apol_NetContexts::_portcon_toggleCheckbutton_lowport {low high_cb high name1 name2 op} {
variable vals
variable widgets
if {$vals($name2)} {
$low configure -state normal
$high_cb configure -state normal
if {$vals(portcon:hiport_enable)} {
$high configure -state normal
}
} else {
$low configure -state disabled
$high_cb configure -state disabled
$high configure -state disabled
}
}
proc Apol_NetContexts::_portcon_toggleCheckbutton_hiport {low high name1 name2 op} {
variable vals
variable widgets
if {$vals($name2)} {
$low configure -text "Low Port"
$high configure -state normal
} else {
$low configure -text "Single Port"
$high configure -state disabled
}
}
proc Apol_NetContexts::_portcon_runSearch {} {
variable vals
variable widgets
_portcon_limitPort $widgets(portcon:port) focusout $vals(portcon:port) port
_portcon_limitPort $widgets(portcon:hiport) focusout $vals(portcon:hiport) hiport
if {$vals(portcon:port_enable)} {
set low $vals(portcon:port)
set high $low
if {$vals(portcon:hiport_enable)} {
set high $vals(portcon:hiport)
if {$vals(portcon:port_enable) && $high < $low} {
tk_messageBox -icon error -type ok -title "Error" -message "The second port is not greater than the first."
return
}
}
} else {
set low -1
set high -1
}
set q [new_apol_portcon_query_t]
$q set_low $::ApolTop::policy $low
$q set_high $::ApolTop::policy $high
if {$vals(portcon:proto_enable)} {
if {[set proto $vals(portcon:proto)] == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No protocol selected."
return
}
$q set_protocol $::ApolTop::policy [apol_str_to_protocol $proto]
}
if {[Apol_Widget::getContextSelectorState $widgets(portcon:context)]} {
foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(portcon:context)] {break}
$q set_context $::ApolTop::policy $context $range_match
}
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set portcons [portcon_vector_to_list $v]
$v -acquire
$v -delete
set results "PORTCONS:"
if {[llength $portcons] == 0} {
append results "\nSearch returned no results."
} else {
foreach p [lsort -command _portcon_sort $portcons] {
append results "\n[_portcon_render $p]"
}
}
Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_NetContexts::_portcon_render {qpol_portcon_datum} {
set loport [$qpol_portcon_datum get_low_port $::ApolTop::qpolicy]
set hiport [$qpol_portcon_datum get_high_port $::ApolTop::qpolicy]
set proto [apol_protocol_to_str [$qpol_portcon_datum get_protocol $::ApolTop::qpolicy]]
set qpol_context [$qpol_portcon_datum get_context $::ApolTop::qpolicy]
if {$loport == $hiport} {
set line "portcon $proto $loport "
} else {
set line "portcon $proto ${loport}-${hiport} "
}
concat $line [apol_qpol_context_render $::ApolTop::policy $qpol_context]
}
proc Apol_NetContexts::_portcon_sort {a b} {
set loport1 [$a get_low_port $::ApolTop::qpolicy]
set hiport1 [$a get_high_port $::ApolTop::qpolicy]
set loport2 [$b get_low_port $::ApolTop::qpolicy]
set hiport2 [$b get_high_port $::ApolTop::qpolicy]
if {$loport1 == $hiport1} {
set singleport1 1
} else {
set singleport1 0
}
if {$loport2 == $hiport2} {
set singleport2 1
} else {
set singleport2 0
}
if {$singleport1 && !$singleport2} {
return -1
} elseif {!$singleport1 && $singleport2} {
return 1
}
if {$loport1 < $loport2} {
return -1
} elseif {$loport1 > $loport2} {
return 1
}
if {$hiport1 < $hiport2} {
return -1
} elseif {$hiport1 > $hiport2} {
return 1
}
set proto1 [apol_protocol_to_str [$a get_protocol $::ApolTop::qpolicy]]
set proto2 [apol_protocol_to_str [$b get_protocol $::ApolTop::qpolicy]]
string compare $proto1 $proto2
}
proc Apol_NetContexts::_netifcon_create {p_f} {
variable vals
variable widgets
frame $p_f.dev
set dev_cb [checkbutton $p_f.dev.dev_enable -text "Device" \
-variable Apol_NetContexts::vals(netifcon:dev_enable)]
set widgets(netifcon:dev) [ComboBox $p_f.dev.dev -entrybg white -width 8 -state disabled \
-textvariable Apol_NetContexts::vals(netifcon:dev) -autopost 1]
trace add variable Apol_NetContexts::vals(netifcon:dev_enable) write \
[list Apol_NetContexts::_toggleCheckbutton $widgets(netifcon:dev)]
pack $dev_cb -side top -anchor w
pack $widgets(netifcon:dev) -side top -expand 0 -fill x -padx 4
frame $p_f.ifcon
set widgets(netifcon:ifcon) [Apol_Widget::makeContextSelector $p_f.ifcon.context "Contexts" "Interface context" -width 18]
pack $widgets(netifcon:ifcon)
frame $p_f.msgcon
set widgets(netifcon:msgcon) [Apol_Widget::makeContextSelector $p_f.msgcon.context "Contexts" "Message context" -width 18]
pack $widgets(netifcon:msgcon)
pack $p_f.dev $p_f.ifcon $p_f.msgcon -side left -padx 4 -pady 2 -anchor nw
}
proc Apol_NetContexts::_netifcon_open {} {
variable vals
set q [new_apol_netifcon_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set vals(netifcon:items) [lsort [netifcon_vector_to_list $v]]
$v -acquire
$v -delete
variable widgets
$widgets(netifcon:dev) configure -values $vals(netifcon:items)
}
proc Apol_NetContexts::_netifcon_show {} {
variable vals
variable widgets
$widgets(items_tf) configure -text "NetIF Contexts"
$widgets(options_pm) raise netifcon
set vals(items) $vals(netifcon:items)
}
proc Apol_NetContexts::_netifcon_popup {netif} {
set text "network interface $netif"
append text "\n [_netifcon_render $netif]"
Apol_Widget::showPopupText "interface $netif" $text
}
proc Apol_NetContexts::_netifcon_runSearch {} {
variable vals
variable widgets
if {$vals(netifcon:dev_enable)} {
if {$vals(netifcon:dev) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No device selected."
return
}
set dev $vals(netifcon:dev)
} else {
set dev {}
}
set q [new_apol_netifcon_query_t]
$q set_device $::ApolTop::policy $dev
if {[Apol_Widget::getContextSelectorState $widgets(netifcon:ifcon)]} {
foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(netifcon:ifcon)] {break}
$q set_if_context $::ApolTop::policy $context $range_match
}
if {[Apol_Widget::getContextSelectorState $widgets(netifcon:msgcon)]} {
foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(netifcon:msgcon)] {break}
$q set_msg_context $::ApolTop::policy $context $range_match
}
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set netifcons [netifcon_vector_to_list $v]
$v -acquire
$v -delete
set results "NETIFCONS:"
if {[llength $netifcons] == 0} {
append results "\nSearch returned no results."
} else {
foreach n [lsort $netifcons] {
append results "\n[_netifcon_render $n]"
}
}
Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_NetContexts::_netifcon_render {netifcon} {
set qpol_netifcon_datum [new_qpol_netifcon_t $::ApolTop::qpolicy $netifcon]
apol_netifcon_render $::ApolTop::policy $qpol_netifcon_datum
}
proc Apol_NetContexts::_nodecon_create {p_f} {
variable vals
variable widgets
frame $p_f.ip_type
set ipv4_rb [radiobutton $p_f.ip_type.v4 -text "IPv4" -value ipv4 \
-variable Apol_NetContexts::vals(nodecon:ip_type)]
set ipv6_rb [radiobutton $p_f.ip_type.v6 -text "IPv6" -value ipv6 \
-variable Apol_NetContexts::vals(nodecon:ip_type)]
trace add variable Apol_NetContexts::vals(nodecon:ip_type) write \
[list Apol_NetContexts::_nodecon_pageChanged]
pack $ipv4_rb $ipv6_rb -side top -anchor nw -pady 5
frame $p_f.opts
set widgets(nodecon:ip_pm) [PagesManager $p_f.opts.pm]
_nodecon_ipv4Create [$widgets(nodecon:ip_pm) add ipv4]
_nodecon_ipv6Create [$widgets(nodecon:ip_pm) add ipv6]
$widgets(nodecon:ip_pm) compute_size
pack $widgets(nodecon:ip_pm)
$widgets(nodecon:ip_pm) raise ipv4
frame $p_f.con
set widgets(nodecon:context) [Apol_Widget::makeContextSelector $p_f.con.context "Contexts"]
pack $widgets(nodecon:context)
pack $p_f.ip_type $p_f.opts $p_f.con -side left -padx 4 -pady 2 -anchor nw
}
proc Apol_NetContexts::_nodecon_open {} {
set q [new_apol_nodecon_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set nodecons [nodecon_vector_to_list $v]
variable vals
variable widgets
set vals(nodecon:items) {}
foreach n [lsort -command _nodecon_sort $nodecons] {
set proto [$n get_protocol $::ApolTop::qpolicy]
set addr [$n get_addr $::ApolTop::qpolicy]
if {$proto == $::QPOL_IPV4} {
set addr [apol_ipv4_addr_render $::ApolTop::policy $addr]
} elseif {$proto == $::QPOL_IPV6} {
set addr [apol_ipv6_addr_render $::ApolTop::policy $addr]
} else {
puts stderr "Unknown protocol $proto"
exit -1
}
lappend vals(nodecon:items) $addr
}
set vals(nodecon:items) [lsort -unique -dictionary $vals(nodecon:items)]
$v -acquire
$v -delete
}
proc Apol_NetContexts::_nodecon_show {} {
variable vals
variable widgets
$widgets(items_tf) configure -text "Node Contexts"
$widgets(options_pm) raise nodecon
set vals(items) $vals(nodecon:items)
}
proc Apol_NetContexts::_nodecon_ipv4Create {fv4} {
variable widgets
set v4addrf [frame $fv4.addr]
set ipv4_addr_cb [checkbutton $v4addrf.enable -text "IP address" \
-variable Apol_NetContexts::vals(nodecon:ipv4_addr_enable)]
set widgets(nodecon:v4addrf2) [frame $v4addrf.a]
for {set i 0} {$i < 4} {incr i} {
set e [entry $widgets(nodecon:v4addrf2).e$i -bg white -justify center -width 4 \
-state disabled \
-validate all -vcmd [list Apol_NetContexts::_nodecon_limitAddr %W %V %P ipv4_addr$i] \
-textvariable Apol_NetContexts::vals(nodecon:ipv4_addr$i)]
pack $e -side left -padx 1 -anchor center
if {$i < 3} {
pack [label $widgets(nodecon:v4addrf2).l$i -text "."] -side left -expand 0 -anchor s
}
}
trace add variable Apol_NetContexts::vals(nodecon:ipv4_addr_enable) write \
[list Apol_NetContexts::_nodecon_toggleV4button $widgets(nodecon:v4addrf2).e]
pack $ipv4_addr_cb -anchor w
pack $widgets(nodecon:v4addrf2) -padx 3 -expand 0 -fill x
set v4maskf [frame $fv4.mask]
set ipv4_mask_cb [checkbutton $v4maskf.enable -text "Mask" \
-variable Apol_NetContexts::vals(nodecon:ipv4_mask_enable)]
set widgets(nodecon:v4maskf2) [frame $v4maskf.m]
for {set i 0} {$i < 4} {incr i} {
set e [entry $widgets(nodecon:v4maskf2).e$i -bg white -justify center -width 4 \
-state disabled \
-validate all -vcmd [list Apol_NetContexts::_nodecon_limitAddr %W %V %P ipv4_mask$i] \
-textvariable Apol_NetContexts::vals(nodecon:ipv4_mask$i)]
pack $e -side left -padx 1 -anchor center
if {$i < 3} {
pack [label $widgets(nodecon:v4maskf2).l$i -text "."] -side left -expand 0 -anchor s
}
}
trace add variable Apol_NetContexts::vals(nodecon:ipv4_mask_enable) write \
[list Apol_NetContexts::_nodecon_toggleV4button $widgets(nodecon:v4maskf2).e]
pack $ipv4_mask_cb -anchor w
pack $widgets(nodecon:v4maskf2) -padx 3 -expand 0 -fill x
pack $v4addrf $v4maskf -padx 4 -pady 2 -anchor nw
}
proc Apol_NetContexts::_nodecon_ipv6Create {fv6} {
set v6addrf [frame $fv6.addr]
set ipv4_addr_cb [checkbutton $v6addrf.enable -text "IP address" \
-variable Apol_NetContexts::vals(nodecon:ipv6_addr_enable)]
set e [entry $v6addrf.addr -bg white -width 28 -state disabled \
-textvariable Apol_NetContexts::vals(nodecon:ipv6_addr)]
trace add variable Apol_NetContexts::vals(nodecon:ipv6_addr_enable) write \
[list Apol_NetContexts::_toggleCheckbutton $e]
pack $ipv4_addr_cb -anchor w
pack $e -padx 4 -expand 0 -fill x
set v6maskf [frame $fv6.mask]
set ipv6_mask_cb [checkbutton $v6maskf.enable -text "Mask" \
-variable Apol_NetContexts::vals(nodecon:ipv6_mask_enable)]
set e [entry $v6maskf.addr -bg white -width 28 -state disabled \
-textvariable Apol_NetContexts::vals(nodecon:ipv6_mask)]
trace add variable Apol_NetContexts::vals(nodecon:ipv6_mask_enable) write \
[list Apol_NetContexts::_toggleCheckbutton $e]
pack $ipv6_mask_cb -anchor w
pack $e -padx 4 -expand 0 -fill x
pack $v6addrf $v6maskf -padx 4 -pady 2 -anchor w
}
proc Apol_NetContexts::_nodecon_pageChanged {name1 name2 op} {
variable vals
variable widgets
$widgets(nodecon:ip_pm) raise $vals(nodecon:ip_type)
}
proc Apol_NetContexts::_nodecon_limitAddr {widget command new_addr varname} {
variable vals
if {$command == "key"} {
if {$new_addr != "" &&
(![string is integer $new_addr] || $new_addr < 0 || $new_addr > 255)} {
return 0
}
} elseif {$command == "focusout"} {
if {$new_addr == ""} {
set vals(nodecon:$varname) 0
} elseif {[string length $new_addr] > 1} {
set vals(nodecon:$varname) [string trimleft $new_addr " 0"]
}
after idle [list $widget config -validate all]
}
return 1
}
proc Apol_NetContexts::_nodecon_toggleV4button {path name1 name2 op} {
variable vals
if {$vals($name2)} {
for {set i 0} {$i < 4} {incr i} {
${path}${i} configure -state normal
}
} else {
for {set i 0} {$i < 4} {incr i} {
${path}${i} configure -state disabled
}
}
}
proc Apol_NetContexts::_nodecon_popup {nodecon_addr} {
set q [new_apol_nodecon_query_t]
set ip [apol_str_to_internal_ip $nodecon_addr]
$q set_addr $::ApolTop::policy $ip
$ip -acquire
$ip -delete
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set nodecons [nodecon_vector_to_list $v]
set text "nodecon $nodecon_addr ([llength $nodecons] context"
if {[llength $nodecons] != 1} {
append text s
}
append text ")"
foreach n [lsort -command _nodecon_sort $nodecons] {
append text "\n [_nodecon_render $n]"
}
Apol_Widget::showPopupText "address $nodecon_addr" $text
$v -acquire
$v -delete
}
proc Apol_NetContexts::_nodecon_runSearch {} {
variable vals
variable widgets
set addr {}
set mask {}
if {$vals(nodecon:ip_type) == "ipv4"} {
foreach i {0 1 2 3} {
_nodecon_limitAddr $widgets(nodecon:v4addrf2).e$i focusout $vals(nodecon:ipv4_addr$i) ipv4_addr$i
_nodecon_limitAddr $widgets(nodecon:v4maskf2).e$i focusout $vals(nodecon:ipv4_mask$i) ipv4_mask$i
}
if {$vals(nodecon:ipv4_addr_enable)} {
set addr [format "%d.%d.%d.%d" \
$vals(nodecon:ipv4_addr0) $vals(nodecon:ipv4_addr1) \
$vals(nodecon:ipv4_addr2) $vals(nodecon:ipv4_addr3)]
}
if {$vals(nodecon:ipv4_mask_enable)} {
set mask [format "%d.%d.%d.%d" \
$vals(nodecon:ipv4_mask0) $vals(nodecon:ipv4_mask1) \
$vals(nodecon:ipv4_mask2) $vals(nodecon:ipv4_mask3)]
}
set proto $::QPOL_IPV4
} else {
if {$vals(nodecon:ipv6_addr_enable)} {
if {[set addr $vals(nodecon:ipv6_addr)] == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No IPV6 address provided."
return
}
}
if {$vals(nodecon:ipv6_mask_enable)} {
if {[set mask $vals(nodecon:ipv6_mask)] == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No IPV6 address provided."
return
}
}
set proto $::QPOL_IPV6
}
set q [new_apol_nodecon_query_t]
$q set_protocol $::ApolTop::policy $proto
if {$addr != {}} {
if {[catch {apol_str_to_internal_ip $addr} u]} {
tk_messageBox -icon error -type ok -title "Error" -message $u
return
}
$q set_addr $::ApolTop::policy $u
}
if {$mask != {}} {
if {[catch {apol_str_to_internal_ip $mask} u]} {
tk_messageBox -icon error -type ok -title "Error" -message $u
return
}
$q set_mask $::ApolTop::policy $u
}
if {[Apol_Widget::getContextSelectorState $widgets(nodecon:context)]} {
foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(nodecon:context)] {break}
$q set_context $::ApolTop::policy $context $range_match
}
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set nodecons [nodecon_vector_to_list $v]
set results "NODECONS:"
if {[llength $nodecons] == 0} {
append results "\nSearch returned no results."
} else {
foreach n [lsort -command _nodecon_sort $nodecons] {
append results "\n[_nodecon_render $n]"
}
}
Apol_Widget::appendSearchResultText $widgets(results) $results
$v -acquire
$v -delete
}
proc Apol_NetContexts::_nodecon_render {qpol_nodecon_datum} {
apol_nodecon_render $::ApolTop::policy $qpol_nodecon_datum
}
proc Apol_NetContexts::_nodecon_sort {a b} {
set proto1 [$a get_protocol $::ApolTop::qpolicy]
set proto2 [$b get_protocol $::ApolTop::qpolicy]
if {$proto1 == $::QPOL_IPV4 && $proto2 == $::QPOL_IPV6} {
return -1
} elseif {$proto1 == $::QPOL_IPV6 && $proto1 == $::QPOL_IPV4} {
return 0
}
if {$proto1 == $::QPOL_IPV4} {
set render apol_ipv4_addr_render
} else {
set render apol_ipv6_addr_render
}
set addr1 [$render $::ApolTop::policy [$a get_addr $::ApolTop::qpolicy]]
set addr2 [$render $::ApolTop::policy [$b get_addr $::ApolTop::qpolicy]]
if {[set x [string compare $addr1 $addr2]] != 0} {
return $x
}
set mask1 [$render $::ApolTop::policy [$a get_mask $::ApolTop::qpolicy]]
set mask2 [$render $::ApolTop::policy [$b get_mask $::ApolTop::qpolicy]]
string compare $mask1 $mask2
}
namespace eval Apol_Open_Policy_Dialog {
variable dialog {}
variable widgets
variable vars
}
proc Apol_Open_Policy_Dialog::getPolicyPath {defaultPath} {
variable dialog
variable vars
array unset vars
_create_dialog .
set vars(path_type) "monolithic"
set vars(primary_file) {}
set vars(last_module) {}
set vars(mod_names) {}
set vars(mod_vers) {}
set vars(mod_paths) {}
if {$defaultPath != {}} {
foreach {path_type primary modules} [policy_path_to_list $defaultPath] {break}
set vars(path_type) $path_type
if {[set vars(primary_file) $primary] != {}} {
$dialog itemconfigure 0 -state normal
}
set vars(last_module) $vars(primary_file)
foreach m $modules {
if {[catch {getModuleInfo $m} info]} {
tk_messageBox -icon error -type ok -title "Open Module" -message $info -detail "Module file $m" -parent [$dialog getframe]
} else {
foreach {name vers type} $info {break}
lappend vars(mod_names) $name
lappend vars(mod_vers) $vers
lappend vars(mod_paths) $m
set vars(last_module) $m
}
}
}
$dialog.bbox _redraw
$dialog draw
destroy $dialog
}
proc Apol_Open_Policy_Dialog::_create_dialog {parent} {
variable dialog
variable widgets
variable vars
destroy $dialog
set dialog [Dialog .open_policy_dialog -modal local -parent $parent \
-cancel 1 \
-separator 1 -homogeneous 1 -title "Open Policy"]
set f [$dialog getframe]
set policy_type_f [frame $f.policy_type]
pack $policy_type_f -padx 4 -pady 4 -expand 0 -anchor w
set l [label $policy_type_f.l -text "Policy Type:"]
set mono_cb [radiobutton $policy_type_f.mono -text "Monolithic policy" \
-value monolithic \
-variable Apol_Open_Policy_Dialog::vars(path_type)]
set mod_cb [radiobutton $policy_type_f.mod -text "Modular policy" \
-value modular \
-variable Apol_Open_Policy_Dialog::vars(path_type)]
pack $l -anchor w
pack $mono_cb $mod_cb -anchor w -padx 8
set primary_f [frame $f.primary]
pack $primary_f -padx 4 -pady 8 -expand 0 -fill x
set widgets(main_label) [label $primary_f.l -text "Policy Filename:"]
pack $widgets(main_label) -anchor w
frame $primary_f.f
pack $primary_f.f -expand 1 -fill x
set e [entry $primary_f.f.e -width 32 -bg white \
-textvariable Apol_Open_Policy_Dialog::vars(primary_file) \
-validate key \
-vcmd [list Apol_Open_Policy_Dialog::_validateEntryKey %P]]
bind $e <Key-Return> Apol_Open_Policy_Dialog::tryOpenPolicy
set b [button $primary_f.f.b -text "Browse" \
-command Apol_Open_Policy_Dialog::browsePrimary]
pack $e -side left -expand 1 -fill x -padx 4
pack $b -side right -expand 0 -padx 4
set modules_f [frame $f.modules]
pack $modules_f -pady 4 -padx 4 -expand 1 -fill both
set mod_list_f [frame $modules_f.mods -relief sunken]
pack $mod_list_f -side left -expand 1 -fill both -padx 4
set mlabel [label $mod_list_f.ml -text "Module:"]
set vlabel [label $mod_list_f.vl -text "Version:"]
set plabel [label $mod_list_f.pl -text "Path:"]
grid $mlabel $vlabel $plabel x -sticky w
set dis_bg [$mlabel cget -bg]
set ml [listbox $mod_list_f.mods -height 6 -width 10 \
-listvariable Apol_Open_Policy_Dialog::vars(mod_names)]
set vl [listbox $mod_list_f.vers -height 6 -width 4 \
-listvariable Apol_Open_Policy_Dialog::vars(mod_vers)]
set pl [listbox $mod_list_f.paths -height 6 -width 24 \
-listvariable Apol_Open_Policy_Dialog::vars(mod_paths)]
set sb [scrollbar $mod_list_f.sb -orient vertical \
-command [list Apol_Open_Policy_Dialog::multiscroll yview]]
grid $ml $vl $pl $sb -sticky nsew
set widgets(bb) [ButtonBox $modules_f.bb -homogeneous 1 -orient vertical -pady 2]
$widgets(bb) add -text "Add" -command Apol_Open_Policy_Dialog::browseModule
$widgets(bb) add -text "Remove" -command Apol_Open_Policy_Dialog::removeModule -state disabled
$widgets(bb) add -text "Import" -command Apol_Open_Policy_Dialog::importList
$widgets(bb) add -text "Export" -command Apol_Open_Policy_Dialog::exportList -state disabled
pack $widgets(bb) -side right -expand 0 -anchor n -padx 4 -pady 10
set widgets(listboxes) [list $ml $vl $pl]
set widgets(scrollbar) $sb
foreach lb $widgets(listboxes) {
$lb configure -yscrollcommand Apol_Open_Policy_Dialog::multiyview \
-relief groove -bg white -exportselection 0
bind $lb <<ListboxSelect>> \
[list Apol_Open_Policy_Dialog::multiselect $lb]
}
trace add variable Apol_Open_Policy_Dialog::vars(path_type) write \
[list Apol_Open_Policy_Dialog::togglePathType \
[list $mlabel $vlabel $plabel] $dis_bg]
$dialog add -text "OK" -command Apol_Open_Policy_Dialog::tryOpenPolicy \
-state disabled
$dialog add -text "Cancel"
}
proc Apol_Open_Policy_Dialog::_validateEntryKey {newvalue} {
variable vars
variable dialog
variable widgets
if {$newvalue == {}} {
$dialog itemconfigure 0 -state disabled
$widgets(bb) itemconfigure 3 -state disabled
} else {
$dialog itemconfigure 0 -state normal
if {$vars(path_type) == "modular"} {
$widgets(bb) itemconfigure 3 -state normal
} else {
$widgets(bb) itemconfigure 3 -state disabled
}
}
return 1
}
proc Apol_Open_Policy_Dialog::togglePathType {labels disabled_bg name1 name2 op} {
variable vars
variable widgets
if {$vars(path_type) == "modular"} {
set state normal
set bg white
$widgets(main_label) configure -text "Base Filename:"
} else {
set state disabled
set bg $disabled_bg
$widgets(main_label) configure -text "Policy Filename:"
}
foreach w $labels {
$w configure -state $state
}
foreach w $widgets(listboxes) {
$w configure -state $state -bg $bg
}
$widgets(bb) configure -state $state
if {$state == "normal" && [[lindex $widgets(listboxes) 0] curselection] > 0} {
$widgets(bb) itemconfigure 1 -state normal
} else {
$widgets(bb) itemconfigure 1 -state disabled
}
if {$state == "normal" && $vars(primary_file) != {}} {
$widgets(bb) itemconfigure 3 -state normal
} else {
$widgets(bb) itemconfigure 3 -state disabled
}
}
proc Apol_Open_Policy_Dialog::browsePrimary {} {
variable vars
variable dialog
.open_policy_dialog.frame.primary.f.b configure -state disabled
if {$vars(path_type) == "monolithic"} {
set title "Open Monolithic Policy"
set initDirName {}
} else {
set title "Open Modular Policy"
if {$vars(primary_file) != {} } {
set initDirName [file dirname $vars(primary_file)]
} else {
set initDirName [file dirname $vars(last_module)]
}
}
set f [tk_getOpenFile -initialdir $initDirName \
-initialfile $vars(primary_file) -parent $dialog -title $title]
if {$f != {}} {
set vars(primary_file) $f
$dialog itemconfigure 0 -state normal
}
.open_policy_dialog.frame.primary.f.b configure -state normal
}
proc Apol_Open_Policy_Dialog::browseModule {} {
variable vars
variable dialog
if {$vars(last_module) != {} } {
set initDirName [file dirname $vars(last_module)]
} else {
set initDirName [file dirname $vars(primary_file)]
}
set paths [tk_getOpenFile -initialdir $initDirName \
-initialfile $vars(last_module) -parent $dialog \
-title "Open Module" -multiple 1]
if {$paths == {}} {
return
}
foreach f $paths {
if { $f != $vars(last_module) } {
addModule $f
}
}
}
proc Apol_Open_Policy_Dialog::addModule {f} {
variable vars
variable widgets
if {[lsearch $vars(mod_paths) $f] >= 0} {
tk_messageBox -icon error -type ok -title "Open Module" -message "Module $f was already added." -parent .open_policy_dialog
return
}
if {[catch {getModuleInfo $f} info]} {
tk_messageBox -icon error -type ok -title "Open Module" -message $info -detail "Module file $f" -parent .open_policy_dialog
} else {
foreach {name vers type} $info {break}
if {$type == 1} {
if {$vars(primary_file) != {}} {
if {$vars(primary_file) != $f} {
tk_messageBox -icon error -type ok -title "Open Module" -message "Base already set" -detail "Current $vars(primary_file)\n\nNew file $f\n\nIgnoring new file." -parent .open_policy_dialog
}
return
}
set vars(primary_file) $f
return
}
set vars(mod_names) [lsort [concat $vars(mod_names) $name]]
set i [lsearch $vars(mod_names) $name]
set vars(mod_vers) [linsert $vars(mod_vers) $i $vers]
set vars(mod_paths) [linsert $vars(mod_paths) $i $f]
foreach lb $widgets(listboxes) {
$lb selection clear 0 end
$lb selection set $i
}
[lindex $widgets(listboxes) 0] see $i
set vars(last_module) $f
$widgets(bb) itemconfigure 1 -state normal
}
}
proc Apol_Open_Policy_Dialog::removeModule {} {
variable widgets
set i [[lindex $widgets(listboxes) 0] curselection]
if {[llength $i] > 0} {
foreach lb $widgets(listboxes) {
$lb delete [lindex $i 0]
}
}
$widgets(bb) itemconfigure 1 -state disabled
}
proc Apol_Open_Policy_Dialog::importList {} {
variable vars
variable dialog
variable widgets
set f [tk_getOpenFile -initialdir [file dirname $vars(primary_file)] \
-parent $dialog -title "Import Policy List"]
if {$f == {}} {
return
}
if {[catch {new_apol_policy_path_t $f} ppath]} {
tk_messageBox -icon error -type ok -title "Import Policy List" \
-message "Error importing policy list $f: $ppath"
return
}
foreach lb $widgets(listboxes) {
$lb delete 0 end
}
foreach {path_type primary modules} [policy_path_to_list $ppath] {break}
set vars(path_type) $path_type
if {[set vars(primary_file) $primary] != {}} {
$dialog itemconfigure 0 -state normal
}
set vars(last_module) $f
foreach m $modules {
addModule $m
}
_validateEntryKey $vars(primary_file)
$ppath -acquire
$ppath -delete
}
proc Apol_Open_Policy_Dialog::exportList {} {
variable vars
variable dialog
set f [tk_getSaveFile -parent $dialog -title "Export Policy List"]
if {$f == {}} {
return
}
set ppath [list_to_policy_path $vars(path_type) $vars(primary_file) $vars(mod_paths)]
if {[catch {$ppath to_file $f} err]} {
tk_messageBox -icon error -type ok -title "Export Policy List" \
-message "Error exporting policy list $f: $err"
}
}
proc Apol_Open_Policy_Dialog::multiscroll {args} {
variable widgets
foreach lb $widgets(listboxes) {
eval $lb $args
}
}
proc Apol_Open_Policy_Dialog::multiselect {lb} {
variable widgets
set sellist [$lb curselection]
set enable_remove 0
foreach lb $widgets(listboxes) {
$lb selection clear 0 end
foreach item $sellist {
$lb selection set $item
set enable_remove 1
}
}
if {$enable_remove} {
$widgets(bb) itemconfigure 1 -state normal
}
}
proc Apol_Open_Policy_Dialog::multiyview {args} {
variable widgets
eval $widgets(scrollbar) set $args
multiscroll yview moveto [lindex $args 0]
}
proc Apol_Open_Policy_Dialog::tryOpenPolicy {} {
variable dialog
variable vars
.open_policy_dialog.bbox.b0 configure -state disabled
if {[string trim $vars(primary_file)] != {}} {
set ppath [list_to_policy_path $vars(path_type) $vars(primary_file) $vars(mod_paths)]
if {[ApolTop::openPolicyPath $ppath] == 0} {
$dialog enddialog {}
}
}
.open_policy_dialog.bbox.b0 configure -state normal
}
proc Apol_Open_Policy_Dialog::getModuleInfo {f} {
set mod [new_qpol_module_t $f]
set retval [list [$mod get_name] [$mod get_version] [$mod get_type]]
$mod -acquire
$mod -delete
return $retval
}
namespace eval Apol_Perms_Map {
variable dialog .apol_perms
variable user_default_pmap_name [file join $::env(HOME) .apol_perm_mapping]
variable opts ;# options for edit perm map dialog
variable widgets
}
proc Apol_Perms_Map::close {} {
variable opts
_close_dialog
set opts(filename) {}
set opts(is_saveable) 0
set opts(modified) 0
}
proc Apol_Perms_Map::showPermMappings {} {
variable dialog
if {[winfo exists $dialog]} {
raise $dialog
} else {
_createEditDialog
_refreshEditDialog
}
}
proc Apol_Perms_Map::openPermMapFromFile {} {
set pmap_name [tk_getOpenFile -title "Select Perm Map to Load" -parent .]
if {$pmap_name != {}} {
return [_loadPermMap $pmap_name [file tail $pmap_name] 1]
}
return 0
}
proc Apol_Perms_Map::openDefaultPermMap {} {
variable user_default_pmap_name
if {[file exists $user_default_pmap_name]} {
set pmap_name $user_default_pmap_name
set pmap_short "User Default Permission Map"
set pmap_editable 1
} else {
set pmap_editable 0
set policy_version [apol_tcl_get_policy_version $::ApolTop::policy]
set pmap_name [apol_file_find_path "apol_perm_mapping_ver${policy_version}"]
if {$pmap_name == {}} {
set pmap_name [apol_file_find_path apol_perm_mapping]
if {$pmap_name == {}} {
set message "Could not locate system default permission map. You must explicitly load a permission map from file."
if {[Apol_Progress_Dialog::is_waiting]} {
error $message
} else {
tk_messageBox -icon error -type ok -title "Permission Maps" \
-message $message
}
return 0
}
}
set pmap_short "System Default Permission Map (Read-Only)"
}
return [_loadPermMap $pmap_name $pmap_short $pmap_editable]
}
proc Apol_Perms_Map::savePermMap {} {
variable opts
if {!$opts(is_saveable)} {
savePermMapAs
} else {
_savePermMap $opts(filename) $opts(shortname)
}
}
proc Apol_Perms_Map::savePermMapAs {} {
set pmap_name [tk_getSaveFile -title "Save Perm Map" -parent .]
if {$pmap_name != {}} {
_savePermMap $pmap_name [file tail $pmap_name]
}
}
proc Apol_Perms_Map::saveDefaultPermMap {} {
variable user_default_pmap_name
variable opts
_savePermMap $user_default_pmap_name "User Default Permission Map"
}
proc Apol_Perms_Map::is_pmap_loaded {} {
variable opts
if {$opts(filename) == {}} {
return 0
}
return 1
}
proc Apol_Perms_Map::_loadPermMap {filename shortname saveable} {
if {[catch {$::ApolTop::policy open_permmap $filename} err]} {
if {[Apol_Progress_Dialog::is_waiting]} {
error $err
} else {
tk_messageBox -icon error -type ok -title "Permission Maps" -message $err
return 0
}
}
variable opts
set opts(filename) $filename
set opts(shortname) $shortname
set opts(is_saveable) $saveable
set opts(modified) 0
if {$err != {}} {
set len [llength [split $err "\n"]]
if {$len > 5} {
incr len -4
set err [lrange [split $err "\n"] 0 3]
lappend err "(plus $len more lines)"
set err [join $err "\n"]
}
if {![Apol_Progress_Dialog::is_waiting]} {
set message "There were warnings while opening the permission map:"
tk_messageBox -icon warning -type ok -title "Permission Maps" \
-message "$message\n\n$err"
}
} else {
if {![Apol_Progress_Dialog::is_waiting]} {
tk_messageBox -icon info -type ok -title "Permission Maps" \
-message "Permission map successfully loaded."
}
}
variable dialog
if {[winfo exists $dialog]} {
_refreshEditDialog
}
return 1
}
proc Apol_Perms_Map::_createEditDialog {} {
variable dialog
variable opts
variable widgets
set title "Permissions Mappings: $opts(shortname)"
Dialog $dialog -parent . -separator 1 -title $title -modal none \
-default 0 -cancel 2
set topf [frame [$dialog getframe].top]
pack $topf -side top -expand 1 -fill both
set classes_box [TitleFrame $topf.classes -text "Object Classes"]
pack $classes_box -side left -padx 2 -pady 2 -expand 0 -fill y
set widgets(classes) [Apol_Widget::makeScrolledListbox [$classes_box getframe].c \
-height 16 -width 24 -listvar Apol_Perms_Map::opts(classes)]
bind $widgets(classes).lb <<ListboxSelect>> Apol_Perms_Map::_refreshPermEdit
pack $widgets(classes) -expand 1 -fill both
set results_box [TitleFrame $topf.perms -text "Permission Mappings"]
pack $results_box -side right -padx 2 -pady 2 -expand 1 -fill both
set sw [ScrolledWindow [$results_box getframe].sw -auto both]
set widgets(perms) [ScrollableFrame $sw.perms -width 300]
$sw setwidget $widgets(perms)
pack $sw -expand 1 -fill both
set label_box [frame [$dialog getframe].l]
pack $label_box -side bottom -anchor center
set widgets(l1) [label $label_box.l1 -fg red -text ""]
set widgets(l2) [label $label_box.l2 -text ""]
pack $widgets(l1) $widgets(l2) -side left
$dialog add -text "OK" -command Apol_Perms_Map::_okay
$dialog add -text "Apply" -command Apol_Perms_Map::_apply
$dialog add -text "Cancel" -command Apol_Perms_Map::_cancel
trace add variable Apol_Perms_Map::opts(modified) write \
Apol_Perms_Map::_toggleButtons
set opts(modified) $opts(modified)
$dialog draw
}
proc Apol_Perms_Map::_refreshEditDialog {} {
variable opts
variable widgets
array set opts {
classes {}
}
set all_mapped 1
set class_index 0
foreach class [Apol_Class_Perms::getClasses] {
set suffix {}
set perm_list {}
foreach perm [Apol_Class_Perms::getPermsForClass $class] {
set direction [$::ApolTop::policy get_permmap_direction $class $perm]
set weight [$::ApolTop::policy get_permmap_weight $class $perm]
set opts(p:${class}:${perm}:map) $direction
set opts(p:${class}:${perm}:weight) $weight
if {$direction == $::APOL_PERMMAP_UNMAPPED} {
set suffix *
set all_mapped 0
}
lappend perm_list [list $perm $direction $weight]
}
set opts(c:$class) $perm_list
lappend opts(classes) "$class$suffix"
if {$suffix != {}} {
$widgets(classes).lb itemconfigure $class_index -foreground red
}
incr class_index
}
if {!$all_mapped} {
$widgets(l1) configure -text "*"
$widgets(l2) configure -text " - Undefined permission mapping(s)"
} else {
$widgets(l1) configure -text ""
$widgets(l2) configure -text ""
}
}
proc Apol_Perms_Map::_refreshPermEdit {} {
variable opts
variable widgets
focus $widgets(classes).lb
set perms [$widgets(perms) getframe]
foreach w [winfo children $perms] {
destroy $w
}
if {[set selection [$widgets(classes).lb curselection]] == {}} {
return
}
set class [lindex $opts(classes) [lindex $selection 0]]
set class [string trimright $class "*"]
foreach perm $opts(c:$class) {
foreach {perm map weight} $perm {break}
if {$map != $::APOL_PERMMAP_UNMAPPED} {
set l [label $perms.$perm:l -text $perm -anchor w]
} else {
set l [label $perms.$perm:l -text "${perm}*" -fg red -anchor w]
}
set menubutton [menubutton $perms.$perm:mb -bd 2 -relief raised \
-indicatoron 1 -width 8 \
-textvariable Apol_Perms_Map::opts(p:${class}:${perm}:map_label)]
set menu [menu $menubutton.m -type normal -tearoff 0]
$menubutton configure -menu $menu
$menu add radiobutton -label "Read" -value $::APOL_PERMMAP_READ \
-command [list Apol_Perms_Map::_togglePermMap $class $perm 1] \
-variable Apol_Perms_Map::opts(p:${class}:${perm}:map)
$menu add radiobutton -label "Write" -value $::APOL_PERMMAP_WRITE \
-command [list Apol_Perms_Map::_togglePermMap $class $perm 1] \
-variable Apol_Perms_Map::opts(p:${class}:${perm}:map)
$menu add radiobutton -label "Both" -value $::APOL_PERMMAP_BOTH \
-command [list Apol_Perms_Map::_togglePermMap $class $perm 1] \
-variable Apol_Perms_Map::opts(p:${class}:${perm}:map)
$menu add radiobutton -label "None" -value $::APOL_PERMMAP_NONE \
-command [list Apol_Perms_Map::_togglePermMap $class $perm 1] \
-variable Apol_Perms_Map::opts(p:${class}:${perm}:map)
set l2 [label $perms.$perm:l2 -text "Weight:" -anchor e]
set weight [spinbox $perms.$perm:weight -from 1 -to 10 -increment 1 \
-width 2 -bg white \
-command [list Apol_Perms_Map::_togglePermMap $class $perm 1] \
-textvariable Apol_Perms_Map::opts(p:${class}:${perm}:weight)]
grid $l $menubutton $l2 $weight -padx 2 -sticky w -pady 4
grid configure $l2 -ipadx 10
_togglePermMap $class $perm 0
}
grid columnconfigure $perms 0 -minsize 100 -weight 1
$widgets(perms) xview moveto 0
$widgets(perms) yview moveto 0
}
proc Apol_Perms_Map::_togglePermMap {class perm modification} {
variable opts
set map $opts(p:${class}:${perm}:map)
if {$map == $::APOL_PERMMAP_READ} {
set opts(p:${class}:${perm}:map_label) "Read"
} elseif {$map == $::APOL_PERMMAP_WRITE} {
set opts(p:${class}:${perm}:map_label) "Write"
} elseif {$map == $::APOL_PERMMAP_BOTH} {
set opts(p:${class}:${perm}:map_label) "Both"
} elseif {$map == $::APOL_PERMMAP_NONE} {
set opts(p:${class}:${perm}:map_label) "None"
} else {
set opts(p:${class}:${perm}:map_label) "Unmapped"
}
set opts(modified) $modification
}
proc Apol_Perms_Map::_toggleButtons {name1 name2 op} {
variable opts
variable dialog
if {$opts(modified)} {
$dialog itemconfigure 1 -state normal
} else {
$dialog itemconfigure 1 -state disabled
}
}
proc Apol_Perms_Map::_okay {} {
_apply
_close_dialog
}
proc Apol_Perms_Map::_apply {} {
variable dialog
variable opts
if {[winfo exists $dialog] && $opts(modified)} {
foreach class $opts(classes) {
set class [string trimright $class "*"]
set perm_list {}
foreach perm [Apol_Class_Perms::getPermsForClass $class] {
set map $opts(p:${class}:${perm}:map)
set weight $opts(p:${class}:${perm}:weight)
if {$map != $::APOL_PERMMAP_UNMAPPED} {
$::ApolTop::policy set_permmap $class $perm $map $weight
}
lappend perm_list [list $perm $map $weight]
}
set opts(c:$class) $perm_list
}
}
set opts(modified) 0
}
proc Apol_Perms_Map::_cancel {} {
variable opts
if {$opts(modified)} {
foreach class $opts(classes) {
set class [string trimright $class "*"]
foreach perm $opts(c:$class) {
foreach {perm map weight} $perm {break}
$::ApolTop::policy set_permmap $class $perm $map $weight
}
}
}
_close_dialog
}
proc Apol_Perms_Map::_close_dialog {} {
variable opts
array unset opts c:*
array unset opts p:*
trace remove variable Apol_Perms_Map::opts(modified) write \
Apol_Perms_Map::_toggleButtons
variable dialog
destroy $dialog
}
proc Apol_Perms_Map::_savePermMap {filename shortname} {
variable opts
variable dialog
_apply
if {[catch {$::ApolTop::policy save_permmap $filename} err]} {
tk_messageBox -icon error -type ok -title "Permission Maps" -message "Error saving permission map: $err"
} else {
set opts(filename) $filename
set opts(shortname) $shortname
set opts(is_saveable) 1
set opts(modified) 0
set title "Permissions Mappings: $opts(shortname)"
if {[winfo exists $dialog]} {
$dialog configure -title $title
_refreshEditDialog
_refreshPermEdit
}
}
}
namespace eval Apol_Polcaps {
variable widgets
variable polcap_list {}
}
proc Apol_Polcaps::create {tab_name nb} {
variable widgets
set frame [$nb insert end $tab_name -text "Policy Capabilities"]
set pw [PanedWindow $frame.pw -side top]
set leftf [$pw add -weight 0]
set rightf [$pw add -weight 1]
pack $pw -fill both -expand yes
set polcap_box [TitleFrame $leftf.polcap_box -text "Policy Capabilities"]
pack $polcap_box -fill both -expand yes
set rlistbox [Apol_Widget::makeScrolledListbox [$polcap_box getframe].lb \
-width 60 -listvar Apol_Polcaps::polcap_list]
pack $rlistbox -fill both -expand yes
return $frame
}
proc Apol_Polcaps::open {ppath} {
variable polcap_list
set polcapnames {}
set q [new_apol_polcap_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_polcap_from_void [$v get_element $i]]
append polcapnames [$q get_name $::ApolTop::qpolicy]
append polcapnames "\n"
}
}
set polcap_list $polcapnames
}
proc Apol_Polcaps::close {} {
variable widgets
variable polcap_list {}
}
proc Apol_Polcaps::getTextWidget {} {
variable widgets
}
namespace eval Apol_PolicyConf {
variable textbox
}
proc Apol_PolicyConf::create {tab_name nb} {
variable textbox
set frame [$nb insert end $tab_name -text "Policy Source"]
set sw [ScrolledWindow $frame.sw -auto none]
set textbox [text [$sw getframe].text -bg white -wrap none]
$sw setwidget $textbox
bind $textbox <Button-3> [list Apol_Widget::_searchresults_popup %W %x %y]
pack $sw -expand yes -fill both
bind $textbox <<Insertion>> Apol_PolicyConf::insertionMarkChanged
rename $textbox ::Apol_PolicyConf::_real_text
proc ::$textbox {cmd args} {
switch -- $cmd {
insert -
delete { return }
fakeinsert { set cmd insert }
fakedelete { set cmd delete }
}
set retval [uplevel 1 ::Apol_PolicyConf::_real_text $cmd $args]
if {$cmd == "mark" && [string equal -length 10 $args "set insert"]} {
event generate $Apol_PolicyConf::textbox <<Insertion>>
}
return $retval
}
}
proc Apol_PolicyConf::open {ppath} {
variable textbox
$textbox fakedelete 0.0 end
if {![ApolTop::is_capable "source"]} {
$textbox fakeinsert end "The currently loaded policy is not a source policy."
ApolTop::_toplevel_enable_tabs tag_source disabled
} else {
ApolTop::_toplevel_enable_tabs tag_source normal
set primary_file [$ppath get_primary]
if {[catch {::open $primary_file r} f]} {
$textbox fakeinsert end "$primary_file does not exist or could not be read by the user."
} else {
$textbox fakeinsert end [read $f]
::close $f
}
}
$textbox see 0.0
$textbox mark set insert 1.0
}
proc Apol_PolicyConf::close {} {
variable textbox
$textbox fakedelete 0.0 end
}
proc Apol_PolicyConf::getTextWidget {} {
variable textbox
return $textbox
}
proc Apol_PolicyConf::insertionMarkChanged {} {
set lpos [$Apol_PolicyConf::textbox index insert]
foreach {line col} [split $lpos .] {break}
ApolTop::setPolicySourceLinenumber $line
}
proc Apol_PolicyConf::gotoLine {line} {
variable textbox
$textbox tag remove sel 0.0 end
$textbox mark set insert $line.0
$textbox see $line.0
$textbox tag add sel $line.0 $line.end
focus $textbox
}
namespace eval Apol_Progress_Dialog {
variable text
variable prev_text
variable val
variable waiting 0
}
proc Apol_Progress_Dialog::wait {title initialtext lambda} {
variable text "$title:\n $initialtext"
variable prev_text $initialtext
variable val -1
set title_width [string length $title]
set text_width [expr {[string length $initialtext] + 4}]
if {$text_width < $title_width} {
set text_width $title_width
}
if {$text_width < 32} {
set text_width 32
}
if {[info exists .apol_progress] == 0} {
ProgressDlg .apol_progress -title $title \
-type normal -stop {} -separator 1 -parent . -maximum 2 \
-width $text_width -textvariable Apol_Progress_Dialog::text \
-variable Apol_Progress_Dialog::val
}
set orig_cursor [. cget -cursor]
. configure -cursor watch
update idletasks
apol_tcl_clear_info_string
variable waiting 1
set catchval [catch {uplevel 1 $lambda} retval]
set waiting 0
. configure -cursor $orig_cursor
destroy .apol_progress
update idletasks
return -code $catchval $retval
}
proc Apol_Progress_Dialog::is_waiting {} {
variable waiting
set waiting
}
proc Apol_Progress_Dialog::_update_message {} {
variable text
variable prev_text
if {[set infoString [apol_tcl_get_info_string]] != $prev_text} {
set text "[lindex [split $text "\n"] 0]\n $infoString"
update idletasks
set prev_text $infoString
}
}
namespace eval Apol_Range_Dialog {
variable dialog ""
variable vars
}
proc Apol_Range_Dialog::getRange {{defaultRange {}} {parent .}} {
variable dialog
variable vars
if {![winfo exists $dialog]} {
_create_dialog $parent
}
set f [$dialog getframe]
Apol_Widget::resetLevelSelectorToPolicy $f.low
Apol_Widget::resetLevelSelectorToPolicy $f.high
set vars($dialog:highenable) 0
if {$defaultRange != {}} {
set low_level [$defaultRange get_low]
set high_level [$defaultRange get_high]
Apol_Widget::setLevelSelectorLevel $f.low $low_level
if {[apol_mls_level_compare $::ApolTop::policy $low_level $high_level] != $::APOL_MLS_EQ} {
set vars($dialog:highenable) 1
Apol_Widget::setLevelSelectorLevel $f.high $high_level
}
}
_high_enabled $dialog
$dialog.bbox _redraw
set retval [$dialog draw]
if {$retval == -1 || $retval == 1} {
return {}
}
_get_range $dialog
}
proc Apol_Range_Dialog::_create_dialog {parent} {
variable dialog
variable vars
set dialog [Dialog .range_dialog -modal local -parent $parent \
-separator 1 -homogeneous 1 -title "Select Range"]
array unset vars $dialog:*
set f [$dialog getframe]
set low_label [label $f.ll -text "Single level"]
set low_level [Apol_Widget::makeLevelSelector $f.low 12]
set high_cb [checkbutton $f.high_enable \
-text "High level" \
-variable Apol_Range_Dialog::vars($dialog:highenable) \
-command [list Apol_Range_Dialog::_high_enabled $dialog]]
set high_level [Apol_Widget::makeLevelSelector $f.high 12]
Apol_Widget::setLevelSelectorState $high_level 0
grid $low_label $high_cb -sticky w
grid $low_level $high_level -sticky ns
grid columnconfigure $f 0 -weight 1 -uniform 1 -pad 4
grid columnconfigure $f 1 -weight 1 -uniform 1 -pad 4
$dialog add -text "OK" -command [list Apol_Range_Dialog::_okay $dialog]
$dialog add -text "Cancel"
}
proc Apol_Range_Dialog::_get_range {dialog} {
variable vars
set f [$dialog getframe]
set range [new_apol_mls_range_t]
if {[ApolTop::is_policy_open]} {
set p $::ApolTop::policy
} else {
set p NULL
}
set low_level [Apol_Widget::getLevelSelectorLevel $f.low]
$range set_low $p $low_level
if {$vars($dialog:highenable)} {
set high_level [Apol_Widget::getLevelSelectorLevel $f.high]
$range set_high $p $high_level
}
return $range
}
proc Apol_Range_Dialog::_okay {dialog} {
set range [_get_range $dialog]
if {![ApolTop::is_policy_open] || [$range validate $::ApolTop::policy] != 1} {
tk_messageBox -icon error -type ok -title "Invalid Range" \
-message "The selected range is not valid. The high level does not dominate the low level."
} else {
$dialog enddialog 0
}
$range -acquire
$range -delete
}
proc Apol_Range_Dialog::_high_enabled {dialog} {
variable vars
set f [$dialog getframe]
if {$vars($dialog:highenable)} {
$f.ll configure -text "Low level"
Apol_Widget::setLevelSelectorState $f.high 1
} else {
$f.ll configure -text "Single level"
Apol_Widget::setLevelSelectorState $f.high 0
}
}
namespace eval Apol_Widget {
variable vars
}
proc Apol_Widget::makeRangeSelector {path rangeMatchText {enableText "MLS range"} args} {
variable vars
array unset vars $path:*
set vars($path:range) {}
set vars($path:range_rendered) {}
set vars($path:search_type) $::APOL_QUERY_EXACT
set f [frame $path]
set range_frame [frame $f.range]
set range2_frame [frame $f.range2]
pack $range_frame $range2_frame -side left -expand 0 -anchor nw
if {$enableText != {}} {
set vars($path:enable) 0
set range_cb [checkbutton $range_frame.enable -text $enableText \
-variable Apol_Widget::vars($path:enable)]
pack $range_cb -side top -expand 0 -anchor nw
trace add variable Apol_Widget::vars($path:enable) write [list Apol_Widget::_toggle_range_selector $path $range_cb]
}
set range_display [eval Entry $range_frame.display -textvariable Apol_Widget::vars($path:range_rendered) -width 20 -editable 0 $args]
set range_button [button $range_frame.button -text "Select Range..." -state disabled -command [list Apol_Widget::_show_mls_range_dialog $path]]
trace add variable Apol_Widget::vars($path:range) write [list Apol_Widget::_update_range_display $path]
pack $range_display -side top -expand 1 -fill x -anchor nw
pack $range_button -side top -expand 0 -anchor ne
if {$enableText != {}} {
pack configure $range_display -padx 4
pack configure $range_button -padx 4
}
set range_label [label $range2_frame.label -text "Range matching:" \
-state disabled]
set range_exact [radiobutton $range2_frame.exact -text "Exact matches" \
-state disabled \
-value $::APOL_QUERY_EXACT \
-variable Apol_Widget::vars($path:search_type)]
set range_subset [radiobutton $range2_frame.subset -text "$rangeMatchText containing range" \
-state disabled \
-value $::APOL_QUERY_SUB \
-variable Apol_Widget::vars($path:search_type)]
set range_superset [radiobutton $range2_frame.superset -text "$rangeMatchText within range" \
-state disabled \
-value $::APOL_QUERY_SUPER \
-variable Apol_Widget::vars($path:search_type)]
pack $range_label $range_exact $range_subset $range_superset \
-side top -expand 0 -anchor nw
return $f
}
proc Apol_Widget::setRangeSelectorState {path newState} {
if {$newState == 0 || $newState == "disabled"} {
set new_state disabled
} else {
set new_state normal
}
foreach w {display button} {
$path.range.$w configure -state $new_state
}
foreach w {label exact subset superset} {
$path.range2.$w configure -state $new_state
}
}
proc Apol_Widget::setRangeSelectorCompleteState {path newState} {
if {$newState == 0 || $newState == "disabled"} {
set new_state disabled
} else {
set new_state normal
}
catch {$path.range.enable configure -state $new_state}
}
proc Apol_Widget::clearRangeSelector {path} {
set Apol_Widget::vars($path:range) {}
set Apol_Widget::vars($path:search_type) $::APOL_QUERY_EXACT
catch {set Apol_Widget::vars($path:enable) 0}
}
proc Apol_Widget::getRangeSelectorState {path} {
return $Apol_Widget::vars($path:enable)
}
proc Apol_Widget::getRangeSelectorValue {path} {
variable vars
if {$vars($path:range) != {}} {
set range [new_apol_mls_range_t $vars($path:range)]
} else {
set range {}
}
list $range $vars($path:search_type)
}
proc Apol_Widget::_toggle_range_selector {path cb name1 name2 op} {
if {$Apol_Widget::vars($path:enable)} {
Apol_Widget::setRangeSelectorState $path normal
} else {
Apol_Widget::setRangeSelectorState $path disabled
}
}
proc Apol_Widget::_show_mls_range_dialog {path} {
$path.range.button configure -state disabled
set range [Apol_Range_Dialog::getRange $Apol_Widget::vars($path:range)]
if {$range != {}} {
set Apol_Widget::vars($path:range) $range
$range -acquire
}
$path.range.button configure -state normal
}
proc Apol_Widget::_update_range_display {path name1 name2 op} {
variable vars
set display $path.range.display
if {$vars($path:range) == {}} {
set vars($path:range_rendered) {}
$display configure -helptext {}
} else {
set s [$vars($path:range) render $::ApolTop::policy]
set vars($path:range_rendered) $s
$display configure -helptext $vars($path:range_rendered)
}
}
namespace eval Apol_Range {
variable widgets
variable vals
}
proc Apol_Range::create {tab_name nb} {
variable widgets
variable vals
set frame [$nb insert end $tab_name -text "Range Transition Rules"]
set obox [TitleFrame $frame.obox -text "Search Options"]
set dbox [TitleFrame $frame.dbox -text "Range Transition Rules Display"]
pack $obox -fill x -expand 0 -padx 2 -pady 2
pack $dbox -fill both -expand yes -padx 2 -pady 2
set source_frame [frame [$obox getframe].source]
set target_frame [frame [$obox getframe].target]
set classes_frame [frame [$obox getframe].classes]
pack $source_frame $target_frame $classes_frame -side left -padx 4 -pady 2 -expand 0 -anchor nw
set vals(enable_source) 0
set source_cb [checkbutton $source_frame.cb -text "Source type" \
-variable Apol_Range::vals(enable_source)]
set widgets(source_type) [Apol_Widget::makeTypeCombobox $source_frame.tcb]
Apol_Widget::setTypeComboboxState $widgets(source_type) 0
trace add variable Apol_Range::vals(enable_source) write \
[list Apol_Range::_toggleTypeCombobox $widgets(source_type)]
pack $source_cb -side top -expand 0 -anchor nw
pack $widgets(source_type) -side top -expand 0 -anchor nw -padx 4
set vals(enable_target) 0
set target_cb [checkbutton $target_frame.cb -text "Target type" \
-variable Apol_Range::vals(enable_target)]
set widgets(target_type) [Apol_Widget::makeTypeCombobox $target_frame.tcb]
Apol_Widget::setTypeComboboxState $widgets(target_type) 0
trace add variable Apol_Range::vals(enable_target) write \
[list Apol_Range::_toggleTypeCombobox $widgets(target_type)]
pack $target_cb -side top -expand 0 -anchor nw
pack $widgets(target_type) -side top -expand 0 -anchor nw -padx 4
set l [label $classes_frame.l -text "Target Classes"]
set sw [ScrolledWindow $classes_frame.sw -auto both]
set widgets(classes) [listbox [$sw getframe].lb -height 5 -width 24 \
-highlightthickness 0 -selectmode multiple \
-exportselection 0 -state disabled \
-bg $ApolTop::default_bg_color \
-listvar Apol_Range::vals(classes)]
$sw setwidget $widgets(classes)
update
grid propagate $sw 0
pack $l $sw -side top -expand 0 -anchor nw
set widgets(range) [Apol_Widget::makeRangeSelector [$obox getframe].range Rules]
pack $widgets(range) -side left -padx 4 -pady 2 -expand 0 -anchor nw
set ok [button [$obox getframe].ok -text "OK" -width 6 -command Apol_Range::_searchRanges]
pack $ok -side right -pady 5 -padx 5 -anchor ne
set widgets(results) [Apol_Widget::makeSearchResults [$dbox getframe].results]
pack $widgets(results) -expand yes -fill both
return $frame
}
proc Apol_Range::open {ppath} {
variable vals
variable widgets
Apol_Widget::resetTypeComboboxToPolicy $widgets(source_type)
Apol_Widget::resetTypeComboboxToPolicy $widgets(target_type)
set vals(classes) [Apol_Class_Perms::getClasses]
$widgets(classes) configure -bg white -state normal
}
proc Apol_Range::close {} {
variable vals
variable widgets
Apol_Widget::clearTypeCombobox $widgets(source_type)
Apol_Widget::clearTypeCombobox $widgets(target_type)
set vals(classes) {}
$widgets(classes) configure -bg $ApolTop::default_bg_color -state disabled
Apol_Widget::clearRangeSelector $widgets(range)
Apol_Widget::clearSearchResults $widgets(results)
set vals(enable_source) 0
set vals(enable_target) 0
}
proc Apol_Range::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_Range::_toggleTypeCombobox {path name1 name2 op} {
Apol_Widget::setTypeComboboxState $path $Apol_Range::vals($name2)
}
proc Apol_Range::_searchRanges {} {
variable vals
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
return
}
if {$vals(enable_source)} {
set source [lindex [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(source_type)] 0]
if {$source == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No source type provided."
return
}
} else {
set source {}
}
if {$vals(enable_target)} {
set target [lindex [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(target_type)] 0]
if {$target == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No target type provided."
return
}
} else {
set target {}
}
if {[Apol_Widget::getRangeSelectorState $widgets(range)]} {
foreach {range range_match} [Apol_Widget::getRangeSelectorValue $widgets(range)] break
if {$range == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No range selected."
return
}
} else {
set range NULL
set range_match 0
}
set q [new_apol_range_trans_query_t]
$q set_source $::ApolTop::policy $source 0
$q set_target $::ApolTop::policy $target 0
foreach c [$widgets(classes) curselection] {
$q append_class $::ApolTop::policy [$widgets(classes) get $c]
}
$q set_range $::ApolTop::policy $range $range_match
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set results [range_trans_vector_to_list $v]
$v -acquire
$v -delete
if {[llength $results] == 0} {
set text "Search returned no results."
} else {
set text "[llength $results] rule"
if {[llength $results] != 1} {
append text s
}
append text " match the search criteria.\n\n"
}
foreach r [lsort -command _range_trans_sort $results] {
append text "[_renderRangeTrans $r]\n"
}
Apol_Widget::appendSearchResultText $widgets(results) $text
}
proc Apol_Range::_renderRangeTrans {rule} {
apol_range_trans_render $::ApolTop::policy $rule
}
proc Apol_Range::_range_trans_sort {a b} {
set t1 [[$a get_source_type $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
set t2 [[$b get_source_type $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
if {[set z [string compare $t1 $t2]] != 0} {
return $z
}
set t1 [[$a get_target_type $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
set t2 [[$b get_target_type $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
if {[set z [string compare $t1 $t2]] != 0} {
return $z
}
set c1 [[$a get_target_class $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
set c2 [[$b get_target_class $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
string compare $c1 $c2
}
namespace eval Apol_RBAC {
variable vals
variable widgets
}
proc Apol_RBAC::create {tab_name nb} {
variable vals
variable widgets
_initializeVars
set frame [$nb insert end $tab_name -text "RBAC Rules"]
set topf [frame $frame.top]
set bottomf [frame $frame.bottom]
pack $topf -expand 0 -fill both -pady 2
pack $bottomf -expand 1 -fill both -pady 2
set rsbox [TitleFrame $topf.rs -text "Rule Selection"]
set obox [TitleFrame $topf.opts -text "Search Options"]
set dbox [TitleFrame $bottomf.results -text "RBAC Rules Display"]
pack $rsbox -side left -expand 0 -fill both -padx 2
pack $obox -side left -expand 1 -fill both -padx 2
pack $dbox -expand 1 -fill both -padx 2
set rs [$rsbox getframe]
radiobutton $rs.allow -text allow -value allow \
-variable Apol_RBAC::vals(rule_selection)
radiobutton $rs.trans -text role_transition -value trans \
-variable Apol_RBAC::vals(rule_selection)
radiobutton $rs.both -text "allow and role_transition" -value both \
-variable Apol_RBAC::vals(rule_selection)
trace add variable Apol_RBAC::vals(rule_selection) write \
[list Apol_RBAC::_ruleChanged]
pack $rs.allow $rs.trans $rs.both -side top -anchor w
set widgets(options_pm) [PagesManager [$obox getframe].opts]
_allowCreate [$widgets(options_pm) add allow]
_transCreate [$widgets(options_pm) add trans]
_bothCreate [$widgets(options_pm) add both]
trace add variable Apol_RBAC::vals(source:which) write Apol_RBAC::_toggleRoleBox
$widgets(options_pm) compute_size
pack $widgets(options_pm) -expand 1 -fill both -side left
$widgets(options_pm) raise allow
set ok [button [$obox getframe].ok -text OK -width 6 -command Apol_RBAC::_searchRBACs]
pack $ok -side right -padx 5 -pady 5 -anchor ne
set widgets(results) [Apol_Widget::makeSearchResults [$dbox getframe].results]
pack $widgets(results) -expand yes -fill both
return $frame
}
proc Apol_RBAC::open {ppath} {
variable vals
variable widgets
$widgets(allow:source) configure -values $Apol_Roles::role_list
$widgets(allow:target) configure -values $Apol_Roles::role_list
$widgets(trans:source) configure -values $Apol_Roles::role_list
$widgets(trans:default) configure -values $Apol_Roles::role_list
$widgets(both:source) configure -values $Apol_Roles::role_list
set vals(target_type:types) $vals(target_type:types)
set vals(rule_selection) allow
}
proc Apol_RBAC::close {} {
variable widgets
_initializeVars
$widgets(allow:source) configure -values {}
$widgets(allow:target) configure -values {}
$widgets(trans:source) configure -values {}
$widgets(trans:target) configure -values {}
$widgets(trans:default) configure -values {}
$widgets(both:source) configure -values {}
}
proc Apol_RBAC::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_RBAC::_initializeVars {} {
variable vals
array set vals {
rule_selection allow
source:use 0
source:sym {}
source:which source
target_role:use 0
target_role:sym {}
target_type:use 0
target_type:sym {}
target_type:types 1
target_type:attribs 0
default:use 0
default:sym {}
}
}
proc Apol_RBAC::_allowCreate {a_f} {
variable vals
variable widgets
set source [frame $a_f.source]
set source_cb [checkbutton $source.enable -text "Source role" \
-variable Apol_RBAC::vals(source:use)]
set widgets(allow:source) [ComboBox $source.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_RBAC::vals(source:sym) \
-helptext "Type or select a role" -autopost 1]
set which_fm [frame $source.which]
set which_source [radiobutton $which_fm.source \
-text "As source" -state disabled \
-variable Apol_RBAC::vals(source:which) \
-value source]
set which_any [radiobutton $which_fm.any \
-text "As source or target" -state disabled \
-variable Apol_RBAC::vals(source:which) \
-value either]
trace add variable Apol_RBAC::vals(source:use) write \
[list Apol_RBAC::_toggleCheckbutton $widgets(allow:source) [list $which_source $which_any]]
pack $which_source $which_any -side top -anchor w
pack $source_cb -side top -anchor w
pack $widgets(allow:source) -side top -expand 0 -fill x -padx 4
pack $which_fm -anchor w -padx 8
pack $source -side left -padx 4 -pady 2 -expand 0 -anchor nw
set target [frame $a_f.target]
set widgets(allow:target_cb) [checkbutton $target.enable -text "Target role" \
-variable Apol_RBAC::vals(target_role:use)]
set widgets(allow:target) [ComboBox $target.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_RBAC::vals(target_role:sym) \
-helptext "Type or select a role" -autopost 1]
trace add variable Apol_RBAC::vals(target_role:use) write \
[list Apol_RBAC::_toggleCheckbutton $widgets(allow:target) {}]
pack $widgets(allow:target_cb) -side top -anchor w
pack $widgets(allow:target) -side top -expand 0 -fill x -padx 4
pack $target -side left -padx 4 -pady 2 -expand 0 -fill y
}
proc Apol_RBAC::_transCreate {t_f} {
variable vals
variable widgets
set source [frame $t_f.source]
set source_cb [checkbutton $source.enable -text "Source role" \
-variable Apol_RBAC::vals(source:use)]
set widgets(trans:source) [ComboBox $source.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_RBAC::vals(source:sym) \
-helptext "Type or select a role" -autopost 1]
set which_fm [frame $source.which]
set which_source [radiobutton $which_fm.source \
-text "As source" -state disabled \
-variable Apol_RBAC::vals(source:which) \
-value source]
set which_any [radiobutton $which_fm.any \
-text "As source or default" -state disabled \
-variable Apol_RBAC::vals(source:which) \
-value either]
trace add variable Apol_RBAC::vals(source:use) write \
[list Apol_RBAC::_toggleCheckbutton $widgets(trans:source) [list $which_source $which_any]]
pack $which_source $which_any -side top -anchor w
pack $source_cb -side top -anchor w
pack $widgets(trans:source) -side top -expand 0 -fill x -padx 4
pack $which_fm -anchor w -padx 8
pack $source -side left -padx 4 -pady 2 -expand 0 -anchor nw
set target [frame $t_f.target]
set target_cb [checkbutton $target.enable -text "Target type" \
-variable Apol_RBAC::vals(target_type:use)]
set widgets(trans:target) [ComboBox $target.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_RBAC::vals(target_type:sym) \
-helptext "Type or select a type/attribute" -autopost 1]
set ta_frame [frame $target.ta]
set types [checkbutton $ta_frame.types -text "Types" -state disabled \
-variable Apol_RBAC::vals(target_type:types)]
set attribs [checkbutton $ta_frame.attribs -text "Attribs" -state disabled \
-variable Apol_RBAC::vals(target_type:attribs)]
$types configure -command [list Apol_RBAC::_toggleTAPushed $types]
$attribs configure -command [list Apol_RBAC::_toggleTAPushed $attribs]
trace add variable Apol_RBAC::vals(target_type:types) write \
[list Apol_RBAC::_toggleTASym]
trace add variable Apol_RBAC::vals(target_type:attribs) write \
[list Apol_RBAC::_toggleTASym]
pack $types $attribs -side left -padx 2
trace add variable Apol_RBAC::vals(target_type:use) write \
[list Apol_RBAC::_toggleCheckbutton $widgets(trans:target) [list $types $attribs]]
pack $target_cb -side top -anchor w
pack $widgets(trans:target) -side top -expand 0 -fill x -padx 4
pack $ta_frame -anchor center -pady 2
pack $target -side left -padx 4 -pady 2 -expand 0 -fill y
set default [frame $t_f.default]
set widgets(trans:default_cb) [checkbutton $default.enable -text "Default role" \
-variable Apol_RBAC::vals(default:use)]
set widgets(trans:default) [ComboBox $default.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_RBAC::vals(default:sym) \
-helptext "Type or select a role" -autopost 1]
trace add variable Apol_RBAC::vals(default:use) write \
[list Apol_RBAC::_toggleCheckbutton $widgets(trans:default) {}]
pack $widgets(trans:default_cb) -side top -anchor w
pack $widgets(trans:default) -side top -expand 0 -fill x -padx 4
pack $default -side left -padx 4 -pady 2 -expand 0 -fill y
}
proc Apol_RBAC::_bothCreate {b_f} {
variable vals
variable widgets
set source [frame $b_f.source]
set source_cb [checkbutton $source.enable -text "Source role" \
-variable Apol_RBAC::vals(source:use)]
set widgets(both:source) [ComboBox $source.cb -width 20 -state disabled \
-entrybg $ApolTop::default_bg_color \
-textvariable Apol_RBAC::vals(source:sym) \
-helptext "Type or select a role" -autopost 1]
set which_fm [frame $source.which]
set which_source [radiobutton $which_fm.source \
-text "As source" -state disabled \
-variable Apol_RBAC::vals(source:which) \
-value source]
set which_any [radiobutton $which_fm.any \
-text "Any field" -state disabled \
-variable Apol_RBAC::vals(source:which) \
-value either]
trace add variable Apol_RBAC::vals(source:use) write \
[list Apol_RBAC::_toggleCheckbutton $widgets(both:source) [list $which_source $which_any]]
pack $which_source $which_any -side top -anchor w
pack $source_cb -side top -anchor w
pack $widgets(both:source) -side top -expand 0 -fill x -padx 4
pack $which_fm -anchor w -padx 8
pack $source -side left -padx 4 -pady 2 -expand 0 -anchor nw
}
proc Apol_RBAC::_toggleCheckbutton {cb w name1 name2 ops} {
variable vals
if {$vals($name2)} {
$cb configure -state normal -entrybg white
foreach x $w {
$x configure -state normal
}
} else {
$cb configure -state disabled -entrybg $ApolTop::default_bg_color
foreach x $w {
$x configure -state disabled
}
}
_maybeEnableTargetRole
_maybeEnableDefaultRole
}
proc Apol_RBAC::_toggleRoleBox {name1 name2 ops} {
_maybeEnableTargetRole
_maybeEnableDefaultRole
}
proc Apol_RBAC::_maybeEnableTargetRole {} {
variable vals
variable widgets
if {$vals(source:use) && $vals(source:which) == "either"} {
$widgets(allow:target_cb) configure -state disabled
$widgets(allow:target) configure -state disabled -entrybg $ApolTop::default_bg_color
} else {
$widgets(allow:target_cb) configure -state normal
set vals(target_role:use) $vals(target_role:use)
}
}
proc Apol_RBAC::_maybeEnableDefaultRole {} {
variable vals
variable widgets
if {$vals(source:use) && $vals(source:which) == "either"} {
$widgets(trans:default_cb) configure -state disabled
$widgets(trans:default) configure -state disabled -entrybg $ApolTop::default_bg_color
} else {
$widgets(trans:default_cb) configure -state normal
set vals(default:use) $vals(default:use)
}
}
proc Apol_RBAC::_toggleTASym {name1 name2 ops} {
variable vals
variable widgets
if {!$vals(target_type:types) && !$vals(target_type:attribs)} {
return
}
if {$vals(target_type:types) && $vals(target_type:attribs)} {
set items [lsort [concat [Apol_Types::getTypes] [Apol_Types::getAttributes]]]
} elseif {$vals(target_type:types)} {
set items [Apol_Types::getTypes]
} else {
set items [Apol_Types::getAttributes]
}
$widgets(trans:target) configure -values $items
}
proc Apol_RBAC::_toggleTAPushed {cb} {
variable vals
if {!$vals(target_type:types) && !$vals(target_type:attribs)} {
$cb select
}
}
proc Apol_RBAC::_ruleChanged {name1 name2 ops} {
variable vals
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
$widgets(options_pm) raise $vals(rule_selection)
}
proc Apol_RBAC::_searchRBACs {} {
variable vals
variable widgets
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
return
}
set raq {}
set rtq {}
if {$vals(rule_selection) == "allow" || $vals(rule_selection) == "both"} {
set raq [new_apol_role_allow_query_t]
}
if {$vals(rule_selection) == "trans" || $vals(rule_selection) == "both"} {
set rtq [new_apol_role_trans_query_t]
}
set source_sym {}
set is_any 0
if {$vals(source:use)} {
if {$vals(source:sym) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No source role selected."
return
}
if {$vals(source:which) == "either"} {
set is_any 1
}
set source_sym $vals(source:sym)
}
set target_role {}
set target_type {}
if {$vals(rule_selection) == "allow" && $vals(target_role:use) && \
(!$vals(source:use) || $vals(source:which) != "either")} {
if {$vals(target_role:sym) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No target role selected."
return
}
set target_role $vals(target_role:sym)
}
if {$vals(rule_selection) == "trans" && $vals(target_type:use)} {
if {$vals(target_type:sym) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No target type selected."
return
}
set target_type $vals(target_type:sym)
}
set default_role {}
if {$vals(rule_selection) == "trans" && $vals(default:use) && \
(!$vals(source:use) || $vals(source:which) != "either")} {
if {$vals(default:sym) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No default role selected."
return
}
set default_role $vals(default:sym)
}
set role_allows {}
if {$raq != {}} {
$raq set_source $::ApolTop::policy $source_sym
$raq set_source_any $::ApolTop::policy $is_any
$raq set_target $::ApolTop::policy $target_role
set v [$raq run $::ApolTop::policy]
$raq -acquire
$raq -delete
set role_allows [role_allow_vector_to_list $v]
$v -acquire
$v -delete
}
set role_trans {}
if {$rtq != {}} {
$rtq set_source $::ApolTop::policy $source_sym
$rtq set_source_any $::ApolTop::policy $is_any
$rtq set_target $::ApolTop::policy $target_type 0
$rtq set_default $::ApolTop::policy $default_role
set v [$rtq run $::ApolTop::policy]
$rtq -acquire
$rtq -delete
set role_trans [role_trans_vector_to_list $v]
$v -acquire
$v -delete
}
set num_results [expr {[llength $role_allows] + [llength $role_trans]}]
if {$num_results == 0} {
set text "Search returned no results."
} else {
set text "$num_results rule"
if {$num_results != 1} {
append text s
}
append text " match the search criteria.\n\n"
}
foreach r [lsort -command _role_allow_sort $role_allows] {
append text "[_render_role_allow $r]\n"
}
foreach r [lsort -command _role_trans_sort $role_trans] {
append text "[_render_role_trans $r]\n"
}
Apol_Widget::appendSearchResultText $widgets(results) $text
}
proc Apol_RBAC::_render_role_allow {qpol_role_allow_datum} {
apol_role_allow_render $::ApolTop::policy $qpol_role_allow_datum
}
proc Apol_RBAC::_render_role_trans {qpol_role_trans_datum} {
apol_role_trans_render $::ApolTop::policy $qpol_role_trans_datum
}
proc Apol_RBAC::_role_allow_sort {a b} {
set r1 [[$a get_source_role $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
set r2 [[$b get_source_role $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
if {[set z [string compare $r1 $r2]] != 0} {
return $z
}
set r1 [[$a get_target_role $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
set r2 [[$b get_target_role $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
string compare $r1 $r2
}
proc Apol_RBAC::_role_trans_sort {a b} {
set r1 [[$a get_source_role $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
set r2 [[$b get_source_role $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
if {[set z [string compare $r1 $r2]] != 0} {
return $z
}
set r1 [[$a get_target_type $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
set r2 [[$b get_target_type $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
string compare $r1 $r2
}
namespace eval Apol_Analysis_relabel {
variable vals
variable widgets
Apol_Analysis::registerAnalysis "Apol_Analysis_relabel" "Direct Relabel"
}
proc Apol_Analysis_relabel::create {options_frame} {
variable vals
variable widgets
_reinitializeVals
set mode_tf [TitleFrame $options_frame.mode -text "Mode"]
pack $mode_tf -side left -padx 2 -pady 2 -expand 0 -fill y
set object_mode [radiobutton [$mode_tf getframe].object \
-text "Object" -value "object" \
-variable Apol_Analysis_relabel::vals(mode)]
pack $object_mode -anchor w
set widgets(mode:to) [checkbutton [$mode_tf getframe].to \
-text "To" \
-variable Apol_Analysis_relabel::vals(mode:to)]
$widgets(mode:to) configure -command \
[list Apol_Analysis_relabel::_toggleToFromPushed $widgets(mode:to)]
set widgets(mode:from) [checkbutton [$mode_tf getframe].from \
-text "From" \
-variable Apol_Analysis_relabel::vals(mode:from)]
$widgets(mode:from) configure -command \
[list Apol_Analysis_relabel::_toggleToFromPushed $widgets(mode:from)]
pack $widgets(mode:to) $widgets(mode:from) -anchor w -padx 8
set subject_mode [radiobutton [$mode_tf getframe].subject \
-text "Subject" -value "subject" \
-variable Apol_Analysis_relabel::vals(mode)]
pack $subject_mode -anchor w -pady 4
trace add variable Apol_Analysis_relabel::vals(mode) write \
Apol_Analysis_relabel::_toggleModeSelected
set req_tf [TitleFrame $options_frame.req -text "Required Parameters"]
pack $req_tf -side left -padx 2 -pady 2 -expand 0 -fill y
set l [label [$req_tf getframe].l -textvariable Apol_Analysis_relabel::vals(type:label)]
pack $l -anchor w
set widgets(type) [Apol_Widget::makeTypeCombobox [$req_tf getframe].type]
pack $widgets(type)
set filter_tf [TitleFrame $options_frame.filter -text "Optional Result Filters"]
pack $filter_tf -side left -padx 2 -pady 2 -expand 1 -fill both
set advanced_f [frame [$filter_tf getframe].advanced]
pack $advanced_f -side left -anchor nw
set access_enable [checkbutton $advanced_f.enable -text "Use advanced filters" \
-variable Apol_Analysis_relabel::vals(advanced_enable)]
pack $access_enable -anchor w
set widgets(advanced) [button $advanced_f.adv -text "Advanced Filters" \
-command Apol_Analysis_relabel::_createAdvancedDialog \
-state disabled]
pack $widgets(advanced) -anchor w -padx 4
trace add variable Apol_Analysis_relabel::vals(advanced_enable) write \
Apol_Analysis_relabel::_toggleAdvancedSelected
set widgets(regexp) [Apol_Widget::makeRegexpEntry [$filter_tf getframe].end]
$widgets(regexp).cb configure -text "Filter result types using regular expression"
pack $widgets(regexp) -side left -anchor nw -padx 8
}
proc Apol_Analysis_relabel::open {} {
variable vals
variable widgets
Apol_Widget::resetTypeComboboxToPolicy $widgets(type)
set vals(classes:inc) {}
foreach class [Apol_Class_Perms::getClasses] {
set perms [Apol_Class_Perms::getPermsForClass $class]
if {[lsearch $perms "relabelto"] >= 0 && [lsearch $perms "relabelfrom"] >= 0} {
lappend vals(classes:inc) $class
}
}
set vals(subjects:inc) [Apol_Types::getTypes]
set vals(subjects:inc_all) $vals(subjects:inc)
}
proc Apol_Analysis_relabel::close {} {
variable widgets
_reinitializeVals
_reinitializeWidgets
Apol_Widget::clearTypeCombobox $widgets(type)
}
proc Apol_Analysis_relabel::getInfo {} {
return "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.
\nOBJECT MODE
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.
\nSUBJECT MODE
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.
\nOPTIONAL RESULT FILTERS
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."
}
proc Apol_Analysis_relabel::newAnalysis {} {
if {[set rt [_checkParams]] != {}} {
return $rt
}
set results [_analyze]
set f [_createResultsDisplay]
_renderResults $f $results
$results -delete
return {}
}
proc Apol_Analysis_relabel::updateAnalysis {f} {
if {[set rt [_checkParams]] != {}} {
return $rt
}
set results [_analyze]
_clearResultsDisplay $f
_renderResults $f $results
$results -acquire
$results -delete
return {}
}
proc Apol_Analysis_relabel::reset {} {
_reinitializeVals
_reinitializeWidgets
open
}
proc Apol_Analysis_relabel::switchTab {query_options} {
variable vals
variable widgets
array set vals $query_options
_reinitializeWidgets
}
proc Apol_Analysis_relabel::saveQuery {channel} {
variable vals
variable widgets
foreach {key value} [array get vals] {
if {$key != "classes:inc" && \
$key != "subjects:inc_all" && $key != "subjects:inc" && \
$key != "subjects:exc"} {
puts $channel "$key $value"
}
}
set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(type)]
puts $channel "type [lindex $type 0]"
puts $channel "type:attrib [lindex $type 1]"
set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
puts $channel "regexp:enable $use_regexp"
puts $channel "regexp $regexp"
}
proc Apol_Analysis_relabel::loadQuery {channel} {
variable vals
set classes_exc {}
set subjects_exc {}
while {[gets $channel line] >= 0} {
set line [string trim $line]
if {$line == {} || [string index $line 0] == "#"} {
continue
}
set key {}
set value {}
regexp -line -- {^(\S+)( (.+))?} $line -> key --> value
switch -- $key {
classes:exc {
set classes_exc $value
}
subjects:exc_all {
set subjects_exc $value
}
default {
set vals($key) $value
}
}
}
open
set vals(classes:exc) {}
foreach c $classes_exc {
set i [lsearch $vals(classes:inc) $c]
if {$i >= 0} {
lappend vals(classes:exc) $c
set vals(classes:inc) [lreplace $vals(classes:inc) $i $i]
}
}
set vals(classes:exc) [lsort $vals(classes:exc)]
set vals(subjects:exc_all) {}
set vals(subjects:exc) {}
foreach s $subjects_exc {
set i [lsearch $vals(subjects:inc_all) $s]
if {$i >= 0} {
lappend vals(subjects:exc_all) $s
lappend vals(subjects:exc) $s
set vals(subjects:inc_all) [lreplace $vals(subjects:inc_all) $i $i]
set i [lsearch $vals(subjects:inc) $s]
set vals(subjects:inc) [lreplace $vals(subjects:inc) $i $i]
}
}
set vals(subjects:exc_all) [lsort $vals(subjects:exc_all)]
set vals(subjects:exc) [lsort $vals(subjects:exc)]
_reinitializeWidgets
}
proc Apol_Analysis_relabel::getTextWidget {tab} {
return [$tab.right getframe].res.tb
}
proc Apol_Analysis_relabel::_reinitializeVals {} {
variable vals
array set vals {
mode object
mode:to 1
mode:from 0
type:label "Starting type"
type {} type:attrib {}
regexp:enable 0
regexp {}
advanced_enable 0
classes:inc {} classes:exc {}
subjects:inc {} subjects:inc_all {}
subjects:exc {} subjects:exc_all {}
subjects:attribenable 0 subjects:attrib {}
}
}
proc Apol_Analysis_relabel::_reinitializeWidgets {} {
variable vals
variable widgets
if {$vals(type:attrib) != {}} {
Apol_Widget::setTypeComboboxValue $widgets(type) [list $vals(type) $vals(type:attrib)]
} else {
Apol_Widget::setTypeComboboxValue $widgets(type) $vals(type)
}
Apol_Widget::setRegexpEntryValue $widgets(regexp) $vals(regexp:enable) $vals(regexp)
_updateTypeLabel
}
proc Apol_Analysis_relabel::_toggleModeSelected {name1 name2 op} {
variable vals
variable widgets
if {$vals(mode) == "object"} {
$widgets(mode:to) configure -state normal
$widgets(mode:from) configure -state normal
} else {
$widgets(mode:to) configure -state disabled
$widgets(mode:from) configure -state disabled
}
_updateTypeLabel
}
proc Apol_Analysis_relabel::_toggleToFromPushed {cb} {
variable vals
if {!$vals(mode:to) && !$vals(mode:from)} {
$cb select
}
_updateTypeLabel
}
proc Apol_Analysis_relabel::_updateTypeLabel {} {
variable vals
if {$vals(mode) == "subject"} {
set vals(type:label) "Subject"
} elseif {$vals(mode:to) && $vals(mode:from)} {
set vals(type:label) "Starting/ending type"
} elseif {$vals(mode:from)} {
set vals(type:label) "Ending type"
} else {
set vals(type:label) "Starting type"
}
}
proc Apol_Analysis_relabel::_toggleAdvancedSelected {name1 name2 op} {
variable vals
variable widgets
if {$vals(advanced_enable)} {
$widgets(advanced) configure -state normal
} else {
$widgets(advanced) configure -state disabled
}
}
proc Apol_Analysis_relabel::_createAdvancedDialog {} {
variable widgets
$widgets(advanced) configure -state disabled
destroy .relabel_analysis_adv
variable vals
set d [Dialog .relabel_analysis_adv -modal local -separator 1 -title "Direct Relabel Advanced Filters" -parent .]
$d add -text "Close"
set tf [TitleFrame [$d getframe].objs -text "Filter By Object Classes"]
pack $tf -side top -expand 1 -fill both -padx 2 -pady 4
_createAdvancedFilter [$tf getframe] "Object Classes" classes 0
set l [label [$tf getframe].l -text "Only showing object classes that have both 'relabelto' and 'relabelfrom' permissions."]
grid $l - - -padx 4 -pady 2
set tf [TitleFrame [$d getframe].types -text "Filter By Subject Types"]
pack $tf -side top -expand 1 -fill both -padx 2 -pady 4
if {$vals(mode) == "object"} {
_createAdvancedFilter [$tf getframe] "Subject Types" subjects 0
} else {
_createAdvancedFilter [$tf getframe] "Subject Types" subjects 1
}
set inc [$tf getframe].inc
set exc [$tf getframe].exc
set attrib [frame [$tf getframe].a]
grid $attrib - -
set attrib_enable [checkbutton $attrib.ae -anchor w \
-text "Filter by attribute" \
-variable Apol_Analysis_relabel::vals(subjects:attribenable)]
set attrib_box [ComboBox $attrib.ab -autopost 1 -entrybg white -width 16 \
-values $Apol_Types::attriblist \
-textvariable Apol_Analysis_relabel::vals(subjects:attrib)]
$attrib_enable configure -command \
[list Apol_Analysis_relabel::_attribEnabled $attrib_box]
trace remove variable Apol_Analysis_relabel::vals(subjects:attrib) write \
[list Apol_Analysis_relabel::_attribChanged]
trace add variable Apol_Analysis_relabel::vals(subjects:attrib) write \
[list Apol_Analysis_relabel::_attribChanged]
pack $attrib_enable -side top -expand 0 -fill x -anchor sw -padx 5 -pady 2
pack $attrib_box -side top -expand 1 -fill x -padx 10
_attribEnabled $attrib_box
if {$vals(mode) == "subject"} {
$attrib_enable configure -state disabled
$attrib_box configure -state disabled
}
$d draw
$widgets(advanced) configure -state normal
}
proc Apol_Analysis_relabel::_createAdvancedFilter {f title varname disabled} {
set l1 [label $f.l1 -text "Included $title"]
set l2 [label $f.l2 -text "Excluded $title"]
grid $l1 x $l2 -sticky w
set inc [Apol_Widget::makeScrolledListbox $f.inc -height 10 -width 24 \
-listvar Apol_Analysis_relabel::vals($varname:inc) \
-selectmode extended -exportselection 0]
set exc [Apol_Widget::makeScrolledListbox $f.exc -height 10 -width 24 \
-listvar Apol_Analysis_relabel::vals($varname:exc) \
-selectmode extended -exportselection 0]
set inc_lb [Apol_Widget::getScrolledListbox $inc]
set exc_lb [Apol_Widget::getScrolledListbox $exc]
set bb [ButtonBox $f.bb -homogeneous 1 -orient vertical -spacing 4]
$bb add -text "-->" -width 10 -command [list Apol_Analysis_relabel::_moveToExclude $varname $inc_lb $exc_lb]
$bb add -text "<--" -width 10 -command [list Apol_Analysis_relabel::_moveToInclude $varname $inc_lb $exc_lb]
grid $inc $bb $exc -sticky nsew
set inc_bb [ButtonBox $f.inc_bb -homogeneous 1 -spacing 4]
$inc_bb add -text "Select All" -command [list $inc_lb selection set 0 end]
$inc_bb add -text "Unselect" -command [list $inc_lb selection clear 0 end]
set exc_bb [ButtonBox $f.exc_bb -homogeneous 1 -spacing 4]
$exc_bb add -text "Select All" -command [list $exc_lb selection set 0 end]
$exc_bb add -text "Unselect" -command [list $exc_lb selection clear 0 end]
grid $inc_bb x $exc_bb -pady 4
grid columnconfigure $f 0 -weight 1 -uniform 0 -pad 2
grid columnconfigure $f 1 -weight 0 -pad 8
grid columnconfigure $f 2 -weight 1 -uniform 0 -pad 2
if {$disabled} {
foreach w [list $l1 $l2 $bb $inc_bb $exc_bb] {
$w configure -state disabled
}
Apol_Widget::setScrolledListboxState $inc disabled
Apol_Widget::setScrolledListboxState $exc disabled
}
}
proc Apol_Analysis_relabel::_moveToExclude {varname inc exc} {
variable vals
if {[set selection [$inc curselection]] == {}} {
return
}
foreach i $selection {
lappend perms [$inc get $i]
}
set vals($varname:exc) [lsort [concat $vals($varname:exc) $perms]]
if {$varname == "subjects"} {
set vals(subjects:exc_all) [lsort [concat $vals(subjects:exc_all) $perms]]
}
foreach p $perms {
set i [lsearch $vals($varname:inc) $p]
set vals($varname:inc) [lreplace $vals($varname:inc) $i $i]
if {$varname == "subjects"} {
set i [lsearch $vals(subjects:inc_all) $p]
set vals(subjects:inc_all) [lreplace $vals(subjects:inc_all) $i $i]
}
}
$inc selection clear 0 end
$exc selection clear 0 end
}
proc Apol_Analysis_relabel::_moveToInclude {varname inc exc} {
variable vals
if {[set selection [$exc curselection]] == {}} {
return
}
foreach i $selection {
lappend perms [$exc get $i]
}
set vals($varname:inc) [lsort [concat $vals($varname:inc) $perms]]
if {$varname == "subjects"} {
set vals(subjects:inc_all) [lsort [concat $vals(subjects:inc_all) $perms]]
}
foreach p $perms {
set i [lsearch $vals($varname:exc) $p]
set vals($varname:exc) [lreplace $vals($varname:exc) $i $i]
if {$varname == "subjects"} {
set i [lsearch $vals(subjects:exc_all) $p]
set vals(subjects:exc_all) [lreplace $vals(subjects:exc_all) $i $i]
}
}
$inc selection clear 0 end
$exc selection clear 0 end
}
proc Apol_Analysis_relabel::_attribEnabled {cb} {
variable vals
if {$vals(subjects:attribenable)} {
$cb configure -state normal
_filterTypeLists $vals(subjects:attrib)
} else {
$cb configure -state disabled
_filterTypeLists ""
}
}
proc Apol_Analysis_relabel::_attribChanged {name1 name2 op} {
variable vals
if {$vals(subjects:attribenable)} {
_filterTypeLists $vals(subjects:attrib)
}
}
proc Apol_Analysis_relabel::_filterTypeLists {attrib} {
variable vals
if {$attrib != {}} {
set typesList {}
if {[Apol_Types::isAttributeInPolicy $attrib]} {
set qpol_type_datum [new_qpol_type_t $::ApolTop::qpolicy $attrib]
set i [$qpol_type_datum get_type_iter $::ApolTop::qpolicy]
foreach t [iter_to_list $i] {
set t [qpol_type_from_void $t]
lappend typesList [$t get_name $::ApolTop::qpolicy]
}
$i -acquire
$i -delete
}
if {$typesList == {}} {
return
}
set vals(subjects:inc) {}
set vals(subjects:exc) {}
foreach t $typesList {
if {[lsearch $vals(subjects:inc_all) $t] >= 0} {
lappend vals(subjects:inc) $t
}
if {[lsearch $vals(subjects:exc_all) $t] >= 0} {
lappend vals(subjects:exc) $t
}
}
set vals(subjects:inc) [lsort $vals(subjects:inc)]
set vals(subjects:exc) [lsort $vals(subjects:exc)]
} else {
set vals(subjects:inc) $vals(subjects:inc_all)
set vals(subjects:exc) $vals(subjects:exc_all)
}
}
proc Apol_Analysis_relabel::_checkParams {} {
variable vals
variable widgets
if {![ApolTop::is_policy_open]} {
return "No current policy file is opened."
}
set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(type)]
if {[lindex $type 0] == {}} {
return "No type was selected."
}
if {![Apol_Types::isTypeInPolicy [lindex $type 0]]} {
return "[lindex $type 0] is not a type within the policy."
}
set vals(type) [lindex $type 0]
set vals(type:attrib) [lindex $type 1]
set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
if {$use_regexp && $regexp == {}} {
return "No regular expression provided."
}
set vals(regexp:enable) $use_regexp
set vals(regexp) $regexp
if {$vals(advanced_enable)} {
if {$vals(classes:inc) == {}} {
return "At least one object class must be included."
}
if {$vals(mode) == "object" && $vals(subjects:inc_all) == {}} {
return "At least one subject type must be included."
}
}
return {} ;# all parameters passed, now ready to do search
}
proc Apol_Analysis_relabel::_analyze {} {
variable vals
if {$vals(mode) == "object"} {
if {$vals(mode:to) && $vals(mode:from)} {
set mode $::APOL_RELABEL_DIR_BOTH
} elseif {$vals(mode:to)} {
set mode $::APOL_RELABEL_DIR_TO
} else {
set mode $::APOL_RELABEL_DIR_FROM
}
} else {
set mode $::APOL_RELABEL_DIR_SUBJECT
}
if {$vals(advanced_enable) && $vals(classes:exc) != {}} {
set classes $vals(classes:inc)
} else {
set classes {}
}
if {$vals(advanced_enable) && $vals(subjects:exc) != {}} {
set subjects $vals(subjects:inc)
} else {
set subjects {}
}
if {$vals(regexp:enable)} {
set regexp $vals(regexp)
} else {
set regexp {}
}
set q [new_apol_relabel_analysis_t]
$q set_dir $::ApolTop::policy $mode
$q set_type $::ApolTop::policy $vals(type)
foreach c $classes {
$q append_class $::ApolTop::policy $c
}
foreach s $subjects {
$q append_subject $::ApolTop::policy $s
}
$q set_result_regex $::ApolTop::policy $regexp
set results [$q run $::ApolTop::policy]
$q -acquire
$q -delete
return $results
}
proc Apol_Analysis_relabel::_createResultsDisplay {} {
variable vals
set f [Apol_Analysis::createResultTab "Relabel" [array get vals]]
if {$vals(mode) == "object"} {
if {$vals(mode:to) && $vals(mode:from)} {
set tree_title "Type $vals(type) relabels to/from"
} elseif {$vals(mode:to)} {
set tree_title "Type $vals(type) relabels to"
} else {
set tree_title "Type $vals(type) relabels from"
}
} else {
set tree_title "Subject $vals(type) relabels"
}
set tree_tf [TitleFrame $f.left -text $tree_title]
pack $tree_tf -side left -expand 0 -fill y -padx 2 -pady 2
set sw [ScrolledWindow [$tree_tf getframe].sw -auto both]
set tree [Tree [$sw getframe].tree -width 24 -redraw 1 -borderwidth 0 \
-highlightthickness 0 -showlines 1 -padx 0 -bg white]
$sw setwidget $tree
pack $sw -expand 1 -fill both
set res_tf [TitleFrame $f.right -text "Relabeling Results"]
pack $res_tf -side left -expand 1 -fill both -padx 2 -pady 2
set res [Apol_Widget::makeSearchResults [$res_tf getframe].res]
$res.tb tag configure title -font {Helvetica 14 bold}
$res.tb tag configure title_type -foreground blue -font {Helvetica 14 bold}
$res.tb tag configure num -font {Helvetica 12 bold}
$res.tb tag configure type_tag -foreground blue -font {Helvetica 12 bold}
pack $res -expand 1 -fill both
$tree configure -selectcommand [list Apol_Analysis_relabel::_treeSelect $res]
return $f
}
proc Apol_Analysis_relabel::_treeSelect {res tree node} {
if {$node != {}} {
$res.tb configure -state normal
$res.tb delete 0.0 end
set data [$tree itemcget $node -data]
if {[string index $node 0] == "o"} {
_renderResultsRuleObject $res $tree $node $data
} elseif {[string index $node 0] == "s"} {
_renderResultsRuleSubject $res $tree $node $data
} else {
eval $res.tb insert end $data
}
$res.tb configure -state disabled
}
}
proc Apol_Analysis_relabel::_clearResultsDisplay {f} {
variable vals
set tree [[$f.left getframe].sw getframe].tree
set res [$f.right getframe].res
$tree delete [$tree nodes root]
Apol_Widget::clearSearchResults $res
Apol_Analysis::setResultTabCriteria [array get vals]
}
proc Apol_Analysis_relabel::_renderResults {f results} {
variable vals
set tree [[$f.left getframe].sw getframe].tree
set res [$f.right getframe].res
$tree insert end root top -text $vals(type) -open 1 -drawcross auto
if {$vals(mode) == "object"} {
set top_text [_renderResultsObject $results $tree]
} else { ;# subject mode
set top_text [_renderResultsSubject $results $tree]
}
$tree itemconfigure top -data $top_text
$tree selection set top
$tree opentree top
$tree see top
}
proc Apol_Analysis_relabel::_result_type_sort {a b} {
set t1 [[$a get_result_type] get_name $::ApolTop::qpolicy]
set t2 [[$b get_result_type] get_name $::ApolTop::qpolicy]
string compare $t1 $t2
}
proc Apol_Analysis_relabel::_renderResultsObject {results tree} {
variable vals
if {$vals(mode:from) && $vals(mode:to)} {
set dir both
} elseif {$vals(mode:to)} {
set dir to
} else {
set dir from
}
foreach r [lsort -command _result_type_sort [relabel_result_vector_to_list $results]] {
set type [[$r get_result_type] get_name $::ApolTop::qpolicy]
set to [relabel_result_pair_vector_to_list [$r get_to]]
set from [relabel_result_pair_vector_to_list [$r get_from]]
set both [relabel_result_pair_vector_to_list [$r get_both]]
set pairs {}
foreach pair [concat $to $from $both] {
set intermed [[$pair get_intermediate_type] get_name $::ApolTop::qpolicy]
lappend pairs [list [$pair get_ruleA] [$pair get_ruleB] $intermed]
}
set pairs [lsort -unique $pairs]
$tree insert end top o:$dir:\#auto -text $type -data $pairs
}
set top_text [list "Direct Relabel Analysis: " title]
switch -- $dir {
both { lappend top_text "Starting/Ending Type: " title }
to { lappend top_text "Ending Type: " title }
from { lappend top_text "Starting Type: " title }
}
lappend top_text $vals(type) title_type \
"\n\n" title \
$vals(type) type_tag
if {[$results get_size]} {
switch -- $dir {
both { lappend top_text " can be relabeled to and from " {} }
to { lappend top_text " can be relabeled to " {} }
from { lappend top_text " can be relabeled from " {} }
}
lappend top_text [$results get_size] num \
" type(s).\n\n" {} \
"This tab provides the results of a Direct Relabel Analysis beginning\n" {}
switch -- $dir {
both { lappend top_text "with the starting/ending" {} }
to { lappend top_text "with the starting" {} }
from { lappend top_text "with the ending" {} }
}
lappend top_text " type above. The results of the analysis are\n" {} \
"presented in tree form with the root of the tree (this node) being the\n" {} \
"starting point for the analysis.\n\n" {} \
"Each child node in the tree represents a type in the current policy\n" {} \
"to/from which relabeling is allowed (depending on you selection\n" {} \
"above)." {}
} else {
switch -- $dir {
both { lappend top_text " cannot be relabeled to/from any type." {} }
to { lappend top_text " cannot be relabeled to any type." {} }
from { lappend top_text " cannot be relabeled from any type." {} }
}
}
}
proc Apol_Analysis_relabel::_renderResultsRuleObject {res tree node data} {
set header [list [$tree itemcget top -text] title_type]
lappend header " can be relabeled:\n" {}
eval $res.tb insert end $header
set dir [lindex [split $node :] 1]
set target_type [$tree itemcget $node -text]
foreach rule_pairs $data {
set class [[[lindex $rule_pairs 0] get_object_class $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
lappend classes($class) $rule_pairs
}
foreach key [lsort [array names classes]] {
$res.tb configure -state normal
$res.tb insert end "\n$key:\n" title
foreach rule_pairs [lsort -index 2 $classes($key)] {
foreach {a_rule b_rule intermed} $rule_pairs {break}
if {$dir == "to" || $dir == "from"} {
set dir_string $dir
} else {
set i [$a_rule get_perm_iter $::ApolTop::qpolicy]
set a_perms [iter_to_str_list $i]
$i -acquire
$i -delete
set i [$b_rule get_perm_iter $::ApolTop::qpolicy]
set b_perms [iter_to_str_list $i]
$i -acquire
$i -delete
if {[lsearch $a_perms "relabelto"] >= 0 && \
[lsearch $a_perms "relabelfrom"] >= 0 && \
[lsearch $b_perms "relabelto"] >= 0 && \
[lsearch $b_perms "relabelfrom"] >= 0} {
set dir_string "to and from"
} elseif {[lsearch $a_perms "relabelto"] >= 0 &&
[lsearch $b_perms "relabelfrom"] >= 0} {
set dir_string "to"
} else {
set dir_string "from"
}
}
$res.tb configure -state normal
$res.tb insert end "\n $dir_string " num \
$target_type type_tag \
" by " {} \
$intermed type_tag \
"\n" {}
set v [new_apol_vector_t]
$v append $a_rule
Apol_Widget::appendSearchResultRules $res 6 $v qpol_avrule_from_void
$v -acquire
$v -delete
if {$a_rule != $b_rule} {
set v [new_apol_vector_t]
$v append $b_rule
Apol_Widget::appendSearchResultRules $res 6 $v qpol_avrule_from_void
$v -acquire
$v -delete
}
}
}
}
proc Apol_Analysis_relabel::_renderResultsSubject {results tree} {
variable vals
set to_count 0
set from_count 0
foreach r [relabel_result_vector_to_list $results] {
set type [[$r get_result_type] get_name $::ApolTop::qpolicy]
set to [relabel_result_pair_vector_to_list [$r get_to]]
set from [relabel_result_pair_vector_to_list [$r get_from]]
set both [relabel_result_pair_vector_to_list [$r get_both]]
foreach pair [concat $to $both] {
lappend to_types($type) [$pair get_ruleA]
}
foreach pair [concat $from $both] {
lappend from_types($type) [$pair get_ruleA]
}
}
set to_count [llength [array names to_types]]
if {$to_count} {
set to_text [list $vals(type) title_type " can relabel to " {} ]
lappend to_text $to_count num \
" type(s). Open the subtree of this item to view the list of types." {}
$tree insert end top to -text "To" -data $to_text -drawcross auto
foreach type [lsort [array names to_types]] {
set rules [lsort -unique $to_types($type)]
$tree insert end to s\#auto -text $type -data [list to $rules]
}
}
set from_count [llength [array names from_types]]
if {$from_count} {
set from_text [list $vals(type) title_type " can relabel from " {} ]
lappend from_text $from_count num \
" type(s). Open the subtree of this item to view the list of types." {}
$tree insert end top from -text "From" -data $from_text -drawcross auto
foreach type [lsort [array names from_types]] {
set rules [lsort -unique $from_types($type)]
$tree insert end from s\#auto -text $type -data [list from $rules]
}
}
set top_text [list "Direct Relabel Analysis: Subject: " title]
lappend top_text $vals(type) title_type \
"\n\n" title \
$vals(type) type_tag
if {$to_count + $from_count} {
lappend top_text " can relabel to " {} \
$to_count num \
" type(s) and relabel from " {} \
$from_count num \
" type(s).\n\n" {} \
"This tab provides the results of a Direct Relabel Analysis for the\n" {} \
"subject above. The results of the analysis are presented in tree form\n" {} \
"with the root of the tree (this node) being the starting point for the\n" {} \
"analysis.\n\n" {} \
"Each child node in the To and From subtrees represents a type in the\n" {} \
"current policy which the chosen subject can relabel." {}
} else {
lappend top_text " does not relabel to or from any type as a subject." {}
}
}
proc Apol_Analysis_relabel::_renderResultsRuleSubject {res tree node data} {
foreach {dir rules} $data {break}
set header [list [$tree itemcget top -text] title_type]
lappend header " can relabel $dir " {} \
[$tree itemcget $node -text] title_type \
"\n\n" {}
eval $res.tb insert end $header
set v [new_apol_vector_t]
foreach r $rules {
$v append $r
}
Apol_Widget::appendSearchResultRules $res 0 $v qpol_avrule_from_void
$v -acquire
$v -delete
}
namespace eval Apol_Roles {
variable widgets
variable opts
variable role_list {}
}
proc Apol_Roles::create {tab_name nb} {
variable widgets
variable opts
_initializeVars
set frame [$nb insert end $tab_name -text "Roles"]
set pw [PanedWindow $frame.pw -side top]
set leftf [$pw add -weight 0]
set rightf [$pw add -weight 1]
pack $pw -fill both -expand yes
set rolebox [TitleFrame $leftf.rolebox -text "Roles"]
set s_optionsbox [TitleFrame $rightf.obox -text "Search Options"]
set resultsbox [TitleFrame $rightf.rbox -text "Search Results"]
pack $rolebox -fill both -expand yes
pack $s_optionsbox -padx 2 -fill both -expand 0
pack $resultsbox -padx 2 -fill both -expand yes
set rlistbox [Apol_Widget::makeScrolledListbox [$rolebox getframe].lb \
-width 20 -listvar Apol_Roles::role_list]
Apol_Widget::setListboxCallbacks $rlistbox \
{{"Display Role Info" {Apol_Roles::_popupRoleInfo role}}}
pack $rlistbox -fill both -expand yes
set ofm [$s_optionsbox getframe]
set lfm [frame $ofm.to]
set cfm [frame $ofm.co]
pack $lfm $cfm -side left -anchor nw -padx 4 -pady 2
radiobutton $lfm.all_info -text "All information" \
-variable Apol_Roles::opts(showSelection) -value all
radiobutton $lfm.names_only -text "Names only" \
-variable Apol_Roles::opts(showSelection) -value names
pack $lfm.all_info $lfm.names_only -anchor w -padx 5 -pady 4
set cb_type [checkbutton $cfm.cb -variable Apol_Roles::opts(useType) -text "Type"]
set widgets(combo_types) [Apol_Widget::makeTypeCombobox $cfm.combo_types]
Apol_Widget::setTypeComboboxState $widgets(combo_types) disabled
trace add variable Apol_Roles::opts(useType) write \
[list Apol_Roles::_toggleTypeCombobox $widgets(combo_types)]
pack $cb_type -anchor w
pack $widgets(combo_types) -anchor w -padx 4
button $ofm.ok -text OK -width 6 -command Apol_Roles::_searchRoles
pack $ofm.ok -side top -anchor e -pady 5 -padx 5
set widgets(results) [Apol_Widget::makeSearchResults [$resultsbox getframe].sw]
pack $widgets(results) -expand 1 -fill both
return $frame
}
proc Apol_Roles::open {ppath} {
set q [new_apol_role_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
variable role_list [lsort [role_vector_to_list $v]]
$v -acquire
$v -delete
variable widgets
Apol_Widget::resetTypeComboboxToPolicy $widgets(combo_types)
}
proc Apol_Roles::close {} {
variable widgets
variable opts
variable role_list {}
_initializeVars
Apol_Widget::clearTypeCombobox $widgets(combo_types)
Apol_Widget::clearSearchResults $widgets(results)
}
proc Apol_Roles::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_Roles::getRoles {} {
variable role_list
set role_list
}
proc Apol_Roles::_initializeVars {} {
variable opts
array set opts {
useType 0
showSelection all
}
}
proc Apol_Roles::_toggleTypeCombobox {path name1 name2 op} {
Apol_Widget::setTypeComboboxState $path $Apol_Roles::opts(useType)
}
proc Apol_Roles::_popupRoleInfo {which role} {
Apol_Widget::showPopupText $role [_renderRole $role 1]
}
proc Apol_Roles::_searchRoles {} {
variable widgets
variable opts
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
return
}
if {$opts(useType)} {
set type [lindex [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(combo_types)] 0]
if {$type == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No type selected."
return
}
} else {
set type {}
}
if {$opts(showSelection) == "names"} {
set show_all 0
} else {
set show_all 1
}
set q [new_apol_role_query_t]
$q set_type $::ApolTop::policy $type
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set roles_data [role_vector_to_list $v]
$v -acquire
$v -delete
set text "ROLES:\n"
if {[llength $roles_data] == 0} {
append text "Search returned no results."
} else {
foreach r [lsort $roles_data] {
append text "\n[_renderRole $r $show_all]"
}
}
Apol_Widget::appendSearchResultText $widgets(results) $text
}
proc Apol_Roles::_renderRole {role_name show_all} {
set qpol_role_datum [new_qpol_role_t $::ApolTop::qpolicy $role_name]
if {!$show_all} {
return $role_name
}
set i [$qpol_role_datum get_type_iter $::ApolTop::qpolicy]
set types {}
while {![$i end]} {
set qpol_type_datum [qpol_type_from_void [$i get_item]]
lappend types [$qpol_type_datum get_name $::ApolTop::qpolicy]
$i next
}
$i -acquire
$i -delete
set text "$role_name ([llength $types] type"
if {[llength $types] != 1} {
append text "s"
}
append text ")\n"
foreach t [lsort -dictionary $types] {
append text " $t\n"
}
return $text
}
namespace eval Apol_TE {
variable vals
variable widgets
variable tabs
variable enabled
}
proc Apol_TE::create {tab_name nb} {
variable vals
variable widgets
_initializeVars
set frame [$nb insert end $tab_name -text "TE Rules"]
set pw [PanedWindow $frame.pw -side left -weights extra]
set topf [$pw add -weight 0]
set bottomf [$pw add -weight 1]
pack $pw -expand 1 -fill both
set top_leftf [frame $topf.tl]
set widgets(search_opts) [NoteBook $topf.nb]
set abox [frame $topf.abox]
pack $top_leftf -side left -expand 0 -fill y
pack $widgets(search_opts) -side left -expand 1 -fill both -padx 10
pack $abox -side right -fill y -padx 5
set rsbox [TitleFrame $top_leftf.rsbox -text "Rule Selection"]
set oobox [TitleFrame $top_leftf.oobox -text "Search Options"]
set rbox [TitleFrame $bottomf.rbox -text "Type Enforcement Rules Display"]
pack $rsbox -side top -expand 0 -fill both
pack $oobox -side top -expand 1 -fill both -pady 2
pack $rbox -expand yes -fill both -padx 2
set fm_rules [$rsbox getframe]
set allow [checkbutton $fm_rules.allow -text "allow" \
-onvalue $::QPOL_RULE_ALLOW -offvalue 0 \
-variable Apol_TE::vals(rs:avrule_allow)]
set neverallow [checkbutton $fm_rules.neverallow -text "neverallow" \
-onvalue $::QPOL_RULE_NEVERALLOW -offvalue 0 \
-variable Apol_TE::vals(rs:avrule_neverallow)]
set auditallow [checkbutton $fm_rules.auditallow -text "auditallow" \
-onvalue $::QPOL_RULE_AUDITALLOW -offvalue 0 \
-variable Apol_TE::vals(rs:avrule_auditallow)]
set dontaudit [checkbutton $fm_rules.dontaudit -text "dontaudit" \
-onvalue $::QPOL_RULE_DONTAUDIT -offvalue 0 \
-variable Apol_TE::vals(rs:avrule_dontaudit)]
set type_transition [checkbutton $fm_rules.type_transition -text "type_trans" \
-onvalue $::QPOL_RULE_TYPE_TRANS -offvalue 0 \
-variable Apol_TE::vals(rs:type_transition)]
set type_member [checkbutton $fm_rules.type_member -text "type_member" \
-onvalue $::QPOL_RULE_TYPE_MEMBER -offvalue 0 \
-variable Apol_TE::vals(rs:type_member)]
set type_change [checkbutton $fm_rules.type_change -text "type_change" \
-onvalue $::QPOL_RULE_TYPE_CHANGE -offvalue 0 \
-variable Apol_TE::vals(rs:type_change)]
grid $allow $type_transition -sticky w -padx 2
grid $auditallow $type_member -sticky w -padx 2
grid $dontaudit $type_change -sticky w -padx 2
grid $neverallow x -sticky w -padx 2
foreach x {allow neverallow auditallow dontaudit type_transition type_member type_change} {
trace add variable Apol_TE::vals(rs:$x) write \
[list Apol_TE::_toggle_rule_selection]
}
set fm_options [$oobox getframe]
set enabled [checkbutton $fm_options.enabled -text "Search only enabled rules" \
-variable Apol_TE::vals(oo:enabled)]
set regexp [checkbutton $fm_options.regex -text "Search using regular expression" \
-variable Apol_TE::vals(oo:regexp)]
pack $enabled $regexp -expand 0 -fill none -anchor w
_createTypesAttribsTab
_createClassesPermsTab
_createFilenameTab
set widgets(new) [button $abox.new -text "New Search" -width 12 \
-command [list Apol_TE::_search_terules new]]
set widgets(update) [button $abox.update -text "Update Search" -width 12 -state disabled \
-command [list Apol_TE::_search_terules update]]
set widgets(reset) [button $abox.reset -text "Reset Criteria" -width 12 \
-command Apol_TE::_reset]
pack $widgets(new) $widgets(update) $widgets(reset) \
-side top -pady 5 -padx 5 -anchor ne
$widgets(search_opts) compute_size
set popupTab_Menu [menu .popup_terules -tearoff 0]
set tab_menu_callbacks \
[list {"Close Tab" Apol_TE::_delete_results} \
{"Rename Tab" Apol_TE::_display_rename_tab_dialog}]
set widgets(results) [NoteBook [$rbox getframe].results]
$widgets(results) bindtabs <Button-1> Apol_TE::_switch_to_tab
$widgets(results) bindtabs <Button-3> \
[list ApolTop::popup \
%W %x %y $popupTab_Menu $tab_menu_callbacks]
set close [button [$rbox getframe].close -text "Close Tab" \
-command Apol_TE::_delete_current_results]
pack $widgets(results) -expand 1 -fill both -padx 4
pack $close -expand 0 -fill x -padx 4 -pady 2
_initializeVars
return $frame
}
proc Apol_TE::open {ppath} {
_initializeVars
_initializeWidgets
_initializeTabs
variable vals
variable enabled
set vals(cp:classes) [Apol_Class_Perms::getClasses]
set enabled(cp:classes) 1
set enabled(cp:perms) 1
set vals(ta:use_filename) 0
}
proc Apol_TE::close {} {
_initializeTabs
_initializeWidgets
_initializeVars
set enabled(cp:perms) 1
}
proc Apol_TE::getTextWidget {} {
variable widgets
variable tabs
if {[$widgets(results) pages] != {}} {
set raisedPage [$widgets(results) raise]
if {$raisedPage != {}} {
return $tabs($raisedPage).tb
}
}
return {}
}
proc Apol_TE::save_query_options {file_channel query_file} {
variable vals
foreach {key value} [array get vals] {
if {$key != "cp:classes" && $key != "cp:perms"} {
puts $file_channel "$key $value"
}
}
}
proc Apol_TE::load_query_options {file_channel} {
variable vals
variable widgets
variable enabled
_initializeVars
set classes_selected {}
set perms_selected {}
while {[gets $file_channel line] >= 0} {
set line [string trim $line]
if {$line == {} || [string index $line 0] == "#"} {
continue
}
regexp -line -- {^(\S+)( (.+))?} $line -> key --> value
if {$key == "cp:classes_selected"} {
set classes_selected $value
} elseif {$key == "cp:perms_selected"} {
set perms_selected $value
} else {
set vals($key) $value
}
}
_initializeWidgets
set vals(cp:classes) [Apol_Class_Perms::getClasses]
set enabled(cp:classes) 1
set enabled(cp:perms) 1
_toggle_perms_toshow -> -> reset
set unknowns {}
set vals(cp:classes_selected) {}
foreach class $classes_selected {
if {[set i [lsearch $vals(cp:classes) $class]] >= 0} {
$widgets(cp:classes) selection set $i
lappend vals(cp:classes_selected) $class
} else {
lappend unknowns $class
}
}
if {[llength $unknowns] > 0} {
tk_messageBox -icon warning -type ok -title "Open Apol Query" \
-message "The following object classes do not exist in the currently loaded policy and were ignored:\n\n[join $unknowns ", "]" \
-parent .
}
_toggle_perms_toshow {} {} {}
set unknowns {}
set vals(cp:perms_selected) {}
foreach perm $perms_selected {
if {[set i [lsearch $vals(cp:perms) $perm]] >= 0} {
$widgets(cp:perms) selection set $i
lappend vals(cp:perms_selected) $perm
} else {
lappend unknowns $perm
}
}
if {[llength $unknowns] > 0} {
tk_messageBox -icon warning -type ok -title "Open Apol Query" \
-message "The following permissions do not exist in the currently loaded policy and were ignored:\n\n[join $unknowns ", "]" \
-parent $parentDlg
}
}
proc Apol_TE::_initializeVars {} {
variable vals
array set vals [list \
rs:avrule_allow $::QPOL_RULE_ALLOW \
rs:avrule_neverallow 0 \
rs:avrule_auditallow $::QPOL_RULE_AUDITALLOW \
rs:avrule_dontaudit $::QPOL_RULE_DONTAUDIT \
rs:type_transition $::QPOL_RULE_TYPE_TRANS \
rs:type_member $::QPOL_RULE_TYPE_MEMBER \
rs:type_change $::QPOL_RULE_TYPE_CHANGE \
ta:source_sym,types $::APOL_QUERY_SYMBOL_IS_TYPE \
ta:target_sym,types $::APOL_QUERY_SYMBOL_IS_TYPE \
ta:default_sym,types $::APOL_QUERY_SYMBOL_IS_TYPE \
ta:filename,files 1 \
]
array set vals {
oo:enabled 0
oo:regexp 0
ta:use_source 0
ta:source_indirect 1
ta:source_which source
ta:source_sym,attribs 0
ta:source_sym {}
ta:use_target 0
ta:target_indirect 1
ta:target_sym,attribs 0
ta:target_sym {}
ta:use_default 0
ta:default_sym,attribs 0
ta:default_sym {}
ta:use_filename 0
ta:filename {}
ta:filename,files 0
cp:classes {}
cp:classes_selected {}
cp:perms {}
cp:perms_selected {}
cp:perms_toshow all
cp:perms_matchall 0
}
variable enabled
array set enabled {
ta:use_source 1
ta:use_target 1
ta:use_default 1
ta:use_filename 1
cp:classes 0
cp:perms 0
}
}
proc Apol_TE::_initializeTabs {} {
variable widgets
variable tabs
array set tabs {
next_result_id 1
}
foreach p [$widgets(results) pages 0 end] {
_delete_results $p
}
}
proc Apol_TE::_initializeWidgets {} {
variable widgets
$widgets(search_opts) raise typeattrib
$widgets(cp:classes) selection clear 0 end
$widgets(cp:perms) selection clear 0 end
}
proc Apol_TE::_createTypesAttribsTab {} {
variable vals
variable widgets
variable enabled
set ta_tab [$widgets(search_opts) insert end typeattrib -text "Types/Attributes"]
set fm_source [frame $ta_tab.source]
set fm_target [frame $ta_tab.target]
set fm_default [frame $ta_tab.default]
grid $fm_source $fm_target $fm_default -padx 4 -sticky ewns
foreach i {0 1 2} {
grid columnconfigure $ta_tab $i -weight 1 -uniform 1
}
grid rowconfigure $ta_tab 0 -weight 1
_create_ta_box source $fm_source "Source type/attribute" 1 1 1
_create_ta_box target $fm_target "Target type/attribute" 1 0 1
_create_ta_box default $fm_default "Default type" 0 0 0
$widgets(search_opts) raise typeattrib
}
proc Apol_TE::_create_ta_box {prefix f title has_indirect has_which has_attribs} {
variable vals
variable widgets
set widgets(ta:use_${prefix}) [checkbutton $f.use -text $title \
-variable Apol_TE::vals(ta:use_${prefix})]
pack $widgets(ta:use_${prefix}) -side top -anchor w
trace add variable Apol_TE::vals(ta:use_${prefix}) write \
[list Apol_TE::_toggle_ta_box $prefix]
set w {}
if {$has_attribs} {
set helptext "Type or select a type or attribute"
} else {
set helptext "Type or select a type"
}
set widgets(ta:${prefix}_sym) [ComboBox $f.sym \
-state disabled -entrybg $ApolTop::default_bg_color \
-textvariable Apol_TE::vals(ta:${prefix}_sym) \
-helptext $helptext -autopost 1]
pack $widgets(ta:${prefix}_sym) -expand 0 -fill x -padx 8
lappend w $widgets(ta:${prefix}_sym)
if {$has_attribs} {
set ta_frame [frame $f.ta]
pack $ta_frame -expand 0 -anchor center -pady 2
set types [checkbutton $ta_frame.types -text "Types" -state disabled \
-onvalue $::APOL_QUERY_SYMBOL_IS_TYPE -offvalue 0 \
-variable Apol_TE::vals(ta:${prefix}_sym,types)]
set attribs [checkbutton $ta_frame.attribs -text "Attribs" -state disabled \
-onvalue $::APOL_QUERY_SYMBOL_IS_ATTRIBUTE -offvalue 0 \
-variable Apol_TE::vals(ta:${prefix}_sym,attribs)]
$types configure -command [list Apol_TE::_toggle_ta_pushed $prefix $types]
$attribs configure -command [list Apol_TE::_toggle_ta_pushed $prefix $attribs]
trace add variable Apol_TE::vals(ta:${prefix}_sym,attribs) write \
[list Apol_TE::_toggle_ta_sym $prefix]
pack $types $attribs -side left -padx 2
lappend w $types $attribs
}
if {$has_indirect} {
set indirect [checkbutton $f.indirect -text "Only direct matches" \
-state disabled -variable Apol_TE::vals(ta:${prefix}_indirect) \
-onvalue 0 -offvalue 1]
pack $indirect -anchor w -padx 8
lappend w $indirect
}
if {$has_which} {
set which_fm [frame $f.which]
set which_source [radiobutton $which_fm.source \
-text "As source" -state disabled \
-variable Apol_TE::vals(ta:${prefix}_which) \
-value source]
set which_any [radiobutton $which_fm.any \
-text "Any" -state disabled \
-variable Apol_TE::vals(ta:${prefix}_which) \
-value either]
trace add variable Apol_TE::vals(ta:${prefix}_which) write \
[list Apol_TE::_toggle_which]
pack $which_source $which_any -side left -padx 2
pack $which_fm -anchor w -padx 6
lappend w $which_source $which_any
}
trace add variable Apol_TE::vals(ta:${prefix}_sym,types) write \
[list Apol_TE::_toggle_ta_sym $prefix]
set widgets(ta:${prefix}_widgets) $w
trace add variable Apol_TE::enabled(ta:use_${prefix}) write \
[list Apol_TE::_toggle_enable_ta ${prefix}]
}
proc Apol_TE::_toggle_rule_selection {name1 name2 op} {
_maybe_enable_default_type
_maybe_enable_perms
}
proc Apol_TE::_toggle_ta_box {col name1 name2 op} {
variable vals
variable enabled
if {$col == "source"} {
_maybe_enable_target_type
_maybe_enable_default_type
}
set enabled(ta:use_${col}) $enabled(ta:use_${col})
}
proc Apol_TE::_toggle_which {name1 name2 op} {
_maybe_enable_target_type
_maybe_enable_default_type
}
proc Apol_TE::_maybe_enable_target_type {} {
variable vals
variable enabled
set any_set 0
if {$enabled(ta:use_source) && $vals(ta:use_source) && $vals(ta:source_which) == "either"} {
set any_set 1
}
if {!$any_set} {
set enabled(ta:use_target) 1
} else {
set enabled(ta:use_target) 0
}
}
proc Apol_TE::_maybe_enable_default_type {} {
variable vals
variable enabled
set typerule_set 0
set any_set 0
foreach x {type_transition type_member type_change} {
if {$vals(rs:$x)} {
set typerule_set 1
break
}
}
if {$enabled(ta:use_source) && $vals(ta:use_source) && $vals(ta:source_which) == "either"} {
set any_set 1
}
if {$typerule_set && !$any_set} {
set enabled(ta:use_default) 1
} else {
set enabled(ta:use_default) 0
}
}
proc Apol_TE::_toggle_enable_ta {col name1 name2 op} {
variable vals
variable widgets
variable enabled
if {$enabled(ta:use_${col})} {
$widgets(ta:use_${col}) configure -state normal
} else {
$widgets(ta:use_${col}) configure -state disabled
}
if {$enabled(ta:use_${col}) && $vals(ta:use_${col})} {
foreach w $widgets(ta:${col}_widgets) {
$w configure -state normal
}
$widgets(ta:${col}_sym) configure -entrybg white
} else {
foreach w $widgets(ta:${col}_widgets) {
$w configure -state disabled
}
$widgets(ta:${col}_sym) configure -entrybg $ApolTop::default_bg_color
}
if {($enabled(ta:use_source) && $vals(ta:use_source)) || \
($enabled(ta:use_target) && $vals(ta:use_target)) || \
($enabled(ta:use_default) && $vals(ta:use_default))} {
$widgets(search_opts) itemconfigure typeattrib -text "Types/Attributes *"
} else {
$widgets(search_opts) itemconfigure typeattrib -text "Types/Attributes"
}
}
proc Apol_TE::_toggle_ta_sym {col name1 name2 op} {
variable vals
variable widgets
if {!$vals(ta:${col}_sym,types) && !$vals(ta:${col}_sym,attribs)} {
return
}
if {$vals(ta:${col}_sym,types) && $vals(ta:${col}_sym,attribs)} {
set items [lsort [concat [Apol_Types::getTypes] [Apol_Types::getAttributes]]]
} elseif {$vals(ta:${col}_sym,types)} {
set items [Apol_Types::getTypes]
} else {
set items [Apol_Types::getAttributes]
}
$widgets(ta:${col}_sym) configure -values $items
}
proc Apol_TE::_toggle_ta_pushed {col cb} {
variable vals
if {!$vals(ta:${col}_sym,types) && !$vals(ta:${col}_sym,attribs)} {
$cb select
}
}
proc Apol_TE::_createFilenameTab {} {
variable vals
variable widgets
variable enabled
set fn_tab [$widgets(search_opts) insert end filename -text "Filename"]
set fm_filename [frame $fn_tab.filename]
grid $fm_filename -padx 4 -sticky ewns
foreach i {0 1 2} {
grid columnconfigure $fn_tab $i -weight 1 -uniform 1
}
grid rowconfigure $fn_tab 0 -weight 1
set widgets(ta:use_filename) [checkbutton $fm_filename.use -text "type_transition filename" \
-onvalue 1 -offvalue 0 -variable Apol_TE::vals(ta:use_filename)]
pack $widgets(ta:use_filename) -side top -anchor w
trace add variable Apol_TE::vals(ta:use_filename) write \
[list Apol_TE::_toggle_fn_box filename]
set w {}
set helptext "Select a filename - Note: no search using regular expr"
set widgets(ta:filename_sym) [ComboBox $fm_filename.sym \
-state normal -entrybg $ApolTop::default_bg_color \
-textvariable Apol_TE::vals(ta:filename_sym) \
-helptext $helptext -autopost 1]
pack $widgets(ta:filename_sym) -expand 0 -fill x -padx 8
lappend w $widgets(ta:filename_sym)
set widgets(ta:filename_widgets) $w
trace add variable Apol_TE::enabled(ta:use_filename) write \
[list Apol_TE::_maybe_enable_filename filename]
trace add variable Apol_TE::vals(ta:filename,files) write \
[list Apol_TE::_toggle_FileNames filename]
}
proc Apol_TE::_toggle_fn_box {col name1 name2 op} {
variable vals
variable enabled
variable widgets
if {$enabled(ta:use_${col})} {
$widgets(ta:use_${col}) configure -state normal
} else {
$widgets(ta:use_${col}) configure -state disabled
}
if {$enabled(ta:use_${col}) && $vals(ta:use_${col})} {
foreach w $widgets(ta:${col}_widgets) {
$w configure -state normal
}
$widgets(ta:${col}_sym) configure -entrybg white
} else {
foreach w $widgets(ta:${col}_widgets) {
$w configure -state disabled
}
$widgets(ta:${col}_sym) configure -entrybg $ApolTop::default_bg_color
}
if {($enabled(ta:use_${col}) && $vals(ta:use_${col}))} { \
$widgets(search_opts) itemconfigure filename -text "Filename *"
} else {
$widgets(search_opts) itemconfigure filename -text "Filename"
}
}
proc Apol_TE::_maybe_enable_filename {col name1 name2 op} {
variable vals
variable enabled
variable widgets
set typerule_set 0
foreach x {type_transition} {
if {$vals(rs:$x)} {
set typerule_set 1
break
}
}
if {$typerule_set && [ApolTop::is_capable "filename_trans"]} {
set enabled(ta:use_filename) 1
} else {
set enabled(ta:use_filename) 0
}
set enabled(ta:use_${col}) $enabled(ta:use_${col})
}
proc Apol_TE::_toggle_FileNames {col name1 name2 op} {
variable vals
variable widgets
variable enabled
if {![ApolTop::is_policy_open]} {
return
}
set items [lsort -unique -dictionary [Apol_TE::Get_FileNames]]
$widgets(ta:${col}_sym) configure -values $items
}
proc Apol_TE::Get_FileNames {} {
set filenames {}
set q [new_apol_filename_trans_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_filename_trans_from_void [$v get_element $i]]
lappend filenames [$q get_filename $::ApolTop::qpolicy]
}
}
return $filenames
}
proc Apol_TE::appendFilenameSearchResultRules {path indent rule_list cast filename} {
set curstate [$path.tb cget -state]
$path.tb configure -state normal
variable enabled
variable vals
set num_rules 0
if { $vals(ta:use_filename) == 0} {
set filename ""
}
for {set i 0} {$i < [$rule_list get_size]} {incr i} {
set rule [$cast [$rule_list get_element $i]]
if {$filename == "" || [$rule get_filename $::ApolTop::qpolicy] == $filename} {
$path.tb insert end [string repeat " " $indent]
$path.tb insert end [apol_filename_trans_render $::ApolTop::policy $rule]
incr num_rules
$path.tb insert end "\n"
}
}
$path.tb configure -state $curstate
list $num_rules $num_rules 0
}
proc Apol_TE::_createClassesPermsTab {} {
variable vals
variable widgets
variable enabled
set objects_tab [$widgets(search_opts) insert end classperms -text "Classes/Permissions"]
set fm_objs [TitleFrame $objects_tab.objs -text "Object Classes"]
set fm_perms [TitleFrame $objects_tab.perms -text "AV Rule Permissions"]
pack $fm_objs -side left -expand 0 -fill both -padx 2 -pady 2
pack $fm_perms -side left -expand 1 -fill both -padx 2 -pady 2
set sw [ScrolledWindow [$fm_objs getframe].sw -auto both]
set widgets(cp:classes) [listbox [$sw getframe].lb -height 5 -width 24 \
-highlightthickness 0 -selectmode multiple \
-exportselection 0 -state disabled \
-bg $ApolTop::default_bg_color \
-listvar Apol_TE::vals(cp:classes)]
$sw setwidget $widgets(cp:classes)
update
grid propagate $sw 0
bind $widgets(cp:classes) <<ListboxSelect>> \
[list Apol_TE::_toggle_cp_select classes]
pack $sw -expand 1 -fill both
set clear [button [$fm_objs getframe].b -text "Clear" -width 6 -state disabled \
-command [list Apol_TE::_clear_cp_listbox $widgets(cp:classes) classes]]
pack $clear -expand 0 -pady 2
set widgets(cp:classes_widgets) [list $widgets(cp:classes) $clear]
set f [$fm_perms getframe]
set sw [ScrolledWindow $f.sw -auto both]
set widgets(cp:perms) [listbox [$sw getframe].lb -height 5 -width 24 \
-highlightthickness 0 -selectmode multiple \
-exportselection 0 -bg white \
-listvar Apol_TE::vals(cp:perms)]
$sw setwidget $widgets(cp:perms)
update
grid propagate $sw 0
bind $widgets(cp:perms) <<ListboxSelect>> \
[list Apol_TE::_toggle_cp_select perms]
set clear [button $f.clear -text "Clear" \
-command [list Apol_TE::_clear_cp_listbox $widgets(cp:perms) perms]]
set reverse [button $f.reverse -text "Reverse" \
-command [list Apol_TE::_reverse_cp_listbox $widgets(cp:perms)]]
set perm_opts_f [frame $f.perms]
set perm_rb_f [frame $perm_opts_f.rb]
set l [label $perm_rb_f.l -text "Permissions to show:" -state disabled]
set all [radiobutton $perm_rb_f.all -text "All" \
-variable Apol_TE::vals(cp:perms_toshow) -value all]
set union [radiobutton $perm_rb_f.union -text "All for selected classes" \
-variable Apol_TE::vals(cp:perms_toshow) -value union]
set intersect [radiobutton $perm_rb_f.inter -text "Common to selected classes" \
-variable Apol_TE::vals(cp:perms_toshow) -value intersect]
trace add variable Apol_TE::vals(cp:perms_toshow) write \
Apol_TE::_toggle_perms_toshow
pack $l $all $union $intersect -anchor w
set all_perms [checkbutton $perm_opts_f.all -text "AV rule must have all selected permissions" \
-variable Apol_TE::vals(cp:perms_matchall)]
pack $perm_rb_f $all_perms -anchor w -pady 4 -padx 4
grid $sw - $perm_opts_f -sticky nsw
grid $clear $reverse ^ -pady 2 -sticky ew
grid columnconfigure $f 0 -weight 0 -uniform 1 -pad 2
grid columnconfigure $f 1 -weight 0 -uniform 1 -pad 2
grid columnconfigure $f 2 -weight 1
grid rowconfigure $f 0 -weight 1
set widgets(cp:perms_widgets) \
[list $widgets(cp:perms) $clear $reverse $l $all $union $intersect $all_perms]
trace add variable Apol_TE::vals(cp:classes_selected) write \
[list Apol_TE::_update_cp_tabname]
trace add variable Apol_TE::vals(cp:perms_selected) write \
[list Apol_TE::_update_cp_tabname]
trace add variable Apol_TE::enabled(cp:classes) write \
[list Apol_TE::_toggle_enable_cp classes]
trace add variable Apol_TE::enabled(cp:perms) write \
[list Apol_TE::_toggle_enable_cp perms]
}
proc Apol_TE::_toggle_enable_cp {prefix name1 name2 op} {
variable vals
variable widgets
variable enabled
if {$enabled(cp:${prefix})} {
foreach w $widgets(cp:${prefix}_widgets) {
$w configure -state normal
}
$widgets(cp:${prefix}) configure -bg white
} else {
foreach w $widgets(cp:${prefix}_widgets) {
$w configure -state disabled
}
$widgets(cp:${prefix}) configure -bg $ApolTop::default_bg_color
}
set vals(cp:${prefix}_selected) $vals(cp:${prefix}_selected)
}
proc Apol_TE::_maybe_enable_perms {} {
variable vals
variable enabled
set avrule_set 0
foreach x {avrule_allow avrule_neverallow avrule_auditallow avrule_dontaudit} {
if {$vals(rs:$x)} {
set avrule_set 1
break
}
}
if {$avrule_set} {
set enabled(cp:perms) 1
} else {
set enabled(cp:perms) 0
}
}
proc Apol_TE::_toggle_perms_toshow {name1 name2 op} {
variable vals
variable widgets
if {$vals(cp:perms_toshow) == "all"} {
if {$op != "update"} {
set vals(cp:perms) $Apol_Class_Perms::perms_list
set vals(cp:perms_selected) {}
}
} elseif {$vals(cp:perms_toshow) == "union"} {
set vals(cp:perms) {}
set vals(cp:perms_selected) {}
foreach class $vals(cp:classes_selected) {
set vals(cp:perms) [lsort -unique -dictionary [concat $vals(cp:perms) [Apol_Class_Perms::getPermsForClass $class]]]
}
} else { ;# intersection
set vals(cp:perms) {}
set vals(cp:perms_selected) {}
set classes {}
foreach i [$widgets(cp:classes) curselection] {
lappend classes [$widgets(cp:classes) get $i]
}
if {$classes == {}} {
return
}
set vals(cp:perms) [Apol_Class_Perms::getPermsForClass [lindex $classes 0]]
foreach class [lrange $classes 1 end] {
set this_perms [Apol_Class_Perms::getPermsForClass $class]
set new_perms {}
foreach p $vals(cp:perms) {
if {[lsearch -exact $this_perms $p] >= 0} {
lappend new_perms $p
}
}
set vals(cp:perms) $new_perms
}
}
}
proc Apol_TE::_toggle_cp_select {col} {
variable vals
variable widgets
set items {}
foreach i [$widgets(cp:${col}) curselection] {
lappend items [$widgets(cp:${col}) get $i]
}
set vals(cp:${col}_selected) $items
if {$col == "classes"} {
_toggle_perms_toshow {} {} update
}
}
proc Apol_TE::_clear_cp_listbox {lb prefix} {
variable vals
$lb selection clear 0 end
set vals(cp:${prefix}_selected) {}
if {$prefix == "classes"} {
_toggle_perms_toshow {} {} update
}
}
proc Apol_TE::_reverse_cp_listbox {lb} {
variable vals
set old_selection [$lb curselection]
set items {}
for {set i 0} {$i < [$lb index end]} {incr i} {
if {[lsearch $old_selection $i] >= 0} {
$lb selection clear $i
} else {
$lb selection set $i
lappend items [$lb get $i]
}
}
set vals(cp:perms_selected) $items
}
proc Apol_TE::_update_cp_tabname {name1 name2 op} {
variable vals
variable widgets
variable enabled
if {($enabled(cp:classes) && $vals(cp:classes_selected) > 0) || \
($enabled(cp:perms) && $vals(cp:perms_selected) > 0)} {
$widgets(search_opts) itemconfigure classperms -text "Classes/Permissions *"
} else {
$widgets(search_opts) itemconfigure classperms -text "Classes/Permissions"
}
}
proc Apol_TE::_delete_results {pageID} {
variable widgets
variable tabs
set curpos [$widgets(results) index $pageID]
$widgets(results) delete $pageID
array unset tabs $pageID:*
array unset tabs $pageID
if {[set next_id [$widgets(results) pages $curpos]] != {}} {
_switch_to_tab $next_id
} elseif {$curpos > 0} {
_switch_to_tab [$widgets(results) pages [expr {$curpos - 1}]]
} else {
$widgets(update) configure -state disabled
}
}
proc Apol_TE::_display_rename_tab_dialog {pageID} {
variable widgets
variable tabs
set d [Dialog .apol_te_tab_rename -homogeneous 1 -spacing 2 -cancel 1 \
-default 0 -modal local -parent . -place center -separator 1 \
-side bottom -title "Rename Results Tab"]
$d add -text "OK" -command [list $d enddialog "ok"]
$d add -text "Cancel" -command [list $d enddialog "cancel"]
set f [$d getframe]
set l [label $f.l -text "Tab name:"]
set tabs(tab:new_name) [$widgets(results) itemcget $pageID -text]
set e [entry $f.e -textvariable Apol_TE::tabs(tab:new_name) -width 16 -bg white]
pack $l $e -side left -padx 2
set retval [$d draw]
destroy $d
if {$retval == "ok"} {
$widgets(results) itemconfigure $pageID -text $tabs(tab:new_name)
}
}
proc Apol_TE::_delete_current_results {} {
variable widgets
if {[set curid [$widgets(results) raise]] != {}} {
_delete_results $curid
}
}
proc Apol_TE::_create_new_results_tab {} {
variable vals
variable widgets
variable tabs
set i $tabs(next_result_id)
incr tabs(next_result_id)
set id "results$i"
set frame [$widgets(results) insert end "$id" -text "Results $i"]
$widgets(results) raise $id
set tabs($id) [Apol_Widget::makeSearchResults $frame.results]
pack $tabs($id) -expand 1 -fill both
set tabs($id:vals) [array get vals]
return $tabs($id)
}
proc Apol_TE::_switch_to_tab {pageID} {
variable vals
variable widgets
variable tabs
if {[$Apol_TE::widgets(results) raise] == $pageID} {
return
}
$widgets(results) raise $pageID
set cur_search_opts [$widgets(search_opts) raise]
array set tmp_vals $tabs($pageID:vals)
set classes_selected $tmp_vals(cp:classes_selected)
set perms_selected $tmp_vals(cp:perms_selected)
array set vals $tabs($pageID:vals)
_initializeWidgets
set vals(cp:classes_selected) $classes_selected
set vals(cp:perms_selected) $perms_selected
foreach c $classes_selected {
$widgets(cp:classes) selection set [lsearch $vals(cp:classes) $c]
}
foreach p $perms_selected {
$widgets(cp:perms) selection set [lsearch $vals(cp:perms) $p]
}
$widgets(search_opts) raise $cur_search_opts
}
proc Apol_TE::_reset {} {
variable enabled
set old_classes_enabled $enabled(cp:classes)
_initializeVars
_initializeWidgets
if {[set enabled(cp:classes) $old_classes_enabled]} {
variable vals
set vals(cp:classes) [Apol_Class_Perms::getClasses]
set enabled(cp:classes) 1
set enabled(cp:perms) 1
}
}
proc Apol_TE::_search_terules {whichButton} {
variable vals
variable widgets
variable enabled
variable tabs
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "TE Rule Search" -message "No current policy file is opened."
return
}
if {$enabled(ta:use_source) && $vals(ta:use_source) && $vals(ta:source_sym) == {}} {
tk_messageBox -icon error -type ok -title "TE Rule Search" -message "No source type/attribute was selected."
return
}
if {$enabled(ta:use_target) && $vals(ta:use_target) && $vals(ta:target_sym) == {}} {
tk_messageBox -icon error -type ok -title "TE Rule Search" -message "No target type/attribute was selected."
return
}
if {$enabled(ta:use_default) && $vals(ta:use_default) && $vals(ta:default_sym) == {}} {
tk_messageBox -icon error -type ok -title "TE Rule Search" -message "No default type selected."
return
}
if {$enabled(ta:use_filename) && $vals(ta:use_filename) && $vals(ta:filename_sym) == {}} {
tk_messageBox -icon error -type ok -title "TE Rule Search" -message "No filename selected."
return
}
set avrule_selection 0
foreach {key value} [array get vals rs:avrule_*] {
set avrule_selection [expr {$avrule_selection | $value}]
}
set terule_selection 0
foreach {key value} [array get vals rs:type_*] {
set terule_selection [expr {$terule_selection | $value}]
}
if {$avrule_selection == 0 && $terule_selection == 0} {
tk_messageBox -icon error -type ok -title "TE Rule Search" -message "At least one rule must be selected."
return
}
set avq [new_apol_avrule_query_t]
set teq [new_apol_terule_query_t]
set fnteq [new_apol_filename_trans_query_t]
if {$enabled(ta:use_source) && $vals(ta:use_source)} {
if {$vals(ta:source_which) == "either"} {
$avq set_source_any $::ApolTop::policy 1
}
$avq set_source $::ApolTop::policy $vals(ta:source_sym) $vals(ta:source_indirect)
$avq set_source_component $::ApolTop::policy [expr {$vals(ta:source_sym,types) | $vals(ta:source_sym,attribs)}]
$teq set_source $::ApolTop::policy $vals(ta:source_sym) $vals(ta:source_indirect)
$teq set_source_component $::ApolTop::policy [expr {$vals(ta:source_sym,types) | $vals(ta:source_sym,attribs)}]
$fnteq set_source $::ApolTop::policy $vals(ta:source_sym) $vals(ta:source_indirect)
}
if {$enabled(ta:use_target) && $vals(ta:use_target)} {
$avq set_target $::ApolTop::policy $vals(ta:target_sym) $vals(ta:target_indirect)
$avq set_target_component $::ApolTop::policy [expr {$vals(ta:target_sym,types) | $vals(ta:target_sym,attribs)}]
$teq set_target $::ApolTop::policy $vals(ta:target_sym) $vals(ta:target_indirect)
$teq set_target_component $::ApolTop::policy [expr {$vals(ta:target_sym,types) | $vals(ta:target_sym,attribs)}]
$fnteq set_target $::ApolTop::policy $vals(ta:target_sym) $vals(ta:target_indirect)
}
if {$enabled(ta:use_default) && $vals(ta:use_default)} {
$teq set_default $::ApolTop::policy $vals(ta:default_sym)
$fnteq set_default $::ApolTop::policy $vals(ta:default_sym)
}
if {$enabled(ta:use_filename) && $vals(ta:use_filename)} {
$fnteq set_filename $::ApolTop::policy $vals(ta:filename_sym)
}
if {$enabled(cp:classes)} {
foreach c $vals(cp:classes_selected) {
$avq append_class $::ApolTop::policy $c
$teq append_class $::ApolTop::policy $c
$fnteq append_class $::ApolTop::policy $c
}
}
if {$enabled(cp:perms)} {
foreach p $vals(cp:perms_selected) {
$avq append_perm $::ApolTop::policy $p
}
$avq set_all_perms $::ApolTop::policy $vals(cp:perms_matchall)
}
$avq set_rules $::ApolTop::policy $avrule_selection
$teq set_rules $::ApolTop::policy $terule_selection
$avq set_enabled $::ApolTop::policy $vals(oo:enabled)
$teq set_enabled $::ApolTop::policy $vals(oo:enabled)
$avq set_regex $::ApolTop::policy $vals(oo:regexp)
$teq set_regex $::ApolTop::policy $vals(oo:regexp)
$fnteq set_regex $::ApolTop::policy $vals(oo:regexp)
foreach x {new update reset} {
$widgets($x) configure -state disabled
}
if {$vals(rs:avrule_neverallow)} {
ApolTop::loadNeverAllows
}
if {![ApolTop::is_capable "neverallow"]} {
set avrule_selection [expr {$avrule_selection & (~$::QPOL_RULE_NEVERALLOW)}]
$avq set_rules $::ApolTop::policy $avrule_selection
}
Apol_Progress_Dialog::wait "TE Rules" "Searching rules" \
{
set numTEs {0 0 0}
set numAVs {0 0 0}
set numFNTEs {0 0 0}
set avresults NULL
set teresults NULL
set fnteresults NULL
set num_avresults 0
set num_teresults 0
set num_fnteresults 0
if {![ApolTop::is_capable "syntactic rules"]} {
if {$avrule_selection != 0} {
set avresults [$avq run $::ApolTop::policy]
}
if {$terule_selection != 0} {
set teresults [$teq run $::ApolTop::policy]
set fnteresults [$fnteq run $::ApolTop::policy]
}
} else {
$::ApolTop::qpolicy build_syn_rule_table
if {$avrule_selection != 0} {
set avresults [$avq run_syn $::ApolTop::policy]
}
if {$terule_selection != 0} {
set teresults [$teq run_syn $::ApolTop::policy]
}
}
if {$terule_selection != 0} {
set fnteresults [$fnteq run $::ApolTop::policy]
}
$avq -acquire
$avq -delete
$teq -acquire
$teq -delete
$fnteq -acquire
$fnteq -delete
if {$avresults != "NULL"} {
set num_avresults [$avresults get_size]
}
if {$teresults != "NULL"} {
set num_teresults [$teresults get_size]
}
if {$fnteresults != "NULL"} {
set num_fnteresults [$fnteresults get_size]
}
if {$whichButton == "new"} {
set sr [_create_new_results_tab]
} else {
set id [$widgets(results) raise]
set tabs($id:vals) [array get vals]
set sr $tabs($id)
Apol_Widget::clearSearchResults $sr
}
if {![ApolTop::is_capable "syntactic rules"]} {
apol_tcl_set_info_string $::ApolTop::policy "Rendering $num_avresults AV rule results"
apol_tcl_terule_sort $::ApolTop::policy $teresults
if {$num_avresults > 0} {
set numAVs [Apol_Widget::appendSearchResultRules $sr 0 $avresults qpol_avrule_from_void]
}
apol_tcl_set_info_string $::ApolTop::policy "Rendering $num_teresults TE rule results"
apol_tcl_avrule_sort $::ApolTop::policy $avresults
if {$num_teresults > 0} {
set numTEs [Apol_Widget::appendSearchResultRules $sr 0 $teresults qpol_terule_from_void]
}
} else {
apol_tcl_set_info_string $::ApolTop::policy "Rendering $num_avresults AV rule results"
if {$num_avresults > 0} {
set numAVs [Apol_Widget::appendSearchResultSynRules $sr 0 $avresults qpol_syn_avrule_from_void]
}
apol_tcl_set_info_string $::ApolTop::policy "Rendering $num_teresults TE rule results"
if {$num_teresults > 0} {
set numTEs [Apol_Widget::appendSearchResultSynRules $sr 0 $teresults qpol_syn_terule_from_void]
}
}
if { $vals(ta:use_filename) == 1 && $vals(ta:use_source) == 0 && $vals(ta:use_target) == 0 && $vals(ta:use_default) == 0} {
Apol_Widget::clearSearchResults $sr
set numTEs {0 0 0}
set numAVs {0 0 0}
}
if {$vals(rs:type_transition) != 0} {
apol_tcl_set_info_string $::ApolTop::policy "Rendering $num_fnteresults Filename TE rule results"
if {$num_fnteresults > 0} {
set numFNTEs [Apol_TE::appendFilenameSearchResultRules $sr 0 $fnteresults qpol_filename_trans_from_void $vals(ta:filename_sym)]
}
}
set num_rules [expr {[lindex $numAVs 0] + [lindex $numTEs 0] + [lindex $numFNTEs 0]}]
set num_enabled [expr {[lindex $numAVs 1] + [lindex $numTEs 1]}]
set num_disabled [expr {[lindex $numAVs 2] + [lindex $numTEs 2]}]
set header "$num_rules rule"
if {$num_rules != 1} {
append header s
}
append header " match the search criteria.\n"
append header "Number of enabled conditional rules: $num_enabled\n"
append header "Number of disabled conditional rules: $num_disabled\n"
Apol_Widget::appendSearchResultHeader $sr $header
}
$widgets(new) configure -state normal
$widgets(reset) configure -state normal
if {[$widgets(results) pages] != {} || $retval == 0} {
$widgets(update) configure -state normal
}
}
namespace eval Apol_Analysis_transflow {
variable vals
variable widgets
Apol_Analysis::registerAnalysis "Apol_Analysis_transflow" "Transitive Information Flow"
}
proc Apol_Analysis_transflow::create {options_frame} {
variable vals
variable widgets
_reinitializeVals
set dir_tf [TitleFrame $options_frame.dir -text "Direction"]
pack $dir_tf -side left -padx 2 -pady 2 -expand 0 -fill y
set dir_to [radiobutton [$dir_tf getframe].to -text "To" \
-value $::APOL_INFOFLOW_IN \
-variable Apol_Analysis_transflow::vals(dir)]
set dir_from [radiobutton [$dir_tf getframe].from -text "From" \
-value $::APOL_INFOFLOW_OUT \
-variable Apol_Analysis_transflow::vals(dir)]
pack $dir_to $dir_from -anchor w
set req_tf [TitleFrame $options_frame.req -text "Required Parameters"]
pack $req_tf -side left -padx 2 -pady 2 -expand 0 -fill y
set l [label [$req_tf getframe].l -text "Starting type"]
pack $l -anchor w
set widgets(type) [Apol_Widget::makeTypeCombobox [$req_tf getframe].type]
pack $widgets(type)
set filter_tf [TitleFrame $options_frame.filter -text "Optional Result Filters"]
pack $filter_tf -side left -padx 2 -pady 2 -expand 1 -fill both
set advanced_f [frame [$filter_tf getframe].advanced]
pack $advanced_f -side left -anchor nw
set widgets(advanced_enable) [checkbutton $advanced_f.enable -text "Use advanced filters" \
-variable Apol_Analysis_transflow::vals(advanced:enable)]
pack $widgets(advanced_enable) -anchor w
set widgets(advanced) [button $advanced_f.b -text "Advanced Filters" \
-command Apol_Analysis_transflow::_createAdvancedDialog \
-state disabled]
pack $widgets(advanced) -anchor w -padx 4
trace add variable Apol_Analysis_transflow::vals(advanced:enable) write \
Apol_Analysis_transflow::_toggleAdvancedSelected
set widgets(regexp) [Apol_Widget::makeRegexpEntry [$filter_tf getframe].end]
$widgets(regexp).cb configure -text "Filter result types using regular expression"
pack $widgets(regexp) -side left -anchor nw -padx 8
}
proc Apol_Analysis_transflow::open {} {
variable vals
variable widgets
Apol_Widget::resetTypeComboboxToPolicy $widgets(type)
set vals(intermed:inc) [Apol_Types::getTypes]
set vals(intermed:inc_all) $vals(intermed:inc)
set vals(classes:displayed) {}
foreach class [Apol_Class_Perms::getClasses] {
foreach perm [Apol_Class_Perms::getPermsForClass $class] {
set vals(perms:$class:$perm) 1
}
lappend vals(classes:displayed) $class
}
}
proc Apol_Analysis_transflow::close {} {
variable widgets
_reinitializeVals
_reinitializeWidgets
Apol_Widget::clearTypeCombobox $widgets(type)
}
proc Apol_Analysis_transflow::getInfo {} {
return "This 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.
\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.
\nThe results of the analysis may be optionally filtered by object
classes and/or permissions, intermediate types, or an end type regular
expression.
\nNOTE: For any given generation, if the parent and the child are the
same, the child cannot be opened. This avoids cyclic analyses.
\nFor additional help on this topic select \"Information Flow Analysis\"
from the help menu."
}
proc Apol_Analysis_transflow::newAnalysis {} {
if {[set rt [_checkParams]] != {}} {
return $rt
}
set results [_analyze]
set f [_createResultsDisplay]
_renderResults $f $results
$results -acquire
$results -delete
return {}
}
proc Apol_Analysis_transflow::updateAnalysis {f} {
if {[set rt [_checkParams]] != {}} {
return $rt
}
set results [_analyze]
_clearResultsDisplay $f
_renderResults $f $results
$results -acquire
$results -delete
return {}
}
proc Apol_Analysis_transflow::reset {} {
_reinitializeVals
_reinitializeWidgets
open
}
proc Apol_Analysis_transflow::switchTab {query_options} {
variable vals
variable widgets
array set vals $query_options
_reinitializeWidgets
}
proc Apol_Analysis_transflow::saveQuery {channel} {
variable vals
variable widgets
foreach {key value} [array get vals] {
switch -glob -- $key {
find_more:* -
intermed:inc* -
intermed:exc -
classes:title {}
classes:displayed {}
perms:* {
if {$value == 0} {
puts $channel "$key $value"
}
}
default {
puts $channel "$key $value"
}
}
}
set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(type)]
puts $channel "type [lindex $type 0]"
puts $channel "type:attrib [lindex $type 1]"
set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
puts $channel "regexp:enable $use_regexp"
puts $channel "regexp $regexp"
}
proc Apol_Analysis_transflow::loadQuery {channel} {
variable vals
set intermed_exc {}
set perms_disabled {}
while {[gets $channel line] >= 0} {
set line [string trim $line]
if {$line == {} || [string index $line 0] == "#"} {
continue
}
set key {}
set value {}
regexp -line -- {^(\S+)( (.+))?} $line -> key --> value
switch -glob -- $key {
intermed:exc_all {
set intermed_exc $value
}
perms:* {
set perms_disabled [concat $perms_disabled $key $value]
}
default {
set vals($key) $value
}
}
}
open
set vals(intermed:exc_all) {}
set vals(intermed:exc) {}
foreach t $intermed_exc {
set i [lsearch $vals(intermed:inc_all) $t]
if {$i >= 0} {
lappend vals(intermed:exc_all) $t
lappend vals(intermed:exc) $t
set vals(intermed:inc_all) [lreplace $vals(intermed:inc_all) $i $i]
set i [lsearch $vals(intermed:inc) $t]
set vals(intermed:inc) [lreplace $vals(intermed:inc) $i $i]
}
}
set vals(intermed:exc_all) [lsort $vals(intermed:exc_all)]
set vals(intermed:exc) [lsort $vals(intermed:exc)]
foreach {key value} $perms_disabled {
if {[info exists vals($key)]} {
set vals($key) $value
}
}
set vals(classes:displayed) {}
foreach class [Apol_Class_Perms::getClasses] {
set all_disabled 1
foreach perm_key [array names vals perms:$class:*] {
if {$vals($perm_key)} {
set all_disabled 0
break
}
}
if {$all_disabled} {
lappend vals(classes:displayed) "$class (excluded)"
} else {
lappend vals(classes:displayed) $class
}
}
_reinitializeWidgets
}
proc Apol_Analysis_transflow::getTextWidget {tab} {
return [$tab.right getframe].res.tb
}
proc Apol_Analysis_transflow::appendResultsNodes {tree parent_node results} {
_createResultsNodes $tree $parent_node $results 0
}
proc Apol_Analysis_transflow::renderPath {res path_num path} {
_renderPath $res $path_num $path
}
proc Apol_Analysis_transflow::_reinitializeVals {} {
variable vals
set vals(dir) $::APOL_INFOFLOW_IN
array set vals {
type {} type:attrib {}
regexp:enable 0
regexp {}
advanced:enable 0
classes:title {}
classes:displayed {}
classes:threshold_enable 0
classes:threshold 1
intermed:inc {} intermed:inc_all {}
intermed:exc {} intermed:exc_all {}
intermed:attribenable 0 intermed:attrib {}
find_more:hours 0 find_more:minutes 0 find_more:seconds 30
find_more:limit 20
}
array unset vals perms:*
foreach class [Apol_Class_Perms::getClasses] {
foreach perm [Apol_Class_Perms::getPermsForClass $class] {
set vals(perms:$class:$perm) 1
}
}
}
proc Apol_Analysis_transflow::_reinitializeWidgets {} {
variable vals
variable widgets
if {$vals(type:attrib) != {}} {
Apol_Widget::setTypeComboboxValue $widgets(type) [list $vals(type) $vals(type:attrib)]
} else {
Apol_Widget::setTypeComboboxValue $widgets(type) $vals(type)
}
Apol_Widget::setRegexpEntryValue $widgets(regexp) $vals(regexp:enable) $vals(regexp)
}
proc Apol_Analysis_transflow::_toggleAdvancedSelected {name1 name2 op} {
variable vals
variable widgets
if {$vals(advanced:enable)} {
$widgets(advanced) configure -state normal
} else {
$widgets(advanced) configure -state disabled
}
}
proc Apol_Analysis_transflow::_createAdvancedDialog {} {
variable widgets
$widgets(advanced) configure -state disabled
destroy .transflow_adv
variable vals
if {[ApolTop::is_policy_open] && ![Apol_Perms_Map::is_pmap_loaded]} {
if {![ApolTop::openDefaultPermMap]} {
return "This analysis requires that a permission map is loaded."
}
}
set d [Dialog .transflow_adv -modal none -separator 1 -title "Transitive Information Flow Advanced Filters" -parent .]
$d add -text "Close" -command [list Apol_Analysis_transflow::_closeAdvancedDialog $d]
set tf [TitleFrame [$d getframe].classes -text "Filter By Object Class Permissions"]
pack $tf -side top -expand 1 -fill both -padx 2 -pady 4
_createClassFilter [$tf getframe]
set tf [TitleFrame [$d getframe].types -text "Filter By Intermediate Types"]
pack $tf -side top -expand 1 -fill both -padx 2 -pady 4
_createIntermedFilter [$tf getframe]
set inc [$tf getframe].inc
set exc [$tf getframe].exc
set attrib [frame [$tf getframe].a]
grid $attrib - -
set attrib_enable [checkbutton $attrib.ae -anchor w \
-text "Filter by attribute" \
-variable Apol_Analysis_transflow::vals(intermed:attribenable)]
set attrib_box [ComboBox $attrib.ab -autopost 1 -entrybg white -width 16 \
-values $Apol_Types::attriblist \
-textvariable Apol_Analysis_transflow::vals(intermed:attrib)]
$attrib_enable configure -command \
[list Apol_Analysis_transflow::_attribEnabled $attrib_box]
trace remove variable Apol_Analysis_transflow::vals(intermed:attrib) write \
[list Apol_Analysis_transflow::_attribChanged]
trace add variable Apol_Analysis_transflow::vals(intermed:attrib) write \
[list Apol_Analysis_transflow::_attribChanged]
pack $attrib_enable -side top -expand 0 -fill x -anchor sw -padx 5 -pady 2
pack $attrib_box -side top -expand 1 -fill x -padx 10
_attribEnabled $attrib_box
$d draw
$widgets(advanced) configure -state normal
}
proc Apol_Analysis_transflow::_closeAdvancedDialog {d} {
$d withdraw
}
proc Apol_Analysis_transflow::_createClassFilter {f} {
variable vals
set l1 [label $f.l1 -text "Object Classes"]
set l [label $f.l]
set vals(classes:title) "Permissions"
set l2 [label $f.l2 -textvariable Apol_Analysis_transflow::vals(classes:title)]
grid $l1 $l $l2 -sticky w
set classes [Apol_Widget::makeScrolledListbox $f.c -selectmode extended \
-height 12 -width 24 -listvar Apol_Analysis_transflow::vals(classes:displayed)]
set sw [ScrolledWindow $f.sw -auto both -bd 2 -relief groove]
set perms [ScrollableFrame $sw.perms -height 150 -width 250]
$sw setwidget $perms
bind $classes.lb <<ListboxSelect>> \
[list Apol_Analysis_transflow::_refreshPerm $classes $perms]
grid $classes x $sw -sticky nsew
update
grid propagate $sw 0
set bb [ButtonBox $f.bb -homogeneous 1 -spacing 4]
$bb add -text "Include All Perms" -width 16 -command [list Apol_Analysis_transflow::_setAllPerms $classes $perms 1]
$bb add -text "Exclude All Perms" -width 16 -command [list Apol_Analysis_transflow::_setAllPerms $classes $perms 0]
grid ^ x $bb -pady 4
set f [frame $f.f]
grid ^ x $f
grid configure $f -sticky ew
set cb [checkbutton $f.cb -text "Exclude permissions with weights below:" \
-variable Apol_Analysis_transflow::vals(classes:threshold_enable)]
set weight [spinbox $f.threshold -from 1 -to 10 -increment 1 \
-width 2 -bg white -justify right \
-textvariable Apol_Analysis_transflow::vals(classes:threshold)]
trace remove variable Apol_Analysis_transflow::vals(classes:threshold_enable) write \
[list Apol_Analysis_transflow::_thresholdChanged $weight]
trace add variable Apol_Analysis_transflow::vals(classes:threshold_enable) write \
[list Apol_Analysis_transflow::_thresholdChanged $weight]
pack $cb $weight -side left
_thresholdChanged $weight {} {} {}
grid columnconfigure $f 0 -weight 0
grid columnconfigure $f 1 -weight 0 -pad 4
grid columnconfigure $f 2 -weight 1
}
proc Apol_Analysis_transflow::_refreshPerm {classes perms} {
variable vals
focus $classes.lb
if {[$classes.lb curselection] == {}} {
return
}
set pf [$perms getframe]
foreach w [winfo children $pf] {
destroy $w
}
foreach {class foo} [$classes.lb get anchor] {break}
set i [$classes.lb index anchor]
set vals(classes:title) "Permissions for $class"
foreach perm_key [lsort [array names vals perms:$class:*]] {
foreach {foo bar perm} [split $perm_key :] {break}
set weight [$::ApolTop::policy get_permmap_weight $class $perm]
set l [label $pf.$perm:l -text $perm -anchor w]
set inc [checkbutton $pf.$perm:i -text "Include" \
-command [list Apol_Analysis_transflow::_togglePerm $class $i] \
-variable Apol_Analysis_transflow::vals(perms:$class:$perm)]
set w [label $pf.$perm:w -text "Weight: $weight"]
grid $l $inc $w -padx 2 -sticky w -pady 4
grid configure $w -ipadx 10
}
grid columnconfigure $pf 0 -minsize 100 -weight 1
$perms xview moveto 0
$perms yview moveto 0
}
proc Apol_Analysis_transflow::_togglePerm {class i} {
variable vals
set all_disabled 1
foreach perm_key [array names vals perms:$class:*] {
if {$vals($perm_key)} {
set all_disabled 0
break
}
}
if {$all_disabled} {
set vals(classes:displayed) [lreplace $vals(classes:displayed) $i $i "$class (excluded)"]
} else {
set vals(classes:displayed) [lreplace $vals(classes:displayed) $i $i $class]
}
}
proc Apol_Analysis_transflow::_setAllPerms {classes perms newValue} {
variable vals
foreach i [$classes.lb curselection] {
foreach {class foo} [split [$classes.lb get $i]] {break}
foreach perm_key [array names vals perms:$class:*] {
set vals($perm_key) $newValue
}
if {$newValue == 1} {
set vals(classes:displayed) [lreplace $vals(classes:displayed) $i $i $class]
} else {
set vals(classes:displayed) [lreplace $vals(classes:displayed) $i $i "$class (excluded)"]
}
}
}
proc Apol_Analysis_transflow::_thresholdChanged {w name1 name2 op} {
variable vals
if {$vals(classes:threshold_enable)} {
$w configure -state normal
} else {
$w configure -state disabled
}
}
proc Apol_Analysis_transflow::_createIntermedFilter {f} {
set l1 [label $f.l1 -text "Included Intermediate Types"]
set l2 [label $f.l2 -text "Excluded Intermediate Types"]
grid $l1 x $l2 -sticky w
set inc [Apol_Widget::makeScrolledListbox $f.inc -height 10 -width 24 \
-listvar Apol_Analysis_transflow::vals(intermed:inc) \
-selectmode extended -exportselection 0]
set exc [Apol_Widget::makeScrolledListbox $f.exc -height 10 -width 24 \
-listvar Apol_Analysis_transflow::vals(intermed:exc) \
-selectmode extended -exportselection 0]
set inc_lb [Apol_Widget::getScrolledListbox $inc]
set exc_lb [Apol_Widget::getScrolledListbox $exc]
set bb [ButtonBox $f.bb -homogeneous 1 -orient vertical -spacing 4]
$bb add -text "-->" -width 10 -command [list Apol_Analysis_transflow::_moveToExclude $inc_lb $exc_lb]
$bb add -text "<--" -width 10 -command [list Apol_Analysis_transflow::_moveToInclude $inc_lb $exc_lb]
grid $inc $bb $exc -sticky nsew
set inc_bb [ButtonBox $f.inc_bb -homogeneous 1 -spacing 4]
$inc_bb add -text "Select All" -command [list $inc_lb selection set 0 end]
$inc_bb add -text "Unselect" -command [list $inc_lb selection clear 0 end]
set exc_bb [ButtonBox $f.exc_bb -homogeneous 1 -spacing 4]
$exc_bb add -text "Select All" -command [list $exc_lb selection set 0 end]
$exc_bb add -text "Unselect" -command [list $exc_lb selection clear 0 end]
grid $inc_bb x $exc_bb -pady 4
grid columnconfigure $f 0 -weight 1 -uniform 0 -pad 2
grid columnconfigure $f 1 -weight 0 -pad 8
grid columnconfigure $f 2 -weight 1 -uniform 0 -pad 2
}
proc Apol_Analysis_transflow::_moveToExclude {inc exc} {
variable vals
if {[set selection [$inc curselection]] == {}} {
return
}
foreach i $selection {
lappend types [$inc get $i]
}
set vals(intermed:exc) [lsort [concat $vals(intermed:exc) $types]]
set vals(intermed:exc_all) [lsort [concat $vals(intermed:exc_all) $types]]
foreach t $types {
set i [lsearch $vals(intermed:inc) $t]
set vals(intermed:inc) [lreplace $vals(intermed:inc) $i $i]
set i [lsearch $vals(intermed:inc_all) $t]
set vals(intermed:inc_all) [lreplace $vals(intermed:inc_all) $i $i]
}
$inc selection clear 0 end
$exc selection clear 0 end
}
proc Apol_Analysis_transflow::_moveToInclude {inc exc} {
variable vals
if {[set selection [$exc curselection]] == {}} {
return
}
foreach i $selection {
lappend types [$exc get $i]
}
set vals(intermed:inc) [lsort [concat $vals(intermed:inc) $types]]
set vals(intermed:inc_all) [lsort [concat $vals(intermed:inc_all) $types]]
foreach t $types {
set i [lsearch $vals(intermed:exc) $t]
set vals(intermed:exc) [lreplace $vals(intermed:exc) $i $i]
set i [lsearch $vals(intermed:exc_all) $t]
set vals(intermed:exc_all) [lreplace $vals(intermed:exc_all) $i $i]
}
$inc selection clear 0 end
$exc selection clear 0 end
}
proc Apol_Analysis_transflow::_attribEnabled {cb} {
variable vals
if {$vals(intermed:attribenable)} {
$cb configure -state normal
_filterTypeLists $vals(intermed:attrib)
} else {
$cb configure -state disabled
_filterTypeLists ""
}
}
proc Apol_Analysis_transflow::_attribChanged {name1 name2 op} {
variable vals
if {$vals(intermed:attribenable)} {
_filterTypeLists $vals(intermed:attrib)
}
}
proc Apol_Analysis_transflow::_filterTypeLists {attrib} {
variable vals
if {$attrib != {}} {
set typesList {}
if {[Apol_Types::isAttributeInPolicy $attrib]} {
set qpol_type_datum [new_qpol_type_t $::ApolTop::qpolicy $attrib]
set i [$qpol_type_datum get_type_iter $::ApolTop::qpolicy]
foreach t [iter_to_list $i] {
set t [qpol_type_from_void $t]
lappend typesList [$t get_name $::ApolTop::qpolicy]
}
$i -acquire
$i -delete
}
if {$typesList == {}} {
return
}
set vals(intermed:inc) {}
set vals(intermed:exc) {}
foreach t $typesList {
if {[lsearch $vals(intermed:inc_all) $t] >= 0} {
lappend vals(intermed:inc) $t
}
if {[lsearch $vals(intermed:exc_all) $t] >= 0} {
lappend vals(intermed:exc) $t
}
}
set vals(intermed:inc) [lsort $vals(intermed:inc)]
set vals(intermed:exc) [lsort $vals(intermed:exc)]
} else {
set vals(intermed:inc) $vals(intermed:inc_all)
set vals(intermed:exc) $vals(intermed:exc_all)
}
}
proc Apol_Analysis_transflow::_checkParams {} {
variable vals
variable widgets
if {![ApolTop::is_policy_open]} {
return "No current policy file is opened."
}
set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(type)]
if {[lindex $type 0] == {}} {
return "No type was selected."
}
if {![Apol_Types::isTypeInPolicy [lindex $type 0]]} {
return "[lindex $type 0] is not a type within the policy."
}
set vals(type) [lindex $type 0]
set vals(type:attrib) [lindex $type 1]
set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
if {$use_regexp && $regexp == {}} {
return "No regular expression provided."
}
set vals(regexp:enable) $use_regexp
set vals(regexp) $regexp
if {![Apol_Perms_Map::is_pmap_loaded]} {
if {![ApolTop::openDefaultPermMap]} {
return "This analysis requires that a permission map is loaded."
}
apol_tcl_clear_info_string
}
if {$vals(advanced:enable)} {
if {$vals(intermed:inc_all) == {}} {
return "At least one intermediate type must be selected."
}
if {[lsearch $vals(intermed:exc_all) $vals(type)] >= 0} {
return "The starting type is on the excluded intermediate types list"
}
set num_perms 0
foreach perm_key [array names vals perms:*] {
if {$vals($perm_key)} {
set num_perms 1
break
}
}
if {$num_perms == 0} {
return "At least one permissions must be enabled."
}
}
return {} ;# all parameters passed, now ready to do search
}
proc Apol_Analysis_transflow::_analyze {} {
variable vals
if {$vals(regexp:enable)} {
set regexp $vals(regexp)
} else {
set regexp {}
}
set threshold {}
if {$vals(advanced:enable)} {
set intermed $vals(intermed:inc_all)
set classperms {}
foreach perm_key [array names vals perms:*] {
if {$vals($perm_key)} {
foreach {foo class perm} [split $perm_key :] {break}
lappend classperms $class $perm
}
}
if {$vals(classes:threshold_enable)} {
set threshold $vals(classes:threshold)
}
} else {
set intermed {}
set classperms {}
}
set q [new_apol_infoflow_analysis_t]
$q set_mode $::ApolTop::policy $::APOL_INFOFLOW_MODE_TRANS
$q set_dir $::ApolTop::policy $vals(dir)
$q set_type $::ApolTop::policy $vals(type)
foreach i $intermed {
$q append_intermediate $::ApolTop::policy $i
}
foreach {c p} $classperms {
$q append_class_perm $::ApolTop::policy $c $p
}
if {$threshold != {}} {
$q set_min_weight $::ApolTop::policy $threshold
}
$q set_result_regex $::ApolTop::policy $regexp
set results [$q run $::ApolTop::policy]
$q -acquire
$q -delete
return $results
}
proc Apol_Analysis_transflow::_analyzeMore {tree node} {
set new_start [$tree itemcget $node -text]
if {[$tree itemcget [$tree parent $node] -text] == $new_start} {
return {}
}
set g [lindex [$tree itemcget top -data] 0]
$g do_more $::ApolTop::policy $new_start
}
proc Apol_Analysis_transflow::_createResultsDisplay {} {
variable vals
set f [Apol_Analysis::createResultTab "Trans Flow" [array get vals]]
set tree_tf [TitleFrame $f.left -text "Transitive Information Flow Tree"]
pack $tree_tf -side left -expand 0 -fill y -padx 2 -pady 2
set sw [ScrolledWindow [$tree_tf getframe].sw -auto both]
set tree [Tree [$sw getframe].tree -width 24 -redraw 1 -borderwidth 0 \
-highlightthickness 0 -showlines 1 -padx 0 -bg white]
$sw setwidget $tree
pack $sw -expand 1 -fill both
set res_tf [TitleFrame $f.right -text "Transitive Information Flow Results"]
pack $res_tf -side left -expand 1 -fill both -padx 2 -pady 2
set res [Apol_Widget::makeSearchResults [$res_tf getframe].res]
$res.tb tag configure title -font {Helvetica 14 bold}
$res.tb tag configure title_type -foreground blue -font {Helvetica 14 bold}
$res.tb tag configure find_more -underline 1
$res.tb tag configure subtitle -font {Helvetica 10 bold}
$res.tb tag configure num -foreground blue -font {Helvetica 10 bold}
$res.tb tag bind find_more <Button-1> [list Apol_Analysis_transflow::_findMore $res $tree]
$res.tb tag bind find_more <Enter> [list $res.tb configure -cursor hand2]
$res.tb tag bind find_more <Leave> [list $res.tb configure -cursor {}]
pack $res -expand 1 -fill both
$tree configure -selectcommand [list Apol_Analysis_transflow::_treeSelect $res]
$tree configure -opencmd [list Apol_Analysis_transflow::_treeOpen $tree]
return $f
}
proc Apol_Analysis_transflow::_treeSelect {res tree node} {
if {$node != {}} {
$res.tb configure -state normal
$res.tb delete 0.0 end
set data [$tree itemcget $node -data]
if {[string index $node 0] == "y"} {
_renderResultsTransFlow $res $tree $node [lindex $data 1]
} else {
eval $res.tb insert end [lindex $data 1]
}
$res.tb configure -state disabled
}
}
proc Apol_Analysis_transflow::_treeOpen {tree node} {
foreach {is_expanded results} [$tree itemcget $node -data] {break}
if {[string index $node 0] == "y" && !$is_expanded} {
Apol_Progress_Dialog::wait "Transitive Information Flow Analysis" \
"Performing Transitive Information Flow Analysis..." \
{
set new_results [_analyzeMore $tree $node]
$tree itemconfigure $node -data [list 1 $results]
if {$new_results != {}} {
_createResultsNodes $tree $node $new_results 1
$new_results -acquire
$new_results -delete
}
}
}
}
proc Apol_Analysis_transflow::_clearResultsDisplay {f} {
variable vals
set tree [[$f.left getframe].sw getframe].tree
set res [$f.right getframe].res
$tree delete [$tree nodes root]
Apol_Widget::clearSearchResults $res
Apol_Analysis::setResultTabCriteria [array get vals]
}
proc Apol_Analysis_transflow::_renderResults {f results} {
variable vals
set graph_handler [$results extract_graph]
$graph_handler -acquire ;# let Tcl's GC destroy graph when this tab closes
set results_list [$results extract_result_vector]
set tree [[$f.left getframe].sw getframe].tree
set res [$f.right getframe].res
$tree insert end root top -text $vals(type) -open 1 -drawcross auto
set top_text [_renderTopText]
$tree itemconfigure top -data [list $graph_handler $top_text]
_createResultsNodes $tree top $results_list 1
$tree selection set top
$tree opentree top 0
$tree see top
$results_list -acquire
$results_list -delete
}
proc Apol_Analysis_transflow::_renderTopText {} {
variable vals
set top_text [list "Transitive Information Flow Analysis: Starting type: " title]
lappend top_text $vals(type) title_type \
"\n\n" title \
"This 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.
\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.
\nNOTE: For any given generation, if the parent and the child are the
same, you cannot open the child. This avoids cyclic analyses." {}
}
proc Apol_Analysis_transflow::_createResultsNodes {tree parent_node results do_expand} {
set all_targets {}
set info_list [infoflow_result_vector_to_list $results]
set results_processed 0
foreach r $info_list {
apol_tcl_set_info_string $::ApolTop::policy "Processing result $results_processed of [llength $info_list]"
if {$do_expand} {
set target [[$r get_end_type] get_name $::ApolTop::qpolicy]
} else {
set first_target [[lindex $info_list 0] get_end_type]
set target [$first_target get_name $::ApolTop::qpolicy]
}
set flow_dir [$r get_dir]
set length [$r get_length]
set steps_v [$r get_steps]
lappend all_targets $target
lappend paths($target) [list $length $steps_v]
incr results_processed
}
set all_targets [lsort -uniq $all_targets]
apol_tcl_set_info_string $::ApolTop::policy "Displaying [llength $all_targets] result(s)"
update idle
foreach t $all_targets {
set sorted_paths {}
foreach path [lsort -uniq [lsort -index 0 -integer $paths($t)]] {
set step_v [lindex $path 1]
set p {}
if {$flow_dir == $::APOL_INFOFLOW_IN} {
for {set i [expr {[$step_v get_size] - 1}]} {$i >= 0} {incr i -1} {
set r [apol_infoflow_step_from_void [$step_v get_element $i]]
lappend p [_infoflow_step_to_list $r]
}
} else {
for {set i 0} {$i < [$step_v get_size]} {incr i} {
set r [apol_infoflow_step_from_void [$step_v get_element $i]]
lappend p [_infoflow_step_to_list $r]
}
}
lappend sorted_paths $p
}
set data [list $flow_dir $sorted_paths]
$tree insert end $parent_node y\#auto -text $t -drawcross allways \
-data [list 0 $data]
}
}
proc Apol_Analysis_transflow::_infoflow_step_to_list {step} {
set start [[$step get_start_type] get_name $::ApolTop::qpolicy]
set end [[$step get_end_type] get_name $::ApolTop::qpolicy]
set weight [$step get_weight]
set rules [avrule_vector_to_list [$step get_rules]]
list $start $end $weight $rules
}
proc Apol_Analysis_transflow::_renderResultsTransFlow {res tree node data} {
set parent_name [$tree itemcget [$tree parent $node] -text]
set name [$tree itemcget $node -text]
foreach {flow_dir paths} $data {break}
switch -- $flow_dir [list \
$::APOL_INFOFLOW_IN {
$res.tb insert end "Information flows to " title \
$parent_name title_type \
" from " title \
$name title_type
} \
$::APOL_INFOFLOW_OUT {
$res.tb insert end "Information flows from " title \
$parent_name title_type \
" to " title \
$name title_type
} \
]
$res.tb insert end " (" title \
"Find more flows" {title_type find_more} \
")\n\n" title \
"Apol found the following number of information flows: " subtitle \
[llength $paths] num \
"\n" subtitle
set path_num 1
foreach path $paths {
$res.tb insert end "\n" {}
_renderPath $res $path_num $path
incr path_num
}
}
proc Apol_Analysis_transflow::_renderPath {res path_num path} {
$res.tb insert end "Flow " subtitle \
$path_num num \
" requires " subtitle \
[llength $path] num \
" steps(s).\n" subtitle \
" " {}
$res.tb insert end [lindex $path 0 0] subtitle \
" -> " {} \
[lindex $path 0 1] subtitle
foreach step [lrange $path 1 end] {
$res.tb insert end " -> " {} \
[lindex $step 1] subtitle
}
$res.tb insert end \n {}
foreach steps $path {
set rules [lindex $steps 3]
set v [new_apol_vector_t]
$v append [lindex $rules 0]
Apol_Widget::appendSearchResultRules $res 6 $v qpol_avrule_from_void
$v -acquire
$v -delete
set v [new_apol_vector_t]
foreach r [lrange $rules 1 end] {
$v append $r
}
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 10 $v qpol_avrule_from_void
$v -acquire
$v -delete
}
}
proc Apol_Analysis_transflow::_findMore {res tree} {
set node [$tree selection get]
set start [$tree itemcget [$tree parent $node] -text]
set end [$tree itemcget $node -text]
set d [Dialog .trans_more -cancel 1 -default 0 -modal local -parent . \
-separator 1 -title "Find More Flows"]
$d add -text Find -command [list Apol_Analysis_transflow::_verifyFindMore $d]
$d add -text Cancel
set f [$d getframe]
set l1 [label $f.l1 -text "Source: $start"]
set l2 [label $f.l2 -text "Target: $end"]
set time_f [frame $f.time]
set path_f [frame $f.path]
pack $l1 $l2 $time_f $path_f -anchor w -padx 8 -pady 4
set t1 [label $time_f.t1 -text "Time limit: "]
set e1 [entry $time_f.e1 -textvariable Apol_Analysis_transflow::vals(find_more:hours) -width 5 -justify right -bg white]
set t2 [label $time_f.t2 -text "Hour(s) "]
set e2 [entry $time_f.e2 -textvariable Apol_Analysis_transflow::vals(find_more:minutes) -width 5 -justify right -bg white]
set t3 [label $time_f.t3 -text "Minute(s) "]
set e3 [entry $time_f.e3 -textvariable Apol_Analysis_transflow::vals(find_more:seconds) -width 5 -justify right -bg white]
set t4 [label $time_f.t4 -text "Second(s) "]
pack $t1 $e1 $t2 $e2 $t3 $e3 $t4 -side left
set t1 [label $path_f.t1 -text "Limit by these number of flows: "]
set e1 [entry $path_f.e1 -textvariable Apol_Analysis_transflow::vals(find_more:limit) -width 5 -justify right -bg white]
pack $t1 $e1 -side left
set retval [$d draw]
destroy .trans_more
if {$retval == 0} {
set graph_handler [lindex [$tree itemcget top -data] 0]
$graph_handler trans_further_prepare $::ApolTop::policy $start $end
_doFindMore $res $tree $node
}
}
proc Apol_Analysis_transflow::_verifyFindMore {d} {
variable vals
set message {}
if {[set hours [string trim $vals(find_more:hours)]] == {}} {
set hours 0
}
if {[set minutes [string trim $vals(find_more:minutes)]] == {}} {
set minutes 0
}
if {[set seconds [string trim $vals(find_more:seconds)]] == {}} {
set seconds 0
}
set path_limit [string trim $vals(find_more:limit)]
if {![string is integer $hours] || $hours > 24 || $hours < 0} {
set message "Invalid hours limit input. Must be between 0-24 inclusive."
} elseif {![string is integer $minutes] || $minutes > 59 || $minutes < 0} {
set message "Invalid minutes limit input. Must be between 0-59 inclusive."
} elseif {![string is integer $seconds] || $seconds > 59 || $seconds < 0} {
set message "Invalid seconds limit input. Must be between 0-59 inclusive."
} elseif {$path_limit == {} && $hours == 0 && $minutes == 0 && $seconds == 0} {
set message "You must specify a time limit."
} elseif {$path_limit != {} && (![string is integer $path_limit] || $path_limit < 0)} {
set message "Number of flows cannot be less than 1."
}
if {$message != {}} {
tk_messageBox -icon error -type ok -title "Find More Flows" -message $message
} else {
$d enddialog 0
}
}
proc Apol_Analysis_transflow::_doFindMore {res tree node} {
variable vals
if {[set hours [string trim $vals(find_more:hours)]] == {}} {
set hours 0
}
if {[set minutes [string trim $vals(find_more:minutes)]] == {}} {
set minutes 0
}
if {[set seconds [string trim $vals(find_more:seconds)]] == {}} {
set seconds 0
}
set path_limit [string trim $vals(find_more:limit)]
if {$hours != 0 || $minutes != 0 || $seconds != 0} {
set time_limit [expr {$hours * 3600 + $minutes * 60 + $seconds}]
set time_limit_str [format " elapsed out of %02d:%02d:%02d" $hours $minutes $seconds]
} else {
set time_limit {}
set time_limit_str {}
}
if {$path_limit != {}} {
set path_limit_str " out of $path_limit"
} else {
set path_limit 0
set path_limit_str {}
}
set vals(find_more:abort) 0
set vals(find_more:searches_text) {}
set vals(find_more:searches_done) -1
set d [ProgressDlg .trans_domore -parent . -title "Find Results" \
-width 40 -height 5 \
-textvariable Apol_Analysis_transflow::vals(find_more:searches_text) \
-variable Apol_Analysis_transflow::vals(find_more:searches_done) \
-stop Stop \
-command [list set Apol_Analysis_transflow::vals(find_more:abort) 1]]
set graph_handler [lindex [$tree itemcget top -data] 0]
set start_time [clock seconds]
set elapsed_time 0
set path_found 0
set v NULL
while {1} {
set elapsed_time [expr {[clock seconds] - $start_time}]
set vals(find_more:searches_text) "Finding more flows:\n\n"
append vals(find_more:searches_text) " Time: [clock format $elapsed_time -format "%H:%M:%S" -gmt 1]$time_limit_str\n\n"
append vals(find_more:searches_text) " Flows: found $path_found$path_limit_str"
update
set v [$graph_handler trans_further_next $::ApolTop::policy $v]
set path_found [$v get_size]
if {($time_limit != {} && $elapsed_time >= $time_limit) || \
($path_limit != 0 && $path_found > $path_limit) || \
$vals(find_more:abort)} {
break
}
}
set vals(find_more:searches_text) "Rendering $path_found flow(s)."
update idletasks
$res.tb configure -state normal
$res.tb delete 0.0 end
set parent_name [$tree itemcget [$tree parent $node] -text]
set name [$tree itemcget $node -text]
set flow_dir [lindex [$tree itemcget $node -data] 1 0]
switch -- $flow_dir [list \
$::APOL_INFOFLOW_IN {
$res.tb insert end "More information flows to " title \
$parent_name title_type \
" from " title \
$name title_type
} \
$::APOL_INFOFLOW_OUT {
$res.tb insert end "More information flows from " title \
$parent_name title_type \
" to " title \
$name title_type
} \
]
$res.tb insert end " (" title \
"Find more flows" {title_type find_more} \
")\n\n" title \
"Time: " subtitle \
[clock format $elapsed_time -format "%H:%M:%S" -gmt 1] subtitle \
[format " out of %02d:%02d:%02d" $hours $minutes $seconds] subtitle \
"\n\nApol found the following number of information flows: " subtitle \
$path_found num \
" out of " subtitle \
$path_limit num \
"\n" subtitle
set results {}
foreach r [infoflow_result_vector_to_list $v] {
set length [$r get_length]
set steps_v [$r get_steps]
lappend results [list $length $steps_v]
}
set path_num 1
foreach r [lsort -index 0 -integer $results] {
set steps_v [lindex $r 1]
set sorted_path {}
if {$flow_dir == $::APOL_INFOFLOW_IN} {
for {set i [expr {[$steps_v get_size] - 1}]} {$i >= 0} {incr i -1} {
set s [apol_infoflow_step_from_void [$steps_v get_element $i]]
lappend sorted_path [_infoflow_step_to_list $s]
}
} else {
for {set i 0} {$i < [$steps_v get_size]} {incr i} {
set s [apol_infoflow_step_from_void [$steps_v get_element $i]]
lappend sorted_path [_infoflow_step_to_list $s]
}
}
$res.tb insert end "\n" {}
_renderPath $res $path_num $sorted_path
incr path_num
}
$res.tb configure -state disabled
destroy $d
$v -acquire
$v -delete
}
namespace eval Apol_Analysis_tra {
variable vals
variable widgets
Apol_Analysis::registerAnalysis "Apol_Analysis_tra" "Types Relationship Summary"
}
proc Apol_Analysis_tra::create {options_frame} {
variable vals
variable widgets
_reinitializeVals
set req_tf [TitleFrame $options_frame.req -text "Required Parameters"]
pack $req_tf -side left -padx 2 -pady 2 -expand 0 -fill y
set fA [frame [$req_tf getframe].fA]
pack $fA -side left -anchor nw -padx 2
set lA [label $fA.l -text "Type A"]
pack $lA -anchor w
set widgets(typeA) [Apol_Widget::makeTypeCombobox $fA.t -width 19]
pack $widgets(typeA)
set fB [frame [$req_tf getframe].fB]
pack $fB -side left -anchor nw -padx 2
set lB [label $fB.l -text "Type B"]
pack $lB -anchor w
set widgets(typeB) [Apol_Widget::makeTypeCombobox $fB.t -width 19]
pack $widgets(typeB)
set basic_tf [TitleFrame $options_frame.basic -text "Basic Relationships"]
pack $basic_tf -side left -padx 2 -pady 2 -expand 0 -fill y
foreach {t a v} [list \
"Common attributes" attribs $::APOL_TYPES_RELATION_COMMON_ATTRIBS \
"Common roles" roles $::APOL_TYPES_RELATION_COMMON_ROLES \
"Common users" users $::APOL_TYPES_RELATION_COMMON_USERS \
"Similar access to resources" similars $::APOL_TYPES_RELATION_SIMILAR_ACCESS \
"Dissimilar access to resources" dissimilars $::APOL_TYPES_RELATION_DISSIMILAR_ACCESS \
"TE allow rules" allows $::APOL_TYPES_RELATION_ALLOW_RULES \
"Type transition/change rules" typerules $::APOL_TYPES_RELATION_TYPE_RULES] {
set cb [checkbutton [$basic_tf getframe].$v -text $t \
-variable Apol_Analysis_tra::vals(run:$a) \
-onvalue $v -offvalue 0]
pack $cb -anchor w
}
set an_tf [TitleFrame $options_frame.an -text "Analysis Relationships"]
pack $an_tf -side left -padx 2 -pady 2 -expand 1 -fill both
foreach {t a v} [list \
"Direct flows between A and B" direct $::APOL_TYPES_RELATION_DIRECT_FLOW \
"Transitive flows A -> B" transAB $::APOL_TYPES_RELATION_TRANS_FLOW_AB \
"Transitive flows B -> A" transBA $::APOL_TYPES_RELATION_TRANS_FLOW_BA \
"Domain transitions A -> B" domainAB $::APOL_TYPES_RELATION_DOMAIN_TRANS_AB \
"Domain transitions B -> A" domainBA $::APOL_TYPES_RELATION_DOMAIN_TRANS_BA] {
set cb [checkbutton [$an_tf getframe].$v -text $t \
-variable Apol_Analysis_tra::vals(run:$a) \
-onvalue $v -offvalue 0]
pack $cb -anchor w
}
}
proc Apol_Analysis_tra::open {} {
variable widgets
Apol_Widget::resetTypeComboboxToPolicy $widgets(typeA)
Apol_Widget::resetTypeComboboxToPolicy $widgets(typeB)
}
proc Apol_Analysis_tra::close {} {
variable widgets
_reinitializeVals
_reinitializeWidgets
Apol_Widget::clearTypeCombobox $widgets(typeA)
Apol_Widget::clearTypeCombobox $widgets(typeB)
}
proc Apol_Analysis_tra::getInfo {} {
return "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 does not include all of the options present in the
standard queries and analyses.
\nFor additional help on this topic select \"Types Relationship Summary
Analysis\" from the help menu."
}
proc Apol_Analysis_tra::newAnalysis {} {
if {[set rt [_checkParams]] != {}} {
return $rt
}
set results [_analyze]
set f [_createResultsDisplay]
_renderResults $f $results
$results -acquire
$results -delete
return {}
}
proc Apol_Analysis_tra::updateAnalysis {f} {
if {[set rt [_checkParams]] != {}} {
return $rt
}
set results [_analyze]
_clearResultsDisplay $f
_renderResults $f $results
$results -acquire
$results -delete
return {}
}
proc Apol_Analysis_tra::reset {} {
_reinitializeVals
_reinitializeWidgets
}
proc Apol_Analysis_tra::switchTab {query_options} {
variable vals
variable widgets
array set vals $query_options
_reinitializeWidgets
}
proc Apol_Analysis_tra::saveQuery {channel} {
variable vals
variable widgets
foreach {key value} [array get vals] {
puts $channel "$key $value"
}
set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(typeA)]
puts $channel "typeA [lindex $type 0]"
puts $channel "typeA:attrib [lindex $type 1]"
set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(typeB)]
puts $channel "typeB [lindex $type 0]"
puts $channel "typeB:attrib [lindex $type 1]"
}
proc Apol_Analysis_tra::loadQuery {channel} {
variable vals
set classes_exc {}
set subjects_exc {}
while {[gets $channel line] >= 0} {
set line [string trim $line]
if {$line == {} || [string index $line 0] == "#"} {
continue
}
set key {}
set value {}
regexp -line -- {^(\S+)( (.+))?} $line -> key --> value
set vals($key) $value
}
_reinitializeWidgets
}
proc Apol_Analysis_tra::getTextWidget {tab} {
return [$tab.right getframe].res.tb
}
proc Apol_Analysis_tra::_reinitializeVals {} {
variable vals
set vals(run:attribs) $::APOL_TYPES_RELATION_COMMON_ATTRIBS
set vals(run:roles) $::APOL_TYPES_RELATION_COMMON_ROLES
set vals(run:users) $::APOL_TYPES_RELATION_COMMON_USERS
array set vals {
typeA {} typeA:attrib {}
typeB {} typeB:attrib {}
run:similars 0
run:dissimilars 0
run:allows 0
run:typerules 0
run:direct 0
run:transAB 0
run:transBA 0
run:domainAB 0
run:domainBA 0
}
}
proc Apol_Analysis_tra::_reinitializeWidgets {} {
variable vals
variable widgets
if {$vals(typeA:attrib) != {}} {
Apol_Widget::setTypeComboboxValue $widgets(typeA) [list $vals(typeA) $vals(typeA:attrib)]
} else {
Apol_Widget::setTypeComboboxValue $widgets(typeA) $vals(typeA)
}
if {$vals(typeB:attrib) != {}} {
Apol_Widget::setTypeComboboxValue $widgets(typeB) [list $vals(typeB) $vals(typeB:attrib)]
} else {
Apol_Widget::setTypeComboboxValue $widgets(typeB) $vals(typeB)
}
}
proc Apol_Analysis_tra::_checkParams {} {
variable vals
variable widgets
if {![ApolTop::is_policy_open]} {
return "No current policy file is opened."
}
set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(typeA)]
if {[lindex $type 0] == {}} {
return "No type was selected for type A."
}
if {![Apol_Types::isTypeInPolicy [lindex $type 0]]} {
return "[lindex $type 0] is not a type within the policy."
}
set vals(typeA) [lindex $type 0]
set vals(typeA:attrib) [lindex $type 1]
set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(typeB)]
if {[lindex $type 0] == {}} {
return "No type was selected for type B."
}
if {![Apol_Types::isTypeInPolicy [lindex $type 0]]} {
return "[lindex $type 0] is not a type within the policy."
}
set vals(typeB) [lindex $type 0]
set vals(typeB:attrib) [lindex $type 1]
set analysis_selected 0
foreach key [array names vals run:*] {
if {$vals($key)} {
if {($key == "run:direct" || [string match run:trans* $key]) && \
![Apol_Perms_Map::is_pmap_loaded]} {
if {![ApolTop::openDefaultPermMap]} {
return "This analysis requires that a permission map is loaded."
}
apol_tcl_clear_info_string
}
set analysis_selected 1
}
}
if {!$analysis_selected} {
return "At least one analysis must be selected."
}
return {} ;# all parameters passed, now ready to do search
}
proc Apol_Analysis_tra::_analyze {} {
variable vals
set q [new_apol_types_relation_analysis_t]
$q set_first_type $::ApolTop::policy $vals(typeA)
$q set_other_type $::ApolTop::policy $vals(typeB)
set analyses 0
foreach key [array names vals run:*] {
set analyses [expr {$analyses | $vals($key)}]
}
$q set_analyses $::ApolTop::policy $analyses
set results [$q run $::ApolTop::policy]
$q -acquire
$q -delete
return $results
}
proc Apol_Analysis_tra::_createResultsDisplay {} {
variable vals
set f [Apol_Analysis::createResultTab "Types Relationship" [array get vals]]
set tree_tf [TitleFrame $f.left -text "Types Relationship Results"]
pack $tree_tf -side left -expand 0 -fill y -padx 2 -pady 2
set sw [ScrolledWindow [$tree_tf getframe].sw -auto both]
set tree [Tree [$sw getframe].tree -width 24 -redraw 1 -borderwidth 0 \
-highlightthickness 0 -showlines 1 -padx 0 -bg white]
$sw setwidget $tree
pack $sw -expand 1 -fill both
set res_tf [TitleFrame $f.right -text "Types Relationship Information"]
pack $res_tf -side left -expand 1 -fill both -padx 2 -pady 2
set res [Apol_Widget::makeSearchResults [$res_tf getframe].res]
$res.tb tag configure title -font {Helvetica 14 bold}
$res.tb tag configure title_type -foreground blue -font {Helvetica 14 bold}
$res.tb tag configure subtitle -font {Helvetica 10 bold}
$res.tb tag configure subtitle_dir -foreground blue -font {Helvetica 10 bold}
$res.tb tag configure num -foreground blue -font {Helvetica 10 bold}
pack $res -expand 1 -fill both
update
grid propagate $sw 0
$tree configure -selectcommand [list Apol_Analysis_tra::_treeSelect $res]
return $f
}
proc Apol_Analysis_tra::_treeSelect {res tree node} {
if {$node != {}} {
$res.tb configure -state normal
$res.tb delete 0.0 end
set data [$tree itemcget $node -data]
set name [$tree itemcget $node -text]
if {[set parent [$tree parent $node]] != "root"} {
set parent_name [$tree itemcget $parent -text]
set parent_data [$tree itemcget $parent -data]
}
switch -glob -- $node {
pre:* {
eval $res.tb insert end $data
}
simtitle {
_showSimilarTitle $res $data
}
sim:* {
_showSimilar $res $name $parent_data $data
}
distitle {
_showDissimilarTitle $res $data
}
dissubtitle* {
_showDissimilarSubtitle $res $data
}
dis:* {
_showDissimilar $res $name $parent_name $data
}
allow {
_showAllows $res $data
}
typerules {
_showTypeRules $res $data
}
x* {
_showDirectFlow $res $data
}
y* {
_showTransFlow $res $data
}
f:* {
_showDTA $res $data
}
}
$res.tb configure -state disabled
}
}
proc Apol_Analysis_tra::_clearResultsDisplay {f} {
variable vals
set tree [[$f.left getframe].sw getframe].tree
set res [$f.right getframe].res
$tree delete [$tree nodes root]
Apol_Widget::clearSearchResults $res
Apol_Analysis::setResultTabCriteria [array get vals]
}
proc Apol_Analysis_tra::_renderResults {f results} {
variable vals
set tree [[$f.left getframe].sw getframe].tree
set res [$f.right getframe].res
if {$vals(run:attribs)} {
_renderCommon Attributes $tree $results get_attributes attr_vector_to_list
}
if {$vals(run:roles)} {
_renderCommon Roles $tree $results get_roles role_vector_to_list
}
if {$vals(run:users)} {
_renderCommon Users $tree $results get_users user_vector_to_list
}
if {$vals(run:similars)} {
_renderSimilars $tree $results
}
if {$vals(run:dissimilars)} {
_renderDissimilars $tree $results
}
if {$vals(run:allows)} {
_renderAllows $tree $results
}
if {$vals(run:typerules)} {
_renderTypeRules $tree $results
}
if {$vals(run:direct)} {
_renderDirectFlow $tree $results
}
if {$vals(run:transAB)} {
_renderTransFlow 0 $tree $results
}
if {$vals(run:transBA)} {
_renderTransFlow 1 $tree $results
}
if {$vals(run:domainAB)} {
_renderDTA 0 $tree $results
}
if {$vals(run:domainBA)} {
_renderDTA 1 $tree $results
}
set first_node [$tree nodes root 0]
$tree selection set $first_node
$tree see $first_node
}
proc Apol_Analysis_tra::_renderCommon {title tree results func convert_func} {
set names [$convert_func [$results $func]]
set text [list "Common $title ([llength $names]):\n\n" title]
foreach n [lsort $names] {
lappend text "$n\n" {}
}
$tree insert end root pre:$title -text "Common $title" -data $text
}
proc Apol_Analysis_tra::_types_relation_access_vector_to_list {v} {
set l {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set a [apol_types_relation_access_from_void [$v get_element $i]]
set type [[$a get_type] get_name $::ApolTop::qpolicy]
set rules [avrule_vector_to_list [$a get_rules]]
lappend l [list $type $rules]
}
set l
}
proc Apol_Analysis_tra::_renderSimilars {tree results} {
variable vals
set simA [_types_relation_access_vector_to_list [$results get_similar_first]]
set simB [_types_relation_access_vector_to_list [$results get_similar_other]]
set data [list $vals(typeA) $vals(typeB) [llength $simA]]
$tree insert end root simtitle -text "Similar access to resources" -data $data -drawcross allways
foreach accessA [lsort -index 0 $simA] accessB [lsort -index 0 $simB] {
set type [lindex $accessA 0]
set rulesA [lindex $accessA 1]
set rulesB [lindex $accessB 1]
$tree insert end simtitle sim:$type -text $type -data [list $rulesA $rulesB]
}
}
proc Apol_Analysis_tra::_showSimilarTitle {res data} {
foreach {typeA typeB numTypes} $data {break}
$res.tb insert end $typeA title_type \
" and " title \
$typeB title_type \
" access $numTypes common type(s).\n\n" title \
"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." {}
}
proc Apol_Analysis_tra::_showSimilar {res name parent_data data} {
foreach {typeA typeB} $parent_data {rulesA rulesB} $data {break}
$res.tb insert end $typeA title_type \
" accesses " title \
$name title_type \
":\n\n" title
set v [new_apol_vector_t]
foreach r $rulesA {
$v append $r
}
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 2 $v qpol_avrule_from_void
$v -acquire
$v -delete
$res.tb insert end "\n" title \
$typeB title_type \
" accesses " title \
$name title_type \
":\n\n" title
set v [new_apol_vector_t]
foreach r $rulesB {
$v append $r
}
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 2 $v qpol_avrule_from_void
$v -acquire
$v -delete
}
proc Apol_Analysis_tra::_renderDissimilars {tree results} {
variable vals
set disA [_types_relation_access_vector_to_list [$results get_dissimilar_first]]
set disB [_types_relation_access_vector_to_list [$results get_dissimilar_other]]
set data [list $vals(typeA) $vals(typeB)]
$tree insert end root distitle -text "Dissimilar access to resources" -data $data
set data [list $vals(typeA) $vals(typeB) [llength $disA]]
$tree insert end distitle dissubtitleA -text $vals(typeA) -data $data -drawcross allways
foreach access [lsort -index 0 $disA] {
set type [lindex $access 0]
set rules [lindex $access 1]
$tree insert end dissubtitleA dis:$type -text $type -data $rules
}
set data [list $vals(typeB) $vals(typeA) [llength $disB]]
$tree insert end distitle dissubtitleB -text $vals(typeB) -data $data -drawcross allways
foreach access [lsort -index 0 $disB] {
set type [lindex $access 0]
set rules [lindex $access 1]
$tree insert end dissubtitleB dis:$type -text $type -data $rules
}
}
proc Apol_Analysis_tra::_showDissimilarTitle {res data} {
foreach {typeA typeB} $data {break}
$res.tb insert end "Dissimilar access between " title \
$typeA title_type \
" and " title \
$typeB title_type \
".\n\n" title \
"Open the subtree for this item to access individual subtrees of types
which can be accessed by one type but not the other. You may then
select a type from a subtree to see the allow rules which provide the
access." {}
}
proc Apol_Analysis_tra::_showDissimilarSubtitle {res data} {
foreach {one_type other_type numTypes} $data {break}
$res.tb insert end $one_type title_type \
" accesss $numTypes type(s) to which " title \
$other_type title_type \
" does not have access.\n\n" title \
"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." {}
}
proc Apol_Analysis_tra::_showDissimilar {res name parent_name data} {
$res.tb insert end $parent_name title_type \
" accesses " title \
$name title_type \
":\n\n" title
set v [new_apol_vector_t]
foreach r $data {
$v append $r
}
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 2 $v qpol_avrule_from_void
$v -acquire
$v -delete
}
proc Apol_Analysis_tra::_renderAllows {tree results} {
set rules [$results get_allowrules]
set rules_dup [new_apol_vector_t $rules]
$rules_dup -acquire
apol_tcl_avrule_sort $::ApolTop::policy $rules_dup
$tree insert end root allow -text "TE Allow Rules" -data $rules_dup
}
proc Apol_Analysis_tra::_showAllows {res data} {
$res.tb insert end "TE Allow Rules ([$data get_size]):\n\n" title
Apol_Widget::appendSearchResultRules $res 2 $data qpol_avrule_from_void
}
proc Apol_Analysis_tra::_renderTypeRules {tree results} {
set rules [$results get_typerules]
set rules_dup [new_apol_vector_t $rules]
apol_tcl_terule_sort $::ApolTop::policy $rules_dup
$rules_dup -acquire
$tree insert end root typerules -text "Type Transition/Change Rules" -data $rules_dup
}
proc Apol_Analysis_tra::_showTypeRules {res data} {
$res.tb insert end "Type transition/change rules ([$data get_size]):\n\n" title
Apol_Widget::appendSearchResultRules $res 2 $data qpol_terule_from_void
}
proc Apol_Analysis_tra::_renderDirectFlow {tree results} {
set v [$results get_directflows]
if {$v == "NULL" || [$v get_size] == 0} {
$tree insert end root pre:direct
set node [$tree nodes root end]
set data [list "No direct information flows found." title]
} else {
variable vals
Apol_Analysis_directflow::appendResultsNodes $tree root $v
set node [$tree nodes root end]
set data [list $vals(typeA) $vals(typeB) [$tree itemcget $node -data]]
}
$tree itemconfigure $node -text "Direct Flows Between A and B" -data $data -drawcross auto
}
proc Apol_Analysis_tra::_showDirectFlow {res data} {
foreach {parent_name name data} $data {break}
foreach {flow_dir classes} [lindex $data 1] {break}
$res.tb insert end "Information flows both into and out of " title \
$parent_name title_type \
" from/to " title \
$name title_type
$res.tb insert end "\n\n" title_type \
"Objects classes for " subtitle \
[string toupper $flow_dir] subtitle_dir \
" flows:\n" subtitle
foreach c $classes {
foreach {class_name rules} $c {break}
$res.tb insert end " " {} \
$class_name\n subtitle
set v [new_apol_vector_t]
foreach r $rules {
$v append $r
}
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 12 $v qpol_avrule_from_void
$v -acquire
$v -delete
}
}
proc Apol_Analysis_tra::_renderTransFlow {dir tree results} {
variable vals
if {$dir == 0} {
set title2 "A->B"
set v [$results get_transflowsAB]
set data [list $vals(typeB) $vals(typeA)]
} else {
set title2 "B->A"
set v [$results get_transflowsBA]
set data [list $vals(typeA) $vals(typeB)]
}
if {$v == "NULL" || [$v get_size] == 0} {
$tree insert end root pre:trans$dir
set node [$tree nodes root end]
set data [list "No transitive information flows found." title]
} else {
Apol_Analysis_transflow::appendResultsNodes $tree root $v
set node [$tree nodes root end]
lappend data [$tree itemcget $node -data]
}
$tree itemconfigure $node -text "Transitive Flows $title2" -data $data -drawcross auto
}
proc Apol_Analysis_tra::_showTransFlow {res data} {
foreach {parent_name name data} $data {break}
foreach {flow_dir paths} [lindex $data 1] {break}
$res.tb insert end "Information flows from " title \
$name title_type \
" to " title \
$parent_name title_type
$res.tb insert end "\n\n" title \
"Apol found the following number of information flows: " subtitle \
[llength $paths] num \
"\n" subtitle
set path_num 1
foreach path $paths {
$res.tb insert end "\n" {}
Apol_Analysis_transflow::renderPath $res $path_num $path
incr path_num
}
}
proc Apol_Analysis_tra::_renderDTA {dir tree results} {
variable vals
if {$dir == 0} {
set title2 "A->B"
set data [list $vals(typeA) $vals(typeB)]
set dta [$results get_domainsAB]
} else {
set title2 "B->A"
set data [list $vals(typeB) $vals(typeA)]
set dta [$results get_domainsBA]
}
if {$dta == "NULL" || [$dta get_size] == 0} {
$tree insert end root pre:dta$dir
set node [$tree nodes root end]
set data [list "No domain transitions found." title]
} else {
Apol_Analysis_domaintrans::appendResultsNodes $tree root $dta
set node [$tree nodes root end]
lappend data [$tree itemcget $node -data]
}
$tree itemconfigure $node -text "Domain Transitions $title2" -data $data -drawcross auto
}
proc Apol_Analysis_tra::_showDTA {res data} {
foreach {parent_name name data} $data {break}
foreach {proctrans setexec ep access_list} [lindex $data 1] {break}
set header [list "Domain transition from " title \
$parent_name title_type \
" to " title \
$name title_type]
eval $res.tb insert end $header
$res.tb insert end "\n\n" title_type
$res.tb insert end "Process Transition Rules: " subtitle \
[llength $proctrans] num \
"\n" subtitle
set v [list_to_vector $proctrans]
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 6 $v _qpol_avrule_from_void
$v -acquire
$v -delete
if {[llength $setexec] > 0} {
$res.tb insert end "\n" {} \
"Setexec Rules: " subtitle \
[llength $setexec] num \
"\n" subtitle
set v [list_to_vector $setexec]
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 6 $v qpol_avrule_from_void
$v -acquire
$v -delete
}
$res.tb insert end "\nEntry Point File Types: " subtitle \
[llength $ep] num
foreach e [lsort -index 0 $ep] {
foreach {intermed entrypoint execute type_trans} $e {break}
$res.tb insert end "\n $intermed\n" {} \
" " {} \
"File Entrypoint Rules: " subtitle \
[llength $entrypoint] num \
"\n" subtitle
set v [list_to_vector $entrypoint]
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 12 $v qpol_avrule_from_void
$v -acquire
$v -delete
$res.tb insert end "\n" {} \
" " {} \
"File Execute Rules: " subtitle \
[llength $execute] num \
"\n" subtitle
set v [list_to_vector $execute]
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 12 $v qpol_avrule_from_void
$v -acquire
$v -delete
if {[llength $type_trans] > 0} {
$res.tb insert end "\n" {} \
" " {} \
"Type_transition Rules: " subtitle \
[llength $type_trans] num \
"\n" subtitle
set v [list_to_vector $type_trans]
apol_tcl_terule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 12 $v qpol_terule_from_void
$v -acquire
$v -delete
}
}
if {[llength $access_list] > 0} {
$res.tb insert end "\n" {} \
"The access filters you specified returned the following rules: " subtitle \
[llength $access_list] num \
"\n" subtitle
set v [list_to_vector $access_list]
apol_tcl_avrule_sort $::ApolTop::policy $v
Apol_Widget::appendSearchResultRules $res 6 $v qpol_avrule_from_void
$v -acquire
$v -delete
}
}
namespace eval Apol_Types {
variable typelist {}
variable attriblist {}
variable opts
variable widgets
}
proc Apol_Types::create {tab_name nb} {
variable opts
variable widgets
_initializeVars
set frame [$nb insert end $tab_name -text "Types"]
set pw1 [PanedWindow $frame.pw -side top]
set left_pane [$pw1 add -weight 0]
set center_pane [$pw1 add -weight 1]
set tpane [frame $left_pane.t]
set apane [frame $left_pane.a]
set tbox [TitleFrame $tpane.tbox -text "Types"]
set abox [TitleFrame $apane.abox -text "Attributes"]
set obox [TitleFrame $center_pane.obox -text "Search Options"]
set rbox [TitleFrame $center_pane.rbox -text "Search Results"]
pack $obox -side top -expand 0 -fill both -padx 2
pack $rbox -expand yes -fill both -padx 2
pack $tbox -fill both -expand yes
pack $abox -fill both -expand yes
pack $pw1 -fill both -expand yes
pack $tpane -fill both -expand 1
pack $apane -fill both -expand 1
set tlistbox [Apol_Widget::makeScrolledListbox [$tbox getframe].types \
-height 10 -width 20 -listvar Apol_Types::typelist]
Apol_Widget::setListboxCallbacks $tlistbox \
{{"Show Type Info" {Apol_Types::_popupTypeInfo type}}}
pack $tlistbox -expand 1 -fill both
set alistbox [Apol_Widget::makeScrolledListbox [$abox getframe].attribs \
-height 5 -width 20 -listvar Apol_Types::attriblist]
Apol_Widget::setListboxCallbacks $alistbox {{"Show Attribute Info" {Apol_Types::_popupTypeInfo attrib}}}
pack $alistbox -expand 1 -fill both
set ofm [$obox getframe]
set fm_types_select [frame $ofm.to]
set fm_attribs_select [frame $ofm.ao]
set fm_permissive_bounds [frame $ofm.po]
pack $fm_types_select $fm_attribs_select $fm_permissive_bounds -side left -padx 4 -pady 2 -anchor nw
set types_select [checkbutton $fm_types_select.type -text "Show types" -variable Apol_Types::opts(types)]
set typeattribs [checkbutton $fm_types_select.typeattribs -text "Include attributes" \
-variable Apol_Types::opts(types:show_attribs)]
pack $types_select -anchor w
pack $typeattribs -anchor w -padx 8
trace add variable Apol_Types::opts(types) write \
[list Apol_Types::_toggleCheckbuttons $typeattribs]
set attribs_select [checkbutton $fm_attribs_select.type -text "Show attributes" \
-variable Apol_Types::opts(attribs)]
set a_types [checkbutton $fm_attribs_select.types -text "Include types" \
-variable Apol_Types::opts(attribs:show_types) -state disabled]
set a_typeattribs [checkbutton $fm_attribs_select.typeattribs -text "Include types' attributes" \
-variable Apol_Types::opts(attribs:show_attribs) -state disabled]
pack $attribs_select -anchor w
pack $a_types $a_typeattribs -anchor w -padx 8
trace add variable Apol_Types::opts(attribs) write \
[list Apol_Types::_toggleCheckbuttons [list $a_typeattribs $a_types]]
set permissive_select [checkbutton $fm_permissive_bounds.type -text "Show permissive types" \
-variable Apol_Types::opts(permissive)]
pack $permissive_select -anchor w
trace add variable Apol_Types::opts(permissive:show_names) write \
[list Apol_Types::_toggleCheckbuttons $permissive_select]
set typebounds_select [checkbutton $fm_permissive_bounds.bounds -text "Show typebounds rules" \
-variable Apol_Types::opts(typebounds)]
pack $typebounds_select -anchor w
trace add variable Apol_Types::opts(typebounds:show_names) write \
[list Apol_Types::_toggleCheckbuttons $typebounds_select]
set widgets(regexp) [Apol_Widget::makeRegexpEntry $ofm.regexpf]
Apol_Widget::setRegexpEntryState $widgets(regexp) 1
pack $widgets(regexp) -side left -padx 4 -pady 2 -anchor nw
set ok [button $ofm.ok -text OK -width 6 -command Apol_Types::_searchTypes]
pack $ok -side right -padx 5 -pady 5 -anchor ne
set widgets(results) [Apol_Widget::makeSearchResults [$rbox getframe].results]
pack $widgets(results) -expand yes -fill both
return $frame
}
proc Apol_Types::open {ppath} {
variable opts
set opts(permissive:show_names) [ApolTop::is_capable "permissive"]
set opts(typebounds:show_names) [ApolTop::is_capable "bounds"]
set q [new_apol_type_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
variable typelist [lsort [type_vector_to_list $v]]
$v -acquire
$v -delete
set q [new_apol_attr_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
variable attriblist [lsort [attr_vector_to_list $v]]
$v -acquire
$v -delete
}
proc Apol_Types::close {} {
variable widgets
_initializeVars
set Apol_Types::typelist {}
set Apol_Types::attriblist {}
Apol_Widget::clearSearchResults $widgets(results)
}
proc Apol_Types::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_Types::isTypeInPolicy {type} {
if {![ApolTop::is_policy_open]} {
return 0
}
set q [new_apol_type_query_t]
$q set_type $::ApolTop::policy $type
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
if {$v == "NULL" || [$v get_size] == 0} {
set retval 0
} else {
set retval 1
}
$v -acquire
$v -delete
set retval
}
proc Apol_Types::isAttributeInPolicy {attrib} {
variable attriblist
if {[ApolTop::is_policy_open] && [lsearch $attriblist $attrib] >= 0} {
return 1
}
return 0
}
proc Apol_Types::getTypes {} {
variable typelist
set typelist
}
proc Apol_Types::getAttributes {} {
variable attriblist
set attriblist
}
proc Apol_Types::_initializeVars {} {
variable opts
array set opts {
types 1 types:show_attribs 1 types:show_aliases 1
attribs 0 attribs:show_types 1 attribs:show_attribs 1
permissive 1 permissive:show_names 0
typebounds 1 typebounds:show_names 0
}
}
proc Apol_Types::_toggleCheckbuttons {w name1 name2 op} {
variable opts
variable widgets
if {$opts($name2)} {
foreach x $w {
$x configure -state normal
}
} else {
foreach x $w {
$x configure -state disabled
}
}
if {!$opts(types) && !$opts(attribs) && !$opts(typebounds)} {
Apol_Widget::setRegexpEntryState $widgets(regexp) 0
} else {
Apol_Widget::setRegexpEntryState $widgets(regexp) 1
}
}
proc Apol_Types::_popupTypeInfo {which ta} {
if {[Apol_File_Contexts::is_db_loaded]} {
set entry_vector [Apol_File_Contexts::get_fc_files_for_ta $which $ta]
set index_file_loaded 1
} else {
set entry_vector {}
set index_file_loaded 0
}
if {$which == "type"} {
set info_ta [_renderType $ta 1 1]
} else {
set info_ta [_renderAttrib $ta 1 0]
}
set w .ta_infobox
destroy $w
set w [Dialog .ta_infobox -cancel 0 -default 0 -modal none -parent . -separator 1 -title $ta]
$w add -text "Close" -command [list destroy $w]
set notebook [NoteBook [$w getframe].nb]
pack $notebook -expand 1 -fill both
set ta_info_tab [$notebook insert end ta_info_tab]
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 sw [ScrolledWindow [$notebook getframe ta_info_tab].sw -scrollbar both -auto both]
set text [text [$sw getframe].text -wrap none -font {helvetica 10} -bg white]
$sw setwidget $text
pack $sw -expand 1 -fill both
$text insert 0.0 $info_ta
$text configure -state disabled
if {$which != "type"} {
set l [label [$notebook getframe fc_info_tab].l \
-text "Files labeled with types that are members of this attribute:" \
-justify left]
pack $l -anchor nw
}
set sw [ScrolledWindow [$notebook getframe fc_info_tab].sw -scrollbar both -auto both]
set fc_text [text [$sw getframe].text -wrap none -font {helvetica 10} -bg white]
$sw setwidget $fc_text
pack $sw -expand 1 -fill both
$notebook raise [$notebook page 0]
if {$index_file_loaded} {
if {$entry_vector != {}} {
set num [$entry_vector get_size]
$fc_text insert 1.0 "Number of files: $num\n\n"
for {set i 0} {$i < $num} {incr i} {
set entry [sefs_entry_from_void [$entry_vector get_element $i]]
$fc_text insert end "[$entry toString]\n"
}
$entry_vector -delete
} else {
$fc_text insert end "No files found."
}
} else {
$fc_text insert 0.0 "No index file is loaded. Load an index file through the File Contexts tab."
}
$fc_text configure -state disabled
$w draw {} 0 400x400
}
proc Apol_Types::_searchTypes {} {
variable widgets
variable opts
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
return
}
if {$opts(types) == 0 && $opts(attribs) == 0 && $opts(permissive) == 0 && $opts(typebounds) == 0} {
tk_messageBox -icon error -type ok -title "Error" -message "No search options provided."
return
}
set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
if {$use_regexp} {
if {$regexp == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No regular expression provided."
return
}
} else {
set regexp {}
}
set results {}
if {$opts(types)} {
set q [new_apol_type_query_t]
$q set_type $::ApolTop::policy $regexp
$q set_regex $::ApolTop::policy $use_regexp
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set types_data [type_vector_to_list $v]
$v -acquire
$v -delete
append results "TYPES ([llength $types_data]):\n\n"
foreach t [lsort $types_data] {
append results "[_renderType $t $opts(types:show_attribs) $opts(types:show_aliases)]\n"
}
}
if {$opts(attribs)} {
set q [new_apol_attr_query_t]
$q set_attr $::ApolTop::policy $regexp
$q set_regex $::ApolTop::policy $use_regexp
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set attribs_data [attr_vector_to_list $v]
$v -acquire
$v -delete
if {$opts(types)} {
append results "\n\n"
}
append results "ATTRIBUTES ([llength $attribs_data]):\n\n"
foreach a [lsort $attribs_data] {
append results "[_renderAttrib $a $opts(attribs:show_types) $opts(attribs:show_attribs)]\n"
}
}
if {$opts(permissive) && [ApolTop::is_capable "permissive"]} {
set q [new_apol_permissive_query_t]
$q set_name $::ApolTop::policy $regexp
$q set_regex $::ApolTop::policy $use_regexp
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set permissive_data [type_vector_to_list $v]
$v -acquire
$v -delete
if {$opts(types) || $opts(attribs)} {
append results "\n\n"
}
append results "PERMISSIVE TYPES ([llength $permissive_data]):\n\n"
foreach p [lsort $permissive_data] {
append results "[_renderType $p 0 0]\n"
}
}
if {$opts(typebounds) && [ApolTop::is_capable "bounds"]} {
set bounds {}
set counter 0
set q [new_apol_typebounds_query_t]
$q set_name $::ApolTop::policy $regexp
$q set_regex $::ApolTop::policy $use_regexp
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_typebounds_from_void [$v get_element $i]]
set parent [$q get_parent_name $::ApolTop::qpolicy]
if {$parent != ""} {
append bounds "typebounds $parent "
append bounds "[$q get_child_name $::ApolTop::qpolicy];\n"
set counter [expr $counter + 1]
}
}
}
if {$opts(types) || $opts(attribs) || $opts(permissive)} {
append results "\n\n"
}
append results "BOUNDED TYPES ($counter):\n\n"
append results "$bounds\n"
}
Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_Types::_renderType {type_name show_attribs show_aliases} {
set qpol_type_datum [new_qpol_type_t $::ApolTop::qpolicy $type_name]
set aliases {}
set attribs {}
set i [$qpol_type_datum get_alias_iter $::ApolTop::qpolicy]
set aliases [iter_to_str_list $i]
$i -acquire
$i -delete
set i [$qpol_type_datum get_attr_iter $::ApolTop::qpolicy]
foreach a [iter_to_list $i] {
set a [qpol_type_from_void $a]
lappend attribs [$a get_name $::ApolTop::qpolicy]
}
$i -acquire
$i -delete
set text "$type_name"
if {$show_aliases && [llength $aliases] > 0} {
append text " alias [list $aliases]"
}
if {$show_attribs} {
append text " ([llength $attribs] attribute"
if {[llength $attribs] != 1} {
append text s
}
append text ")\n"
foreach a [lsort $attribs] {
append text " $a\n"
}
}
return $text
}
proc Apol_Types::_renderAttrib {attrib_name show_types show_attribs} {
set permissive {}
set qpol_type_datum [new_qpol_type_t $::ApolTop::qpolicy $attrib_name]
set text "$attrib_name"
if {$show_types} {
set types {}
set i [$qpol_type_datum get_type_iter $::ApolTop::qpolicy]
foreach t [iter_to_list $i] {
set t [qpol_type_from_void $t]
lappend types [$t get_name $::ApolTop::qpolicy]
}
$i -acquire
$i -delete
append text " ([llength $types] type"
if {[llength $types] != 1} {
append text s
}
append text ")\n"
foreach type_name [lsort $types] {
append text " $type_name"
if {$show_attribs} {
set t [new_qpol_type_t $::ApolTop::qpolicy $type_name]
set this_attribs {}
set i [$t get_attr_iter $::ApolTop::qpolicy]
foreach a [iter_to_list $i] {
set a [qpol_type_from_void $a]
lappend this_attribs [$a get_name $::ApolTop::qpolicy]
}
$i -acquire
$i -delete
set this_attribs [lsort $this_attribs]
set idx [lsearch -sorted -exact $attrib_name $this_attribs]
append text " { [lreplace $this_attribs $idx $idx] }"
}
append text "\n"
}
}
return $text
}
namespace eval Apol_Users {
variable opts
variable widgets
variable users_list {}
}
proc Apol_Users::create {tab_name nb} {
variable opts
variable widgets
_initializeVars
set frame [$nb insert end $tab_name -text "Users"]
set pw1 [PanedWindow $frame.pw -side top]
set rpane [$pw1 add -weight 0]
set spane [$pw1 add -weight 1]
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 $pw1 -fill both -expand yes
pack $s_optionsbox -side top -expand 0 -fill both -padx 2
pack $userbox -fill both -expand yes
pack $resultsbox -expand yes -fill both -padx 2
set users_listbox [Apol_Widget::makeScrolledListbox [$userbox getframe].lb -width 20 -listvar Apol_Users::users_list]
Apol_Widget::setListboxCallbacks $users_listbox \
{{"Display User Info" {Apol_Users::_popupUserInfo users}}}
pack $users_listbox -fill both -expand yes
set ofm [$s_optionsbox getframe]
set verboseFrame [frame $ofm.verbose]
set rolesFrame [frame $ofm.roles]
set defaultFrame [frame $ofm.default]
set rangeFrame [frame $ofm.range]
pack $verboseFrame $rolesFrame $defaultFrame $rangeFrame \
-side left -padx 4 -pady 2 -anchor nw -expand 0 -fill y
radiobutton $verboseFrame.all_info -text "All information" \
-variable Apol_Users::opts(showSelection) -value all
radiobutton $verboseFrame.names_only -text "Names only" \
-variable Apol_Users::opts(showSelection) -value names
pack $verboseFrame.all_info $verboseFrame.names_only -anchor w -padx 5 -pady 4
checkbutton $rolesFrame.cb -variable Apol_Users::opts(useRole) -text "Role"
set widgets(role) [ComboBox $rolesFrame.combo -width 12 -textvariable Apol_Users::opts(role) \
-helptext "Type or select a role" -state disabled \
-autopost 1]
trace add variable Apol_Users::opts(useRole) write \
[list Apol_Users::_toggleRolesCheckbutton $widgets(role)]
pack $rolesFrame.cb -anchor nw
pack $widgets(role) -padx 4
set widgets(defaultCB) [checkbutton $defaultFrame.cb -variable Apol_Users::opts(enable_default) -text "Default MLS level"]
set defaultDisplay [Entry $defaultFrame.display -textvariable Apol_Users::opts(default_level_display) -width 16 -editable 0]
set defaultButton [button $defaultFrame.button -text "Select Level..." -state disabled -command [list Apol_Users::_show_level_dialog]]
trace add variable Apol_Users::opts(enable_default) write \
[list Apol_Users::_toggleDefaultCheckbutton $widgets(defaultCB) $defaultDisplay $defaultButton]
trace add variable Apol_Users::opts(default_level) write \
[list Apol_Users::_updateDefaultDisplay $defaultDisplay]
pack $widgets(defaultCB) -side top -anchor nw -expand 0
pack $defaultDisplay -side top -expand 0 -fill x -padx 4
pack $defaultButton -side top -expand 1 -fill none -padx 4 -anchor ne
set widgets(range) [Apol_Widget::makeRangeSelector $rangeFrame.range Users]
pack $widgets(range) -expand 1 -fill x
button $ofm.ok -text OK -width 6 -command Apol_Users::_searchUsers
pack $ofm.ok -side right -pady 5 -padx 5 -anchor ne
set widgets(results) [Apol_Widget::makeSearchResults [$resultsbox getframe].results]
pack $widgets(results) -expand yes -fill both
return $frame
}
proc Apol_Users::open {ppath} {
set q [new_apol_user_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
variable users_list [lsort [user_vector_to_list $v]]
$v -acquire
$v -delete
variable opts
variable widgets
$Apol_Users::widgets(role) configure -values [Apol_Roles::getRoles]
if {[ApolTop::is_capable "mls"]} {
Apol_Widget::setRangeSelectorCompleteState $widgets(range) normal
$widgets(defaultCB) configure -state normal
} else {
Apol_Widget::clearRangeSelector $widgets(range)
Apol_Widget::setRangeSelectorCompleteState $widgets(range) disabled
set opts(enable_default) 0
$widgets(defaultCB) configure -state disabled
}
}
proc Apol_Users::close {} {
variable widgets
_initializeVars
variable users_list {}
$widgets(role) configure -values ""
Apol_Widget::clearSearchResults $widgets(results)
Apol_Widget::clearRangeSelector $widgets(range)
Apol_Widget::setRangeSelectorCompleteState $widgets(range) normal
$widgets(defaultCB) configure -state normal
}
proc Apol_Users::getTextWidget {} {
variable widgets
return $widgets(results).tb
}
proc Apol_Users::getUsers {} {
variable users_list
set users_list
}
proc Apol_Users::_initializeVars {} {
variable opts
array set opts {
showSelection all
useRole 0 role {}
enable_default 0 default_level {}
}
}
proc Apol_Users::_toggleRolesCheckbutton {path name1 name2 op} {
variable opts
if {$opts($name2)} {
$path configure -state normal -entrybg white
} else {
$path configure -state disabled -entrybg $ApolTop::default_bg_color
}
}
proc Apol_Users::_toggleDefaultCheckbutton {cb display button name1 name2 op} {
variable opts
if {$opts($name2)} {
$button configure -state normal
$display configure -state normal
} else {
$button configure -state disabled
$display configure -state disabled
}
}
proc Apol_Users::_show_level_dialog {} {
variable opts
.mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.default.button configure -state disabled
set new_level [Apol_Level_Dialog::getLevel $opts(default_level)]
if {$new_level != {}} {
set opts(default_level) $new_level
$opts(default_level) -acquire
}
.mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.default.button configure -state normal
}
proc Apol_Users::_updateDefaultDisplay {display name1 name2 op} {
variable opts
if {$opts(default_level) == {}} {
set opts(default_level_display) {}
$display configure -helptext {}
} else {
set level [$opts(default_level) render $::ApolTop::policy]
if {$level == {}} {
set opts(default_level_display) "<invalid MLS level>"
} else {
set opts(default_level_display) $level
}
$display configure -helptext $opts(default_level_display)
}
}
proc Apol_Users::_popupUserInfo {which user} {
Apol_Widget::showPopupText $user [_renderUser $user 1]
}
proc Apol_Users::_searchUsers {} {
variable opts
variable widgets
.mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.ok configure -state disabled
Apol_Widget::clearSearchResults $widgets(results)
if {![ApolTop::is_policy_open]} {
tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
.mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.ok configure -state normal
return
}
if {$opts(useRole)} {
if {$opts(role) == ""} {
tk_messageBox -icon error -type ok -title "Error" -message "No role selected."
.mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.ok configure -state normal
return
}
set role $opts(role)
} else {
set role {}
}
if {$opts(enable_default)} {
if {$opts(default_level) == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No default level selected."
.mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.ok configure -state normal
return
}
set default $opts(default_level)
} else {
set default NULL
}
set range_enabled [Apol_Widget::getRangeSelectorState $widgets(range)]
foreach {range range_type} [Apol_Widget::getRangeSelectorValue $widgets(range)] {break}
if {$range_enabled} {
if {$range == {}} {
tk_messageBox -icon error -type ok -title "Error" -message "No range selected."
.mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.ok configure -state normal
return
}
} else {
set range NULL
}
if {$opts(showSelection) == "all"} {
set show_all 1
} else {
set show_all 0
}
set q [new_apol_user_query_t]
$q set_role $::ApolTop::policy $role
$q set_default_level $::ApolTop::policy $default
$q set_range $::ApolTop::policy $range $range_type
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set users_data [user_vector_to_list $v]
$v -acquire
$v -delete
set text "USERS:\n"
if {[llength $users_data] == 0} {
append text "Search returned no results."
} else {
foreach u [lsort -index 0 $users_data] {
append text "\n[_renderUser $u $show_all]"
}
}
Apol_Widget::appendSearchResultText $widgets(results) $text
.mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.ok configure -state normal
}
proc Apol_Users::_renderUser {user_name show_all} {
set text "$user_name"
if {!$show_all} {
return $text
}
set qpol_user_datum [new_qpol_user_t $::ApolTop::qpolicy $user_name]
if {[ApolTop::is_capable "mls"]} {
set default [$qpol_user_datum get_dfltlevel $::ApolTop::qpolicy]
set apol_default [new_apol_mls_level_t $::ApolTop::policy $default]
append text " level [$apol_default render $::ApolTop::policy]"
$apol_default -acquire
$apol_default -delete
set range [$qpol_user_datum get_range $::ApolTop::qpolicy]
set apol_range [new_apol_mls_range_t $::ApolTop::policy $range]
append text " range [$apol_range render $::ApolTop::policy]"
$apol_range -acquire
$apol_range -delete
}
set i [$qpol_user_datum get_role_iter $::ApolTop::qpolicy]
set roles {}
while {![$i end]} {
set qpol_role_datum [qpol_role_from_void [$i get_item]]
lappend roles [$qpol_role_datum get_name $::ApolTop::qpolicy]
$i next
}
append text " ([llength $roles] role"
if {[llength $roles] != 1} {
append text "s"
}
append text ")\n"
foreach r $roles {
append text " $r\n"
}
return $text
}
proc iter_to_list {iter} {
set list {}
while {![$iter end]} {
lappend list [$iter get_item]
$iter next
}
return $list
}
proc iter_to_str_list {iter} {
set list {}
while {![$iter end]} {
lappend list [to_str [$iter get_item]]
$iter next
}
return $list
}
proc list_to_vector {list} {
set v [new_apol_vector_t]
$v -acquire
foreach x $list {
$v append $x
}
return $v
}
proc list_to_str_vector {list} {
set v [new_apol_string_vector_t]
$v -acquire
foreach x $list {
$v append $x
}
return $v
}
proc str_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
lappend list [$v get_element $i]
}
return $list
}
proc attr_vector_to_list {v} {
type_vector_to_list $v
}
proc avrule_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_avrule_from_void [$v get_element $i]]
lappend list $q
}
return $list
}
proc bool_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_bool_from_void [$v get_element $i]]
lappend list [$q get_name $::ApolTop::qpolicy]
}
return $list
}
proc cat_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_cat_from_void [$v get_element $i]]
lappend list [$q get_name $::ApolTop::qpolicy]
}
return $list
}
proc class_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_class_from_void [$v get_element $i]]
lappend list [$q get_name $::ApolTop::qpolicy]
}
return $list
}
proc common_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_common_from_void [$v get_element $i]]
lappend list [$q get_name $::ApolTop::qpolicy]
}
return $list
}
proc cond_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_cond_from_void [$v get_element $i]]
lappend list $q
}
return $list
}
proc domain_trans_result_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set a [apol_domain_trans_result_from_void [$v get_element $i]]
lappend list $a
}
return $list
}
proc fs_use_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_fs_use_from_void [$v get_element $i]]
lappend list $q
}
return $list
}
proc genfscon_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_genfscon_from_void [$v get_element $i]]
lappend list $q
}
return $list
}
proc infoflow_result_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set a [apol_infoflow_result_from_void [$v get_element $i]]
lappend list $a
}
return $list
}
proc isid_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_isid_from_void [$v get_element $i]]
lappend list [$q get_name $::ApolTop::qpolicy]
}
return $list
}
proc level_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_level_from_void [$v get_element $i]]
lappend list [$q get_name $::ApolTop::qpolicy]
}
return $list
}
proc netifcon_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_netifcon_from_void [$v get_element $i]]
lappend list [$q get_name $::ApolTop::qpolicy]
}
return $list
}
proc nodecon_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_nodecon_from_void [$v get_element $i]]
lappend list $q
}
return $list
}
proc portcon_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
lappend list [qpol_portcon_from_void [$v get_element $i]]
}
return $list
}
proc range_trans_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
lappend list [qpol_range_trans_from_void [$v get_element $i]]
}
return $list
}
proc relabel_result_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
lappend list [apol_relabel_result_from_void [$v get_element $i]]
}
return $list
}
proc relabel_result_pair_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
lappend list [apol_relabel_result_pair_from_void [$v get_element $i]]
}
return $list
}
proc role_allow_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
lappend list [qpol_role_allow_from_void [$v get_element $i]]
}
return $list
}
proc role_trans_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
lappend list [qpol_role_trans_from_void [$v get_element $i]]
}
return $list
}
proc role_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_role_from_void [$v get_element $i]]
lappend list [$q get_name $::ApolTop::qpolicy]
}
return $list
}
proc terule_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_terule_from_void [$v get_element $i]]
lappend list $q
}
return $list
}
proc type_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_type_from_void [$v get_element $i]]
lappend list [$q get_name $::ApolTop::qpolicy]
}
return $list
}
proc user_vector_to_list {v} {
set list {}
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_user_from_void [$v get_element $i]]
lappend list [$q get_name $::ApolTop::qpolicy]
}
return $list
}
proc list_to_policy_path {path_type primary modules} {
if {$path_type == "monolithic"} {
set path_type $::APOL_POLICY_PATH_TYPE_MONOLITHIC
} else {
set path_type $::APOL_POLICY_PATH_TYPE_MODULAR
}
set ppath [new_apol_policy_path_t $path_type $primary [list_to_str_vector $modules]]
$ppath -acquire
return $ppath
}
proc policy_path_to_list {ppath} {
if {[$ppath get_type] == $::APOL_POLICY_PATH_TYPE_MONOLITHIC} {
set path_type "monolithic"
} else {
set path_type "modular"
}
set primary [$ppath get_primary]
set modules [str_vector_to_list [$ppath get_modules]]
list $path_type $primary $modules
}
set COPYRIGHT_INFO "Copyright (C) 2001-2008 Tresys Technology, LLC"
namespace eval ApolTop {
variable policy {} ;# handle to an apol_policy, or {} if none opened
variable qpolicy {} ;# handle to policy's qpol_policy_t, or {} if none opened
variable policy_version_string {}
variable policy_handle_unknown_string {}
variable policy_source_linenum {}
variable policy_stats_summary {}
variable policy_stats ;# array of statistics for the current policy
variable dot_apol_file [file join $::env(HOME) .apol]
variable recent_files {}
variable last_policy_path {}
variable max_recent_files 5
variable show_fake_attrib_warning 1 ;# warn if using fake attribute names
variable default_bg_color
variable text_font {}
variable title_font {}
variable dialog_font {}
variable general_font {}
variable query_file_ext ".qf"
variable mainframe_width 1000
variable mainframe_height 700
variable mainframe
variable notebook
variable current_tab
variable tabs {
{Apol_Types components {}}
{Apol_Class_Perms components {}}
{Apol_Roles components {}}
{Apol_Users components {}}
{Apol_Cond_Bools components {tag_conditionals}}
{Apol_MLS components {tag_mls}}
{Apol_Initial_SIDS components {}}
{Apol_NetContexts components {}}
{Apol_FSContexts components {}}
{Apol_Polcaps components {tag_polcap}}
{Apol_Namespaces components {}}
{Apol_TE rules {tag_query_saveable}}
{Apol_Cond_Rules rules {tag_conditionals}}
{Apol_Constraint rules {tag_query_saveable}}
{Apol_RBAC rules {}}
{Apol_Range rules {tag_mls}}
{Apol_Bounds rules {tag_bounds}}
{Apol_DefaultObjects rules {tag_default_objects}}
{Apol_File_Contexts {} {}}
{Apol_Analysis {} {tag_query_saveable}}
{Apol_PolicyConf {} {tag_source}}
}
}
proc ApolTop::is_policy_open {} {
if {$::ApolTop::policy == {}} {
return 0
}
return 1
}
proc ApolTop::is_capable {capability} {
if {![is_policy_open]} {
return 0;
}
switch -- $capability {
"attribute names" { set cap $::QPOL_CAP_ATTRIB_NAMES }
"conditionals" { set cap $::QPOL_CAP_CONDITIONALS }
"line numbers" { set cap $::QPOL_CAP_LINE_NUMBERS }
"mls" { set cap $::QPOL_CAP_MLS }
"neverallow" { set cap $::QPOL_CAP_NEVERALLOW }
"source" { set cap $::QPOL_CAP_SOURCE }
"syntactic rules" { set cap $::QPOL_CAP_SYN_RULES }
"polcap" { set cap $::QPOL_CAP_POLCAPS }
"bounds" { set cap $::QPOL_CAP_BOUNDS }
"default_objects" { set cap $::QPOL_CAP_DEFAULT_OBJECTS }
"default_type" { set cap $::QPOL_CAP_DEFAULT_TYPE }
"permissive" { set cap $::QPOL_CAP_PERMISSIVE }
"filename_trans" { set cap $::QPOL_CAP_FILENAME_TRANS }
default { return 0 }
}
variable qpolicy
$qpolicy has_capability $cap
}
proc ApolTop::openPolicyPath {ppath} {
_close_policy
set primary_file [$ppath get_primary]
if {[catch {Apol_Progress_Dialog::wait $primary_file "Opening policy." \
{
apol_tcl_open_policy $ppath
} \
} p] || $p == "NULL"} {
tk_messageBox -icon error -type ok -title "Open Policy" -parent . \
-message "[apol_tcl_get_error_string]"
return -1 ;# indicates failed to open policy
}
variable policy $p
variable qpolicy [$p get_qpol]
_toplevel_policy_open $ppath
_add_recent $ppath
variable last_policy_path $ppath
variable show_fake_attrib_warning
if {![is_capable "attribute names"] && \
[llength $::Apol_Types::attriblist] > 0 && \
$show_fake_attrib_warning} {
set d [Dialog .fake_attribute_dialog -modal local -parent . \
-title "Open Policy" -separator 1]
$d add -text "OK"
set f [$d getframe]
label $f.l -text "Warning: Apol has generated attribute names because\nthe original names were not preserved in the policy." -justify left
checkbutton $f.cb -text "Show this message again next time." \
-variable ApolTop::show_fake_attrib_warning
pack $f.l $f.cb -padx 10 -pady 10
$d draw
destroy $d
}
return 0 ;# indicates policy opened successfully
}
proc ApolTop::loadNeverAllows {} {
if {![is_capable "neverallow"]} {
Apol_Progress_Dialog::wait "Loading neverallow rules" "Rebuilding policy" \
{
$::ApolTop::qpolicy rebuild 0
_toplevel_update_stats
}
}
}
proc ApolTop::popup {parent x y menu callbacks callback_arg} {
set gx [winfo rootx $parent]
set gy [winfo rooty $parent]
set cmx [expr {$gx + $x}]
set cmy [expr {$gy + $y}]
$menu delete 0 end
foreach callback $callbacks {
$menu add command -label [lindex $callback 0] -command [concat [lindex $callback 1] $callback_arg]
}
tk_popup $menu $cmx $cmy
}
proc ApolTop::getCurrentTab {} {
variable current_tab
set current_tab
}
proc ApolTop::getCurrentTextWidget {} {
[getCurrentTab]::getTextWidget
}
proc ApolTop::setCurrentTab {tab_name} {
variable tabs
foreach tab $tabs {
if {[lindex $tab 0] == $tab_name} {
variable notebook
set parent_nb $notebook
foreach nb [lindex $tab 1] {
$parent_nb raise $nb
set parent_nb [$parent_nb getframe $nb].nb
}
$parent_nb raise $tab_name
variable current_tab $tab_name
_toplevel_tab_switched
return
}
}
puts stderr "\[setCurrentTab\] tried to set the tab to $tab_name"
exit -1
}
proc ApolTop::setPolicySourceLinenumber {line} {
variable policy_source_linenum "Line $line"
}
proc ApolTop::showPolicySourceLineNumber {line} {
setCurrentTab Apol_PolicyConf
Apol_PolicyConf::gotoLine $line
}
proc ApolTop::_create_toplevel {} {
set menus {
"&File" {} file 0 {
{command "&Open..." {} "Open a new policy" {Ctrl o} -command ApolTop::_open_policy}
{command "&Close" {tag_policy_open} "Close current polocy" {Ctrl w} -command ApolTop::_user_close_policy}
{separator}
{cascade "&Recent Files" {} recent 0 {}}
{separator}
{command "&Quit" {} "Quit policy analysis tool" {Ctrl q} -command ApolTop::_exit}
}
"&Edit" {} edit 0 {
{command "&Copy" {tag_policy_open} {} {Ctrl c} -command ApolTop::_copy}
{command "Select &All" {tag_policy_open} {} {Ctrl a} -command ApolTop::_select_all}
{separator}
{command "&Find..." {tag_policy_open} "Find text in current buffer" {Ctrl f} -command Apol_Find::find}
{command "&Goto Line..." {tag_policy_open} "Goto a line in current buffer" {Ctrl g} -command Apol_Goto::goto}
{separator}
}
"&Query" {} query 0 {
{command "&Open Query..." {tag_policy_open} "Open query criteria file" {} -command ApolTop::_open_query_file}
{command "&Save Query..." {tag_policy_open tag_query_saveable} "Save current query criteria to file" {} -command ApolTop::_save_query_file}
{separator}
{command "&Policy Summary" {tag_policy_open} "Display summary statistics" {} -command ApolTop::_show_policy_summary}
}
"&Tools" {} tools 0 {
{command "&Open Perm Map..." {tag_policy_open} "Open a permission map from file" {} -command ApolTop::_open_perm_map_from_file}
{command "Open &Default Perm Map" {tag_policy_open} "Open the default permission map" {} -command ApolTop::openDefaultPermMap}
{command "&Save Perm Map..." {tag_policy_open tag_perm_map_open} "Save the permission map to a file" {} -command ApolTop::_save_perm_map}
{command "Save Perm Map &As..." {tag_policy_open tag_perm_map_open} "Save the permission map to a file" {} -command ApolTop::_save_perm_map_as}
{command "Save Perm Map as D&efault" {tag_policy_open tag_perm_map_open} "Save the permission map to default file" {} -command ApolTop::_save_perm_map_default}
{command "&View Perm Map..." {tag_policy_open tag_perm_map_open} "Edit currently loaded permission map" {} -command Apol_Perms_Map::showPermMappings}
}
"&Help" {} helpmenu 0 {
{command "&General Help" {} "Show help on using apol" {} -command {ApolTop::_show_file Help apol_help.txt}}
{command "&Domain Transition Analysis" {} "Show help on domain transitions" {} -command {ApolTop::_show_file "Domain Transition Analysis Help" domaintrans_help.txt}}
{command "&Information Flow Analysis" {} "Show help on information flows" {} -command {ApolTop::_show_file "Information Flow Analysis Help" infoflow_help.txt}}
{command "Direct &Relabel Analysis" {} "Show help on file relabeling" {} -command {ApolTop::_show_file "Relabel Analysis Help" file_relabel_help.txt}}
{command "&Types Relationship Summary Analysis" {} "Show help on types relationships" {} -command {ApolTop::_show_file "Types Relationship Summary Analysis Help" types_relation_help.txt}}
{separator}
{command "&About apol" {} "Show copyright information" {} -command ApolTop::_about}
}
}
variable mainframe [MainFrame .mainframe -menu $menus -textvariable ApolTop::statu_line]
pack $mainframe -fill both -expand yes
$mainframe addindicator -textvariable ApolTop::policy_source_linenum -width 14
$mainframe addindicator -textvariable ApolTop::policy_stats_summary -width 88
$mainframe addindicator -textvariable ApolTop::policy_version_string -width 28
$mainframe setmenustate tag_policy_open disabled
variable notebook [NoteBook [$mainframe getframe].nb]
pack $notebook -fill both -expand yes -padx 4 -pady 4
set page [$notebook insert end components -text "Policy Components"]
set components [NoteBook $page.nb]
pack $components -fill both -expand yes -padx 4 -pady 4
set page [$notebook insert end rules -text "Policy Rules"]
set rules [NoteBook $page.nb]
pack $rules -fill both -expand yes -padx 4 -pady 4
$notebook bindtabs <Button-1> [list ApolTop::_switch_tab $components $rules]
$components bindtabs <Button-1> [list ApolTop::_switch_tab $components $rules]
$rules bindtabs <Button-1> [list ApolTop::_switch_tab $components $rules]
variable tabs
foreach tab $tabs {
set parent_nb $notebook
foreach nb [lindex $tab 1] {
set parent_nb [set $nb]
}
[lindex $tab 0]::create [lindex $tab 0] $parent_nb
}
$components raise [$components page 0]
$rules raise [$rules page 0]
$notebook raise [$notebook page 0]
$notebook compute_size
setCurrentTab [$components page 0]
}
proc ApolTop::_switch_tab {components_nb rules_nb new_tab} {
if {$new_tab == "components"} {
set new_tab [$components_nb raise]
} elseif {$new_tab == "rules"} {
set new_tab [$rules_nb raise]
}
variable current_tab $new_tab
_toplevel_tab_switched
}
proc ApolTop::_toplevel_tab_switched {} {
variable tabs
variable current_tab
variable mainframe
foreach tab $tabs {
if {[lindex $tab 0] != $current_tab} {
continue
}
focus [getCurrentTextWidget]
if {[lsearch [lindex $tab 2] "tag_query_saveable"] >= 0} {
$mainframe setmenustate tag_query_saveable normal
} else {
$mainframe setmenustate tag_query_saveable disabled
}
if {[lsearch [lindex $tab 2] "tag_source"] >= 0} {
[lindex $tab 0]::insertionMarkChanged
} else {
variable policy_source_linenum {}
}
break
}
}
proc ApolTop::_toplevel_policy_open {ppath} {
variable tabs
foreach tab $tabs {
[lindex $tab 0]::open $ppath
}
if {![is_capable "conditionals"]} {
_toplevel_enable_tabs tag_conditionals disabled
}
if {![is_capable "mls"]} {
_toplevel_enable_tabs tag_mls disabled
}
if {![is_capable "source"]} {
_toplevel_enable_tabs tag_source disabled
}
if {![is_capable "polcap"]} {
_toplevel_enable_tabs tag_polcap disabled
}
if {![is_capable "bounds"]} {
_toplevel_enable_tabs tag_bounds disabled
}
if {![is_capable "default_objects"]} {
_toplevel_enable_tabs tag_default_objects disabled
}
_toplevel_tab_switched
variable mainframe
$mainframe setmenustate tag_policy_open normal
$mainframe setmenustate tag_perm_map_open disabled
_toplevel_update_stats
variable policy_version_string [$::ApolTop::policy get_version_type_mls_str]
variable policy_handle_unknown_string
set policy_handle_unknown -1
set policy_handle_unknown [$::ApolTop::policy get_policy_handle_unknown]
if {$policy_handle_unknown == 0} {
set policy_handle_unknown_string "deny"
} elseif {$policy_handle_unknown == 2} {
set policy_handle_unknown_string "reject"
} elseif {$policy_handle_unknown == 4} {
set policy_handle_unknown_string "allow"
} else {
set policy_handle_unknown_string "unknown"
}
set primary_file [$ppath get_primary]
wm title . "SELinux Policy Analysis - $primary_file"
}
proc ApolTop::_toplevel_enable_tabs {tag new_state} {
variable tabs
variable notebook
foreach tab $tabs {
if {[lsearch [lindex $tab 2] $tag] >= 0} {
set parent_nb $notebook
foreach nb [lindex $tab 1] {
set parent_nb [$parent_nb getframe $nb].nb
}
$parent_nb itemconfigure [lindex $tab 0] -state $new_state
if {[$parent_nb raise] == {}} {
$parent_nb raise [$parent_nb pages 0]
setCurrentTab [lindex $tabs 0 0]
}
}
}
}
proc ApolTop::_build_recent_files_menu {} {
variable mainframe
variable recent_files
variable max_recent_files
set recent_menu [$mainframe getmenu recent]
$recent_menu delete 0 $max_recent_files
foreach r $recent_files {
foreach {path_type primary_file modules} [policy_path_to_list $r] {break}
if {$path_type == "monolithic"} {
set label $primary_file
} else {
set label "$primary_file + [llength $modules] module"
if {[llength $modules] != 1} {
append label "s"
}
}
$recent_menu add command -label $label \
-command [list ApolTop::openPolicyPath $r]
}
}
proc ApolTop::_add_recent {ppath} {
variable recent_files
variable max_recent_files
set new_recent $ppath
foreach r $recent_files {
if {[apol_policy_path_compare $r $ppath] != 0} {
lappend new_recent $r
}
}
set recent_files [lrange $new_recent 0 [expr {$max_recent_files - 1}]]
_build_recent_files_menu
}
proc ApolTop::_toplevel_update_stats {} {
variable policy_stats
variable policy_stats_summary
set iter_funcs {
"classes" get_class_iter
"commons" get_common_iter
"roles" get_role_iter
"role_allow" get_role_allow_iter
"role_trans" get_role_trans_iter
"users" get_user_iter
"bools" get_bool_iter
"sens" get_level_iter
"cats" get_cat_iter
"range_trans" get_range_trans_iter
"constraints" get_constraint_iter
"validatetrans" get_validatetrans_iter
"filename_trans" get_filename_trans_iter
"sids" get_isid_iter
"portcons" get_portcon_iter
"netifcons" get_netifcon_iter
"nodecons" get_nodecon_iter
"genfscons" get_genfscon_iter
"fs_uses" get_fs_use_iter
"permissive" get_permissive_iter
"polcap" get_polcap_iter
}
foreach {key func} $iter_funcs {
set i [$::ApolTop::qpolicy $func]
set policy_stats($key) [$i get_size]
$i -acquire
$i -delete
}
set query_funcs {
"perms" new_apol_perm_query_t
"types" new_apol_type_query_t
"attribs" new_apol_attr_query_t
}
foreach {key func} $query_funcs {
set q [$func]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set policy_stats($key) [$v get_size]
$v -acquire
$v -delete
}
set avrule_bits [list \
avrule_allow $::QPOL_RULE_ALLOW \
avrule_auditallow $::QPOL_RULE_AUDITALLOW \
avrule_dontaudit $::QPOL_RULE_DONTAUDIT \
avrule_neverallow $::QPOL_RULE_NEVERALLOW \
]
foreach {key bit} $avrule_bits {
if {$bit == $::QPOL_RULE_NEVERALLOW && ![is_capable "neverallow"]} {
set policy_stats($key) 0
} else {
set i [$::ApolTop::qpolicy get_avrule_iter $bit]
set policy_stats($key) [$i get_size]
$i -acquire
$i -delete
}
}
set terule_bits [list \
type_trans $::QPOL_RULE_TYPE_TRANS \
type_member $::QPOL_RULE_TYPE_CHANGE \
type_change $::QPOL_RULE_TYPE_MEMBER \
]
foreach {key bit} $terule_bits {
set i [$::ApolTop::qpolicy get_avrule_iter $bit]
set policy_stats($key) [$i get_size]
$i -acquire
$i -delete
}
if {[ApolTop::is_capable "mls"]} {
set mlsconstrain_count [ApolTop::_get_mls_count new_apol_constraint_query_t]
set policy_stats(constraints) [expr $policy_stats(constraints) - $mlsconstrain_count]
set policy_stats(mlsconstraints) $mlsconstrain_count
set mlsvalidatetrans_count [ApolTop::_get_mls_count new_apol_validatetrans_query_t]
set policy_stats(validatetrans) [expr $policy_stats(validatetrans) - $mlsvalidatetrans_count]
set policy_stats(mlsvalidatetrans) $mlsvalidatetrans_count
} else {
set policy_stats(mlsconstraints) 0
set policy_stats(mlsvalidatetrans) 0
}
set policy_stats(userbounds) 0
set policy_stats(rolebounds) 0
set policy_stats(typebounds) 0
if {[is_capable "bounds"]} {
set q [new_apol_userbounds_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_userbounds_from_void [$v get_element $i]]
set parent [$q get_parent_name $::ApolTop::qpolicy]
if {$parent != ""} {
set policy_stats(userbounds) [expr $policy_stats(userbounds) + 1]
}
}
}
set q [new_apol_rolebounds_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_rolebounds_from_void [$v get_element $i]]
set parent [$q get_parent_name $::ApolTop::qpolicy]
if {$parent != ""} {
set policy_stats(rolebounds) [expr $policy_stats(rolebounds) + 1]
}
}
}
set q [new_apol_typebounds_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_typebounds_from_void [$v get_element $i]]
set parent [$q get_parent_name $::ApolTop::qpolicy]
if {$parent != ""} {
set policy_stats(typebounds) [expr $policy_stats(typebounds) + 1]
}
}
}
}
set policy_stats(default_user) 0
set policy_stats(default_role) 0
set policy_stats(default_type) 0
set policy_stats(default_range) 0
if {[is_capable "default_objects"]} {
set q [new_apol_default_object_query_t]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_default_object_from_void [$v get_element $i]]
set default [$q get_user_default $::ApolTop::qpolicy]
if {$default != ""} {
set policy_stats(default_user) [expr $policy_stats(default_user) + 1]
}
set default [$q get_role_default $::ApolTop::qpolicy]
if {$default != ""} {
set policy_stats(default_role) [expr $policy_stats(default_role) + 1]
}
if {[is_capable "default_type"]} {
set default [$q get_type_default $::ApolTop::qpolicy]
if {$default != ""} {
set policy_stats(default_type) [expr $policy_stats(default_type) + 1]
}
}
set default [$q get_range_default $::ApolTop::qpolicy]
if {$default != ""} {
set policy_stats(default_range) [expr $policy_stats(default_range) + 1]
}
}
}
}
set policy_stats_summary ""
append policy_stats_summary "Classes: $policy_stats(classes) "
append policy_stats_summary "Perms: $policy_stats(perms) "
append policy_stats_summary "Types: $policy_stats(types) "
append policy_stats_summary "Attribs: $policy_stats(attribs) "
set num_te_rules [expr {$policy_stats(avrule_allow) + $policy_stats(avrule_auditallow) +
$policy_stats(avrule_dontaudit) + $policy_stats(avrule_neverallow) +
$policy_stats(type_trans) + $policy_stats(type_member) +
$policy_stats(type_change)}]
if {![is_capable "neverallow"]} {
append num_te_rules "+"
}
append policy_stats_summary "AV + TE rules: $num_te_rules "
append policy_stats_summary "Roles: $policy_stats(roles) "
append policy_stats_summary "Users: $policy_stats(users)"
}
proc ApolTop::_open_policy {} {
variable last_policy_path
Apol_Open_Policy_Dialog::getPolicyPath $last_policy_path
}
proc ApolTop::_user_close_policy {} {
variable last_policy_path
_close_policy
set last_policy_path {}
}
proc ApolTop::_close_policy {} {
variable policy_version_string {}
variable policy_handle_unknown {}
variable policy_stats_summary {}
wm title . "SELinux Policy Analysis"
set i 0
Apol_Progress_Dialog::wait "apol" "Closing policy." \
{
variable tabs
foreach tab $tabs {
if {[catch [lindex $tab 0]::close]} {
set i [expr $i+2]
}
}
Apol_Perms_Map::close
variable policy
if {$policy != {}} {
$policy -acquire
$policy -delete
set policy {}
variable qpolicy {}
}
}
variable mainframe
$mainframe setmenustate tag_policy_open disabled
$mainframe setmenustate tag_perm_map_open disabled
_toplevel_enable_tabs tag_conditionals normal
_toplevel_enable_tabs tag_mls normal
_toplevel_enable_tabs tag_polcap normal
_toplevel_enable_tabs tag_bounds normal
_toplevel_enable_tabs tag_default_objects normal
}
proc ApolTop::_exit {} {
variable policy
if {$policy != {}} {
_close_policy
}
Apol_File_Contexts::close
_write_configuration_file
exit
}
proc ApolTop::_copy {} {
set w [getCurrentTextWidget]
if {$w != {} && [$w tag ranges sel] != {}} {
set data [$w get sel.first sel.last]
clipboard clear
clipboard append -- $data
}
}
proc ApolTop::_select_all {} {
set w [getCurrentTextWidget]
if {$w != {}} {
$w tag add sel 1.0 end
}
}
proc ApolTop::_find {} {
Apol_Find::find
}
proc ApolTop::_goto {} {
Apol_Goto::goto
}
proc ApolTop::_open_query_file {} {
set types " {\"Query files\" { $ApolTop::query_file_ext }} "
set query_file [tk_getOpenFile -filetypes $types -title "Open Apol Query" \
-defaultextension $ApolTop::query_file_ext -parent .]
if {$query_file != {}} {
if {[catch {::open $query_file r} f]} {
tk_messageBox -icon error -type ok -title "Open Apol Query" \
-message "Could not open $query_file: $f"
}
while {[gets $f line] >= 0} {
set query_id [string trim $line]
if {$query_id == {} || [string index $query_id 0] == "#"} {
continue
}
break
}
variable tabs
foreach tab $tabs {
if {$query_id == [lindex $tab 0] && [lsearch [lindex $tab 2] "tag_query_saveable"] >= 0} {
if {[catch {${query_id}::load_query_options $f} err]} {
tk_messageBox -icon error -type ok -title "Open Apol Query" \
-message $err
} else {
setCurrentTab $query_id
}
return
}
}
tk_messageBox -icon error -type ok -title "Open Apol Query" \
-message "The query criteria file could not be read and may be corrupted."
close $f
}
}
proc ApolTop::_save_query_file {} {
set types " {\"Query files\" {$ApolTop::query_file_ext}} "
set query_file [tk_getSaveFile -title "Save Apol Query" \
-defaultextension $ApolTop::query_file_ext \
-filetypes $types -parent .]
if {$query_file != {}} {
if {[catch {::open $query_file w} f]} {
tk_messageBox -icon error -type ok -title "Save Apol Query" \
-message "Could not save $query_file: $f"
}
if {[catch {puts $f [getCurrentTab]} err]} {
tk_messageBox -icon error -type ok -title "Save Apol Query" \
-message $err
}
if {[catch {[getCurrentTab]::save_query_options $f $query_file} err]} {
tk_messageBox -icon error -type ok -title "Save Apol Query" \
-message $err
}
close $f
}
}
proc ApolTop::_show_policy_summary {} {
variable policy_version_string
variable policy_handle_unknown_string
variable policy_stats
if {![regexp -- {^([^\(]+) \(([^,]+), ([^\)]+)} $ApolTop::policy_version_string -> policy_version policy_type policy_mls_type]} {
set policy_version $ApolTop::policy_version_string
set policy_type "unknown"
set policy_mls_type "unknown"
}
set policy_version [string trim $policy_version]
destroy .policy_statsbox
set dialog [Dialog .policy_statsbox -separator 1 -title "Policy Summary" \
-modal none -parent .]
$dialog add -text Close -command [list destroy $dialog]
set w [$dialog getframe]
label $w.title -text "Policy Summary Statistics"
set f [frame $w.summary]
label $f.l -justify left -text " Policy Version:\n Policy Type:\n MLS Status:\n Handle unknown Class/Perms:"
label $f.r -justify left -text "$policy_version\n$policy_type\n$policy_mls_type\n$policy_handle_unknown_string"
grid $f.l $f.r -sticky w
grid configure $f.r -padx 30
grid $w.title - -sticky w -padx 8
grid $f - -sticky w -padx 8
grid [Separator $w.sep] - -sticky ew -pady 5
set f [frame $w.left]
set i 0
foreach {title block} {
"Number of Classes and Permissions" {
"Object Classes" classes
"Common Permissions" commons
"Permissions" perms
}
"Number of Types and Attributes" {
"Types" types
" that includes permissive types" permissive
" that includes bounded types" typebounds
"Attributes" attribs
}
"Number of Type Enforcement Rules" {
"allows" avrule_allow
"auditallows" avrule_auditallow
"dontaudits" avrule_dontaudit
"neverallows" avrule_neverallow
"type_transitions" type_trans
"type_transitions - filename" filename_trans
"type_members" type_member
"type_changes" type_change
}
"Number of Roles" {
"Roles" roles
" that includes bounded roles" rolebounds
}
"Number of RBAC Rules" {
"allows" role_allow
"role_transitions" role_trans
}
"Number of Default Object Rules" {
"default_user" default_user
"default_role" default_role
"default_type" default_type
"default_range" default_range
}
} {
set ltext "$title:"
set rtext {}
foreach {l r} $block {
append ltext "\n $l:"
if {$r != "avrule_neverallow" || [is_capable "neverallow"]} {
append rtext "\n$policy_stats($r)"
} else {
append rtext "\nN/A"
}
}
label $f.l$i -justify left -text $ltext
label $f.r$i -justify left -text $rtext
grid $f.l$i $f.r$i -sticky w -padx 4 -pady 2
incr i
}
set i 0
set g [frame $w.right]
foreach {title block} {
"Number of Users" {
"Users" users
" that includes bounded users" userbounds
}
"Number of Booleans" {
"Booleans" bools
}
"Number of Constraints" {
"constrain" constraints
"validatetrans" validatetrans
}
"Number of MLS Components" {
"Sensitivities" sens
"Categories" cats
}
"Number of MLS Rules" {
"range_transitions" range_trans
"mlsconstrain" mlsconstraints
"mlsvalidatetrans" mlsvalidatetrans
}
"Number of Initial SIDs" {
"SIDs" sids
}
"Number of OContexts" {
"PortCons" portcons
"NetIfCons" netifcons
"NodeCons" nodecons
"GenFSCons" genfscons
"fs_use statements" fs_uses
}
"Number of Policy Capabilities" {
"polcap" polcap
}
} {
set ltext "$title:"
set rtext {}
foreach {l r} $block {
append ltext "\n $l:"
append rtext "\n$policy_stats($r)"
}
label $g.l$i -justify left -text $ltext
label $g.r$i -justify left -text $rtext
grid $g.l$i $g.r$i -sticky w -padx 4 -pady 2
incr i
}
grid $f $g -sticky nw -padx 4
$dialog draw
}
proc ApolTop::_open_perm_map_from_file {} {
if {[Apol_Perms_Map::openPermMapFromFile]} {
variable mainframe
$mainframe setmenustate tag_perm_map_open normal
}
}
proc ApolTop::openDefaultPermMap {} {
if {[Apol_Perms_Map::openDefaultPermMap]} {
variable mainframe
$mainframe setmenustate tag_perm_map_open normal
return 1
}
return 0
}
proc ApolTop::_save_perm_map {} {
Apol_Perms_Map::savePermMap
}
proc ApolTop::_save_perm_map_as {} {
Apol_Perms_Map::savePermMapAs
}
proc ApolTop::_save_perm_map_default {} {
Apol_Perms_Map::saveDefaultPermMap
}
proc ApolTop::_show_file {title file_name} {
set helpfile [file join [tcl_config_get_install_dir] $file_name]
if {[catch {::open $helpfile} f]} {
set info $f
} else {
set info [read $f]
close $f
}
Apol_Widget::showPopupParagraph $title $info
}
proc ApolTop::_about {} {
if {[winfo exists .apol_about]} {
raise .apol_about
} else {
variable apol_icon
Dialog .apol_about -cancel 0 -default 0 -image $apol_icon \
-modal none -parent . -separator 1 -title "About apol"
set f [.apol_about getframe]
set l1 [label $f.l1 -text "apol [tcl_config_get_version]" -height 2]
set label_font [$l1 cget -font]
if {[llength $label_font] > 1} {
foreach {name size} [$l1 cget -font] {break}
incr size 6
$l1 configure -font [list $name $size bold]
}
set l2 [label $f.l2 -text "Security Policy Analysis Tool for Security Enhanced Linux\n${::COPYRIGHT_INFO}\nhttp://oss.tresys.com/projects/setools"]
pack $l1 $l2
.apol_about add -text "Close" -command [list destroy .apol_about]
.apol_about draw
}
}
proc ApolTop::_load_fonts {} {
variable title_font
variable dialog_font
variable general_font
variable text_font
tk scaling -displayof . 1.0
if {$general_font == ""} {
set general_font "Helvetica 10"
}
option add *Font $general_font
if {$title_font == {}} {
set title_font "Helvetica 10 bold italic"
}
option add *TitleFrame.l.font $title_font
if {$dialog_font == {}} {
set dialog_font "Helvetica 10"
}
option add *Dialog*font $dialog_font
option add *Dialog*TitleFrame.l.font $title_font
if {$text_font == ""} {
set text_font "fixed"
}
option add *text*font $text_font
}
proc ApolTop::_read_configuration_file {} {
variable dot_apol_file
variable recent_files
if {![file exists $dot_apol_file]} {
return
}
if {[catch {::open $dot_apol_file r} f]} {
tk_messageBox -icon error -type ok -title "apol" \
-message "Could not open $dot_apol_file: $f"
return
}
while {![eof $f]} {
set option [string trim [gets $f]]
if {$option == {} || [string compare -length 1 $option "\#"] == 0} {
continue
}
set value [string trim [gets $f]]
if {[eof $f]} {
puts stderr "EOF reached while reading $option"
break
}
if {$value == {}} {
puts stderr "Empty value for option $option"
continue
}
switch -- $option {
"\[window_height\]" {
if {[string is integer -strict $value] != 1} {
puts stderr "window_height was not given as an integer and is ignored"
break
}
variable mainframe_height $value
}
"\[window_width\]" {
if {[string is integer -strict $value] != 1} {
puts stderr "window_width was not given as an integer and is ignored"
break
}
variable mainframe_width $value
}
"\[title_font\]" {
variable title_font $value
}
"\[dialog_font\]" {
variable dialog_font $value
}
"\[text_font\]" {
variable text_font $value
}
"\[general_font\]" {
variable general_font $value
}
"\[show_fake_attrib_warning\]" {
variable show_fake_attrib_warning $value
}
"\[max_recent_files\]" {
if {[string is integer -strict $value] != 1} {
puts stderr "max_recent_files was not given as an integer and is ignored"
} else {
if {$value < 2} {
variable max_recent_files 2
} else {
variable max_recent_files $value
}
}
}
"recent_files" {
if {[string is integer -strict $value] != 1} {
puts stderr "Number of recent files was not given as an integer and was ignored."
continue
} elseif {$value < 0} {
puts stderr "Number of recent was less than 0 and was ignored."
continue
}
while {$value > 0} {
incr value -1
set line [gets $f]
if {[eof $f]} {
puts stderr "EOF reached trying to read recent files."
break
}
if {[llength $line] == 1} {
set ppath [new_apol_policy_path_t $::APOL_POLICY_PATH_TYPE_MONOLITHIC $line NULL]
$ppath -acquire
} else {
foreach {path_type primary modules} $line {break}
if {[catch {list_to_policy_path $path_type $primary $modules} ppath]} {
puts stderr "Invalid policy path line: $line"
continue
}
}
lappend recent_files $ppath
}
}
}
}
close $f
}
proc ApolTop::_write_configuration_file {} {
variable dot_apol_file
variable recent_files
variable text_font
variable title_font
variable dialog_font
variable general_font
if {[catch {::open $dot_apol_file w} f]} {
tk_messageBox -icon error -type ok -title "apol" \
-message "Could not open $dot_apol_file for writing: $f"
return
}
puts $f "recent_files"
puts $f [llength $recent_files]
foreach r $recent_files {
puts $f [policy_path_to_list $r]
}
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 "\[show_fake_attrib_warning\]"
variable show_fake_attrib_warning
puts $f $show_fake_attrib_warning
puts $f "\[max_recent_files\]"
variable max_recent_files
puts $f $max_recent_files
close $f
}
proc ApolTop::_get_mls_count {command} {
set q [$command]
set v [$q run $::ApolTop::policy]
$q -acquire
$q -delete
set mls_count 0
for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
set q [qpol_constraint_from_void [$v get_element $i]]
set x [$q get_expr_iter $::ApolTop::qpolicy]
while {![$x end]} {
foreach t [iter_to_list $x] {
set t [qpol_constraint_expr_node_from_void $t]
set sym_type [$t get_sym_type $::ApolTop::qpolicy]
if { $sym_type >= $::QPOL_CEXPR_SYM_L1L2 } {
set mls_count [expr $mls_count + 1]
break
}
}
}
$x -acquire
$x -delete
}
return $mls_count
}
proc ApolTop::main {} {
variable notebook
tcl_config_init
rename send {}
if {[catch {package require BWidget}]} {
tk_messageBox -icon error -type ok -title "Apol Startup" -message \
"The BWidget package could not be found. Ensure that BWidget is installed in a location that Tcl/Tk can read."
exit -1
}
wm withdraw .
wm title . "SELinux Policy Analysis"
wm protocol . WM_DELETE_WINDOW ApolTop::_exit
variable default_bg_color [. cget -background]
catch {tcl_config_patch_bwidget}
_load_fonts
_read_configuration_file
_create_toplevel
bind . <Button-1> {focus %W}
bind . <Button-2> {focus %W}
bind . <Button-3> {focus %W}
_build_recent_files_menu
set icon_file [file join [tcl_config_get_install_dir] apol.gif]
if {![catch {image create photo -file $icon_file} icon]} {
catch {wm iconphoto . -default $icon}
}
variable apol_icon $icon
variable mainframe_width [$notebook cget -width]
variable mainframe_height [$notebook cget -height]
wm geom . ${mainframe_width}x${mainframe_height}
wm deiconify .
raise .
focus .
}
proc handle_args {argv0 argv} {
set argvp 0
while {$argvp < [llength $argv]} {
set arg [lindex $argv $argvp]
switch -- $arg {
"-h" - "--help" { print_help $argv0 verbose; exit }
"-V" - "--version" { print_version_info; exit }
"--" { incr argvp; break }
default {
if {[string index $arg 0] != "-"} {
break
} else {
puts stderr "$argv0: unrecognized option `$arg'"
print_help $argv0 brief
exit 1
}
}
}
incr argvp
}
set arglen [expr [llength $argv]-$argvp]
set ppath {}
if {$arglen <= 0} {
return {}
} elseif {$arglen == 1} {
set path_type $::APOL_POLICY_PATH_TYPE_MONOLITHIC
set policy_file [lindex $argv $argvp]
set mod_paths [list_to_str_vector {}]
if {[apol_file_is_policy_path_list $policy_file]} {
set ppath [new_apol_policy_path_t $policy_file]
}
} elseif {$arglen > 1} {
set path_type $::APOL_POLICY_PATH_TYPE_MODULAR
set policy_file {}
foreach f [lrange $argv $argvp end] {
if {[catch {Apol_Open_Policy_Dialog::getModuleInfo $f} modinfo]} {
tk_messageBox -icon error -type ok -title "Module access error" -message $modinfo
} else {
foreach {name vers type} $modinfo {break}
if {$type == 1} { ;# This file is a base 'module'
if {$policy_file != {} && $policy_file != $f} {
set rsp [tk_messageBox -icon error -type okcancel -title "Open Module" -message "Multiple base entries found." -detail "Current file: $policy_file\n\nNew file: $f\n\nClick OK to ignore new file, Cancel to exit"]
if {$rsp == "cancel"} { exit 1}
} else {
set policy_file $f
}
} else { ;# Append regular modules to the list.
lappend module_list $f
}
}
}
set mod_paths [list_to_str_vector $module_list]
}
if {$ppath == {}} {
set ppath [new_apol_policy_path_t $path_type $policy_file $mod_paths]
}
if {$ppath == {}} {
puts stderr "Error loading $policy_file."
} else {
$ppath -acquire
}
return $ppath
}
proc print_help {program_name verbose} {
puts "Usage: $program_name \[OPTIONS\] \[POLICY ...\]\n"
if {$verbose != "verbose"} {
puts "\tTry $program_name --help for more help.\n"
} else {
puts "Policy Analysis tool for Security Enhanced Linux.\n"
puts " -h, --help print this help text and exit"
puts " -V, --version print version information and exit\n"
}
}
proc print_version_info {} {
puts "apol [tcl_config_get_version]\n$::COPYRIGHT_INFO"
}
proc print_init {s} {
puts -nonewline $s
flush stdout
}
if {[catch {tcl_config_init_libraries}]} {
puts stderr "FAILED. The SETools libraries could not be found in any of these subdirectories:\n\t[join $auto_path "\n\t"]"
exit -1
}
print_init "Initializing Tk... "
if {[catch {package require Tk}]} {
puts stderr "FAILED. This library could not be found in any of these subdirectories:\n\t[join $auto_path "\n\t"]"
puts stderr "This may indicate a problem with the tcl package's auto_path variable.\n"
exit -1
}
puts "done."
set path [handle_args $argv0 $argv]
ApolTop::main
if {$path != {}} {
after idle [list ApolTop::openPolicyPath $path]
}