line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::ISC::DHCPClient; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
53297
|
use 5.014; |
|
1
|
|
|
|
|
3
|
|
4
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
15
|
|
5
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
51
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
Net::ISC::DHCPClient - ISC dhclient lease reader |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 VERSION |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Version 0.14 |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=cut |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $VERSION = '0.14'; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
1
|
|
|
1
|
|
355
|
use Net::ISC::DHCPClient::InetLease; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
24
|
|
22
|
1
|
|
|
1
|
|
323
|
use Net::ISC::DHCPClient::Inet6Lease; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
23
|
1
|
|
|
1
|
|
381
|
use Time::Local; |
|
1
|
|
|
|
|
1856
|
|
|
1
|
|
|
|
|
2106
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub new { |
27
|
0
|
|
|
0
|
0
|
|
my ($class, %opts) = @_; |
28
|
|
|
|
|
|
|
|
29
|
0
|
0
|
|
|
|
|
die "Missing leases_path!" if (!defined($opts{leases_path})); |
30
|
|
|
|
|
|
|
|
31
|
0
|
|
|
|
|
|
my $self = {}; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# Incoming arguments: |
34
|
0
|
0
|
|
|
|
|
$self->{INTERFACE} = defined($opts{interface}) ? $opts{interface} : undef; |
35
|
0
|
|
|
|
|
|
$self->{leases_path} = $opts{leases_path}; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Internal storage: |
38
|
0
|
|
|
|
|
|
$self->{leases_af_inet} = undef; |
39
|
0
|
|
|
|
|
|
$self->{leases_af_inet6} = undef; |
40
|
|
|
|
|
|
|
|
41
|
0
|
|
|
|
|
|
bless ($self, $class); |
42
|
|
|
|
|
|
|
|
43
|
0
|
|
|
|
|
|
return $self; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub is_dhcp($$;$) |
48
|
|
|
|
|
|
|
{ |
49
|
0
|
|
|
0
|
0
|
|
my ($self, $af, $inteface_to_query) = @_; |
50
|
|
|
|
|
|
|
|
51
|
0
|
0
|
0
|
|
|
|
die "Address family is: inet or inet6!" if (!($af eq 'inet' || $af eq 'inet6')); |
52
|
|
|
|
|
|
|
|
53
|
0
|
0
|
0
|
|
|
|
if (defined($inteface_to_query) && |
|
|
|
0
|
|
|
|
|
54
|
|
|
|
|
|
|
defined($self->{INTERFACE}) && |
55
|
|
|
|
|
|
|
$self->{INTERFACE} ne $inteface_to_query) { |
56
|
0
|
|
|
|
|
|
die sprintf("Cannot query interface %s, has %s.", $inteface_to_query, $self->{INTERFACE}); |
57
|
|
|
|
|
|
|
} |
58
|
0
|
0
|
|
|
|
|
if (defined($self->{INTERFACE})) { |
59
|
0
|
0
|
|
|
|
|
if ($af eq 'inet') { |
60
|
0
|
|
|
|
|
|
$self->leases_af_inet(); |
61
|
0
|
|
|
|
|
|
return scalar(@{$self->{leases_af_inet}}) > 0; |
|
0
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
} |
63
|
0
|
0
|
|
|
|
|
if ($af eq 'inet6') { |
64
|
0
|
|
|
|
|
|
$self->leases_af_inet6(); |
65
|
0
|
|
|
|
|
|
return scalar(@{$self->{leases_af_inet6}}) > 0; |
|
0
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
|
|
|
return 0; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
0
|
0
|
|
|
|
|
die "Need interface!" if (!defined($inteface_to_query)); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# Iterate all found leases and look for given interface |
74
|
0
|
|
|
|
|
|
my $leases_to_check; |
75
|
0
|
0
|
|
|
|
|
$leases_to_check = $self->{leases_af_inet} if ($af eq 'inet'); |
76
|
0
|
0
|
|
|
|
|
$leases_to_check = $self->{leases_af_inet6} if ($af eq 'inet6'); |
77
|
0
|
|
|
|
|
|
for my $lease (@$leases_to_check) { |
78
|
0
|
0
|
|
|
|
|
return 1 if ($lease->{INTERFACE} eq $inteface_to_query); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
|
return 0; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub leases_af_inet($) |
85
|
|
|
|
|
|
|
{ |
86
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
87
|
|
|
|
|
|
|
|
88
|
0
|
0
|
|
|
|
|
return $self->{leases_af_inet} if ($self->{leases_af_inet}); |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
$self->{leases_af_inet} = $self->_read_lease_file($self->{leases_path}, |
91
|
|
|
|
|
|
|
$self->{INTERFACE}, |
92
|
0
|
|
|
|
|
|
'inet'); |
93
|
|
|
|
|
|
|
|
94
|
0
|
|
|
|
|
|
return $self->{leases_af_inet}; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub leases_af_inet6($) |
98
|
|
|
|
|
|
|
{ |
99
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
100
|
|
|
|
|
|
|
|
101
|
0
|
0
|
|
|
|
|
return $self->{leases_af_inet6} if ($self->{leases_af_inet6}); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
$self->{leases_af_inet6} = $self->_read_lease_file($self->{leases_path}, |
104
|
|
|
|
|
|
|
$self->{INTERFACE}, |
105
|
0
|
|
|
|
|
|
'inet6'); |
106
|
|
|
|
|
|
|
|
107
|
0
|
|
|
|
|
|
return $self->{leases_af_inet6}; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub _read_lease_file($$$$) |
112
|
|
|
|
|
|
|
{ |
113
|
0
|
|
|
0
|
|
|
my ($self, $path, $interface, $af) = @_; |
114
|
0
|
|
|
|
|
|
my @isc_lease_files; |
115
|
|
|
|
|
|
|
my @netplan_lease_files; |
116
|
0
|
|
|
|
|
|
my $leases = []; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# Search for matching .lease files |
119
|
0
|
|
|
|
|
|
my $leasefile_re1; |
120
|
|
|
|
|
|
|
my $leasefile_re2; |
121
|
0
|
|
|
|
|
|
my $leasefile_re3; |
122
|
0
|
0
|
|
|
|
|
if ($af eq 'inet') { |
|
|
0
|
|
|
|
|
|
123
|
0
|
0
|
|
|
|
|
if ($interface) { |
124
|
0
|
|
|
|
|
|
$leasefile_re1 = qr/^dhclient-(.*)?-($interface)\.lease$/; |
125
|
0
|
|
|
|
|
|
$leasefile_re2 = qr/^dhclient\.($interface)\.leases$/; |
126
|
0
|
|
|
|
|
|
$leasefile_re3 = qr/^internal-(.*)?-($interface)\.lease$/; |
127
|
|
|
|
|
|
|
} else { |
128
|
0
|
|
|
|
|
|
$leasefile_re1 = qr/^dhclient-(.*)?-(.+)\.lease$/; |
129
|
0
|
|
|
|
|
|
$leasefile_re2 = qr/^dhclient\.(.+)\.leases$/; |
130
|
0
|
|
|
|
|
|
$leasefile_re3 = qr/^internal-(.*)?-($interface)\.lease$/; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
} elsif ($af eq 'inet6') { |
133
|
0
|
0
|
|
|
|
|
if ($interface) { |
134
|
0
|
|
|
|
|
|
$leasefile_re1 = qr/^dhclient6-(.*)?-($interface)\.lease$/; |
135
|
0
|
|
|
|
|
|
$leasefile_re2 = qr/^dhclient6\.($interface)\.leases$/; |
136
|
|
|
|
|
|
|
} else { |
137
|
0
|
|
|
|
|
|
$leasefile_re1 = qr/^dhclient6-(.*)?-(.+)\.lease$/; |
138
|
0
|
|
|
|
|
|
$leasefile_re2 = qr/^dhclient6\.(.+)\.leases$/; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
} else { |
141
|
0
|
|
|
|
|
|
die "Unknown AF! '$af'"; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
|
my @paths_to_attempt; |
145
|
0
|
0
|
|
|
|
|
if (ref($path) eq "ARRAY") { |
146
|
0
|
|
|
|
|
|
@paths_to_attempt = @$path; |
147
|
|
|
|
|
|
|
} else { |
148
|
0
|
|
|
|
|
|
@paths_to_attempt = ($path); |
149
|
|
|
|
|
|
|
} |
150
|
0
|
|
|
|
|
|
foreach my $lease_path (@paths_to_attempt) { |
151
|
0
|
0
|
0
|
|
|
|
next if (! -d $lease_path || ! -X $lease_path); |
152
|
0
|
0
|
|
|
|
|
opendir(my $dh, $lease_path) or |
153
|
|
|
|
|
|
|
die "Cannot read lease directory $lease_path. Error: $!"; |
154
|
0
|
|
|
|
|
|
my @all_files = readdir($dh); |
155
|
0
|
0
|
|
|
|
|
@isc_lease_files = grep { /$leasefile_re1/ && -f "$lease_path/$_" } @all_files; |
|
0
|
|
|
|
|
|
|
156
|
0
|
0
|
|
|
|
|
@isc_lease_files = grep { /$leasefile_re2/ && -f "$lease_path/$_" } @all_files if (!@isc_lease_files); |
|
0
|
0
|
|
|
|
|
|
157
|
0
|
0
|
|
|
|
|
@netplan_lease_files = grep { /$leasefile_re3/ && -f "$lease_path/$_" } @all_files if ($leasefile_re3); |
|
0
|
0
|
|
|
|
|
|
158
|
0
|
|
|
|
|
|
closedir($dh); |
159
|
|
|
|
|
|
|
|
160
|
0
|
0
|
|
|
|
|
if (@isc_lease_files) { |
161
|
0
|
|
|
|
|
|
@isc_lease_files = map("$lease_path/$_", @isc_lease_files); |
162
|
|
|
|
|
|
|
} |
163
|
0
|
0
|
|
|
|
|
if (@netplan_lease_files) { |
164
|
0
|
|
|
|
|
|
@netplan_lease_files = map("$lease_path/$_", @netplan_lease_files); |
165
|
|
|
|
|
|
|
} |
166
|
0
|
0
|
0
|
|
|
|
last if (@isc_lease_files || @netplan_lease_files); |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
0
|
|
|
|
|
|
for my $leaseFile (@isc_lease_files) { |
170
|
0
|
0
|
|
|
|
|
open (LEASEFILE, $leaseFile) or |
171
|
|
|
|
|
|
|
die "Cannot open leasefile $leaseFile. Error: $!"; |
172
|
|
|
|
|
|
|
|
173
|
0
|
|
|
|
|
|
my $currentLease; |
174
|
0
|
|
|
|
|
|
my $hasIscLeaseData = 0; |
175
|
0
|
|
|
|
|
|
my $ia_type = []; |
176
|
0
|
|
|
|
|
|
while () { |
177
|
0
|
|
|
|
|
|
chomp(); |
178
|
0
|
0
|
|
|
|
|
if (/^lease? \{/) { |
179
|
0
|
|
|
|
|
|
$hasIscLeaseData = 1; |
180
|
0
|
|
|
|
|
|
$currentLease = Net::ISC::DHCPClient::InetLease->new(); |
181
|
0
|
|
|
|
|
|
next; |
182
|
|
|
|
|
|
|
} |
183
|
0
|
0
|
|
|
|
|
if (/^lease6 \{/) { |
184
|
0
|
|
|
|
|
|
$hasIscLeaseData = 1; |
185
|
0
|
|
|
|
|
|
$currentLease = Net::ISC::DHCPClient::Inet6Lease->new(); |
186
|
0
|
|
|
|
|
|
next; |
187
|
|
|
|
|
|
|
} |
188
|
0
|
0
|
|
|
|
|
if (/^\}/) { |
189
|
|
|
|
|
|
|
# dhclient will append lease information, newest is last. |
190
|
|
|
|
|
|
|
# unshift() will place newest first. |
191
|
0
|
0
|
|
|
|
|
unshift(@$leases, $currentLease) if ($hasIscLeaseData); |
192
|
0
|
|
|
|
|
|
$hasIscLeaseData = 0; |
193
|
0
|
|
|
|
|
|
next; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
0
|
0
|
|
|
|
|
if (!$hasIscLeaseData) { |
197
|
0
|
|
|
|
|
|
next; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
0
|
|
|
|
|
|
s/^\s+//; # Eat starting whitespace |
201
|
0
|
0
|
|
|
|
|
$self->_isc_af_inet_lease_parser($currentLease, $_) if ($af eq 'inet'); |
202
|
0
|
0
|
|
|
|
|
$self->_isc_af_inet6_lease_parser($currentLease, $ia_type, $_) if ($af eq 'inet6'); |
203
|
|
|
|
|
|
|
} # end while () |
204
|
0
|
|
|
|
|
|
close (LEASEFILE); |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
0
|
|
|
|
|
|
for my $leaseFile (@netplan_lease_files) { |
208
|
0
|
0
|
|
|
|
|
open (LEASEFILE, $leaseFile) or |
209
|
|
|
|
|
|
|
die "Cannot open leasefile $leaseFile. Error: $!"; |
210
|
|
|
|
|
|
|
|
211
|
0
|
|
|
|
|
|
my $currentLease; |
212
|
0
|
|
|
|
|
|
my $ia_type = []; |
213
|
0
|
|
|
|
|
|
while () { |
214
|
0
|
|
|
|
|
|
chomp(); |
215
|
0
|
0
|
|
|
|
|
next if (!/^([^=]+)=(.*)$/); |
216
|
|
|
|
|
|
|
|
217
|
0
|
|
|
|
|
|
my $freshLease = 0; |
218
|
0
|
0
|
|
|
|
|
if (!$currentLease) { |
219
|
0
|
|
|
|
|
|
$currentLease = Net::ISC::DHCPClient::InetLease->new(); |
220
|
0
|
|
|
|
|
|
$freshLease = 1; |
221
|
|
|
|
|
|
|
} |
222
|
0
|
0
|
|
|
|
|
$self->_netplan_af_inet_lease_parser($currentLease, $1, $2) if ($af eq 'inet'); |
223
|
0
|
0
|
|
|
|
|
if ($freshLease) { |
224
|
|
|
|
|
|
|
# Netplan lease file doesn't have interface information in |
225
|
|
|
|
|
|
|
# the file. Parse the filename for interface. |
226
|
0
|
0
|
|
|
|
|
if ($leaseFile =~ /-([^-.]+)\.lease$/) { |
227
|
0
|
|
|
|
|
|
$currentLease->{INTERFACE} = $1; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
} # end while () |
231
|
0
|
|
|
|
|
|
close (LEASEFILE); |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
# There will be only 1 lease in the netplan lease file |
234
|
0
|
0
|
|
|
|
|
unshift(@$leases, $currentLease) if ($currentLease); |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
0
|
|
|
|
|
|
return $leases; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
sub _isc_af_inet_lease_parser($$$) |
241
|
|
|
|
|
|
|
{ |
242
|
0
|
|
|
0
|
|
|
my ($self, $currentLease, $line) = @_; |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
SWITCH: { |
245
|
|
|
|
|
|
|
# interface "eth1"; |
246
|
0
|
0
|
|
|
|
|
/^interface\s+"(.+)";/ && do { |
|
0
|
|
|
|
|
|
|
247
|
0
|
|
|
|
|
|
$currentLease->{INTERFACE} = $1; |
248
|
0
|
|
|
|
|
|
last SWITCH; |
249
|
|
|
|
|
|
|
}; |
250
|
|
|
|
|
|
|
# fixed-address 213.28.228.27; |
251
|
0
|
0
|
|
|
|
|
/^fixed-address\s+(.+);/ && do { |
252
|
0
|
|
|
|
|
|
$currentLease->{FIXED_ADDRESS} = $1; |
253
|
0
|
|
|
|
|
|
last SWITCH; |
254
|
|
|
|
|
|
|
}; |
255
|
|
|
|
|
|
|
# option subnet-mask 255.255.255.0; |
256
|
0
|
0
|
|
|
|
|
(/^option\s+(\S+)\s*(.+);/) && do { |
257
|
0
|
|
|
|
|
|
$currentLease->{OPTION}{$1} = $2; |
258
|
0
|
|
|
|
|
|
last SWITCH; |
259
|
|
|
|
|
|
|
}; |
260
|
|
|
|
|
|
|
# renew 5 2002/12/27 06:25:31; |
261
|
0
|
0
|
|
|
|
|
(m#^renew\s+(\d+)\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);#) && do { |
262
|
0
|
|
|
|
|
|
my $leaseTime = timegm($7, $6, $5, $4, $3-1, $2); |
263
|
0
|
|
|
|
|
|
$currentLease->{RENEW} = $leaseTime; |
264
|
0
|
|
|
|
|
|
last SWITCH; |
265
|
|
|
|
|
|
|
}; |
266
|
|
|
|
|
|
|
# rebind 5 2002/12/27 06:25:31; |
267
|
0
|
0
|
|
|
|
|
(m#^rebind\s+(\d+)\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);#) && do { |
268
|
0
|
|
|
|
|
|
my $leaseTime = timegm($7, $6, $5, $4, $3-1, $2); |
269
|
0
|
|
|
|
|
|
$currentLease->{REBIND} = $leaseTime; |
270
|
0
|
|
|
|
|
|
last SWITCH; |
271
|
|
|
|
|
|
|
}; |
272
|
|
|
|
|
|
|
# renew 5 2002/12/27 06:25:31; |
273
|
0
|
0
|
|
|
|
|
(m#^expire\s+(\d+)\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);#) && do { |
274
|
0
|
|
|
|
|
|
my $leaseTime = timegm($7, $6, $5, $4, $3-1, $2); |
275
|
0
|
|
|
|
|
|
$currentLease->{EXPIRE} = $leaseTime; |
276
|
0
|
|
|
|
|
|
last SWITCH; |
277
|
|
|
|
|
|
|
}; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
sub _isc_af_inet6_lease_parser($$$$) |
282
|
|
|
|
|
|
|
{ |
283
|
0
|
|
|
0
|
|
|
my ($self, $currentLease, $ia_type, $line) = @_; |
284
|
|
|
|
|
|
|
|
285
|
0
|
|
|
|
|
|
my $context = ''; |
286
|
0
|
|
|
|
|
|
my $addr = ''; |
287
|
0
|
0
|
|
|
|
|
$context = $ia_type->[0] if (defined($ia_type->[0])); |
288
|
0
|
0
|
|
|
|
|
$addr = $ia_type->[1] if (defined($ia_type->[1])); |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
SWITCH: { |
291
|
|
|
|
|
|
|
# interface "eth1"; |
292
|
0
|
0
|
|
|
|
|
/^interface\s+"(.+)";/ && do { |
|
0
|
|
|
|
|
|
|
293
|
0
|
|
|
|
|
|
$currentLease->{INTERFACE} = $1; |
294
|
0
|
|
|
|
|
|
last SWITCH; |
295
|
|
|
|
|
|
|
}; |
296
|
0
|
0
|
|
|
|
|
/^ia-na\s+(\S+)\s*\{/ && do { |
297
|
|
|
|
|
|
|
# Identity Association: Non-temporary Address |
298
|
0
|
|
|
|
|
|
push(@$ia_type, 'non-temporary'); |
299
|
0
|
|
|
|
|
|
$currentLease->{IA}->{'non-temporary'} = {}; |
300
|
0
|
|
|
|
|
|
last SWITCH; |
301
|
|
|
|
|
|
|
}; |
302
|
0
|
0
|
|
|
|
|
/^ia-pd\s+(\S+)\s*\{/ && do { |
303
|
|
|
|
|
|
|
# Identity Association: Prefix Delegation |
304
|
0
|
|
|
|
|
|
push(@$ia_type, 'prefix'); |
305
|
0
|
|
|
|
|
|
$currentLease->{IA}->{'prefix'} = {}; |
306
|
0
|
|
|
|
|
|
last SWITCH; |
307
|
|
|
|
|
|
|
}; |
308
|
0
|
0
|
|
|
|
|
/^\}/ && do { |
309
|
0
|
|
|
|
|
|
pop(@$ia_type); |
310
|
0
|
|
|
|
|
|
last SWITCH; |
311
|
|
|
|
|
|
|
}; |
312
|
|
|
|
|
|
|
# starts 1517742816; |
313
|
|
|
|
|
|
|
# Note: either IA or address |
314
|
0
|
0
|
|
|
|
|
/^(starts)\s+(\d+);/ && do { |
315
|
0
|
0
|
|
|
|
|
if (defined($ia_type->[1])) { |
316
|
0
|
|
|
|
|
|
$currentLease->{IA}->{$context}->{$addr}->{$1} = $2; |
317
|
|
|
|
|
|
|
} else { |
318
|
0
|
|
|
|
|
|
$currentLease->{IA}->{$context}->{$1} = $2; |
319
|
|
|
|
|
|
|
} |
320
|
0
|
|
|
|
|
|
last SWITCH; |
321
|
|
|
|
|
|
|
}; |
322
|
|
|
|
|
|
|
# renew 302400; |
323
|
0
|
0
|
|
|
|
|
/^(renew)\s+(\d+);/ && do { |
324
|
0
|
|
|
|
|
|
$currentLease->{IA}->{$context}->{$1} = $2; |
325
|
0
|
|
|
|
|
|
last SWITCH; |
326
|
|
|
|
|
|
|
}; |
327
|
|
|
|
|
|
|
# rebind 483840; |
328
|
0
|
0
|
|
|
|
|
/^(rebind)\s+(\d+);/ && do { |
329
|
0
|
|
|
|
|
|
$currentLease->{IA}->{$context}->{$1} = $2; |
330
|
0
|
|
|
|
|
|
last SWITCH; |
331
|
|
|
|
|
|
|
}; |
332
|
|
|
|
|
|
|
# preferred-life 604800; |
333
|
0
|
0
|
|
|
|
|
/^(preferred-life)\s+(\d+);/ && do { |
334
|
0
|
|
|
|
|
|
$currentLease->{IA}->{$context}->{$addr}->{$1} = $2; |
335
|
0
|
|
|
|
|
|
last SWITCH; |
336
|
|
|
|
|
|
|
}; |
337
|
|
|
|
|
|
|
# max-life 2592000; |
338
|
0
|
0
|
|
|
|
|
/^(max-life)\s+(\d+);/ && do { |
339
|
0
|
|
|
|
|
|
$currentLease->{IA}->{$context}->{$addr}->{$1} = $2; |
340
|
0
|
|
|
|
|
|
last SWITCH; |
341
|
|
|
|
|
|
|
}; |
342
|
0
|
0
|
|
|
|
|
/^(iaaddr)\s+(\S+)\s*\{/ && do { |
343
|
|
|
|
|
|
|
# Identity Association Address |
344
|
0
|
|
|
|
|
|
push(@$ia_type, $1); |
345
|
0
|
|
|
|
|
|
$currentLease->{IA}->{$context}->{$1}->{addr} = $2; |
346
|
0
|
|
|
|
|
|
last SWITCH; |
347
|
|
|
|
|
|
|
}; |
348
|
0
|
0
|
|
|
|
|
/^(iaprefix)\s+(\S+)\s*\{/ && do { |
349
|
|
|
|
|
|
|
# Identity Association Prefix |
350
|
0
|
|
|
|
|
|
push(@$ia_type, $1); |
351
|
0
|
|
|
|
|
|
$currentLease->{IA}->{$context}->{$1}->{addr} = $2; |
352
|
0
|
|
|
|
|
|
last SWITCH; |
353
|
|
|
|
|
|
|
}; |
354
|
0
|
0
|
|
|
|
|
/^option\s+dhcp6\.(\S+)\s+(.+)$/ && do { |
355
|
|
|
|
|
|
|
# option dhcp6. |
356
|
|
|
|
|
|
|
# Collect only global options, skip the IA options |
357
|
0
|
0
|
|
|
|
|
$currentLease->{OPTION}->{$1} = $2 if (!$context); |
358
|
0
|
|
|
|
|
|
last SWITCH; |
359
|
|
|
|
|
|
|
}; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
sub _netplan_af_inet_lease_parser($$$$) |
364
|
|
|
|
|
|
|
{ |
365
|
0
|
|
|
0
|
|
|
my ($self, $currentLease, $variable, $value) = @_; |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
SWITCH: { |
368
|
|
|
|
|
|
|
# ADDRESS=62.248.219.173 |
369
|
0
|
0
|
|
|
|
|
$variable eq "ADDRESS" && do { |
|
0
|
|
|
|
|
|
|
370
|
0
|
|
|
|
|
|
$currentLease->{FIXED_ADDRESS} = $value; |
371
|
0
|
|
|
|
|
|
last SWITCH; |
372
|
|
|
|
|
|
|
}; |
373
|
|
|
|
|
|
|
# NETMASK=255.255.255.0 |
374
|
0
|
0
|
|
|
|
|
$variable eq "NETMASK" && do { |
375
|
0
|
|
|
|
|
|
$currentLease->{OPTION}{'subnet-mask'} = $value; |
376
|
0
|
|
|
|
|
|
last SWITCH; |
377
|
|
|
|
|
|
|
}; |
378
|
|
|
|
|
|
|
# ROUTER=62.248.219.1 |
379
|
0
|
0
|
|
|
|
|
$variable eq "ROUTER" && do { |
380
|
0
|
|
|
|
|
|
$currentLease->{OPTION}{'routers'} = $value; |
381
|
0
|
|
|
|
|
|
last SWITCH; |
382
|
|
|
|
|
|
|
}; |
383
|
|
|
|
|
|
|
# SERVER_ADDRESS=195.74.3.56 |
384
|
0
|
0
|
|
|
|
|
$variable eq "SERVER_ADDRESS" && do { |
385
|
0
|
|
|
|
|
|
$currentLease->{OPTION}{'dhcp-server-identifier'} = $value; |
386
|
0
|
|
|
|
|
|
last SWITCH; |
387
|
|
|
|
|
|
|
}; |
388
|
|
|
|
|
|
|
# DNS=195.197.54.100 212.54.0.3 |
389
|
0
|
0
|
|
|
|
|
$variable eq "DNS" && do { |
390
|
|
|
|
|
|
|
# Have the IP-list comma separated |
391
|
0
|
|
|
|
|
|
$currentLease->{OPTION}{'domain-name-servers'} = ($value =~ s/ +/,/gr); |
392
|
0
|
|
|
|
|
|
last SWITCH; |
393
|
|
|
|
|
|
|
}; |
394
|
|
|
|
|
|
|
# NTP=193.66.253.102 193.66.253.82 |
395
|
0
|
0
|
|
|
|
|
$variable eq "NTP" && do { |
396
|
|
|
|
|
|
|
# Have the IP-list comma separated |
397
|
0
|
|
|
|
|
|
$currentLease->{OPTION}{'ntp-servers'} = ($value =~ s/ +/,/gr); |
398
|
0
|
|
|
|
|
|
last SWITCH; |
399
|
|
|
|
|
|
|
}; |
400
|
|
|
|
|
|
|
# DOMAINNAME=elisa-laajakaista.fi |
401
|
0
|
0
|
|
|
|
|
$variable eq "SERVER_ADDRESS" && do { |
402
|
0
|
|
|
|
|
|
$currentLease->{OPTION}{'domain-name'} = $value; |
403
|
0
|
|
|
|
|
|
last SWITCH; |
404
|
|
|
|
|
|
|
}; |
405
|
|
|
|
|
|
|
# T1=3600 |
406
|
0
|
0
|
|
|
|
|
$variable eq "T1" && do { |
407
|
|
|
|
|
|
|
# Take current time, and add the value on it. |
408
|
|
|
|
|
|
|
# Nowhere near the actual value, but it's better than nothing! |
409
|
0
|
|
|
|
|
|
my $leaseTime = time() + int($value); |
410
|
0
|
|
|
|
|
|
$currentLease->{RENEW} = $leaseTime; |
411
|
0
|
|
|
|
|
|
last SWITCH; |
412
|
|
|
|
|
|
|
}; |
413
|
|
|
|
|
|
|
# T2=6300 |
414
|
0
|
0
|
|
|
|
|
$variable eq "T2" && do { |
415
|
|
|
|
|
|
|
# Take current time, and add the value on it. |
416
|
|
|
|
|
|
|
# Nowhere near the actual value, but it's better than nothing! |
417
|
0
|
|
|
|
|
|
my $leaseTime = time() + int($value); |
418
|
0
|
|
|
|
|
|
$currentLease->{REBIND} = $leaseTime; |
419
|
0
|
|
|
|
|
|
last SWITCH; |
420
|
|
|
|
|
|
|
}; |
421
|
|
|
|
|
|
|
# LIFETIME=7200 |
422
|
0
|
0
|
|
|
|
|
$variable eq "LIFETIME" && do { |
423
|
|
|
|
|
|
|
# Take current time, and add the value on it. |
424
|
|
|
|
|
|
|
# Nowhere near the actual value, but it's better than nothing! |
425
|
0
|
|
|
|
|
|
my $leaseTime = time() + int($value); |
426
|
0
|
|
|
|
|
|
$currentLease->{OPTION}{'dhcp-lease-time'} = int($value); |
427
|
0
|
|
|
|
|
|
$currentLease->{EXPIRE} = $leaseTime; |
428
|
0
|
|
|
|
|
|
last SWITCH; |
429
|
|
|
|
|
|
|
}; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=head1 AUTHOR |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
Jari Turkia, C<< >> |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=head1 BUGS |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
Please report any bugs or feature requests to GitHub https://github.com/HQJaTu/Net-ISC-DHCPClient. |
441
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=head1 SUPPORT |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
perldoc Net::ISC::DHCPClient |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
You can also look for information at: |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=over 4 |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
L |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
L |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
=item * CPAN Ratings |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
L |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
=item * Search CPAN |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
L |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=back |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
Copyright 2017 Jari Turkia. |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
484
|
|
|
|
|
|
|
under the terms of the the Artistic License (2.0). You may obtain a |
485
|
|
|
|
|
|
|
copy of the full license at: |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
L |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
Any use, modification, and distribution of the Standard or Modified |
490
|
|
|
|
|
|
|
Versions is governed by this Artistic License. By using, modifying or |
491
|
|
|
|
|
|
|
distributing the Package, you accept this license. Do not use, modify, |
492
|
|
|
|
|
|
|
or distribute the Package, if you do not accept this license. |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
If your Modified Version has been derived from a Modified Version made |
495
|
|
|
|
|
|
|
by someone other than you, you are nevertheless required to ensure that |
496
|
|
|
|
|
|
|
your Modified Version complies with the requirements of this license. |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
This license does not grant you the right to use any trademark, service |
499
|
|
|
|
|
|
|
mark, tradename, or logo of the Copyright Holder. |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
This license includes the non-exclusive, worldwide, free-of-charge |
502
|
|
|
|
|
|
|
patent license to make, have made, use, offer to sell, sell, import and |
503
|
|
|
|
|
|
|
otherwise transfer the Package with respect to any patent claims |
504
|
|
|
|
|
|
|
licensable by the Copyright Holder that are necessarily infringed by the |
505
|
|
|
|
|
|
|
Package. If you institute patent litigation (including a cross-claim or |
506
|
|
|
|
|
|
|
counterclaim) against any party alleging that the Package constitutes |
507
|
|
|
|
|
|
|
direct or contributory patent infringement, then this Artistic License |
508
|
|
|
|
|
|
|
to you shall terminate on the date that such litigation is filed. |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER |
511
|
|
|
|
|
|
|
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. |
512
|
|
|
|
|
|
|
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR |
513
|
|
|
|
|
|
|
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY |
514
|
|
|
|
|
|
|
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR |
515
|
|
|
|
|
|
|
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR |
516
|
|
|
|
|
|
|
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, |
517
|
|
|
|
|
|
|
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
=cut |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
# vim: tabstop=4 shiftwidth=4 softtabstop=4 expandtab: |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
1; # End of Net::ISC::DHCPClient |