1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 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
}
|