diff options
Diffstat (limited to 'apol/directflow_module.tcl')
| -rw-r--r-- | apol/directflow_module.tcl | 582 |
1 files changed, 582 insertions, 0 deletions
diff --git a/apol/directflow_module.tcl b/apol/directflow_module.tcl new file mode 100644 index 0000000..61055ec --- /dev/null +++ b/apol/directflow_module.tcl @@ -0,0 +1,582 @@ +# 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_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] + # 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:selected { + set classes $value + } + default { + set vals($key) $value + } + } + } + + # fill in only classes found within the current policy + 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 +} + +#################### private functions below #################### + +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) {} +} + +#################### functions that do analyses #################### + +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 a permap is not loaded then load the default permap + 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} { + # 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 {} + } + set g [lindex [$tree itemcget top -data] 0] + $g do_more $::ApolTop::policy $new_start +} + +################# functions that control analysis output ################# + +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 { + # an informational node, whose data has already been rendered + eval $res.tb insert end [lindex $data 1] + } + $res.tb configure -state disabled + } +} + +# perform additional direct infoflows if this node has not been +# analyzed yet +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] + # mark this node as having been expanded + $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." +} + +# If do_expand is zero, then generate result nodes for only the first +# target type of $results. This is needed by two types relationship +# analysis. +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 + } +} |