diff options
Diffstat (limited to 'apol/mls_tab.tcl')
| -rw-r--r-- | apol/mls_tab.tcl | 332 |
1 files changed, 332 insertions, 0 deletions
diff --git a/apol/mls_tab.tcl b/apol/mls_tab.tcl new file mode 100644 index 0000000..e8e5a8e --- /dev/null +++ b/apol/mls_tab.tcl @@ -0,0 +1,332 @@ +# Copyright (C) 2001-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 + +namespace eval Apol_MLS { + variable widgets + variable vals +} + +proc Apol_MLS::create {tab_name nb} { + variable widgets + variable vals + + _initializeVars + + # Layout frames + 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 + + # build the left column, where one may browse sensitivities and categories + 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 + + # build the search options + 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 + + # build the results box + 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 +} + +# Given a sensitivity name, return a non-empty string if that +# sensitivity is within the loaded policy. This string is the same as +# the given parameter if the name is a sensitivity; it will be the +# real sensitivity's name if the parameter is an alias. If no policy +# has been loaded then return an empty string. +proc Apol_MLS::isSensInPolicy {sens} { + variable vals + if {![ApolTop::is_policy_open]} { + return {} + } + if {[lsearch $vals(senslist) $sens] >= 0} { + return $sens + } + # try looking up aliases + 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 {} +} + +#### private functions below #### + +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 +} |