From 47be9ff57e72906660bb62a515222f482131e1fb Mon Sep 17 00:00:00 2001 From: Miroslav Grepl Date: Fri, 11 Apr 2014 09:37:53 +0200 Subject: Create setools-3.3.7 git repo --- apol/relabel_module.tcl | 898 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 898 insertions(+) create mode 100644 apol/relabel_module.tcl (limited to 'apol/relabel_module.tcl') diff --git a/apol/relabel_module.tcl b/apol/relabel_module.tcl new file mode 100644 index 0000000..ddace64 --- /dev/null +++ b/apol/relabel_module.tcl @@ -0,0 +1,898 @@ +# Copyright (C) 2003-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_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 -acquire + $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] + # Skip empty lines and comments + 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 + } + } + } + + # fill in the exclusion lists using only classes/types found + # within the current policy + 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 +} + +#################### private functions below #################### + +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 +} + +# disallow both to and from to be deselected +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 + } +} + +################# functions that do advanced filters ################# + +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] + # remove any old traces on the attribute + 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 == {}} { + # unknown attribute, so don't change listboxes + 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) + } +} + +#################### functions that do analyses #################### + +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 +} + +################# functions that control analysis output ################# + +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 { + # an informational node, whose data has already been rendered + 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} + + # determine direction of relabelling + 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 +} -- cgit