1# --
2# Copyright (C) 2001-2020 OTRS AG, https://otrs.com/
3# --
4# This software comes with ABSOLUTELY NO WARRANTY. For details, see
5# the enclosed file COPYING for license information (GPL). If you
6# did not receive this file, see https://www.gnu.org/licenses/gpl-3.0.txt.
7# --
8
9package Kernel::System::Environment;
10
11use strict;
12use warnings;
13
14use POSIX;
15use ExtUtils::MakeMaker;
16use Sys::Hostname::Long;
17
18our @ObjectDependencies = (
19    'Kernel::Config',
20    'Kernel::System::DB',
21    'Kernel::System::Main',
22);
23
24=head1 NAME
25
26Kernel::System::Environment - collect environment info
27
28=head1 DESCRIPTION
29
30Functions to collect environment info
31
32=head1 PUBLIC INTERFACE
33
34=head2 new()
35
36create environment object. Do not use it directly, instead use:
37
38    my $EnvironmentObject = $Kernel::OM->Get('Kernel::System::Environment');
39
40=cut
41
42sub new {
43    my ( $Type, %Param ) = @_;
44
45    # allocate new hash for object
46    my $Self = {};
47    bless( $Self, $Type );
48
49    return $Self;
50}
51
52=head2 OSInfoGet()
53
54collect operating system information
55
56    my %OSInfo = $EnvironmentObject->OSInfoGet();
57
58returns:
59
60    %OSInfo = (
61        Distribution => "debian",
62        Hostname     => "servername.example.com",
63        OS           => "Linux",
64        OSName       => "debian 7.1",
65        Path         => "/home/otrs/bin:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games",
66        POSIX        => [
67                        "Linux",
68                        "servername",
69                        "3.2.0-4-686-pae",
70                        "#1 SMP Debian 3.2.46-1",
71                        "i686",
72                      ],
73        User         => "otrs",
74    );
75
76=cut
77
78sub OSInfoGet {
79    my ( $Self, %Param ) = @_;
80
81    my @Data = POSIX::uname();
82
83    # get main object
84    my $MainObject = $Kernel::OM->Get('Kernel::System::Main');
85
86    my %OSMap = (
87        linux   => 'Linux',
88        freebsd => 'FreeBSD',
89        openbsd => 'OpenBSD',
90        darwin  => 'MacOSX',
91    );
92
93    # If used OS is a linux system
94    my $OSName;
95    my $Distribution;
96    if ( $^O =~ /(linux|unix|netbsd)/i ) {
97
98        if ( $^O eq 'linux' ) {
99
100            $MainObject->Require('Linux::Distribution');
101
102            my $DistributionName = Linux::Distribution::distribution_name();
103
104            $Distribution = $DistributionName || 'unknown';
105
106            if ($DistributionName) {
107
108                my $DistributionVersion = Linux::Distribution::distribution_version() || '';
109
110                $OSName = $DistributionName . ' ' . $DistributionVersion;
111            }
112        }
113        elsif ( -e "/etc/issue" ) {
114
115            my $Content = $MainObject->FileRead(
116                Location => '/etc/issue',
117                Result   => 'ARRAY',
118            );
119
120            if ($Content) {
121                $OSName = $Content->[0];
122            }
123        }
124    }
125    elsif ( $^O eq 'darwin' ) {
126
127        my $MacVersion = `sw_vers -productVersion` || '';
128        chomp $MacVersion;
129
130        $OSName = 'MacOSX ' . $MacVersion;
131    }
132    elsif ( $^O eq 'freebsd' || $^O eq 'openbsd' ) {
133
134        my $BSDVersion = `uname -r` || '';
135        chomp $BSDVersion;
136
137        $OSName = "$OSMap{$^O} $BSDVersion";
138    }
139
140    # collect OS data
141    my %EnvOS = (
142        Hostname     => hostname_long(),
143        OSName       => $OSName || 'Unknown version',
144        Distribution => $Distribution,
145        User         => $ENV{USER} || $ENV{USERNAME},
146        Path         => $ENV{PATH},
147        HostType     => $ENV{HOSTTYPE},
148        LcCtype      => $ENV{LC_CTYPE},
149        Cpu          => $ENV{CPU},
150        MachType     => $ENV{MACHTYPE},
151        POSIX        => \@Data,
152        OS           => $OSMap{$^O} || $^O,
153    );
154
155    return %EnvOS;
156}
157
158=head2 ModuleVersionGet()
159
160Return the version of an installed perl module:
161
162    my $Version = $EnvironmentObject->ModuleVersionGet(
163        Module => 'MIME::Parser',
164    );
165
166returns
167
168    $Version = '5.503';
169
170or undef if the module is not installed.
171
172=cut
173
174sub ModuleVersionGet {
175    my ( $Self, %Param ) = @_;
176
177    my $File = "$Param{Module}.pm";
178    $File =~ s{::}{/}g;
179
180    # traverse @INC to see if the current module is installed in
181    # one of these locations
182    my $Path;
183    PATH:
184    for my $Dir (@INC) {
185
186        my $PossibleLocation = File::Spec->catfile( $Dir, $File );
187
188        next PATH if !-r $PossibleLocation;
189
190        $Path = $PossibleLocation;
191
192        last PATH;
193    }
194
195    # if we have no $Path the module is not installed
196    return if !$Path;
197
198    # determine version number by means of ExtUtils::MakeMaker
199    return MM->parse_version($Path);
200}
201
202=head2 PerlInfoGet()
203
204collect perl information:
205
206    my %PerlInfo = $EnvironmentObject->PerlInfoGet();
207
208you can also specify options:
209
210    my %PerlInfo = $EnvironmentObject->PerlInfoGet(
211        BundledModules => 1,
212    );
213
214returns:
215
216    %PerlInfo = (
217        PerlVersion   => "5.14.2",
218
219    # if you specified 'BundledModules => 1' you'll also get this:
220
221        Modules => {
222            "Algorithm::Diff"  => "1.30",
223            "Apache::DBI"      => 1.62,
224            ......
225        },
226    );
227
228=cut
229
230sub PerlInfoGet {
231    my ( $Self, %Param ) = @_;
232
233    # collect perl data
234    my %EnvPerl = (
235        PerlVersion => sprintf "%vd",
236        $^V,
237    );
238
239    my %Modules;
240    if ( $Param{BundledModules} ) {
241
242        for my $Module (
243            qw(
244            parent
245            Algorithm::Diff
246            Apache::DBI
247            CGI
248            Class::Inspector
249            Crypt::PasswdMD5
250            Crypt::Random::Source
251            CSS::Minifier
252            Email::Valid
253            Encode::Locale
254            Exporter::Tiny
255            IO::Interactive
256            JavaScript::Minifier
257            JSON
258            JSON::PP
259            Linux::Distribution
260            Locale::Codes
261            LWP
262            Mail::Address
263            Mail::Internet
264            Math::Random::ISAAC
265            Math::Random::Secure
266            MIME::Tools
267            Module::Find
268            Module::Refresh
269            Moo
270            Mozilla::CA
271            Net::IMAP::Simple
272            Net::HTTP
273            Net::SSLGlue
274            PDF::API2
275            SOAP::Lite
276            Sys::Hostname::Long
277            Text::CSV
278            Text::Diff
279            Types::TypeTiny
280            YAML
281            URI
282            namespace::clean
283            )
284            )
285        {
286            $Modules{$Module} = $Self->ModuleVersionGet( Module => $Module );
287        }
288    }
289
290    # add modules list
291    if (%Modules) {
292        $EnvPerl{Modules} = \%Modules;
293    }
294
295    return %EnvPerl;
296}
297
298=head2 DBInfoGet()
299
300collect database information
301
302    my %DBInfo = $EnvironmentObject->DBInfoGet();
303
304returns
305
306    %DBInfo = (
307        Database => "otrsproduction",
308        Host     => "dbserver.example.com",
309        User     => "otrsuser",
310        Type     => "mysql",
311        Version  => "MySQL 5.5.31-0+wheezy1",
312    )
313
314=cut
315
316sub DBInfoGet {
317    my ( $Self, %Param ) = @_;
318
319    # get needed objects
320    my $ConfigObject = $Kernel::OM->Get('Kernel::Config');
321    my $DBObject     = $Kernel::OM->Get('Kernel::System::DB');
322
323    # collect DB data
324    my %EnvDB = (
325        Host     => $ConfigObject->Get('DatabaseHost'),
326        Database => $ConfigObject->Get('Database'),
327        User     => $ConfigObject->Get('DatabaseUser'),
328        Type     => $ConfigObject->Get('Database::Type') || $DBObject->{'DB::Type'},
329        Version  => $DBObject->Version(),
330    );
331
332    return %EnvDB;
333}
334
335=head2 OTRSInfoGet()
336
337collect OTRS information
338
339    my %OTRSInfo = $EnvironmentObject->OTRSInfoGet();
340
341returns:
342
343    %OTRSInfo = (
344        Product         => "OTRS",
345        Version         => "3.3.1",
346        DefaultLanguage => "en",
347        Home            => "/opt/otrs",
348        Host            => "prod.otrs.com",
349        SystemID        => 70,
350    );
351
352=cut
353
354sub OTRSInfoGet {
355    my ( $Self, %Param ) = @_;
356
357    # get config object
358    my $ConfigObject = $Kernel::OM->Get('Kernel::Config');
359
360    # collect OTRS data
361    my %EnvOTRS = (
362        Version         => $ConfigObject->Get('Version'),
363        Home            => $ConfigObject->Get('Home'),
364        Host            => $ConfigObject->Get('FQDN'),
365        Product         => $ConfigObject->Get('Product'),
366        SystemID        => $ConfigObject->Get('SystemID'),
367        DefaultLanguage => $ConfigObject->Get('DefaultLanguage'),
368    );
369
370    return %EnvOTRS;
371}
372
3731;
374
375=head1 TERMS AND CONDITIONS
376
377This software is part of the OTRS project (L<https://otrs.org/>).
378
379This software comes with ABSOLUTELY NO WARRANTY. For details, see
380the enclosed file COPYING for license information (GPL). If you
381did not receive this file, see L<https://www.gnu.org/licenses/gpl-3.0.txt>.
382
383=cut
384