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
|
# 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 1.7+
namespace eval Apol_Widget {
variable vars
}
# Creates a widget that lets the user select a context (user + role +
# type + MLS range) and a range search type (exact, subset, superset).
# If the second argument is not "" then add a checkbutton that
# enables/disables the entire widget.
proc Apol_Widget::makeContextSelector {path rangeMatchText {enableText "Context"} args} {
variable vars
array unset vars $path:*
set vars($path:context) {{} {} {} {{{} {}}}}
set vars($path:context_rendered) {}
set vars($path:search_type) "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]
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
}
# range search type
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 exact -variable Apol_Widget::vars($path:search_type)]
set range_subset [radiobutton $context2_frame.subset -text "$rangeMatchText Containing Range" \
-state disabled \
-value subset -variable Apol_Widget::vars($path:search_type)]
set range_superset [radiobutton $context2_frame.superset -text "$rangeMatchText Within Range" \
-state disabled \
-value superset -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_mls_policy]} {
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:search_type) exact
catch {set Apol_Widget::vars($path:enable) 0}
}
proc Apol_Widget::getContextSelectorState {path} {
return $Apol_Widget::vars($path:enable)
}
# returns a 2-uple containing the context value and the search type
proc Apol_Widget::getContextSelectorValue {path} {
variable vars
# remove the attribute field from the third element
set c $vars($path:context)
# the following uses Tcl 8.4+ specific functions
lset c 2 [lindex $c 2 0]
list $c $vars($path:search_type)
}
########## private functions below ##########
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} {
set Apol_Widget::vars($path:context) [Apol_Context_Dialog::getContext $Apol_Widget::vars($path:context)]
# the trace on this variable will trigger [_update_context_display] to execute
}
proc Apol_Widget::_update_context_display {path name1 name2 op} {
variable vars
set display $path.context.display
foreach {user role type range} $vars($path:context) {break}
set context ""
if {$user == ""} {
lappend context "*"
} else {
lappend context $user
}
if {$role == ""} {
lappend context "*"
} else {
lappend context $role
}
if {$type == ""} {
lappend context "*"
} else {
lappend context [lindex $type 0]
}
if {[ApolTop::is_mls_policy]} {
if {$range == "" || $range == {{} {}}} {
lappend context "*"
} else {
if {[catch {apol_RenderLevel [lindex $range 0]} level]} {
set level "?"
}
if {[llength $range] > 1 && [lindex $range 0] != [lindex $range 1]} {
if {[catch {apol_RenderLevel [lindex $range 1]} high]} {
append level " - ?"
} else {
append level " - $high"
}
}
if {$level == ""} {
lappend context "*"
} else {
lappend context $level
}
}
}
set vars($path:context_rendered) [join $context ":"]
$display configure -helptext $vars($path:context_rendered)
}
|