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   4863680 use strict;
  44         79  
  44         1018  
4 44     44   139 use warnings;
  44         52  
  44         971  
5 44     44   127 use base 'Exporter';
  44         81  
  44         2829  
6              
7 44     44   175 use English qw(-no_match_vars);
  44         56  
  44         235  
8 44     44   14315 use File::stat;
  44         9270  
  44         244  
9 44     44   2437 use File::Which;
  44         1275  
  44         1337  
10 44     44   1085 use Memoize;
  44         3350  
  44         1484  
11 44     44   18882 use Time::Local;
  44         51059  
  44         2215  
12              
13 44     44   951 use FusionInventory::Agent::Tools;
  44         55  
  44         5291  
14 44     44   14364 use FusionInventory::Agent::Tools::Network;
  44         89  
  44         69653  
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   38159 my ($logger, $if, $lease_file) = @_;
94              
95              
96 2         9 my $handle = getFileHandle(file => $lease_file, logger => $logger);
97 2 50       5 return unless $handle;
98              
99 2         84 my ($lease, $dhcp, $server_ip, $expiration_time);
100              
101             # find the last lease for the interface with its expire date
102 2         20 while (my $line = <$handle>) {
103 60 100       250 if ($line=~ /^lease/i) {
104 4         5 $lease = 1;
105 4         7 next;
106             }
107 56 100       72 if ($line=~ /^}/) {
108 4         3 $lease = 0;
109 4         14 next;
110             }
111              
112 52 50       55 next unless $lease;
113              
114             # inside a lease section
115 52 100       71 if ($line =~ /interface\s+"([^"]+)"/){
116 4         8 $dhcp = ($1 eq $if);
117 4         7 next;
118             }
119              
120 48 50       51 next unless $dhcp;
121              
122 48 100       120 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         9 $server_ip = $1;
128             } elsif (
129             $line =~
130             /expire \s+ \d \s+ (\d+)\/(\d+)\/(\d+) \s+ (\d+):(\d+):(\d+)/x
131             ) {
132 4         11 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         5 $mon = $mon - 1;
136 4         13 $expiration_time = timelocal($sec, $min, $hour, $day, $mon, $year);
137             }
138             }
139 2         18 close $handle;
140              
141 2 50       4 return unless $expiration_time;
142              
143 2         3 my $current_time = time();
144              
145 2 50       11 return $current_time <= $expiration_time ? $server_ip : undef;
146             }
147              
148             sub getFilesystemsFromDf {
149 5     5 1 21505 my (%params) = @_;
150 5         19 my $handle = getFileHandle(%params);
151              
152 5         7 my @filesystems;
153              
154             # get headers line first
155 5         66 my $line = <$handle>;
156 5 50       11 return unless $line;
157              
158 5         6 chomp $line;
159 5         32 my @headers = split(/\s+/, $line);
160              
161 5         12 while (my $line = <$handle>) {
162 24         21 chomp $line;
163 24         75 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         19 my ($filesystem, $total, $free, $type);
169 24 100       27 if ($headers[1] eq 'Type') {
170 8         7 $filesystem = $infos[1];
171 8         7 $total = $infos[2];
172 8         4 $free = $infos[4];
173 8         8 $type = $infos[6];
174             } else {
175 16         11 $filesystem = $params{type};
176 16         15 $total = $infos[1];
177 16         8 $free = $infos[3];
178 16         11 $type = $infos[5];
179             }
180              
181             # skip some virtual filesystems
182 24 100 66     100 next if $total !~ /^\d+$/ || $total == 0;
183 23 100 66     87 next if $free !~ /^\d+$/ || $free == 0;
184              
185 20         100 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         26 close $handle;
195              
196 5         24 return @filesystems;
197             }
198              
199             sub getFilesystemsTypesFromMount {
200 3     3 1 2583 my (%params) = (
201             command => 'mount',
202             @_
203             );
204              
205 3         9 my $handle = getFileHandle(%params);
206 3 50       6 return unless $handle;
207              
208 3         3 my @types;
209 3         28 while (my $line = <$handle>) {
210             # BSD-style:
211             # /dev/mirror/gm0s1d on / (ufs, local, soft-updates)
212 17 100       43 if ($line =~ /^\S+ on \S+ \((\w+)/) {
213 5         8 push @types, $1;
214 5         10 next;
215             }
216             # Linux style:
217             # /dev/sda2 on / type ext4 (rw,noatime,errors=remount-ro)
218 12 100       25 if ($line =~ /^\S+ on \S+ type (\w+)/) {
219 8         11 push @types, $1;
220 8         17 next;
221             }
222             }
223 3         14 close $handle;
224              
225             ### raw result: @types
226              
227             return
228 3         10 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   4791 my (%params) = (
240             command => 'ps',
241             @_
242             );
243              
244 1         4 my $handle = getFileHandle(%params);
245              
246             # skip headers
247 1         23 my $line = <$handle>;
248              
249 1         2 my @processes;
250              
251 1         4 while ($line = <$handle>) {
252 149 50       379 next unless $line =~
253             /^
254             \s* (\S+)
255             \s+ (\S+)
256             \s+ (\S+)
257             \s+ ...
258             \s+ (\S.+)
259             /x;
260 149         127 my $pid = $1;
261 149         96 my $user = $2;
262 149         136 my $vsz = $3;
263 149         125 my $cmd = $4;
264              
265 149         467 push @processes, {
266             USER => $user,
267             PID => $pid,
268             VIRTUALMEMORY => $vsz,
269             CMD => $cmd
270             };
271             }
272              
273 1         7 close $handle;
274              
275 1         19 return @processes;
276             }
277              
278             sub _getProcessesOther {
279 2 50   2   132866 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         12 my $handle = getFileHandle(%params);
287              
288             # skip headers
289 2         188 my $line = <$handle>;
290              
291             # get the current timestamp
292 2         6 my $localtime = time();
293              
294 2         2 my @processes;
295              
296 2         10 while ($line = <$handle>) {
297              
298 166 50       617 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         184 my $user = $1;
311 166         132 my $pid = $2;
312 166         123 my $cpu = $3;
313 166         119 my $mem = $4;
314 166         128 my $vsz = $5;
315 166         121 my $tty = $6;
316 166         118 my $etime = $7;
317 166         146 my $cmd = $8;
318              
319 166         225 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         26 close $handle;
332              
333 2         27 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   124 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         439 my ($psec, $pmin, $phour, $pday) =
370             reverse(split(/\D/, $elapsedtime_string));
371              
372             ## no critic (ExplicitReturnUndef)
373 166 50 33     464 return undef unless defined $psec && defined $pmin;
374              
375             # Compute a timestamp from the process etime value
376 166 100       344 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         1269 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         170 $year = $year + 1900;
388 166         97 $month = $month + 1;
389 166         1178 return sprintf("%04d-%02d-%02d %02d:%02d", $year, $month, $day, $hour, $min);
390             }
391              
392             sub getRoutingTable {
393 10     10 1 8431 my (%params) = (
394             command => 'netstat -nr -f inet',
395             @_
396             );
397              
398 10         31 my $handle = getFileHandle(%params);
399 10 50       18 return unless $handle;
400              
401 10         4 my $routes;
402              
403             # first, skip all header lines
404 10         107 while (my $line = <$handle>) {
405 26 100       74 last if $line =~ /^Destination/;
406             }
407              
408             # second, collect routes
409 10         19 while (my $line = <$handle>) {
410 125 100       730 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         324 $routes->{$1} = $2;
428             }
429 10         48 close $handle;
430              
431 10         37 return $routes;
432             }
433              
434             1;
435             __END__