File: users_tab.tcl

package info (click to toggle)
setools 2.4-3
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 9,680 kB
  • ctags: 8,392
  • sloc: ansic: 96,778; tcl: 21,447; yacc: 4,341; makefile: 874; lex: 304; sh: 164
file content (325 lines) | stat: -rw-r--r-- 11,930 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
# Copyright (C) 2001-2006 Tresys Technology, LLC
# see file 'COPYING' for use and warranty information 

# TCL/TK GUI for SE Linux policy analysis
# Requires tcl and tk 8.4+, with BWidgets


##############################################################
# ::Apol_Users
#  
# The Users page
##############################################################
namespace eval Apol_Users {
    variable opts
    variable users_list ""
    variable widgets
}

##############################################################
# ::search
#  	- Search text widget for a string
# 
proc Apol_Users::search { str case_Insensitive regExpr srch_Direction } {
    variable widgets
    ApolTop::textSearch $widgets(results).tb $str $case_Insensitive $regExpr $srch_Direction
}

# ----------------------------------------------------------------------------------------
#  Command Apol_Users::set_Focus_to_Text
#
#  Description: 
# ----------------------------------------------------------------------------------------
proc Apol_Users::set_Focus_to_Text {} {
    focus $Apol_Users::widgets(results)
}

# ------------------------------------------------------------------------------
#  Command Apol_Users::searchUsers
# ------------------------------------------------------------------------------
proc Apol_Users::searchUsers {} {
    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(useRole) && $opts(role) == ""} {
        tk_messageBox -icon error -type ok -title "Error" -message "No role selected."
        return
    }
    if {$opts(enable_default) && $opts(default_level) == {{} {}}} {
        tk_messageBox -icon error -type ok -title "Error" -message "No default level selected."
        return
    }
    set range_enabled [Apol_Widget::getRangeSelectorState $widgets(range)]
    foreach {val_range val_search_type} [Apol_Widget::getRangeSelectorValue $widgets(range)] {break}
    if {$range_enabled && $val_range == {{{} {}} {{} {}}}} {
        tk_messageBox -icon error -type ok -title "Error" -message "No range selected."
        return
    }
    
    if {[catch {apol_GetUsers} orig_users_info]} {
	tk_messageBox -icon error -type ok -title "Error" -message "Error obtaining users list:\n$orig_users_info"
        return
    }

    # apply filters to the list of users
    set users_info {}
    foreach u $orig_users_info {
        foreach {user roles default range} $u {break}
        if {$opts(useRole) && \
                [lsearch -exact $roles $opts(role)] == -1} {
            continue
        }
        if {$opts(enable_default) && \
                $default ne $opts(default_level)} {
            continue
        }
        if {$range_enabled && \
                ![apol_CompareRanges $val_range $range $val_search_type]} {
            continue
        }
        lappend users_info $user
    }

    # now display results
    set results "USERS:"
    if {[llength $users_info] == 0} {
        append results "\nSearch returned no results."
    } else {
        foreach user $users_info {
            if {$opts(showSelection) == "all"} {
                append results "\n[renderUser $user 1]"
            } else {
                append results "\n[renderUser $user 0]"
            }
        }
    }
    Apol_Widget::appendSearchResultText $widgets(results) $results
}

proc Apol_Users::renderUser {user show_all} {
    set text ""
    foreach {user roles default range} [lindex [apol_GetUsers $user] 0] {break}
    append text "$user"
    if {!$show_all} {
        return $text
    }
    if {[ApolTop::is_mls_policy]} {
        append text " level [apol_RenderLevel $default]"
        set low [apol_RenderLevel [lindex $range 0]]
        set high [apol_RenderLevel [lindex $range 1]]
        if {$low == $high} {
            append text " range $low"
        } else {
            append text " range $low - $high"
        }
    }
    append text " ([llength $roles] role"
    if {[llength $roles] != 1} {
        append text "s"
    }
    append text ")"
    append text "\n"
    foreach r $roles {
        append text "    $r\n"
    }
    return $text
}

# ------------------------------------------------------------------------------
#  Command Apol_Users::open
# ------------------------------------------------------------------------------
proc Apol_Users::open { } {
    variable users_list
    variable widgets
  
    set rt [catch {set users_list [apol_GetNames users]} err]
    if {$rt != 0} {
	return -code error $err
    }
    set users_list [lsort $users_list]
    $Apol_Users::widgets(role) configure -values $Apol_Roles::role_list
    if {[ApolTop::is_mls_policy]} {
        Apol_Widget::setRangeSelectorCompleteState $widgets(range) normal
        $widgets(defaultCB) configure -state normal
    } else {
        Apol_Widget::clearRangeSelector $widgets(range)
        Apol_Widget::setRangeSelectorCompleteState $widgets(range) disabled
        set Apol_Users::opts(enable_default) 0
        $widgets(defaultCB) configure -state disabled
    }
    return 0
} 

