1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use Data::Dumper;
sub getWorkDir {
my $currDir = `pwd`;
chomp($currDir);
my $scriptFile = $0;
$scriptFile = $ENV{SCRIPT_FILENAME} if exists $ENV{SCRIPT_FILENAME};
(my $scriptDir = $scriptFile) =~ s/\/[^\/]+$//;
my $destDir = ($scriptDir =~ /^\//) ? $scriptDir : $currDir . '/' . $scriptDir;
chdir "$destDir/../" or die "Cannot change into workdir '$destDir/../': $!\n";
my $workDir = `pwd`;
chomp($workDir);
return $workDir;
}
BEGIN {
my $workDir = &getWorkDir();
$ENV{workdir} = $workDir;
unshift @INC, $ENV{workdir} . '/modules';
}
$| = 1;
my $workDir = &getWorkDir();
$ENV{workdir} = $workDir;
unshift @INC, $ENV{workdir} . '/modules';
our $conf; *conf = \$HaCi::Conf::conf;
eval {
require HaCi::Conf;
&HaCi::Conf::init($workDir);
};
my $q = new CGI(@_);
my $title = 'HaCi - IP Address Administration';
my $ver = $conf->{static}->{gui}->{version} || '[unknown]';
my @mands = qw/CGI CGI::Ajax CGI::Carp CGI::Cookie CGI::Session Class::Accessor Class::MakeMethods Config::General DBD::mysql Digest::MD5 Digest::SHA Encode Encode::Guess File::Temp HTML::Entities Locale::gettext Log::LogLite Math::Base85 Math::BigInt%1.87 Net::CIDR Net::IMAP::Simple Net::IPv6Addr Net::SNMP Storable Template Time::Local Text::CSV/;
my @opts = qw/Cache::FastMmap Cache::FileCache DNS::ZoneParse IO::Socket::INET6 Math::BigInt::GMP Net::DNS Net::Nslookup Net::Ping Pod::WSDL SOAP::Transport::HTTP SQL::Translator%0.09000 SQL::Translator::Diff Text::CSV_XS Apache::DBI DBD::Pg DBD::mysql Frontier::RPC2 File::Basename Time::HiRes JSON URI::Query Text::CSV_XS/;
print $q->header(-charset=>'UTF-8');
print $q->start_html({
title => $title
});
print $q->h1($title);
print $q->h2("Version: " . $ver . (($ENV{MOD_PERL}) ? ' (running under mod-perl)' : ''));
print $q->h6($ENV{SERVER_SOFTWARE});
eval {
require HaCi::Utils;
&HaCi::Utils::getConfig();
my $dbError = &checkDB();
my $dbHost = $conf->{user}->{db}->{dbhost} || '';
my $dbName = $conf->{user}->{db}->{dbname} || '';
my $dbUser = $conf->{user}->{db}->{dbuser} || '';
print $q->br, $q->h3("Database connection ($dbUser\@$dbHost:$dbName): <font color=#" . (($dbError eq 'OK') ? '00AA00' : 'AA0000') . ">$dbError</font>");
};
print $q->br, $q->h5("Canot test database connection:<br><pre>$@</pre>");
print $q->br, $q->h3("<u>Mandatory Modules:</u>");
print $q->start_table({cellpadding=>3, rules=>'all'});
foreach (sort @mands) {
s/%/ /g;
eval "use $_";
warn $@ if $@;
print $q->Tr($q->th({align=>'left'}, $_), $q->td({bgcolor=>(($@) ? '#FFAAAA' : '#AAFFAA')}, (($@) ? 'NOT' : '') . ' available'));
}
print $q->end_table;
print $q->start_table({cellpadding=>3, rules=>'all'});
print $q->br, $q->h3("<u>Recommended Modules:</u>");
foreach (sort @opts) {
s/%/ /g;
eval "use $_";
warn $@ if $@;
print $q->Tr($q->th({align=>'left'}, $_), $q->td({bgcolor=>(($@) ? '#FFAAAA' : '#AAFFAA')}, (($@) ? 'NOT' : '') . ' available'));
}
exit 0;
#-----------------------------------
sub checkDB {
my $dbType = &HaCi::Utils::getConfigValue('db', 'dbtype');
eval {
require "HaCi/Tables/$dbType/network.pm";
};
return "Error while loading Table 'network': $@\n" if $@;
$DBIEasy::lastError = '';
my $tableRef = "HaCi::Tables::${dbType}::network"->new($conf->{user}->{db});
return $DBIEasy::lastError if $DBIEasy::lastError;
my $dbh = $tableRef->dbh();
if (ref($dbh) && $dbh->can('ping') && $dbh->ping()) {
return 'OK';
} else {
return $dbh->errstr;
}
return 'OK';
}
# vim:ts=4:sw=4
|
