diff options
Diffstat (limited to 'apol/domaintrans_module.tcl')
| -rw-r--r-- | apol/domaintrans_module.tcl | 999 |
1 files changed, 999 insertions, 0 deletions
diff --git a/apol/domaintrans_module.tcl b/apol/domaintrans_module.tcl new file mode 100644 index 0000000..ea1d471 --- /dev/null +++ b/apol/domaintrans_module.tcl @@ -0,0 +1,999 @@ +# 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_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 { + # don't save these variables + } + 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] + # Skip empty lines and comments + 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 + } + } + + # fill in the inclusion lists using only types/classes found + # within the current policy + 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 +} + +#################### private functions below #################### + +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 + } +} + +################# functions that do access filters ################# + +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] + # remove any old traces on the attribute + 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) {} +} + +#################### functions that do analyses #################### + +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} { + # disallow more analysis if this node is the same as its parent + 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 +} + +################# functions that control analysis output ################# + +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 { + # an informational node, whose data has already been rendered + eval $res.tb insert end $data + } + $res.tb configure -state disabled + } +} + +# perform additional domain transitions if this node has not been +# analyzed yet +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 }] + # mark this node as having been expanded + $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} + # direction of domain transition is encoded encoded in the node's + # identifier + 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 + } +} |