# ------------------------------------------------------------------------------
#  Command Apol_Users::close
# ------------------------------------------------------------------------------
proc Apol_Users::close { } {
    variable opts
    variable widgets
    set Apol_Users::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
    array set opts {
        showSelection all
        useRole 0         role {}
        enable_default 0  default_level {{} {}}
    }
}

proc Apol_Users::free_call_back_procs { } {
}

# ------------------------------------------------------------------------------
#  Command Apol_Users::popupUserInfo
# ------------------------------------------------------------------------------
proc Apol_Users::popupUserInfo {which user} {
    Apol_Widget::showPopupText $user [renderUser $user 1]
}

########################################################################
# ::goto_line
#  	- goes to indicated line in text box
# 
proc Apol_Users::goto_line { line_num } {
    variable widgets
    Apol_Widget::gotoLineSearchResults $widgets(results) $line_num
}

# ------------------------------------------------------------------------------
#  Command Apol_Users::create
# ------------------------------------------------------------------------------
proc Apol_Users::create {nb} {
    variable opts
    variable widgets

    array set opts {
        showSelection all
        useRole 0          role {}
        enable_default 0   default_level {{} {}}
    }
    
    # Layout frames
    set frame [$nb insert end $ApolTop::users_tab -text "Users"]
    set pw1   [PanedWindow $frame.pw -side top]
    set rpane [$pw1 add -weight 0]
    set spane [$pw1 add -weight 1]

    # Title frames
    set userbox [TitleFrame $rpane.userbox -text "Users"]
    set s_optionsbox [TitleFrame $spane.obox -text "Search Options"]
    set resultsbox [TitleFrame $spane.rbox -text "Search Results"]

    # Placing layout
    pack $pw1 -fill both -expand yes

    # Placing title frames
    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
   
    # Users listbox widget
    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

    # Search options subframes
    set ofm [$s_optionsbox getframe]
    
    set verboseFrame [frame $ofm.verbose -relief sunken -borderwidth 1]
    radiobutton $verboseFrame.names_only -text "Names Only" \
        -variable Apol_Users::opts(showSelection) -value names 
    radiobutton $verboseFrame.all_info -text "All Information" \
        -variable Apol_Users::opts(showSelection) -value all
    pack $verboseFrame.names_only $verboseFrame.all_info -side top -anchor nw -pady 5 -padx 5

    set rolesFrame [frame $ofm.roles -relief sunken -borderwidth 1]
    checkbutton $rolesFrame.cb -variable Apol_Users::opts(useRole) -text "Roles"
    set widgets(role) [ComboBox $rolesFrame.combo -width 12 -textvariable Apol_Users::opts(role) \
                           -helptext "Type or select a role" -state disabled]

    bind $widgets(role).e <KeyPress> [list ApolTop::_create_popup $widgets(role) %W %K]
    trace add variable Apol_Users::opts(useRole) write \
        [list Apol_Users::toggleRolesCheckbutton $widgets(role)]
    pack $rolesFrame.cb -side top -anchor nw
    pack $widgets(role) -side top -anchor nw -padx 4 -expand 0 -fill x

    set defaultFrame [frame $ofm.default -relief sunken -borderwidth 1]
    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 rangeFrame [frame $ofm.range -relief sunken -borderwidth 1]
    set widgets(range) [Apol_Widget::makeRangeSelector $rangeFrame.range Users]
    pack $widgets(range) -expand 1 -fill x
    
    pack $verboseFrame $rolesFrame $defaultFrame $rangeFrame \
        -side left -padx 5 -pady 4 -anchor nw -expand 0 -fill y

    # Action Buttons
    button $ofm.ok -text OK -width 6 -command {Apol_Users::searchUsers}
    pack $ofm.ok -side right -pady 5 -padx 5 -anchor ne

    # Display results window
    set widgets(results) [Apol_Widget::makeSearchResults [$resultsbox getframe].results]
    pack $widgets(results) -expand yes -fill both 

    return $frame	
}

#### private functions below ####

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 {} {
    set Apol_Users::opts(default_level) [Apol_Level_Dialog::getLevel $Apol_Users::opts(default_level)]
}

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 [apol_RenderLevel $opts(default_level)]
        if {$level == ""} {
            set opts(default_level_display) "<invalid MLS level>"
        } else {
            set opts(default_level_display) $level
        }
        $display configure -helptext $opts(default_level_display)
    }
}