line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sys::Info::Driver::Linux::OS; |
2
|
1
|
|
|
1
|
|
146003
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
3
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
36
|
|
4
|
1
|
|
|
1
|
|
16
|
use vars qw( $VERSION ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
46
|
|
5
|
1
|
|
|
1
|
|
5
|
use base qw( Sys::Info::Base ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
84
|
|
6
|
1
|
|
|
1
|
|
991
|
use POSIX (); |
|
1
|
|
|
|
|
7745
|
|
|
1
|
|
|
|
|
30
|
|
7
|
1
|
|
|
1
|
|
8
|
use Cwd; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
82
|
|
8
|
1
|
|
|
1
|
|
7
|
use Carp qw( croak ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
54
|
|
9
|
1
|
|
|
1
|
|
649
|
use Sys::Info::Driver::Linux; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
55
|
|
10
|
1
|
|
|
1
|
|
701
|
use Sys::Info::Driver::Linux::Constants qw( :all ); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
274
|
|
11
|
1
|
|
|
1
|
|
7
|
use constant FSTAB_LENGTH => 6; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2508
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
##no critic (InputOutput::ProhibitBacktickOperators) |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
$VERSION = '0.7903'; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub init { |
18
|
1
|
|
|
1
|
1
|
4037
|
my $self = shift; |
19
|
1
|
|
|
|
|
12
|
$self->{OSVERSION} = undef; # see _populate_osversion |
20
|
1
|
|
|
|
|
4
|
$self->{FILESYSTEM} = undef; # see _populate_fs |
21
|
1
|
|
|
|
|
3
|
return; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# unimplemented |
25
|
1
|
|
|
1
|
1
|
413
|
sub logon_server {} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub edition { |
28
|
1
|
|
|
1
|
1
|
516
|
return shift->_populate_osversion->{OSVERSION}{RAW}{EDITION}; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub tz { |
32
|
2
|
|
|
2
|
1
|
765
|
my $self = shift; |
33
|
2
|
50
|
|
|
|
42
|
return if ! -e proc->{timezone}; |
34
|
2
|
|
|
|
|
9
|
chomp( my $rv = $self->slurp( proc->{timezone} ) ); |
35
|
2
|
|
|
|
|
237
|
return $rv; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub meta { |
39
|
1
|
|
|
1
|
1
|
17
|
my $self = shift->_populate_osversion; |
40
|
|
|
|
|
|
|
|
41
|
1
|
|
|
|
|
11
|
require POSIX; |
42
|
1
|
|
|
|
|
5
|
require Sys::Info::Device; |
43
|
|
|
|
|
|
|
|
44
|
1
|
|
|
|
|
8
|
my $cpu = Sys::Info::Device->new('CPU'); |
45
|
1
|
|
|
|
|
50
|
my $arch = ($cpu->identify)[0]->{architecture}; |
46
|
1
|
|
|
|
|
29
|
my %mem = $self->_parse_meminfo; |
47
|
1
|
|
|
|
|
70
|
my @swaps = $self->_parse_swap; |
48
|
1
|
|
|
|
|
4
|
my %info; |
49
|
|
|
|
|
|
|
|
50
|
1
|
|
|
|
|
6
|
$info{manufacturer} = $self->{OSVERSION}{MANUFACTURER}; |
51
|
1
|
|
|
|
|
3
|
$info{build_type} = undef; |
52
|
1
|
|
|
|
|
4
|
$info{owner} = undef; |
53
|
1
|
|
|
|
|
4
|
$info{organization} = undef; |
54
|
1
|
|
|
|
|
5
|
$info{product_id} = undef; |
55
|
1
|
|
|
|
|
7
|
$info{install_date} = $self->{OSVERSION}{RAW}{BUILD_DATE}; |
56
|
1
|
|
|
|
|
4
|
$info{boot_device} = undef; |
57
|
|
|
|
|
|
|
|
58
|
1
|
|
|
|
|
172
|
$info{physical_memory_total} = $mem{MemTotal}; |
59
|
1
|
|
|
|
|
6
|
$info{physical_memory_available} = $mem{MemFree}; |
60
|
1
|
|
|
|
|
4
|
$info{page_file_total} = $mem{SwapTotal}; |
61
|
1
|
|
|
|
|
4
|
$info{page_file_available} = $mem{SwapFree}; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# windows specific |
64
|
1
|
|
|
|
|
3
|
$info{windows_dir} = undef; |
65
|
1
|
|
|
|
|
4
|
$info{system_dir} = undef; |
66
|
|
|
|
|
|
|
|
67
|
1
|
|
|
|
|
3
|
$info{system_manufacturer} = undef; |
68
|
1
|
|
|
|
|
4
|
$info{system_model} = undef; |
69
|
1
|
|
|
|
|
11
|
$info{system_type} = sprintf '%s based Computer', $arch; |
70
|
|
|
|
|
|
|
|
71
|
1
|
|
|
|
|
5
|
$info{page_file_path} = join ', ', map { $_->{Filename} } @swaps; |
|
2
|
|
|
|
|
12
|
|
72
|
|
|
|
|
|
|
|
73
|
1
|
|
|
|
|
188
|
return %info; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub tick_count { |
77
|
2
|
|
|
2
|
1
|
13
|
my $self = shift; |
78
|
2
|
|
50
|
|
|
13
|
my $uptime = $self->slurp( proc->{uptime} ) || return 0; |
79
|
2
|
|
|
|
|
291
|
my @uptime = split /\s+/xms, $uptime; |
80
|
|
|
|
|
|
|
# this file has two entries. uptime is the first one. second: idle time |
81
|
2
|
|
|
|
|
12
|
return $uptime[UP_TIME]; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub name { |
85
|
3
|
|
|
3
|
1
|
42
|
my($self, @args) = @_; |
86
|
3
|
|
|
|
|
22
|
$self->_populate_osversion; |
87
|
3
|
50
|
|
|
|
18
|
my %opt = @args % 2 ? () : @args; |
88
|
3
|
100
|
|
|
|
11
|
my $id = $opt{long} ? 'LONGNAME' : 'NAME'; |
89
|
3
|
100
|
|
|
|
26
|
return $self->{OSVERSION}{ $opt{edition} ? $id . '_EDITION' : $id }; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
1
|
|
|
1
|
1
|
5
|
sub version { return shift->_populate_osversion->{OSVERSION}{VERSION} } |
93
|
1
|
|
|
1
|
1
|
3
|
sub build { return shift->_populate_osversion->{OSVERSION}{RAW}{BUILD_DATE} } |
94
|
1
|
|
|
1
|
1
|
27
|
sub uptime { return time - shift->tick_count } |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
# user methods |
97
|
|
|
|
|
|
|
sub is_root { |
98
|
9
|
50
|
|
9
|
1
|
7759
|
return 0 if defined &Sys::Info::EMULATE; |
99
|
9
|
|
|
|
|
18
|
my $name = login_name(); |
100
|
9
|
|
|
|
|
1070
|
my $id = POSIX::geteuid(); |
101
|
9
|
|
|
|
|
427
|
my $gid = POSIX::getegid(); |
102
|
9
|
50
|
|
|
|
210
|
return 0 if $@; |
103
|
9
|
50
|
33
|
|
|
37
|
return 0 if ! defined $id || ! defined $gid; |
104
|
9
|
|
33
|
|
|
763
|
return $id == 0 && $gid == 0 && $name eq 'root'; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub login_name { |
108
|
11
|
|
|
11
|
1
|
14503
|
my($self, @args) = @_; |
109
|
11
|
50
|
|
|
|
41
|
my %opt = @args % 2 ? () : @args; |
110
|
11
|
|
50
|
|
|
270
|
my $login = POSIX::getlogin() || return; |
111
|
0
|
0
|
|
|
|
0
|
my $rv = eval { $opt{real} ? (getpwnam $login)[REAL_NAME_FIELD] : $login }; |
|
0
|
|
|
|
|
0
|
|
112
|
0
|
0
|
|
|
|
0
|
$rv =~ s{ [,]{3,} \z }{}xms if $opt{real}; |
113
|
0
|
|
|
|
|
0
|
return $rv; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
2
|
|
|
2
|
1
|
779
|
sub node_name { return shift->uname->{nodename} } |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub domain_name { |
119
|
2
|
|
|
2
|
1
|
906
|
my $self = shift; |
120
|
|
|
|
|
|
|
# hmmmm... |
121
|
2
|
|
|
|
|
13
|
foreach my $line ( $self->read_file( proc->{resolv} ) ) { |
122
|
6
|
|
|
|
|
278
|
chomp $line; |
123
|
6
|
100
|
|
|
|
21
|
if ( $line =~ m{\A domain \s+ (.*) \z}xmso ) { |
124
|
2
|
|
|
|
|
8
|
return $1; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
} |
127
|
0
|
|
|
|
|
0
|
my $sys = qx{dnsdomainname 2> /dev/null}; |
128
|
0
|
|
|
|
|
0
|
return $sys; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub fs { |
132
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
133
|
1
|
|
|
|
|
11
|
$self->{current_dir} = Cwd::getcwd(); |
134
|
|
|
|
|
|
|
|
135
|
1
|
|
|
|
|
2
|
my(@fstab, @junk, $re); |
136
|
1
|
|
|
|
|
7
|
foreach my $line( $self->read_file( proc->{fstab} ) ) { |
137
|
1
|
|
|
|
|
109
|
chomp $line; |
138
|
1
|
50
|
|
|
|
7
|
next if $line =~ m{ \A \# }xms; |
139
|
0
|
|
|
|
|
0
|
@junk = split /\s+/xms, $line; |
140
|
0
|
0
|
0
|
|
|
0
|
next if ! @junk || @junk != FSTAB_LENGTH; |
141
|
0
|
0
|
|
|
|
0
|
next if lc($junk[FS_TYPE]) eq 'swap'; # ignore swaps |
142
|
0
|
|
|
|
|
0
|
$re = $junk[MOUNT_POINT]; |
143
|
0
|
0
|
|
|
|
0
|
next if $self->{current_dir} !~ m{\Q$re\E}xmsi; |
144
|
0
|
|
|
|
|
0
|
push @fstab, [ $re, $junk[FS_TYPE] ]; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
1
|
50
|
|
|
|
4
|
@fstab = reverse sort { $a->[0] cmp $b->[0] } @fstab if @fstab > 1; |
|
0
|
|
|
|
|
0
|
|
148
|
1
|
|
|
|
|
5
|
my $fstype = $fstab[0]->[1]; |
149
|
1
|
|
|
|
|
9
|
my $attr = $self->_fs_attributes( $fstype ); |
150
|
|
|
|
|
|
|
return |
151
|
0
|
|
|
|
|
0
|
filesystem => $fstype, |
152
|
1
|
50
|
|
|
|
18
|
($attr ? %{$attr} : ()) |
153
|
|
|
|
|
|
|
; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
1
|
50
|
|
1
|
1
|
382
|
sub bitness { return shift->uname->{machine} =~ m{64}xms ? '64' : '32' } |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# ------------------------[ P R I V A T E ]------------------------ # |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub _parse_meminfo { |
161
|
1
|
|
|
1
|
|
4
|
my $self = shift; |
162
|
1
|
|
|
|
|
3
|
my %mem; |
163
|
1
|
|
|
|
|
7
|
foreach my $line ( split /\n/xms, $self->slurp( proc->{meminfo} ) ) { |
164
|
42
|
|
|
|
|
1852
|
chomp $line; |
165
|
42
|
|
|
|
|
118
|
my($k, $v) = split /:/xms, $line; |
166
|
|
|
|
|
|
|
# units in KB |
167
|
42
|
|
|
|
|
125
|
$mem{ $k } = (split /\s+/xms, $self->trim( $v ) )[0]; |
168
|
|
|
|
|
|
|
} |
169
|
1
|
|
|
|
|
73
|
return %mem; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub _parse_swap { |
173
|
1
|
|
|
1
|
|
3
|
my $self = shift; |
174
|
1
|
|
|
|
|
9
|
my @swaps = split /\n/xms, $self->slurp( proc->{swaps} ); |
175
|
1
|
|
|
|
|
208
|
my @swap_title = split /\s+/xms, shift @swaps; |
176
|
1
|
|
|
|
|
4
|
my @swap_list; |
177
|
1
|
|
|
|
|
5
|
foreach my $line ( @swaps ) { |
178
|
2
|
|
|
|
|
4
|
chomp $line; |
179
|
2
|
|
|
|
|
10
|
my @data = split /\s+/xms, $line; |
180
|
10
|
|
|
|
|
44
|
push @swap_list, |
181
|
|
|
|
|
|
|
{ |
182
|
2
|
|
|
|
|
10
|
map { $swap_title[$_] => $data[$_] } 0..$#swap_title |
183
|
|
|
|
|
|
|
}; |
184
|
|
|
|
|
|
|
} |
185
|
1
|
|
|
|
|
8
|
return @swap_list; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
sub _ip { |
189
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
190
|
0
|
|
|
|
|
0
|
my $cmd = q{/sbin/ifconfig}; |
191
|
0
|
0
|
0
|
|
|
0
|
return if ! -e $cmd || ! -x _; |
192
|
0
|
|
|
|
|
0
|
my $raw = qx($cmd); |
193
|
0
|
0
|
|
|
|
0
|
return if not $raw; |
194
|
0
|
|
|
|
|
0
|
my @raw = split /inet addr/xms, $raw; |
195
|
0
|
0
|
0
|
|
|
0
|
return if ! @raw || @raw < 2 || ! $raw[1]; |
|
|
|
0
|
|
|
|
|
196
|
0
|
0
|
|
|
|
0
|
if ( $raw[1] =~ m{(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})}xms ) { |
197
|
0
|
|
|
|
|
0
|
return $1; |
198
|
|
|
|
|
|
|
} |
199
|
0
|
|
|
|
|
0
|
return; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub _populate_osversion { |
203
|
7
|
|
|
7
|
|
17
|
my $self = shift; |
204
|
7
|
100
|
|
|
|
47
|
return $self if $self->{OSVERSION}; |
205
|
1
|
|
|
|
|
1186
|
require Sys::Info::Driver::Linux::OS::Distribution; |
206
|
1
|
|
|
|
|
19
|
my $distro = Sys::Info::Driver::Linux::OS::Distribution->new; |
207
|
1
|
|
|
|
|
4
|
my $osname = $distro->name; |
208
|
1
|
|
|
|
|
5
|
my $V = $distro->version; |
209
|
1
|
|
|
|
|
5
|
my $edition = $distro->edition; |
210
|
1
|
|
|
|
|
5
|
my $kernel = $distro->kernel; |
211
|
1
|
|
|
|
|
6
|
my $build = $distro->build; |
212
|
1
|
|
|
|
|
4
|
my $build_date = $distro->build_date; |
213
|
1
|
|
50
|
|
|
6
|
my $manufacturer = $distro->manufacturer || q{}; |
214
|
|
|
|
|
|
|
|
215
|
1
|
50
|
|
|
|
44
|
$self->{OSVERSION} = { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
216
|
|
|
|
|
|
|
NAME => $osname, |
217
|
|
|
|
|
|
|
NAME_EDITION => $edition ? "$osname ($edition)" : $osname, |
218
|
|
|
|
|
|
|
LONGNAME => q{}, # will be set below |
219
|
|
|
|
|
|
|
LONGNAME_EDITION => q{}, # will be set below |
220
|
|
|
|
|
|
|
VERSION => $V, |
221
|
|
|
|
|
|
|
KERNEL => $kernel, |
222
|
|
|
|
|
|
|
MANUFACTURER => $manufacturer, |
223
|
|
|
|
|
|
|
RAW => { |
224
|
|
|
|
|
|
|
BUILD => defined $build ? $build : 0, |
225
|
|
|
|
|
|
|
BUILD_DATE => defined $build_date ? $build_date : 0, |
226
|
|
|
|
|
|
|
EDITION => $edition, |
227
|
|
|
|
|
|
|
}, |
228
|
|
|
|
|
|
|
}; |
229
|
|
|
|
|
|
|
|
230
|
1
|
|
|
|
|
3
|
my $o = $self->{OSVERSION}; |
231
|
1
|
|
|
|
|
2
|
my $t = '%s %s (kernel: %s)'; |
232
|
1
|
|
|
|
|
7
|
$o->{LONGNAME} = sprintf $t, $o->{NAME}, $o->{VERSION}, $kernel; |
233
|
1
|
|
|
|
|
4
|
$o->{LONGNAME_EDITION} = sprintf $t, $o->{NAME_EDITION}, $o->{VERSION}, $kernel; |
234
|
1
|
|
|
|
|
19
|
return $self; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub _fs_attributes { |
238
|
1
|
|
|
1
|
|
3
|
my $self = shift; |
239
|
1
|
|
|
|
|
2
|
my $fs = shift; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
return { |
242
|
1
|
|
|
|
|
762
|
ext3 => { |
243
|
|
|
|
|
|
|
case_sensitive => 1, #'supports case-sensitive filenames', |
244
|
|
|
|
|
|
|
preserve_case => 1, #'preserves the case of filenames', |
245
|
|
|
|
|
|
|
unicode => 1, #'supports Unicode in filenames', |
246
|
|
|
|
|
|
|
#acl => '', #'preserves and enforces ACLs', |
247
|
|
|
|
|
|
|
#file_compression => '', #'supports file-based compression', |
248
|
|
|
|
|
|
|
#disk_quotas => '', #'supports disk quotas', |
249
|
|
|
|
|
|
|
#sparse => '', #'supports sparse files', |
250
|
|
|
|
|
|
|
#reparse => '', #'supports reparse points', |
251
|
|
|
|
|
|
|
#remote_storage => '', #'supports remote storage', |
252
|
|
|
|
|
|
|
#compressed_volume => '', #'is a compressed volume (e.g. DoubleSpace)', |
253
|
|
|
|
|
|
|
#object_identifiers => '', #'supports object identifiers', |
254
|
|
|
|
|
|
|
efs => '1', #'supports the Encrypted File System (EFS)', |
255
|
|
|
|
|
|
|
#max_file_length => ''; |
256
|
|
|
|
|
|
|
}, |
257
|
|
|
|
|
|
|
}->{$fs}; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
1; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
__END__ |