diff options
Diffstat (limited to 'apol/common_widgets.tcl')
| -rw-r--r-- | apol/common_widgets.tcl | 688 |
1 files changed, 688 insertions, 0 deletions
diff --git a/apol/common_widgets.tcl b/apol/common_widgets.tcl new file mode 100644 index 0000000..617cd70 --- /dev/null +++ b/apol/common_widgets.tcl @@ -0,0 +1,688 @@ +# 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_Widget { + variable menuPopup {} + variable infoPopup {} + variable infoPopup2 {} + variable vars +} + +# Create a listbox contained within a scrolled window. Whenever the +# listbox has focus, if the user hits an alphanum key then scroll to +# the first entry beginning with that letter. That entry is then +# selected, with all others being cleared. Repeatedly hitting the +# same key causes the widget to select succesive entries, wrapping +# back to the first when at the end of the list. (This behavior +# assumes that the listbox has been alphabetized.) +proc Apol_Widget::makeScrolledListbox {path args} { + set sw [ScrolledWindow $path -scrollbar both -auto both] + set lb [eval listbox $sw.lb $args -bg white -highlightthickness 0] + $sw setwidget $lb + + update + grid propagate $sw 0 + bind $lb <<ListboxSelect>> [list focus $lb] + + # if the user hits a letter while the listbox has focus, jump to + # the first entry that begins with that letter + bind $lb <Key> [list Apol_Widget::_listbox_key $lb %K] + return $sw +} + +# Add callback(s) to a listbox. The callback_list is a list of +# 2-uple entries like so: +# +# menu_name {function ?args?} +# +# The first entry is executed upon double-clicks. +proc Apol_Widget::setListboxCallbacks {path callback_list} { + set lb [getScrolledListbox $path] + + # add double-click on an item to immediately do something + bind $lb <Double-Button-1> [eval list Apol_Widget::_listbox_double_click $lb [lindex $callback_list 0 1]] + + # enable right-clicks on listbox to popup a menu; that menu lets + # the user see more info + set lb [getScrolledListbox $path] + bind $lb <Button-3> [list Apol_Widget::_listbox_popup %W %x %y $callback_list $lb] +} + +proc Apol_Widget::getScrolledListbox {path} { + return $path.lb +} + +proc Apol_Widget::setScrolledListboxState {path newState} { + if {$newState == 0 || $newState == "disabled"} { + $path.lb configure -state disabled + } else { + $path.lb configure -state normal + } +} + +# Create combobox from which the user may choose a type. Then create +# a combobox from which the user may select an attribute; this +# attribute filters the allowable types. +proc Apol_Widget::makeTypeCombobox {path args} { + variable vars + array unset vars $path:* + set vars($path:type) "" + set vars($path:attribenable) 0 + set vars($path:attrib) "" + + set f [frame $path] + set type_box [eval ComboBox $f.tb -helptext {{Type or select a type}} \ + -textvariable Apol_Widget::vars($path:type) \ + -entrybg white -width 20 -autopost 1 $args] + pack $type_box -side top -expand 1 -fill x + + set attrib_width [expr {[$type_box cget -width] - 4}] + set attrib_enable [checkbutton $f.ae \ + -anchor w -text "Filter by attribute"\ + -variable Apol_Widget::vars($path:attribenable) \ + -command [list Apol_Widget::_attrib_enabled $path]] + set attrib_box [ComboBox $f.ab -autopost 1 -entrybg white -width $attrib_width \ + -textvariable Apol_Widget::vars($path:attrib)] + trace add variable Apol_Widget::vars($path:attrib) write [list Apol_Widget::_attrib_changed $path] + 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 9 + _attrib_enabled $path + return $f +} + +proc Apol_Widget::resetTypeComboboxToPolicy {path} { + $path.tb configure -values [Apol_Types::getTypes] + $path.ab configure -values [Apol_Types::getAttributes] +} + +proc Apol_Widget::clearTypeCombobox {path} { + variable vars + set vars($path:attribenable) 0 + set vars($path:attrib) "" + set vars($path:type) "" + $path.tb configure -values {} + $path.ab configure -values {} + _attrib_enabled $path +} + +# Return the currently selected type. If an attribute is acting as a +# filter, the return value will instead be a 2-ple list of the +# selected type and the selected attribute. +proc Apol_Widget::getTypeComboboxValueAndAttrib {path} { + variable vars + if {$vars($path:attribenable)} { + list [string trim $vars($path:type)] $vars($path:attrib) + } else { + string trim $vars($path:type) + } +} + +# Set the type and possibly attribute for a type combobox. The first +# element of $type is the type to set. If $type has more than one +# element, then the second element is the attribute upon which to +# filter. +proc Apol_Widget::setTypeComboboxValue {path type} { + variable vars + if {[llength $type] <= 1} { + set vars($path:type) $type + set vars($path:attribenable) 0 + set vars($path:attrib) "" + } else { + set vars($path:type) [lindex $type 0] + set vars($path:attribenable) 1 + set vars($path:attrib) [lindex $type 1] + } + _attrib_enabled $path +} + +proc Apol_Widget::setTypeComboboxState {path newState} { + variable vars + if {$newState == 0 || $newState == "disabled"} { + $path.tb configure -state disabled + $path.ae configure -state disabled + $path.ab configure -state disabled + } else { + $path.tb configure -state normal + $path.ae configure -state normal + if {$vars($path:attribenable)} { + $path.ab configure -state normal + } + } +} + + +# Create a mega-widget used to select a single MLS level (a +# sensitivity + 0 or more categories). +# +# @param catSize Number of categories to show in the dropdown box. +proc Apol_Widget::makeLevelSelector {path catSize args} { + variable vars + array unset vars $path:* + set vars($path:sens) {} + set vars($path:cats) {} + + set f [frame $path] + set sens_box [eval ComboBox $f.sens $args \ + -textvariable Apol_Widget::vars($path:sens) \ + -entrybg white -width 16 -autopost 1] + trace add variable Apol_Widget::vars($path:sens) write [list Apol_Widget::_sens_changed $path] + pack $sens_box -side top -expand 0 -fill x + + set cats_label [label $f.cl -text "Categories:"] + pack $cats_label -side top -anchor sw -pady 2 -expand 0 + + set cats [makeScrolledListbox $f.cats -width 16 -height $catSize \ + -listvariable Apol_Widget::vars($path:cats) \ + -selectmode extended -exportselection 0] + pack $cats -side top -expand 1 -fill both + + set reset [button $f.reset -text "Clear Categories" \ + -command [list [getScrolledListbox $cats] selection clear 0 end]] + pack $reset -side top -anchor center -pady 2 + return $f +} + +# Return an apol_mls_level_t object that represents the level +# selected. The caller must delete it afterwards. +proc Apol_Widget::getLevelSelectorLevel {path} { + variable vars + set apol_level [new_apol_mls_level_t] + # convert sensitivity aliases to its real name, if necessary + set l [Apol_MLS::isSensInPolicy $vars($path:sens)] + if {[ApolTop::is_policy_open]} { + set p $::ApolTop::policy + } else { + set p NULL + } + if {$l == {}} { + $apol_level set_sens $p $vars($path:sens) + } else { + $apol_level set_sens $p $l + } + set sl [getScrolledListbox $path.cats] + set cats {} + foreach idx [$sl curselection] { + $apol_level append_cats $p [$sl get $idx] + } + return $apol_level +} + +# Given an apol_mls_level_t object, set the level selector's display +# to match the level. +proc Apol_Widget::setLevelSelectorLevel {path level} { + variable vars + if {$level == "NULL"} { + set sens {} + } else { + set sens [$level get_sens] + } + set sens_list [$path.sens cget -values] + if {$sens != {} && [lsearch -exact $sens_list $sens] != -1} { + set vars($path:sens) $sens + set cats_list $vars($path:cats) + set first_idx -1 + set listbox [getScrolledListbox $path.cats] + set cats [str_vector_to_list [$level get_cats]] + foreach cat $cats { + if {[set idx [lsearch -exact $cats_list $cat]] != -1} { + $listbox selection set $idx + if {$first_idx == -1 || $idx < $first_idx} { + set first_idx $idx + } + } + } + # scroll the listbox so that the first one selected is visible + # near the top + incr first_idx -1 + $listbox yview scroll $first_idx units + } +} + +proc Apol_Widget::resetLevelSelectorToPolicy {path} { + variable vars + set vars($path:sens) {} + + if {![ApolTop::is_policy_open]} { + $path.sens configure -values {} + } else { + set level_data {} + set i [$::ApolTop::qpolicy get_level_iter] + while {![$i end]} { + set qpol_level_datum [qpol_level_from_void [$i get_item]] + if {![$qpol_level_datum get_isalias $::ApolTop::qpolicy]} { + 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] + } + $i next + } + $i -acquire + $i -delete + set level_names {} + foreach l [lsort -integer -index 1 $level_data] { + lappend level_names [lindex $l 0] + } + $path.sens configure -values $level_names + } +} + +proc Apol_Widget::clearLevelSelector {path} { + variable vars + set vars($path:sens) {} + $path.sens configure -values {} + # the category box will be cleared because of the trace on $path:sens +} + +proc Apol_Widget::setLevelSelectorState {path newState} { + if {$newState == 0 || $newState == "disabled"} { + set newState disabled + } else { + set newState normal + } + $path.sens configure -state $newState + $path.cl configure -state $newState + $path.reset configure -state $newState + setScrolledListboxState $path.cats $newState +} + +# Create a common "search using regular expression" checkbutton + entry. +proc Apol_Widget::makeRegexpEntry {path args} { + variable vars + array unset vars $path:* + set vars($path:enable_regexp) 0 + + set f [frame $path] + set cb [checkbutton $f.cb -text "Search using regular expression" \ + -variable Apol_Widget::vars($path:enable_regexp)] + set regexp [eval entry $f.entry $args \ + -textvariable Apol_Widget::vars($path:regexp) \ + -width 32 -state disabled -bg $ApolTop::default_bg_color] + trace add variable Apol_Widget::vars($path:enable_regexp) write \ + [list Apol_Widget::_toggle_regexp_check_button $regexp] + pack $cb -side top -anchor nw + pack $regexp -side top -padx 4 -anchor nw -expand 0 -fill x + return $f +} + +proc Apol_Widget::setRegexpEntryState {path newState} { + variable vars + if {$newState == 0 || $newState == "disabled"} { + set vars($path:enable_regexp) 0 + $path.cb configure -state disabled + } else { + $path.cb configure -state normal + } +} + +proc Apol_Widget::setRegexpEntryValue {path newState newValue} { + variable vars + set old_state [$path.cb cget -state] + set vars($path:enable_regexp) $newState + set vars($path:regexp) $newValue + $path.cb configure -state $old_state +} + +proc Apol_Widget::getRegexpEntryState {path} { + return $Apol_Widget::vars($path:enable_regexp) +} + +proc Apol_Widget::getRegexpEntryValue {path} { + return $Apol_Widget::vars($path:regexp) +} + +# Create a scrolled non-editable text widget, from which search +# results may be displayed. +proc Apol_Widget::makeSearchResults {path args} { + variable vars + array unset vars $path:* + set sw [ScrolledWindow $path -scrollbar both -auto both] + set tb [eval text $sw.tb $args -bg white -wrap none -state disabled -font $ApolTop::text_font] + set vars($path:cursor) [$tb cget -cursor] + bind $tb <Button-3> [list Apol_Widget::_searchresults_popup %W %x %y] + $tb tag configure linenum -foreground blue -underline 1 + $tb tag configure selected -foreground red -underline 1 + $tb tag configure enabled -foreground green -underline 1 + $tb tag configure disabled -foreground red -underline 1 + $tb tag bind linenum <Button-1> [list Apol_Widget::_hyperlink $path %x %y] + $tb tag bind linenum <Enter> [list $tb configure -cursor hand2] + $tb tag bind linenum <Leave> [list $tb configure -cursor $Apol_Widget::vars($path:cursor)] + $sw setwidget $tb + return $sw +} + +proc Apol_Widget::clearSearchResults {path} { + $path.tb configure -state normal + $path.tb delete 0.0 end + $path.tb configure -state disabled +} + +proc Apol_Widget::copySearchResults {path} { + if {[$path tag ranges sel] != {}} { + set data [$path get sel.first sel.last] + clipboard clear + clipboard append -- $data + } +} + +proc Apol_Widget::selectAllSearchResults {path} { + $path tag add sel 1.0 end +} + +proc Apol_Widget::appendSearchResultHeader {path header} { + $path.tb configure -state normal + $path.tb insert 1.0 "$header\n" + $path.tb configure -state disabled +} + +proc Apol_Widget::appendSearchResultText {path text} { + $path.tb configure -state normal + $path.tb insert end $text + $path.tb configure -state disabled +} + +# Append a vector of qpol_avrule_t or qpol_terule_t to a search +# results box. Sort the rules by string representation. Returns the +# number of rules that were appended, number of enabled rules, and +# number of disabled rules. +# +# @param cast SWIG casting function, one of "new_qpol_avrule_t" or +# "new_qpol_terule_t" +proc Apol_Widget::appendSearchResultRules {path indent rule_list cast} { + set curstate [$path.tb cget -state] + $path.tb configure -state normal + + set num_enabled 0 + set num_disabled 0 + + for {set i 0} {$i < [$rule_list get_size]} {incr i} { + set rule [$cast [$rule_list get_element $i]] + $path.tb insert end [string repeat " " $indent] + $path.tb insert end [apol_tcl_rule_render $::ApolTop::policy $rule] + if {[$rule get_cond $::ApolTop::qpolicy] != "NULL"} { + if {[$rule get_is_enabled $::ApolTop::qpolicy]} { + $path.tb insert end " \[" {} "Enabled" enabled "\]" + incr num_enabled + } else { + $path.tb insert end " \[" {} "Disabled" disabled "\]" + incr num_disabled + } + } + $path.tb insert end "\n" + } + $path.tb configure -state $curstate + list [$rule_list get_size] $num_enabled $num_disabled +} + +# Append a vector of qpol_syn_avrule_t or qpol_syn_terule_t to a +# search results box. Returns the number of rules that were appended, +# number of enabled rules, and number of disabled rules. +# +# @param cast SWIG casting function, one of "new_qpol_syn_avrule_t" or +# "new_qpol_syn_terule_t" +proc Apol_Widget::appendSearchResultSynRules {path indent rule_list cast} { + set curstate [$path.tb cget -state] + $path.tb configure -state normal + + set num_enabled 0 + set num_disabled 0 + if {[ApolTop::is_capable "line numbers"]} { + set do_linenums 1 + } else { + set do_linenums 0 + } + + for {set i 0} {$i < [$rule_list get_size]} {incr i} { + set syn_rule [$cast [$rule_list get_element $i]] + $path.tb insert end [string repeat " " $indent] + if {$do_linenums} { + $path.tb insert end \ + "\[" {} \ + [$syn_rule get_lineno $::ApolTop::qpolicy] linenum \ + "\] " {} + } + $path.tb insert end [apol_tcl_rule_render $::ApolTop::policy $syn_rule] + if {[$syn_rule get_cond $::ApolTop::qpolicy] != "NULL"} { + if {[$syn_rule get_is_enabled $::ApolTop::qpolicy]} { + $path.tb insert end " \[" {} "Enabled" enabled "\]" + incr num_enabled + } else { + $path.tb insert end " \[" {} "Disabled" disabled "\]" + incr num_disabled + } + } + $path.tb insert end "\n" + } + $path.tb configure -state $curstate + list [$rule_list get_size] $num_enabled $num_disabled +} + +proc Apol_Widget::showPopupText {title info} { + variable infoPopup + if {![winfo exists $infoPopup]} { + set infoPopup [toplevel .apol_widget_info_popup] + wm withdraw $infoPopup + set sw [ScrolledWindow $infoPopup.sw -scrollbar both -auto horizontal] + set text [text [$sw getframe].text -font {helvetica 10} -wrap none -width 35 -height 10] + $sw setwidget $text + pack $sw -expand 1 -fill both + set b [button $infoPopup.close -text "Close" -command [list destroy $infoPopup]] + pack $b -side bottom -expand 0 -pady 5 + wm geometry $infoPopup 250x200+50+50 + update + grid propagate $sw 0 + } + wm title $infoPopup $title + set text [$infoPopup.sw getframe].text + $text configure -state normal + $text delete 1.0 end + $text insert 0.0 $info + $text configure -state disabled + wm deiconify $infoPopup + raise $infoPopup +} + +# Used to show pre-rendered paragraphs of text. +proc Apol_Widget::showPopupParagraph {title info} { + variable infoPopup2 + if {![winfo exists $infoPopup2]} { + set infoPopup2 [Dialog .apol_widget_info_popup2 -modal none -parent . \ + -transient false -cancel 0 -default 0 -separator 1] + $infoPopup2 add -text "Close" -command [list destroy $infoPopup2] + set sw [ScrolledWindow [$infoPopup2 getframe].sw -auto both -scrollbar both] + $sw configure -relief sunken + set text [text [$sw getframe].text -font $ApolTop::text_font \ + -wrap none -width 75 -height 25 -bg white] + $sw setwidget $text + update + grid propagate $sw 0 + pack $sw -expand 1 -fill both -padx 4 -pady 4 + $infoPopup2 draw + } else { + raise $infoPopup2 + wm deiconify $infoPopup2 + } + $infoPopup2 configure -title $title + set text [[$infoPopup2 getframe].sw getframe].text + $text configure -state normal + $text delete 1.0 end + $text insert 0.0 $info + $text configure -state disabled +} + +########## private functions below ########## + +proc Apol_Widget::_listbox_key {listbox key} { + if {[string length $key] == 1} { + # only scroll with non-function keys + set values [set ::[$listbox cget -listvar]] + set x [lsearch $values $key*] + if {$x >= 0} { + # if the current value already begins with that letter, + # cycle to the next one, wrapping back to the first value + # as necessary + set curvalue [$listbox get active] + set curindex [$listbox curselection] + if {$curindex != "" && [string index $curvalue 0] == $key} { + set new_x [expr {$curindex + 1}] + if {[string index [lindex $values $new_x] 0] != $key} { + # wrap around + set new_x $x + } + } else { + set new_x $x + } + + $listbox selection clear 0 end + $listbox selection set $new_x + $listbox activate $new_x + $listbox see $new_x + } + event generate $listbox <<ListboxSelect>> + } +} + +proc Apol_Widget::_listbox_double_click {listbox callback_func args} { + eval $callback_func $args [$listbox get active] +} + +proc Apol_Widget::_listbox_popup {w x y callbacks lb} { + focus $lb + set selected_item [$lb get active] + if {$selected_item == {}} { + return + } + + # create a global popup menu widget if one does not already exist + variable menuPopup + if {![winfo exists $menuPopup]} { + set menuPopup [menu .apol_widget_menu_popup -tearoff 0] + } + + ApolTop::popup $w $x $y $menuPopup $callbacks $selected_item +} + +proc Apol_Widget::_attrib_enabled {path} { + variable vars + if {$vars($path:attribenable)} { + $path.ab configure -state normal + _filter_type_combobox $path $vars($path:attrib) + } else { + $path.ab configure -state disabled + _filter_type_combobox $path "" + } +} + +proc Apol_Widget::_attrib_changed {path name1 name2 op} { + variable vars + if {$vars($path:attribenable)} { + _filter_type_combobox $path $vars($name2) + } +} + +proc Apol_Widget::_attrib_validate {path} { + # check that the attribute given was valid +} + +proc Apol_Widget::_filter_type_combobox {path attribvalue} { + variable vars + if {$attribvalue != {}} { + set typesList {} + if {[Apol_Types::isAttributeInPolicy $attribvalue]} { + set qpol_type_datum [new_qpol_type_t $::ApolTop::qpolicy $attribvalue] + 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 type combobox + return + } + } else { + set typesList [Apol_Types::getTypes] + # during policy load this list should already have been sorted + } + if {[lsearch -exact $typesList $vars($path:type)] == -1} { + set vars($path:type) {} + } + $path.tb configure -values [lsort $typesList] +} + +proc Apol_Widget::_sens_changed {path name1 name2 op} { + variable vars + # get a list of categories associated with this sensitivity + [getScrolledListbox $path.cats] selection clear 0 end + set vars($path:cats) {} + set sens [Apol_MLS::isSensInPolicy $vars($path:sens)] + if {$sens != {}} { + # the given level exists within the given policy + set qpol_level_datum [new_qpol_level_t $::ApolTop::qpolicy $sens] + set i [$qpol_level_datum get_cat_iter $::ApolTop::qpolicy] + while {![$i end]} { + set qpol_cat_datum [qpol_cat_from_void [$i get_item]] + lappend vars($path:cats) [$qpol_cat_datum get_name $::ApolTop::qpolicy] + $i next + } + $i -acquire + $i -delete + } +} + +proc Apol_Widget::_toggle_regexp_check_button {path name1 name2 op} { + if {$Apol_Widget::vars($name2)} { + $path configure -state normal -bg white + } else { + $path configure -state disabled -bg $ApolTop::default_bg_color + } +} + +proc Apol_Widget::_searchresults_popup {path x y} { + if {[ApolTop::is_policy_open]} { + focus $path + # create a global popup menu widget if one does not already exist + variable menuPopup + if {![winfo exists $menuPopup]} { + set menuPopup [menu .apol_widget_menu_popup -tearoff 0] + } + set callbacks { + {"Copy" Apol_Widget::copySearchResults} + {"Select All" Apol_Widget::selectAllSearchResults} + } + ApolTop::popup $path $x $y $menuPopup $callbacks $path + } +} + +proc Apol_Widget::_hyperlink {path x y} { + set tb $path.tb + set range [$tb tag prevrange linenum "@$x,$y + 1 char"] + $tb tag add selected [lindex $range 0] [lindex $range 1] + set line_num [$tb get [lindex $range 0] [lindex $range 1]] + ApolTop::showPolicySourceLineNumber $line_num +} + +proc Apol_Widget::_render_typeset {typeset} { + if {[llength $typeset] > 1} { + if {[lindex $typeset 0] == "~"} { + set typeset "~\{[lrange $typeset 1 end]\}" + } else { + set typeset "\{$typeset\}" + } + } else { + set typeset + } +} |