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