path: root/apol/mls_tab.tcl

# Copyright (C) 2001-2007 Tresys Technology, LLC
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

namespace eval Apol_MLS {
    variable widgets
    variable vals
}

proc Apol_MLS::create {tab_name nb} {
    variable widgets
    variable vals

    _initializeVars

    # Layout frames
    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

    # build the left column, where one may browse sensitivities and categories
    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

    # build the search options
    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

    # build the results box
    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
}

# Given a sensitivity name, return a non-empty string if that
# sensitivity is within the loaded policy.  This string is the same as
# the given parameter if the name is a sensitivity; it will be the
# real sensitivity's name if the parameter is an alias.  If no policy
# has been loaded then return an empty string.
proc Apol_MLS::isSensInPolicy {sens} {
    variable vals
    if {![ApolTop::is_policy_open]} {
        return {}
    }
    if {[lsearch $vals(senslist) $sens] >= 0} {
        return $sens
    }
    # try looking up aliases
    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 {}
}

#### private functions below ####

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
}