-
Notifications
You must be signed in to change notification settings - Fork 0
/
ipconfig.tcl
324 lines (255 loc) · 7.96 KB
/
ipconfig.tcl
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
# temp
lappend auto_path /usr/local/lib
package require Itcl
package require Tk
tk_setPalette white
#font create StatusFont -family Courier -size 18 -weight bold
#font create LabelFont -family Courier -size 14 -weight bold
#font create CtrlFont -family Arial -size 12 -weight bold
#font create InputFont -family Courier -size 18 -weight bold
#set ipv4ConfigType dhcp
set ipv4ConfigType static
set ipv4ObjectList [list ip netmask default_gateway dns1 dns2]
#
# ip_entry - itcl class for Tk for entering IP addresses
#
itcl::class ip_entry {
public variable w
public variable state
constructor {window args} {
configure {*}$args
set w $window
frame $w -relief sunken -borderwidth 0
entry $w.1 -width 3 -relief flat -validate all -vcmd {is_valid_octet %P} -font InputFont -disabledforeground darkgrey -disabledbackground white -justify right -selectbackground lightblue
label $w.a -text . -background gray90 -relief flat
entry $w.2 -width 3 -relief flat -validate all -vcmd {is_valid_octet %P} -font InputFont -disabledforeground darkgrey -disabledbackground white -justify right -selectbackground lightblue
label $w.b -text . -background gray90 -relief flat
entry $w.3 -width 3 -relief flat -validate all -vcmd {is_valid_octet %P} -font InputFont -disabledforeground darkgrey -disabledbackground white -justify right -selectbackground lightblue
label $w.c -text . -background gray90 -relief flat
entry $w.4 -width 3 -relief flat -validate all -vcmd {is_valid_octet %P} -font InputFont -disabledforeground darkgrey -disabledbackground white -justify right -selectbackground lightblue
eval pack [winfo children $w] -side left -padx 0
for {set i 1} {$i < 5} {incr i} {
bind $w.$i <FocusIn> "10key_entry $this"
}
return $w
}
#
# set_state - set_state readyonly, set_state normal
#
method set_state {wantState} {
set state $wantState
for {set i 1} {$i <= 4} {incr i} {
$w.$i configure -state $state
}
if {$state == "disabled"} {
$w configure -relief flat
} else {
$w configure -relief sunken
}
}
#
# get - return the IP address or an empty string depending on what we've
# got
#
method get {} {
set v1 [$w.1 get]
set v2 [$w.2 get]
set v3 [$w.3 get]
set v4 [$w.4 get]
if {$v1 == "" || $v2 == "" || $v3 == "" || $v4 == ""} {
return ""
}
return "$v1.$v2.$v3.$v4"
}
method store {ip} {
set i 1
foreach v [split $ip "."] {
#Skip if more than 4 octets
if {$i < 5} {
$w.$i delete 0 end
$w.$i insert 0 $v
}
incr i
}
}
method focus_on_me {} {
focus $w.1
$w.1 select range 0 end
}
}
#
# 10key_entry - replace the IP of the specified IP_entry object
#
proc 10key_entry {id} {
focus .config.f.dhcp_options.manually
create_newmenu .keypad "Enter IP" "destroy .keypad" "destroy .keypad"
frame .keypad.f
grid .keypad.f -columnspan 3
setup_keypad_10key .keypad.f $id
}
#
# is_valid_octet - return 1 if a string is empty or a valid integer
# between 0 and 255
#
proc is_valid_octet {str} {
if {$str eq ""} {return 1}
expr {[string is integer -strict $str] && $str >= 0 && $str < 256}
}
#
# ip_netmask_default_gateway - create Tk stuff to allow the user to
# specify an IP, netmask and default gateway
#
proc ip_netmask_default_gateway {w type} {
# ip
#
set row 0
label $w.dhcp_options_label -text "Configure" -font LabelFont -foreground grey
grid $w.dhcp_options_label -row $row -column 0
#tk_optionMenu $w.dhcp_options dhcpSetting "Using DHCP" "Manually"
set f $w.dhcp_options
frame $f
radiobutton $f.using_dhcp -variable ipv4ConfigType -value dhcp -text "Using DHCP" -font InputFont -command "ipv4_config_type_changed"
pack $f.using_dhcp -side left -fill x -pady 10
focus $f.using_dhcp
radiobutton $f.manually -variable ipv4ConfigType -value static -text "Using Static" -font InputFont -command "ipv4_config_type_changed"
pack $f.manually -side left -fill x
grid $w.dhcp_options -row $row -column 1
label $w.right_side_label -text " " -font LabelFont
grid $w.right_side_label -row $row -column 2
incr row
label $w.iplabel -text "IP" -font LabelFont -foreground grey
grid $w.iplabel -row $row -column 0
ip_entry ip $w.ip
grid $w.ip -row $row -column 1
incr row
# netmask
label $w.netmasklabel -text "Netmask" -font LabelFont -foreground grey
grid $w.netmasklabel -row $row -column 0
ip_entry netmask $w.netmask
grid $w.netmask -row $row -column 1
incr row
# default gateway
label $w.defaultgatewaylabel -text "Gateway" -font LabelFont -foreground grey
grid $w.defaultgatewaylabel -row $row -column 0
ip_entry default_gateway $w.defaultgateway
grid $w.defaultgateway -row $row -column 1
incr row
# dns 1
label $w.dns1label -text "DNS 1" -font LabelFont -foreground grey
grid $w.dns1label -row $row -column 0
ip_entry dns1 $w.dns1
grid $w.dns1 -row $row -column 1
incr row
# dns 2
label $w.dns2label -text "DNS 2" -font LabelFont -foreground grey
grid $w.dns2label -row $row -column 0
ip_entry dns2 $w.dns2
grid $w.dns2 -row $row -column 1
incr row
ttk::button $w.accept -text "Accept" -style FA.TButton -command "config_accept $type"
grid $w.accept -row $row -column 0 -columnspan 2 -sticky e
# trigger the initial read/write or readonly state based on the dhcp
# or manual setting of the ipv4ConfigType, which will be updated from
# radiobutton actions after this
ipv4_config_type_changed
}
#
# delete_ip_netmask_default_gateway - delete the Tk objects created
#
proc delete_ip_netmask_default_gateway {w} {
foreach obj [list ip netmask default_gateway dns1 dns2] {
itcl::delete object $obj
}
destroy $w
}
proc set_dhcp_fields_state {state} {
foreach ipv4Object $::ipv4ObjectList {
if { $ipv4Object == "dns1" || $ipv4Object == "dns2" } {
$ipv4Object set_state normal
} else {
$ipv4Object set_state $state
}
}
}
#
# ipv4_config_type_changed - callback routine to do the needful if the user
# siwtches between manual and dhcp config options
#
proc ipv4_config_type_changed {} {
switch $::ipv4ConfigType {
"static" {
set_dhcp_fields_state normal
}
"dhcp" {
set_dhcp_fields_state disabled
focus .config.f.dhcp_options.using_dhcp
}
default {
error "software error, ipv4ConfigType value of $::ipv4ConfigType not accounted for"
}
}
}
#
# populate_ip_fields - populate the IP widgets with real values from the
# system
#
proc populate_ip_fields {type} {
piawareConfig read_config
set_dhcp_fields_state normal
ip store [piawareConfig get $type-address]
netmask store [piawareConfig get $type-netmask]
default_gateway store [piawareConfig get $type-gateway]
lassign [piawareConfig get $type-nameservers] dns1 dns2
dns1 store $dns1
dns2 store $dns2
if {[piawareConfig get $type-type] == "dhcp"} {
set ::ipv4ConfigType dhcp
} else {
set ::ipv4ConfigType static
}
ipv4_config_type_changed
}
proc config_accept {type} {
switch $::ipv4ConfigType {
"static" {
piawareConfig read_config
piawareConfig set_option $type-type $::ipv4ConfigType
piawareConfig set_option $type-address [ip get]
piawareConfig set_option $type-netmask [netmask get]
piawareConfig set_option $type-gateway [default_gateway get]
piawareConfig set_option $type-nameservers [get_dns]
piawareConfig set_option wired-network yes
#for some reason the wireless network conflicts with the wired so we turn wireless off
piawareConfig set_option wireless-network no
piawareConfig write_config
}
"dhcp" {
piawareConfig read_config
piawareConfig set_option $type-type $::ipv4ConfigType
piawareConfig set_option wired-network yes
#for some reason the wireless network conflicts with the wired so we turn wireless off
piawareConfig set_option wireless-network no
piawareConfig write_config
}
default {
}
}
delete_ip_netmask_default_gateway .config
change_network_status
}
proc get_dns {} {
set dnslist {}
set d1 [dns1 get]
if {$d1 ne ""} {
lappend dnslist $d1
}
set d2 [dns2 get]
if {$d2 ne ""} {
lappend dnslist $d2
}
return $dnslist
}
proc config_cancel {} {
delete_ip_netmask_default_gateway .config
}
set dhcpClientID "piaware"