File Coverage

blib/lib/FusionInventory/Agent/Tools/Unix.pm
Criterion Covered Total %
statement 143 168 85.1
branch 40 64 62.5
condition 5 9 55.5
subroutine 17 20 85.0
pod 5 5 100.0
total 210 266 78.9


line stmt bran cond sub pod time code
1             package FusionInventory::Agent::Tools::Unix;
2              
3 44     44   6959659 use strict;
  44         235  
  44         1187  
4 44     44   240 use warnings;
  44         110  
  44         1282  
5 44     44   213 use base 'Exporter';
  44         139  
  44         3740  
6              
7 44     44   230 use English qw(-no_match_vars);
  44         80  
  44         329  
8 44     44   23108 use File::stat;
  44         15604  
  44         402  
9 44     44   3881 use File::Which;
  44         1891  
  44         1949  
10 44     44   2192 use Memoize;
  44         5253  
  44         2080  
11 44     44   37314 use Time::Local;
  44         76978  
  44         2821  
12              
13 44     44   1626 use FusionInventory::Agent::Tools;
  44         85  
  44         8029  
14 44     44   23689 use FusionInventory::Agent::Tools::Network;
  44         147  
  44         100374  
15              
16             our @EXPORT = qw(
17             getDeviceCapacity
18             getIpDhcp
19             getFilesystemsFromDf
20             getFilesystemsTypesFromMount
21             getProcesses
22             getRoutingTable
23             );
24              
25             memoize('getProcesses');
26              
27             sub getDeviceCapacity {
28 0     0 1 0 my (%params) = @_;
29              
30 0 0       0 return unless $params{device};
31              
32             # GNU version requires -p flag
33 0 0       0 my $command = getFirstLine(command => '/sbin/fdisk -v') =~ '^GNU' ?
34             "/sbin/fdisk -p -s $params{device}" :
35             "/sbin/fdisk -s $params{device}" ;
36              
37             my $capacity = getFirstLine(
38             command => $command,
39             logger => $params{logger},
40 0         0 );
41              
42 0 0       0 $capacity = int($capacity / 1000) if $capacity;
43              
44 0         0 return $capacity;
45             }
46              
47             sub getIpDhcp {
48 0     0 1 0 my ($logger, $if) = @_;
49              
50 0         0 my $dhcpLeaseFile = _findDhcpLeaseFile($if);
51              
52 0 0       0 return unless $dhcpLeaseFile;
53              
54 0         0 _parseDhcpLeaseFile($logger, $if, $dhcpLeaseFile);
55             }
56              
57             sub _findDhcpLeaseFile {
58 0     0   0 my ($if) = @_;
59              
60 0         0 my @directories = qw(
61             /var/db
62             /var/lib/dhcp3
63             /var/lib/dhcp
64             /var/lib/dhclient
65             );
66 0         0 my @patterns = ("*$if*.lease", "*.lease", "dhclient.leases.$if");
67 0         0 my @files;
68              
69 0         0 foreach my $directory (@directories) {
70 0 0       0 next unless -d $directory;
71 0         0 foreach my $pattern (@patterns) {
72              
73             push @files,
74 0         0 grep { -s $_ }
  0         0  
75             glob("$directory/$pattern");
76             }
77             }
78              
79 0 0       0 return unless @files;
80              
81             # sort by creation time
82             @files =
83 0         0 map { $_->[0] }
84 0         0 sort { $a->[1]->ctime() <=> $b->[1]->ctime() }
85 0         0 map { [ $_, stat($_) ] }
  0         0  
86             @files;
87              
88             # take the last one
89 0         0 return $files[-1];
90             }
91              
92             sub _parseDhcpLeaseFile {
93 2     2   104001 my ($logger, $if, $lease_file) = @_;
94              
95              
96 2         18 my $handle = getFileHandle(file => $lease_file, logger => $logger);
97 2 50       6 return unless $handle;
98              
99 2         176 my ($lease, $dhcp, $server_ip, $expiration_time);
100              
101             # find the last lease for the interface with its expire date
102 2         34 while (my $line = <$handle>) {
103 60 100       403 if ($line=~ /^lease/i) {
104 4         7 $lease = 1;
105 4         12 next;
106             }
107 56 100       120 if ($line=~ /^}/) {
108 4         7 $lease = 0;
109 4         22 next;
110             }
111              
112 52 50       92 next unless $lease;
113              
114             # inside a lease section
115 52 100       119 if ($line =~ /interface\s+"([^"]+)"/){
116 4         10 $dhcp = ($1 eq $if);
117 4         13 next;
118             }
119              
120 48 50       86 next unless $dhcp;
121              
122 48 100       226 if (
    100          
123             $line =~
124             /option \s+ dhcp-server-identifier \s+ (\d{1,3}(?:\.\d{1,3}){3})/x
125             ) {
126             # server IP
127 4         16 $server_ip = $1;
128             } elsif (
129             $line =~
130             /expire \s+ \d \s+ (\d+)\/(\d+)\/(\d+) \s+ (\d+):(\d+):(\d+)/x
131             ) {
132 4         18 my ($year, $mon, $day, $hour, $min, $sec)
133             = ($1, $2, $3, $4, $5, $6);
134             # warning, expected ranges is 0-11, not 1-12
135 4         8 $mon = $mon - 1;
136 4         14 $expiration_time = timelocal($sec, $min, $hour, $day, $mon, $year);
137             }
138             }
139 2         63 close $handle;
140              
141 2 50       7 return unless $expiration_time;
142              
143 2         4 my $current_time = time();
144              
145 2 50       15 return $current_time <= $expiration_time ? $server_ip : undef;
146             }
147              
148             sub getFilesystemsFromDf {
149 5     5 1 43613 my (%params) = @_;
150 5         19 my $handle = getFileHandle(%params);
151              
152 5         9 my @filesystems;
153              
154             # get headers line first
155 5         94 my $line = <$handle>;
156 5 50       12 return unless $line;
157              
158 5         9 chomp $line;
159 5         54 my @headers = split(/\s+/, $line);
160              
161 5         19 while (my $line = <$handle>) {
162 24         35 chomp $line;
163 24         143 my @infos = split(/\s+/, $line);
164              
165             # depending on the df implementation, and how it is called
166             # the filesystem type may appear as second colum, or be missing
167             # in the second case, it has to be given by caller
168 24         29 my ($filesystem, $total, $free, $type);
169 24 100       49 if ($headers[1] eq 'Type') {
170 8         11 $filesystem = $infos[1];
171 8         9 $total = $infos[2];
172 8         9 $free = $infos[4];
173 8         14 $type = $infos[6];
174             } else {
175 16         25 $filesystem = $params{type};
176 16         24 $total = $infos[1];
177 16         20 $free = $infos[3];
178 16         21 $type = $infos[5];
179             }
180              
181             # skip some virtual filesystems
182 24 100 66     146 next if $total !~ /^\d+$/ || $total == 0;
183 23 100 66     134 next if $free !~ /^\d+$/ || $free == 0;
184              
185 20         166 push @filesystems, {
186             VOLUMN => $infos[0],
187             FILESYSTEM => $filesystem,
188             TOTAL => int($total / 1024),
189             FREE => int($free / 1024),
190             TYPE => $type
191             };
192             }
193              
194 5         65 close $handle;
195              
196 5         34 return @filesystems;
197             }
198              
199             sub getFilesystemsTypesFromMount {
200 3     3 1 3850 my (%params) = (
201             command => 'mount',
202             @_
203             );
204              
205 3         16 my $handle = getFileHandle(%params);
206 3 50       11 return unless $handle;
207              
208 3         5 my @types;
209 3         35 while (my $line = <$handle>) {
210             # BSD-style:
211             # /dev/mirror/gm0s1d on / (ufs, local, soft-updates)
212 17 100       66 if ($line =~ /^\S+ on \S+ \((\w+)/) {
213 5         12 push @types, $1;
214 5         17 next;
215             }
216             # Linux style:
217             # /dev/sda2 on / type ext4 (rw,noatime,errors=remount-ro)
218 12 100       47 if ($line =~ /^\S+ on \S+ type (\w+)/) {
219 8         19 push @types, $1;
220 8         53 next;
221             }
222             }
223 3         22 close $handle;
224              
225             ### raw result: @types
226              
227             return
228 3         13 uniq
229             @types;
230             }
231              
232             sub getProcesses {
233             my $ps = which('ps');
234             return -l $ps && readlink($ps) eq 'busybox' ? _getProcessesBusybox(@_) :
235             _getProcessesOther(@_) ;
236             }
237              
238             sub _getProcessesBusybox {
239 1     1   2069 my (%params) = (
240             command => 'ps',
241             @_
242             );
243              
244 1         6 my $handle = getFileHandle(%params);
245              
246             # skip headers
247 1         21 my $line = <$handle>;
248              
249 1         2 my @processes;
250              
251 1         6 while ($line = <$handle>) {
252 149 50       591 next unless $line =~
253             /^
254             \s* (\S+)
255             \s+ (\S+)
256             \s+ (\S+)
257             \s+ ...
258             \s+ (\S.+)
259             /x;
260 149         241 my $pid = $1;
261 149         215 my $user = $2;
262 149         199 my $vsz = $3;
263 149         248 my $cmd = $4;
264              
265 149         951 push @processes, {
266             USER => $user,
267             PID => $pid,
268             VIRTUALMEMORY => $vsz,
269             CMD => $cmd
270             };
271             }
272              
273 1         8 close $handle;
274              
275 1         28 return @processes;
276             }
277              
278             sub _getProcessesOther {
279 2 50   2   200559 my (%params) = (
280             command =>
281             'ps -A -o user,pid,pcpu,pmem,vsz,tty,etime' . ',' .
282             ($OSNAME eq 'solaris' ? 'comm' : 'command'),
283             @_
284             );
285              
286 2         13 my $handle = getFileHandle(%params);
287              
288             # skip headers
289 2         284 my $line = <$handle>;
290              
291             # get the current timestamp
292 2         7 my $localtime = time();
293              
294 2         2 my @processes;
295              
296 2         9 while ($line = <$handle>) {
297              
298 166 50       907 next unless $line =~
299             /^ \s*
300             (\S+) \s+
301             (\S+) \s+
302             (\S+) \s+
303             (\S+) \s+
304             (\S+) \s+
305             (\S+) \s+
306             (\S+) \s+
307             (\S.*\S)
308             /x;
309              
310 166         283 my $user = $1;
311 166         232 my $pid = $2;
312 166         219 my $cpu = $3;
313 166         224 my $mem = $4;
314 166         254 my $vsz = $5;
315 166         230 my $tty = $6;
316 166         239 my $etime = $7;
317 166         277 my $cmd = $8;
318              
319 166         361 push @processes, {
320             USER => $user,
321             PID => $pid,
322             CPUUSAGE => $cpu,
323             MEM => $mem,
324             VIRTUALMEMORY => $vsz,
325             TTY => $tty,
326             STARTED => _getProcessStartTime($localtime, $etime),
327             CMD => $cmd
328             };
329             }
330              
331 2         145 close $handle;
332              
333 2         39 return @processes;
334             }
335              
336             my %month = (
337             Jan => '01',
338             Feb => '02',
339             Mar => '03',
340             Apr => '04',
341             May => '05',
342             Jun => '06',
343             Jul => '07',
344             Aug => '08',
345             Sep => '09',
346             Oct => '10',
347             Nov => '11',
348             Dec => '12',
349             );
350             my %day = (
351             Mon => '01',
352             Tue => '02',
353             Wed => '03',
354             Thu => '04',
355             Fry => '05',
356             Sat => '06',
357             Sun => '07',
358             );
359             my $monthPattern = join ('|', keys %month);
360              
361             # Computes a consistent process starting time from the process etime value.
362             sub _getProcessStartTime {
363 166     166   245 my ($localtime, $elapsedtime_string) = @_;
364              
365              
366             # POSIX specifies that ps etime entry looks like [[dd-]hh:]mm:ss
367             # if either day and hour are not present then they will eat
368             # up the minutes and seconds so split on a non digit and reverse it:
369 166         651 my ($psec, $pmin, $phour, $pday) =
370             reverse(split(/\D/, $elapsedtime_string));
371              
372             ## no critic (ExplicitReturnUndef)
373 166 50 33     711 return undef unless defined $psec && defined $pmin;
374              
375             # Compute a timestamp from the process etime value
376 166 100       563 my $elapsedtime = $psec +
    100          
377             $pmin * 60 +
378             ($phour ? $phour * 60 * 60 : 0) +
379             ($pday ? $pday * 24 * 60 * 60 : 0) ;
380              
381             # Substract this timestamp from the current time, creating the date at which
382             # the process was launched
383 166         2386 my (undef, $min, $hour, $day, $month, $year) =
384             localtime($localtime - $elapsedtime);
385              
386             # Output the final date, after completing it (time + UNIX epoch)
387 166         280 $year = $year + 1900;
388 166         197 $month = $month + 1;
389 166         1789 return sprintf("%04d-%02d-%02d %02d:%02d", $year, $month, $day, $hour, $min);
390             }
391              
392             sub getRoutingTable {
393 10     10 1 13220 my (%params) = (
394             command => 'netstat -nr -f inet',
395             @_
396             );
397              
398 10         38 my $handle = getFileHandle(%params);
399 10 50       32 return unless $handle;
400              
401 10         11 my $routes;
402              
403             # first, skip all header lines
404 10         126 while (my $line = <$handle>) {
405 26 100       108 last if $line =~ /^Destination/;
406             }
407              
408             # second, collect routes
409 10         30 while (my $line = <$handle>) {
410 125 100       1203 next unless $line =~ /^
411             (
412             $ip_address_pattern
413             |
414             $network_pattern
415             |
416             default
417             )
418             \s+
419             (
420             $ip_address_pattern
421             |
422             $mac_address_pattern
423             |
424             link\#\d+
425             )
426             /x;
427 102         537 $routes->{$1} = $2;
428             }
429 10         78 close $handle;
430              
431 10         47 return $routes;
432             }
433              
434             1;
435             __END__