One Hat Cyber Team

Edit File: apol

#!/bin/sh
# \
exec tclsh "$0" ${1+"$@"}

##############################################################
#
# apol: SELinux Policy Analysis Tools
#
# Copyright (C) 2002-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
#
# Question/comments to: setools@tresys.com
#
# This tool is designed to analyze SELinux policies.  See the
# assoicated help file for more information.
#
##############################################################
proc tcl_config_init_libraries {} {
    global auto_path
    lappend auto_path /usr/lib/setools
    print_init "Initializing libqpol... "
    package require qpol 1.7
    print_init "done.\nInitializing libapol... "
    package require apol 4.4
    print_init "done.\nInitializing libsefs... "
    package require sefs 4.0.4
    print_init "done.\nInitializing libapol_tcl... "
    package require apol_tcl 4.4
    print_init "done.\n"
}
proc tcl_config_get_install_dir {} {
    return "/usr/share/setools-3.3"
}

proc tcl_config_init {} {
}
proc tcl_config_get_version {} {
    return 3.3.8
}
namespace eval Apol_Analysis {
    variable vals
    variable widgets
    variable tabs
}
proc Apol_Analysis::create {tab_name nb} {
    variable vals
    variable widgets
    set frame [$nb insert end $tab_name -text "Analysis"]
    set pw [PanedWindow $frame.pw -side left -weights extra]
    set topf [$pw add -weight 0]
    set bottomf [$pw add -weight 1]
    pack $pw -expand 1 -fill both
    set top_leftf [TitleFrame $topf.left -text "Analysis Type"]
    set opts_f [TitleFrame $topf.opts -text "Analysis Options"]
    set buttons_f [frame $topf.buttons]
    pack $top_leftf -side left -expand 0 -fill y -padx 2
    pack $opts_f -side left -expand 1 -fill both -padx 2
    pack $buttons_f -side right -expand 0 -anchor ne -padx 2
    set results_f [TitleFrame $bottomf.r -text "Analysis Results"]
    pack $results_f -expand 1 -fill both -padx 2
    set widgets(modules) [Apol_Widget::makeScrolledListbox [$top_leftf getframe].m \
                              -height 8 -width 24 -listvar Apol_Analysis::vals(module_names) -exportselection 0]
    $widgets(modules).lb selection set 0
    bind $widgets(modules).lb <<ListboxSelect>> Apol_Analysis::_selectModule
    pack $widgets(modules) -expand 1 -fill both
    set widgets(search_opts) [PagesManager [$opts_f getframe].s]
    foreach m $vals(modules) {
        ${m}::create [$widgets(search_opts) add $m]
    }
    $widgets(search_opts) compute_size
    $widgets(search_opts) raise [lindex $vals(modules) 0]
    pack $widgets(search_opts) -expand 1 -fill both
    set widgets(new) [button $buttons_f.new -text "New Analysis" -width 12 \
                          -command [list Apol_Analysis::_analyze new]]
    set widgets(update) [button $buttons_f.update -text "Update Analysis" -width 12 -state disabled \
                             -command [list Apol_Analysis::_analyze update]]
    set widgets(reset) [button $buttons_f.reset -text "Reset Criteria" -width 12 \
                            -command Apol_Analysis::_reset]
    set widgets(info) [button $buttons_f.info -text "Info" -width 12 \
                            -command Apol_Analysis::_info]
    pack $widgets(new) $widgets(update) $widgets(reset) $widgets(info) \
        -side top -pady 5 -padx 5 -anchor ne
    set popupTab_Menu [menu .popup_analysis -tearoff 0]
    set tab_menu_callbacks \
        [list {"Close Tab" Apol_Analysis::_deleteResults} \
             {"Rename Tab" Apol_Analysis::_displayRenameTabDialog}]
    set widgets(results) [NoteBook [$results_f getframe].results]
    $widgets(results) bindtabs <Button-1> Apol_Analysis::_switchTab
    $widgets(results) bindtabs <Button-3> \
        [list ApolTop::popup \
             %W %x %y $popupTab_Menu $tab_menu_callbacks]
    set close [button [$results_f getframe].close -text "Close Tab" \
                   -command Apol_Analysis::_deleteCurrentResults]
    pack $widgets(results) -expand 1 -fill both -padx 4
    pack $close -expand 0 -fill x -padx 4 -pady 2
    _reinitializeTabs
    return $frame
}
proc Apol_Analysis::open {ppath} {
    variable vals
    foreach m $vals(modules) {
        ${m}::open
    }
}
proc Apol_Analysis::close {} {
    variable vals
    variable widgets
    foreach m $vals(modules) {
        ${m}::close
    }
    _reinitializeTabs
}
proc Apol_Analysis::getTextWidget {} {
    variable widgets
    variable tabs
    set curid [$widgets(results) raise]
    if {$curid != {}} {
        return [$tabs($curid:module)::getTextWidget [$widgets(results) getframe $curid]]
    }
    return {}
}
proc Apol_Analysis::save_query_options {file_channel query_file} {
    variable widgets
    set m [$widgets(search_opts) raise]
    puts $file_channel $m
    ${m}::saveQuery $file_channel
}
proc Apol_Analysis::load_query_options {file_channel} {
    variable vals
    variable widgets
    set line {}
    while {[gets $file_channel line] >= 0} {
        set line [string trim $line]
        if {$line == {} || [string index $line 0] == "#"} {
            continue
        }
        break
    }
    if {$line == {} || [set i [lsearch -exact $vals(modules) $line]] == -1} {
        tk_messageBox -icon error -type ok -title "Open Apol Query" -message "The specified query is not a valid analysis module."
        return
    }
    ${line}::loadQuery $file_channel
    $widgets(modules).lb selection clear 0 end
    set module [lindex $vals(modules) $i]
    $widgets(search_opts) raise $module
    $widgets(modules).lb selection set [lsearch $vals(module_names) $vals($module:name)]
}
proc Apol_Analysis::registerAnalysis {mod_proc mod_name} {
    variable vals
    lappend vals(modules) $mod_proc
    lappend vals(module_names) $mod_name
    set vals($mod_proc:name) $mod_name
}
proc Apol_Analysis::createResultTab {short_name criteria} {
    variable widgets
    variable tabs
    set i $tabs(next_result_id)
    incr tabs(next_result_id)
    set m [$widgets(search_opts) raise]
    set id "results$i"
    set frame [$widgets(results) insert end $id -text "($i) $short_name"]
    $widgets(results) raise $id
    set tabs($id:module) $m
    set tabs($id:vals) $criteria
    return $frame
}
proc Apol_Analysis::setResultTabCriteria {criteria} {
    variable widgets
    variable tabs
    set id [$widgets(results) raise]
    if {$id != {}} {
        set tabs($id:vals) $criteria
    }
}
proc Apol_Analysis::_selectModule {} {
    variable vals
    variable widgets
    variable tabs
    focus $widgets(modules).lb
    if {[set selection [$widgets(modules).lb curselection]] == {}} {
        return
    }
    set module [lindex $vals(modules) [lindex $selection 0]]
    $widgets(search_opts) raise $module
    set result_tab [$widgets(results) raise]
    if {$result_tab != {} && $tabs($result_tab:module) == $module} {
        $widgets(update) configure -state normal
    } else {
        $widgets(update) configure -state disabled
    }
}
proc Apol_Analysis::_analyze {which_button} {
    variable vals
    variable widgets
    variable tabs
    $widgets(new) configure -state disabled
    $widgets(update) configure -state disabled
    set m [$widgets(search_opts) raise]
    set retval [Apol_Progress_Dialog::wait "$vals($m:name) Analysis" \
                    "Performing $vals($m:name) Analysis..." \
                    {
                        if {$which_button == "new"} {
                            ${m}::newAnalysis
                        } else {
                            set f [$widgets(results) getframe [$widgets(results) raise]]
                            if {[set retval [${m}::updateAnalysis $f]] != {}} {
                                _deleteCurrentResults
                            }
                            set retval
                        }
                    }]
    if {$retval != {}} {
        tk_messageBox -icon error -type ok -title "$vals($m:name) Analysis" -message "Error while performing analysis:\n\n$retval"
    }
    if {[$widgets(results) raise] == {}} {
        $widgets(update) configure -state disabled
    } else {
        $widgets(update) configure -state normal
    }
    $widgets(new) configure -state normal
}
proc Apol_Analysis::_reset {} {
    variable vals
    variable widgets
    set m [$widgets(search_opts) raise]
    ${m}::reset
}
proc Apol_Analysis::_info {} {
    variable vals
    variable widgets
    set m [$widgets(search_opts) raise]
    Apol_Widget::showPopupParagraph $vals(${m}:name) [${m}::getInfo]
}
proc Apol_Analysis::_reinitializeTabs {} {
    variable widgets
    variable tabs
    array set tabs {
        next_result_id 1
    }
    foreach p [$widgets(results) pages 0 end] {
        _deleteResults $p
    }
}
proc Apol_Analysis::_switchTab {pageID} {
    variable vals
    variable widgets
    variable tabs
    $widgets(update) configure -state normal
    if {[$widgets(results) raise] == $pageID} {
        return
    }
    $widgets(results) raise $pageID
    set cur_search_opts [$widgets(search_opts) raise]
    set m $tabs($pageID:module)
    ${m}::switchTab $tabs($pageID:vals)
    $widgets(modules).lb selection clear 0 end
    $widgets(modules).lb selection set [lsearch $vals(module_names) $vals(${m}:name)]
    $widgets(search_opts) raise $m
}
proc Apol_Analysis::_deleteResults {pageID} {
    variable widgets
    variable tabs
    set curpos [$widgets(results) index $pageID]
    $widgets(results) delete $pageID
    array unset tabs $pageID:*
    array unset tabs $pageID
    if {[set next_id [$widgets(results) pages $curpos]] != {}} {
        _switchTab $next_id
    } elseif {$curpos > 0} {
        _switchTab [$widgets(results) pages [expr {$curpos - 1}]]
    } else {
        $widgets(update) configure -state disabled
    }
}
proc Apol_Analysis::_deleteCurrentResults {} {
    variable widgets
    if {[set curid [$widgets(results) raise]] != {}} {
        _deleteResults $curid
    }
}
proc Apol_Analysis::_displayRenameTabDialog {pageID} {
    variable widgets
    variable tabs
    set d [Dialog .apol_analysis_tab_rename -homogeneous 1 -spacing 2 -cancel 1 \
               -default 0 -modal local -parent . -place center -separator 1 \
               -side bottom -title "Rename Results Tab"]
    $d add -text "OK" -command [list $d enddialog "ok"]
    $d add -text "Cancel" -command [list $d enddialog "cancel"]
    set f [$d getframe]
    set l [label $f.l -text "Tab name:"]
    set tabs(tab:new_name) [$widgets(results) itemcget $pageID -text]
    set e [entry $f.e -textvariable Apol_Analysis::tabs(tab:new_name) -width 16 -bg white]
    pack $l $e -side left -padx 2
    set retval [$d draw]
    destroy $d
    if {$retval == "ok"} {
        $widgets(results) itemconfigure $pageID -text $tabs(tab:new_name)
    }
}
namespace eval Apol_Class_Perms {
    variable class_list {}
    variable common_list {}
    variable perms_list {}
    variable opts
    variable widgets
}
proc Apol_Class_Perms::create {tab_name nb} {
    variable opts
    variable widgets
    _initializeVars
    set frame [$nb insert end $tab_name -text "Classes/Perms"]
    set pw1 [PanedWindow $frame.pw -side top]
    set left_pane   [$pw1 add -weight 0]
    set center_pane [$pw1 add -weight 1]
    set class_pane  [frame $left_pane.class]
    set common_pane [frame $left_pane.common]
    set perms_pane  [frame $left_pane.perms]
    set classes_box [TitleFrame $class_pane.tbox -text "Object Classes"]
    set common_box  [TitleFrame $common_pane.tbox -text "Common Permissions"]
    set perms_box   [TitleFrame $perms_pane.tbox -text "Permissions"]
    set options_box [TitleFrame $center_pane.obox -text "Search Options"]
    set results_box [TitleFrame $center_pane.rbox -text "Search Results"]
    pack $classes_box -fill both -expand yes
    pack $common_box -fill both -expand yes
    pack $perms_box -fill both -expand yes
    pack $options_box -padx 2 -fill both -expand 0
    pack $results_box -padx 2 -fill both -expand yes
    pack $pw1 -fill both -expand yes
    pack $class_pane $common_pane -expand 0 -fill both
    pack $perms_pane -expand 1 -fill both
    set class_listbox [Apol_Widget::makeScrolledListbox [$classes_box getframe].lb -height 8 -width 20 -listvar Apol_Class_Perms::class_list]
    Apol_Widget::setListboxCallbacks $class_listbox \
        {{"Display Object Class Info" {Apol_Class_Perms::_popupInfo class}}}
    pack $class_listbox -fill both -expand yes
    set common_listbox [Apol_Widget::makeScrolledListbox [$common_box getframe].lb -height 5 -width 20 -listvar Apol_Class_Perms::common_perms_list]
    Apol_Widget::setListboxCallbacks $common_listbox \
        {{"Display Common Permission Class Info" {Apol_Class_Perms::_popupInfo common}}}
    pack $common_listbox -fill both -expand yes
    set perms_listbox [Apol_Widget::makeScrolledListbox [$perms_box getframe].lb -height 10 -width 20 -listvar Apol_Class_Perms::perms_list]
    Apol_Widget::setListboxCallbacks $perms_listbox \
        {{"Display Permission Info" {Apol_Class_Perms::_popupInfo perm}}}
    pack $perms_listbox -fill both -expand yes
    set ofm [$options_box getframe]
    set classesfm [frame $ofm.classes]
    set commonsfm [frame $ofm.commons]
    set permsfm [frame $ofm.perms]
    pack $classesfm $commonsfm $permsfm -side left -padx 4 -pady 2 -anchor ne
    set classes [checkbutton $classesfm.classes -text "Object classes" \
                     -variable Apol_Class_Perms::opts(classes:show)]
    set perms [checkbutton $classesfm.perms -text "Include perms" \
                   -variable Apol_Class_Perms::opts(classes:perms)]
    set commons [checkbutton $classesfm.commons -text "Expand common perms" \
                     -variable Apol_Class_Perms::opts(classes:commons)]
    trace add variable Apol_Class_Perms::opts(classes:show) write \
        [list Apol_Class_Perms::_toggleCheckbuttons $perms $commons]
    trace add variable Apol_Class_Perms::opts(classes:perms) write \
        [list Apol_Class_Perms::_toggleCheckbuttons $commons {}]
    pack $classes -anchor w
    pack $perms $commons -anchor w -padx 8
    set commons [checkbutton $commonsfm.commons -text "Common permissions" \
                     -variable Apol_Class_Perms::opts(commons:show)]
    set perms [checkbutton $commonsfm.perms2 -text "Include perms" \
                   -variable Apol_Class_Perms::opts(commons:perms) \
                   -state disabled]
    set classes [checkbutton $commonsfm.classes -text "Object classes" \
                     -variable Apol_Class_Perms::opts(commons:classes) \
                     -state disabled]
    trace add variable Apol_Class_Perms::opts(commons:show) write \
        [list Apol_Class_Perms::_toggleCheckbuttons $perms $classes]
    pack $commons -anchor w
    pack $perms $classes -anchor w -padx 8
    set perms [checkbutton $permsfm.prems -text "Permissions" \
                   -variable Apol_Class_Perms::opts(perms:show)]
    set classes [checkbutton $permsfm.classes -text "Object classes" \
                     -variable Apol_Class_Perms::opts(perms:classes) \
                     -state disabled]
    set commons [checkbutton $permsfm.commons -text "Common perms" \
                     -variable Apol_Class_Perms::opts(perms:commons) \
                     -state disabled]
    trace add variable Apol_Class_Perms::opts(perms:show) write \
        [list Apol_Class_Perms::_toggleCheckbuttons $classes $commons]
    pack $perms -anchor w
    pack $classes $commons -anchor w -padx 8
    set widgets(regexp) [Apol_Widget::makeRegexpEntry $ofm.regexp]
    pack $widgets(regexp) -side left -padx 2 -pady 2 -anchor ne
    set ok [button $ofm.ok -text OK -width 6 \
                -command Apol_Class_Perms::_search]
    pack $ok -side right -pady 5 -padx 5 -anchor ne
    set widgets(results) [Apol_Widget::makeSearchResults [$results_box getframe].results]
    pack $widgets(results) -expand yes -fill both
    return $frame
}
proc Apol_Class_Perms::open {ppath} {
    set q [new_apol_class_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    variable class_list [lsort [class_vector_to_list $v]]
    $v -acquire
    $v -delete
    set q [new_apol_common_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    variable common_perms_list [lsort [common_vector_to_list $v]]
    $v -acquire
    $v -delete
    set q [new_apol_perm_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    variable perms_list [lsort [str_vector_to_list $v]]
    $v -acquire
    $v -delete
}
proc Apol_Class_Perms::close {} {
    variable class_list {}
    variable common_perms_list {}
    variable perms_list {}
    variable widgets
    _initializeVars
    Apol_Widget::clearSearchResults $widgets(results)
}
proc Apol_Class_Perms::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_Class_Perms::getClasses {} {
    variable class_list
    set class_list
}
proc Apol_Class_Perms::getPermsForClass {class_name} {
    set qpol_class_datum [new_qpol_class_t $::ApolTop::qpolicy $class_name]
    set i [$qpol_class_datum get_perm_iter $::ApolTop::qpolicy]
    set perms [iter_to_str_list $i]
    $i -acquire
    $i -delete
    if {[set qpol_common_datum [$qpol_class_datum get_common $::ApolTop::qpolicy]] != "NULL"} {
        set i [$qpol_common_datum get_perm_iter $::ApolTop::qpolicy]
        set perms [concat $perms [iter_to_str_list $i]]
        $i -acquire
        $i -delete
    }
    lsort -dictionary -unique $perms
}
proc Apol_Class_Perms::getClassesForPerm {perm_name} {
    set classes_list {}
    set i [$::ApolTop::qpolicy get_class_iter $perm_name]
    while {![$i end]} {
        set qpol_class_datum [qpol_class_from_void [$i get_item]]
        lappend classes_list [$qpol_class_datum get_name $::ApolTop::qpolicy]
        $i next
    }
    $i -acquire
    $i -delete
    set indirect_classes_list {}
    set i [$::ApolTop::qpolicy get_common_iter $perm_name]
    while {![$i end]} {
        set qpol_common_datum [qpol_common_from_void [$i get_item]]
        set q [new_apol_class_query_t]
        $q set_common $::ApolTop::policy [$qpol_common_datum get_name $::ApolTop::qpolicy]
        set v [$q run $::ApolTop::policy]
        $q -acquire
        $q -delete
        set indirect_classes_list [concat $indirect_classes_list [class_vector_to_list $v]]
        $v -acquire
        $v -delete
        $i next
    }
    $i -acquire
    $i -delete
    list [lsort $classes_list] [lsort -unique $indirect_classes_list]
}
proc Apol_Class_Perms::_initializeVars {} {
    variable opts
    array set opts {
        classes:show 1  classes:perms 1  classes:commons 1
        commons:show 0  commons:perms 1  commons:classes 1
        perms:show 0    perms:classes 1  perms:commons 1
    }
}
proc Apol_Class_Perms::_popupInfo {which name} {
    if {$which == "class"} {
        set text [_renderClass $name 1 0]
    } elseif {$which == "common"} {
        set text [_renderCommon $name 1 0]
    } else {
        set text [_renderPerm $name 1 1]
    }
    Apol_Widget::showPopupText $name $text
}
proc Apol_Class_Perms::_toggleCheckbuttons {cb1 cb2 name1 name2 op} {
    variable opts
    variable widgets
    if {$opts($name2)} {
        $cb1 configure -state normal
        if {$name2 == "classes:show"} {
            if {$opts(classes:perms)} {
                $cb2 configure -state normal
            } else {
                $cb2 configure -state disabled
            }
        } elseif {$cb2 != {}} {
            $cb2 configure -state normal
        }
    } else {
        $cb1 configure -state disabled
        if {$cb2 != {}} {
            $cb2 configure -state disabled
        }
    }
    if {!$opts(classes:show) && !$opts(commons:show) && !$opts(perms:show)} {
        Apol_Widget::setRegexpEntryState $widgets(regexp) 0
    } else {
        Apol_Widget::setRegexpEntryState $widgets(regexp) 1
    }
}
proc Apol_Class_Perms::_search {} {
    variable opts
    variable widgets
    Apol_Widget::clearSearchResults $widgets(results)
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
        return
    }
    if {!$opts(classes:show) && !$opts(commons:show) && !$opts(perms:show)} {
        tk_messageBox -icon error -type ok -title "Error" -message "No search options provided."
        return
    }
    set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
    set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
    if {$use_regexp} {
        if {$regexp == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No regular expression provided."
            return
        }
    } else {
        set regexp {}
    }
    set results {}
    if {$opts(classes:show)} {
        if {[set classes_perms $opts(classes:perms)]} {
            set classes_commons $opts(classes:commons)
        } else {
            set classes_commons 0
        }
        set q [new_apol_class_query_t]
        $q set_class $::ApolTop::policy $regexp
        $q set_regex $::ApolTop::policy $use_regexp
        set v [$q run $::ApolTop::policy]
        $q -acquire
        $q -delete
        set classes_data [class_vector_to_list $v]
        $v -acquire
        $v -delete
        append results "OBJECT CLASSES:\n"
        if {$classes_data == {}} {
            append results "Search returned no results.\n"
        } else {
            foreach c [lsort -index 0 $classes_data] {
                append results [_renderClass $c $opts(classes:perms) $classes_commons]
            }
        }
    }
    if {$opts(commons:show)} {
        set q [new_apol_common_query_t]
        $q set_common $::ApolTop::policy $regexp
        $q set_regex $::ApolTop::policy $use_regexp
        set v [$q run $::ApolTop::policy]
        $q -acquire
        $q -delete
        set commons_data [common_vector_to_list $v]
        $v -acquire
        $v -delete
        append results "\nCOMMON PERMISSIONS:  \n"
        if {$commons_data == {}} {
            append results "Search returned no results.\n"
        } else {
            foreach c [lsort -index 0 $commons_data] {
                append results [_renderCommon $c $opts(commons:perms) $opts(commons:classes)]
            }
        }
    }
    if {$opts(perms:show)} {
        set q [new_apol_perm_query_t]
        $q set_perm $::ApolTop::policy $regexp
        $q set_regex $::ApolTop::policy $use_regexp
        set v [$q run $::ApolTop::policy]
        $q -acquire
        $q -delete
        set perms_data [str_vector_to_list $v]
        $v -acquire
        $v -delete
        append results "\nPERMISSIONS"
        if {$opts(perms:classes)} {
            append results "  (* means class uses permission via a common permission)"
        }
        append results ":\n"
        if {$perms_data == {}} {
            append results "Search returned no results.\n"
        } else {
            foreach p [lsort -index 0 $perms_data] {
                append results [_renderPerm $p $opts(perms:classes) $opts(perms:commons)]
            }
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) [string trim $results]
}
proc Apol_Class_Perms::_renderClass {class_name show_perms expand_common} {
    set qpol_class_datum [new_qpol_class_t $::ApolTop::qpolicy $class_name]
    if {[set qpol_common_datum [$qpol_class_datum get_common $::ApolTop::qpolicy]] == "NULL"} {
        set common_name {}
    } else {
        set common_name [$qpol_common_datum get_name $::ApolTop::qpolicy]
    }
    set text "$class_name\n"
    if {$show_perms} {
        set i [$qpol_class_datum get_perm_iter $::ApolTop::qpolicy]
        set perms_list [iter_to_str_list $i]
        $i -acquire
        $i -delete
        foreach perm [lsort $perms_list] {
            append text "    $perm\n"
        }
        if {$common_name != {}} {
            append text "    $common_name  (common perm)\n"
            if {$expand_common} {
                set i [$qpol_common_datum get_perm_iter $::ApolTop::qpolicy]
                foreach perm [lsort [iter_to_str_list $i]] {
                    append text "        $perm\n"
                }
                $i -acquire
                $i -delete
            }
        }
        append text \n
    }
    return $text
}
proc Apol_Class_Perms::_renderCommon {common_name show_perms show_classes} {
    set qpol_common_datum [new_qpol_common_t $::ApolTop::qpolicy $common_name]
    set text "$common_name\n"
    if {$show_perms} {
        set i [$qpol_common_datum get_perm_iter $::ApolTop::qpolicy]
        foreach perm [lsort [iter_to_str_list $i]] {
            append text "    $perm\n"
        }
        $i -acquire
        $i -delete
    }
    if {$show_classes} {
        append text "  Object classes that use this common permission:\n"
        set i [$::ApolTop::qpolicy get_class_iter]
        set classes_list {}
        while {![$i end]} {
            set qpol_class_t [qpol_class_from_void [$i get_item]]
            set q [$qpol_class_t get_common $::ApolTop::qpolicy]
            if {$q != "NULL" && [$q get_name $::ApolTop::qpolicy] == $common_name} {
                lappend classes_list [$qpol_class_t get_name $::ApolTop::qpolicy]
            }
            $i next
        }
        $i -acquire
        $i -delete
        foreach class [lsort $classes_list] {
            append text "      $class\n"
        }
    }
    if {$show_perms || $show_classes} {
        append text "\n"
    }
    return $text
}
proc Apol_Class_Perms::_renderPerm {perm_name show_classes show_commons} {
    set text "$perm_name\n"
    if {$show_classes} {
        append text "  object classes:\n"
        foreach {classes_list indirect_classes_list} [getClassesForPerm $perm_name] {break}
        foreach c $indirect_classes_list {
            lappend classes_list ${c}*
        }
        if {$classes_list == {}} {
            append text "    <none>\n"
        } else {
            foreach class [lsort -uniq $classes_list] {
                append text "    $class\n"
            }
        }
    }
    if {$show_commons} {
        append text "  common permissions:\n"
        set commons_list {}
        set i [$::ApolTop::qpolicy get_common_iter $perm_name]
        while {![$i end]} {
            set qpol_common_datum [qpol_common_from_void [$i get_item]]
            lappend commons_list [$qpol_common_datum get_name $::ApolTop::qpolicy]
            $i next
        }
        $i -acquire
        $i -delete
        if {$commons_list == {}} {
            append text "    <none>\n"
        } else {
            foreach common [lsort $commons_list] {
                append text "    $common\n"
            }
        }
    }
    if {$show_classes || $show_commons} {
        append text "\n"
    }
    return $text
}
namespace eval Apol_Widget {
    variable menuPopup {}
    variable infoPopup {}
    variable infoPopup2 {}
    variable vars
}
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]
    bind $lb <Key> [list Apol_Widget::_listbox_key $lb %K]
    return $sw
}
proc Apol_Widget::setListboxCallbacks {path callback_list} {
    set lb [getScrolledListbox $path]
    bind $lb <Double-Button-1> [eval list Apol_Widget::_listbox_double_click $lb [lindex $callback_list 0 1]]
    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
    }
}
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
}
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)
    }
}
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
        }
    }
}
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
}
proc Apol_Widget::getLevelSelectorLevel {path} {
    variable vars
    set apol_level [new_apol_mls_level_t]
    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
}
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
                }
            }
        }
        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 {}
}
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
}
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)
}
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
}
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
}
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
}
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
}
proc Apol_Widget::_listbox_key {listbox key} {
    if {[string length $key] == 1} {
        set values [set ::[$listbox cget -listvar]]
        set x [lsearch $values $key*]
        if {$x >= 0} {
            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} {
                    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
    }
    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} {
}
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 == {}} {
            return
        }
    } else {
        set typesList [Apol_Types::getTypes]
    }
    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
    [getScrolledListbox $path.cats] selection clear 0 end
    set vars($path:cats) {}
    set sens [Apol_MLS::isSensInPolicy $vars($path:sens)]
    if {$sens != {}} {
        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
        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
    }
}
namespace eval Apol_Cond_Bools {
    variable cond_bools_list {}
    variable cond_bools_defaults
    variable cond_bools_values
    variable opts
    variable widgets
}
proc Apol_Cond_Bools::create {tab_name nb} {
    variable opts
    variable widgets
    _initializeVars
    set frame [$nb insert end $tab_name -text "Booleans"]
    set pw [PanedWindow $frame.pw -side top]
    set left_pane [$pw add -weight 0]
    set right_pane [$pw add -weight 1]
    pack $pw -expand 1 -fill both
    set cond_bools_box [TitleFrame $left_pane.cond_bools_box -text "Booleans"]
    set s_optionsbox   [TitleFrame $right_pane.obox -text "Search Options"]
    set rslts_frame    [TitleFrame $right_pane.rbox -text "Search Results"]
    pack $cond_bools_box -expand 1 -fill both
    pack $s_optionsbox -padx 2 -fill x -expand 0
    pack $rslts_frame -padx 2 -fill both -expand yes
    set left_frame [$cond_bools_box getframe]
    set sw_b [ScrolledWindow $left_frame.sw -auto both]
    set widgets(listbox) [ScrollableFrame $sw_b.listbox -bg white -width 200]
    $sw_b setwidget $widgets(listbox)
    set button_defaults [button $left_frame.button_defaults \
                             -text "Reset to Policy Defaults" \
                             -command Apol_Cond_Bools::_resetAll]
    pack $sw_b -side top -expand 1 -fill both
    pack $button_defaults -side bottom -pady 2 -expand 0 -fill x
    set ofm [$s_optionsbox getframe]
    set bool_frame [frame $ofm.bool]
    set show_frame [frame $ofm.show]
    pack $bool_frame $show_frame -side left -padx 4 -pady 2 -anchor nw
    set enable [checkbutton $bool_frame.enable \
                    -variable Apol_Cond_Bools::opts(enable_bool) \
                    -text "Boolean"]
    set widgets(combo_box) [ComboBox $bool_frame.combo_box \
                                -textvariable Apol_Cond_Bools::opts(name) \
                                -helptext "Type or select a boolean variable" \
                                -state disabled -entrybg white -autopost 1]
    set widgets(regexp) [checkbutton $bool_frame.regexp \
                             -text "Search using regular expression" \
                             -state disabled \
                             -variable Apol_Cond_Bools::opts(use_regexp)]
    trace add variable Apol_Cond_Bools::opts(enable_bool) write \
        [list Apol_Cond_Bools::_toggleSearchBools]
    pack $enable -anchor w
    pack $widgets(combo_box) $widgets(regexp) -padx 4 -anchor nw -expand 0 -fill x
    set show_default [checkbutton $show_frame.show_default \
                           -variable Apol_Cond_Bools::opts(show_default) \
                          -text "Show default state"]
    set show_current [checkbutton $show_frame.show_current \
                        -variable Apol_Cond_Bools::opts(show_current) \
                        -text "Show current state"]
    pack $show_default $show_current -anchor w
    set ok_button [button $ofm.ok -text "OK" -width 6 \
                       -command Apol_Cond_Bools::_search]
    pack $ok_button -side right -anchor ne -padx 5 -pady 5
    set widgets(results) [Apol_Widget::makeSearchResults [$rslts_frame getframe].results]
    pack $widgets(results) -expand yes -fill both
    return $frame
}
proc Apol_Cond_Bools::open {ppath} {
    set q [new_apol_bool_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    variable cond_bools_list [lsort [bool_vector_to_list $v]]
    $v -acquire
    $v -delete
    variable cond_bools_defaults
    foreach bool $cond_bools_list {
        set b [new_qpol_bool_t $::ApolTop::qpolicy $bool]
        set cond_bools_defaults($bool) [$b get_state $::ApolTop::qpolicy]
        _insert_listbox_item $bool $cond_bools_defaults($bool)
    }
    variable widgets
    $widgets(listbox) xview moveto 0
    $widgets(listbox) yview moveto 0
    $widgets(listbox) configure -areaheight 0 -areawidth 0
    $widgets(combo_box) configure -values $cond_bools_list
}
proc Apol_Cond_Bools::close {} {
    variable widgets
    variable cond_bools_list {}
    variable cond_bools_defaults
    variable cond_bools_values
    _initializeVars
    $widgets(combo_box) configure -values {}
    foreach w [winfo children [$widgets(listbox) getframe]] {
        destroy $w
    }
    [$widgets(listbox) getframe] configure -width 1 -height 1
    Apol_Widget::clearSearchResults $widgets(results)
    array unset cond_bools_defaults
    array unset cond_bools_values
}
proc Apol_Cond_Bools::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_Cond_Bools::getBooleans {} {
    variable cond_bools_list
    set cond_bools_list
}
proc Apol_Cond_Bools::_initializeVars {} {
    variable opts
    array set opts {
        enable_bool 0
        name ""
        use_regexp 0
        show_default 1
        show_current 1
    }
}
proc Apol_Cond_Bools::_insert_listbox_item {bool initial_state} {
    variable widgets
    variable cond_bools_values
    set cond_bools_values($bool) $initial_state
    set subf [$widgets(listbox) getframe]
    set rb_true [radiobutton $subf.t:$bool -bg white \
                     -variable Apol_Cond_Bools::cond_bools_values($bool) \
                     -value 1 -highlightthickness 0 -text "True"]
    set rb_false [radiobutton $subf.f:$bool -bg white \
                      -variable Apol_Cond_Bools::cond_bools_values($bool) \
                      -value 0 -highlightthickness 0 -text "False"]
    trace add variable Apol_Cond_Bools::cond_bools_values($bool) write \
        [list Apol_Cond_Bools::_set_bool_value]
    set rb_label [label $subf.l:$bool -bg white -text "- $bool"]
    grid $rb_true $rb_false $rb_label -padx 2 -pady 5 -sticky w
}
proc Apol_Cond_Bools::_toggleSearchBools {name1 name2 op} {
    variable opts
    variable widgets
    if {$opts(enable_bool)} {
        $widgets(combo_box) configure -state normal
        $widgets(regexp) configure -state normal
    } else {
        $widgets(combo_box) configure -state disabled
        $widgets(regexp) configure -state disabled
    }
}
proc Apol_Cond_Bools::_set_bool_value {name1 name2 op} {
    variable cond_bools_values
    set qpol_bool_datum [new_qpol_bool_t $::ApolTop::qpolicy $name2]
    $qpol_bool_datum set_state $::ApolTop::qpolicy $cond_bools_values($name2)
}
proc Apol_Cond_Bools::_resetAll {} {
    variable cond_bools_defaults
    variable cond_bools_values
    array set cond_bools_values [array get cond_bools_defaults]
}
proc Apol_Cond_Bools::_search {} {
    variable opts
    variable widgets
    Apol_Widget::clearSearchResults $widgets(results)
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
        return
    }
    set name [string trim $opts(name)]
    if {$opts(enable_bool) && $name == {}} {
        tk_messageBox -icon error -type ok -title "Error" -message "No boolean variable provided."
        return
    }
    set q [new_apol_bool_query_t]
    $q set_bool $::ApolTop::policy $name
    $q set_regex $::ApolTop::policy $opts(use_regexp)
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set bools_data [bool_vector_to_list $v]
    $v -acquire
    $v -delete
    set results {}
    set results "BOOLEANS:\n"
    if {[llength $bools_data] == 0} {
        append results "Search returned no results."
    } else {
        foreach b [lsort $bools_data] {
            append results "\n[_renderBool $b $opts(show_default) $opts(show_current)]"
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_Cond_Bools::_renderBool {bool_name show_default show_current} {
    variable cond_bools_defaults
    set qpol_bool_datum [new_qpol_bool_t $::ApolTop::qpolicy $bool_name]
    set cur_state [$qpol_bool_datum get_state $::ApolTop::qpolicy]
    set text [format "%-28s" $bool_name]
    if {$show_default} {
        if {$cond_bools_defaults($bool_name)} {
            append text "  Default State: True "
        } else {
            append text "  Default State: False"
        }
    }
    if {$show_current} {
        if {$cur_state} {
            append text "  Current State: True "
        } else {
            append text "  Current State: False"
        }
    }
    return $text
}
namespace eval Apol_Cond_Rules {
    variable vals
    variable widgets
}
proc Apol_Cond_Rules::create {tab_name nb} {
    variable vals
    variable widgets
    _initializeVars
    set frame [$nb insert end $tab_name -text "Conditional Expressions"]
    set topf [frame $frame.top]
    set bottomf [frame $frame.bottom]
    pack $topf -expand 0 -fill both -pady 2
    pack $bottomf -expand 1 -fill both -pady 2
    set rules_box [TitleFrame $topf.rules_box -text "Rule Selection"]
    set obox [TitleFrame $topf.obox -text "Search Options"]
    set dbox [TitleFrame $bottomf.dbox -text "Conditional Expressions Display"]
    pack $rules_box -side left -expand 0 -fill both -padx 2
    pack $obox -side left -expand 1 -fill both -padx 2
    pack $dbox -expand 1 -fill both -padx 2
    set fm_rules [$rules_box getframe]
    set allow [checkbutton $fm_rules.allow -text "allow" \
                   -onvalue $::QPOL_RULE_ALLOW -offvalue 0 \
                   -variable Apol_Cond_Rules::vals(rs:avrule_allow)]
    set auditallow [checkbutton $fm_rules.auditallow -text "auditallow" \
                        -onvalue $::QPOL_RULE_AUDITALLOW -offvalue 0 \
                        -variable Apol_Cond_Rules::vals(rs:avrule_auditallow)]
    set dontaudit [checkbutton $fm_rules.dontaudit -text "dontaudit" \
                       -onvalue $::QPOL_RULE_DONTAUDIT -offvalue 0 \
                       -variable Apol_Cond_Rules::vals(rs:avrule_dontaudit)]
    set type_transition [checkbutton $fm_rules.type_transition -text "type_trans" \
                             -onvalue $::QPOL_RULE_TYPE_TRANS -offvalue 0 \
                             -variable Apol_Cond_Rules::vals(rs:type_transition)]
    set type_member [checkbutton $fm_rules.type_member -text "type_member" \
                         -onvalue $::QPOL_RULE_TYPE_MEMBER -offvalue 0 \
                         -variable Apol_Cond_Rules::vals(rs:type_member)]
    set type_change [checkbutton $fm_rules.type_change -text "type_change" \
                         -onvalue $::QPOL_RULE_TYPE_CHANGE -offvalue 0 \
                         -variable Apol_Cond_Rules::vals(rs:type_change)]
    grid $allow $type_transition -sticky w -padx 2
    grid $auditallow $type_member -sticky w -padx 2
    grid $dontaudit $type_change -sticky w -padx 2
    set ofm [$obox getframe]
    set bool_frame [frame $ofm.bool]
    pack $bool_frame -side left -padx 4 -pady 2 -anchor nw
    set enable [checkbutton $bool_frame.enable \
                    -variable Apol_Cond_Rules::vals(enable_bool) \
                    -text "Boolean"]
    set widgets(combo_box) [ComboBox $bool_frame.combo_box \
                                -textvariable Apol_Cond_Rules::vals(name) \
                                -helptext "Type or select a boolean variable" \
                                -state disabled -entrybg white -autopost 1]
    set widgets(regexp) [checkbutton $bool_frame.regexp \
                             -text "Search using regular expression" \
                             -state disabled \
                             -variable Apol_Cond_Rules::vals(use_regexp)]
    trace add variable Apol_Cond_Rules::vals(enable_bool) write \
        [list Apol_Cond_Rules::_toggleSearchBools]
    pack $enable -anchor w
    pack $widgets(combo_box) $widgets(regexp) -padx 4 -anchor nw -expand 0 -fill x
    set ok_button [button $ofm.ok -text OK -width 6 \
                       -command Apol_Cond_Rules::_search]
    pack $ok_button -side right -anchor ne -padx 5 -pady 5
    set widgets(results) [Apol_Widget::makeSearchResults [$dbox getframe].results]
    pack $widgets(results) -expand yes -fill both
    return $frame
}
proc Apol_Cond_Rules::open {ppath} {
    variable widgets
    $widgets(combo_box) configure -values [Apol_Cond_Bools::getBooleans]
}
proc Apol_Cond_Rules::close {} {
    variable widgets
    _initializeVars
    $widgets(combo_box) configure -values {}
    Apol_Widget::clearSearchResults $widgets(results)
}
proc Apol_Cond_Rules::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_Cond_Rules::_initializeVars {} {
    variable vals
    array set vals [list \
                        rs:avrule_allow $::QPOL_RULE_ALLOW \
                        rs:avrule_auditallow $::QPOL_RULE_AUDITALLOW \
                        rs:avrule_dontaudit $::QPOL_RULE_DONTAUDIT \
                        rs:type_transition $::QPOL_RULE_TYPE_TRANS \
                        rs:type_member $::QPOL_RULE_TYPE_MEMBER \
                        rs:type_change $::QPOL_RULE_TYPE_CHANGE \
                        enable_bool 0 \
                        name {} \
                        use_regexp 0]
}
proc Apol_Cond_Rules::_toggleSearchBools {name1 name2 op} {
    variable vals
    variable widgets
    if {$vals(enable_bool)} {
        $widgets(combo_box) configure -state normal
        $widgets(regexp) configure -state normal
    } else {
        $widgets(combo_box) configure -state disabled
        $widgets(regexp) configure -state disabled
    }
}
proc Apol_Cond_Rules::_search {} {
    variable vals
    variable widgets
    .mainframe.frame.nb.frules.nb.fApol_Cond_Rules.top.obox.f.ok configure -state disabled
    Apol_Widget::clearSearchResults $widgets(results)
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
        .mainframe.frame.nb.frules.nb.fApol_Cond_Rules.top.obox.f.ok configure -state normal
        return
    }
    set avrule_selection 0
    foreach {key value} [array get vals rs:avrule_*] {
        set avrule_selection [expr {$avrule_selection | $value}]
    }
    set terule_selection 0
    foreach {key value} [array get vals rs:type_*] {
        set terule_selection [expr {$terule_selection | $value}]
    }
    if {$avrule_selection == 0 && $terule_selection == 0} {
            tk_messageBox -icon error -type ok -title "Error" -message "At least one rule must be selected."
            .mainframe.frame.nb.frules.nb.fApol_Cond_Rules.top.obox.f.ok configure -state normal
            return
    }
    set bool_name {}
    if {$vals(enable_bool)} {
        if {[set bool_name $vals(name)] == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No booleean selected."
            .mainframe.frame.nb.frules.nb.fApol_Cond_Rules.top.obox.f.ok configure -state normal
            return
        }
    }
    set q [new_apol_cond_query_t]
    $q set_bool $::ApolTop::policy $bool_name
    if {$vals(use_regexp)} {
        $q set_regex $::ApolTop::policy 1
    }
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set results [cond_vector_to_list $v]
    $v -acquire
    $v -delete
    if {[llength $results] == 0} {
        set text "Search returned no results."
    } else {
        set text "[llength $results] conditional"
        if {[llength $results] != 1} {
            append text s
        }
        append text " match the search criteria.  Expressions are in Reverse Polish Notation.\n\n"
    }
    Apol_Widget::appendSearchResultText $widgets(results) $text
    if {![info exists apol_progress]} {
        Apol_Progress_Dialog::wait "Conditional Expressions" "Rendering conditionals" \
        {
            if {[ApolTop::is_capable "syntactic rules"]} {
                $::ApolTop::qpolicy build_syn_rule_table
            }
            set counter 1
            set num_results [llength $results]
            foreach r [lsort -index 0 $results] {
                apol_tcl_set_info_string $::ApolTop::policy "Rendering $counter of $num_results"
                set text [_renderConditional $r $avrule_selection $terule_selection $counter]
                Apol_Widget::appendSearchResultText $widgets(results) "$text\n\n"
                incr counter
            }
        }
    }
    .mainframe.frame.nb.frules.nb.fApol_Cond_Rules.top.obox.f.ok configure -state normal
}
proc Apol_Cond_Rules::_renderConditional {cond avrules terules cond_number} {
    set cond_expr [apol_cond_expr_render $::ApolTop::policy $cond]
    set i [$cond get_av_true_iter $::ApolTop::qpolicy $avrules]
    set av_true_vector [new_apol_vector_t $i]
    $i -acquire
    $i -delete
    set i [$cond get_av_false_iter $::ApolTop::qpolicy $avrules]
    set av_false_vector [new_apol_vector_t $i]
    $i -acquire
    $i -delete
    set i [$cond get_te_true_iter $::ApolTop::qpolicy $terules]
    set te_true_vector [new_apol_vector_t $i]
    $i -acquire
    $i -delete
    set i [$cond get_te_false_iter $::ApolTop::qpolicy $terules]
    set te_false_vector [new_apol_vector_t $i]
    $i -acquire
    $i -delete
    variable widgets
    set text "conditional expression $cond_number: \[ [join $cond_expr] \]\n"
    Apol_Widget::appendSearchResultText $widgets(results) "$text\nTRUE list:\n"
    if {![ApolTop::is_capable "syntactic rules"]} {
        apol_tcl_avrule_sort $::ApolTop::policy $av_true_vector
        Apol_Widget::appendSearchResultRules $widgets(results) 4 $av_true_vector qpol_avrule_from_void
        apol_tcl_terule_sort $::ApolTop::policy $te_true_vector
        Apol_Widget::appendSearchResultRules $widgets(results) 4 $te_true_vector qpol_terule_from_void
    } else {
        set syn_avrules [apol_avrule_list_to_syn_avrules $::ApolTop::policy $av_true_vector NULL]
        Apol_Widget::appendSearchResultSynRules $widgets(results) 4 $syn_avrules qpol_syn_avrule_from_void
        set syn_terules [apol_terule_list_to_syn_terules $::ApolTop::policy $te_true_vector]
        Apol_Widget::appendSearchResultSynRules $widgets(results) 4 $syn_terules qpol_syn_terule_from_void
        $syn_avrules -acquire
        $syn_avrules -delete
        $syn_terules -acquire
        $syn_terules -delete
    }
    Apol_Widget::appendSearchResultText $widgets(results) "\nFALSE list:\n"
    if {![ApolTop::is_capable "syntactic rules"]} {
        apol_tcl_avrule_sort $::ApolTop::policy $av_false_vector
        Apol_Widget::appendSearchResultRules $widgets(results) 4 $av_false_vector qpol_avrule_from_void
        apol_tcl_terule_sort $::ApolTop::policy $te_false_vector
        Apol_Widget::appendSearchResultRules $widgets(results) 4 $te_false_vector qpol_terule_from_void
    } else {
        set syn_avrules [apol_avrule_list_to_syn_avrules $::ApolTop::policy $av_false_vector NULL]
        Apol_Widget::appendSearchResultSynRules $widgets(results) 4 $syn_avrules qpol_syn_avrule_from_void
        set syn_terules [apol_terule_list_to_syn_terules $::ApolTop::policy $te_false_vector]
        Apol_Widget::appendSearchResultSynRules $widgets(results) 4 $syn_terules qpol_syn_terule_from_void
        $syn_avrules -acquire
        $syn_avrules -delete
        $syn_terules -acquire
        $syn_terules -delete
    }
    $av_true_vector -acquire
    $av_true_vector -delete
    $av_false_vector -acquire
    $av_false_vector -delete
    $te_true_vector -acquire
    $te_true_vector -delete
    $te_false_vector -acquire
    $te_false_vector -delete
}
namespace eval Apol_Context_Dialog {
    variable dialog ""
    variable vars
}
proc Apol_Context_Dialog::getContext {{defaultContext {}} {defaultAttribute {}} {parent .}} {
    variable dialog
    variable vars
    if {![winfo exists $dialog]} {
        _create_dialog $parent
    }
    set user {}
    set role {}
    set type {}
    set low_level {}
    set high_level {}
    array set vars [list $dialog:low_enable 0  $dialog:high_enable 0]
    if {$defaultContext != {}} {
        set user [$defaultContext get_user] #line causing segfault. most likely the entire $defaultContext doesn't exist
        set role [$defaultContext get_role]
        set type [$defaultContext get_type]
        if {$defaultAttribute != {}} {
            lappend type $defaultAttribute
        }
        set range [$defaultContext get_range]
        if {$range != "NULL"} {
            set low_level [$range get_low]
            set high_level [$range get_high]
        }
    }
    $vars($dialog:user_box) configure -values [Apol_Users::getUsers]
    set vars($dialog:user) $user
    if {$user == {}} {
        set vars($dialog:user_enable) 0
    } else {
        set vars($dialog:user_enable) 1
    }
    $vars($dialog:role_box) configure -values [Apol_Roles::getRoles]
    set vars($dialog:role) $role
    if {$role == {}} {
        set vars($dialog:role_enable) 0
    } else {
        set vars($dialog:role_enable) 1
    }
    Apol_Widget::resetTypeComboboxToPolicy $vars($dialog:type_box)
    Apol_Widget::setTypeComboboxValue $vars($dialog:type_box) $type
    if {$type == {}} {
        set vars($dialog:type_enable) 0
    } else {
        set vars($dialog:type_enable) 1
    }
    Apol_Widget::resetLevelSelectorToPolicy $vars($dialog:low_level)
    Apol_Widget::resetLevelSelectorToPolicy $vars($dialog:high_level)
    if {[ApolTop::is_policy_open] && [ApolTop::is_capable "mls"]} {
        if {$low_level != {}} {
            set vars($dialog:low_enable) 1
            Apol_Widget::setLevelSelectorLevel $vars($dialog:low_level) $low_level
        }
        if {$high_level != {} && $high_level != "NULL"} {
            set vars($dialog:low_enable) 1
            set vars($dialog:high_enable) 1
            Apol_Widget::setLevelSelectorLevel $vars($dialog:high_level) $high_level
        }
        $vars($dialog:low_cb) configure -state normal
    } else {
        set vars($dialog:low_enable) 0
        set vars($dialog:high_enable) 0
        $vars($dialog:low_cb) configure -state disabled
    }
    $dialog.bbox _redraw
    set retval [$dialog draw]
    if {$retval == -1 || $retval == 1} {
        return {}
    }
    set context [_get_context $dialog]
    set attribute [lindex [Apol_Widget::getTypeComboboxValueAndAttrib $vars($dialog:type_box)] 1]
    list $context $attribute
}
proc Apol_Context_Dialog::_create_dialog {parent} {
    variable dialog
    variable vars
    set dialog [Dialog .context_dialog -modal local -parent $parent \
                    -separator 1 -homogeneous 1 -title "Select Context"]
    array unset vars $dialog:*
    set f [$dialog getframe]
    set left_f [frame $f.left]
    set user_f [frame $left_f.user]
    set vars($dialog:user_cb) [checkbutton $user_f.enable -text "User" \
                                  -variable Apol_Context_Dialog::vars($dialog:user_enable)]
    set vars($dialog:user_box) [ComboBox $user_f.user -entrybg white \
                                   -width 12 \
                                   -textvariable Apol_Context_Dialog::vars($dialog:user) \
                                   -autopost 1]
    trace add variable Apol_Context_Dialog::vars($dialog:user_enable) write \
        [list Apol_Context_Dialog::_user_changed $dialog]
    pack $vars($dialog:user_cb) -anchor nw
    pack $vars($dialog:user_box) -anchor nw -padx 4 -expand 0 -fill x
    set role_f [frame $left_f.role]
    set vars($dialog:role_cb) [checkbutton $role_f.enable -text "Role" \
                                 -variable Apol_Context_Dialog::vars($dialog:role_enable)]
    set vars($dialog:role_box) [ComboBox $role_f.role -entrybg white -width 12 \
                                  -textvariable Apol_Context_Dialog::vars($dialog:role) -autopost 1]
    trace add variable Apol_Context_Dialog::vars($dialog:role_enable) write \
        [list Apol_Context_Dialog::_role_changed $dialog]
    pack $vars($dialog:role_cb) -anchor nw
    pack $vars($dialog:role_box) -anchor nw -padx 4 -expand 0 -fill x
    set type_f [frame $left_f.type]
    set vars($dialog:type_cb) [checkbutton $type_f.enable -text "Type" \
                                   -variable Apol_Context_Dialog::vars($dialog:type_enable)]
    set vars($dialog:type_box) [Apol_Widget::makeTypeCombobox $type_f.type]
    pack $vars($dialog:type_cb) -anchor nw
    pack $vars($dialog:type_box) -anchor nw -padx 4 -expand 0 -fill x
    trace add variable Apol_Context_Dialog::vars($dialog:type_enable) write \
        [list Apol_Context_Dialog::_type_changed $dialog]
    pack $user_f $role_f $type_f -side top -expand 1 -fill x
    set mlsbox [TitleFrame $f.mlsbox -text "MLS Range"]
    set mls_f [$mlsbox getframe]
    set vars($dialog:low_cb) [checkbutton $mls_f.low_cb -text "Single Level" \
                                  -variable Apol_Context_Dialog::vars($dialog:low_enable)]
    set vars($dialog:low_level) [Apol_Widget::makeLevelSelector $mls_f.low 8]
    trace add variable Apol_Context_Dialog::vars($dialog:low_enable) write \
        [list Apol_Context_Dialog::_low_changed $dialog]
    set vars($dialog:high_cb) [checkbutton $mls_f.high_cb \
                                   -text "High Level" \
                                   -variable Apol_Context_Dialog::vars($dialog:high_enable)]
    set vars($dialog:high_level) [Apol_Widget::makeLevelSelector $mls_f.high 8]
    trace add variable Apol_Context_Dialog::vars($dialog:high_enable) write \
        [list Apol_Context_Dialog::_high_changed $dialog]
    grid $vars($dialog:low_cb) $vars($dialog:high_cb) -sticky w
    grid $vars($dialog:low_level) $vars($dialog:high_level) -sticky nsew
    grid columnconfigure $mls_f 0 -weight 1 -uniform 1 -pad 2
    grid columnconfigure $mls_f 1 -weight 1 -uniform 1 -pad 2
    grid rowconfigure $mls_f 1 -weight 1
    pack $left_f $mlsbox -side left -expand 1 -fill both
    $dialog add -text "OK" -command [list Apol_Context_Dialog::_okay $dialog]
    $dialog add -text "Cancel"
}
proc Apol_Context_Dialog::_okay {dialog} {
    variable vars
    set context [new_apol_context_t]
    if {[ApolTop::is_policy_open]} {
        set p $::ApolTop::policy
    } else {
        set p NULL
    }
    if {$vars($dialog:user_enable)} {
        if {[set user $vars($dialog:user)] == {}} {
            tk_messageBox -icon error -type ok -title "Could Not Validate Context" \
                -message "No user was selected."
            return
        }
        $context set_user $p $user
    }
    if {$vars($dialog:role_enable)} {
        if {[set role $vars($dialog:role)] == {}} {
            tk_messageBox -icon error -type ok -title "Could Not Validate Context" \
                -message "No role was selected."
            return
        }
        $context set_role $p $role
    }
    if {$vars($dialog:type_enable)} {
        set type [lindex [Apol_Widget::getTypeComboboxValueAndAttrib $vars($dialog:type_box)] 0]
        if {$type == {}} {
            tk_messageBox -icon error -type ok -title "Could Not Validate Context" \
                -message "No type was selected."
            return
        }
        $context set_type $p $type
    }
    if {$vars($dialog:low_enable)} {
        set range [_get_range $dialog]
        if {$range == {}} {
            tk_messageBox -icon error -type ok -title "Could Not Validate Context" \
                -message "No level was selected."
            return
        }
        $context set_range $p $range
    }
    if {![ApolTop::is_policy_open] || [$context validate_partial $p] <= 0} {
        tk_messageBox -icon error -type ok -title "Could Not Validate Context" \
            -message "The selected context is not valid for the current policy."
        return
    } else {
        $dialog enddialog 0
    }
    $context -acquire
    $context -delete
}
proc Apol_Context_Dialog::_get_context {dialog} {
    variable vars
    set context [new_apol_context_t]
    if {[ApolTop::is_policy_open]} {
        set p $::ApolTop::policy
    } else {
        set p NULL
    }
    if {$vars($dialog:user_enable)} {
        $context set_user $p $vars($dialog:user)
    }
    if {$vars($dialog:role_enable)} {
        $context set_role $p $vars($dialog:role)
    }
    if {$vars($dialog:type_enable)} {
        set type [lindex [Apol_Widget::getTypeComboboxValueAndAttrib $vars($dialog:type_box)] 0]
        $context set_type $p $type
    }
    set range [_get_range $dialog]
    if {$range != {}} {
        $context set_range $p $range
    }
    return $context
}
proc Apol_Context_Dialog::_get_range {dialog} {
    variable vars
    if {!$vars($dialog:low_enable)} {
        return {}
    }
    if {[ApolTop::is_policy_open]} {
        set p $::ApolTop::policy
    } else {
        set p NULL
    }
    set range [new_apol_mls_range_t]
    $range set_low $p [Apol_Widget::getLevelSelectorLevel $vars($dialog:low_level)]
    if {$vars($dialog:high_enable)} {
        $range set_high $p [Apol_Widget::getLevelSelectorLevel $vars($dialog:high_level)]
    }
    return $range
}
proc Apol_Context_Dialog::_user_changed {dialog name1 name2 op} {
    variable vars
    if {$vars($dialog:user_enable)} {
        $vars($dialog:user_box) configure -state normal
    } else {
        $vars($dialog:user_box) configure -state disabled
    }
}
proc Apol_Context_Dialog::_role_changed {dialog name1 name2 op} {
    variable vars
    if {$vars($dialog:role_enable)} {
        $vars($dialog:role_box) configure -state normal
    } else {
        $vars($dialog:role_box) configure -state disabled
    }
}
proc Apol_Context_Dialog::_type_changed {dialog name1 name2 op} {
    variable vars
    if {$vars($dialog:type_enable)} {
        Apol_Widget::setTypeComboboxState $vars($dialog:type_box) 1
    } else {
        Apol_Widget::setTypeComboboxState $vars($dialog:type_box) 0
    }
}
proc Apol_Context_Dialog::_low_changed {dialog name1 name2 op} {
    variable vars
    if {$vars($dialog:low_enable)} {
        $vars($dialog:high_cb) configure -state normal
        Apol_Widget::setLevelSelectorState $vars($dialog:low_level) 1
        if {$vars($dialog:high_enable)} {
            Apol_Widget::setLevelSelectorState $vars($dialog:high_level) 1
        }
    } else {
        $vars($dialog:high_cb) configure -state disabled
        Apol_Widget::setLevelSelectorState $vars($dialog:low_level) 0
        Apol_Widget::setLevelSelectorState $vars($dialog:high_level) 0
    }
}
proc Apol_Context_Dialog::_high_changed {dialog name1 name2 op} {
    variable vars
    if {$vars($dialog:high_enable)} {
        $vars($dialog:low_cb) configure -text "Low Level"
        Apol_Widget::setLevelSelectorState $vars($dialog:high_level) 1
    } else {
        $vars($dialog:low_cb) configure -text "Single Level"
        Apol_Widget::setLevelSelectorState $vars($dialog:high_level) 0
    }
}
namespace eval Apol_Widget {
    variable vars
}
proc Apol_Widget::makeContextSelector {path rangeMatchText {enableText "Context"} args} {
    variable vars
    array unset vars $path:*
    set vars($path:context) {}
    set vars($path:attribute) {}
    set vars($path:context_rendered) {}
    set vars($path:search_type) $::APOL_QUERY_EXACT
    set f [frame $path]
    set context_frame [frame $f.context]
    set context2_frame [frame $f.context2]
    pack $context_frame $context2_frame -side left -expand 0 -anchor nw
    if {$enableText != {}} {
        set vars($path:enable) 0
        set context_cb [checkbutton $context_frame.enable -text $enableText \
                          -variable Apol_Widget::vars($path:enable)]
        pack $context_cb -side top -expand 0 -anchor nw
        trace add variable Apol_Widget::vars($path:enable) write [list Apol_Widget::_toggle_context_selector $path $context_cb]
    }
    set context_display [eval Entry $context_frame.display -textvariable Apol_Widget::vars($path:context_rendered) -width 26 -editable 0 $args]
    set context_button [button $context_frame.button -text "Select Context..." -state disabled -command [list Apol_Widget::_show_context_dialog $path]]
    trace add variable Apol_Widget::vars($path:context) write [list Apol_Widget::_update_context_display $path]
    set vars($path:context) {}  ;# this will invoke the display function
    pack $context_display -side top -expand 1 -fill x -anchor nw
    pack $context_button -side top -expand 0 -anchor ne
    if {$enableText != {}} {
        pack configure $context_display -padx 4
        pack configure $context_button -padx 4
    }
    set range_label [label $context2_frame.label -text "MLS range matching:" \
                         -state disabled]
    set range_exact [radiobutton $context2_frame.exact -text "Exact matches" \
                         -state disabled -value $::APOL_QUERY_EXACT \
                         -variable Apol_Widget::vars($path:search_type)]
    set range_subset [radiobutton $context2_frame.subset -text "$rangeMatchText containing range" \
                          -state disabled -value $::APOL_QUERY_SUB \
                          -variable Apol_Widget::vars($path:search_type)]
    set range_superset [radiobutton $context2_frame.superset -text "$rangeMatchText within range" \
                            -state disabled -value $::APOL_QUERY_SUPER \
                            -variable Apol_Widget::vars($path:search_type)]
    pack $range_label $range_exact $range_subset $range_superset \
        -side top -expand 0 -anchor nw
    return $f
}
proc Apol_Widget::setContextSelectorState {path newState} {
    if {$newState == 0 || $newState == "disabled"} {
        set new_state disabled
    } else {
        set new_state normal
    }
    foreach w {display button} {
        $path.context.$w configure -state $new_state
    }
    if {![ApolTop::is_capable "mls"]} {
        set new_state disabled
    }
    foreach w {label exact subset superset} {
        $path.context2.$w configure -state $new_state
    }
}
proc Apol_Widget::clearContextSelector {path} {
    set Apol_Widget::vars($path:context) {}
    set Apol_Widget::vars($path:attribute) {}
    set Apol_Widget::vars($path:search_type) $::APOL_QUERY_EXACT
    catch {set Apol_Widget::vars($path:enable) 0}
}
proc Apol_Widget::getContextSelectorState {path} {
    return $Apol_Widget::vars($path:enable)
}
proc Apol_Widget::getContextSelectorValue {path} {
    variable vars
    list $vars($path:context) $vars($path:search_type) $vars($path:attribute)
}
proc Apol_Widget::_toggle_context_selector {path cb name1 name2 op} {
    if {$Apol_Widget::vars($path:enable)} {
        Apol_Widget::setContextSelectorState $path normal
    } else {
        Apol_Widget::setContextSelectorState $path disabled
    }
}
proc Apol_Widget::_show_context_dialog {path} {
    variable vars
    $path.context.button configure -state disabled
    set new_context [Apol_Context_Dialog::getContext $vars($path:context) $vars($path:attribute)]
    if {$new_context != {}} {
        set vars($path:context) [lindex $new_context 0]
        set vars($path:attribute) [lindex $new_context 1]
    }
    $path.context.button configure -state normal
}
proc Apol_Widget::_update_context_display {path name1 name2 op} {
    variable vars
    set display $path.context.display
    if {$vars($path:context) == {}} {
        set context_str "*:*:*"
        if {[ApolTop::is_policy_open] && [ApolTop::is_capable "mls"]} {
            append context_str ":*"
        }
    } else {
        set context_str [$vars($path:context) render $::ApolTop::policy]
    }
    set vars($path:context_rendered) $context_str
    $display configure -helptext $vars($path:context_rendered)
}
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]
        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
            }
        }
    }
    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
}
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) {}
}
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 {![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} {
    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
}
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 {
            eval $res.tb insert end [lindex $data 1]
        }
        $res.tb configure -state disabled
    }
}
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]
                $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."
}
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
    }
}
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 {
            }
            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]
        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
        }
    }
    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
}
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
    }
}
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]
    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) {}
}
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} {
    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
}
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 {
            eval $res.tb insert end $data
        }
        $res.tb configure -state disabled
    }
}
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 }]
        $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}
    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
    }
}
namespace eval Apol_File_Contexts {
    variable opts
    variable widgets
    variable info_button_text \
        "This tab allows the user to create and open a file context index.
The file context index is an on-disk database which contains the
labeling information for an entire filesystem.  Once an index has been
created it can then be queried by user, type, MLS range (if it
contains MLS information), object class, and/or path.\n
The result of the context query is a list of matching files, ordered
by path.  The first field is the full SELinux context, assuming that
'Show SELinux file context' is enabled.  If 'Show object class' is
enabled, then the next field is the type of file that matched; this
will be one of 'file', 'dir', and so forth.  The remaining field is
the full path to the file."
}
proc Apol_File_Contexts::create {tab_name nb} {
    variable opts
    variable widgets
    _initializeVars
    set frame [$nb insert end $tab_name -text "File Contexts"]
    set status [TitleFrame $frame.status -text "File Context Index"]
    set options [TitleFrame $frame.opts -text "Search Options"]
    set results [TitleFrame $frame.results -text "Matching Files"]
    pack $status $options -expand 0 -fill x -pady 2
    pack $results -expand 1 -fill both -pady 2
    set status_frame [$status getframe]
    set status_buttons [ButtonBox $status_frame.bb -homogeneous 1 -padx 2]
    $status_buttons add -text "Create and Open" -command {Apol_File_Contexts::_create_dialog}
    $status_buttons add -text "Open" -command {Apol_File_Contexts::_open_database}
    pack $status_buttons -side left -anchor nw -padx 2 -pady 4
    set status_text [frame $status_frame.t]
    pack $status_text -side left -anchor nw -padx 6 -pady 4
    label $status_text.l -text "Opened Index:"
    set status1 [label $status_text.t -textvariable Apol_File_Contexts::opts(statusText)]
    set status2 [label $status_text.t2 -textvariable Apol_File_Contexts::opts(statusText2) -fg red]
    trace add variable Apol_File_Contexts::opts(indexFilename) write \
        [list Apol_File_Contexts::_changeStatusLabel $status1 $status2]
    grid $status_text.l $status1 -sticky w
    grid x $status2 -sticky w -pady 2
    pack $status -side top -expand 0 -fill x -pady 2 -padx 2
    set opts(indexFilename) $opts(indexFilename)
    set options_frame [$options getframe]
    set show_frame [frame $options_frame.show]
    set user_frame [frame $options_frame.user]
    set role_frame [frame $options_frame.role]
    set type_frame [frame $options_frame.type]
    set range_frame [frame $options_frame.range]
    set objclass_frame [frame $options_frame.objclass]
    set path_frame [frame $options_frame.path]
    grid $show_frame $user_frame $role_frame $type_frame $range_frame $objclass_frame $path_frame \
        -padx 2 -sticky news
    foreach idx {1 2 3 4 5} {
        grid columnconfigure $options_frame $idx -uniform 1 -weight 0
    }
    grid columnconfigure $options_frame 0 -weight 0 -pad 8
    grid columnconfigure $options_frame 6 -weight 0
    set use_regexp [checkbutton $show_frame.regexp \
                           -variable Apol_File_Contexts::opts(useRegexp) \
                           -text "Search using regular expression"]
    set show_context [checkbutton $show_frame.context \
                          -variable Apol_File_Contexts::opts(showContext) \
                          -text "Show SELinux file context"]
    set show_objclass [checkbutton $show_frame.objclass \
                           -variable Apol_File_Contexts::opts(showObjclass) \
                           -text "Show object class"]
    pack $use_regexp $show_context $show_objclass -side top -anchor nw
    checkbutton $user_frame.enable -text "User" \
        -variable Apol_File_Contexts::opts(useUser)
    set widgets(user) [entry $user_frame.e -width 12 \
                           -textvariable Apol_File_Contexts::opts(user)]
    trace add variable Apol_File_Contexts::opts(useUser) write \
        [list Apol_File_Contexts::_toggleEnable $widgets(user)]
    pack $user_frame.enable -side top -anchor nw
    pack $widgets(user) -side top -anchor nw -padx 4 -expand 0 -fill x
    checkbutton $role_frame.enable -text "Role" \
        -variable Apol_File_Contexts::opts(useRole)
    set widgets(role) [entry $role_frame.e -width 12 \
                           -textvariable Apol_File_Contexts::opts(role)]
    trace add variable Apol_File_Contexts::opts(useRole) write \
        [list Apol_File_Contexts::_toggleEnable $widgets(role)]
    pack $role_frame.enable -side top -anchor nw
    pack $widgets(role) -side top -anchor nw -padx 4 -expand 0 -fill x
    checkbutton $type_frame.enable -text "Type" \
        -variable Apol_File_Contexts::opts(useType)
    set widgets(type) [entry $type_frame.e -width 12 \
                           -textvariable Apol_File_Contexts::opts(type)]
    trace add variable Apol_File_Contexts::opts(useType) write \
        [list Apol_File_Contexts::_toggleEnable $widgets(type)]
    pack $type_frame.enable -side top -anchor nw
    pack $widgets(type) -side top -anchor nw -padx 4 -expand 0 -fill x
    checkbutton $objclass_frame.enable -text "Object class" \
        -variable Apol_File_Contexts::opts(useObjclass)
    set widgets(objclass) [entry $objclass_frame.e -width 12 \
                           -textvariable Apol_File_Contexts::opts(objclass)]
    trace add variable Apol_File_Contexts::opts(useObjclass) write \
        [list Apol_File_Contexts::_toggleEnable $widgets(objclass)]
    pack $objclass_frame.enable -side top -anchor nw
    pack $widgets(objclass) -side top -anchor nw -padx 4 -expand 0 -fill x
    set range_cb [checkbutton $range_frame.enable \
                      -variable Apol_File_Contexts::opts(useRange) -text "MLS range"]
    set range_entry [entry $range_frame.e -width 12 \
                         -textvariable Apol_File_Contexts::opts(range)]
    trace add variable Apol_File_Contexts::opts(useRange) write \
        [list Apol_File_Contexts::_toggleEnable $range_entry]
    trace add variable Apol_File_Contexts::opts(fc_is_mls) write \
        [list Apol_File_Contexts::_toggleRange $range_cb $range_entry]
    pack $range_cb -side top -anchor nw
    pack $range_entry -side top -anchor nw -padx 4 -expand 0 -fill x
    checkbutton $path_frame.enable \
        -variable Apol_File_Contexts::opts(usePath) -text "File path"
    set path_entry [entry $path_frame.path -width 24 \
                        -textvariable Apol_File_Contexts::opts(path)]
    trace add variable Apol_File_Contexts::opts(usePath) write \
        [list Apol_File_Contexts::_toggleEnable $path_entry]
    pack $path_frame.enable -side top -anchor nw
    pack $path_entry -side top -anchor nw -padx 4 -expand 0 -fill x
    set bb [ButtonBox $options_frame.bb -orient vertical -homogeneous 1 -pady 2]
    $bb add -text OK -width 6 -command {Apol_File_Contexts::_search}
    $bb add -text Info -width 6 -command {Apol_File_Contexts::_show_info}
    grid $bb -row 0 -column 7 -padx 5 -pady 5 -sticky ne
    grid columnconfigure $options_frame 7 -weight 1
    set widgets(results) [Apol_Widget::makeSearchResults [$results getframe].results]
    pack $widgets(results) -expand yes -fill both
    return $frame
}
proc Apol_File_Contexts::open {ppath} {
    if {[is_db_loaded]} {
        variable opts
        $opts(db) associatePolicy $::ApolTop::policy
    }
}
proc Apol_File_Contexts::close {} {
    _close_database
}
proc Apol_File_Contexts::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_File_Contexts::is_db_loaded {} {
    variable opts
    if {$opts(db) != {}} {
        return 1
    }
    return 0
}
proc Apol_File_Contexts::get_fc_files_for_ta {which ta} {
    set q [new_sefs_query]
    if {$which == "type"} {
        $q type $ta 0
    } else {
        $q type $ta 1
    }
    variable opts
    if {[catch {Apol_Progress_Dialog::wait "File Contexts" "Searching database for $ta" \
                    {
                        $opts(db) runQuery $q
                    }} results]} {
        tk_messageBox -icon error -type ok -title "File Contexts" -message $results
        delete_sefs_query $q
        return {}
    }
    delete_sefs_query $q
    return $results
}
proc Apol_File_Contexts::_initializeVars {} {
    variable opts
    variable widgets
    array set opts {
        useUser 0       user {}
        useRole 0       role {}
        useType 0       type {}
        useObjclass 0   objclass {}
        useRange 0      range {}
        usePath 0       path {}
        useRegexp 0  showContext 1  showObjclass 1
        db {}
        fc_is_mls 1
        indexFilename {}
    }
}
proc Apol_File_Contexts::_show_info {} {
    .mainframe.frame.nb.fApol_File_Contexts.opts.f.bb.b1 configure -state disabled
    Apol_Widget::showPopupParagraph "File Contexts Information" $Apol_File_Contexts::info_button_text
    .mainframe.frame.nb.fApol_File_Contexts.opts.f.bb.b1 configure -state normal
}
proc Apol_File_Contexts::_changeStatusLabel {label1 label2 name1 name2 opt} {
    variable opts
    if {$opts(db) == {}} {
        set opts(statusText) "No Index File Opened"
        $label1 configure -fg red
        set opts(statusText2) {}
    } else {
        set opts(statusText) $opts(indexFilename)
        $label1 configure -fg black
        if {$opts(fc_is_mls)} {
            set opts(statusText2) "Database contexts include MLS ranges."
            $label2 configure -fg black
        } else {
            set opts(statusText2) "Database contexts do not include MLS ranges."
            $label2 configure -fg red
        }
    }
}
proc Apol_File_Contexts::_toggleEnable {entry name1 name2 op} {
    variable opts
    if {$opts($name2)} {
        $entry configure -state normal -bg white
    } else {
        $entry configure -state disabled -bg $ApolTop::default_bg_color
    }
}
proc Apol_File_Contexts::_toggleRange {cb entry name1 name2 op} {
    variable opts
    if {$opts(fc_is_mls)} {
        $cb configure -state normal
        if {$opts(useRange)} {
            $entry configure -state normal -bg white
        }
    } else {
        $cb configure -state disabled
        $entry configure -state disabled -bg $ApolTop::default_bg_color
    }
}
proc Apol_File_Contexts::_create_dialog {} {
    variable opts
    set opts(new_filename) $opts(indexFilename)
    set opts(new_rootdir) "/"
    set d [Dialog .filecontexts_create -title "Create Index File" \
               -default 0 -cancel 1 -modal local -parent . -separator 1]
    $d add -text "OK" -command [list Apol_File_Contexts::_create_database $d] \
        -state disabled
    $d add -text "Cancel"
    set f [$d getframe]
    set file_l [label $f.file_l -justify left -anchor w -text "Save index to:"]
    set file_entry [entry $f.file_e -width 30 -bg white -takefocus 1\
                        -textvariable Apol_File_Contexts::opts(new_filename) \
                        -validate key \
                        -vcmd [list Apol_File_Contexts::_validateEntryKey %P $d new_rootdir]]
    focus $file_entry
    set file_browse [button $f.file_b -text "Browse" -width 8 -takefocus 1 \
                         -command [list Apol_File_Contexts::_browse_save]]
    set root_l [label $f.root_l -justify left -anchor w -text "Directory to index:"]
    set root_entry [entry $f.root_e -width 30 -bg white -takefocus 1 \
                        -textvariable Apol_File_Contexts::opts(new_rootdir) \
                        -validate key \
                        -vcmd [list Apol_File_Contexts::_validateEntryKey %P $d new_filename]]
    set root_browse [button $f.root_b -text "Browse" -width 8 -takefocus 1 \
                         -command [list Apol_File_Contexts::_browse_root]]
    grid $file_l $file_entry $file_browse -padx 4 -pady 2 -sticky ew
    grid $root_l $root_entry $root_browse -padx 4 -pady 2 -sticky ew
    grid columnconfigure $f 0 -weight 0
    grid columnconfigure $f 1 -weight 1
    grid columnconfigure $f 2 -weight 0
    $d draw
    destroy $d
}
proc Apol_File_Contexts::_browse_save {} {
    variable opts
    set f [tk_getSaveFile -initialfile $opts(new_filename) \
           -parent .filecontexts_create -title "Save Index"]
    if {$f != {}} {
        set opts(new_filename) $f
    }
}
proc Apol_File_Contexts::_browse_root {} {
    variable opts
    set f [tk_chooseDirectory -initialdir $opts(new_rootdir) \
               -parent .filecontexts_create -title "Directory to Index"]
    if {$f != {}} {
        set opts(new_rootdir) $f
    }
}
proc Apol_File_Contexts::_validateEntryKey {newvalue dialog othervar} {
    variable opts
    if {$newvalue == {} || $opts($othervar) == {}} {
        $dialog itemconfigure 0 -state disabled
    } else {
        $dialog itemconfigure 0 -state normal
    }
    return 1
}
proc Apol_File_Contexts::_create_database {dialog} {
    variable opts
    if {[catch {Apol_Progress_Dialog::wait "Create Database" "Scanning $opts(new_rootdir)" \
                    {
                        set db [apol_tcl_open_database_from_dir $opts(new_rootdir)]
                        $db save $opts(new_filename)
                        set db
                    } \
                } db] || $db == "NULL"} {
        tk_messageBox -icon error -type ok -title "Create Database" \
            -message [apol_tcl_get_info_string]
        return
    }
    if {$opts(db) != {}} {
        delete_sefs_fclist $opts(db)
    }
    _initializeVars
    set opts(db) $db
    set opts(fc_is_mls) [$db isMLS]
    set opts(indexFilename) $opts(new_filename)
    if {[ApolTop::is_policy_open]} {
        $opts(db) associatePolicy $::ApolTop::policy
    }
    $dialog enddialog {}
}
proc Apol_File_Contexts::_open_database {} {
    variable opts
    set f [tk_getOpenFile -initialfile $opts(indexFilename) -parent . \
               -title "Open Database"]
    if {$f == {}} {
        return
    }
    if {[catch {Apol_Progress_Dialog::wait "Open Database" "Opening $f" \
                    {apol_tcl_open_database $f} \
                } db] || $db == "NULL"} {
        tk_messageBox -icon error -type ok -title "Open Database" \
            -message [apol_tcl_get_info_string]
        return
    }
    if {$opts(db) != {}} {
        delete_sefs_fclist $opts(db)
    }
    _initializeVars
    set opts(db) $db
    set opts(fc_is_mls) [$db isMLS]
    set opts(indexFilename) $f
    if {[ApolTop::is_policy_open]} {
        $opts(db) associatePolicy $::ApolTop::policy
    }
}
proc Apol_File_Contexts::_search {} {
    variable opts
    variable widgets
    if {$opts(db) == {}} {
        tk_messageBox -icon error -type ok -title "File Contexts" -message "No database opened."
        return
    }
    Apol_Widget::clearSearchResults $widgets(results)
    if {$opts(useUser)} {
        if {[set user $opts(user)] == {}} {
            tk_messageBox -icon error -type ok -title "File Contexts" -message "No user selected."
            return
        }
    } else {
        set user {}
    }
    if {$opts(useRole)} {
        if {[set role $opts(role)] == {}} {
            tk_messageBox -icon error -type ok -title "File Contexts" -message "No user selected."
            return
        }
    } else {
        set role {}
    }
    if {$opts(useType)} {
        if {[set type $opts(type)] == {}} {
            tk_messageBox -icon error -type ok -title "File Contexts" -message "No type selected."
            return
        }
    } else {
        set type {}
    }
    if {$opts(fc_is_mls) && $opts(useRange)} {
        if {[set range $opts(range)] == {}} {
            tk_messageBox -icon error -type ok -title "File Contexts" -message "No MLS range selected."
            return
        }
    } else {
        set range {}
    }
    if {$opts(useObjclass)} {
        if {[set objclass $opts(objclass)] == {}} {
            tk_messageBox -icon error -type ok -title "File Contexts" -message "No object class selected."
            return
        }
    } else {
        set objclass {}
    }
    if {$opts(usePath)} {
        if {[set path $opts(path)] == {}} {
            tk_messageBox -icon error -type ok -title "File Contexts" -message "No path selected."
            return
        }
    } else {
        set path {}
    }
    set q [new_sefs_query]
    $q user $user
    $q role $role
    $q type $type 0
    $q range $range 0
    $q objectClass $objclass
    $q path $path
    $q regex $opts(useRegexp)
    if {[catch {Apol_Progress_Dialog::wait "File Contexts" "Searching database" \
                    {
                        set num_results [apol_tcl_query_database $opts(db) $q]
                        if {$num_results == 0} {
                            Apol_Widget::appendSearchResultText $widgets(results) "Search returned no results."
                        } else {
                            Apol_Widget::appendSearchResultHeader $widgets(results) "FILES FOUND ($num_results):\n\n"
                        }
                    }} err]} {
        tk_messageBox -icon error -type ok -title "File Contexts" -message $err
    }
    delete_sefs_query $q
}
proc Apol_File_Contexts::_search_callback {entry} {
    variable opts
    variable widgets
    set text {}
    if {$opts(showContext)} {
        set context [[$entry context] render NULL]
        append text [format "%-40s" $context]
    }
    if {$opts(showObjclass)} {
        set class [apol_objclass_to_str [$entry objectClass]]
        append text [format " %-12s" $class]
    }
    append text " [$entry path]\n"
    Apol_Widget::appendSearchResultText $widgets(results) $text
}
proc Apol_File_Contexts::_close_database {} {
    variable opts
    variable widgets
    if {$opts(db) != {}} {
        delete_sefs_fclist $opts(db)
    }
    _initializeVars
    Apol_Widget::clearSearchResults $widgets(results)
}
namespace eval Apol_Find {
    variable dialog .apol_find_dialog
    variable search_string {}
    variable case_sensitive 0
    variable enable_regexp 0
    variable direction "down"
}
proc Apol_Find::find {} {
    variable dialog
    if {![winfo exists $dialog]} {
        _create_dialog
    } else {
        raise $dialog
        variable entry
        focus $entry
        $entry selection range 0 end
    }
}
proc Apol_Find::_create_dialog {} {
    variable dialog
    Dialog $dialog -title "Find" -separator 0 -parent . \
        -side right -default 0 -cancel 1 -modal none -homogeneous 1
    set top_frame [frame [$dialog getframe].top]
    set bottom_frame [frame [$dialog getframe].bottom]
    pack $top_frame -expand 1 -fill both -padx 10 -pady 5
    pack $bottom_frame -expand 0 -fill both -padx 10 -pady 5
    set entry_label [label $top_frame.l -text "Find:" -anchor e]
    variable entry [entry $top_frame.e -bg white \
                        -textvariable Apol_Find::search_string -width 16]
    pack $entry_label -side left -expand 0 -padx 10
    pack $entry -side left -expand 1 -fill x
    set options_frame [frame $bottom_frame.opts]
    pack $options_frame -side left -padx 5
    set options_case [checkbutton $options_frame.case -text "Match case" \
                          -variable Apol_Find::case_sensitive]
    set options_regex [checkbutton $options_frame.regex -text "Regular expression" \
                           -variable Apol_Find::enable_regexp]
    pack $options_case -anchor w
    pack $options_regex -anchor w
    set dir_frame [TitleFrame $bottom_frame.dir -text Direction]
    pack $dir_frame -side left
    set dir_up [radiobutton [$dir_frame getframe].up -text Up \
                    -variable Apol_Find::direction -value up]
    set dir_down [radiobutton [$dir_frame getframe].down -text Down \
                      -variable Apol_Find::direction -value down]
    pack $dir_up $dir_down -side left
    $dialog add -text "Find Next" -command Apol_Find::_do_find
    $dialog add -text "Cancel" -command [list destroy $dialog]
    focus $entry
    $dialog draw
    wm resizable $dialog 0 0
}
proc Apol_Find::_do_find {} {
    set w [ApolTop::getCurrentTextWidget]
    if {$w == {}} {
        return
    }
    variable search_string
    variable case_sensitive
    variable enable_regexp
    variable direction
    if {$search_string == {}} {
        return
    }
    set opts {}
    if {!$case_sensitive} {
        lappend opts "-nocase"
    }
    if {$enable_regexp} {
        lappend opts "-regexp"
    }
    if {$direction == "down"} {
        lappend opts "-forward"
        set start_pos [$w index insert]
    } else {
        lappend opts "-backward"
        set start_pos [lindex [$w tag ranges sel] 0]
    }
    if {$start_pos == {}} {
        set start_pos "1.0"
    }
    $w tag remove sel 0.0 end
    variable dialog
    if {[catch {eval $w search -count count $opts -- [list $search_string] $start_pos} pos]} {
        tk_messageBox -parent $dialog -icon warning -type ok -title "Find" -message \
                 "Invalid regular expression."
        return
    }
    if {$pos == {}} {
        tk_messageBox -parent $dialog -icon warning -type ok -title "Find" -message \
                 "String not found."
    } else {
        if {$direction == "down"} {
            $w mark set insert "$pos + $count char"
            $w see "$pos + $count char"
        } else {
            $w mark set insert "$pos"
            $w see $pos
        }
        $w tag add sel $pos "$pos + $count char"
    }
}
namespace eval Apol_FSContexts {
    variable widgets
    variable vals
}
proc Apol_FSContexts::create {tab_name nb} {
    variable widgets
    variable vals
    _initializeVars
    set frame [$nb insert end $tab_name -text "FS Contexts"]
    set pw [PanedWindow $frame.pw -side top -weights extra]
    set leftf [$pw add -weight 0]
    set rightf [$pw add -weight 1]
    pack $pw -fill both -expand yes
    set context_box [TitleFrame $leftf.context_f -text "Context Type"]
    set context_f [$context_box getframe]
    radiobutton $context_f.genfscon -text "genfscon" -value genfscon \
        -variable Apol_FSContexts::vals(context_type)
    radiobutton $context_f.fsuse -text "fs_use" -value fsuse \
        -variable Apol_FSContexts::vals(context_type)
    trace add variable Apol_FSContexts::vals(context_type) write \
        {Apol_FSContexts::_contextTypeChanged}
    pack $context_f.genfscon $context_f.fsuse \
        -anchor w -expand 0 -padx 4 -pady 5
    pack $context_box -expand 0 -fill x
    set widgets(items_tf) [TitleFrame $leftf.items_f -text "GenFS Contexts"]
    set widgets(items) [Apol_Widget::makeScrolledListbox [$widgets(items_tf) getframe].items \
                            -height 20 -width 20 -listvar Apol_FSContexts::vals(items)]
    Apol_Widget::setListboxCallbacks $widgets(items) \
        {{"Show Context Info" {Apol_FSContexts::_popupContextInfo}}}
    pack $widgets(items) -expand 1 -fill both
    pack $widgets(items_tf) -expand 1 -fill both
    set optsbox [TitleFrame $rightf.optsbox -text "Search Options"]
    pack $optsbox -side top -expand 0 -fill both -padx 2
    set widgets(options_pm) [PagesManager [$optsbox getframe].pm]
    _genfscon_create [$widgets(options_pm) add genfscon]
    _fsuse_create [$widgets(options_pm) add fsuse]
    $widgets(options_pm) compute_size
    pack $widgets(options_pm) -expand 1 -fill both -side left
    $widgets(options_pm) raise genfscon
    set ok [button [$optsbox getframe].ok -text "OK" -width 6 \
                -command Apol_FSContexts::_runSearch]
    pack $ok -side right -pady 5 -padx 5 -anchor ne
    set resultsbox [TitleFrame $rightf.resultsbox -text "Search Results"]
    pack $resultsbox -expand yes -fill both -padx 2
    set widgets(results) [Apol_Widget::makeSearchResults [$resultsbox getframe].results]
    pack $widgets(results) -side top -expand yes -fill both
    return $frame
}
proc Apol_FSContexts::open {ppath} {
    variable vals
    _genfscon_open
    _fsuse_open
    set vals(context_type) genfscon
}
proc Apol_FSContexts::close {} {
    variable widgets
    _initializeVars
    Apol_Widget::clearSearchResults $widgets(results)
    Apol_Widget::clearContextSelector $widgets(genfscon:context)
    Apol_Widget::clearContextSelector $widgets(fsuse:context)
    $widgets(genfscon:fs) configure -values {}
    $widgets(fsuse:type) configure -values {}
    $widgets(fsuse:fs) configure -values {}
}
proc Apol_FSContexts::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_FSContexts::_initializeVars {} {
    variable vals
    array set vals {
        genfscon:items {}
        genfscon:fs_enable 0     genfscon:fs {}
        genfscon:path_enable 0   genfscon:path {}
        fsuse:items {}
        fsuse:type_enable 0  fsuse:type {}
        fsuse:fs_enable 0    fsuse:fs {}
        items {}
        context_type genfscon
    }
}
proc Apol_FSContexts::_contextTypeChanged {name1 name2 op} {
    variable vals
    variable widgets
    Apol_Widget::clearSearchResults $widgets(results)
    if {$vals(context_type) == "genfscon"} {
        _genfscon_show
    } else {
        _fsuse_show
    }
}
proc Apol_FSContexts::_popupContextInfo {value} {
    variable vals
    if {$vals(context_type) == "genfscon"} {
        _genfscon_popup $value
    } else {
        _fsuse_popup $value
    }
}
proc Apol_FSContexts::_toggleCheckbutton {path name1 name2 op} {
    variable vals
    variable widgets
    if {$vals($name2)} {
        $path configure -state normal
    } else {
        $path configure -state disabled
    }
}
proc Apol_FSContexts::_runSearch {} {
    variable vals
    variable widgets
    Apol_Widget::clearSearchResults $widgets(results)
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
        return
    }
    if {$vals(context_type) == "genfscon"} {
        _genfscon_runSearch
    } else {
        _fsuse_runSearch
    }
}
proc Apol_FSContexts::_genfscon_create {p_f} {
    variable widgets
    variable vals
    set fs [frame $p_f.fs]
    set fs_cb [checkbutton $fs.fs_enable -text "Filesystem" \
                   -variable Apol_FSContexts::vals(genfscon:fs_enable)]
    set widgets(genfscon:fs) [ComboBox $fs.fs -entrybg white -width 12 -state disabled \
                                  -textvariable Apol_FSContexts::vals(genfscon:fs) -autopost 1]
    trace add variable Apol_FSContexts::vals(genfscon:fs_enable) write \
        [list Apol_FSContexts::_toggleCheckbutton $widgets(genfscon:fs)]
    pack $fs_cb -side top -anchor w
    pack $widgets(genfscon:fs) -side top -expand 0 -fill x -padx 4
    set p [frame $p_f.p]
    set p_cb [checkbutton $p.p_enable -text "Path" \
                   -variable Apol_FSContexts::vals(genfscon:path_enable)]
    set widgets(genfscon:path) [entry $p.path -bg white -width 24 \
                                    -state disabled \
                                    -textvariable Apol_FSContexts::vals(genfscon:path)]
    trace add variable Apol_FSContexts::vals(genfscon:path_enable) write \
        [list Apol_FSContexts::_toggleCheckbutton $widgets(genfscon:path)]
    pack $p_cb -side top -anchor w
    pack $widgets(genfscon:path) -side top -expand 0 -fill x -padx 4
    frame $p_f.c
    set widgets(genfscon:context) [Apol_Widget::makeContextSelector $p_f.c.context "Contexts"]
    pack $widgets(genfscon:context)
    pack $fs $p $p_f.c -side left -anchor n -padx 4 -pady 2
}
proc Apol_FSContexts::_genfscon_open {} {
    variable vals
    set q [new_apol_genfscon_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set genfscons [genfscon_vector_to_list $v]
    set vals(genfscon:items) {}
    foreach g $genfscons {
        lappend vals(genfscon:items) [$g get_name $::ApolTop::qpolicy]
    }
    set vals(genfscon:items) [lsort -unique $vals(genfscon:items)]
    $v -acquire
    $v -delete
    variable widgets
    $widgets(genfscon:fs) configure -values $vals(genfscon:items)
}
proc Apol_FSContexts::_genfscon_show {} {
    variable vals
    variable widgets
    $widgets(items_tf) configure -text "GenFS Contexts"
    $widgets(options_pm) raise genfscon
    set vals(items) $vals(genfscon:items)
}
proc Apol_FSContexts::_genfscon_popup {fstype} {
    set q [new_apol_genfscon_query_t]
    $q set_filesystem $::ApolTop::policy $fstype
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set genfscons [genfscon_vector_to_list $v]
    set text "genfs filesystem $fstype ([llength $genfscons] context"
    if {[llength $genfscons] != 1} {
        append text s
    }
    append text ")"
    foreach g [lsort -command _genfscon_sort $genfscons] {
        append text "\n    [_genfscon_render $g]"
    }
    Apol_Widget::showPopupText "filesystem $fstype" $text
    $v -acquire
    $v -delete
}
proc Apol_FSContexts::_genfscon_runSearch {} {
    variable vals
    variable widgets
    if {$vals(genfscon:fs_enable)} {
        if {$vals(genfscon:fs) == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No filesystem selected."
            return
        }
        set fstype $vals(genfscon:fs_enable)
    } else {
        set fstype {}
    }
    if {$vals(genfscon:path_enable)} {
        if {$vals(genfscon:path) == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No path given."
            return
        }
        set path $vals(genfscon:path)
    } else {
        set path {}
    }
    set q [new_apol_genfscon_query_t]
    if {[Apol_Widget::getContextSelectorState $widgets(genfscon:context)]} {
        foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(genfscon:context)] {break}
        $q set_context $::ApolTop::policy $context $range_match
    }
    $q set_filesystem $::ApolTop::policy $fstype
    $q set_path $::ApolTop::policy $path
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set genfscons [genfscon_vector_to_list $v]
    set results "GENFSCONS:"
    if {[llength $genfscons] == 0} {
        append results "\nSearch returned no results."
    } else {
        foreach g [lsort -command _genfscon_sort $genfscons] {
            append results "\n[_genfscon_render $g]"
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) $results
    $v -acquire
    $v -delete
}
proc Apol_FSContexts::_genfscon_render {qpol_genfscon_datum} {
    apol_genfscon_render $::ApolTop::policy $qpol_genfscon_datum
}
proc Apol_FSContexts::_genfscon_sort {a b} {
    set name_a [$a get_name $::ApolTop::qpolicy]
    set name_b [$b get_name $::ApolTop::qpolicy]
    if {[set z [string compare $name_a $name_b]] != 0} {
        return $z
    }
    set path_a [$a get_path $::ApolTop::qpolicy]
    set path_b [$b get_path $::ApolTop::qpolicy]
    if {[set z [string compare $path_a $path_b]] != 0} {
        return $z
    }
    return 0
}
proc Apol_FSContexts::_fsuse_create {p_f} {
    variable widgets
    variable vals
    set t [frame $p_f.t]
    set type_cb [checkbutton $t.type_enable -text "Statement type" \
                   -variable Apol_FSContexts::vals(fsuse:type_enable)]
    set widgets(fsuse:type) [ComboBox $t.type -entrybg white -width 12 -state disabled \
                                  -textvariable Apol_FSContexts::vals(fsuse:type) -autopost 1]
    trace add variable Apol_FSContexts::vals(fsuse:type_enable) write \
        [list Apol_FSContexts::_toggleCheckbutton $widgets(fsuse:type)]
    pack $type_cb -side top -anchor w
    pack $widgets(fsuse:type) -side top -expand 0 -fill x -padx 4
    set fs [frame $p_f.fs]
    set fs_cb [checkbutton $fs.fs_enable -text "Filesystem" \
                   -variable Apol_FSContexts::vals(fsuse:fs_enable)]
    set widgets(fsuse:fs) [ComboBox $fs.fs -entrybg white -width 12 -state disabled \
                                  -textvariable Apol_FSContexts::vals(fsuse:fs) -autopost 1]
    trace add variable Apol_FSContexts::vals(fsuse:fs_enable) write \
        [list Apol_FSContexts::_toggleCheckbutton $widgets(fsuse:fs)]
    pack $fs_cb -side top -anchor w
    pack $widgets(fsuse:fs) -side top -expand 0 -fill x -padx 4
    frame $p_f.c
    set widgets(fsuse:context) [Apol_Widget::makeContextSelector $p_f.c.context "Contexts"]
    pack $widgets(fsuse:context)
    pack $t $fs $p_f.c -side left -anchor n -padx 4 -pady 2
}
proc Apol_FSContexts::_fsuse_open {} {
    variable vals
    set q [new_apol_fs_use_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set fs_uses [lsort -unique [fs_use_vector_to_list $v]]
    $v -acquire
    $v -delete
    set vals(fsuse:items) {}
    set behavs {}
    foreach f $fs_uses {
        lappend vals(fsuse:items) [$f get_name $::ApolTop::qpolicy]
        lappend behavs [apol_fs_use_behavior_to_str [$f get_behavior $::ApolTop::qpolicy]]
    }
    variable widgets
    set vals(fsuse:items) [lsort -unique $vals(fsuse:items)]
    $widgets(fsuse:type) configure -values [lsort -unique $behavs]
    $widgets(fsuse:fs) configure -values $vals(fsuse:items)
}
proc Apol_FSContexts::_fsuse_show {} {
    variable vals
    variable widgets
    $widgets(items_tf) configure -text "fs_use Contexts"
    $widgets(options_pm) raise fsuse
    set vals(items) $vals(fsuse:items)
}
proc Apol_FSContexts::_fsuse_popup {fs} {
    set qpol_fs_use_datum [new_qpol_fs_use_t $::ApolTop::qpolicy $fs]
    set text "fs_use $fs\n    [_fsuse_render $qpol_fs_use_datum]"
    Apol_Widget::showPopupText $fs $text
}
proc Apol_FSContexts::_fsuse_runSearch {} {
    variable vals
    variable widgets
    if {$vals(fsuse:type_enable)} {
        if {$vals(fsuse:type) == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No fs_use statement type selected."
            return
        }
        set behavior [apol_str_to_fs_use_behavior $vals(fsuse:type)]
        if {$behavior < 0} {
            tk_messageBox -icon error -type ok -title "Error" -message "$vals(fsuse:type) is not a valid fs_use statement type."
            return
        }
    } else {
        set behavior -1
    }
    if {$vals(fsuse:fs_enable)} {
        if {$vals(fsuse:fs) == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No filesystem selected."
            return
        }
        set fstype $vals(fsuse:fs)
    } else {
        set fstype {}
    }
    set q [new_apol_fs_use_query_t]
    if {[Apol_Widget::getContextSelectorState $widgets(fsuse:context)]} {
        foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(fsuse:context)] {break}
        $q set_context $::ApolTop::policy $context $range_match
    }
    $q set_filesystem $::ApolTop::policy $fstype
    $q set_behavior $::ApolTop::policy $behavior
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set fsuses [fs_use_vector_to_list $v]
    $v -acquire
    $v -delete
    set results "FS_USES:"
    if {[llength $fsuses] == 0} {
        append results "\nSearch returned no results."
    } else {
        foreach u [lsort -command _fsuse_sort $fsuses] {
            append results "\n[_fsuse_render $u]"
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_FSContexts::_fsuse_render {qpol_fs_use_datum} {
    apol_fs_use_render $::ApolTop::policy $qpol_fs_use_datum
}
proc Apol_FSContexts::_fsuse_sort {a b} {
    set behav_a [apol_fs_use_behavior_to_str [$a get_behavior $::ApolTop::qpolicy]]
    set behav_b [apol_fs_use_behavior_to_str [$b get_behavior $::ApolTop::qpolicy]]
    if {[set z [string compare $behav_a $behav_b]] != 0} {
        return $z
    }
    set name_a [$a get_name $::ApolTop::qpolicy]
    set name_b [$b get_name $::ApolTop::qpolicy]
    if {[set z [string compare $name_a $name_b]] != 0} {
        return $z
    }
    return 0
}
namespace eval Apol_Goto {
    variable dialog .apol_goto_dialog
    variable line_num
}
proc Apol_Goto::goto {} {
    variable dialog
    if {![winfo exists $dialog]} {
        _create_dialog
    } else {
        raise $dialog
        variable entry
        focus $entry
        $entry selection range 0 end
    }
}
proc Apol_Goto::_create_dialog {} {
    variable dialog
    Dialog $dialog -title "Goto Line" -separator 0 -parent . \
        -default 0 -cancel 1 -modal none -homogeneous 1
    set top_frame [$dialog getframe]
    set entry_label [label $top_frame.l -text "Goto Line:" -anchor e]
    variable entry [entry $top_frame.e -bg white \
                        -textvariable Apol_Goto::line_num -width 10]
    pack $entry_label -side left -padx 5 -pady 5
    pack $entry -side left -padx 5 -pady 5 -expand 1 -fill x
    $dialog add -text "OK" -command [list Apol_Goto::_do_goto]
    $dialog add -text "Cancel" -command [list destroy $dialog]
    $entry selection range 0 end
    focus $entry
    $dialog draw
    wm resizable $dialog 0 0
}
proc Apol_Goto::_do_goto {} {
    set w [ApolTop::getCurrentTextWidget]
    if {$w == {}} {
        return
    }
    variable line_num
    if {[string is integer -strict $line_num] != 1} {
        tk_messageBox -icon error \
            -type ok  \
            -title "Goto Line" \
            -message "$line_num is not a valid line number."
    } else {
	$w tag remove sel 0.0 end
	$w mark set insert ${line_num}.0
	$w see ${line_num}.0
	$w tag add sel $line_num.0 $line_num.end
	focus $w
    }
    variable dialog
    destroy $dialog
}
namespace eval Apol_Initial_SIDS {
    variable widgets
    variable vals
}
proc Apol_Initial_SIDS::create {tab_name nb} {
    variable widgets
    variable vals
    array set vals {
        items {}
    }
    set frame [$nb insert end $tab_name -text "Initial SIDs"]
    set pw [PanedWindow $frame.pw -side top -weights extra]
    set leftf [$pw add -weight 0]
    set rightf [$pw add -weight 1]
    pack $pw -fill both -expand yes
    set sids_box [TitleFrame $leftf.sids_box -text "Initial SIDs"]
    set s_optionsbox [TitleFrame $rightf.obox -text "Search Options"]
    set rslts_frame [TitleFrame $rightf.rbox -text "Search Results"]
    pack $sids_box -expand 1 -fill both
    pack $s_optionsbox -side top -expand 0 -fill both -padx 2
    pack $rslts_frame -side top -expand yes -fill both -padx 2
    set widgets(items) [Apol_Widget::makeScrolledListbox [$sids_box getframe].lb -width 20 -listvar Apol_Initial_SIDS::vals(items)]
    Apol_Widget::setListboxCallbacks $widgets(items) \
        {{"Display Initial SID Context" {Apol_Initial_SIDS::_popupSIDInfo}}}
    pack $widgets(items) -expand 1 -fill both
    set f [frame [$s_optionsbox getframe].c]
    set widgets(context) [Apol_Widget::makeContextSelector $f.context "Context"]
    pack $widgets(context)
    pack $f -side left -anchor n -padx 4 -pady 2
    set ok [button [$s_optionsbox getframe].ok -text "OK" -width 6 \
                -command Apol_Initial_SIDS::_search]
    pack $ok -side right -pady 5 -padx 5 -anchor ne
    set widgets(results) [Apol_Widget::makeSearchResults [$rslts_frame getframe].results]
    pack $widgets(results) -side top -expand yes -fill both
    return $frame
}
proc Apol_Initial_SIDS::open {ppath} {
    variable vals
    set q [new_apol_isid_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set vals(items) [lsort [isid_vector_to_list $v]]
    $v -acquire
    $v -delete
}
proc Apol_Initial_SIDS::close {} {
    variable vals
    variable widgets
    set vals(items) {}
    Apol_Widget::clearSearchResults $widgets(results)
    Apol_Widget::clearContextSelector $widgets(context)
}
proc Apol_Initial_SIDS::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_Initial_SIDS::_popupSIDInfo {sid} {
    set text "$sid:\n    [_render_isid $sid 1]"
    Apol_Widget::showPopupText "$sid Context" $text
}
proc Apol_Initial_SIDS::_search {} {
    variable vals
    variable widgets
    set name {}
    set context {}
    set range_match 0
    Apol_Widget::clearSearchResults $widgets(results)
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
        return
    }
    set q [new_apol_isid_query_t]
    if {[Apol_Widget::getContextSelectorState $widgets(context)]} {
        foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(context)] {break}
        $q set_context $::ApolTop::policy $context $range_match
    }
    set v [$q run $::ApolTop::policy] #line causing segfaulting
    $q -acquire
    $q -delete
    set isids [isid_vector_to_list $v]
    $v -acquire
    $v -delete
    set results "INITIAL SIDS:"
    if {[llength $isids] == 0} {
        append results "\nSearch returned no results."
    } else {
        foreach i [lsort -dictionary $isids] {
            append results "\n[_render_isid $i]"
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_Initial_SIDS::_render_isid {isid_name {compact 0}} {
    set qpol_isid_datum [new_qpol_isid_t $::ApolTop::qpolicy $isid_name]
    set qpol_context [$qpol_isid_datum get_context $::ApolTop::qpolicy]
    set context_str [apol_qpol_context_render $::ApolTop::policy $qpol_context]
    if {$compact} {
        format "sid %s %s" $isid_name $context_str
    } else {
        format "sid  %-16s %s" $isid_name $context_str
    }
}
namespace eval Apol_Level_Dialog {
    variable dialog ""
    variable vars
}
proc Apol_Level_Dialog::getLevel {{defaultLevel {}} {parent .}} {
    variable dialog
    if {![winfo exists $dialog]} {
        _create_dialog $parent
    }
    set f [$dialog getframe]
    Apol_Widget::resetLevelSelectorToPolicy $f.level
    if {$defaultLevel != {}} {
        Apol_Widget::setLevelSelectorLevel $f.level $defaultLevel
    }
    $dialog.bbox _redraw
    set retval [$dialog draw]
    if {$retval == -1 || $retval == 1} {
        return {}
    }
    _get_level $dialog
}
proc Apol_Level_Dialog::_create_dialog {parent} {
    variable dialog
    variable vars
    set dialog [Dialog .level_dialog -modal local -parent $parent \
                    -separator 1 -homogeneous 1 -title "Select Level"]
    array unset vars $dialog:*
    set f [$dialog getframe]
    set label [label $f.ll -text "Level:"]
    set level [Apol_Widget::makeLevelSelector $f.level 12]
    pack $label -anchor w
    pack $level -expand 1 -fill both
    $dialog add -text "OK" -command [list Apol_Level_Dialog::_okay $dialog]
    $dialog add -text "Cancel"
}
proc Apol_Level_Dialog::_get_level {dialog} {
    return [Apol_Widget::getLevelSelectorLevel [$dialog getframe].level]
}
proc Apol_Level_Dialog::_okay {dialog} {
    set level [_get_level $dialog]
    if {![ApolTop::is_policy_open] || [$level validate $::ApolTop::policy] != 1} {
        tk_messageBox -icon error -type ok -title "Invalid Level" \
            -message "The selected level is not valid for the current policy."
    } else {
        $dialog enddialog 0
    }
    $level -acquire
    $level -delete
}
namespace eval Apol_MLS {
    variable widgets
    variable vals
}
proc Apol_MLS::create {tab_name nb} {
    variable widgets
    variable vals
    _initializeVars
    set frame [$nb insert end $tab_name -text "MLS"]
    set pw [PanedWindow $frame.pw -side top -weights extra]
    set leftf [$pw add -weight 0]
    set rightf [$pw add -weight 1]
    pack $pw -fill both -expand yes
    set sensbox [TitleFrame $leftf.sensbox -text "Sensitivities"]
    set catsbox [TitleFrame $leftf.catsbox -text "Categories"]
    pack $sensbox -fill both -expand 0
    pack $catsbox -fill both -expand yes
    set sensbox [Apol_Widget::makeScrolledListbox [$sensbox getframe].sens \
                     -height 10 -width 20 -listvar Apol_MLS::vals(senslist)]
    Apol_Widget::setListboxCallbacks $sensbox \
        {{"Show Sensitivity Info" {Apol_MLS::_popupSensInfo}}}
    pack $sensbox -expand 1 -fill both
    set catsbox [Apol_Widget::makeScrolledListbox [$catsbox getframe].cats \
                     -height 16 -width 20 -listvar Apol_MLS::vals(catslist)]
    Apol_Widget::setListboxCallbacks $catsbox \
        {{"Show Category Info" {Apol_MLS::_popupCatsInfo}}}
    pack $catsbox -expand 1 -fill both
    set optsbox [TitleFrame $rightf.optsbox -text "Search Options"]
    pack $optsbox -side top -expand 0 -fill both -padx 2
    set sensf [frame [$optsbox getframe].sensf]
    set catsf [frame [$optsbox getframe].catsf]
    pack $sensf $catsf -side left -padx 4 -pady 2 -anchor nw
    set enable_sens [checkbutton $sensf.enable -text "Sensitivities" \
                         -variable Apol_MLS::vals(enable_sens)]
    set show_cats [checkbutton $sensf.cats -text "Show levels (categories)" \
                       -variable Apol_MLS::vals(show_cats_too)]
    trace add variable Apol_MLS::vals(enable_sens) write \
        [list Apol_MLS::_toggleCheckbutton $show_cats]
    pack $enable_sens -side top -anchor nw
    pack $show_cats -side top -anchor nw -padx 8
    set enable_cats [checkbutton $catsf.enable -text "Categories" \
                         -variable Apol_MLS::vals(enable_cats)]
    set show_sens [checkbutton $catsf.cats -text "Show sensitivities" \
                       -variable Apol_MLS::vals(show_sens_too) -state disabled]
    trace add variable Apol_MLS::vals(enable_cats) write \
        [list Apol_MLS::_toggleCheckbutton $show_sens]
    pack $enable_cats -side top -anchor nw
    pack $show_sens -side top -anchor nw -padx 8
    set widgets(regexp) [Apol_Widget::makeRegexpEntry [$optsbox getframe].regexpf]
    pack $widgets(regexp) -side left -padx 4 -pady 2 -anchor nw
    set ok [button [$optsbox getframe].ok -text "OK" -width 6 \
                -command Apol_MLS::_search]
    pack $ok -side right -pady 5 -padx 5 -anchor ne
    set resultsbox [TitleFrame $rightf.resultsbox -text "Search Results"]
    pack $resultsbox -expand yes -fill both -padx 2
    set widgets(results) [Apol_Widget::makeSearchResults [$resultsbox getframe].results]
    pack $widgets(results) -side top -expand yes -fill both
    return $frame
}
proc Apol_MLS::open {ppath} {
    variable vals
    set q [new_apol_level_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set vals(senslist) [lsort [level_vector_to_list $v]]
    $v -acquire
    $v -delete
    set q [new_apol_cat_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set vals(catslist) [lsort [cat_vector_to_list $v]]
    $v -acquire
    $v -delete
}
proc Apol_MLS::close {} {
    variable widgets
    _initializeVars
    Apol_Widget::clearSearchResults $widgets(results)
}
proc Apol_MLS::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_MLS::isSensInPolicy {sens} {
    variable vals
    if {![ApolTop::is_policy_open]} {
        return {}
    }
    if {[lsearch $vals(senslist) $sens] >= 0} {
        return $sens
    }
    foreach s $vals(senslist) {
        set qpol_level_t [new_qpol_level_t $::ApolTop::qpolicy $s]
        set i [$qpol_level_t get_alias_iter $::ApolTop::qpolicy]
        set l [iter_to_str_list $i]
        $i -acquire
        $i -delete
        if {[lsearch $l $sens] >= 0} {
            return $s
        }
    }
    return {}
}
proc Apol_MLS::_initializeVars {} {
    variable vals
    array set vals {
        senslist {}      catslist {}
        enable_sens 1    show_cats_too 1
        enable_cats 0    show_sens_too 1
    }
}
proc Apol_MLS::_toggleCheckbutton {path name1 name2 op} {
    variable vals
    variable widgets
    if {$vals($name2)} {
        $path configure -state normal
    } else {
        $path configure -state disabled
    }
    if {$vals(enable_sens) == 0 && $vals(enable_cats) == 0} {
        Apol_Widget::setRegexpEntryState $widgets(regexp) 0
    } else {
        Apol_Widget::setRegexpEntryState $widgets(regexp) 1
    }
}
proc Apol_MLS::_popupSensInfo {sens} {
    Apol_Widget::showPopupText $sens [_renderLevel $sens 1]
}
proc Apol_MLS::_popupCatsInfo {cats} {
    Apol_Widget::showPopupText $cats [_renderCats $cats 1]
}
proc Apol_MLS::_renderLevel {level_name show_level} {
    set qpol_level_datum [new_qpol_level_t $::ApolTop::qpolicy $level_name]
    set i [$qpol_level_datum get_alias_iter $::ApolTop::qpolicy]
    set aliases [iter_to_str_list $i]
    $i -acquire
    $i -delete
    set text $level_name
    if {[llength $aliases] > 0} {
        append text " alias \{$aliases\}"
    }
    if {$show_level} {
        set i [$qpol_level_datum get_cat_iter $::ApolTop::qpolicy]
        set num_cats [$i get_size]
        $i -acquire
        $i -delete
        append text " ($num_cats categor"
        if {$num_cats == 1} {
            append text "y)"
        } else {
            append text "ies)"
        }
        set level [new_apol_mls_level_t $::ApolTop::policy $qpol_level_datum]
        append text "\n    level [$level render $::ApolTop::policy]\n"
        $level -acquire
        $level -delete
    }
    return $text
}
proc Apol_MLS::_renderCats {cat_name show_sens} {
    set qpol_cat_datum [new_qpol_cat_t $::ApolTop::qpolicy $cat_name]
    set i [$qpol_cat_datum get_alias_iter $::ApolTop::qpolicy]
    set aliases [iter_to_str_list $i]
    $i -acquire
    $i -delete
    set text $cat_name
    if {[llength $aliases] > 0} {
        append text " alias \{$aliases\}"
    }
    if {$show_sens} {
        append text "\n"
        set q [new_apol_level_query_t]
        $q set_cat $::ApolTop::policy $cat_name
        set v [$q run $::ApolTop::policy]
        $q -acquire
        $q -delete
        set sens_list {}
        for {set i 0} {$i < [$v get_size]} {incr i} {
            set qpol_level_datum [qpol_level_from_void [$v get_element $i]]
            set level_name [$qpol_level_datum get_name $::ApolTop::qpolicy]
            set level_value [$qpol_level_datum get_value $::ApolTop::qpolicy]
            lappend sens_list [list $level_name $level_value]
        }
        $v -acquire
        $v -delete
        foreach s [lsort -integer -index 1 $sens_list] {
            append text "    [lindex $s 0]\n"
        }
    }
    return $text
}
proc Apol_MLS::_search {} {
    variable vals
    variable widgets
    Apol_Widget::clearSearchResults $widgets(results)
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
        return
    }
    if {$vals(enable_sens) == 0 && $vals(enable_cats) == 0} {
        tk_messageBox -icon error -type ok -title "Error" -message "No search options provided."
        return
    }
    set results ""
    set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
    if {$use_regexp} {
        set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
        if {$regexp == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No regular expression provided."
            return
        }
    } else {
        set regexp {}
    }
    if {$vals(enable_sens)} {
        set q [new_apol_level_query_t]
        $q set_sens $::ApolTop::policy $regexp
        $q set_regex $::ApolTop::policy $use_regexp
        set v [$q run $::ApolTop::policy]
        $q -acquire
        $q -delete
        set level_data {}
        for {set i 0} {$i < [$v get_size]} {incr i} {
            set qpol_level_datum [qpol_level_from_void [$v get_element $i]]
            set level_name [$qpol_level_datum get_name $::ApolTop::qpolicy]
            set level_value [$qpol_level_datum get_value $::ApolTop::qpolicy]
            lappend level_data [list $level_name $level_value]
        }
        $v -acquire
        $v -delete
        append results "SENSITIVITIES (ordered by dominance from low to high):"
        if {[llength $level_data] == 0} {
            append results "\nSearch returned no results."
        } else {
            foreach l [lsort -integer -index 1 $level_data] {
                append results "\n[_renderLevel [lindex $l 0] $vals(show_cats_too)]"
            }
        }
    }
    if {$vals(enable_cats)} {
        if {$vals(enable_sens)} {
            append results "\n\n"
        }
        set q [new_apol_cat_query_t]
        $q set_cat $::ApolTop::policy $regexp
        $q set_regex $::ApolTop::policy $use_regexp
        set v [$q run $::ApolTop::policy]
        $q -acquire
        $q -delete
        set cats_data {}
        for {set i 0} {$i < [$v get_size]} {incr i} {
            set qpol_cat_datum [qpol_cat_from_void [$v get_element $i]]
            set cat_name [$qpol_cat_datum get_name $::ApolTop::qpolicy]
            set cat_value [$qpol_cat_datum get_value $::ApolTop::qpolicy]
            lappend cats_data [list $cat_name $cat_value]
        }
        $v -acquire
        $v -delete
        append results "CATEGORIES (ordered by appearance within policy):"
        if {[llength $cats_data] == 0} {
            append results "\nSearch returned no results."
        } else {
            foreach c [lsort -integer -index 1 $cats_data] {
                append results "\n[_renderCats [lindex $c 0] $vals(show_sens_too)]"
            }
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) $results
}
namespace eval Apol_NetContexts {
    variable widgets
    variable vals
}
proc Apol_NetContexts::create {tab_name nb} {
    variable widgets
    variable vals
    _initializeVars
    set frame [$nb insert end $tab_name -text "Net Contexts"]
    set pw [PanedWindow $frame.pw -side top -weights extra]
    set leftf [$pw add -weight 0]
    set rightf [$pw add -weight 1]
    pack $pw -fill both -expand yes
    set context_box [TitleFrame $leftf.context_f -text "Context Type"]
    set context_f [$context_box getframe]
    radiobutton $context_f.portcon -text "portcon" -value portcon \
        -variable Apol_NetContexts::vals(context_type)
    radiobutton $context_f.netifcon -text "netifcon" -value netifcon \
        -variable Apol_NetContexts::vals(context_type)
    radiobutton $context_f.nodecon -text "nodecon" -value nodecon \
        -variable Apol_NetContexts::vals(context_type)
    trace add variable Apol_NetContexts::vals(context_type) write \
        {Apol_NetContexts::_contextTypeChanged}
    pack $context_f.portcon $context_f.netifcon $context_f.nodecon \
        -anchor w -expand 0 -padx 4 -pady 5
    pack $context_box -anchor nw -expand 0 -fill x
    set widgets(items_tf) [TitleFrame $leftf.items_f -text "Port Contexts"]
    set widgets(items) [Apol_Widget::makeScrolledListbox [$widgets(items_tf) getframe].items \
                            -height 20 -width 20 -listvar Apol_NetContexts::vals(items)]
    Apol_Widget::setListboxCallbacks $widgets(items) \
        {{"Show Context Info" {Apol_NetContexts::_popupContextInfo}}}
    pack $widgets(items) -expand 1 -fill both
    pack $widgets(items_tf) -expand 1 -fill both
    set optsbox [TitleFrame $rightf.optsbox -text "Search Options"]
    pack $optsbox -side top -expand 0 -fill both -padx 2
    set widgets(options_pm) [PagesManager [$optsbox getframe].pm]
    _portcon_create [$widgets(options_pm) add portcon]
    _netifcon_create [$widgets(options_pm) add netifcon]
    _nodecon_create [$widgets(options_pm) add nodecon]
    $widgets(options_pm) compute_size
    pack $widgets(options_pm) -expand 1 -fill both -side left
    $widgets(options_pm) raise portcon
    set ok [button [$optsbox getframe].ok -text "OK" -width 6 \
                -command Apol_NetContexts::_runSearch]
    pack $ok -side right -pady 5 -padx 5 -anchor ne
    set resultsbox [TitleFrame $rightf.resultsbox -text "Search Results"]
    pack $resultsbox -expand yes -fill both -padx 2
    set widgets(results) [Apol_Widget::makeSearchResults [$resultsbox getframe].results]
    pack $widgets(results) -side top -expand yes -fill both
    return $frame
}
proc Apol_NetContexts::open {ppath} {
    variable vals
    _portcon_open
    _netifcon_open
    _nodecon_open
    set vals(context_type) portcon
}
proc Apol_NetContexts::close {} {
    variable widgets
    _initializeVars
    Apol_Widget::clearSearchResults $widgets(results)
    Apol_Widget::clearContextSelector $widgets(portcon:context)
    Apol_Widget::clearContextSelector $widgets(netifcon:ifcon)
    Apol_Widget::clearContextSelector $widgets(netifcon:msgcon)
    Apol_Widget::clearContextSelector $widgets(nodecon:context)
    $widgets(portcon:proto) configure -values {}
    $widgets(netifcon:dev) configure -values {}
}
proc Apol_NetContexts::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_NetContexts::_initializeVars {} {
    variable vals
    array set vals {
        portcon:items {}
        portcon:proto_enable 0    portcon:proto {}
        portcon:port_enable 0     portcon:port 0
        portcon:hiport_enable 0   portcon:hiport 0
        netifcon:items {}
        netifcon:dev_enable 0     netifcon:dev {}
        nodecon:items {}
        nodecon:ip_type ipv4
        nodecon:ipv4_addr_enable 0
        nodecon:ipv4_addr0 0        nodecon:ipv4_addr1 0
        nodecon:ipv4_addr2 0        nodecon:ipv4_addr3 0
        nodecon:ipv4_mask_enable 0
        nodecon:ipv4_mask0 255      nodecon:ipv4_mask1 255
        nodecon:ipv4_mask2 255      nodecon:ipv4_mask3 255
        nodecon:ipv6_addr_enable 0  nodecon:ipv6_addr ::
        nodecon:ipv6_mask_enable 0  nodecon:ipv6_mask ::
        items {}
        context_type portcon
    }
}
proc Apol_NetContexts::_contextTypeChanged {name1 name2 op} {
    variable vals
    variable widgets
    Apol_Widget::clearSearchResults $widgets(results)
    if {$vals(context_type) == "portcon"} {
        _portcon_show
    } elseif {$vals(context_type) == "netifcon"} {
        _netifcon_show
    } else {
        _nodecon_show
    }
}
proc Apol_NetContexts::_popupContextInfo {value} {
    variable vals
    if {$vals(context_type) == "portcon"} {
        _portcon_popup $value
    } elseif {$vals(context_type) == "netifcon"} {
        _netifcon_popup $value
    } else {
        _nodecon_popup $value
    }
}
proc Apol_NetContexts::_toggleCheckbutton {path name1 name2 op} {
    variable vals
    variable widgets
    if {$vals($name2)} {
        $path configure -state normal
    } else {
        $path configure -state disabled
    }
}
proc Apol_NetContexts::_runSearch {} {
    variable vals
    variable widgets
    Apol_Widget::clearSearchResults $widgets(results)
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
        return
    }
    if {$vals(context_type) == "portcon"} {
        _portcon_runSearch
    } elseif {$vals(context_type) == "netifcon"} {
        _netifcon_runSearch
    } else {
        _nodecon_runSearch
    }
}
proc Apol_NetContexts::_portcon_create {p_f} {
    variable widgets
    variable vals
    frame $p_f.proto
    set proto_cb [checkbutton $p_f.proto.proto_enable -text "Protocol" \
                      -variable Apol_NetContexts::vals(portcon:proto_enable)]
    set widgets(portcon:proto) [ComboBox $p_f.proto.proto -entrybg white -width 8 -state disabled \
                                    -textvariable Apol_NetContexts::vals(portcon:proto) -autopost 1]
    trace add variable Apol_NetContexts::vals(portcon:proto_enable) write \
        [list Apol_NetContexts::_toggleCheckbutton $widgets(portcon:proto)]
    pack $proto_cb -side top -anchor w
    pack $widgets(portcon:proto) -side top -expand 0 -fill x -padx 4
    frame $p_f.port
    set low [frame $p_f.port.l]
    set port_cb [checkbutton $low.port_enable -text "Single Port" \
                     -variable Apol_NetContexts::vals(portcon:port_enable)]
    set widgets(portcon:port) [spinbox $low.port -bg white -width 8 \
                                   -justify right -state disabled \
                                   -from 0 -to 65535 \
                                   -validate all -vcmd [list Apol_NetContexts::_portcon_limitPort %W %V %P port] \
                                   -textvariable Apol_NetContexts::vals(portcon:port)]
    set high [frame $p_f.port.h]
    set hiport_cb [checkbutton $high.hiport_enable -text "High Port" \
                       -state disabled \
                       -variable Apol_NetContexts::vals(portcon:hiport_enable)]
    set widgets(portcon:hiport) [spinbox $high.hiport -bg white -width 8 \
                                     -justify right -state disabled \
                                     -from 0 -to 65535 \
                                     -validate all -vcmd [list Apol_NetContexts::_portcon_limitPort %W %V %P hiport] \
                                     -textvariable Apol_NetContexts::vals(portcon:hiport)]
    trace add variable Apol_NetContexts::vals(portcon:port_enable) write \
        [list Apol_NetContexts::_portcon_toggleCheckbutton_lowport \
             $widgets(portcon:port) $hiport_cb $widgets(portcon:hiport)]
    trace add variable Apol_NetContexts::vals(portcon:hiport_enable) write \
        [list Apol_NetContexts::_portcon_toggleCheckbutton_hiport $port_cb $widgets(portcon:hiport)]
    pack $port_cb -side top -anchor w -expand 0
    pack $widgets(portcon:port) -side top -expand 0 -fill x -padx 4
    pack $hiport_cb -side top -anchor w -expand 0
    pack $widgets(portcon:hiport) -side top -expand 0 -fill x -padx 4
    pack $low $high -side left -expand 0 -fill both
    frame $p_f.c
    set widgets(portcon:context) [Apol_Widget::makeContextSelector $p_f.c.context "Contexts"]
    pack $widgets(portcon:context)
    pack $p_f.proto $p_f.port $p_f.c -side left -padx 4 -pady 2 -anchor nw
}
proc Apol_NetContexts::_portcon_open {} {
    variable vals
    set q [new_apol_portcon_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set portcons [portcon_vector_to_list $v]
    $v -acquire
    $v -delete
    set vals(portcon:items) {}
    set protos {}
    foreach p $portcons {
        set low [$p get_low_port $::ApolTop::qpolicy]
        set high [$p get_high_port $::ApolTop::qpolicy]
        set proto [$p get_protocol $::ApolTop::qpolicy]
        if {$low == $high} {
            lappend vals(portcon:items) $low
        } else {
            lappend vals(portcon:items) "$low-$high"
        }
        lappend protos [apol_protocol_to_str $proto]
    }
    variable widgets
    set vals(portcon:items) [lsort -unique -dictionary $vals(portcon:items)]
    $widgets(portcon:proto) configure -values [lsort -unique -dictionary $protos]
}
proc Apol_NetContexts::_portcon_show {} {
    variable vals
    variable widgets
    $widgets(items_tf) configure -text "Port Contexts"
    $widgets(options_pm) raise portcon
    set vals(items) $vals(portcon:items)
}
proc Apol_NetContexts::_portcon_popup {port} {
    foreach {low high} [split $port "-"] {break}
    if {$high == {}} {
        set high $low
    }
    set q [new_apol_portcon_query_t]
    $q set_low $::ApolTop::policy $low
    $q set_high $::ApolTop::policy $high
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set portcons [portcon_vector_to_list $v]
    $v -acquire
    $v -delete
    set text "port $port ([llength $portcons] context"
    if {[llength $portcons] != 1} {
        append text s
    }
    append text ")"
    foreach p [lsort -command _portcon_sort $portcons] {
        append text "\n    [_portcon_render $p]"
    }
    Apol_Widget::showPopupText "port $port" $text
}
proc Apol_NetContexts::_portcon_limitPort {widget command new_port varname} {
    variable vals
    if {$command == "key"} {
        if {$new_port != "" &&
            (![string is integer $new_port] || $new_port < 0 || $new_port > 65535)} {
            return 0
        }
    } elseif {$command == "focusout"} {
        if {$new_port == ""} {
            set vals(portcon:$varname) 0
        } elseif {[string length $new_port] > 1} {
            set vals(portcon:$varname) [string trimleft $new_port " 0"]
        }
        $widget config -validate all
    }
    return 1
}
proc Apol_NetContexts::_portcon_toggleCheckbutton_lowport {low high_cb high name1 name2 op} {
    variable vals
    variable widgets
    if {$vals($name2)} {
        $low configure -state normal
        $high_cb configure -state normal
        if {$vals(portcon:hiport_enable)} {
            $high configure -state normal
        }
    } else {
        $low configure -state disabled
        $high_cb configure -state disabled
        $high configure -state disabled
    }
}
proc Apol_NetContexts::_portcon_toggleCheckbutton_hiport {low high name1 name2 op} {
    variable vals
    variable widgets
    if {$vals($name2)} {
        $low configure -text "Low Port"
        $high configure -state normal
    } else {
        $low configure -text "Single Port"
        $high configure -state disabled
    }
}
proc Apol_NetContexts::_portcon_runSearch {} {
    variable vals
    variable widgets
    _portcon_limitPort $widgets(portcon:port) focusout $vals(portcon:port) port
    _portcon_limitPort $widgets(portcon:hiport) focusout $vals(portcon:hiport) hiport
    if {$vals(portcon:port_enable)} {
        set low $vals(portcon:port)
        set high $low
        if {$vals(portcon:hiport_enable)} {
            set high $vals(portcon:hiport)
            if {$vals(portcon:port_enable) && $high < $low} {
                tk_messageBox -icon error -type ok -title "Error" -message "The second port is not greater than the first."
                return
            }
        }
    } else {
        set low -1
        set high -1
    }
    set q [new_apol_portcon_query_t]
    $q set_low $::ApolTop::policy $low
    $q set_high $::ApolTop::policy $high
    if {$vals(portcon:proto_enable)} {
        if {[set proto $vals(portcon:proto)] == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No protocol selected."
            return
        }
        $q set_protocol $::ApolTop::policy [apol_str_to_protocol $proto]
    }
    if {[Apol_Widget::getContextSelectorState $widgets(portcon:context)]} {
        foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(portcon:context)] {break}
        $q set_context $::ApolTop::policy $context $range_match
    }
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set portcons [portcon_vector_to_list $v]
    $v -acquire
    $v -delete
    set results "PORTCONS:"
    if {[llength $portcons] == 0} {
        append results "\nSearch returned no results."
    } else {
        foreach p [lsort -command _portcon_sort $portcons] {
            append results "\n[_portcon_render $p]"
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_NetContexts::_portcon_render {qpol_portcon_datum} {
    set loport [$qpol_portcon_datum get_low_port $::ApolTop::qpolicy]
    set hiport [$qpol_portcon_datum get_high_port $::ApolTop::qpolicy]
    set proto [apol_protocol_to_str [$qpol_portcon_datum get_protocol $::ApolTop::qpolicy]]
    set qpol_context [$qpol_portcon_datum get_context $::ApolTop::qpolicy]
    if {$loport == $hiport} {
        set line "portcon $proto $loport "
    } else {
        set line "portcon $proto ${loport}-${hiport} "
    }
    concat $line [apol_qpol_context_render $::ApolTop::policy $qpol_context]
}
proc Apol_NetContexts::_portcon_sort {a b} {
    set loport1 [$a get_low_port $::ApolTop::qpolicy]
    set hiport1 [$a get_high_port $::ApolTop::qpolicy]
    set loport2 [$b get_low_port $::ApolTop::qpolicy]
    set hiport2 [$b get_high_port $::ApolTop::qpolicy]
    if {$loport1 == $hiport1} {
        set singleport1 1
    } else {
        set singleport1 0
    }
    if {$loport2 == $hiport2} {
        set singleport2 1
    } else {
        set singleport2 0
    }
    if {$singleport1 && !$singleport2} {
        return -1
    } elseif {!$singleport1 && $singleport2} {
        return 1
    }
    if {$loport1 < $loport2} {
        return -1
    } elseif {$loport1 > $loport2} {
        return 1
    }
    if {$hiport1 < $hiport2} {
        return -1
    } elseif {$hiport1 > $hiport2} {
        return 1
    }
    set proto1 [apol_protocol_to_str [$a get_protocol $::ApolTop::qpolicy]]
    set proto2 [apol_protocol_to_str [$b get_protocol $::ApolTop::qpolicy]]
    string compare $proto1 $proto2
}
proc Apol_NetContexts::_netifcon_create {p_f} {
    variable vals
    variable widgets
    frame $p_f.dev
    set dev_cb [checkbutton $p_f.dev.dev_enable -text "Device" \
                    -variable Apol_NetContexts::vals(netifcon:dev_enable)]
    set widgets(netifcon:dev) [ComboBox $p_f.dev.dev -entrybg white -width 8 -state disabled \
                                   -textvariable Apol_NetContexts::vals(netifcon:dev) -autopost 1]
    trace add variable Apol_NetContexts::vals(netifcon:dev_enable) write \
        [list Apol_NetContexts::_toggleCheckbutton $widgets(netifcon:dev)]
    pack $dev_cb -side top -anchor w
    pack $widgets(netifcon:dev) -side top -expand 0 -fill x -padx 4
    frame $p_f.ifcon
    set widgets(netifcon:ifcon) [Apol_Widget::makeContextSelector $p_f.ifcon.context "Contexts" "Interface context" -width 18]
    pack $widgets(netifcon:ifcon)
    frame $p_f.msgcon
    set widgets(netifcon:msgcon) [Apol_Widget::makeContextSelector $p_f.msgcon.context "Contexts" "Message context" -width 18]
    pack $widgets(netifcon:msgcon)
    pack $p_f.dev $p_f.ifcon $p_f.msgcon -side left -padx 4 -pady 2 -anchor nw
}
proc Apol_NetContexts::_netifcon_open {} {
    variable vals
    set q [new_apol_netifcon_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set vals(netifcon:items) [lsort [netifcon_vector_to_list $v]]
    $v -acquire
    $v -delete
    variable widgets
    $widgets(netifcon:dev) configure -values $vals(netifcon:items)
}
proc Apol_NetContexts::_netifcon_show {} {
    variable vals
    variable widgets
    $widgets(items_tf) configure -text "NetIF Contexts"
    $widgets(options_pm) raise netifcon
    set vals(items) $vals(netifcon:items)
}
proc Apol_NetContexts::_netifcon_popup {netif} {
    set text "network interface $netif"
    append text "\n    [_netifcon_render $netif]"
    Apol_Widget::showPopupText "interface $netif" $text
}
proc Apol_NetContexts::_netifcon_runSearch {} {
    variable vals
    variable widgets
    if {$vals(netifcon:dev_enable)} {
        if {$vals(netifcon:dev) == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No device selected."
            return
        }
        set dev $vals(netifcon:dev)
    } else {
        set dev {}
    }
    set q [new_apol_netifcon_query_t]
    $q set_device $::ApolTop::policy $dev
    if {[Apol_Widget::getContextSelectorState $widgets(netifcon:ifcon)]} {
        foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(netifcon:ifcon)] {break}
        $q set_if_context $::ApolTop::policy $context $range_match
    }
    if {[Apol_Widget::getContextSelectorState $widgets(netifcon:msgcon)]} {
        foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(netifcon:msgcon)] {break}
        $q set_msg_context $::ApolTop::policy $context $range_match
    }
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set netifcons [netifcon_vector_to_list $v]
    $v -acquire
    $v -delete
    set results "NETIFCONS:"
    if {[llength $netifcons] == 0} {
        append results "\nSearch returned no results."
    } else {
        foreach n [lsort $netifcons] {
            append results "\n[_netifcon_render $n]"
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_NetContexts::_netifcon_render {netifcon} {
    set qpol_netifcon_datum [new_qpol_netifcon_t $::ApolTop::qpolicy $netifcon]
    apol_netifcon_render $::ApolTop::policy $qpol_netifcon_datum
}
proc Apol_NetContexts::_nodecon_create {p_f} {
    variable vals
    variable widgets
    frame $p_f.ip_type
    set ipv4_rb [radiobutton $p_f.ip_type.v4 -text "IPv4" -value ipv4 \
                     -variable Apol_NetContexts::vals(nodecon:ip_type)]
    set ipv6_rb [radiobutton $p_f.ip_type.v6 -text "IPv6" -value ipv6 \
                     -variable Apol_NetContexts::vals(nodecon:ip_type)]
    trace add variable Apol_NetContexts::vals(nodecon:ip_type) write \
        [list Apol_NetContexts::_nodecon_pageChanged]
    pack $ipv4_rb $ipv6_rb -side top -anchor nw -pady 5
    frame $p_f.opts
    set widgets(nodecon:ip_pm) [PagesManager $p_f.opts.pm]
    _nodecon_ipv4Create [$widgets(nodecon:ip_pm) add ipv4]
    _nodecon_ipv6Create [$widgets(nodecon:ip_pm) add ipv6]
    $widgets(nodecon:ip_pm) compute_size
    pack $widgets(nodecon:ip_pm)
    $widgets(nodecon:ip_pm) raise ipv4
    frame $p_f.con
    set widgets(nodecon:context) [Apol_Widget::makeContextSelector $p_f.con.context "Contexts"]
    pack $widgets(nodecon:context)
    pack $p_f.ip_type $p_f.opts $p_f.con -side left -padx 4 -pady 2 -anchor nw
}
proc Apol_NetContexts::_nodecon_open {} {
    set q [new_apol_nodecon_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set nodecons [nodecon_vector_to_list $v]
    variable vals
    variable widgets
    set vals(nodecon:items) {}
    foreach n [lsort -command _nodecon_sort $nodecons] {
        set proto [$n get_protocol $::ApolTop::qpolicy]
        set addr [$n get_addr $::ApolTop::qpolicy]
        if {$proto == $::QPOL_IPV4} {
            set addr [apol_ipv4_addr_render $::ApolTop::policy $addr]
        } elseif {$proto == $::QPOL_IPV6} {
            set addr [apol_ipv6_addr_render $::ApolTop::policy $addr]
        } else {
            puts stderr "Unknown protocol $proto"
            exit -1
        }
        lappend vals(nodecon:items) $addr
    }
    set vals(nodecon:items) [lsort -unique -dictionary $vals(nodecon:items)]
    $v -acquire
    $v -delete
}
proc Apol_NetContexts::_nodecon_show {} {
    variable vals
    variable widgets
    $widgets(items_tf) configure -text "Node Contexts"
    $widgets(options_pm) raise nodecon
    set vals(items) $vals(nodecon:items)
}
proc Apol_NetContexts::_nodecon_ipv4Create {fv4} {
    variable widgets
    set v4addrf [frame $fv4.addr]
    set ipv4_addr_cb [checkbutton $v4addrf.enable -text "IP address" \
                          -variable Apol_NetContexts::vals(nodecon:ipv4_addr_enable)]
    set widgets(nodecon:v4addrf2) [frame $v4addrf.a]
    for {set i 0} {$i < 4} {incr i} {
        set e [entry $widgets(nodecon:v4addrf2).e$i -bg white -justify center -width 4 \
                   -state disabled \
                   -validate all -vcmd [list Apol_NetContexts::_nodecon_limitAddr %W %V %P ipv4_addr$i] \
                   -textvariable Apol_NetContexts::vals(nodecon:ipv4_addr$i)]
        pack $e -side left -padx 1 -anchor center
        if {$i < 3} {
            pack [label $widgets(nodecon:v4addrf2).l$i -text "."] -side left -expand 0 -anchor s
        }
    }
    trace add variable Apol_NetContexts::vals(nodecon:ipv4_addr_enable) write \
        [list Apol_NetContexts::_nodecon_toggleV4button $widgets(nodecon:v4addrf2).e]
    pack $ipv4_addr_cb -anchor w
    pack $widgets(nodecon:v4addrf2) -padx 3 -expand 0 -fill x
    set v4maskf [frame $fv4.mask]
    set ipv4_mask_cb [checkbutton $v4maskf.enable -text "Mask" \
                          -variable Apol_NetContexts::vals(nodecon:ipv4_mask_enable)]
    set widgets(nodecon:v4maskf2) [frame $v4maskf.m]
    for {set i 0} {$i < 4} {incr i} {
        set e [entry $widgets(nodecon:v4maskf2).e$i -bg white -justify center -width 4 \
                   -state disabled \
                   -validate all -vcmd [list Apol_NetContexts::_nodecon_limitAddr %W %V %P ipv4_mask$i] \
                   -textvariable Apol_NetContexts::vals(nodecon:ipv4_mask$i)]
        pack $e -side left -padx 1 -anchor center
        if {$i < 3} {
            pack [label $widgets(nodecon:v4maskf2).l$i -text "."] -side left -expand 0 -anchor s
        }
    }
    trace add variable Apol_NetContexts::vals(nodecon:ipv4_mask_enable) write \
        [list Apol_NetContexts::_nodecon_toggleV4button $widgets(nodecon:v4maskf2).e]
    pack $ipv4_mask_cb -anchor w
    pack $widgets(nodecon:v4maskf2) -padx 3 -expand 0 -fill x
    pack $v4addrf $v4maskf -padx 4 -pady 2 -anchor nw
}
proc Apol_NetContexts::_nodecon_ipv6Create {fv6} {
    set v6addrf [frame $fv6.addr]
    set ipv4_addr_cb [checkbutton $v6addrf.enable -text "IP address" \
                          -variable Apol_NetContexts::vals(nodecon:ipv6_addr_enable)]
    set e [entry $v6addrf.addr -bg white -width 28 -state disabled \
               -textvariable Apol_NetContexts::vals(nodecon:ipv6_addr)]
    trace add variable Apol_NetContexts::vals(nodecon:ipv6_addr_enable) write \
        [list Apol_NetContexts::_toggleCheckbutton $e]
    pack $ipv4_addr_cb -anchor w
    pack $e -padx 4 -expand 0 -fill x
    set v6maskf [frame $fv6.mask]
    set ipv6_mask_cb [checkbutton $v6maskf.enable -text "Mask" \
                          -variable Apol_NetContexts::vals(nodecon:ipv6_mask_enable)]
    set e [entry $v6maskf.addr -bg white -width 28 -state disabled \
               -textvariable Apol_NetContexts::vals(nodecon:ipv6_mask)]
    trace add variable Apol_NetContexts::vals(nodecon:ipv6_mask_enable) write \
        [list Apol_NetContexts::_toggleCheckbutton $e]
    pack $ipv6_mask_cb -anchor w
    pack $e -padx 4 -expand 0 -fill x
    pack $v6addrf $v6maskf -padx 4 -pady 2 -anchor w
}
proc Apol_NetContexts::_nodecon_pageChanged {name1 name2 op} {
    variable vals
    variable widgets
    $widgets(nodecon:ip_pm) raise $vals(nodecon:ip_type)
}
proc Apol_NetContexts::_nodecon_limitAddr {widget command new_addr varname} {
    variable vals
    if {$command == "key"} {
        if {$new_addr != "" &&
            (![string is integer $new_addr] || $new_addr < 0 || $new_addr > 255)} {
            return 0
        }
    } elseif {$command == "focusout"} {
        if {$new_addr == ""} {
            set vals(nodecon:$varname) 0
        } elseif {[string length $new_addr] > 1} {
            set vals(nodecon:$varname) [string trimleft $new_addr " 0"]
        }
        after idle [list $widget config -validate all]
    }
    return 1
}
proc Apol_NetContexts::_nodecon_toggleV4button {path name1 name2 op} {
    variable vals
    if {$vals($name2)} {
        for {set i 0} {$i < 4} {incr i} {
            ${path}${i} configure -state normal
        }
    } else {
        for {set i 0} {$i < 4} {incr i} {
            ${path}${i} configure -state disabled
        }
    }
}
proc Apol_NetContexts::_nodecon_popup {nodecon_addr} {
    set q [new_apol_nodecon_query_t]
    set ip [apol_str_to_internal_ip $nodecon_addr]
    $q set_addr $::ApolTop::policy $ip
    $ip -acquire
    $ip -delete
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set nodecons [nodecon_vector_to_list $v]
    set text "nodecon $nodecon_addr ([llength $nodecons] context"
    if {[llength $nodecons] != 1} {
        append text s
    }
    append text ")"
    foreach n [lsort -command _nodecon_sort $nodecons] {
        append text "\n    [_nodecon_render $n]"
    }
    Apol_Widget::showPopupText "address $nodecon_addr" $text
    $v -acquire
    $v -delete
}
proc Apol_NetContexts::_nodecon_runSearch {} {
    variable vals
    variable widgets
    set addr {}
    set mask {}
    if {$vals(nodecon:ip_type) == "ipv4"} {
        foreach i {0 1 2 3} {
            _nodecon_limitAddr $widgets(nodecon:v4addrf2).e$i focusout $vals(nodecon:ipv4_addr$i) ipv4_addr$i
            _nodecon_limitAddr $widgets(nodecon:v4maskf2).e$i focusout $vals(nodecon:ipv4_mask$i) ipv4_mask$i
        }
        if {$vals(nodecon:ipv4_addr_enable)} {
            set addr [format "%d.%d.%d.%d" \
                          $vals(nodecon:ipv4_addr0) $vals(nodecon:ipv4_addr1) \
                          $vals(nodecon:ipv4_addr2) $vals(nodecon:ipv4_addr3)]
        }
        if {$vals(nodecon:ipv4_mask_enable)} {
            set mask [format "%d.%d.%d.%d" \
                          $vals(nodecon:ipv4_mask0) $vals(nodecon:ipv4_mask1) \
                          $vals(nodecon:ipv4_mask2) $vals(nodecon:ipv4_mask3)]
        }
        set proto $::QPOL_IPV4
    } else {
        if {$vals(nodecon:ipv6_addr_enable)} {
            if {[set addr $vals(nodecon:ipv6_addr)] == {}} {
                tk_messageBox -icon error -type ok -title "Error" -message "No IPV6 address provided."
                return
            }
        }
        if {$vals(nodecon:ipv6_mask_enable)} {
            if {[set mask $vals(nodecon:ipv6_mask)] == {}} {
                tk_messageBox -icon error -type ok -title "Error" -message "No IPV6 address provided."
                return
            }
        }
        set proto $::QPOL_IPV6
    }
    set q [new_apol_nodecon_query_t]
    $q set_protocol $::ApolTop::policy $proto
    if {$addr != {}} {
        if {[catch {apol_str_to_internal_ip $addr} u]} {
            tk_messageBox -icon error -type ok -title "Error" -message $u
            return
        }
        $q set_addr $::ApolTop::policy $u
    }
    if {$mask != {}} {
        if {[catch {apol_str_to_internal_ip $mask} u]} {
            tk_messageBox -icon error -type ok -title "Error" -message $u
            return
        }
        $q set_mask $::ApolTop::policy $u
    }
    if {[Apol_Widget::getContextSelectorState $widgets(nodecon:context)]} {
        foreach {context range_match attribute} [Apol_Widget::getContextSelectorValue $widgets(nodecon:context)] {break}
        $q set_context $::ApolTop::policy $context $range_match
    }
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set nodecons [nodecon_vector_to_list $v]
    set results "NODECONS:"
    if {[llength $nodecons] == 0} {
        append results "\nSearch returned no results."
    } else {
        foreach n [lsort -command _nodecon_sort $nodecons] {
            append results "\n[_nodecon_render $n]"
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) $results
    $v -acquire
    $v -delete
}
proc Apol_NetContexts::_nodecon_render {qpol_nodecon_datum} {
    apol_nodecon_render $::ApolTop::policy $qpol_nodecon_datum
}
proc Apol_NetContexts::_nodecon_sort {a b} {
    set proto1 [$a get_protocol $::ApolTop::qpolicy]
    set proto2 [$b get_protocol $::ApolTop::qpolicy]
    if {$proto1 == $::QPOL_IPV4 && $proto2 == $::QPOL_IPV6} {
        return -1
    } elseif {$proto1 == $::QPOL_IPV6 && $proto1 == $::QPOL_IPV4} {
        return 0
    }
    if {$proto1 == $::QPOL_IPV4} {
        set render apol_ipv4_addr_render
    } else {
        set render apol_ipv6_addr_render
    }
    set addr1 [$render $::ApolTop::policy [$a get_addr $::ApolTop::qpolicy]]
    set addr2 [$render $::ApolTop::policy [$b get_addr $::ApolTop::qpolicy]]
    if {[set x [string compare $addr1 $addr2]] != 0} {
        return $x
    }
    set mask1 [$render $::ApolTop::policy [$a get_mask $::ApolTop::qpolicy]]
    set mask2 [$render $::ApolTop::policy [$b get_mask $::ApolTop::qpolicy]]
    string compare $mask1 $mask2
}
namespace eval Apol_Open_Policy_Dialog {
    variable dialog {}
    variable widgets
    variable vars
}
proc Apol_Open_Policy_Dialog::getPolicyPath {defaultPath} {
    variable dialog
    variable vars
    array unset vars
    _create_dialog .
    set vars(path_type) "monolithic"
    set vars(primary_file) {}
    set vars(last_module) {}
    set vars(mod_names) {}
    set vars(mod_vers) {}
    set vars(mod_paths) {}
    if {$defaultPath != {}} {
        foreach {path_type primary modules} [policy_path_to_list $defaultPath] {break}
        set vars(path_type) $path_type
        if {[set vars(primary_file) $primary] != {}} {
            $dialog itemconfigure 0 -state normal
        }
        set vars(last_module) $vars(primary_file)
        foreach m $modules {
            if {[catch {getModuleInfo $m} info]} {
                tk_messageBox -icon error -type ok -title "Open Module" -message $info -detail "Module file $m" -parent [$dialog getframe]
            } else {
                foreach {name vers type} $info {break}
                lappend vars(mod_names) $name
                lappend vars(mod_vers) $vers
                lappend vars(mod_paths) $m
                set vars(last_module) $m
            }
        }
    }
    $dialog.bbox _redraw
    $dialog draw
    destroy $dialog
}
proc Apol_Open_Policy_Dialog::_create_dialog {parent} {
    variable dialog
    variable widgets
    variable vars
    destroy $dialog
    set dialog [Dialog .open_policy_dialog -modal local -parent $parent \
                    -cancel 1 \
                    -separator 1 -homogeneous 1 -title "Open Policy"]
    set f [$dialog getframe]
    set policy_type_f [frame $f.policy_type]
    pack $policy_type_f -padx 4 -pady 4 -expand 0 -anchor w
    set l [label $policy_type_f.l -text "Policy Type:"]
    set mono_cb [radiobutton $policy_type_f.mono -text "Monolithic policy" \
                     -value monolithic \
                     -variable Apol_Open_Policy_Dialog::vars(path_type)]
    set mod_cb [radiobutton $policy_type_f.mod -text "Modular policy" \
                    -value modular \
                    -variable Apol_Open_Policy_Dialog::vars(path_type)]
    pack $l -anchor w
    pack $mono_cb $mod_cb -anchor w -padx 8
    set primary_f [frame $f.primary]
    pack $primary_f -padx 4 -pady 8 -expand 0 -fill x
    set widgets(main_label) [label $primary_f.l -text "Policy Filename:"]
    pack $widgets(main_label) -anchor w
    frame $primary_f.f
    pack $primary_f.f -expand 1 -fill x
    set e [entry $primary_f.f.e -width 32 -bg white \
               -textvariable Apol_Open_Policy_Dialog::vars(primary_file) \
               -validate key \
               -vcmd [list Apol_Open_Policy_Dialog::_validateEntryKey %P]]
    bind $e <Key-Return> Apol_Open_Policy_Dialog::tryOpenPolicy
    set b [button $primary_f.f.b -text "Browse" \
               -command Apol_Open_Policy_Dialog::browsePrimary]
    pack $e -side left -expand 1 -fill x -padx 4
    pack $b -side right -expand 0 -padx 4
    set modules_f [frame $f.modules]
    pack $modules_f -pady 4 -padx 4 -expand 1 -fill both
    set mod_list_f [frame $modules_f.mods -relief sunken]
    pack $mod_list_f -side left -expand 1 -fill both -padx 4
    set mlabel [label $mod_list_f.ml -text "Module:"]
    set vlabel [label $mod_list_f.vl -text "Version:"]
    set plabel [label $mod_list_f.pl -text "Path:"]
    grid $mlabel $vlabel $plabel x -sticky w
    set dis_bg [$mlabel cget -bg]
    set ml [listbox $mod_list_f.mods -height 6 -width 10 \
                -listvariable Apol_Open_Policy_Dialog::vars(mod_names)]
    set vl [listbox $mod_list_f.vers -height 6 -width 4 \
                -listvariable Apol_Open_Policy_Dialog::vars(mod_vers)]
    set pl [listbox $mod_list_f.paths -height 6 -width 24 \
                -listvariable Apol_Open_Policy_Dialog::vars(mod_paths)]
    set sb [scrollbar $mod_list_f.sb -orient vertical \
                -command [list Apol_Open_Policy_Dialog::multiscroll yview]]
    grid $ml $vl $pl $sb -sticky nsew
    set widgets(bb) [ButtonBox $modules_f.bb -homogeneous 1 -orient vertical -pady 2]
    $widgets(bb) add -text "Add" -command Apol_Open_Policy_Dialog::browseModule
    $widgets(bb) add -text "Remove" -command Apol_Open_Policy_Dialog::removeModule -state disabled
    $widgets(bb) add -text "Import" -command Apol_Open_Policy_Dialog::importList
    $widgets(bb) add -text "Export" -command Apol_Open_Policy_Dialog::exportList -state disabled
    pack $widgets(bb) -side right -expand 0 -anchor n -padx 4 -pady 10
    set widgets(listboxes) [list $ml $vl $pl]
    set widgets(scrollbar) $sb
    foreach lb $widgets(listboxes) {
        $lb configure -yscrollcommand Apol_Open_Policy_Dialog::multiyview \
                -relief groove -bg white -exportselection 0
        bind $lb <<ListboxSelect>> \
            [list Apol_Open_Policy_Dialog::multiselect $lb]
    }
    trace add variable Apol_Open_Policy_Dialog::vars(path_type) write \
        [list Apol_Open_Policy_Dialog::togglePathType \
             [list $mlabel $vlabel $plabel] $dis_bg]
    $dialog add -text "OK" -command Apol_Open_Policy_Dialog::tryOpenPolicy \
        -state disabled
    $dialog add -text "Cancel"
}
proc Apol_Open_Policy_Dialog::_validateEntryKey {newvalue} {
    variable vars
    variable dialog
    variable widgets
    if {$newvalue == {}} {
        $dialog itemconfigure 0 -state disabled
        $widgets(bb) itemconfigure 3 -state disabled
    } else {
        $dialog itemconfigure 0 -state normal
        if {$vars(path_type) == "modular"} {
            $widgets(bb) itemconfigure 3 -state normal
        } else {
            $widgets(bb) itemconfigure 3 -state disabled
        }
    }
    return 1
}
proc Apol_Open_Policy_Dialog::togglePathType {labels disabled_bg name1 name2 op} {
    variable vars
    variable widgets
    if {$vars(path_type) == "modular"} {
        set state normal
        set bg white
        $widgets(main_label) configure -text "Base Filename:"
    } else {
        set state disabled
        set bg $disabled_bg
        $widgets(main_label) configure -text "Policy Filename:"
    }
    foreach w $labels {
        $w configure -state $state
    }
    foreach w $widgets(listboxes) {
        $w configure -state $state -bg $bg
    }
    $widgets(bb) configure -state $state
    if {$state == "normal" && [[lindex $widgets(listboxes) 0] curselection] > 0} {
        $widgets(bb) itemconfigure 1 -state normal
    } else {
        $widgets(bb) itemconfigure 1 -state disabled
    }
    if {$state == "normal" && $vars(primary_file) != {}} {
        $widgets(bb) itemconfigure 3 -state normal
    } else {
        $widgets(bb) itemconfigure 3 -state disabled
    }
}
proc Apol_Open_Policy_Dialog::browsePrimary {} {
    variable vars
    variable dialog
    .open_policy_dialog.frame.primary.f.b configure -state disabled
    if {$vars(path_type) == "monolithic"} {
        set title "Open Monolithic Policy"
		set initDirName {}
    } else {
        set title "Open Modular Policy"
		if {$vars(primary_file) != {} } {
			set initDirName [file dirname $vars(primary_file)]
		} else {
			set initDirName [file dirname $vars(last_module)]
		}
    }
    set f [tk_getOpenFile -initialdir $initDirName \
               -initialfile $vars(primary_file) -parent $dialog -title $title]
    if {$f != {}} {
        set vars(primary_file) $f
        $dialog itemconfigure 0 -state normal
    }
    .open_policy_dialog.frame.primary.f.b configure -state normal
}
proc Apol_Open_Policy_Dialog::browseModule {} {
    variable vars
    variable dialog
	if {$vars(last_module) != {} } {
		set initDirName [file dirname $vars(last_module)]
	} else {
		set initDirName [file dirname $vars(primary_file)]
	}
    set paths [tk_getOpenFile -initialdir $initDirName \
                   -initialfile $vars(last_module) -parent $dialog \
                   -title "Open Module" -multiple 1]
    if {$paths == {}} {
        return
    }
    foreach f $paths {
		if { $f != $vars(last_module) } { 
			addModule $f
		}
    }
}
proc Apol_Open_Policy_Dialog::addModule {f} {
    variable vars
    variable widgets
    if {[lsearch $vars(mod_paths) $f] >= 0} {
        tk_messageBox -icon error -type ok -title "Open Module" -message "Module $f was already added." -parent .open_policy_dialog
        return
    }
    if {[catch {getModuleInfo $f} info]} {
        tk_messageBox -icon error -type ok -title "Open Module" -message $info -detail "Module file $f" -parent .open_policy_dialog
    } else {
        foreach {name vers type} $info {break}
		if {$type == 1} {
			if {$vars(primary_file) != {}} {
				if {$vars(primary_file) != $f} {
				tk_messageBox -icon error -type ok -title "Open Module" -message "Base already set" -detail "Current $vars(primary_file)\n\nNew file $f\n\nIgnoring new file." -parent .open_policy_dialog
				}
				return
			}
			set vars(primary_file) $f
			return
		}
        set vars(mod_names) [lsort [concat $vars(mod_names) $name]]
        set i [lsearch $vars(mod_names) $name]
        set vars(mod_vers) [linsert $vars(mod_vers) $i $vers]
        set vars(mod_paths) [linsert $vars(mod_paths) $i $f]
        foreach lb $widgets(listboxes) {
            $lb selection clear 0 end
            $lb selection set $i
        }
        [lindex $widgets(listboxes) 0] see $i
        set vars(last_module) $f
        $widgets(bb) itemconfigure 1 -state normal
    }
}
proc Apol_Open_Policy_Dialog::removeModule {} {
    variable widgets
    set i [[lindex $widgets(listboxes) 0] curselection]
    if {[llength $i] > 0} {
        foreach lb $widgets(listboxes) {
            $lb delete [lindex $i 0]
        }
    }
    $widgets(bb) itemconfigure 1 -state disabled
}
proc Apol_Open_Policy_Dialog::importList {} {
    variable vars
    variable dialog
    variable widgets
    set f [tk_getOpenFile -initialdir [file dirname $vars(primary_file)] \
               -parent $dialog -title "Import Policy List"]
    if {$f == {}} {
        return
    }
    if {[catch {new_apol_policy_path_t $f} ppath]} {
        tk_messageBox -icon error -type ok -title "Import Policy List" \
            -message "Error importing policy list $f: $ppath"
        return
    }
    foreach lb $widgets(listboxes) {
        $lb delete 0 end
    }
    foreach {path_type primary modules} [policy_path_to_list $ppath] {break}
    set vars(path_type) $path_type
    if {[set vars(primary_file) $primary] != {}} {
        $dialog itemconfigure 0 -state normal
    }
    set vars(last_module) $f
    foreach m $modules {
        addModule $m
    }
    _validateEntryKey $vars(primary_file)
    $ppath -acquire
    $ppath -delete
}
proc Apol_Open_Policy_Dialog::exportList {} {
    variable vars
    variable dialog
    set f [tk_getSaveFile -parent $dialog -title "Export Policy List"]
    if {$f == {}} {
        return
    }
    set ppath [list_to_policy_path $vars(path_type) $vars(primary_file) $vars(mod_paths)]
    if {[catch {$ppath to_file $f} err]} {
        tk_messageBox -icon error -type ok -title "Export Policy List" \
            -message "Error exporting policy list $f: $err"
    }
}
proc Apol_Open_Policy_Dialog::multiscroll {args} {
    variable widgets
    foreach lb $widgets(listboxes) {
        eval $lb $args
    }
}
proc Apol_Open_Policy_Dialog::multiselect {lb} {
    variable widgets
    set sellist [$lb curselection]
    set enable_remove 0
    foreach lb $widgets(listboxes) {
        $lb selection clear 0 end
        foreach item $sellist {
            $lb selection set $item
            set enable_remove 1
        }
    }
    if {$enable_remove} {
        $widgets(bb) itemconfigure 1 -state normal
    }
}
proc Apol_Open_Policy_Dialog::multiyview {args} {
    variable widgets
    eval $widgets(scrollbar) set $args
    multiscroll yview moveto [lindex $args 0]
}
proc Apol_Open_Policy_Dialog::tryOpenPolicy {} {
    variable dialog
    variable vars
    .open_policy_dialog.bbox.b0 configure -state disabled
    if {[string trim $vars(primary_file)] != {}} {
        set ppath [list_to_policy_path $vars(path_type) $vars(primary_file) $vars(mod_paths)]
        if {[ApolTop::openPolicyPath $ppath] == 0} {
            $dialog enddialog {}
        }
    }
    .open_policy_dialog.bbox.b0 configure -state normal
}
proc Apol_Open_Policy_Dialog::getModuleInfo {f} {
    set mod [new_qpol_module_t $f]
    set retval [list [$mod get_name] [$mod get_version] [$mod get_type]]
    $mod -acquire
    $mod -delete
    return $retval
}
namespace eval Apol_Perms_Map {
    variable dialog .apol_perms
    variable user_default_pmap_name [file join $::env(HOME) .apol_perm_mapping]
    variable opts           ;# options for edit perm map dialog
    variable widgets
}
proc Apol_Perms_Map::close {} {
    variable opts
    _close_dialog
    set opts(filename) {}
    set opts(is_saveable) 0
    set opts(modified) 0
}
proc Apol_Perms_Map::showPermMappings {} {
    variable dialog
    if {[winfo exists $dialog]} {
        raise $dialog
    } else {
        _createEditDialog
        _refreshEditDialog
    }
}
proc Apol_Perms_Map::openPermMapFromFile {} {
    set pmap_name [tk_getOpenFile -title "Select Perm Map to Load" -parent .]
    if {$pmap_name != {}} {
        return [_loadPermMap $pmap_name [file tail $pmap_name] 1]
    }
    return 0
}
proc Apol_Perms_Map::openDefaultPermMap {} {
    variable user_default_pmap_name
    if {[file exists $user_default_pmap_name]} {
        set pmap_name $user_default_pmap_name
        set pmap_short "User Default Permission Map"
        set pmap_editable 1
    } else {
        set pmap_editable 0
        set policy_version [apol_tcl_get_policy_version $::ApolTop::policy]
        set pmap_name [apol_file_find_path "apol_perm_mapping_ver${policy_version}"]
        if {$pmap_name == {}} {
            set pmap_name [apol_file_find_path apol_perm_mapping]
            if {$pmap_name == {}} {
                set message "Could not locate system default permission map.  You must explicitly load a permission map from file."
                if {[Apol_Progress_Dialog::is_waiting]} {
                    error $message
                } else {
                    tk_messageBox -icon error -type ok -title "Permission Maps" \
                        -message $message
                }
                return 0
            }
        }
        set pmap_short "System Default Permission Map (Read-Only)"
    }
    return [_loadPermMap $pmap_name $pmap_short $pmap_editable]
}
proc Apol_Perms_Map::savePermMap {} {
    variable opts
    if {!$opts(is_saveable)} {
        savePermMapAs
    } else {
        _savePermMap $opts(filename) $opts(shortname)
    }
}
proc Apol_Perms_Map::savePermMapAs {} {
    set pmap_name [tk_getSaveFile -title "Save Perm Map" -parent .]
    if {$pmap_name != {}} {
         _savePermMap $pmap_name [file tail $pmap_name]
    }
}
proc Apol_Perms_Map::saveDefaultPermMap {} {
    variable user_default_pmap_name
    variable opts
    _savePermMap $user_default_pmap_name "User Default Permission Map"
}
proc Apol_Perms_Map::is_pmap_loaded {} {
    variable opts
    if {$opts(filename) == {}} {
        return 0
    }
    return 1
}
proc Apol_Perms_Map::_loadPermMap {filename shortname saveable} {
    if {[catch {$::ApolTop::policy open_permmap $filename} err]} {
        if {[Apol_Progress_Dialog::is_waiting]} {
            error $err
        } else {
            tk_messageBox -icon error -type ok -title "Permission Maps" -message $err
            return 0
        }
    }
    variable opts
    set opts(filename) $filename
    set opts(shortname) $shortname
    set opts(is_saveable) $saveable
    set opts(modified) 0
    if {$err != {}} {
        set len [llength [split $err "\n"]]
        if {$len > 5} {
            incr len -4
            set err [lrange [split $err "\n"] 0 3]
            lappend err "(plus $len more lines)"
            set err [join $err "\n"]
        }
        if {![Apol_Progress_Dialog::is_waiting]} {
            set message "There were warnings while opening the permission map:"
            tk_messageBox -icon warning -type ok -title "Permission Maps" \
                -message "$message\n\n$err"
        }
    } else {
        if {![Apol_Progress_Dialog::is_waiting]} {
            tk_messageBox -icon info -type ok -title "Permission Maps" \
                -message "Permission map successfully loaded."
        }
    }
    variable dialog
    if {[winfo exists $dialog]} {
        _refreshEditDialog
    }
    return 1
}
proc Apol_Perms_Map::_createEditDialog {} {
    variable dialog
    variable opts
    variable widgets
    set title "Permissions Mappings: $opts(shortname)"
    Dialog $dialog -parent . -separator 1 -title $title -modal none \
        -default 0 -cancel 2
    set topf [frame [$dialog getframe].top]
    pack $topf -side top -expand 1 -fill both
    set classes_box [TitleFrame $topf.classes -text "Object Classes"]
    pack $classes_box -side left -padx 2 -pady 2 -expand 0 -fill y
    set widgets(classes) [Apol_Widget::makeScrolledListbox [$classes_box getframe].c \
                              -height 16 -width 24 -listvar Apol_Perms_Map::opts(classes)]
    bind $widgets(classes).lb <<ListboxSelect>> Apol_Perms_Map::_refreshPermEdit
    pack $widgets(classes) -expand 1 -fill both
    set results_box [TitleFrame $topf.perms -text "Permission Mappings"]
    pack $results_box -side right -padx 2 -pady 2 -expand 1 -fill both
    set sw [ScrolledWindow [$results_box getframe].sw -auto both]
    set widgets(perms) [ScrollableFrame $sw.perms -width 300]
    $sw setwidget $widgets(perms)
    pack $sw -expand 1 -fill both
    set label_box [frame [$dialog getframe].l]
    pack $label_box -side bottom -anchor center
    set widgets(l1) [label $label_box.l1 -fg red -text ""]
    set widgets(l2) [label $label_box.l2 -text ""]
    pack $widgets(l1) $widgets(l2) -side left
    $dialog add -text "OK" -command Apol_Perms_Map::_okay
    $dialog add -text "Apply" -command Apol_Perms_Map::_apply
    $dialog add -text "Cancel" -command Apol_Perms_Map::_cancel
    trace add variable Apol_Perms_Map::opts(modified) write \
        Apol_Perms_Map::_toggleButtons
    set opts(modified) $opts(modified)
    $dialog draw
}
proc Apol_Perms_Map::_refreshEditDialog {} {
    variable opts
    variable widgets
    array set opts {
        classes {}
    }
    set all_mapped 1
    set class_index 0
    foreach class [Apol_Class_Perms::getClasses] {
        set suffix {}
        set perm_list {}
        foreach perm [Apol_Class_Perms::getPermsForClass $class] {
            set direction [$::ApolTop::policy get_permmap_direction $class $perm]
            set weight [$::ApolTop::policy get_permmap_weight $class $perm]
            set opts(p:${class}:${perm}:map) $direction
            set opts(p:${class}:${perm}:weight) $weight
            if {$direction == $::APOL_PERMMAP_UNMAPPED} {
                set suffix *
                set all_mapped 0
            }
            lappend perm_list [list $perm $direction $weight]
        }
        set opts(c:$class) $perm_list
        lappend opts(classes) "$class$suffix"
        if {$suffix != {}} {
            $widgets(classes).lb itemconfigure $class_index -foreground red
        }
        incr class_index
    }
    if {!$all_mapped} {
        $widgets(l1) configure -text "*"
        $widgets(l2) configure -text " - Undefined permission mapping(s)"
    } else {
        $widgets(l1) configure -text ""
        $widgets(l2) configure -text ""
    }
}
proc Apol_Perms_Map::_refreshPermEdit {} {
    variable opts
    variable widgets
    focus $widgets(classes).lb
    set perms [$widgets(perms) getframe]
    foreach w [winfo children $perms] {
        destroy $w
    }
    if {[set selection [$widgets(classes).lb curselection]] == {}} {
        return
    }
    set class [lindex $opts(classes) [lindex $selection 0]]
    set class [string trimright $class "*"]
    foreach perm $opts(c:$class) {
        foreach {perm map weight} $perm {break}
        if {$map != $::APOL_PERMMAP_UNMAPPED} {
            set l [label $perms.$perm:l -text $perm -anchor w]
        } else {
            set l [label $perms.$perm:l -text "${perm}*" -fg red -anchor w]
        }
        set menubutton [menubutton $perms.$perm:mb -bd 2 -relief raised \
                            -indicatoron 1 -width 8 \
                            -textvariable Apol_Perms_Map::opts(p:${class}:${perm}:map_label)]
        set menu [menu $menubutton.m -type normal -tearoff 0]
        $menubutton configure -menu $menu
        $menu add radiobutton -label "Read" -value $::APOL_PERMMAP_READ \
            -command [list Apol_Perms_Map::_togglePermMap $class $perm 1] \
            -variable Apol_Perms_Map::opts(p:${class}:${perm}:map)
        $menu add radiobutton -label "Write" -value $::APOL_PERMMAP_WRITE \
            -command [list Apol_Perms_Map::_togglePermMap $class $perm 1] \
            -variable Apol_Perms_Map::opts(p:${class}:${perm}:map)
        $menu add radiobutton -label "Both" -value $::APOL_PERMMAP_BOTH \
            -command [list Apol_Perms_Map::_togglePermMap $class $perm 1] \
            -variable Apol_Perms_Map::opts(p:${class}:${perm}:map)
        $menu add radiobutton -label "None" -value $::APOL_PERMMAP_NONE \
            -command [list Apol_Perms_Map::_togglePermMap $class $perm 1] \
            -variable Apol_Perms_Map::opts(p:${class}:${perm}:map)
        set l2 [label $perms.$perm:l2 -text "Weight:" -anchor e]
        set weight [spinbox $perms.$perm:weight -from 1 -to 10 -increment 1 \
                        -width 2 -bg white \
                        -command [list Apol_Perms_Map::_togglePermMap $class $perm 1] \
                        -textvariable Apol_Perms_Map::opts(p:${class}:${perm}:weight)]
        grid $l $menubutton $l2 $weight -padx 2 -sticky w -pady 4
        grid configure $l2 -ipadx 10
        _togglePermMap $class $perm 0
    }
    grid columnconfigure $perms 0 -minsize 100 -weight 1
    $widgets(perms) xview moveto 0
    $widgets(perms) yview moveto 0
}
proc Apol_Perms_Map::_togglePermMap {class perm modification} {
    variable opts
    set map $opts(p:${class}:${perm}:map)
    if {$map == $::APOL_PERMMAP_READ} {
        set opts(p:${class}:${perm}:map_label) "Read"
    } elseif {$map == $::APOL_PERMMAP_WRITE} {
        set opts(p:${class}:${perm}:map_label) "Write"
    } elseif {$map == $::APOL_PERMMAP_BOTH} {
        set opts(p:${class}:${perm}:map_label) "Both"
    } elseif {$map == $::APOL_PERMMAP_NONE} {
        set opts(p:${class}:${perm}:map_label) "None"
    } else {
        set opts(p:${class}:${perm}:map_label) "Unmapped"
    }
    set opts(modified) $modification
}
proc Apol_Perms_Map::_toggleButtons {name1 name2 op} {
    variable opts
    variable dialog
    if {$opts(modified)} {
        $dialog itemconfigure 1 -state normal
    } else {
        $dialog itemconfigure 1 -state disabled
    }
}
proc Apol_Perms_Map::_okay {} {
    _apply
    _close_dialog
}
proc Apol_Perms_Map::_apply {} {
    variable dialog
    variable opts
    if {[winfo exists $dialog] && $opts(modified)} {
        foreach class $opts(classes) {
            set class [string trimright $class "*"]
            set perm_list {}
            foreach perm [Apol_Class_Perms::getPermsForClass $class] {
                set map $opts(p:${class}:${perm}:map)
                set weight $opts(p:${class}:${perm}:weight)
                if {$map != $::APOL_PERMMAP_UNMAPPED} {
                    $::ApolTop::policy set_permmap $class $perm $map $weight
                }
                lappend perm_list [list $perm $map $weight]
            }
            set opts(c:$class) $perm_list
        }
    }
    set opts(modified) 0
}
proc Apol_Perms_Map::_cancel {} {
    variable opts
    if {$opts(modified)} {
        foreach class $opts(classes) {
            set class [string trimright $class "*"]
            foreach perm $opts(c:$class) {
                foreach {perm map weight} $perm {break}
                $::ApolTop::policy set_permmap $class $perm $map $weight
            }
        }
    }
    _close_dialog
}
proc Apol_Perms_Map::_close_dialog {} {
    variable opts
    array unset opts c:*
    array unset opts p:*
    trace remove variable Apol_Perms_Map::opts(modified) write \
        Apol_Perms_Map::_toggleButtons
    variable dialog
    destroy $dialog
}
proc Apol_Perms_Map::_savePermMap {filename shortname} {
    variable opts
    variable dialog
    _apply
    if {[catch {$::ApolTop::policy save_permmap $filename} err]} {
        tk_messageBox -icon error -type ok -title "Permission Maps" -message "Error saving permission map: $err"
    } else {
        set opts(filename) $filename
        set opts(shortname) $shortname
        set opts(is_saveable) 1
        set opts(modified) 0
        set title "Permissions Mappings: $opts(shortname)"
        if {[winfo exists $dialog]} {
            $dialog configure -title $title
            _refreshEditDialog
            _refreshPermEdit
        }
    }
}
namespace eval Apol_PolicyConf {
    variable textbox
}
proc Apol_PolicyConf::create {tab_name nb} {
    variable textbox
    set frame [$nb insert end $tab_name -text "Policy Source"]
    set sw [ScrolledWindow $frame.sw -auto none]
    set textbox [text [$sw getframe].text -bg white -wrap none]
    $sw setwidget $textbox
    bind $textbox <Button-3> [list Apol_Widget::_searchresults_popup %W %x %y]
    pack $sw -expand yes -fill both
    bind $textbox <<Insertion>> Apol_PolicyConf::insertionMarkChanged
    rename $textbox ::Apol_PolicyConf::_real_text
    proc ::$textbox {cmd args} {
        switch -- $cmd {
            insert -
            delete { return }
            fakeinsert { set cmd insert }
            fakedelete { set cmd delete }
        }
        set retval [uplevel 1 ::Apol_PolicyConf::_real_text $cmd $args]
        if {$cmd == "mark" && [string equal -length 10 $args "set insert"]} {
            event generate $Apol_PolicyConf::textbox <<Insertion>>
        }
        return $retval
    }
}
proc Apol_PolicyConf::open {ppath} {
    variable textbox
    $textbox fakedelete 0.0 end
    if {![ApolTop::is_capable "source"]} {
        $textbox fakeinsert end "The currently loaded policy is not a source policy."
    } else {
        set primary_file [$ppath get_primary]
        if {[catch {::open $primary_file r} f]} {
            $textbox fakeinsert end "$primary_file does not exist or could not be read by the user."
        } else {
            $textbox fakeinsert end [read $f]
            ::close $f
        }
    }
    $textbox see 0.0
    $textbox mark set insert 1.0
}
proc Apol_PolicyConf::close {} {
    variable textbox
    $textbox fakedelete 0.0 end
}
proc Apol_PolicyConf::getTextWidget {} {
    variable textbox
    return $textbox
}
proc Apol_PolicyConf::insertionMarkChanged {} {
    set lpos [$Apol_PolicyConf::textbox index insert]
    foreach {line col} [split $lpos .] {break}
    ApolTop::setPolicySourceLinenumber $line
}
proc Apol_PolicyConf::gotoLine {line} {
    variable textbox
    $textbox tag remove sel 0.0 end
    $textbox mark set insert $line.0
    $textbox see $line.0
    $textbox tag add sel $line.0 $line.end
    focus $textbox
}
namespace eval Apol_Progress_Dialog {
    variable text
    variable prev_text
    variable val
    variable waiting 0
}
proc Apol_Progress_Dialog::wait {title initialtext lambda} {
    variable text "$title:\n    $initialtext"
    variable prev_text $initialtext
    variable val -1
    set title_width [string length $title]
    set text_width [expr {[string length $initialtext] + 4}]
    if {$text_width < $title_width} {
        set text_width $title_width
    }
    if {$text_width < 32} {
        set text_width 32
    }
    if {[info exists .apol_progress] == 0} {
        ProgressDlg .apol_progress -title $title \
            -type normal -stop {} -separator 1 -parent . -maximum 2 \
            -width $text_width -textvariable Apol_Progress_Dialog::text \
            -variable Apol_Progress_Dialog::val
    }
    set orig_cursor [. cget -cursor]
    . configure -cursor watch
    update idletasks
    apol_tcl_clear_info_string
    variable waiting 1
    set catchval [catch {uplevel 1 $lambda} retval]
    set waiting 0
    . configure -cursor $orig_cursor
    destroy .apol_progress
    update idletasks
    return -code $catchval $retval
}
proc Apol_Progress_Dialog::is_waiting {} {
    variable waiting
    set waiting
}
proc Apol_Progress_Dialog::_update_message {} {
    variable text
    variable prev_text
    if {[set infoString [apol_tcl_get_info_string]] != $prev_text} {
        set text "[lindex [split $text "\n"] 0]\n    $infoString"
        update idletasks
        set prev_text $infoString
    }
}
namespace eval Apol_Range_Dialog {
    variable dialog ""
    variable vars
}
proc Apol_Range_Dialog::getRange {{defaultRange {}} {parent .}} {
    variable dialog
    variable vars
    if {![winfo exists $dialog]} {
        _create_dialog $parent
    }
    set f [$dialog getframe]
    Apol_Widget::resetLevelSelectorToPolicy $f.low
    Apol_Widget::resetLevelSelectorToPolicy $f.high
    set vars($dialog:highenable) 0
    if {$defaultRange != {}} {
        set low_level [$defaultRange get_low]
        set high_level [$defaultRange get_high]
        Apol_Widget::setLevelSelectorLevel $f.low $low_level
        if {[apol_mls_level_compare $::ApolTop::policy $low_level $high_level] != $::APOL_MLS_EQ} {
            set vars($dialog:highenable) 1
            Apol_Widget::setLevelSelectorLevel $f.high $high_level
        }
    }
    _high_enabled $dialog
    $dialog.bbox _redraw
    set retval [$dialog draw]
    if {$retval == -1 || $retval == 1} {
        return {}
    }
    _get_range $dialog
}
proc Apol_Range_Dialog::_create_dialog {parent} {
    variable dialog
    variable vars
    set dialog [Dialog .range_dialog -modal local -parent $parent \
                    -separator 1 -homogeneous 1 -title "Select Range"]
    array unset vars $dialog:*
    set f [$dialog getframe]
    set low_label [label $f.ll -text "Single level"]
    set low_level [Apol_Widget::makeLevelSelector $f.low 12]
    set high_cb [checkbutton $f.high_enable \
                     -text "High level" \
                     -variable Apol_Range_Dialog::vars($dialog:highenable) \
                     -command [list Apol_Range_Dialog::_high_enabled $dialog]]
    set high_level [Apol_Widget::makeLevelSelector $f.high 12]
    Apol_Widget::setLevelSelectorState $high_level 0
    grid $low_label $high_cb -sticky w
    grid $low_level $high_level -sticky ns
    grid columnconfigure $f 0 -weight 1 -uniform 1 -pad 4
    grid columnconfigure $f 1 -weight 1 -uniform 1 -pad 4
    $dialog add -text "OK" -command [list Apol_Range_Dialog::_okay $dialog]
    $dialog add -text "Cancel"
}
proc Apol_Range_Dialog::_get_range {dialog} {
    variable vars
    set f [$dialog getframe]
    set range [new_apol_mls_range_t]
    if {[ApolTop::is_policy_open]} {
        set p $::ApolTop::policy
    } else {
        set p NULL
    }
    set low_level [Apol_Widget::getLevelSelectorLevel $f.low]
    $range set_low $p $low_level
    if {$vars($dialog:highenable)} {
        set high_level [Apol_Widget::getLevelSelectorLevel $f.high]
        $range set_high $p $high_level
    }
    return $range
}
proc Apol_Range_Dialog::_okay {dialog} {
    set range [_get_range $dialog]
    if {![ApolTop::is_policy_open] || [$range validate $::ApolTop::policy] != 1} {
        tk_messageBox -icon error -type ok -title "Invalid Range" \
            -message "The selected range is not valid.  The high level does not dominate the low level."
    } else {
        $dialog enddialog 0
    }
    $range -acquire
    $range -delete
}
proc Apol_Range_Dialog::_high_enabled {dialog} {
    variable vars
    set f [$dialog getframe]
    if {$vars($dialog:highenable)} {
        $f.ll configure -text "Low level"
        Apol_Widget::setLevelSelectorState $f.high 1
    } else {
        $f.ll configure -text "Single level"
        Apol_Widget::setLevelSelectorState $f.high 0
    }
}
namespace eval Apol_Widget {
    variable vars
}
proc Apol_Widget::makeRangeSelector {path rangeMatchText {enableText "MLS range"} args} {
    variable vars
    array unset vars $path:*
    set vars($path:range) {}
    set vars($path:range_rendered) {}
    set vars($path:search_type) $::APOL_QUERY_EXACT
    set f [frame $path]
    set range_frame [frame $f.range]
    set range2_frame [frame $f.range2]
    pack $range_frame $range2_frame -side left -expand 0 -anchor nw
    if {$enableText != {}} {
        set vars($path:enable) 0
        set range_cb [checkbutton $range_frame.enable -text $enableText \
                          -variable Apol_Widget::vars($path:enable)]
        pack $range_cb -side top -expand 0 -anchor nw
        trace add variable Apol_Widget::vars($path:enable) write [list Apol_Widget::_toggle_range_selector $path $range_cb]
    }
    set range_display [eval Entry $range_frame.display -textvariable Apol_Widget::vars($path:range_rendered) -width 20 -editable 0 $args]
    set range_button [button $range_frame.button -text "Select Range..." -state disabled -command [list Apol_Widget::_show_mls_range_dialog $path]]
    trace add variable Apol_Widget::vars($path:range) write [list Apol_Widget::_update_range_display $path]
    pack $range_display -side top -expand 1 -fill x -anchor nw
    pack $range_button -side top -expand 0 -anchor ne
    if {$enableText != {}} {
        pack configure $range_display -padx 4
        pack configure $range_button -padx 4
    }
    set range_label [label $range2_frame.label -text "Range matching:" \
                         -state disabled]
    set range_exact [radiobutton $range2_frame.exact -text "Exact matches" \
                         -state disabled \
                         -value $::APOL_QUERY_EXACT \
                         -variable Apol_Widget::vars($path:search_type)]
    set range_subset [radiobutton $range2_frame.subset -text "$rangeMatchText containing range" \
                          -state disabled \
                          -value $::APOL_QUERY_SUB \
                          -variable Apol_Widget::vars($path:search_type)]
    set range_superset [radiobutton $range2_frame.superset -text "$rangeMatchText within range" \
                            -state disabled \
                            -value $::APOL_QUERY_SUPER \
                            -variable Apol_Widget::vars($path:search_type)]
    pack $range_label $range_exact $range_subset $range_superset \
        -side top -expand 0 -anchor nw
    return $f
}
proc Apol_Widget::setRangeSelectorState {path newState} {
    if {$newState == 0 || $newState == "disabled"} {
        set new_state disabled
    } else {
        set new_state normal
    }
    foreach w {display button} {
        $path.range.$w configure -state $new_state
    }
    foreach w {label exact subset superset} {
        $path.range2.$w configure -state $new_state
    }
}
proc Apol_Widget::setRangeSelectorCompleteState {path newState} {
    if {$newState == 0 || $newState == "disabled"} {
        set new_state disabled
    } else {
        set new_state normal
    }
    catch {$path.range.enable configure -state $new_state}
}
proc Apol_Widget::clearRangeSelector {path} {
    set Apol_Widget::vars($path:range) {}
    set Apol_Widget::vars($path:search_type) $::APOL_QUERY_EXACT
    catch {set Apol_Widget::vars($path:enable) 0}
}
proc Apol_Widget::getRangeSelectorState {path} {
    return $Apol_Widget::vars($path:enable)
}
proc Apol_Widget::getRangeSelectorValue {path} {
    variable vars
    if {$vars($path:range) != {}} {
        set range [new_apol_mls_range_t $vars($path:range)]
    } else {
        set range {}
    }
    list $range $vars($path:search_type)
}
proc Apol_Widget::_toggle_range_selector {path cb name1 name2 op} {
    if {$Apol_Widget::vars($path:enable)} {
        Apol_Widget::setRangeSelectorState $path normal
    } else {
        Apol_Widget::setRangeSelectorState $path disabled
    }
}
proc Apol_Widget::_show_mls_range_dialog {path} {
    $path.range.button configure -state disabled
    set range [Apol_Range_Dialog::getRange $Apol_Widget::vars($path:range)]
    if {$range != {}} {
        set Apol_Widget::vars($path:range) $range
        $range -acquire
    }
    $path.range.button configure -state normal
}
proc Apol_Widget::_update_range_display {path name1 name2 op} {
    variable vars
    set display $path.range.display
    if {$vars($path:range) == {}} {
        set vars($path:range_rendered) {}
        $display configure -helptext {}
    } else {
        set s [$vars($path:range) render $::ApolTop::policy]
        set vars($path:range_rendered) $s
        $display configure -helptext $vars($path:range_rendered)
    }
}
namespace eval Apol_Range {
    variable widgets
    variable vals
}
proc Apol_Range::create {tab_name nb} {
    variable widgets
    variable vals
    set frame [$nb insert end $tab_name -text "Range Transition Rules"]
    set obox [TitleFrame $frame.obox -text "Search Options"]
    set dbox [TitleFrame $frame.dbox -text "Range Transition Rules Display"]
    pack $obox -fill x -expand 0 -padx 2 -pady 2
    pack $dbox -fill both -expand yes -padx 2 -pady 2
    set source_frame [frame [$obox getframe].source]
    set target_frame [frame [$obox getframe].target]
    set classes_frame [frame [$obox getframe].classes]
    pack $source_frame $target_frame $classes_frame -side left -padx 4 -pady 2 -expand 0 -anchor nw
    set vals(enable_source) 0
    set source_cb [checkbutton $source_frame.cb -text "Source type" \
                       -variable Apol_Range::vals(enable_source)]
    set widgets(source_type) [Apol_Widget::makeTypeCombobox $source_frame.tcb]
    Apol_Widget::setTypeComboboxState $widgets(source_type) 0
    trace add variable Apol_Range::vals(enable_source) write \
        [list Apol_Range::_toggleTypeCombobox $widgets(source_type)]
    pack $source_cb -side top -expand 0 -anchor nw
    pack $widgets(source_type) -side top -expand 0 -anchor nw -padx 4
    set vals(enable_target) 0
    set target_cb [checkbutton $target_frame.cb -text "Target type" \
                       -variable Apol_Range::vals(enable_target)]
    set widgets(target_type) [Apol_Widget::makeTypeCombobox $target_frame.tcb]
    Apol_Widget::setTypeComboboxState $widgets(target_type) 0
    trace add variable Apol_Range::vals(enable_target) write \
        [list Apol_Range::_toggleTypeCombobox $widgets(target_type)]
    pack $target_cb -side top -expand 0 -anchor nw
    pack $widgets(target_type) -side top -expand 0 -anchor nw -padx 4
    set l [label $classes_frame.l -text "Target Classes"]
    set sw [ScrolledWindow $classes_frame.sw -auto both]
    set widgets(classes) [listbox [$sw getframe].lb -height 5 -width 24 \
                              -highlightthickness 0 -selectmode multiple \
                              -exportselection 0 -state disabled \
                              -bg $ApolTop::default_bg_color \
                              -listvar Apol_Range::vals(classes)]
    $sw setwidget $widgets(classes)
    update
    grid propagate $sw 0
    pack $l $sw -side top -expand 0 -anchor nw
    set widgets(range) [Apol_Widget::makeRangeSelector [$obox getframe].range Rules]
    pack $widgets(range) -side left -padx 4 -pady 2 -expand 0 -anchor nw
    set ok [button [$obox getframe].ok -text "OK" -width 6 -command Apol_Range::_searchRanges]
    pack $ok -side right -pady 5 -padx 5 -anchor ne
    set widgets(results) [Apol_Widget::makeSearchResults [$dbox getframe].results]
    pack $widgets(results) -expand yes -fill both
    return $frame
}
proc Apol_Range::open {ppath} {
    variable vals
    variable widgets
    Apol_Widget::resetTypeComboboxToPolicy $widgets(source_type)
    Apol_Widget::resetTypeComboboxToPolicy $widgets(target_type)
    set vals(classes) [Apol_Class_Perms::getClasses]
    $widgets(classes) configure -bg white -state normal
}
proc Apol_Range::close {} {
    variable vals
    variable widgets
    Apol_Widget::clearTypeCombobox $widgets(source_type)
    Apol_Widget::clearTypeCombobox $widgets(target_type)
    set vals(classes) {}
    $widgets(classes) configure -bg $ApolTop::default_bg_color -state disabled
    Apol_Widget::clearRangeSelector $widgets(range)
    Apol_Widget::clearSearchResults $widgets(results)
    set vals(enable_source) 0
    set vals(enable_target) 0
}
proc Apol_Range::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_Range::_toggleTypeCombobox {path name1 name2 op} {
    Apol_Widget::setTypeComboboxState $path $Apol_Range::vals($name2)
}
proc Apol_Range::_searchRanges {} {
    variable vals
    variable widgets
    Apol_Widget::clearSearchResults $widgets(results)
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
        return
    }
    if {$vals(enable_source)} {
        set source [lindex [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(source_type)] 0]
        if {$source == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No source type provided."
            return
        }
    } else {
        set source {}
    }
    if {$vals(enable_target)} {
        set target [lindex [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(target_type)] 0]
        if {$target == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No target type provided."
            return
        }
    } else {
        set target {}
    }
    if {[Apol_Widget::getRangeSelectorState $widgets(range)]} {
        foreach {range range_match} [Apol_Widget::getRangeSelectorValue $widgets(range)] break
        if {$range == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No range selected."
            return
        }
    } else {
        set range NULL
        set range_match 0
    }
    set q [new_apol_range_trans_query_t]
    $q set_source $::ApolTop::policy $source 0
    $q set_target $::ApolTop::policy $target 0
    foreach c [$widgets(classes) curselection] {
        $q append_class $::ApolTop::policy [$widgets(classes) get $c]
    }
    $q set_range $::ApolTop::policy $range $range_match
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set results [range_trans_vector_to_list $v]
    $v -acquire
    $v -delete
    if {[llength $results] == 0} {
        set text "Search returned no results."
    } else {
        set text "[llength $results] rule"
        if {[llength $results] != 1} {
            append text s
        }
        append text " match the search criteria.\n\n"
    }
    foreach r [lsort -command _range_trans_sort $results] {
        append text "[_renderRangeTrans $r]\n"
    }
    Apol_Widget::appendSearchResultText $widgets(results) $text
}
proc Apol_Range::_renderRangeTrans {rule} {
    apol_range_trans_render $::ApolTop::policy $rule
}
proc Apol_Range::_range_trans_sort {a b} {
    set t1 [[$a get_source_type $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    set t2 [[$b get_source_type $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    if {[set z [string compare $t1 $t2]] != 0} {
        return $z
    }
    set t1 [[$a get_target_type $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    set t2 [[$b get_target_type $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    if {[set z [string compare $t1 $t2]] != 0} {
        return $z
    }
    set c1 [[$a get_target_class $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    set c2 [[$b get_target_class $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    string compare $c1 $c2
}
namespace eval Apol_RBAC {
    variable vals
    variable widgets
}
proc Apol_RBAC::create {tab_name nb} {
    variable vals
    variable widgets
    _initializeVars
    set frame [$nb insert end $tab_name -text "RBAC Rules"]
    set topf [frame $frame.top]
    set bottomf [frame $frame.bottom]
    pack $topf -expand 0 -fill both -pady 2
    pack $bottomf -expand 1 -fill both -pady 2
    set rsbox [TitleFrame $topf.rs -text "Rule Selection"]
    set obox [TitleFrame $topf.opts -text "Search Options"]
    set dbox [TitleFrame $bottomf.results -text "RBAC Rules Display"]
    pack $rsbox -side left -expand 0 -fill both -padx 2
    pack $obox -side left -expand 1 -fill both -padx 2
    pack $dbox -expand 1 -fill both -padx 2
    set rs [$rsbox getframe]
    radiobutton $rs.allow -text allow -value allow \
        -variable Apol_RBAC::vals(rule_selection)
    radiobutton $rs.trans -text role_transition -value trans \
        -variable Apol_RBAC::vals(rule_selection)
    radiobutton $rs.both -text "allow and role_transition" -value both \
        -variable Apol_RBAC::vals(rule_selection)
    trace add variable Apol_RBAC::vals(rule_selection) write \
        [list Apol_RBAC::_ruleChanged]
    pack $rs.allow $rs.trans $rs.both -side top -anchor w
    set widgets(options_pm) [PagesManager [$obox getframe].opts]
    _allowCreate [$widgets(options_pm) add allow]
    _transCreate [$widgets(options_pm) add trans]
    _bothCreate [$widgets(options_pm) add both]
    trace add variable Apol_RBAC::vals(source:which) write Apol_RBAC::_toggleRoleBox
    $widgets(options_pm) compute_size
    pack $widgets(options_pm) -expand 1 -fill both -side left
    $widgets(options_pm) raise allow
    set ok [button [$obox getframe].ok -text OK -width 6 -command Apol_RBAC::_searchRBACs]
    pack $ok -side right -padx 5 -pady 5 -anchor ne
    set widgets(results) [Apol_Widget::makeSearchResults [$dbox getframe].results]
    pack $widgets(results) -expand yes -fill both
    return $frame
}
proc Apol_RBAC::open {ppath} {
    variable vals
    variable widgets
    $widgets(allow:source) configure -values $Apol_Roles::role_list
    $widgets(allow:target) configure -values $Apol_Roles::role_list
    $widgets(trans:source) configure -values $Apol_Roles::role_list
    $widgets(trans:default) configure -values $Apol_Roles::role_list
    $widgets(both:source) configure -values $Apol_Roles::role_list
    set vals(target_type:types) $vals(target_type:types)
    set vals(rule_selection) allow
}
proc Apol_RBAC::close {} {
    variable widgets
    _initializeVars
    $widgets(allow:source) configure -values {}
    $widgets(allow:target) configure -values {}
    $widgets(trans:source) configure -values {}
    $widgets(trans:target) configure -values {}
    $widgets(trans:default) configure -values {}
    $widgets(both:source) configure -values {}
}
proc Apol_RBAC::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_RBAC::_initializeVars {} {
    variable vals
    array set vals {
        rule_selection allow
        source:use 0
        source:sym {}
        source:which source
        target_role:use 0
        target_role:sym {}
        target_type:use 0
        target_type:sym {}
        target_type:types 1
        target_type:attribs 0
        default:use 0
        default:sym {}
    }
}
proc Apol_RBAC::_allowCreate {a_f} {
    variable vals
    variable widgets
    set source [frame $a_f.source]
    set source_cb [checkbutton $source.enable -text "Source role" \
                       -variable Apol_RBAC::vals(source:use)]
    set widgets(allow:source) [ComboBox $source.cb -width 20 -state disabled \
                                   -entrybg $ApolTop::default_bg_color \
                                   -textvariable Apol_RBAC::vals(source:sym) \
                                   -helptext "Type or select a role" -autopost 1]
    set which_fm [frame $source.which]
    set which_source [radiobutton $which_fm.source \
                          -text "As source" -state disabled \
                          -variable Apol_RBAC::vals(source:which) \
                          -value source]
    set which_any [radiobutton $which_fm.any \
                       -text "As source or target" -state disabled \
                       -variable Apol_RBAC::vals(source:which) \
                       -value either]
    trace add variable Apol_RBAC::vals(source:use) write \
        [list Apol_RBAC::_toggleCheckbutton $widgets(allow:source) [list $which_source $which_any]]
    pack $which_source $which_any -side top -anchor w
    pack $source_cb -side top -anchor w
    pack $widgets(allow:source) -side top -expand 0 -fill x -padx 4
    pack $which_fm -anchor w -padx 8
    pack $source -side left -padx 4 -pady 2 -expand 0 -anchor nw
    set target [frame $a_f.target]
    set widgets(allow:target_cb) [checkbutton $target.enable -text "Target role" \
                                      -variable Apol_RBAC::vals(target_role:use)]
    set widgets(allow:target) [ComboBox $target.cb -width 20 -state disabled \
                                   -entrybg $ApolTop::default_bg_color \
                                   -textvariable Apol_RBAC::vals(target_role:sym) \
                                   -helptext "Type or select a role" -autopost 1]
    trace add variable Apol_RBAC::vals(target_role:use) write \
        [list Apol_RBAC::_toggleCheckbutton $widgets(allow:target) {}]
    pack $widgets(allow:target_cb) -side top -anchor w
    pack $widgets(allow:target) -side top -expand 0 -fill x -padx 4
    pack $target -side left -padx 4 -pady 2 -expand 0 -fill y
}
proc Apol_RBAC::_transCreate {t_f} {
    variable vals
    variable widgets
    set source [frame $t_f.source]
    set source_cb [checkbutton $source.enable -text "Source role" \
                       -variable Apol_RBAC::vals(source:use)]
    set widgets(trans:source) [ComboBox $source.cb -width 20 -state disabled \
                                        -entrybg $ApolTop::default_bg_color \
                                        -textvariable Apol_RBAC::vals(source:sym) \
                                        -helptext "Type or select a role" -autopost 1]
    set which_fm [frame $source.which]
    set which_source [radiobutton $which_fm.source \
                          -text "As source" -state disabled \
                          -variable Apol_RBAC::vals(source:which) \
                          -value source]
    set which_any [radiobutton $which_fm.any \
                       -text "As source or default" -state disabled \
                       -variable Apol_RBAC::vals(source:which) \
                       -value either]
    trace add variable Apol_RBAC::vals(source:use) write \
        [list Apol_RBAC::_toggleCheckbutton $widgets(trans:source) [list $which_source $which_any]]
    pack $which_source $which_any -side top -anchor w
    pack $source_cb -side top -anchor w
    pack $widgets(trans:source) -side top -expand 0 -fill x -padx 4
    pack $which_fm -anchor w -padx 8
    pack $source -side left -padx 4 -pady 2 -expand 0 -anchor nw
    set target [frame $t_f.target]
    set target_cb [checkbutton $target.enable -text "Target type" \
                       -variable Apol_RBAC::vals(target_type:use)]
    set widgets(trans:target) [ComboBox $target.cb -width 20 -state disabled \
                                   -entrybg $ApolTop::default_bg_color \
                                   -textvariable Apol_RBAC::vals(target_type:sym) \
                                   -helptext "Type or select a type/attribute" -autopost 1]
    set ta_frame [frame $target.ta]
    set types [checkbutton $ta_frame.types -text "Types" -state disabled \
                   -variable Apol_RBAC::vals(target_type:types)]
    set attribs [checkbutton $ta_frame.attribs -text "Attribs" -state disabled \
                   -variable Apol_RBAC::vals(target_type:attribs)]
    $types configure -command [list Apol_RBAC::_toggleTAPushed $types]
    $attribs configure -command [list Apol_RBAC::_toggleTAPushed $attribs]
    trace add variable Apol_RBAC::vals(target_type:types) write \
        [list Apol_RBAC::_toggleTASym]
    trace add variable Apol_RBAC::vals(target_type:attribs) write \
        [list Apol_RBAC::_toggleTASym]
    pack $types $attribs -side left -padx 2
    trace add variable Apol_RBAC::vals(target_type:use) write \
        [list Apol_RBAC::_toggleCheckbutton $widgets(trans:target) [list $types $attribs]]
    pack $target_cb -side top -anchor w
    pack $widgets(trans:target) -side top -expand 0 -fill x -padx 4
    pack $ta_frame -anchor center -pady 2
    pack $target -side left -padx 4 -pady 2 -expand 0 -fill y
    set default [frame $t_f.default]
    set widgets(trans:default_cb) [checkbutton $default.enable -text "Default role" \
                                       -variable Apol_RBAC::vals(default:use)]
    set widgets(trans:default) [ComboBox $default.cb -width 20 -state disabled \
                                   -entrybg $ApolTop::default_bg_color \
                                   -textvariable Apol_RBAC::vals(default:sym) \
                                   -helptext "Type or select a role" -autopost 1]
    trace add variable Apol_RBAC::vals(default:use) write \
        [list Apol_RBAC::_toggleCheckbutton $widgets(trans:default) {}]
    pack $widgets(trans:default_cb) -side top -anchor w
    pack $widgets(trans:default) -side top -expand 0 -fill x -padx 4
    pack $default -side left -padx 4 -pady 2 -expand 0 -fill y
}
proc Apol_RBAC::_bothCreate {b_f} {
    variable vals
    variable widgets
    set source [frame $b_f.source]
    set source_cb [checkbutton $source.enable -text "Source role" \
                       -variable Apol_RBAC::vals(source:use)]
    set widgets(both:source) [ComboBox $source.cb -width 20 -state disabled \
                                   -entrybg $ApolTop::default_bg_color \
                                   -textvariable Apol_RBAC::vals(source:sym) \
                                   -helptext "Type or select a role" -autopost 1]
    set which_fm [frame $source.which]
    set which_source [radiobutton $which_fm.source \
                          -text "As source" -state disabled \
                          -variable Apol_RBAC::vals(source:which) \
                          -value source]
    set which_any [radiobutton $which_fm.any \
                       -text "Any field" -state disabled \
                       -variable Apol_RBAC::vals(source:which) \
                       -value either]
    trace add variable Apol_RBAC::vals(source:use) write \
        [list Apol_RBAC::_toggleCheckbutton $widgets(both:source) [list $which_source $which_any]]
    pack $which_source $which_any -side top -anchor w
    pack $source_cb -side top -anchor w
    pack $widgets(both:source) -side top -expand 0 -fill x -padx 4
    pack $which_fm -anchor w -padx 8
    pack $source -side left -padx 4 -pady 2 -expand 0 -anchor nw
}
proc Apol_RBAC::_toggleCheckbutton {cb w name1 name2 ops} {
    variable vals
    if {$vals($name2)} {
        $cb configure -state normal -entrybg white
        foreach x $w {
            $x configure -state normal
        }
    } else {
        $cb configure -state disabled -entrybg $ApolTop::default_bg_color
        foreach x $w {
            $x configure -state disabled
        }
    }
    _maybeEnableTargetRole
    _maybeEnableDefaultRole
}
proc Apol_RBAC::_toggleRoleBox {name1 name2 ops} {
    _maybeEnableTargetRole
    _maybeEnableDefaultRole
}
proc Apol_RBAC::_maybeEnableTargetRole {} {
    variable vals
    variable widgets
    if {$vals(source:use) && $vals(source:which) == "either"} {
        $widgets(allow:target_cb) configure -state disabled
        $widgets(allow:target) configure -state disabled -entrybg $ApolTop::default_bg_color
    } else {
        $widgets(allow:target_cb) configure -state normal
        set vals(target_role:use) $vals(target_role:use)
    }
}
proc Apol_RBAC::_maybeEnableDefaultRole {} {
    variable vals
    variable widgets
    if {$vals(source:use) && $vals(source:which) == "either"} {
        $widgets(trans:default_cb) configure -state disabled
        $widgets(trans:default) configure -state disabled -entrybg $ApolTop::default_bg_color
    } else {
        $widgets(trans:default_cb) configure -state normal
        set vals(default:use) $vals(default:use)
    }
}
proc Apol_RBAC::_toggleTASym {name1 name2 ops} {
    variable vals
    variable widgets
    if {!$vals(target_type:types) && !$vals(target_type:attribs)} {
        return
    }
    if {$vals(target_type:types) && $vals(target_type:attribs)} {
        set items [lsort [concat [Apol_Types::getTypes] [Apol_Types::getAttributes]]]
    } elseif {$vals(target_type:types)} {
        set items [Apol_Types::getTypes]
    } else {
        set items [Apol_Types::getAttributes]
    }
    $widgets(trans:target) configure -values $items
}
proc Apol_RBAC::_toggleTAPushed {cb} {
    variable vals
    if {!$vals(target_type:types) && !$vals(target_type:attribs)} {
        $cb select
    }
}
proc Apol_RBAC::_ruleChanged {name1 name2 ops} {
    variable vals
    variable widgets
    Apol_Widget::clearSearchResults $widgets(results)
    $widgets(options_pm) raise $vals(rule_selection)
}
proc Apol_RBAC::_searchRBACs {} {
    variable vals
    variable widgets
    Apol_Widget::clearSearchResults $widgets(results)
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
        return
    }
    set raq {}
    set rtq {}
    if {$vals(rule_selection) == "allow" || $vals(rule_selection) == "both"} {
        set raq [new_apol_role_allow_query_t]
    }
    if {$vals(rule_selection) == "trans" || $vals(rule_selection) == "both"} {
        set rtq [new_apol_role_trans_query_t]
    }
    set source_sym {}
    set is_any 0
    if {$vals(source:use)} {
        if {$vals(source:sym) == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No source role selected."
            return
        }
        if {$vals(source:which) == "either"} {
            set is_any 1
        }
        set source_sym $vals(source:sym)
    }
    set target_role {}
    set target_type {}
    if {$vals(rule_selection) == "allow" && $vals(target_role:use) && \
            (!$vals(source:use) || $vals(source:which) != "either")} {
        if {$vals(target_role:sym) == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No target role selected."
            return
        }
        set target_role $vals(target_role:sym)
    }
    if {$vals(rule_selection) == "trans" && $vals(target_type:use)} {
        if {$vals(target_type:sym) == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No target type selected."
            return
        }
        set target_type $vals(target_type:sym)
    }
    set default_role {}
    if {$vals(rule_selection) == "trans" && $vals(default:use) && \
            (!$vals(source:use) || $vals(source:which) != "either")} {
        if {$vals(default:sym) == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No default role selected."
            return
        }
        set default_role $vals(default:sym)
    }
    set role_allows {}
    if {$raq != {}} {
        $raq set_source $::ApolTop::policy $source_sym
        $raq set_source_any $::ApolTop::policy $is_any
        $raq set_target $::ApolTop::policy $target_role
        set v [$raq run $::ApolTop::policy]
        $raq -acquire
        $raq -delete
        set role_allows [role_allow_vector_to_list $v]
        $v -acquire
        $v -delete
    }
    set role_trans {}
    if {$rtq != {}} {
        $rtq set_source $::ApolTop::policy $source_sym
        $rtq set_source_any $::ApolTop::policy $is_any
        $rtq set_target $::ApolTop::policy $target_type 0
        $rtq set_default $::ApolTop::policy $default_role
        set v [$rtq run $::ApolTop::policy]
        $rtq -acquire
        $rtq -delete
        set role_trans [role_trans_vector_to_list $v]
        $v -acquire
        $v -delete
    }
    set num_results [expr {[llength $role_allows] + [llength $role_trans]}]
    if {$num_results == 0} {
        set text "Search returned no results."
    } else {
        set text "$num_results rule"
        if {$num_results != 1} {
            append text s
        }
        append text " match the search criteria.\n\n"
    }
    foreach r [lsort -command _role_allow_sort $role_allows] {
        append text "[_render_role_allow $r]\n"
    }
    foreach r [lsort -command _role_trans_sort $role_trans] {
        append text "[_render_role_trans $r]\n"
    }
    Apol_Widget::appendSearchResultText $widgets(results) $text
}
proc Apol_RBAC::_render_role_allow {qpol_role_allow_datum} {
    apol_role_allow_render $::ApolTop::policy $qpol_role_allow_datum
}
proc Apol_RBAC::_render_role_trans {qpol_role_trans_datum} {
    apol_role_trans_render $::ApolTop::policy $qpol_role_trans_datum
}
proc Apol_RBAC::_role_allow_sort {a b} {
    set r1 [[$a get_source_role $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    set r2 [[$b get_source_role $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    if {[set z [string compare $r1 $r2]] != 0} {
        return $z
    }
    set r1 [[$a get_target_role $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    set r2 [[$b get_target_role $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    string compare $r1 $r2
}
proc Apol_RBAC::_role_trans_sort {a b} {
    set r1 [[$a get_source_role $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    set r2 [[$b get_source_role $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    if {[set z [string compare $r1 $r2]] != 0} {
        return $z
    }
    set r1 [[$a get_target_type $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    set r2 [[$b get_target_type $::ApolTop::qpolicy] get_name $::ApolTop::qpolicy]
    string compare $r1 $r2
}
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 -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]
        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
            }
        }
    }
    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
}
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
}
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
    }
}
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]
    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 == {}} {
            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)
    }
}
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
}
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 {
            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}
            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
}
namespace eval Apol_Roles {
    variable widgets
    variable opts
    variable role_list {}
}
proc Apol_Roles::create {tab_name nb} {
    variable widgets
    variable opts
    _initializeVars
    set frame [$nb insert end $tab_name -text "Roles"]
    set pw [PanedWindow $frame.pw -side top]
    set leftf [$pw add -weight 0]
    set rightf [$pw add -weight 1]
    pack $pw -fill both -expand yes
    set rolebox [TitleFrame $leftf.rolebox -text "Roles"]
    set s_optionsbox [TitleFrame $rightf.obox -text "Search Options"]
    set resultsbox [TitleFrame $rightf.rbox -text "Search Results"]
    pack $rolebox -fill both -expand yes
    pack $s_optionsbox -padx 2 -fill both -expand 0
    pack $resultsbox -padx 2 -fill both -expand yes
    set rlistbox [Apol_Widget::makeScrolledListbox [$rolebox getframe].lb \
                      -width 20 -listvar Apol_Roles::role_list]
    Apol_Widget::setListboxCallbacks $rlistbox \
        {{"Display Role Info" {Apol_Roles::_popupRoleInfo role}}}
    pack $rlistbox -fill both -expand yes
    set ofm [$s_optionsbox getframe]
    set lfm [frame $ofm.to]
    set cfm [frame $ofm.co]
    pack $lfm $cfm -side left -anchor nw -padx 4 -pady 2
    radiobutton $lfm.all_info -text "All information" \
        -variable Apol_Roles::opts(showSelection) -value all
    radiobutton $lfm.names_only -text "Names only" \
        -variable Apol_Roles::opts(showSelection) -value names
    pack $lfm.all_info $lfm.names_only -anchor w -padx 5 -pady 4
    set cb_type [checkbutton $cfm.cb -variable Apol_Roles::opts(useType) -text "Type"]
    set widgets(combo_types) [Apol_Widget::makeTypeCombobox $cfm.combo_types]
    Apol_Widget::setTypeComboboxState $widgets(combo_types) disabled
    trace add variable Apol_Roles::opts(useType) write \
        [list Apol_Roles::_toggleTypeCombobox $widgets(combo_types)]
    pack $cb_type -anchor w
    pack $widgets(combo_types) -anchor w -padx 4
    button $ofm.ok -text OK -width 6 -command Apol_Roles::_searchRoles
    pack $ofm.ok -side top -anchor e -pady 5 -padx 5
    set widgets(results) [Apol_Widget::makeSearchResults [$resultsbox getframe].sw]
    pack $widgets(results) -expand 1 -fill both
    return $frame
}
proc Apol_Roles::open {ppath} {
    set q [new_apol_role_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    variable role_list [lsort [role_vector_to_list $v]]
    $v -acquire
    $v -delete
    variable widgets
    Apol_Widget::resetTypeComboboxToPolicy $widgets(combo_types)
}
proc Apol_Roles::close {} {
    variable widgets
    variable opts
    variable role_list {}
    _initializeVars
    Apol_Widget::clearTypeCombobox $widgets(combo_types)
    Apol_Widget::clearSearchResults $widgets(results)
}
proc Apol_Roles::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_Roles::getRoles {} {
    variable role_list
    set role_list
}
proc Apol_Roles::_initializeVars {} {
    variable opts
    array set opts {
        useType 0
        showSelection all
    }
}
proc Apol_Roles::_toggleTypeCombobox {path name1 name2 op} {
    Apol_Widget::setTypeComboboxState $path $Apol_Roles::opts(useType)
}
proc Apol_Roles::_popupRoleInfo {which role} {
    Apol_Widget::showPopupText $role [_renderRole $role 1]
}
proc Apol_Roles::_searchRoles {} {
    variable widgets
    variable opts
    Apol_Widget::clearSearchResults $widgets(results)
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
        return
    }
    if {$opts(useType)} {
        set type [lindex [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(combo_types)] 0]
        if {$type == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No type selected."
            return
        }
    } else {
        set type {}
    }
    if {$opts(showSelection) == "names"} {
        set show_all 0
    } else {
        set show_all 1
    }
    set q [new_apol_role_query_t]
    $q set_type $::ApolTop::policy $type
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set roles_data [role_vector_to_list $v]
    $v -acquire
    $v -delete
    set text "ROLES:\n"
    if {[llength $roles_data] == 0} {
        append text "Search returned no results."
    } else {
        foreach r [lsort $roles_data] {
            append text "\n[_renderRole $r $show_all]"
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) $text
}
proc Apol_Roles::_renderRole {role_name show_all} {
    set qpol_role_datum [new_qpol_role_t $::ApolTop::qpolicy $role_name]
    if {!$show_all} {
        return $role_name
    }
    set i [$qpol_role_datum get_type_iter $::ApolTop::qpolicy]
    set types {}
    while {![$i end]} {
        set qpol_type_datum [qpol_type_from_void [$i get_item]]
        lappend types [$qpol_type_datum get_name $::ApolTop::qpolicy]
        $i next
    }
    $i -acquire
    $i -delete
    set text "$role_name ([llength $types] type"
    if {[llength $types] != 1} {
        append text "s"
    }
    append text ")\n"
    foreach t [lsort -dictionary $types] {
        append text "    $t\n"
    }
    return $text
}
namespace eval Apol_TE {
    variable vals
    variable widgets
    variable tabs
    variable enabled
}
proc Apol_TE::create {tab_name nb} {
    variable vals
    variable widgets
    _initializeVars
    set frame [$nb insert end $tab_name -text "TE Rules"]
    set pw [PanedWindow $frame.pw -side left -weights extra]
    set topf [$pw add -weight 0]
    set bottomf [$pw add -weight 1]
    pack $pw -expand 1 -fill both
    set top_leftf [frame $topf.tl]
    set widgets(search_opts) [NoteBook $topf.nb]
    set abox [frame $topf.abox]
    pack $top_leftf -side left -expand 0 -fill y
    pack $widgets(search_opts) -side left -expand 1 -fill both -padx 10
    pack $abox -side right -fill y -padx 5
    set rsbox [TitleFrame $top_leftf.rsbox -text "Rule Selection"]
    set oobox [TitleFrame $top_leftf.oobox -text "Search Options"]
    set rbox [TitleFrame $bottomf.rbox -text "Type Enforcement Rules Display"]
    pack $rsbox -side top -expand 0 -fill both
    pack $oobox -side top -expand 1 -fill both -pady 2
    pack $rbox -expand yes -fill both -padx 2
    set fm_rules [$rsbox getframe]
    set allow [checkbutton $fm_rules.allow -text "allow" \
                   -onvalue $::QPOL_RULE_ALLOW -offvalue 0 \
                   -variable Apol_TE::vals(rs:avrule_allow)]
    set neverallow [checkbutton $fm_rules.neverallow -text "neverallow" \
                        -onvalue $::QPOL_RULE_NEVERALLOW -offvalue 0 \
                        -variable Apol_TE::vals(rs:avrule_neverallow)]
    set auditallow [checkbutton $fm_rules.auditallow -text "auditallow" \
                        -onvalue $::QPOL_RULE_AUDITALLOW -offvalue 0 \
                        -variable Apol_TE::vals(rs:avrule_auditallow)]
    set dontaudit [checkbutton $fm_rules.dontaudit -text "dontaudit" \
                       -onvalue $::QPOL_RULE_DONTAUDIT -offvalue 0 \
                       -variable Apol_TE::vals(rs:avrule_dontaudit)]
    set type_transition [checkbutton $fm_rules.type_transition -text "type_trans" \
                             -onvalue $::QPOL_RULE_TYPE_TRANS -offvalue 0 \
                             -variable Apol_TE::vals(rs:type_transition)]
    set type_member [checkbutton $fm_rules.type_member -text "type_member" \
                         -onvalue $::QPOL_RULE_TYPE_MEMBER -offvalue 0 \
                         -variable Apol_TE::vals(rs:type_member)]
    set type_change [checkbutton $fm_rules.type_change -text "type_change" \
                         -onvalue $::QPOL_RULE_TYPE_CHANGE -offvalue 0 \
                         -variable Apol_TE::vals(rs:type_change)]
    grid $allow $type_transition -sticky w -padx 2
    grid $auditallow $type_member -sticky w -padx 2
    grid $dontaudit $type_change -sticky w -padx 2
    grid $neverallow x -sticky w -padx 2
    foreach x {allow neverallow auditallow dontaudit type_transition type_member type_change} {
        trace add variable Apol_TE::vals(rs:$x) write \
            [list Apol_TE::_toggle_rule_selection]
    }
    set fm_options [$oobox getframe]
    set enabled [checkbutton $fm_options.enabled -text "Search only enabled rules" \
                     -variable Apol_TE::vals(oo:enabled)]
    set regexp [checkbutton $fm_options.regex -text "Search using regular expression" \
                    -variable Apol_TE::vals(oo:regexp)]
    pack $enabled $regexp -expand 0 -fill none -anchor w
    _createTypesAttribsTab
    _createClassesPermsTab
    set widgets(new) [button $abox.new -text "New Search" -width 12 \
                       -command [list Apol_TE::_search_terules new]]
    set widgets(update) [button $abox.update -text "Update Search" -width 12 -state disabled \
                             -command [list Apol_TE::_search_terules update]]
    set widgets(reset) [button $abox.reset -text "Reset Criteria" -width 12 \
                            -command Apol_TE::_reset]
    pack $widgets(new) $widgets(update) $widgets(reset) \
        -side top -pady 5 -padx 5 -anchor ne
    $widgets(search_opts) compute_size
    set popupTab_Menu [menu .popup_terules -tearoff 0]
    set tab_menu_callbacks \
        [list {"Close Tab" Apol_TE::_delete_results} \
             {"Rename Tab" Apol_TE::_display_rename_tab_dialog}]
    set widgets(results) [NoteBook [$rbox getframe].results]
    $widgets(results) bindtabs <Button-1> Apol_TE::_switch_to_tab
    $widgets(results) bindtabs <Button-3> \
        [list ApolTop::popup \
             %W %x %y $popupTab_Menu $tab_menu_callbacks]
    set close [button [$rbox getframe].close -text "Close Tab" \
                   -command Apol_TE::_delete_current_results]
    pack $widgets(results) -expand 1 -fill both -padx 4
    pack $close -expand 0 -fill x -padx 4 -pady 2
    _initializeVars
    return $frame
}
proc Apol_TE::open {ppath} {
    _initializeVars
    _initializeWidgets
    _initializeTabs
    variable vals
    variable enabled
    set vals(cp:classes) [Apol_Class_Perms::getClasses]
    set enabled(cp:classes) 1
    set enabled(cp:perms) 1
}
proc Apol_TE::close {} {
    _initializeTabs
    _initializeWidgets
    _initializeVars
    set enabled(cp:perms) 1
}
proc Apol_TE::getTextWidget {} {
    variable widgets
    variable tabs
    if {[$widgets(results) pages] != {}} {
        set raisedPage [$widgets(results) raise]
        if {$raisedPage != {}} {
            return $tabs($raisedPage).tb
	}
    }
    return {}
}
proc Apol_TE::save_query_options {file_channel query_file} {
    variable vals
    foreach {key value} [array get vals] {
        if {$key != "cp:classes" && $key != "cp:perms"} {
            puts $file_channel "$key $value"
        }
    }
}
proc Apol_TE::load_query_options {file_channel} {
    variable vals
    variable widgets
    variable enabled
    _initializeVars
    set classes_selected {}
    set perms_selected {}
    while {[gets $file_channel line] >= 0} {
        set line [string trim $line]
        if {$line == {} || [string index $line 0] == "#"} {
            continue
        }
        regexp -line -- {^(\S+)( (.+))?} $line -> key --> value
        if {$key == "cp:classes_selected"} {
            set classes_selected $value
        } elseif {$key == "cp:perms_selected"} {
            set perms_selected $value
        } else {
            set vals($key) $value
        }
    }
    _initializeWidgets
    set vals(cp:classes) [Apol_Class_Perms::getClasses]
    set enabled(cp:classes) 1
    set enabled(cp:perms) 1
    _toggle_perms_toshow -> -> reset
    set unknowns {}
    set vals(cp:classes_selected) {}
    foreach class $classes_selected {
        if {[set i [lsearch $vals(cp:classes) $class]] >= 0} {
            $widgets(cp:classes) selection set $i
            lappend vals(cp:classes_selected) $class
        } else {
            lappend unknowns $class
        }
    }
    if {[llength $unknowns] > 0} {
        tk_messageBox -icon warning -type ok -title "Open Apol Query" \
            -message "The following object classes do not exist in the currently loaded policy and were ignored:\n\n[join $unknowns ", "]" \
            -parent .
    }
    _toggle_perms_toshow {} {} {}
    set unknowns {}
    set vals(cp:perms_selected) {}
    foreach perm $perms_selected {
        if {[set i [lsearch $vals(cp:perms) $perm]] >= 0} {
            $widgets(cp:perms) selection set $i
            lappend vals(cp:perms_selected) $perm
        } else {
            lappend unknowns $perm
        }
    }
    if {[llength $unknowns] > 0} {
        tk_messageBox -icon warning -type ok -title "Open Apol Query" \
            -message "The following permissions do not exist in the currently loaded policy and were ignored:\n\n[join $unknowns ", "]" \
            -parent $parentDlg
    }
}
proc Apol_TE::_initializeVars {} {
    variable vals
    array set vals [list \
                        rs:avrule_allow $::QPOL_RULE_ALLOW \
                        rs:avrule_neverallow 0 \
                        rs:avrule_auditallow $::QPOL_RULE_AUDITALLOW \
                        rs:avrule_dontaudit $::QPOL_RULE_DONTAUDIT \
                        rs:type_transition $::QPOL_RULE_TYPE_TRANS \
                        rs:type_member $::QPOL_RULE_TYPE_MEMBER \
                        rs:type_change $::QPOL_RULE_TYPE_CHANGE \
                        ta:source_sym,types $::APOL_QUERY_SYMBOL_IS_TYPE \
                        ta:target_sym,types $::APOL_QUERY_SYMBOL_IS_TYPE \
                        ta:default_sym,types $::APOL_QUERY_SYMBOL_IS_TYPE \
                       ]
    array set vals {
        oo:enabled 0
        oo:regexp 0
        ta:use_source 0
        ta:source_indirect 1
        ta:source_which source
        ta:source_sym,attribs 0
        ta:source_sym {}
        ta:use_target 0
        ta:target_indirect 1
        ta:target_sym,attribs 0
        ta:target_sym {}
        ta:use_default 0
        ta:default_sym,attribs 0
        ta:default_sym {}
        cp:classes {}
        cp:classes_selected {}
        cp:perms {}
        cp:perms_selected {}
        cp:perms_toshow all
        cp:perms_matchall 0
    }
    variable enabled
    array set enabled {
        ta:use_source 1
        ta:use_target 1
        ta:use_default 1
        cp:classes 0
        cp:perms 0
    }
}
proc Apol_TE::_initializeTabs {} {
    variable widgets
    variable tabs
    array set tabs {
        next_result_id 1
    }
    foreach p [$widgets(results) pages 0 end] {
        _delete_results $p
    }
}
proc Apol_TE::_initializeWidgets {} {
    variable widgets
    $widgets(search_opts) raise typeattrib
    $widgets(cp:classes) selection clear 0 end
    $widgets(cp:perms) selection clear 0 end
}
proc Apol_TE::_createTypesAttribsTab {} {
    variable vals
    variable widgets
    variable enabled
    set ta_tab [$widgets(search_opts) insert end typeattrib -text "Types/Attributes"]
    set fm_source [frame $ta_tab.source]
    set fm_target [frame $ta_tab.target]
    set fm_default [frame $ta_tab.default]
    grid $fm_source $fm_target $fm_default -padx 4 -sticky ewns
    foreach i {0 1 2} {
        grid columnconfigure $ta_tab $i -weight 1 -uniform 1
    }
    grid rowconfigure $ta_tab 0 -weight 1
    _create_ta_box source $fm_source "Source type/attribute" 1 1 1
    _create_ta_box target $fm_target "Target type/attribute" 1 0 1
    _create_ta_box default $fm_default "Default type" 0 0 0
    $widgets(search_opts) raise typeattrib
}
proc Apol_TE::_create_ta_box {prefix f title has_indirect has_which has_attribs} {
    variable vals
    variable widgets
    set widgets(ta:use_${prefix}) [checkbutton $f.use -text $title \
                                       -variable Apol_TE::vals(ta:use_${prefix})]
    pack $widgets(ta:use_${prefix}) -side top -anchor w
    trace add variable Apol_TE::vals(ta:use_${prefix}) write \
        [list Apol_TE::_toggle_ta_box $prefix]
    set w {}
    if {$has_attribs} {
        set helptext "Type or select a type or attribute"
    } else {
        set helptext "Type or select a type"
    }
    set widgets(ta:${prefix}_sym) [ComboBox $f.sym \
                                       -state disabled -entrybg $ApolTop::default_bg_color \
                                       -textvariable Apol_TE::vals(ta:${prefix}_sym) \
                                       -helptext $helptext -autopost 1]
    pack $widgets(ta:${prefix}_sym) -expand 0 -fill x -padx 8
    lappend w $widgets(ta:${prefix}_sym)
    if {$has_attribs} {
        set ta_frame [frame $f.ta]
        pack $ta_frame -expand 0 -anchor center -pady 2
        set types [checkbutton $ta_frame.types -text "Types" -state disabled \
                       -onvalue $::APOL_QUERY_SYMBOL_IS_TYPE -offvalue 0 \
                       -variable Apol_TE::vals(ta:${prefix}_sym,types)]
        set attribs [checkbutton $ta_frame.attribs -text "Attribs" -state disabled \
                         -onvalue $::APOL_QUERY_SYMBOL_IS_ATTRIBUTE -offvalue 0 \
                         -variable Apol_TE::vals(ta:${prefix}_sym,attribs)]
        $types configure -command [list Apol_TE::_toggle_ta_pushed $prefix $types]
        $attribs configure -command [list Apol_TE::_toggle_ta_pushed $prefix $attribs]
        trace add variable Apol_TE::vals(ta:${prefix}_sym,attribs) write \
            [list Apol_TE::_toggle_ta_sym $prefix]
        pack $types $attribs -side left -padx 2
        lappend w $types $attribs
    }
    if {$has_indirect} {
        set indirect [checkbutton $f.indirect -text "Only direct matches" \
                          -state disabled -variable Apol_TE::vals(ta:${prefix}_indirect) \
                          -onvalue 0 -offvalue 1]
        pack $indirect -anchor w -padx 8
        lappend w $indirect
    }
    if {$has_which} {
        set which_fm [frame $f.which]
        set which_source [radiobutton $which_fm.source \
                              -text "As source" -state disabled \
                              -variable Apol_TE::vals(ta:${prefix}_which) \
                              -value source]
        set which_any [radiobutton $which_fm.any \
                           -text "Any" -state disabled \
                           -variable Apol_TE::vals(ta:${prefix}_which) \
                           -value either]
        trace add variable Apol_TE::vals(ta:${prefix}_which) write \
            [list Apol_TE::_toggle_which]
        pack $which_source $which_any -side left -padx 2
        pack $which_fm -anchor w -padx 6
        lappend w $which_source $which_any
    }
    trace add variable Apol_TE::vals(ta:${prefix}_sym,types) write \
            [list Apol_TE::_toggle_ta_sym $prefix]
    set widgets(ta:${prefix}_widgets) $w
    trace add variable Apol_TE::enabled(ta:use_${prefix}) write \
        [list Apol_TE::_toggle_enable_ta ${prefix}]
}
proc Apol_TE::_toggle_rule_selection {name1 name2 op} {
    _maybe_enable_default_type
    _maybe_enable_perms
}
proc Apol_TE::_toggle_ta_box {col name1 name2 op} {
    variable vals
    variable enabled
    if {$col == "source"} {
        _maybe_enable_target_type
        _maybe_enable_default_type
    }
    set enabled(ta:use_${col}) $enabled(ta:use_${col})
}
proc Apol_TE::_toggle_which {name1 name2 op} {
    _maybe_enable_target_type
    _maybe_enable_default_type
}
proc Apol_TE::_maybe_enable_target_type {} {
    variable vals
    variable enabled
    set any_set 0
    if {$enabled(ta:use_source) && $vals(ta:use_source) && $vals(ta:source_which) == "either"} {
        set any_set 1
    }
    if {!$any_set} {
        set enabled(ta:use_target) 1
    } else {
        set enabled(ta:use_target) 0
    }
}
proc Apol_TE::_maybe_enable_default_type {} {
    variable vals
    variable enabled
    set typerule_set 0
    set any_set 0
    foreach x {type_transition type_member type_change} {
        if {$vals(rs:$x)} {
            set typerule_set 1
            break
        }
    }
    if {$enabled(ta:use_source) && $vals(ta:use_source) && $vals(ta:source_which) == "either"} {
        set any_set 1
    }
    if {$typerule_set && !$any_set} {
        set enabled(ta:use_default) 1
    } else {
        set enabled(ta:use_default) 0
    }
}
proc Apol_TE::_toggle_enable_ta {col name1 name2 op} {
    variable vals
    variable widgets
    variable enabled
    if {$enabled(ta:use_${col})} {
        $widgets(ta:use_${col}) configure -state normal
    } else {
        $widgets(ta:use_${col}) configure -state disabled
    }
    if {$enabled(ta:use_${col}) && $vals(ta:use_${col})} {
        foreach w $widgets(ta:${col}_widgets) {
            $w configure -state normal
        }
        $widgets(ta:${col}_sym) configure -entrybg white
    } else {
        foreach w $widgets(ta:${col}_widgets) {
            $w configure -state disabled
        }
        $widgets(ta:${col}_sym) configure -entrybg $ApolTop::default_bg_color
    }
    if {($enabled(ta:use_source) && $vals(ta:use_source)) || \
            ($enabled(ta:use_target) && $vals(ta:use_target)) || \
            ($enabled(ta:use_default) && $vals(ta:use_default))} {
        $widgets(search_opts) itemconfigure typeattrib -text "Types/Attributes *"
    } else {
        $widgets(search_opts) itemconfigure typeattrib -text "Types/Attributes"
    }
}
proc Apol_TE::_toggle_ta_sym {col name1 name2 op} {
    variable vals
    variable widgets
    if {!$vals(ta:${col}_sym,types) && !$vals(ta:${col}_sym,attribs)} {
        return
    }
    if {$vals(ta:${col}_sym,types) && $vals(ta:${col}_sym,attribs)} {
        set items [lsort [concat [Apol_Types::getTypes] [Apol_Types::getAttributes]]]
    } elseif {$vals(ta:${col}_sym,types)} {
        set items [Apol_Types::getTypes]
    } else {
        set items [Apol_Types::getAttributes]
    }
    $widgets(ta:${col}_sym) configure -values $items
}
proc Apol_TE::_toggle_ta_pushed {col cb} {
    variable vals
    if {!$vals(ta:${col}_sym,types) && !$vals(ta:${col}_sym,attribs)} {
        $cb select
    }
}
proc Apol_TE::_createClassesPermsTab {} {
    variable vals
    variable widgets
    variable enabled
    set objects_tab [$widgets(search_opts) insert end classperms -text "Classes/Permissions"]
    set fm_objs [TitleFrame $objects_tab.objs -text "Object Classes"]
    set fm_perms [TitleFrame $objects_tab.perms -text "AV Rule Permissions"]
    pack $fm_objs -side left -expand 0 -fill both -padx 2 -pady 2
    pack $fm_perms -side left -expand 1 -fill both -padx 2 -pady 2
    set sw [ScrolledWindow [$fm_objs getframe].sw -auto both]
    set widgets(cp:classes) [listbox [$sw getframe].lb -height 5 -width 24 \
                                 -highlightthickness 0 -selectmode multiple \
                                 -exportselection 0 -state disabled \
                                 -bg $ApolTop::default_bg_color \
                                 -listvar Apol_TE::vals(cp:classes)]
    $sw setwidget $widgets(cp:classes)
    update
    grid propagate $sw 0
    bind $widgets(cp:classes) <<ListboxSelect>> \
        [list Apol_TE::_toggle_cp_select classes]
    pack $sw -expand 1 -fill both
    set clear [button [$fm_objs getframe].b -text "Clear" -width 6 -state disabled \
                   -command [list Apol_TE::_clear_cp_listbox $widgets(cp:classes) classes]]
    pack $clear -expand 0 -pady 2
    set widgets(cp:classes_widgets) [list $widgets(cp:classes) $clear]
    set f [$fm_perms getframe]
    set sw [ScrolledWindow $f.sw -auto both]
    set widgets(cp:perms) [listbox [$sw getframe].lb -height 5 -width 24 \
                               -highlightthickness 0 -selectmode multiple \
                               -exportselection 0 -bg white \
                               -listvar Apol_TE::vals(cp:perms)]
    $sw setwidget $widgets(cp:perms)
    update
    grid propagate $sw 0
    bind $widgets(cp:perms) <<ListboxSelect>> \
        [list Apol_TE::_toggle_cp_select perms]
    set clear [button $f.clear -text "Clear" \
                   -command [list Apol_TE::_clear_cp_listbox $widgets(cp:perms) perms]]
    set reverse [button $f.reverse -text "Reverse" \
                     -command [list Apol_TE::_reverse_cp_listbox $widgets(cp:perms)]]
    set perm_opts_f [frame $f.perms]
    set perm_rb_f [frame $perm_opts_f.rb]
    set l [label $perm_rb_f.l -text "Permissions to show:" -state disabled]
    set all [radiobutton $perm_rb_f.all -text "All" \
                       -variable Apol_TE::vals(cp:perms_toshow) -value all]
    set union [radiobutton $perm_rb_f.union -text "All for selected classes" \
                       -variable Apol_TE::vals(cp:perms_toshow) -value union]
    set intersect [radiobutton $perm_rb_f.inter -text "Common to selected classes" \
                       -variable Apol_TE::vals(cp:perms_toshow) -value intersect]
    trace add variable Apol_TE::vals(cp:perms_toshow) write \
        Apol_TE::_toggle_perms_toshow
    pack $l $all $union $intersect -anchor w
    set all_perms [checkbutton $perm_opts_f.all -text "AV rule must have all selected permissions" \
                       -variable Apol_TE::vals(cp:perms_matchall)]
    pack $perm_rb_f $all_perms -anchor w -pady 4 -padx 4
    grid $sw - $perm_opts_f -sticky nsw
    grid $clear $reverse ^ -pady 2 -sticky ew
    grid columnconfigure $f 0 -weight 0 -uniform 1 -pad 2
    grid columnconfigure $f 1 -weight 0 -uniform 1 -pad 2
    grid columnconfigure $f 2 -weight 1
    grid rowconfigure $f 0 -weight 1
    set widgets(cp:perms_widgets) \
        [list $widgets(cp:perms) $clear $reverse $l $all $union $intersect $all_perms]
    trace add variable Apol_TE::vals(cp:classes_selected) write \
        [list Apol_TE::_update_cp_tabname]
    trace add variable Apol_TE::vals(cp:perms_selected) write \
        [list Apol_TE::_update_cp_tabname]
    trace add variable Apol_TE::enabled(cp:classes) write \
        [list Apol_TE::_toggle_enable_cp classes]
    trace add variable Apol_TE::enabled(cp:perms) write \
        [list Apol_TE::_toggle_enable_cp perms]
}
proc Apol_TE::_toggle_enable_cp {prefix name1 name2 op} {
    variable vals
    variable widgets
    variable enabled
    if {$enabled(cp:${prefix})} {
        foreach w $widgets(cp:${prefix}_widgets) {
            $w configure -state normal
        }
        $widgets(cp:${prefix}) configure -bg white
    } else {
        foreach w $widgets(cp:${prefix}_widgets) {
            $w configure -state disabled
        }
        $widgets(cp:${prefix}) configure -bg $ApolTop::default_bg_color
    }
    set vals(cp:${prefix}_selected) $vals(cp:${prefix}_selected)
}
proc Apol_TE::_maybe_enable_perms {} {
    variable vals
    variable enabled
    set avrule_set 0
    foreach x {avrule_allow avrule_neverallow avrule_auditallow avrule_dontaudit} {
        if {$vals(rs:$x)} {
            set avrule_set 1
            break
        }
    }
    if {$avrule_set} {
        set enabled(cp:perms) 1
    } else {
        set enabled(cp:perms) 0
    }
}
proc Apol_TE::_toggle_perms_toshow {name1 name2 op} {
    variable vals
    variable widgets
    if {$vals(cp:perms_toshow) == "all"} {
        if {$op != "update"} {
            set vals(cp:perms) $Apol_Class_Perms::perms_list
            set vals(cp:perms_selected) {}
        }
    } elseif {$vals(cp:perms_toshow) == "union"} {
        set vals(cp:perms) {}
        set vals(cp:perms_selected) {}
        foreach class $vals(cp:classes_selected) {
            set vals(cp:perms) [lsort -unique -dictionary [concat $vals(cp:perms) [Apol_Class_Perms::getPermsForClass $class]]]
        }
    } else {  ;# intersection
        set vals(cp:perms) {}
        set vals(cp:perms_selected) {}
        set classes {}
        foreach i [$widgets(cp:classes) curselection] {
            lappend classes [$widgets(cp:classes) get $i]
        }
        if {$classes == {}} {
            return
        }
        set vals(cp:perms) [Apol_Class_Perms::getPermsForClass [lindex $classes 0]]
        foreach class [lrange $classes 1 end] {
            set this_perms [Apol_Class_Perms::getPermsForClass $class]
            set new_perms {}
            foreach p $vals(cp:perms) {
                if {[lsearch -exact $this_perms $p] >= 0} {
                    lappend new_perms $p
                }
            }
            set vals(cp:perms) $new_perms
        }
    }
}
proc Apol_TE::_toggle_cp_select {col} {
    variable vals
    variable widgets
    set items {}
    foreach i [$widgets(cp:${col}) curselection] {
        lappend items [$widgets(cp:${col}) get $i]
    }
    set vals(cp:${col}_selected) $items
    if {$col == "classes"} {
        _toggle_perms_toshow {} {} update
    }
}
proc Apol_TE::_clear_cp_listbox {lb prefix} {
    variable vals
    $lb selection clear 0 end
    set vals(cp:${prefix}_selected) {}
    if {$prefix == "classes"} {
        _toggle_perms_toshow {} {} update
    }
}
proc Apol_TE::_reverse_cp_listbox {lb} {
    variable vals
    set old_selection [$lb curselection]
    set items {}
    for {set i 0} {$i < [$lb index end]} {incr i} {
        if {[lsearch $old_selection $i] >= 0} {
            $lb selection clear $i
        } else {
            $lb selection set $i
            lappend items [$lb get $i]
        }
    }
    set vals(cp:perms_selected) $items
}
proc Apol_TE::_update_cp_tabname {name1 name2 op} {
    variable vals
    variable widgets
    variable enabled
    if {($enabled(cp:classes) && $vals(cp:classes_selected) > 0) || \
            ($enabled(cp:perms) && $vals(cp:perms_selected) > 0)} {
            $widgets(search_opts) itemconfigure classperms -text "Classes/Permissions *"
    } else {
        $widgets(search_opts) itemconfigure classperms -text "Classes/Permissions"
    }
}
proc Apol_TE::_delete_results {pageID} {
    variable widgets
    variable tabs
    set curpos [$widgets(results) index $pageID]
    $widgets(results) delete $pageID
    array unset tabs $pageID:*
    array unset tabs $pageID
    if {[set next_id [$widgets(results) pages $curpos]] != {}} {
        _switch_to_tab $next_id
    } elseif {$curpos > 0} {
        _switch_to_tab [$widgets(results) pages [expr {$curpos - 1}]]
    } else {
        $widgets(update) configure -state disabled
    }
}
proc Apol_TE::_display_rename_tab_dialog {pageID} {
    variable widgets
    variable tabs
    set d [Dialog .apol_te_tab_rename -homogeneous 1 -spacing 2 -cancel 1 \
               -default 0 -modal local -parent . -place center -separator 1 \
               -side bottom -title "Rename Results Tab"]
    $d add -text "OK" -command [list $d enddialog "ok"]
    $d add -text "Cancel" -command [list $d enddialog "cancel"]
    set f [$d getframe]
    set l [label $f.l -text "Tab name:"]
    set tabs(tab:new_name) [$widgets(results) itemcget $pageID -text]
    set e [entry $f.e -textvariable Apol_TE::tabs(tab:new_name) -width 16 -bg white]
    pack $l $e -side left -padx 2
    set retval [$d draw]
    destroy $d
    if {$retval == "ok"} {
        $widgets(results) itemconfigure $pageID -text $tabs(tab:new_name)
    }
}
proc Apol_TE::_delete_current_results {} {
    variable widgets
    if {[set curid [$widgets(results) raise]] != {}} {
        _delete_results $curid
    }
}
proc Apol_TE::_create_new_results_tab {} {
    variable vals
    variable widgets
    variable tabs
    set i $tabs(next_result_id)
    incr tabs(next_result_id)
    set id "results$i"
    set frame [$widgets(results) insert end "$id" -text "Results $i"]
    $widgets(results) raise $id
    set tabs($id) [Apol_Widget::makeSearchResults $frame.results]
    pack $tabs($id) -expand 1 -fill both
    set tabs($id:vals) [array get vals]
    return $tabs($id)
}
proc Apol_TE::_switch_to_tab {pageID} {
    variable vals
    variable widgets
    variable tabs
    if {[$Apol_TE::widgets(results) raise] == $pageID} {
        return
    }
    $widgets(results) raise $pageID
    set cur_search_opts [$widgets(search_opts) raise]
    array set tmp_vals $tabs($pageID:vals)
    set classes_selected $tmp_vals(cp:classes_selected)
    set perms_selected $tmp_vals(cp:perms_selected)
    array set vals $tabs($pageID:vals)
    _initializeWidgets
    set vals(cp:classes_selected) $classes_selected
    set vals(cp:perms_selected) $perms_selected
    foreach c $classes_selected {
        $widgets(cp:classes) selection set [lsearch $vals(cp:classes) $c]
    }
    foreach p $perms_selected {
        $widgets(cp:perms) selection set [lsearch $vals(cp:perms) $p]
    }
    $widgets(search_opts) raise $cur_search_opts
}
proc Apol_TE::_reset {} {
    variable enabled
    set old_classes_enabled $enabled(cp:classes)
    _initializeVars
    _initializeWidgets
    if {[set enabled(cp:classes) $old_classes_enabled]} {
        variable vals
        set vals(cp:classes) [Apol_Class_Perms::getClasses]
        set enabled(cp:classes) 1
        set enabled(cp:perms) 1
    }
}
proc Apol_TE::_search_terules {whichButton} {
    variable vals
    variable widgets
    variable enabled
    variable tabs
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "TE Rule Search" -message "No current policy file is opened."
        return
    }
    if {$enabled(ta:use_source) && $vals(ta:use_source) && $vals(ta:source_sym) == {}} {
        tk_messageBox -icon error -type ok -title "TE Rule Search" -message "No source type/attribute was selected."
        return
    }
    if {$enabled(ta:use_target) && $vals(ta:use_target) && $vals(ta:target_sym) == {}} {
        tk_messageBox -icon error -type ok -title "TE Rule Search" -message "No target type/attribute was selected."
        return
    }
    if {$enabled(ta:use_default) && $vals(ta:use_default) && $vals(ta:default_sym) == {}} {
        tk_messageBox -icon error -type ok -title "TE Rule Search" -message "No default type selected."
        return
    }
    set avrule_selection 0
    foreach {key value} [array get vals rs:avrule_*] {
        set avrule_selection [expr {$avrule_selection | $value}]
    }
    set terule_selection 0
    foreach {key value} [array get vals rs:type_*] {
        set terule_selection [expr {$terule_selection | $value}]
    }
    if {$avrule_selection == 0 && $terule_selection == 0} {
            tk_messageBox -icon error -type ok -title "TE Rule Search" -message "At least one rule must be selected."
            return
    }
    set avq [new_apol_avrule_query_t]
    set teq [new_apol_terule_query_t]
    if {$enabled(ta:use_source) && $vals(ta:use_source)} {
        if {$vals(ta:source_which) == "either"} {
            $avq set_source_any $::ApolTop::policy 1
        }
        $avq set_source $::ApolTop::policy $vals(ta:source_sym) $vals(ta:source_indirect)
        $avq set_source_component $::ApolTop::policy [expr {$vals(ta:source_sym,types) | $vals(ta:source_sym,attribs)}]
        $teq set_source $::ApolTop::policy $vals(ta:source_sym) $vals(ta:source_indirect)
        $teq set_source_component $::ApolTop::policy [expr {$vals(ta:source_sym,types) | $vals(ta:source_sym,attribs)}]
    }
    if {$enabled(ta:use_target) && $vals(ta:use_target)} {
        $avq set_target $::ApolTop::policy $vals(ta:target_sym) $vals(ta:target_indirect)
        $avq set_target_component $::ApolTop::policy [expr {$vals(ta:target_sym,types) | $vals(ta:target_sym,attribs)}]
        $teq set_target $::ApolTop::policy $vals(ta:target_sym) $vals(ta:target_indirect)
        $teq set_target_component $::ApolTop::policy [expr {$vals(ta:target_sym,types) | $vals(ta:target_sym,attribs)}]
    }
    if {$enabled(ta:use_default) && $vals(ta:use_default)} {
        $teq set_default $::ApolTop::policy $vals(ta:default_sym)
    }
    if {$enabled(cp:classes)} {
        foreach c $vals(cp:classes_selected) {
            $avq append_class $::ApolTop::policy $c
            $teq append_class $::ApolTop::policy $c
        }
    }
    if {$enabled(cp:perms)} {
        foreach p $vals(cp:perms_selected) {
            $avq append_perm $::ApolTop::policy $p
        }
        $avq set_all_perms $::ApolTop::policy $vals(cp:perms_matchall)
    }
    $avq set_rules $::ApolTop::policy $avrule_selection
    $teq set_rules $::ApolTop::policy $terule_selection
    $avq set_enabled $::ApolTop::policy $vals(oo:enabled)
    $teq set_enabled $::ApolTop::policy $vals(oo:enabled)
    $avq set_regex $::ApolTop::policy $vals(oo:regexp)
    $teq set_regex $::ApolTop::policy $vals(oo:regexp)
    foreach x {new update reset} {
        $widgets($x) configure -state disabled
    }
    if {$vals(rs:avrule_neverallow)} {
        ApolTop::loadNeverAllows
    }
    if {![ApolTop::is_capable "neverallow"]} {
        set avrule_selection [expr {$avrule_selection & (~$::QPOL_RULE_NEVERALLOW)}]
        $avq set_rules $::ApolTop::policy $avrule_selection
    }
    Apol_Progress_Dialog::wait "TE Rules" "Searching rules" \
        {
            set numTEs {0 0 0}
            set numAVs {0 0 0}
            set avresults NULL
            set teresults NULL
            set num_avresults 0
            set num_teresults 0
            if {![ApolTop::is_capable "syntactic rules"]} {
                if {$avrule_selection != 0} {
                    set avresults [$avq run $::ApolTop::policy]
                }
                if {$terule_selection != 0} {
                    set teresults [$teq run $::ApolTop::policy]
                }
            } else {
                $::ApolTop::qpolicy build_syn_rule_table
                if {$avrule_selection != 0} {
                    set avresults [$avq run_syn $::ApolTop::policy]
                }
                if {$terule_selection != 0} {
                    set teresults [$teq run_syn $::ApolTop::policy]
                }
            }
            $avq -acquire
            $avq -delete
            $teq -acquire
            $teq -delete
            if {$avresults != "NULL"} {
                set num_avresults [$avresults get_size]
            }
            if {$teresults != "NULL"} {
                set num_teresults [$teresults get_size]
            }
            if {$whichButton == "new"} {
                set sr [_create_new_results_tab]
            } else {
                set id [$widgets(results) raise]
                set tabs($id:vals) [array get vals]
                set sr $tabs($id)
                Apol_Widget::clearSearchResults $sr
            }
            if {![ApolTop::is_capable "syntactic rules"]} {
                apol_tcl_set_info_string $::ApolTop::policy "Rendering $num_avresults AV rule results"
                apol_tcl_terule_sort $::ApolTop::policy $teresults
                if {$num_avresults > 0} {
                    set numAVs [Apol_Widget::appendSearchResultRules $sr 0 $avresults qpol_avrule_from_void]
                }
                apol_tcl_set_info_string $::ApolTop::policy "Rendering $num_teresults TE rule results"
                apol_tcl_avrule_sort $::ApolTop::policy $avresults
                if {$num_teresults > 0} {
                    set numTEs [Apol_Widget::appendSearchResultRules $sr 0 $teresults qpol_terule_from_void]
                }
            } else {
                apol_tcl_set_info_string $::ApolTop::policy "Rendering $num_avresults AV rule results"
                if {$num_avresults > 0} {
                    set numAVs [Apol_Widget::appendSearchResultSynRules $sr 0 $avresults qpol_syn_avrule_from_void]
                }
                apol_tcl_set_info_string $::ApolTop::policy "Rendering $num_teresults TE rule results"
                if {$num_teresults > 0} {
                    set numTEs [Apol_Widget::appendSearchResultSynRules $sr 0 $teresults qpol_syn_terule_from_void]
                }
            }
            set num_rules [expr {[lindex $numAVs 0] + [lindex $numTEs 0]}]
            set num_enabled [expr {[lindex $numAVs 1] + [lindex $numTEs 1]}]
            set num_disabled [expr {[lindex $numAVs 2] + [lindex $numTEs 2]}]
            set header "$num_rules rule"
            if {$num_rules != 1} {
                append header s
            }
            append header " match the search criteria.\n"
            append header "Number of enabled conditional rules: $num_enabled\n"
            append header "Number of disabled conditional rules: $num_disabled\n"
            Apol_Widget::appendSearchResultHeader $sr $header
        }
    $widgets(new) configure -state normal
    $widgets(reset) configure -state normal
    if {[$widgets(results) pages] != {} || $retval == 0} {
        $widgets(update) configure -state normal
    }
}
namespace eval Apol_Analysis_transflow {
    variable vals
    variable widgets
    Apol_Analysis::registerAnalysis "Apol_Analysis_transflow" "Transitive Information Flow"
}
proc Apol_Analysis_transflow::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_to [radiobutton [$dir_tf getframe].to -text "To" \
                    -value $::APOL_INFOFLOW_IN \
                    -variable Apol_Analysis_transflow::vals(dir)]
    set dir_from [radiobutton [$dir_tf getframe].from -text "From" \
                      -value $::APOL_INFOFLOW_OUT \
                      -variable Apol_Analysis_transflow::vals(dir)]
    pack $dir_to $dir_from -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 advanced_f [frame [$filter_tf getframe].advanced]
    pack $advanced_f -side left -anchor nw
    set widgets(advanced_enable) [checkbutton $advanced_f.enable -text "Use advanced filters" \
                                      -variable Apol_Analysis_transflow::vals(advanced:enable)]
    pack $widgets(advanced_enable) -anchor w
    set widgets(advanced) [button $advanced_f.b -text "Advanced Filters" \
                               -command Apol_Analysis_transflow::_createAdvancedDialog \
                               -state disabled]
    pack $widgets(advanced) -anchor w -padx 4
    trace add variable Apol_Analysis_transflow::vals(advanced:enable) write \
        Apol_Analysis_transflow::_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_transflow::open {} {
    variable vals
    variable widgets
    Apol_Widget::resetTypeComboboxToPolicy $widgets(type)
    set vals(intermed:inc) [Apol_Types::getTypes]
    set vals(intermed:inc_all) $vals(intermed:inc)
    set vals(classes:displayed) {}
    foreach class [Apol_Class_Perms::getClasses] {
        foreach perm [Apol_Class_Perms::getPermsForClass $class] {
            set vals(perms:$class:$perm) 1
        }
        lappend vals(classes:displayed) $class
    }
}
proc Apol_Analysis_transflow::close {} {
    variable widgets
    _reinitializeVals
    _reinitializeWidgets
    Apol_Widget::clearTypeCombobox $widgets(type)
}
proc Apol_Analysis_transflow::getInfo {} {
    return "This analysis generates the results of a Transitive 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 transitive information flow to or from its parent
node.  If flow 'To' is selected the information flows from the child
to the parent.  If flow 'From' is selected then information flows from
the parent to the child.
\nThe results of the analysis may be optionally filtered by object
classes and/or permissions, intermediate types, 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_transflow::newAnalysis {} {
    if {[set rt [_checkParams]] != {}} {
        return $rt
    }
    set results [_analyze]
    set f [_createResultsDisplay]
    _renderResults $f $results
    $results -acquire
    $results -delete
    return {}
}
proc Apol_Analysis_transflow::updateAnalysis {f} {
    if {[set rt [_checkParams]] != {}} {
        return $rt
    }
    set results [_analyze]
    _clearResultsDisplay $f
    _renderResults $f $results
    $results -acquire
    $results -delete
    return {}
}
proc Apol_Analysis_transflow::reset {} {
    _reinitializeVals
    _reinitializeWidgets
    open
}
proc Apol_Analysis_transflow::switchTab {query_options} {
    variable vals
    variable widgets
    array set vals $query_options
    _reinitializeWidgets
}
proc Apol_Analysis_transflow::saveQuery {channel} {
    variable vals
    variable widgets
    foreach {key value} [array get vals] {
        switch -glob -- $key {
            find_more:* -
            intermed:inc* -
            intermed:exc -
            classes:title {}
            classes:displayed {}
            perms:* {
                if {$value == 0} {
                    puts $channel "$key $value"
                }
            }
            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_transflow::loadQuery {channel} {
    variable vals
    set intermed_exc {}
    set perms_disabled {}
    while {[gets $channel line] >= 0} {
        set line [string trim $line]
        if {$line == {} || [string index $line 0] == "#"} {
            continue
        }
        set key {}
        set value {}
        regexp -line -- {^(\S+)( (.+))?} $line -> key --> value
        switch -glob -- $key {
            intermed:exc_all {
                set intermed_exc $value
            }
            perms:* {
                set perms_disabled [concat $perms_disabled $key $value]
            }
            default {
                set vals($key) $value
            }
        }
    }
    open
    set vals(intermed:exc_all) {}
    set vals(intermed:exc) {}
    foreach t $intermed_exc {
        set i [lsearch $vals(intermed:inc_all) $t]
        if {$i >= 0} {
            lappend vals(intermed:exc_all) $t
            lappend vals(intermed:exc) $t
            set vals(intermed:inc_all) [lreplace $vals(intermed:inc_all) $i $i]
            set i [lsearch $vals(intermed:inc) $t]
            set vals(intermed:inc) [lreplace $vals(intermed:inc) $i $i]
        }
    }
    set vals(intermed:exc_all) [lsort $vals(intermed:exc_all)]
    set vals(intermed:exc) [lsort $vals(intermed:exc)]
    foreach {key value} $perms_disabled {
        if {[info exists vals($key)]} {
            set vals($key) $value
        }
    }
    set vals(classes:displayed) {}
    foreach class [Apol_Class_Perms::getClasses] {
        set all_disabled 1
        foreach perm_key [array names vals perms:$class:*] {
            if {$vals($perm_key)} {
                set all_disabled 0
                break
            }
        }
        if {$all_disabled} {
            lappend vals(classes:displayed) "$class (excluded)"
        } else {
            lappend vals(classes:displayed) $class
        }
    }
    _reinitializeWidgets
}
proc Apol_Analysis_transflow::getTextWidget {tab} {
    return [$tab.right getframe].res.tb
}
proc Apol_Analysis_transflow::appendResultsNodes {tree parent_node results} {
    _createResultsNodes $tree $parent_node $results 0
}
proc Apol_Analysis_transflow::renderPath {res path_num path} {
    _renderPath $res $path_num $path
}
proc Apol_Analysis_transflow::_reinitializeVals {} {
    variable vals
    set vals(dir) $::APOL_INFOFLOW_IN
    array set vals {
        type {}  type:attrib {}
        regexp:enable 0
        regexp {}
        advanced:enable 0
        classes:title {}
        classes:displayed {}
        classes:threshold_enable 0
        classes:threshold 1
        intermed:inc {}   intermed:inc_all {}
        intermed:exc {}   intermed:exc_all {}
        intermed:attribenable 0  intermed:attrib {}
        find_more:hours 0   find_more:minutes 0   find_more:seconds 30
        find_more:limit 20
    }
    array unset vals perms:*
    foreach class [Apol_Class_Perms::getClasses] {
        foreach perm [Apol_Class_Perms::getPermsForClass $class] {
            set vals(perms:$class:$perm) 1
        }
    }
}
proc Apol_Analysis_transflow::_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_transflow::_toggleAdvancedSelected {name1 name2 op} {
    variable vals
    variable widgets
    if {$vals(advanced:enable)} {
        $widgets(advanced) configure -state normal
    } else {
        $widgets(advanced) configure -state disabled
    }
}
proc Apol_Analysis_transflow::_createAdvancedDialog {} {
    variable widgets
    $widgets(advanced) configure -state disabled
    destroy .transflow_adv
    variable vals
    if {[ApolTop::is_policy_open] && ![Apol_Perms_Map::is_pmap_loaded]} {
        if {![ApolTop::openDefaultPermMap]} {
            return "This analysis requires that a permission map is loaded."
        }
    }
    set d [Dialog .transflow_adv -modal none -separator 1 -title "Transitive Information Flow Advanced Filters" -parent .]
    $d add -text "Close" -command [list Apol_Analysis_transflow::_closeAdvancedDialog $d]
    set tf [TitleFrame [$d getframe].classes -text "Filter By Object Class Permissions"]
    pack $tf -side top -expand 1 -fill both -padx 2 -pady 4
    _createClassFilter [$tf getframe]
    set tf [TitleFrame [$d getframe].types -text "Filter By Intermediate Types"]
    pack $tf -side top -expand 1 -fill both -padx 2 -pady 4
    _createIntermedFilter [$tf getframe]
    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_transflow::vals(intermed:attribenable)]
    set attrib_box [ComboBox $attrib.ab -autopost 1 -entrybg white -width 16 \
                        -values $Apol_Types::attriblist \
                        -textvariable Apol_Analysis_transflow::vals(intermed:attrib)]
    $attrib_enable configure -command \
        [list Apol_Analysis_transflow::_attribEnabled $attrib_box]
    trace remove variable Apol_Analysis_transflow::vals(intermed:attrib) write \
        [list Apol_Analysis_transflow::_attribChanged]
    trace add variable Apol_Analysis_transflow::vals(intermed:attrib) write \
        [list Apol_Analysis_transflow::_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
    $d draw
    $widgets(advanced) configure -state normal
}
proc Apol_Analysis_transflow::_closeAdvancedDialog {d} {
	$d withdraw
}
proc Apol_Analysis_transflow::_createClassFilter {f} {
    variable vals
    set l1 [label $f.l1 -text "Object Classes"]
    set l [label $f.l]
    set vals(classes:title) "Permissions"
    set l2 [label $f.l2 -textvariable Apol_Analysis_transflow::vals(classes:title)]
    grid $l1 $l $l2 -sticky w
    set classes [Apol_Widget::makeScrolledListbox $f.c -selectmode extended \
                     -height 12 -width 24 -listvar Apol_Analysis_transflow::vals(classes:displayed)]
    set sw [ScrolledWindow $f.sw -auto both -bd 2 -relief groove]
    set perms [ScrollableFrame $sw.perms -height 150 -width 250]
    $sw setwidget $perms
    bind $classes.lb <<ListboxSelect>> \
        [list Apol_Analysis_transflow::_refreshPerm $classes $perms]
    grid $classes x $sw -sticky nsew
    update
    grid propagate $sw 0
    set bb [ButtonBox $f.bb -homogeneous 1 -spacing 4]
    $bb add -text "Include All Perms" -width 16 -command [list Apol_Analysis_transflow::_setAllPerms $classes $perms 1]
    $bb add -text "Exclude All Perms" -width 16 -command [list Apol_Analysis_transflow::_setAllPerms $classes $perms 0]
    grid ^ x $bb -pady 4
    set f [frame $f.f]
    grid ^ x $f
    grid configure $f -sticky ew
    set cb [checkbutton $f.cb -text "Exclude permissions with weights below:" \
                -variable Apol_Analysis_transflow::vals(classes:threshold_enable)]
    set weight [spinbox $f.threshold -from 1 -to 10 -increment 1 \
                    -width 2 -bg white -justify right \
                    -textvariable Apol_Analysis_transflow::vals(classes:threshold)]
    trace remove variable Apol_Analysis_transflow::vals(classes:threshold_enable) write \
        [list Apol_Analysis_transflow::_thresholdChanged $weight]
    trace add variable Apol_Analysis_transflow::vals(classes:threshold_enable) write \
        [list Apol_Analysis_transflow::_thresholdChanged $weight]
    pack $cb $weight -side left
    _thresholdChanged $weight {} {} {}
    grid columnconfigure $f 0 -weight 0
    grid columnconfigure $f 1 -weight 0 -pad 4
    grid columnconfigure $f 2 -weight 1
}
proc Apol_Analysis_transflow::_refreshPerm {classes perms} {
    variable vals
    focus $classes.lb
    if {[$classes.lb curselection] == {}} {
        return
    }
    set pf [$perms getframe]
    foreach w [winfo children $pf] {
        destroy $w
    }
    foreach {class foo} [$classes.lb get anchor] {break}
    set i [$classes.lb index anchor]
    set vals(classes:title) "Permissions for $class"
    foreach perm_key [lsort [array names vals perms:$class:*]] {
        foreach {foo bar perm} [split $perm_key :] {break}
        set weight [$::ApolTop::policy get_permmap_weight $class $perm]
        set l [label $pf.$perm:l -text $perm -anchor w]
        set inc [checkbutton $pf.$perm:i -text "Include" \
                     -command [list Apol_Analysis_transflow::_togglePerm $class $i] \
                     -variable Apol_Analysis_transflow::vals(perms:$class:$perm)]
        set w [label $pf.$perm:w -text "Weight: $weight"]
        grid $l $inc $w -padx 2 -sticky w -pady 4
        grid configure $w -ipadx 10
    }
    grid columnconfigure $pf 0 -minsize 100 -weight 1
    $perms xview moveto 0
    $perms yview moveto 0
}
proc Apol_Analysis_transflow::_togglePerm {class i} {
    variable vals
    set all_disabled 1
    foreach perm_key [array names vals perms:$class:*] {
        if {$vals($perm_key)} {
            set all_disabled 0
            break
        }
    }
    if {$all_disabled} {
        set vals(classes:displayed) [lreplace $vals(classes:displayed) $i $i "$class (excluded)"]
    } else {
        set vals(classes:displayed) [lreplace $vals(classes:displayed) $i $i $class]
    }
}
proc Apol_Analysis_transflow::_setAllPerms {classes perms newValue} {
    variable vals
    foreach i [$classes.lb curselection] {
        foreach {class foo} [split [$classes.lb get $i]] {break}
        foreach perm_key [array names vals perms:$class:*] {
            set vals($perm_key) $newValue
        }
        if {$newValue == 1} {
            set vals(classes:displayed) [lreplace $vals(classes:displayed) $i $i $class]
        } else {
            set vals(classes:displayed) [lreplace $vals(classes:displayed) $i $i "$class (excluded)"]
        }
    }
}
proc Apol_Analysis_transflow::_thresholdChanged {w name1 name2 op} {
    variable vals
    if {$vals(classes:threshold_enable)} {
        $w configure -state normal
    } else {
        $w configure -state disabled
    }
}
proc Apol_Analysis_transflow::_createIntermedFilter {f} {
    set l1 [label $f.l1 -text "Included Intermediate Types"]
    set l2 [label $f.l2 -text "Excluded Intermediate Types"]
    grid $l1 x $l2 -sticky w
    set inc [Apol_Widget::makeScrolledListbox $f.inc -height 10 -width 24 \
                 -listvar Apol_Analysis_transflow::vals(intermed:inc) \
                 -selectmode extended -exportselection 0]
    set exc [Apol_Widget::makeScrolledListbox $f.exc -height 10 -width 24 \
                 -listvar Apol_Analysis_transflow::vals(intermed: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_transflow::_moveToExclude $inc_lb $exc_lb]
    $bb add -text "<--" -width 10 -command [list Apol_Analysis_transflow::_moveToInclude $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
}
proc Apol_Analysis_transflow::_moveToExclude {inc exc} {
    variable vals
    if {[set selection [$inc curselection]] == {}} {
        return
    }
    foreach i $selection {
        lappend types [$inc get $i]
    }
    set vals(intermed:exc) [lsort [concat $vals(intermed:exc) $types]]
    set vals(intermed:exc_all) [lsort [concat $vals(intermed:exc_all) $types]]
    foreach t $types {
        set i [lsearch $vals(intermed:inc) $t]
        set vals(intermed:inc) [lreplace $vals(intermed:inc) $i $i]
        set i [lsearch $vals(intermed:inc_all) $t]
        set vals(intermed:inc_all) [lreplace $vals(intermed:inc_all) $i $i]
    }
    $inc selection clear 0 end
    $exc selection clear 0 end
}
proc Apol_Analysis_transflow::_moveToInclude {inc exc} {
    variable vals
    if {[set selection [$exc curselection]] == {}} {
        return
    }
    foreach i $selection {
        lappend types [$exc get $i]
    }
    set vals(intermed:inc) [lsort [concat $vals(intermed:inc) $types]]
    set vals(intermed:inc_all) [lsort [concat $vals(intermed:inc_all) $types]]
    foreach t $types {
        set i [lsearch $vals(intermed:exc) $t]
        set vals(intermed:exc) [lreplace $vals(intermed:exc) $i $i]
        set i [lsearch $vals(intermed:exc_all) $t]
        set vals(intermed:exc_all) [lreplace $vals(intermed:exc_all) $i $i]
    }
    $inc selection clear 0 end
    $exc selection clear 0 end
}
proc Apol_Analysis_transflow::_attribEnabled {cb} {
    variable vals
    if {$vals(intermed:attribenable)} {
        $cb configure -state normal
        _filterTypeLists $vals(intermed:attrib)
    } else {
        $cb configure -state disabled
        _filterTypeLists ""
    }
}
proc Apol_Analysis_transflow::_attribChanged {name1 name2 op} {
    variable vals
    if {$vals(intermed:attribenable)} {
        _filterTypeLists $vals(intermed:attrib)
    }
}
proc Apol_Analysis_transflow::_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 == {}} {
            return
        }
        set vals(intermed:inc) {}
        set vals(intermed:exc) {}
        foreach t $typesList {
            if {[lsearch $vals(intermed:inc_all) $t] >= 0} {
                lappend vals(intermed:inc) $t
            }
            if {[lsearch $vals(intermed:exc_all) $t] >= 0} {
                lappend vals(intermed:exc) $t
            }
        }
        set vals(intermed:inc) [lsort $vals(intermed:inc)]
        set vals(intermed:exc) [lsort $vals(intermed:exc)]
    } else {
        set vals(intermed:inc) $vals(intermed:inc_all)
        set vals(intermed:exc) $vals(intermed:exc_all)
    }
}
proc Apol_Analysis_transflow::_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 {![Apol_Perms_Map::is_pmap_loaded]} {
        if {![ApolTop::openDefaultPermMap]} {
            return "This analysis requires that a permission map is loaded."
        }
        apol_tcl_clear_info_string
    }
    if {$vals(advanced:enable)} {
        if {$vals(intermed:inc_all) == {}} {
            return "At least one intermediate type must be selected."
        }
        if {[lsearch $vals(intermed:exc_all) $vals(type)] >= 0} {
            return "The starting type is on the excluded intermediate types list"
        }
        set num_perms 0
        foreach perm_key [array names vals perms:*] {
            if {$vals($perm_key)} {
                set num_perms 1
                break
            }
        }
        if {$num_perms == 0} {
            return "At least one permissions must be enabled."
        }
    }
    return {}  ;# all parameters passed, now ready to do search
}
proc Apol_Analysis_transflow::_analyze {} {
    variable vals
    if {$vals(regexp:enable)} {
        set regexp $vals(regexp)
    } else {
        set regexp {}
    }
    set threshold {}
    if {$vals(advanced:enable)} {
        set intermed $vals(intermed:inc_all)
        set classperms {}
        foreach perm_key [array names vals perms:*] {
            if {$vals($perm_key)} {
                foreach {foo class perm} [split $perm_key :] {break}
                lappend classperms $class $perm
            }
        }
        if {$vals(classes:threshold_enable)} {
            set threshold $vals(classes:threshold)
        }
    } else {
        set intermed {}
        set classperms {}
    }
    set q [new_apol_infoflow_analysis_t]
    $q set_mode $::ApolTop::policy $::APOL_INFOFLOW_MODE_TRANS
    $q set_dir $::ApolTop::policy $vals(dir)
    $q set_type $::ApolTop::policy $vals(type)
    foreach i $intermed {
        $q append_intermediate $::ApolTop::policy $i
    }
    foreach {c p} $classperms {
        $q append_class_perm $::ApolTop::policy $c $p
    }
    if {$threshold != {}} {
        $q set_min_weight $::ApolTop::policy $threshold
    }
    $q set_result_regex $::ApolTop::policy $regexp
    set results [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    return $results
}
proc Apol_Analysis_transflow::_analyzeMore {tree node} {
    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
}
proc Apol_Analysis_transflow::_createResultsDisplay {} {
    variable vals
    set f [Apol_Analysis::createResultTab "Trans Flow" [array get vals]]
    set tree_tf [TitleFrame $f.left -text "Transitive 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 "Transitive 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 find_more -underline 1
    $res.tb tag configure subtitle -font {Helvetica 10 bold}
    $res.tb tag configure num -foreground blue -font {Helvetica 10 bold}
    $res.tb tag bind find_more <Button-1> [list Apol_Analysis_transflow::_findMore $res $tree]
    $res.tb tag bind find_more <Enter> [list $res.tb configure -cursor hand2]
    $res.tb tag bind find_more <Leave> [list $res.tb configure -cursor {}]
    pack $res -expand 1 -fill both
    $tree configure -selectcommand [list Apol_Analysis_transflow::_treeSelect $res]
    $tree configure -opencmd [list Apol_Analysis_transflow::_treeOpen $tree]
    return $f
}
proc Apol_Analysis_transflow::_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] == "y"} {
            _renderResultsTransFlow $res $tree $node [lindex $data 1]
        } else {
            eval $res.tb insert end [lindex $data 1]
        }
        $res.tb configure -state disabled
    }
}
proc Apol_Analysis_transflow::_treeOpen {tree node} {
    foreach {is_expanded results} [$tree itemcget $node -data] {break}
    if {[string index $node 0] == "y" && !$is_expanded} {
        Apol_Progress_Dialog::wait "Transitive Information Flow Analysis" \
            "Performing Transitive Information Flow Analysis..." \
            {
                set new_results [_analyzeMore $tree $node]
                $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_transflow::_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_transflow::_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_transflow::_renderTopText {} {
    variable vals
    set top_text [list "Transitive Information Flow Analysis: Starting type: " title]
    lappend top_text $vals(type) title_type \
        "\n\n" title \
        "This tab provides the results of a Transitive 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 transitive 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." {}
}
proc Apol_Analysis_transflow::_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 first_target [[lindex $info_list 0] get_end_type]
            set target [$first_target get_name $::ApolTop::qpolicy]
        }
        set flow_dir [$r get_dir]
        set length [$r get_length]
        set steps_v [$r get_steps]
        lappend all_targets $target
        lappend paths($target) [list $length $steps_v]
        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 {
        set sorted_paths {}
        foreach path [lsort -uniq [lsort -index 0 -integer $paths($t)]] {
            set step_v [lindex $path 1]
            set p {}
            if {$flow_dir == $::APOL_INFOFLOW_IN} {
                for {set i [expr {[$step_v get_size] - 1}]} {$i >= 0} {incr i -1} {
                    set r [apol_infoflow_step_from_void [$step_v get_element $i]]
                    lappend p [_infoflow_step_to_list $r]
                }
            } else {
                for {set i 0} {$i < [$step_v get_size]} {incr i} {
                    set r [apol_infoflow_step_from_void [$step_v get_element $i]]
                    lappend p [_infoflow_step_to_list $r]
                }
            }
            lappend sorted_paths $p
        }
        set data [list $flow_dir $sorted_paths]
        $tree insert end $parent_node y\#auto -text $t -drawcross allways \
            -data [list 0 $data]
    }
}
proc Apol_Analysis_transflow::_infoflow_step_to_list {step} {
    set start [[$step get_start_type] get_name $::ApolTop::qpolicy]
    set end [[$step get_end_type] get_name $::ApolTop::qpolicy]
    set weight [$step get_weight]
    set rules [avrule_vector_to_list [$step get_rules]]
    list $start $end $weight $rules
}
proc Apol_Analysis_transflow::_renderResultsTransFlow {res tree node data} {
    set parent_name [$tree itemcget [$tree parent $node] -text]
    set name [$tree itemcget $node -text]
    foreach {flow_dir paths} $data {break}
    switch -- $flow_dir [list \
        $::APOL_INFOFLOW_IN {
            $res.tb insert end "Information flows to " title \
                $parent_name title_type \
                " from " title \
                $name title_type
        } \
        $::APOL_INFOFLOW_OUT {
            $res.tb insert end "Information flows from " title \
                $parent_name title_type \
                " to " title \
                $name title_type
        } \
                            ]
    $res.tb insert end "  (" title \
        "Find more flows" {title_type find_more} \
        ")\n\n" title \
        "Apol found the following number of information flows: " subtitle \
        [llength $paths] num \
        "\n" subtitle
    set path_num 1
    foreach path $paths {
        $res.tb insert end "\n" {}
        _renderPath $res $path_num $path
        incr path_num
    }
}
proc Apol_Analysis_transflow::_renderPath {res path_num path} {
    $res.tb insert end "Flow " subtitle \
        $path_num num \
        " requires " subtitle \
        [llength $path] num \
        " steps(s).\n" subtitle \
        "    " {}
    $res.tb insert end [lindex $path 0 0] subtitle \
        " -> " {} \
        [lindex $path 0 1] subtitle
    foreach step [lrange $path 1 end] {
        $res.tb insert end " -> " {} \
            [lindex $step 1] subtitle
    }
    $res.tb insert end \n {}
    foreach steps $path {
        set rules [lindex $steps 3]
        set v [new_apol_vector_t]
        $v append [lindex $rules 0]
        Apol_Widget::appendSearchResultRules $res 6 $v qpol_avrule_from_void
        $v -acquire
        $v -delete
        set v [new_apol_vector_t]
        foreach r [lrange $rules 1 end] {
            $v append $r
        }
        apol_tcl_avrule_sort $::ApolTop::policy $v
        Apol_Widget::appendSearchResultRules $res 10 $v qpol_avrule_from_void
        $v -acquire
        $v -delete
    }
}
proc Apol_Analysis_transflow::_findMore {res tree} {
    set node [$tree selection get]
    set start [$tree itemcget [$tree parent $node] -text]
    set end [$tree itemcget $node -text]
    set d [Dialog .trans_more -cancel 1 -default 0 -modal local -parent . \
               -separator 1 -title "Find More Flows"]
    $d add -text Find -command [list Apol_Analysis_transflow::_verifyFindMore $d]
    $d add -text Cancel
    set f [$d getframe]
    set l1 [label $f.l1 -text "Source: $start"]
    set l2 [label $f.l2 -text "Target: $end"]
    set time_f [frame $f.time]
    set path_f [frame $f.path]
    pack $l1 $l2 $time_f $path_f -anchor w -padx 8 -pady 4
    set t1 [label $time_f.t1 -text "Time limit: "]
    set e1 [entry $time_f.e1 -textvariable Apol_Analysis_transflow::vals(find_more:hours) -width 5 -justify right -bg white]
    set t2 [label $time_f.t2 -text "Hour(s)  "]
    set e2 [entry $time_f.e2 -textvariable Apol_Analysis_transflow::vals(find_more:minutes) -width 5 -justify right -bg white]
    set t3 [label $time_f.t3 -text "Minute(s)  "]
    set e3 [entry $time_f.e3 -textvariable Apol_Analysis_transflow::vals(find_more:seconds) -width 5 -justify right -bg white]
    set t4 [label $time_f.t4 -text "Second(s)  "]
    pack $t1 $e1 $t2 $e2 $t3 $e3 $t4 -side left
    set t1 [label $path_f.t1 -text "Limit by these number of flows: "]
    set e1 [entry $path_f.e1 -textvariable Apol_Analysis_transflow::vals(find_more:limit) -width 5 -justify right -bg white]
    pack $t1 $e1 -side left
    set retval [$d draw]
    destroy .trans_more
    if {$retval == 0} {
        set graph_handler [lindex [$tree itemcget top -data] 0]
        $graph_handler trans_further_prepare $::ApolTop::policy $start $end
        _doFindMore $res $tree $node
    }
}
proc Apol_Analysis_transflow::_verifyFindMore {d} {
    variable vals
    set message {}
    if {[set hours [string trim $vals(find_more:hours)]] == {}} {
        set hours 0
    }
    if {[set minutes [string trim $vals(find_more:minutes)]] == {}} {
        set minutes 0
    }
    if {[set seconds [string trim $vals(find_more:seconds)]] == {}} {
        set seconds 0
    }
    set path_limit [string trim $vals(find_more:limit)]
    if {![string is integer $hours] || $hours > 24 || $hours < 0} {
        set message "Invalid hours limit input.  Must be between 0-24 inclusive."
    } elseif {![string is integer $minutes] || $minutes > 59 || $minutes < 0} {
        set message "Invalid minutes limit input.  Must be between 0-59 inclusive."
    } elseif {![string is integer $seconds] || $seconds > 59 || $seconds < 0} {
        set message "Invalid seconds limit input.  Must be between 0-59 inclusive."
    } elseif {$path_limit == {} && $hours == 0 && $minutes == 0 && $seconds == 0} {
        set message "You must specify a time limit."
    } elseif {$path_limit != {} && (![string is integer $path_limit] || $path_limit < 0)} {
        set message "Number of flows cannot be less than 1."
    }
    if {$message != {}} {
        tk_messageBox -icon error -type ok -title "Find More Flows" -message $message
    } else {
        $d enddialog 0
    }
}
proc Apol_Analysis_transflow::_doFindMore {res tree node} {
    variable vals
    if {[set hours [string trim $vals(find_more:hours)]] == {}} {
        set hours 0
    }
    if {[set minutes [string trim $vals(find_more:minutes)]] == {}} {
        set minutes 0
    }
    if {[set seconds [string trim $vals(find_more:seconds)]] == {}} {
        set seconds 0
    }
    set path_limit [string trim $vals(find_more:limit)]
    if {$hours != 0 || $minutes != 0 || $seconds != 0} {
        set time_limit [expr {$hours * 3600 + $minutes * 60 + $seconds}]
        set time_limit_str [format " elapsed out of %02d:%02d:%02d" $hours $minutes $seconds]
    } else {
        set time_limit {}
        set time_limit_str {}
    }
    if {$path_limit != {}} {
        set path_limit_str " out of $path_limit"
    } else {
        set path_limit 0
        set path_limit_str {}
    }
    set vals(find_more:abort) 0
    set vals(find_more:searches_text) {}
    set vals(find_more:searches_done) -1
    set d [ProgressDlg .trans_domore -parent . -title "Find Results" \
               -width 40 -height 5 \
               -textvariable Apol_Analysis_transflow::vals(find_more:searches_text) \
               -variable Apol_Analysis_transflow::vals(find_more:searches_done) \
               -stop Stop \
               -command [list set Apol_Analysis_transflow::vals(find_more:abort) 1]]
    set graph_handler [lindex [$tree itemcget top -data] 0]
    set start_time [clock seconds]
    set elapsed_time 0
    set path_found 0
    set v NULL
    while {1} {
        set elapsed_time [expr {[clock seconds] - $start_time}]
        set vals(find_more:searches_text) "Finding more flows:\n\n"
        append vals(find_more:searches_text) "    Time: [clock format $elapsed_time -format "%H:%M:%S" -gmt 1]$time_limit_str\n\n"
        append vals(find_more:searches_text) "    Flows: found $path_found$path_limit_str"
        update
        set v [$graph_handler trans_further_next $::ApolTop::policy $v]
        set path_found [$v get_size]
        if {($time_limit != {} && $elapsed_time >= $time_limit) || \
                ($path_limit != 0 && $path_found > $path_limit) || \
                $vals(find_more:abort)} {
            break
        }
    }
    set vals(find_more:searches_text) "Rendering $path_found flow(s)."
    update idletasks
    $res.tb configure -state normal
    $res.tb delete 0.0 end
    set parent_name [$tree itemcget [$tree parent $node] -text]
    set name [$tree itemcget $node -text]
    set flow_dir [lindex [$tree itemcget $node -data] 1 0]
    switch -- $flow_dir [list \
        $::APOL_INFOFLOW_IN {
            $res.tb insert end "More information flows to " title \
                $parent_name title_type \
                " from " title \
                $name title_type
        } \
        $::APOL_INFOFLOW_OUT {
            $res.tb insert end "More information flows from " title \
                $parent_name title_type \
                " to " title \
                $name title_type
        } \
                             ]
    $res.tb insert end "  (" title \
        "Find more flows" {title_type find_more} \
        ")\n\n" title \
        "Time: " subtitle \
        [clock format $elapsed_time -format "%H:%M:%S" -gmt 1] subtitle \
        [format " out of %02d:%02d:%02d" $hours $minutes $seconds] subtitle \
        "\n\nApol found the following number of information flows: " subtitle \
        $path_found num \
        " out of " subtitle \
        $path_limit num \
        "\n" subtitle
    set results {}
    foreach r [infoflow_result_vector_to_list $v] {
        set length [$r get_length]
        set steps_v [$r get_steps]
        lappend results [list $length $steps_v]
    }
    set path_num 1
    foreach r [lsort -index 0 -integer $results] {
        set steps_v [lindex $r 1]
        set sorted_path {}
        if {$flow_dir == $::APOL_INFOFLOW_IN} {
            for {set i [expr {[$steps_v get_size] - 1}]} {$i >= 0} {incr i -1} {
                set s [apol_infoflow_step_from_void [$steps_v get_element $i]]
                lappend sorted_path [_infoflow_step_to_list $s]
            }
        } else {
            for {set i 0} {$i < [$steps_v get_size]} {incr i} {
                set s [apol_infoflow_step_from_void [$steps_v get_element $i]]
                lappend sorted_path [_infoflow_step_to_list $s]
            }
        }
        $res.tb insert end "\n" {}
        _renderPath $res $path_num $sorted_path
        incr path_num
    }
    $res.tb configure -state disabled
    destroy $d
    $v -acquire
    $v -delete
}
namespace eval Apol_Analysis_tra {
    variable vals
    variable widgets
    Apol_Analysis::registerAnalysis "Apol_Analysis_tra" "Types Relationship Summary"
}
proc Apol_Analysis_tra::create {options_frame} {
    variable vals
    variable widgets
    _reinitializeVals
    set req_tf [TitleFrame $options_frame.req -text "Required Parameters"]
    pack $req_tf -side left -padx 2 -pady 2 -expand 0 -fill y
    set fA [frame [$req_tf getframe].fA]
    pack $fA -side left -anchor nw -padx 2
    set lA [label $fA.l -text "Type A"]
    pack $lA -anchor w
    set widgets(typeA) [Apol_Widget::makeTypeCombobox $fA.t -width 19]
    pack $widgets(typeA)
    set fB [frame [$req_tf getframe].fB]
    pack $fB -side left -anchor nw -padx 2
    set lB [label $fB.l -text "Type B"]
    pack $lB -anchor w
    set widgets(typeB) [Apol_Widget::makeTypeCombobox $fB.t -width 19]
    pack $widgets(typeB)
    set basic_tf [TitleFrame $options_frame.basic -text "Basic Relationships"]
    pack $basic_tf -side left -padx 2 -pady 2 -expand 0 -fill y
    foreach {t a v} [list \
                       "Common attributes" attribs $::APOL_TYPES_RELATION_COMMON_ATTRIBS \
                       "Common roles" roles $::APOL_TYPES_RELATION_COMMON_ROLES \
                       "Common users" users $::APOL_TYPES_RELATION_COMMON_USERS \
                       "Similar access to resources" similars $::APOL_TYPES_RELATION_SIMILAR_ACCESS \
                       "Dissimilar access to resources" dissimilars $::APOL_TYPES_RELATION_DISSIMILAR_ACCESS \
                       "TE allow rules" allows $::APOL_TYPES_RELATION_ALLOW_RULES \
                       "Type transition/change rules" typerules $::APOL_TYPES_RELATION_TYPE_RULES] {
        set cb [checkbutton [$basic_tf getframe].$v -text $t \
                    -variable Apol_Analysis_tra::vals(run:$a) \
                    -onvalue $v -offvalue 0]
        pack $cb -anchor w
    }
    set an_tf [TitleFrame $options_frame.an -text "Analysis Relationships"]
    pack $an_tf -side left -padx 2 -pady 2 -expand 1 -fill both
    foreach {t a v} [list \
                         "Direct flows between A and B" direct $::APOL_TYPES_RELATION_DIRECT_FLOW \
                         "Transitive flows A -> B" transAB $::APOL_TYPES_RELATION_TRANS_FLOW_AB \
                         "Transitive flows B -> A" transBA $::APOL_TYPES_RELATION_TRANS_FLOW_BA \
                         "Domain transitions A -> B" domainAB $::APOL_TYPES_RELATION_DOMAIN_TRANS_AB \
                         "Domain transitions B -> A" domainBA $::APOL_TYPES_RELATION_DOMAIN_TRANS_BA] {
        set cb [checkbutton [$an_tf getframe].$v -text $t \
                    -variable Apol_Analysis_tra::vals(run:$a) \
                    -onvalue $v -offvalue 0]
        pack $cb -anchor w
    }
}
proc Apol_Analysis_tra::open {} {
    variable widgets
    Apol_Widget::resetTypeComboboxToPolicy $widgets(typeA)
    Apol_Widget::resetTypeComboboxToPolicy $widgets(typeB)
}
proc Apol_Analysis_tra::close {} {
    variable widgets
    _reinitializeVals
    _reinitializeWidgets
    Apol_Widget::clearTypeCombobox $widgets(typeA)
    Apol_Widget::clearTypeCombobox $widgets(typeB)
}
proc Apol_Analysis_tra::getInfo {} {
    return "The types relationship summary analysis in Apol is a convenience
mechanism to allow a user to quickly do several queries and analyses
already in present in Apol to understand the relationship between two
types.  This is meant to quickly display the relationship between two
types and therefore does not include all of the options present in the
standard queries and analyses.
\nFor additional help on this topic select \"Types Relationship Summary
Analysis\" from the help menu."
}
proc Apol_Analysis_tra::newAnalysis {} {
    if {[set rt [_checkParams]] != {}} {
        return $rt
    }
    set results [_analyze]
    set f [_createResultsDisplay]
    _renderResults $f $results
    $results -acquire
    $results -delete
    return {}
}
proc Apol_Analysis_tra::updateAnalysis {f} {
    if {[set rt [_checkParams]] != {}} {
        return $rt
    }
    set results [_analyze]
    _clearResultsDisplay $f
    _renderResults $f $results
    $results -acquire
    $results -delete
    return {}
}
proc Apol_Analysis_tra::reset {} {
    _reinitializeVals
    _reinitializeWidgets
}
proc Apol_Analysis_tra::switchTab {query_options} {
    variable vals
    variable widgets
    array set vals $query_options
    _reinitializeWidgets
}
proc Apol_Analysis_tra::saveQuery {channel} {
    variable vals
    variable widgets
    foreach {key value} [array get vals] {
        puts $channel "$key $value"
    }
    set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(typeA)]
    puts $channel "typeA [lindex $type 0]"
    puts $channel "typeA:attrib [lindex $type 1]"
    set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(typeB)]
    puts $channel "typeB [lindex $type 0]"
    puts $channel "typeB:attrib [lindex $type 1]"
}
proc Apol_Analysis_tra::loadQuery {channel} {
    variable vals
    set classes_exc {}
    set subjects_exc {}
    while {[gets $channel line] >= 0} {
        set line [string trim $line]
        if {$line == {} || [string index $line 0] == "#"} {
            continue
        }
        set key {}
        set value {}
        regexp -line -- {^(\S+)( (.+))?} $line -> key --> value
        set vals($key) $value
    }
    _reinitializeWidgets
}
proc Apol_Analysis_tra::getTextWidget {tab} {
    return [$tab.right getframe].res.tb
}
proc Apol_Analysis_tra::_reinitializeVals {} {
    variable vals
    set vals(run:attribs) $::APOL_TYPES_RELATION_COMMON_ATTRIBS
    set vals(run:roles) $::APOL_TYPES_RELATION_COMMON_ROLES
    set vals(run:users) $::APOL_TYPES_RELATION_COMMON_USERS
    array set vals {
        typeA {}  typeA:attrib {}
        typeB {}  typeB:attrib {}
        run:similars 0
        run:dissimilars 0
        run:allows 0
        run:typerules 0
        run:direct 0
        run:transAB 0
        run:transBA 0
        run:domainAB 0
        run:domainBA 0
    }
}
proc Apol_Analysis_tra::_reinitializeWidgets {} {
    variable vals
    variable widgets
    if {$vals(typeA:attrib) != {}} {
        Apol_Widget::setTypeComboboxValue $widgets(typeA) [list $vals(typeA) $vals(typeA:attrib)]
    } else {
        Apol_Widget::setTypeComboboxValue $widgets(typeA) $vals(typeA)
    }
    if {$vals(typeB:attrib) != {}} {
        Apol_Widget::setTypeComboboxValue $widgets(typeB) [list $vals(typeB) $vals(typeB:attrib)]
    } else {
        Apol_Widget::setTypeComboboxValue $widgets(typeB) $vals(typeB)
    }
}
proc Apol_Analysis_tra::_checkParams {} {
    variable vals
    variable widgets
    if {![ApolTop::is_policy_open]} {
        return "No current policy file is opened."
    }
    set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(typeA)]
    if {[lindex $type 0] == {}} {
        return "No type was selected for type A."
    }
    if {![Apol_Types::isTypeInPolicy [lindex $type 0]]} {
        return "[lindex $type 0] is not a type within the policy."
    }
    set vals(typeA) [lindex $type 0]
    set vals(typeA:attrib) [lindex $type 1]
    set type [Apol_Widget::getTypeComboboxValueAndAttrib $widgets(typeB)]
    if {[lindex $type 0] == {}} {
        return "No type was selected for type B."
    }
    if {![Apol_Types::isTypeInPolicy [lindex $type 0]]} {
        return "[lindex $type 0] is not a type within the policy."
    }
    set vals(typeB) [lindex $type 0]
    set vals(typeB:attrib) [lindex $type 1]
    set analysis_selected 0
    foreach key [array names vals run:*] {
        if {$vals($key)} {
            if {($key == "run:direct" || [string match run:trans* $key]) && \
                    ![Apol_Perms_Map::is_pmap_loaded]} {
                if {![ApolTop::openDefaultPermMap]} {
                    return "This analysis requires that a permission map is loaded."
                }
                apol_tcl_clear_info_string
            }
            set analysis_selected 1
        }
    }
    if {!$analysis_selected} {
        return "At least one analysis must be selected."
    }
    return {}  ;# all parameters passed, now ready to do search
}
proc Apol_Analysis_tra::_analyze {} {
    variable vals
    set q [new_apol_types_relation_analysis_t]
    $q set_first_type $::ApolTop::policy $vals(typeA)
    $q set_other_type $::ApolTop::policy $vals(typeB)
    set analyses 0
    foreach key [array names vals run:*] {
        set analyses [expr {$analyses | $vals($key)}]
    }
    $q set_analyses $::ApolTop::policy $analyses
    set results [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    return $results
}
proc Apol_Analysis_tra::_createResultsDisplay {} {
    variable vals
    set f [Apol_Analysis::createResultTab "Types Relationship" [array get vals]]
    set tree_tf [TitleFrame $f.left -text "Types Relationship Results"]
    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 "Types Relationship Information"]
    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}
    $res.tb tag configure num -foreground blue -font {Helvetica 10 bold}
    pack $res -expand 1 -fill both
    update
    grid propagate $sw 0
    $tree configure -selectcommand [list Apol_Analysis_tra::_treeSelect $res]
    return $f
}
proc Apol_Analysis_tra::_treeSelect {res tree node} {
    if {$node != {}} {
        $res.tb configure -state normal
        $res.tb delete 0.0 end
        set data [$tree itemcget $node -data]
        set name [$tree itemcget $node -text]
        if {[set parent [$tree parent $node]] != "root"} {
            set parent_name [$tree itemcget $parent -text]
            set parent_data [$tree itemcget $parent -data]
        }
        switch -glob -- $node {
            pre:* {
                eval $res.tb insert end $data
            }
            simtitle {
                _showSimilarTitle $res $data
            }
            sim:* {
                _showSimilar $res $name $parent_data $data
            }
            distitle {
                _showDissimilarTitle $res $data
            }
            dissubtitle* {
                _showDissimilarSubtitle $res $data
            }
            dis:* {
                _showDissimilar $res $name $parent_name $data
            }
            allow {
                _showAllows $res $data
            }
            typerules {
                _showTypeRules $res $data
            }
            x* {
                _showDirectFlow $res $data
            }
            y* {
                _showTransFlow $res $data
            }
            f:* {
                _showDTA $res $data
            }
        }
        $res.tb configure -state disabled
    }
}
proc Apol_Analysis_tra::_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_tra::_renderResults {f results} {
    variable vals
    set tree [[$f.left getframe].sw getframe].tree
    set res [$f.right getframe].res
    if {$vals(run:attribs)} {
        _renderCommon Attributes $tree $results get_attributes attr_vector_to_list
    }
    if {$vals(run:roles)} {
        _renderCommon Roles $tree $results get_roles role_vector_to_list
    }
    if {$vals(run:users)} {
        _renderCommon Users $tree $results get_users user_vector_to_list
    }
    if {$vals(run:similars)} {
        _renderSimilars $tree $results
    }
    if {$vals(run:dissimilars)} {
        _renderDissimilars $tree $results
    }
    if {$vals(run:allows)} {
        _renderAllows $tree $results
    }
    if {$vals(run:typerules)} {
        _renderTypeRules $tree $results
    }
    if {$vals(run:direct)} {
        _renderDirectFlow $tree $results
    }
    if {$vals(run:transAB)} {
        _renderTransFlow 0 $tree $results
    }
    if {$vals(run:transBA)} {
        _renderTransFlow 1 $tree $results
    }
    if {$vals(run:domainAB)} {
        _renderDTA 0 $tree $results
    }
    if {$vals(run:domainBA)} {
        _renderDTA 1 $tree $results
    }
    set first_node [$tree nodes root 0]
    $tree selection set $first_node
    $tree see $first_node
}
proc Apol_Analysis_tra::_renderCommon {title tree results func convert_func} {
    set names [$convert_func [$results $func]]
    set text [list "Common $title ([llength $names]):\n\n" title]
    foreach n [lsort $names] {
        lappend text "$n\n" {}
    }
    $tree insert end root pre:$title -text "Common $title" -data $text
}
proc Apol_Analysis_tra::_types_relation_access_vector_to_list {v} {
    set l {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set a [apol_types_relation_access_from_void [$v get_element $i]]
        set type [[$a get_type] get_name $::ApolTop::qpolicy]
        set rules [avrule_vector_to_list [$a get_rules]]
        lappend l [list $type $rules]
    }
    set l
}
proc Apol_Analysis_tra::_renderSimilars {tree results} {
    variable vals
    set simA [_types_relation_access_vector_to_list [$results get_similar_first]]
    set simB [_types_relation_access_vector_to_list [$results get_similar_other]]
    set data [list $vals(typeA) $vals(typeB) [llength $simA]]
    $tree insert end root simtitle -text "Similar access to resources" -data $data -drawcross allways
    foreach accessA [lsort -index 0 $simA] accessB [lsort -index 0 $simB] {
        set type [lindex $accessA 0]
        set rulesA [lindex $accessA 1]
        set rulesB [lindex $accessB 1]
        $tree insert end simtitle sim:$type -text $type -data [list $rulesA $rulesB]
    }
}
proc Apol_Analysis_tra::_showSimilarTitle {res data} {
    foreach {typeA typeB numTypes} $data {break}
    $res.tb insert end $typeA title_type \
        " and " title \
        $typeB title_type \
        " access $numTypes common type(s).\n\n" title \
        "Open the subtree for this item to see the list of common types that
can be accessed.  You may then select a type from the subtree to see
the allow rules which provide the access." {}
}
proc Apol_Analysis_tra::_showSimilar {res name parent_data data} {
    foreach {typeA typeB} $parent_data {rulesA rulesB} $data {break}
    $res.tb insert end $typeA title_type \
        " accesses " title \
        $name title_type \
        ":\n\n" title
    set v [new_apol_vector_t]
    foreach r $rulesA {
        $v append $r
    }
    apol_tcl_avrule_sort $::ApolTop::policy $v
    Apol_Widget::appendSearchResultRules $res 2 $v qpol_avrule_from_void
    $v -acquire
    $v -delete
    $res.tb insert end "\n" title \
        $typeB title_type \
        " accesses " title \
        $name title_type \
        ":\n\n" title
    set v [new_apol_vector_t]
    foreach r $rulesB {
        $v append $r
    }
    apol_tcl_avrule_sort $::ApolTop::policy $v
    Apol_Widget::appendSearchResultRules $res 2 $v qpol_avrule_from_void
    $v -acquire
    $v -delete
}
proc Apol_Analysis_tra::_renderDissimilars {tree results} {
    variable vals
    set disA [_types_relation_access_vector_to_list [$results get_dissimilar_first]]
    set disB [_types_relation_access_vector_to_list [$results get_dissimilar_other]]
    set data [list $vals(typeA) $vals(typeB)]
    $tree insert end root distitle -text "Dissimilar access to resources" -data $data
    set data [list $vals(typeA) $vals(typeB) [llength $disA]]
    $tree insert end distitle dissubtitleA -text $vals(typeA) -data $data -drawcross allways
    foreach access [lsort -index 0 $disA] {
        set type [lindex $access 0]
        set rules [lindex $access 1]
        $tree insert end dissubtitleA dis:$type -text $type -data $rules
    }
    set data [list $vals(typeB) $vals(typeA) [llength $disB]]
    $tree insert end distitle dissubtitleB -text $vals(typeB) -data $data -drawcross allways
    foreach access [lsort -index 0 $disB] {
        set type [lindex $access 0]
        set rules [lindex $access 1]
        $tree insert end dissubtitleB dis:$type -text $type -data $rules
    }
}
proc Apol_Analysis_tra::_showDissimilarTitle {res data} {
    foreach {typeA typeB} $data {break}
    $res.tb insert end "Dissimilar access between " title \
        $typeA title_type \
        " and " title \
        $typeB title_type \
        ".\n\n" title \
        "Open the subtree for this item to access individual subtrees of types
which can be accessed by one type but not the other.  You may then
select a type from a subtree to see the allow rules which provide the
access." {}
}
proc Apol_Analysis_tra::_showDissimilarSubtitle {res data} {
    foreach {one_type other_type numTypes} $data {break}
    $res.tb insert end $one_type title_type \
        " accesss $numTypes type(s) to which " title \
        $other_type title_type \
        " does not have access.\n\n" title \
        "Open the subtree for this item to see the list of types.  You may then
select a type from the subtree to see the allow rules which provide
the access." {}
}
proc Apol_Analysis_tra::_showDissimilar {res name parent_name data} {
    $res.tb insert end $parent_name title_type \
        " accesses " title \
        $name title_type \
        ":\n\n" title
    set v [new_apol_vector_t]
    foreach r $data {
        $v append $r
    }
    apol_tcl_avrule_sort $::ApolTop::policy $v
    Apol_Widget::appendSearchResultRules $res 2 $v qpol_avrule_from_void
    $v -acquire
    $v -delete
}
proc Apol_Analysis_tra::_renderAllows {tree results} {
    set rules [$results get_allowrules]
    set rules_dup [new_apol_vector_t $rules]
    $rules_dup -acquire
    apol_tcl_avrule_sort $::ApolTop::policy $rules_dup
    $tree insert end root allow -text "TE Allow Rules" -data $rules_dup
}
proc Apol_Analysis_tra::_showAllows {res data} {
    $res.tb insert end "TE Allow Rules ([$data get_size]):\n\n" title
    Apol_Widget::appendSearchResultRules $res 2 $data qpol_avrule_from_void
}
proc Apol_Analysis_tra::_renderTypeRules {tree results} {
    set rules [$results get_typerules]
    set rules_dup [new_apol_vector_t $rules]
    apol_tcl_terule_sort $::ApolTop::policy $rules_dup
    $rules_dup -acquire
    $tree insert end root typerules -text "Type Transition/Change Rules" -data $rules_dup
}
proc Apol_Analysis_tra::_showTypeRules {res data} {
    $res.tb insert end "Type transition/change rules ([$data get_size]):\n\n" title
    Apol_Widget::appendSearchResultRules $res 2 $data qpol_terule_from_void
}
proc Apol_Analysis_tra::_renderDirectFlow {tree results} {
    set v [$results get_directflows]
    if {$v == "NULL" || [$v get_size] == 0} {
        $tree insert end root pre:direct
        set node [$tree nodes root end]
        set data [list "No direct information flows found." title]
    } else {
        variable vals
        Apol_Analysis_directflow::appendResultsNodes $tree root $v
        set node [$tree nodes root end]
        set data [list $vals(typeA) $vals(typeB) [$tree itemcget $node -data]]
    }
    $tree itemconfigure $node -text "Direct Flows Between A and B" -data $data -drawcross auto
}
proc Apol_Analysis_tra::_showDirectFlow {res data} {
    foreach {parent_name name data} $data {break}
    foreach {flow_dir classes} [lindex $data 1] {break}
    $res.tb insert end "Information flows both into and out of " title \
        $parent_name title_type \
        " from/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
    }
}
proc Apol_Analysis_tra::_renderTransFlow {dir tree results} {
    variable vals
    if {$dir == 0} {
        set title2 "A->B"
        set v [$results get_transflowsAB]
        set data [list $vals(typeB) $vals(typeA)]
    } else {
        set title2 "B->A"
        set v [$results get_transflowsBA]
        set data [list $vals(typeA) $vals(typeB)]
    }
    if {$v == "NULL" || [$v get_size] == 0} {
        $tree insert end root pre:trans$dir
        set node [$tree nodes root end]
        set data [list "No transitive information flows found." title]
    } else {
        Apol_Analysis_transflow::appendResultsNodes $tree root $v
        set node [$tree nodes root end]
        lappend data [$tree itemcget $node -data]
    }
    $tree itemconfigure $node -text "Transitive Flows $title2" -data $data -drawcross auto
}
proc Apol_Analysis_tra::_showTransFlow {res data} {
    foreach {parent_name name data} $data {break}
    foreach {flow_dir paths} [lindex $data 1] {break}
    $res.tb insert end "Information flows from " title \
        $name title_type \
        " to " title \
        $parent_name title_type
    $res.tb insert end "\n\n" title \
        "Apol found the following number of information flows: " subtitle \
        [llength $paths] num \
        "\n" subtitle
    set path_num 1
    foreach path $paths {
        $res.tb insert end "\n" {}
        Apol_Analysis_transflow::renderPath $res $path_num $path
        incr path_num
    }
}
proc Apol_Analysis_tra::_renderDTA {dir tree results} {
    variable vals
    if {$dir == 0} {
        set title2 "A->B"
        set data [list $vals(typeA) $vals(typeB)]
        set dta [$results get_domainsAB]
    } else {
        set title2 "B->A"
        set data [list $vals(typeB) $vals(typeA)]
        set dta [$results get_domainsBA]
    }
    if {$dta == "NULL" || [$dta get_size] == 0} {
        $tree insert end root pre:dta$dir
        set node [$tree nodes root end]
        set data [list "No domain transitions found." title]
    } else {
        Apol_Analysis_domaintrans::appendResultsNodes $tree root $dta
        set node [$tree nodes root end]
        lappend data [$tree itemcget $node -data]
    }
    $tree itemconfigure $node -text "Domain Transitions $title2" -data $data -drawcross auto
}
proc Apol_Analysis_tra::_showDTA {res data} {
    foreach {parent_name name data} $data {break}
    foreach {proctrans setexec ep access_list} [lindex $data 1] {break}
    set header [list "Domain transition from " title \
                    $parent_name title_type \
                    " to " title \
                    $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
    }
}
namespace eval Apol_Types {
    variable typelist {}
    variable attriblist {}
    variable opts
    variable widgets
}
proc Apol_Types::create {tab_name nb} {
    variable opts
    variable widgets
    _initializeVars
    set frame [$nb insert end $tab_name -text "Types"]
    set pw1   [PanedWindow $frame.pw -side top]
    set left_pane   [$pw1 add -weight 0]
    set center_pane [$pw1 add -weight 1]
    set tpane [frame $left_pane.t]
    set apane [frame $left_pane.a]
    set tbox [TitleFrame $tpane.tbox -text "Types"]
    set abox [TitleFrame $apane.abox -text "Attributes"]
    set obox [TitleFrame $center_pane.obox -text "Search Options"]
    set rbox [TitleFrame $center_pane.rbox -text "Search Results"]
    pack $obox -side top -expand 0 -fill both -padx 2
    pack $rbox -expand yes -fill both -padx 2
    pack $tbox -fill both -expand yes
    pack $abox -fill both -expand yes
    pack $pw1 -fill both -expand yes
    pack $tpane -fill both -expand 1
    pack $apane -fill both -expand 1
    set tlistbox [Apol_Widget::makeScrolledListbox [$tbox getframe].types \
                      -height 10 -width 20 -listvar Apol_Types::typelist]
    Apol_Widget::setListboxCallbacks $tlistbox \
        {{"Show Type Info" {Apol_Types::_popupTypeInfo type}}}
    pack $tlistbox -expand 1 -fill both
    set alistbox [Apol_Widget::makeScrolledListbox [$abox getframe].attribs \
                      -height 5 -width 20 -listvar Apol_Types::attriblist]
    Apol_Widget::setListboxCallbacks $alistbox {{"Show Attribute Info" {Apol_Types::_popupTypeInfo attrib}}}
    pack $alistbox -expand 1 -fill both
    set ofm [$obox getframe]
    set fm_types_select [frame $ofm.to]
    set fm_attribs_select [frame $ofm.ao]
    pack $fm_types_select $fm_attribs_select -side left -padx 4 -pady 2 -anchor nw
    set types_select [checkbutton $fm_types_select.type -text "Show types" -variable Apol_Types::opts(types)]
    set typeattribs [checkbutton $fm_types_select.typeattribs -text "Include attributes" \
	-variable Apol_Types::opts(types:show_attribs)]
    pack $types_select -anchor w
    pack $typeattribs -anchor w -padx 8
    trace add variable Apol_Types::opts(types) write \
        [list Apol_Types::_toggleCheckbuttons $typeattribs]
    set attribs_select [checkbutton $fm_attribs_select.type -text "Show attributes" \
	-variable Apol_Types::opts(attribs)]
    set a_types [checkbutton $fm_attribs_select.types -text "Include types" \
	-variable Apol_Types::opts(attribs:show_types) -state disabled]
    set a_typeattribs [checkbutton $fm_attribs_select.typeattribs -text "Include types' attributes" \
	-variable Apol_Types::opts(attribs:show_attribs) -state disabled]
    pack $attribs_select -anchor w
    pack $a_types $a_typeattribs -anchor w -padx 8
    trace add variable Apol_Types::opts(attribs) write \
        [list Apol_Types::_toggleCheckbuttons [list $a_typeattribs $a_types]]
    set widgets(regexp) [Apol_Widget::makeRegexpEntry $ofm.regexpf]
    Apol_Widget::setRegexpEntryState $widgets(regexp) 1
    pack $widgets(regexp) -side left -padx 4 -pady 2 -anchor nw
    set ok [button $ofm.ok -text OK -width 6 -command Apol_Types::_searchTypes]
    pack $ok -side right -padx 5 -pady 5 -anchor ne
    set widgets(results) [Apol_Widget::makeSearchResults [$rbox getframe].results]
    pack $widgets(results) -expand yes -fill both
    return $frame
}
proc Apol_Types::open {ppath} {
    set q [new_apol_type_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    variable typelist [lsort [type_vector_to_list $v]]
    $v -acquire
    $v -delete
    set q [new_apol_attr_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    variable attriblist [lsort [attr_vector_to_list $v]]
    $v -acquire
    $v -delete
}
proc Apol_Types::close {} {
    variable widgets
    _initializeVars
    set Apol_Types::typelist {}
    set Apol_Types::attriblist {}
    Apol_Widget::clearSearchResults $widgets(results)
}
proc Apol_Types::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_Types::isTypeInPolicy {type} {
    if {![ApolTop::is_policy_open]} {
        return 0
    }
    set q [new_apol_type_query_t]
    $q set_type $::ApolTop::policy $type
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    if {$v == "NULL" || [$v get_size] == 0} {
        set retval 0
    } else {
        set retval 1
    }
    $v -acquire
    $v -delete
    set retval
}
proc Apol_Types::isAttributeInPolicy {attrib} {
    variable attriblist
    if {[ApolTop::is_policy_open] && [lsearch $attriblist $attrib] >= 0} {
        return 1
    }
    return 0
}
proc Apol_Types::getTypes {} {
    variable typelist
    set typelist
}
proc Apol_Types::getAttributes {} {
    variable attriblist
    set attriblist
}
proc Apol_Types::_initializeVars {} {
    variable opts
    array set opts {
        types 1    types:show_attribs 1  types:show_aliases 1
        attribs 0  attribs:show_types 1  attribs:show_attribs 1
    }
}
proc Apol_Types::_toggleCheckbuttons {w name1 name2 op} {
    variable opts
    variable widgets
    if {$opts($name2)} {
        foreach x $w {
            $x configure -state normal
        }
    } else {
        foreach x $w {
            $x configure -state disabled
        }
    }
    if {!$opts(types) && !$opts(attribs)} {
        Apol_Widget::setRegexpEntryState $widgets(regexp) 0
    } else {
        Apol_Widget::setRegexpEntryState $widgets(regexp) 1
    }
}
proc Apol_Types::_popupTypeInfo {which ta} {
    if {[Apol_File_Contexts::is_db_loaded]} {
        set entry_vector [Apol_File_Contexts::get_fc_files_for_ta $which $ta]
        set index_file_loaded 1
    } else {
        set entry_vector {}
        set index_file_loaded 0
    }
    if {$which == "type"} {
        set info_ta [_renderType $ta 1 1]
    } else {
        set info_ta [_renderAttrib $ta 1 0]
    }
    set w .ta_infobox
    destroy $w
    set w [Dialog .ta_infobox -cancel 0 -default 0 -modal none -parent . -separator 1 -title $ta]
    $w add -text "Close" -command [list destroy $w]
    set notebook [NoteBook [$w getframe].nb]
    pack $notebook -expand 1 -fill both
    set ta_info_tab [$notebook insert end ta_info_tab]
    set fc_info_tab [$notebook insert end fc_info_tab -text "Files"]
    if {$which == "type"} {
        $notebook itemconfigure ta_info_tab -text "Attributes"
    } else {
        $notebook itemconfigure ta_info_tab -text "Types"
    }
    set sw [ScrolledWindow [$notebook getframe ta_info_tab].sw -scrollbar both -auto both]
    set text [text [$sw getframe].text -wrap none -font {helvetica 10} -bg white]
    $sw setwidget $text
    pack $sw -expand 1 -fill both
    $text insert 0.0 $info_ta
    $text configure -state disabled
    if {$which != "type"} {
        set l [label [$notebook getframe fc_info_tab].l \
                   -text "Files labeled with types that are members of this attribute:" \
                   -justify left]
        pack $l -anchor nw
    }
    set sw [ScrolledWindow [$notebook getframe fc_info_tab].sw -scrollbar both -auto both]
    set fc_text [text [$sw getframe].text -wrap none -font {helvetica 10} -bg white]
    $sw setwidget $fc_text
    pack $sw -expand 1 -fill both
    $notebook raise [$notebook page 0]
    if {$index_file_loaded} {
        if {$entry_vector != {}} {
            set num [$entry_vector get_size]
            $fc_text insert 1.0 "Number of files: $num\n\n"
            for {set i 0} {$i < $num} {incr i} {
                set entry [sefs_entry_from_void [$entry_vector get_element $i]]
                $fc_text insert end "[$entry toString]\n"
            }
            $entry_vector -delete
        } else {
            $fc_text insert end "No files found."
        }
    } else {
        $fc_text insert 0.0 "No index file is loaded.  Load an index file through the File Contexts tab."
    }
    $fc_text configure -state disabled
    $w draw {} 0 400x400
}
proc Apol_Types::_searchTypes {} {
    variable widgets
    variable opts
    Apol_Widget::clearSearchResults $widgets(results)
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
        return
    }
    if {$opts(types) == 0 && $opts(attribs) == 0} {
        tk_messageBox -icon error -type ok -title "Error" -message "No search options provided."
        return
    }
    set use_regexp [Apol_Widget::getRegexpEntryState $widgets(regexp)]
    set regexp [Apol_Widget::getRegexpEntryValue $widgets(regexp)]
    if {$use_regexp} {
        if {$regexp == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No regular expression provided."
            return
        }
    } else {
        set regexp {}
    }
    set results {}
    if {$opts(types)} {
        set q [new_apol_type_query_t]
        $q set_type $::ApolTop::policy $regexp
        $q set_regex $::ApolTop::policy $use_regexp
        set v [$q run $::ApolTop::policy]
        $q -acquire
        $q -delete
        set types_data [type_vector_to_list $v]
        $v -acquire
        $v -delete
        append results "TYPES ([llength $types_data]):\n\n"
        foreach t [lsort $types_data] {
            append results "[_renderType $t $opts(types:show_attribs) $opts(types:show_aliases)]\n"
        }
    }
    if {$opts(attribs)} {
        set q [new_apol_attr_query_t]
        $q set_attr $::ApolTop::policy $regexp
        $q set_regex $::ApolTop::policy $use_regexp
        set v [$q run $::ApolTop::policy]
        $q -acquire
        $q -delete
        set attribs_data [attr_vector_to_list $v]
        $v -acquire
        $v -delete
        if {$opts(types)} {
            append results "\n\n"
        }
        append results "ATTRIBUTES ([llength $attribs_data]):\n\n"
        foreach a [lsort $attribs_data] {
            append results "[_renderAttrib $a $opts(attribs:show_types) $opts(attribs:show_attribs)]\n"
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) $results
}
proc Apol_Types::_renderType {type_name show_attribs show_aliases} {
    set qpol_type_datum [new_qpol_type_t $::ApolTop::qpolicy $type_name]
    set aliases {}
    set attribs {}
    set i [$qpol_type_datum get_alias_iter $::ApolTop::qpolicy]
    set aliases [iter_to_str_list $i]
    $i -acquire
    $i -delete
    set i [$qpol_type_datum get_attr_iter $::ApolTop::qpolicy]
    foreach a [iter_to_list $i] {
        set a [qpol_type_from_void $a]
        lappend attribs [$a get_name $::ApolTop::qpolicy]
    }
    $i -acquire
    $i -delete
    set text "$type_name"
    if {$show_aliases && [llength $aliases] > 0} {
        append text " alias [list $aliases]"
    }
    if {$show_attribs} {
        append text " ([llength $attribs] attribute"
        if {[llength $attribs] != 1} {
            append text s
        }
        append text ")\n"
        foreach a [lsort $attribs] {
            append text "    $a\n"
        }
    }
    return $text
}
proc Apol_Types::_renderAttrib {attrib_name show_types show_attribs} {
    set qpol_type_datum [new_qpol_type_t $::ApolTop::qpolicy $attrib_name]
    set text "$attrib_name"
    if {$show_types} {
        set types {}
        set i [$qpol_type_datum get_type_iter $::ApolTop::qpolicy]
        foreach t [iter_to_list $i] {
            set t [qpol_type_from_void $t]
            lappend types [$t get_name $::ApolTop::qpolicy]
        }
        $i -acquire
        $i -delete
        append text " ([llength $types] type"
        if {[llength $types] != 1} {
            append text s
        }
        append text ")\n"
        foreach type_name [lsort $types] {
            append text "    $type_name"
            if {$show_attribs} {
                set t [new_qpol_type_t $::ApolTop::qpolicy $type_name]
                set this_attribs {}
                set i [$t get_attr_iter $::ApolTop::qpolicy]
                foreach a [iter_to_list $i] {
                    set a [qpol_type_from_void $a]
                    lappend this_attribs [$a get_name $::ApolTop::qpolicy]
                }
                $i -acquire
                $i -delete
                set this_attribs [lsort $this_attribs]
                set idx [lsearch -sorted -exact $attrib_name $this_attribs]
                append text "  { [lreplace $this_attribs $idx $idx] }"
            }
            append text "\n"
        }
    }
    return $text
}
namespace eval Apol_Users {
    variable opts
    variable widgets
    variable users_list {}
}
proc Apol_Users::create {tab_name nb} {
    variable opts
    variable widgets
    _initializeVars
    set frame [$nb insert end $tab_name -text "Users"]
    set pw1   [PanedWindow $frame.pw -side top]
    set rpane [$pw1 add -weight 0]
    set spane [$pw1 add -weight 1]
    set userbox [TitleFrame $rpane.userbox -text "Users"]
    set s_optionsbox [TitleFrame $spane.obox -text "Search Options"]
    set resultsbox [TitleFrame $spane.rbox -text "Search Results"]
    pack $pw1 -fill both -expand yes
    pack $s_optionsbox -side top -expand 0 -fill both -padx 2
    pack $userbox -fill both -expand yes
    pack $resultsbox -expand yes -fill both -padx 2
    set users_listbox [Apol_Widget::makeScrolledListbox [$userbox getframe].lb -width 20 -listvar Apol_Users::users_list]
    Apol_Widget::setListboxCallbacks $users_listbox \
        {{"Display User Info" {Apol_Users::_popupUserInfo users}}}
    pack $users_listbox -fill both -expand yes
    set ofm [$s_optionsbox getframe]
    set verboseFrame [frame $ofm.verbose]
    set rolesFrame [frame $ofm.roles]
    set defaultFrame [frame $ofm.default]
    set rangeFrame [frame $ofm.range]
    pack $verboseFrame $rolesFrame $defaultFrame $rangeFrame \
        -side left -padx 4 -pady 2 -anchor nw -expand 0 -fill y
    radiobutton $verboseFrame.all_info -text "All information" \
        -variable Apol_Users::opts(showSelection) -value all
    radiobutton $verboseFrame.names_only -text "Names only" \
        -variable Apol_Users::opts(showSelection) -value names
    pack $verboseFrame.all_info $verboseFrame.names_only -anchor w -padx 5 -pady 4
    checkbutton $rolesFrame.cb -variable Apol_Users::opts(useRole) -text "Role"
    set widgets(role) [ComboBox $rolesFrame.combo -width 12 -textvariable Apol_Users::opts(role) \
                           -helptext "Type or select a role" -state disabled \
                           -autopost 1]
    trace add variable Apol_Users::opts(useRole) write \
        [list Apol_Users::_toggleRolesCheckbutton $widgets(role)]
    pack $rolesFrame.cb -anchor nw
    pack $widgets(role) -padx 4
    set widgets(defaultCB) [checkbutton $defaultFrame.cb -variable Apol_Users::opts(enable_default) -text "Default MLS level"]
    set defaultDisplay [Entry $defaultFrame.display -textvariable Apol_Users::opts(default_level_display) -width 16 -editable 0]
    set defaultButton [button $defaultFrame.button -text "Select Level..." -state disabled -command [list Apol_Users::_show_level_dialog]]
    trace add variable Apol_Users::opts(enable_default) write \
        [list Apol_Users::_toggleDefaultCheckbutton $widgets(defaultCB) $defaultDisplay $defaultButton]
    trace add variable Apol_Users::opts(default_level) write \
        [list Apol_Users::_updateDefaultDisplay $defaultDisplay]
    pack $widgets(defaultCB) -side top -anchor nw -expand 0
    pack $defaultDisplay -side top -expand 0 -fill x -padx 4
    pack $defaultButton -side top -expand 1 -fill none -padx 4 -anchor ne
    set widgets(range) [Apol_Widget::makeRangeSelector $rangeFrame.range Users]
    pack $widgets(range) -expand 1 -fill x
    button $ofm.ok -text OK -width 6 -command Apol_Users::_searchUsers
    pack $ofm.ok -side right -pady 5 -padx 5 -anchor ne
    set widgets(results) [Apol_Widget::makeSearchResults [$resultsbox getframe].results]
    pack $widgets(results) -expand yes -fill both
    return $frame
}
proc Apol_Users::open {ppath} {
    set q [new_apol_user_query_t]
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    variable users_list [lsort [user_vector_to_list $v]]
    $v -acquire
    $v -delete
    variable opts
    variable widgets
    $Apol_Users::widgets(role) configure -values [Apol_Roles::getRoles]
    if {[ApolTop::is_capable "mls"]} {
        Apol_Widget::setRangeSelectorCompleteState $widgets(range) normal
        $widgets(defaultCB) configure -state normal
    } else {
        Apol_Widget::clearRangeSelector $widgets(range)
        Apol_Widget::setRangeSelectorCompleteState $widgets(range) disabled
        set opts(enable_default) 0
        $widgets(defaultCB) configure -state disabled
    }
}
proc Apol_Users::close {} {
    variable widgets
    _initializeVars
    variable users_list {}
    $widgets(role) configure -values ""
    Apol_Widget::clearSearchResults $widgets(results)
    Apol_Widget::clearRangeSelector $widgets(range)
    Apol_Widget::setRangeSelectorCompleteState $widgets(range) normal
    $widgets(defaultCB) configure -state normal
}
proc Apol_Users::getTextWidget {} {
    variable widgets
    return $widgets(results).tb
}
proc Apol_Users::getUsers {} {
    variable users_list
    set users_list
}
proc Apol_Users::_initializeVars {} {
    variable opts
    array set opts {
        showSelection all
        useRole 0         role {}
        enable_default 0  default_level {}
    }
}
proc Apol_Users::_toggleRolesCheckbutton {path name1 name2 op} {
    variable opts
    if {$opts($name2)} {
    $path configure -state normal -entrybg white
    } else {
        $path configure -state disabled -entrybg $ApolTop::default_bg_color
    }
}
proc Apol_Users::_toggleDefaultCheckbutton {cb display button name1 name2 op} {
    variable opts
    if {$opts($name2)} {
        $button configure -state normal
        $display configure -state normal
    } else {
        $button configure -state disabled
        $display configure -state disabled
    }
}
proc Apol_Users::_show_level_dialog {} {
    variable opts
    .mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.default.button configure -state disabled
    set new_level [Apol_Level_Dialog::getLevel $opts(default_level)]
    if {$new_level != {}} {
        set opts(default_level) $new_level
        $opts(default_level) -acquire
    }
    .mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.default.button configure -state normal
}
proc Apol_Users::_updateDefaultDisplay {display name1 name2 op} {
    variable opts
    if {$opts(default_level) == {}} {
        set opts(default_level_display) {}
        $display configure -helptext {}
    } else {
        set level [$opts(default_level) render $::ApolTop::policy]
        if {$level == {}} {
            set opts(default_level_display) "<invalid MLS level>"
        } else {
            set opts(default_level_display) $level
        }
        $display configure -helptext $opts(default_level_display)
    }
}
proc Apol_Users::_popupUserInfo {which user} {
    Apol_Widget::showPopupText $user [_renderUser $user 1]
}
proc Apol_Users::_searchUsers {} {
    variable opts
    variable widgets
    .mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.ok configure -state disabled
    Apol_Widget::clearSearchResults $widgets(results)
    if {![ApolTop::is_policy_open]} {
        tk_messageBox -icon error -type ok -title "Error" -message "No current policy file is opened."
        .mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.ok configure -state normal
        return
    }
    if {$opts(useRole)} {
        if {$opts(role) == ""} {
            tk_messageBox -icon error -type ok -title "Error" -message "No role selected."
            .mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.ok configure -state normal
            return
        }
        set role $opts(role)
    } else {
        set role {}
    }
    if {$opts(enable_default)} {
        if {$opts(default_level) == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No default level selected."
            .mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.ok configure -state normal
            return
        }
        set default $opts(default_level)
    } else {
        set default NULL
    }
    set range_enabled [Apol_Widget::getRangeSelectorState $widgets(range)]
    foreach {range range_type} [Apol_Widget::getRangeSelectorValue $widgets(range)] {break}
    if {$range_enabled} {
        if {$range == {}} {
            tk_messageBox -icon error -type ok -title "Error" -message "No range selected."
            .mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.ok configure -state normal
            return
        }
    } else {
        set range NULL
    }
    if {$opts(showSelection) == "all"} {
        set show_all 1
    } else {
        set show_all 0
    }
    set q [new_apol_user_query_t]
    $q set_role $::ApolTop::policy $role
    $q set_default_level $::ApolTop::policy $default
    $q set_range $::ApolTop::policy $range $range_type
    set v [$q run $::ApolTop::policy]
    $q -acquire
    $q -delete
    set users_data [user_vector_to_list $v]
    $v -acquire
    $v -delete
    set text "USERS:\n"
    if {[llength $users_data] == 0} {
        append text "Search returned no results."
    } else {
        foreach u [lsort -index 0 $users_data] {
            append text "\n[_renderUser $u $show_all]"
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) $text
    .mainframe.frame.nb.fcomponents.nb.fApol_Users.pw.f1.frame.obox.f.ok configure -state normal
}
proc Apol_Users::_renderUser {user_name show_all} {
    set text "$user_name"
    if {!$show_all} {
        return $text
    }
    set qpol_user_datum [new_qpol_user_t $::ApolTop::qpolicy $user_name]
    if {[ApolTop::is_capable "mls"]} {
        set default [$qpol_user_datum get_dfltlevel $::ApolTop::qpolicy]
        set apol_default [new_apol_mls_level_t $::ApolTop::policy $default]
        append text " level [$apol_default render $::ApolTop::policy]"
        $apol_default -acquire
        $apol_default -delete
        set range [$qpol_user_datum get_range $::ApolTop::qpolicy]
        set apol_range [new_apol_mls_range_t $::ApolTop::policy $range]
        append text " range [$apol_range render $::ApolTop::policy]"
        $apol_range -acquire
        $apol_range -delete
    }
    set i [$qpol_user_datum get_role_iter $::ApolTop::qpolicy]
    set roles {}
    while {![$i end]} {
        set qpol_role_datum [qpol_role_from_void [$i get_item]]
        lappend roles [$qpol_role_datum get_name $::ApolTop::qpolicy]
        $i next
    }
    append text " ([llength $roles] role"
    if {[llength $roles] != 1} {
        append text "s"
    }
    append text ")\n"
    foreach r $roles {
        append text "    $r\n"
    }
    return $text
}
proc iter_to_list {iter} {
    set list {}
    while {![$iter end]} {
        lappend list [$iter get_item]
        $iter next
    }
    return $list
}
proc iter_to_str_list {iter} {
    set list {}
    while {![$iter end]} {
        lappend list [to_str [$iter get_item]]
        $iter next
    }
    return $list
}
proc list_to_vector {list} {
    set v [new_apol_vector_t]
    $v -acquire
    foreach x $list {
        $v append $x
    }
    return $v
}
proc list_to_str_vector {list} {
    set v [new_apol_string_vector_t]
    $v -acquire
    foreach x $list {
        $v append $x
    }
    return $v
}
proc str_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        lappend list [$v get_element $i]
    }
    return $list
}
proc attr_vector_to_list {v} {
    type_vector_to_list $v
}
proc avrule_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_avrule_from_void [$v get_element $i]]
        lappend list $q
    }
    return $list
}
proc bool_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_bool_from_void [$v get_element $i]]
        lappend list [$q get_name $::ApolTop::qpolicy]
    }
    return $list
}
proc cat_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_cat_from_void [$v get_element $i]]
        lappend list [$q get_name $::ApolTop::qpolicy]
    }
    return $list
}
proc class_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_class_from_void [$v get_element $i]]
        lappend list [$q get_name $::ApolTop::qpolicy]
    }
    return $list
}
proc common_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_common_from_void [$v get_element $i]]
        lappend list [$q get_name $::ApolTop::qpolicy]
    }
    return $list
}
proc cond_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_cond_from_void [$v get_element $i]]
        lappend list $q
    }
    return $list
}
proc domain_trans_result_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set a [apol_domain_trans_result_from_void [$v get_element $i]]
        lappend list $a
    }
    return $list
}
proc fs_use_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_fs_use_from_void [$v get_element $i]]
        lappend list $q
    }
    return $list
}
proc genfscon_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_genfscon_from_void [$v get_element $i]]
        lappend list $q
    }
    return $list
}
proc infoflow_result_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set a [apol_infoflow_result_from_void [$v get_element $i]]
        lappend list $a
    }
    return $list
}
proc isid_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_isid_from_void [$v get_element $i]]
        lappend list [$q get_name $::ApolTop::qpolicy]
    }
    return $list
}
proc level_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_level_from_void [$v get_element $i]]
        lappend list [$q get_name $::ApolTop::qpolicy]
    }
    return $list
}
proc netifcon_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_netifcon_from_void [$v get_element $i]]
        lappend list [$q get_name $::ApolTop::qpolicy]
    }
    return $list
}
proc nodecon_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_nodecon_from_void [$v get_element $i]]
        lappend list $q
    }
    return $list
}
proc portcon_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        lappend list [qpol_portcon_from_void [$v get_element $i]]
    }
    return $list
}
proc range_trans_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        lappend list [qpol_range_trans_from_void [$v get_element $i]]
    }
    return $list
}
proc relabel_result_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        lappend list [apol_relabel_result_from_void [$v get_element $i]]
    }
    return $list
}
proc relabel_result_pair_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        lappend list [apol_relabel_result_pair_from_void [$v get_element $i]]
    }
    return $list
}
proc role_allow_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        lappend list [qpol_role_allow_from_void [$v get_element $i]]
    }
    return $list
}
proc role_trans_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        lappend list [qpol_role_trans_from_void [$v get_element $i]]
    }
    return $list
}
proc role_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_role_from_void [$v get_element $i]]
        lappend list [$q get_name $::ApolTop::qpolicy]
    }
    return $list
}
proc terule_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_terule_from_void [$v get_element $i]]
        lappend list $q
    }
    return $list
}
proc type_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_type_from_void [$v get_element $i]]
        lappend list [$q get_name $::ApolTop::qpolicy]
    }
    return $list
}
proc user_vector_to_list {v} {
    set list {}
    for {set i 0} {$v != "NULL" && $i < [$v get_size]} {incr i} {
        set q [qpol_user_from_void [$v get_element $i]]
        lappend list [$q get_name $::ApolTop::qpolicy]
    }
    return $list
}
proc list_to_policy_path {path_type primary modules} {
    if {$path_type == "monolithic"} {
        set path_type $::APOL_POLICY_PATH_TYPE_MONOLITHIC
    } else {
        set path_type $::APOL_POLICY_PATH_TYPE_MODULAR
    }
    set ppath [new_apol_policy_path_t $path_type $primary [list_to_str_vector $modules]]
    $ppath -acquire
    return $ppath
}
proc policy_path_to_list {ppath} {
    if {[$ppath get_type] == $::APOL_POLICY_PATH_TYPE_MONOLITHIC} {
        set path_type "monolithic"
    } else {
        set path_type "modular"
    }
    set primary [$ppath get_primary]
    set modules [str_vector_to_list [$ppath get_modules]]
    list $path_type $primary $modules
}
set COPYRIGHT_INFO "Copyright (C) 2001-2008 Tresys Technology, LLC"
namespace eval ApolTop {
    variable policy {} ;# handle to an apol_policy, or {} if none opened
    variable qpolicy {} ;# handle to policy's qpol_policy_t, or {} if none opened
    variable policy_version_string {}
    variable policy_source_linenum {}
    variable policy_stats_summary {}
    variable policy_stats  ;# array of statistics for the current policy
    variable dot_apol_file [file join $::env(HOME) .apol]
    variable recent_files {}
    variable last_policy_path {}
    variable max_recent_files 5
    variable show_fake_attrib_warning 1 ;# warn if using fake attribute names
    variable default_bg_color
    variable text_font {}
    variable title_font {}
    variable dialog_font {}
    variable general_font {}
    variable query_file_ext ".qf"
    variable mainframe_width 1000
    variable mainframe_height 700
    variable mainframe
    variable notebook
    variable current_tab
    variable tabs {
        {Apol_Types components {}}
        {Apol_Class_Perms components {}}
        {Apol_Roles components {}}
        {Apol_Users components {}}
        {Apol_Cond_Bools components {tag_conditionals}}
        {Apol_MLS components {tag_mls}}
        {Apol_Initial_SIDS components {}}
        {Apol_NetContexts components {}}
        {Apol_FSContexts components {}}
        {Apol_TE rules {tag_query_saveable}}
        {Apol_Cond_Rules rules {tag_conditionals}}
        {Apol_RBAC rules {}}
        {Apol_Range rules {tag_mls}}
        {Apol_File_Contexts {} {}}
        {Apol_Analysis {} {tag_query_saveable}}
        {Apol_PolicyConf {} {tag_source}}
    }
}
proc ApolTop::is_policy_open {} {
    if {$::ApolTop::policy == {}} {
        return 0
    }
    return 1
}
proc ApolTop::is_capable {capability} {
    if {![is_policy_open]} {
        return 0;
    }
    switch -- $capability {
        "attribute names" { set cap $::QPOL_CAP_ATTRIB_NAMES }
        "conditionals" { set cap $::QPOL_CAP_CONDITIONALS }
        "line numbers" { set cap $::QPOL_CAP_LINE_NUMBERS }
        "mls" { set cap $::QPOL_CAP_MLS }
        "neverallow" { set cap $::QPOL_CAP_NEVERALLOW }
        "source" { set cap $::QPOL_CAP_SOURCE }
        "syntactic rules" { set cap $::QPOL_CAP_SYN_RULES }
        default { return 0 }
    }
    variable qpolicy
    $qpolicy has_capability $cap
}
proc ApolTop::openPolicyPath {ppath} {
    _close_policy
    set primary_file [$ppath get_primary]
    if {[catch {Apol_Progress_Dialog::wait $primary_file "Opening policy." \
                    {
                        apol_tcl_open_policy $ppath
                    } \
                } p] || $p == "NULL"} {
        tk_messageBox -icon error -type ok -title "Open Policy" -parent . \
            -message "[apol_tcl_get_error_string]"
        return -1  ;# indicates failed to open policy
    }
    variable policy $p
    variable qpolicy [$p get_qpol]
    _toplevel_policy_open $ppath
    _add_recent $ppath
    variable last_policy_path $ppath
    variable show_fake_attrib_warning
    if {![is_capable "attribute names"] && \
            [llength $::Apol_Types::attriblist] > 0 && \
            $show_fake_attrib_warning} {
        set d [Dialog .fake_attribute_dialog -modal local -parent . \
                   -title "Open Policy" -separator 1]
        $d add -text "OK"
        set f [$d getframe]
        label $f.l -text "Warning: Apol has generated attribute names because\nthe original names were not preserved in the policy." -justify left
        checkbutton $f.cb -text "Show this message again next time." \
            -variable ApolTop::show_fake_attrib_warning
        pack $f.l $f.cb -padx 10 -pady 10
        $d draw
        destroy $d
    }
    return 0  ;# indicates policy opened successfully
}
proc ApolTop::loadNeverAllows {} {
    if {![is_capable "neverallow"]} {
        Apol_Progress_Dialog::wait "Loading neverallow rules" "Rebuilding policy" \
            {
                $::ApolTop::qpolicy rebuild 0
                _toplevel_update_stats
            }
    }
}
proc ApolTop::popup {parent x y menu callbacks callback_arg} {
    set gx [winfo rootx $parent]
    set gy [winfo rooty $parent]
    set cmx [expr {$gx + $x}]
    set cmy [expr {$gy + $y}]
    $menu delete 0 end
    foreach callback $callbacks {
        $menu add command -label [lindex $callback 0] -command [concat [lindex $callback 1] $callback_arg]
    }
    tk_popup $menu $cmx $cmy
}
proc ApolTop::getCurrentTab {} {
    variable current_tab
    set current_tab
}
proc ApolTop::getCurrentTextWidget {} {
    [getCurrentTab]::getTextWidget
}
proc ApolTop::setCurrentTab {tab_name} {
    variable tabs
    foreach tab $tabs {
        if {[lindex $tab 0] == $tab_name} {
            variable notebook
            set parent_nb $notebook
            foreach nb [lindex $tab 1] {
                $parent_nb raise $nb
                set parent_nb [$parent_nb getframe $nb].nb
            }
            $parent_nb raise $tab_name
            variable current_tab $tab_name
            _toplevel_tab_switched
            return
        }
    }
    puts stderr "\[setCurrentTab\] tried to set the tab to $tab_name"
    exit -1
}
proc ApolTop::setPolicySourceLinenumber {line} {
    variable policy_source_linenum "Line $line"
}
proc ApolTop::showPolicySourceLineNumber {line} {
    setCurrentTab Apol_PolicyConf
    Apol_PolicyConf::gotoLine $line
}
proc ApolTop::_create_toplevel {} {
    set menus {
        "&File" {} file 0 {
            {command "&Open..." {} "Open a new policy" {Ctrl o} -command ApolTop::_open_policy}
            {command "&Close" {tag_policy_open} "Close current polocy" {Ctrl w} -command ApolTop::_user_close_policy}
            {separator}
            {cascade "&Recent Files" {} recent 0 {}}
            {separator}
            {command "&Quit" {} "Quit policy analysis tool" {Ctrl q} -command ApolTop::_exit}
        }
        "&Edit" {} edit 0 {
            {command "&Copy" {tag_policy_open} {} {Ctrl c} -command ApolTop::_copy}
            {command "Select &All" {tag_policy_open} {} {Ctrl a} -command ApolTop::_select_all}
            {separator}
            {command "&Find..." {tag_policy_open} "Find text in current buffer" {Ctrl f} -command Apol_Find::find}
            {command "&Goto Line..." {tag_policy_open} "Goto a line in current buffer" {Ctrl g} -command Apol_Goto::goto}
            {separator}
        }
        "&Query" {} query 0 {
            {command "&Open Query..." {tag_policy_open} "Open query criteria file" {} -command ApolTop::_open_query_file}
            {command "&Save Query..." {tag_policy_open tag_query_saveable} "Save current query criteria to file" {} -command ApolTop::_save_query_file}
            {separator}
            {command "&Policy Summary" {tag_policy_open} "Display summary statistics" {} -command ApolTop::_show_policy_summary}
        }
        "&Tools" {} tools 0 {
            {command "&Open Perm Map..." {tag_policy_open} "Open a permission map from file" {} -command ApolTop::_open_perm_map_from_file}
            {command "Open &Default Perm Map" {tag_policy_open} "Open the default permission map" {} -command ApolTop::openDefaultPermMap}
            {command "&Save Perm Map..." {tag_policy_open tag_perm_map_open} "Save the permission map to a file" {} -command ApolTop::_save_perm_map}
            {command "Save Perm Map &As..." {tag_policy_open tag_perm_map_open} "Save the permission map to a file" {} -command ApolTop::_save_perm_map_as}
            {command "Save Perm Map as D&efault" {tag_policy_open tag_perm_map_open} "Save the permission map to default file" {} -command ApolTop::_save_perm_map_default}
            {command "&View Perm Map..." {tag_policy_open tag_perm_map_open} "Edit currently loaded permission map" {} -command Apol_Perms_Map::showPermMappings}
        }
        "&Help" {} helpmenu 0 {
            {command "&General Help" {} "Show help on using apol" {} -command {ApolTop::_show_file Help apol_help.txt}}
            {command "&Domain Transition Analysis" {} "Show help on domain transitions" {} -command {ApolTop::_show_file "Domain Transition Analysis Help" domaintrans_help.txt}}
            {command "&Information Flow Analysis" {} "Show help on information flows" {} -command {ApolTop::_show_file "Information Flow Analysis Help" infoflow_help.txt}}
            {command "Direct &Relabel Analysis" {} "Show help on file relabeling" {} -command {ApolTop::_show_file "Relabel Analysis Help" file_relabel_help.txt}}
            {command "&Types Relationship Summary Analysis" {} "Show help on types relationships" {} -command {ApolTop::_show_file "Types Relationship Summary Analysis Help" types_relation_help.txt}}
            {separator}
            {command "&About apol" {} "Show copyright information" {} -command ApolTop::_about}
        }
    }
    variable mainframe [MainFrame .mainframe -menu $menus -textvariable ApolTop::statu_line]
    pack $mainframe -fill both -expand yes
    $mainframe addindicator -textvariable ApolTop::policy_source_linenum -width 14
    $mainframe addindicator -textvariable ApolTop::policy_stats_summary -width 88
    $mainframe addindicator -textvariable ApolTop::policy_version_string -width 28
    $mainframe setmenustate tag_policy_open disabled
    variable notebook [NoteBook [$mainframe getframe].nb]
    pack $notebook -fill both -expand yes -padx 4 -pady 4
    set page [$notebook insert end components -text "Policy Components"]
    set components [NoteBook $page.nb]
    pack $components -fill both -expand yes -padx 4 -pady 4
    set page [$notebook insert end rules -text "Policy Rules"]
    set rules [NoteBook $page.nb]
    pack $rules -fill both -expand yes -padx 4 -pady 4
    $notebook bindtabs <Button-1> [list ApolTop::_switch_tab $components $rules]
    $components bindtabs <Button-1> [list ApolTop::_switch_tab $components $rules]
    $rules bindtabs <Button-1> [list ApolTop::_switch_tab $components $rules]
    variable tabs
    foreach tab $tabs {
        set parent_nb $notebook
        foreach nb [lindex $tab 1] {
            set parent_nb [set $nb]
        }
        [lindex $tab 0]::create [lindex $tab 0] $parent_nb
    }
    $components raise [$components page 0]
    $rules raise [$rules page 0]
    $notebook raise [$notebook page 0]
    $notebook compute_size
    setCurrentTab [$components page 0]
}
proc ApolTop::_switch_tab {components_nb rules_nb new_tab} {
    if {$new_tab == "components"} {
        set new_tab [$components_nb raise]
    } elseif {$new_tab == "rules"} {
        set new_tab [$rules_nb raise]
    }
    variable current_tab $new_tab
    _toplevel_tab_switched
}
proc ApolTop::_toplevel_tab_switched {} {
    variable tabs
    variable current_tab
    variable mainframe
    foreach tab $tabs {
        if {[lindex $tab 0] != $current_tab} {
            continue
        }
        focus [getCurrentTextWidget]
        if {[lsearch [lindex $tab 2] "tag_query_saveable"] >= 0} {
            $mainframe setmenustate tag_query_saveable normal
        } else {
            $mainframe setmenustate tag_query_saveable disabled
        }
        if {[lsearch [lindex $tab 2] "tag_source"] >= 0} {
            [lindex $tab 0]::insertionMarkChanged
        } else {
            variable policy_source_linenum {}
        }
        break
    }
}
proc ApolTop::_toplevel_policy_open {ppath} {
    variable tabs
    foreach tab $tabs {
        [lindex $tab 0]::open $ppath
    }
    if {![is_capable "conditionals"]} {
        _toplevel_enable_tabs tag_conditionals disabled
    }
    if {![is_capable "mls"]} {
        _toplevel_enable_tabs tag_mls disabled
    }
    if {![is_capable "source"]} {
        _toplevel_enable_tabs tag_source disabled
    }
    _toplevel_tab_switched
    variable mainframe
    $mainframe setmenustate tag_policy_open normal
    $mainframe setmenustate tag_perm_map_open disabled
    _toplevel_update_stats
    variable policy_version_string [$::ApolTop::policy get_version_type_mls_str]
    set primary_file [$ppath get_primary]
    wm title . "SELinux Policy Analysis - $primary_file"
}
proc ApolTop::_toplevel_enable_tabs {tag new_state} {
    variable tabs
    variable notebook
    foreach tab $tabs {
        if {[lsearch [lindex $tab 2] $tag] >= 0} {
            set parent_nb $notebook
            foreach nb [lindex $tab 1] {
                set parent_nb [$parent_nb getframe $nb].nb
            }
            $parent_nb itemconfigure [lindex $tab 0] -state $new_state
            if {[$parent_nb raise] == {}} {
                $parent_nb raise [$parent_nb pages 0]
                setCurrentTab [lindex $tabs 0 0]
            }
        }
    }
}
proc ApolTop::_build_recent_files_menu {} {
    variable mainframe
    variable recent_files
    variable max_recent_files
    set recent_menu [$mainframe getmenu recent]
    $recent_menu delete 0 $max_recent_files
    foreach r $recent_files {
        foreach {path_type primary_file modules} [policy_path_to_list $r] {break}
        if {$path_type == "monolithic"} {
            set label $primary_file
        } else {
            set label "$primary_file + [llength $modules] module"
            if {[llength $modules] != 1} {
                append label "s"
            }
        }
        $recent_menu add command -label $label \
            -command [list ApolTop::openPolicyPath $r]
    }
}
proc ApolTop::_add_recent {ppath} {
    variable recent_files
    variable max_recent_files
    set new_recent $ppath
    foreach r $recent_files {
        if {[apol_policy_path_compare $r $ppath] != 0} {
            lappend new_recent $r
        }
    }
    set recent_files [lrange $new_recent 0 [expr {$max_recent_files - 1}]]
    _build_recent_files_menu
}
proc ApolTop::_toplevel_update_stats {} {
    variable policy_stats
    variable policy_stats_summary
    set iter_funcs {
        "classes" get_class_iter
        "commons" get_common_iter
        "roles" get_role_iter
        "role_allow" get_role_allow_iter
        "role_trans" get_role_trans_iter
        "users" get_user_iter
        "bools" get_bool_iter
        "sens" get_level_iter
        "cats" get_cat_iter
        "range_trans" get_range_trans_iter
        "sids" get_isid_iter
        "portcons" get_portcon_iter
        "netifcons" get_netifcon_iter
        "nodecons" get_nodecon_iter
        "genfscons" get_genfscon_iter
        "fs_uses" get_fs_use_iter
    }
    foreach {key func} $iter_funcs {
        set i [$::ApolTop::qpolicy $func]
        set policy_stats($key) [$i get_size]
        $i -acquire
        $i -delete
    }
    set query_funcs {
        "perms" new_apol_perm_query_t
        "types" new_apol_type_query_t
        "attribs" new_apol_attr_query_t
    }
    foreach {key func} $query_funcs {
        set q [$func]
        set v [$q run $::ApolTop::policy]
        $q -acquire
        $q -delete
        set policy_stats($key) [$v get_size]
        $v -acquire
        $v -delete
    }
    set avrule_bits [list \
                         avrule_allow $::QPOL_RULE_ALLOW \
                         avrule_auditallow $::QPOL_RULE_AUDITALLOW \
                         avrule_dontaudit $::QPOL_RULE_DONTAUDIT \
                         avrule_neverallow $::QPOL_RULE_NEVERALLOW \
                        ]
    foreach {key bit} $avrule_bits {
        if {$bit == $::QPOL_RULE_NEVERALLOW && ![is_capable "neverallow"]} {
            set policy_stats($key) 0
        } else {
            set i [$::ApolTop::qpolicy get_avrule_iter $bit]
            set policy_stats($key) [$i get_size]
            $i -acquire
            $i -delete
        }
    }
    set terule_bits [list \
                         type_trans $::QPOL_RULE_TYPE_TRANS \
                         type_member $::QPOL_RULE_TYPE_CHANGE \
                         type_change $::QPOL_RULE_TYPE_MEMBER \
                        ]
    foreach {key bit} $terule_bits {
        set i [$::ApolTop::qpolicy get_avrule_iter $bit]
        set policy_stats($key) [$i get_size]
        $i -acquire
        $i -delete
    }
    set policy_stats_summary ""
    append policy_stats_summary "Classes: $policy_stats(classes)   "
    append policy_stats_summary "Perms: $policy_stats(perms)   "
    append policy_stats_summary "Types: $policy_stats(types)   "
    append policy_stats_summary "Attribs: $policy_stats(attribs)   "
    set num_te_rules [expr {$policy_stats(avrule_allow) + $policy_stats(avrule_auditallow) +
                            $policy_stats(avrule_dontaudit) + $policy_stats(avrule_neverallow) +
                            $policy_stats(type_trans) + $policy_stats(type_member) +
                            $policy_stats(type_change)}]
    if {![is_capable "neverallow"]} {
        append num_te_rules "+"
    }
    append policy_stats_summary "AV + TE rules: $num_te_rules   "
    append policy_stats_summary "Roles: $policy_stats(roles)   "
    append policy_stats_summary "Users: $policy_stats(users)"
}
proc ApolTop::_open_policy {} {
    variable last_policy_path
    Apol_Open_Policy_Dialog::getPolicyPath $last_policy_path
}
proc ApolTop::_user_close_policy {} {
	variable last_policy_path
	_close_policy
	set last_policy_path {}
}
proc ApolTop::_close_policy {} {
    variable policy_version_string {}
    variable policy_stats_summary {}
    wm title . "SELinux Policy Analysis"
    set i 0
    Apol_Progress_Dialog::wait "apol" "Closing policy." \
        {
            variable tabs
            foreach tab $tabs {
                if {[catch [lindex $tab 0]::close]} {
                set i [expr $i+2]
                }
            }
            Apol_Perms_Map::close
            variable policy
	    if {$policy != {}} {
                $policy -acquire
                $policy -delete
                set policy {}
                variable qpolicy {}
            }
        }
    variable mainframe
    $mainframe setmenustate tag_policy_open disabled
    $mainframe setmenustate tag_perm_map_open disabled
    _toplevel_enable_tabs tag_conditionals normal
    _toplevel_enable_tabs tag_mls normal
    _toplevel_enable_tabs tag_source normal
}
proc ApolTop::_exit {} {
    variable policy
    if {$policy != {}} {
        _close_policy
    }
    Apol_File_Contexts::close
    _write_configuration_file
    exit
}
proc ApolTop::_copy {} {
    set w [getCurrentTextWidget]
    if {$w != {} && [$w tag ranges sel] != {}} {
        set data [$w get sel.first sel.last]
        clipboard clear
        clipboard append -- $data
    }
}
proc ApolTop::_select_all {} {
    set w [getCurrentTextWidget]
    if {$w != {}} {
        $w tag add sel 1.0 end
    }
}
proc ApolTop::_find {} {
    Apol_Find::find
}
proc ApolTop::_goto {} {
    Apol_Goto::goto
}
proc ApolTop::_open_query_file {} {
    set types " {\"Query files\" { $ApolTop::query_file_ext }} "
    set query_file [tk_getOpenFile -filetypes $types -title "Open Apol Query" \
                        -defaultextension $ApolTop::query_file_ext -parent .]
    if {$query_file != {}} {
        if {[catch {::open $query_file r} f]} {
            tk_messageBox -icon error -type ok -title "Open Apol Query" \
                -message "Could not open $query_file: $f"
        }
        while {[gets $f line] >= 0} {
            set query_id [string trim $line]
            if {$query_id == {} || [string index $query_id 0] == "#"} {
                continue
            }
            break
        }
        variable tabs
        foreach tab $tabs {
            if {$query_id == [lindex $tab 0] && [lsearch [lindex $tab 2] "tag_query_saveable"] >= 0} {
                if {[catch {${query_id}::load_query_options $f} err]} {
                    tk_messageBox -icon error -type ok -title "Open Apol Query" \
                        -message $err
                } else {
                    setCurrentTab $query_id
                }
                return
            }
        }
        tk_messageBox -icon error -type ok -title "Open Apol Query" \
            -message "The query criteria file could not be read and may be corrupted."
        close $f
    }
}
proc ApolTop::_save_query_file {} {
    set types " {\"Query files\" {$ApolTop::query_file_ext}} "
    set query_file [tk_getSaveFile -title "Save Apol Query" \
                        -defaultextension $ApolTop::query_file_ext \
                        -filetypes $types -parent .]
    if {$query_file != {}} {
        if {[catch {::open $query_file w} f]} {
            tk_messageBox -icon error -type ok -title "Save Apol Query" \
                -message "Could not save $query_file: $f"
        }
        if {[catch {puts $f [getCurrentTab]} err]} {
            tk_messageBox -icon error -type ok -title "Save Apol Query" \
                -message $err
        }
        if {[catch {[getCurrentTab]::save_query_options $f $query_file} err]} {
            tk_messageBox -icon error -type ok -title "Save Apol Query" \
                -message $err
        }
        close $f
    }
}
proc ApolTop::_show_policy_summary {} {
    variable policy_version_string
    variable policy_stats
    if {![regexp -- {^([^$]+) \(([^,]+), ([^$]+)} $ApolTop::policy_version_string -> policy_version policy_type policy_mls_type]} {
        set policy_version $ApolTop::policy_version_string
        set policy_type "unknown"
        set policy_mls_type "unknown"
    }
    set policy_version [string trim $policy_version]
    destroy .policy_statsbox
    set dialog [Dialog .policy_statsbox -separator 1 -title "Policy Summary" \
                    -modal none -parent .]
    $dialog add -text Close -command [list destroy $dialog]
    set w [$dialog getframe]
    label $w.title -text "Policy Summary Statistics"
    set f [frame $w.summary]
    label $f.l -justify left -text "    Policy Version:\n    Policy Type:\n    MLS Status:"
    label $f.r -justify left -text "$policy_version\n$policy_type\n$policy_mls_type"
    grid $f.l $f.r -sticky w
    grid configure $f.r -padx 30
    grid $w.title - -sticky w -padx 8
    grid $f - -sticky w -padx 8
    grid [Separator $w.sep] - -sticky ew -pady 5
    set f [frame $w.left]
    set i 0
    foreach {title block} {
        "Number of Classes and Permissions" {
            "Object Classes" classes
            "Common Permissions" commons
            "Permissions" perms
        }
        "Number of Types and Attributes" {
            "Types" types
            "Attributes" attribs
        }
        "Number of Type Enforcement Rules" {
            "allows" avrule_allow
            "auditallows" avrule_auditallow
            "dontaudits" avrule_dontaudit
            "neverallows" avrule_neverallow
            "type_transitions" type_trans
            "type_members" type_member
            "type_changes" type_change
        }
        "Number of Roles" {
            "Roles" roles
        }
        "Number of RBAC Rules" {
            "allows" role_allow
            "role_transitions" role_trans
        }
    } {
        set ltext "$title:"
        set rtext {}
        foreach {l r} $block {
            append ltext "\n    $l:"
            if {$r != "avrule_neverallow" || [is_capable "neverallow"]} {
                append rtext "\n$policy_stats($r)"
            } else {
                append rtext "\nN/A"
            }
        }
        label $f.l$i -justify left -text $ltext
        label $f.r$i -justify left -text $rtext
        grid $f.l$i $f.r$i -sticky w -padx 4 -pady 2
        incr i
    }
    set i 0
    set g [frame $w.right]
    foreach {title block} {
        "Number of Users" {
            "Users" users
        }
        "Number of Booleans" {
            "Booleans" bools
        }
        "Number of MLS Components" {
            "Sensitivities" sens
            "Categories" cats
        }
        "Number of MLS Rules" {
            "range_transitions" range_trans
        }
        "Number of Initial SIDs" {
            "SIDs" sids
        }
        "Number of OContexts" {
            "PortCons" portcons
            "NetIfCons" netifcons
            "NodeCons" nodecons
            "GenFSCons" genfscons
            "fs_use statements" fs_uses
        }
    } {
        set ltext "$title:"
        set rtext {}
        foreach {l r} $block {
            append ltext "\n    $l:"
            append rtext "\n$policy_stats($r)"
        }
        label $g.l$i -justify left -text $ltext
        label $g.r$i -justify left -text $rtext
        grid $g.l$i $g.r$i -sticky w -padx 4 -pady 2
        incr i
    }
    grid $f $g -sticky nw -padx 4
    $dialog draw
}
proc ApolTop::_open_perm_map_from_file {} {
    if {[Apol_Perms_Map::openPermMapFromFile]} {
        variable mainframe
        $mainframe setmenustate tag_perm_map_open normal
    }
}
proc ApolTop::openDefaultPermMap {} {
    if {[Apol_Perms_Map::openDefaultPermMap]} {
        variable mainframe
        $mainframe setmenustate tag_perm_map_open normal
        return 1
    }
    return 0
}
proc ApolTop::_save_perm_map {} {
    Apol_Perms_Map::savePermMap
}
proc ApolTop::_save_perm_map_as {} {
    Apol_Perms_Map::savePermMapAs
}
proc ApolTop::_save_perm_map_default {} {
    Apol_Perms_Map::saveDefaultPermMap
}
proc ApolTop::_show_file {title file_name} {
    set helpfile [file join [tcl_config_get_install_dir] $file_name]
    if {[catch {::open $helpfile} f]} {
        set info $f
    } else {
        set info [read $f]
        close $f
    }
    Apol_Widget::showPopupParagraph $title $info
}
proc ApolTop::_about {} {
    if {[winfo exists .apol_about]} {
        raise .apol_about
    } else {
        variable apol_icon
        Dialog .apol_about -cancel 0 -default 0 -image $apol_icon \
            -modal none -parent . -separator 1 -title "About apol"
        set f [.apol_about getframe]
        set l1 [label $f.l1 -text "apol [tcl_config_get_version]" -height 2]
        set label_font [$l1 cget -font]
        if {[llength $label_font] > 1} {
            foreach {name size} [$l1 cget -font] {break}
            incr size 6
            $l1 configure -font [list $name $size bold]
        }
        set l2 [label $f.l2 -text "Security Policy Analysis Tool for Security Enhanced Linux\n${::COPYRIGHT_INFO}\nhttp://oss.tresys.com/projects/setools"]
        pack $l1 $l2
        .apol_about add -text "Close" -command [list destroy .apol_about]
        .apol_about draw
    }
}
proc ApolTop::_load_fonts {} {
    variable title_font
    variable dialog_font
    variable general_font
    variable text_font
    tk scaling -displayof . 1.0
    if {$general_font == ""} {
        set general_font "Helvetica 10"
    }
    option add *Font $general_font
    if {$title_font == {}} {
        set title_font "Helvetica 10 bold italic"
    }
    option add *TitleFrame.l.font $title_font
    if {$dialog_font == {}} {
        set dialog_font "Helvetica 10"
    }
    option add *Dialog*font $dialog_font
    option add *Dialog*TitleFrame.l.font $title_font
    if {$text_font == ""} {
        set text_font "fixed"
    }
    option add *text*font $text_font
}
proc ApolTop::_read_configuration_file {} {
    variable dot_apol_file
    variable recent_files
    if {![file exists $dot_apol_file]} {
        return
    }
    if {[catch {::open $dot_apol_file r} f]} {
        tk_messageBox -icon error -type ok -title "apol" \
            -message "Could not open $dot_apol_file: $f"
        return
    }
    while {![eof $f]} {
        set option [string trim [gets $f]]
        if {$option == {} || [string compare -length 1 $option "\#"] == 0} {
            continue
        }
        set value [string trim [gets $f]]
        if {[eof $f]} {
            puts stderr "EOF reached while reading $option"
            break
        }
        if {$value == {}} {
            puts stderr "Empty value for option $option"
            continue
        }
        switch -- $option {
            "\[window_height\]" {
                if {[string is integer -strict $value] != 1} {
                    puts stderr "window_height was not given as an integer and is ignored"
                    break
                }
                variable mainframe_height $value
            }
            "\[window_width\]" {
                if {[string is integer -strict $value] != 1} {
                    puts stderr "window_width was not given as an integer and is ignored"
                    break
                }
                variable mainframe_width $value
            }
            "\[title_font\]" {
                variable title_font $value
            }
            "\[dialog_font\]" {
                variable dialog_font $value
            }
            "\[text_font\]" {
                variable text_font $value
            }
            "\[general_font\]" {
                variable general_font $value
            }
            "\[show_fake_attrib_warning\]" {
                variable show_fake_attrib_warning $value
            }
            "\[max_recent_files\]" {
                if {[string is integer -strict $value] != 1} {
                    puts stderr "max_recent_files was not given as an integer and is ignored"
                } else {
                    if {$value < 2} {
                        variable max_recent_files 2
                    } else {
                        variable max_recent_files $value
                    }
                }
            }
            "recent_files" {
                if {[string is integer -strict $value] != 1} {
                    puts stderr "Number of recent files was not given as an integer and was ignored."
                    continue
                } elseif {$value < 0} {
                    puts stderr "Number of recent was less than 0 and was ignored."
                    continue
                }
                while {$value > 0} {
                    incr value -1
                    set line [gets $f]
                    if {[eof $f]} {
                        puts stderr "EOF reached trying to read recent files."
                        break
                    }
                    if {[llength $line] == 1} {
                        set ppath [new_apol_policy_path_t $::APOL_POLICY_PATH_TYPE_MONOLITHIC $line NULL]
                        $ppath -acquire
                    } else {
                        foreach {path_type primary modules} $line {break}
                        if {[catch {list_to_policy_path $path_type $primary $modules} ppath]} {
                            puts stderr "Invalid policy path line: $line"
                            continue
                        }
                    }
                    lappend recent_files $ppath
                }
            }
        }
    }
    close $f
}
proc ApolTop::_write_configuration_file {} {
    variable dot_apol_file
    variable recent_files
    variable text_font
    variable title_font
    variable dialog_font
    variable general_font
    if {[catch {::open $dot_apol_file w} f]} {
        tk_messageBox -icon error -type ok -title "apol" \
            -message "Could not open $dot_apol_file for writing: $f"
        return
    }
    puts $f "recent_files"
    puts $f [llength $recent_files]
    foreach r $recent_files {
        puts $f [policy_path_to_list $r]
    }
    puts $f "\n"
    puts $f "# Font format: family ?size? ?style? ?style ...?"
    puts $f "# Possible values for the style arguments are as follows:"
    puts $f "# normal bold roman italic underline overstrike\n#\n#"
    puts $f "# NOTE: When configuring fonts, remember to remove the following "
    puts $f "# \[window height\] and \[window width\] entries before starting apol. "
    puts $f "# Not doing this may cause widgets to be obscured when running apol."
    puts $f "\[general_font\]"
    if {$general_font == {}} {
        puts $f "Helvetica 10"
    } else {
        puts $f "$general_font"
    }
    puts $f "\[title_font\]"
    if {$title_font == {}} {
        puts $f "Helvetica 10 bold italic"
    } else {
        puts $f "$title_font"
    }
    puts $f "\[dialog_font\]"
    if {$dialog_font == {}} {
        puts $f "Helvetica 10"
    } else {
        puts $f "$dialog_font"
    }
    puts $f "\[text_font\]"
    if {$text_font == {}} {
        puts $f "fixed"
    } else {
        puts $f "$text_font"
    }
    puts $f "\[window_height\]"
    puts $f [winfo height .]
    puts $f "\[window_width\]"
    puts $f [winfo width .]
    puts $f "\[show_fake_attrib_warning\]"
    variable show_fake_attrib_warning
    puts $f $show_fake_attrib_warning
    puts $f "\[max_recent_files\]"
    variable max_recent_files
    puts $f $max_recent_files
    close $f
}
proc ApolTop::main {} {
    variable notebook
    tcl_config_init
    rename send {}
    if {[catch {package require BWidget}]} {
        tk_messageBox -icon error -type ok -title "Apol Startup" -message \
            "The BWidget package could not be found.  Ensure that BWidget is installed in a location that Tcl/Tk can read."
        exit -1
    }
    wm withdraw .
    wm title . "SELinux Policy Analysis"
    wm protocol . WM_DELETE_WINDOW ApolTop::_exit
    variable default_bg_color [. cget -background]
    catch {tcl_config_patch_bwidget}
    _load_fonts
    _read_configuration_file
    _create_toplevel
    bind . <Button-1> {focus %W}
    bind . <Button-2> {focus %W}
    bind . <Button-3> {focus %W}
    _build_recent_files_menu
    set icon_file [file join [tcl_config_get_install_dir] apol.gif]
    if {![catch {image create photo -file $icon_file} icon]} {
        catch {wm iconphoto . -default $icon}
    }
    variable apol_icon $icon
    variable mainframe_width [$notebook cget -width]
    variable mainframe_height [$notebook cget -height]
    wm geom . ${mainframe_width}x${mainframe_height}
    wm deiconify .
    raise .
    focus .
}
proc handle_args {argv0 argv} {
    set argvp 0
    while {$argvp < [llength $argv]} {
        set arg [lindex $argv $argvp]
        switch -- $arg {
            "-h" - "--help" { print_help $argv0 verbose; exit }
            "-V" - "--version" { print_version_info; exit }
            "--" { incr argvp; break }
            default {
                if {[string index $arg 0] != "-"} {
                    break
                } else {
                    puts stderr "$argv0: unrecognized option `$arg'"
                    print_help $argv0 brief
                    exit 1
                }
            }
        }
        incr argvp
    }
	set arglen [expr [llength $argv]-$argvp]
    set ppath {}
	if {$arglen <= 0} {
		return {}
	} elseif {$arglen == 1} {
        set path_type $::APOL_POLICY_PATH_TYPE_MONOLITHIC
        set policy_file [lindex $argv $argvp]
		set mod_paths [list_to_str_vector {}]
		if {[apol_file_is_policy_path_list $policy_file]} {
			set ppath [new_apol_policy_path_t $policy_file]
		}
	} elseif {$arglen > 1} {
		set path_type $::APOL_POLICY_PATH_TYPE_MODULAR
		set policy_file {} 
		foreach f [lrange $argv $argvp end] {
			if {[catch {Apol_Open_Policy_Dialog::getModuleInfo $f} modinfo]} {
				tk_messageBox -icon error -type ok -title "Module access error" -message $modinfo
			} else {
				foreach {name vers type} $modinfo {break}
				if {$type == 1} {	;# This file is a base 'module'
					if {$policy_file != {} && $policy_file != $f} {
							set rsp [tk_messageBox -icon error -type okcancel -title "Open Module" -message "Multiple base entries found." -detail "Current file: $policy_file\n\nNew file: $f\n\nClick OK to ignore new file, Cancel to exit"]
							if {$rsp == "cancel"} { exit 1}
					} else {
						set policy_file $f
					}
				} else {	;# Append regular modules to the list.
					lappend module_list $f
				}
			}
		}
		set mod_paths [list_to_str_vector $module_list]
	}
    if {$ppath == {}} {
        set ppath [new_apol_policy_path_t $path_type $policy_file $mod_paths]
    }
    if {$ppath == {}} {
        puts stderr "Error loading $policy_file."
    } else {
        $ppath -acquire
    }
    return $ppath
}
proc print_help {program_name verbose} {
    puts "Usage: $program_name \[OPTIONS\] \[POLICY ...\]\n"
    if {$verbose != "verbose"} {
        puts "\tTry $program_name --help for more help.\n"
    } else {
        puts "Policy Analysis tool for Security Enhanced Linux.\n"
        puts "   -h, --help              print this help text and exit"
        puts "   -V, --version           print version information and exit\n"
    }
}
proc print_version_info {} {
    puts "apol [tcl_config_get_version]\n$::COPYRIGHT_INFO"
}
proc print_init {s} {
    puts -nonewline $s
    flush stdout
}
if {[catch {tcl_config_init_libraries}]} {
    puts stderr "FAILED. The SETools libraries could not be found in any of these subdirectories:\n\t[join $auto_path "\n\t"]"
    exit -1
}
print_init "Initializing Tk... "
if {[catch {package require Tk}]} {
    puts stderr "FAILED. This library could not be found in any of these subdirectories:\n\t[join $auto_path "\n\t"]"
    puts stderr "This may indicate a problem with the tcl package's auto_path variable.\n"
    exit -1
}
puts "done."
set path [handle_args $argv0 $argv]
ApolTop::main
if {$path != {}} {
    after idle [list ApolTop::openPolicyPath $path]
}