#!/usr/bin/perl ########################################################################## # ServerCheck Version 2.10 # # # Created: May 01, 1999 # Updated: Mar 08, 2008 # Copyright: 1999 - 2009 Virtual Solutions. All Rights Reserved # # URL: http://www.monster-submit.com/servercheck/ ########################################################################## ########################################################################## # Copyright Notice ########################################################################## # Any redistribution of this script without the expressed written consent # of Virtual Solutions is strictly prohibited. Copying any of the code # contained within this script and claiming it as your own is also # prohibited. You may not remove any of these header notices. By using # this code you agree to indemnify Virtual Solutions from any liability # that might arise from its use. # If this URL is not properly defined on your server, then edit this variable # as the URL pointing to the servercheck.cgi script. my $script_url = "http://$ENV{'HTTP_HOST'}$ENV{'SCRIPT_NAME'}"; ############################################################## # Installation ############################################################## # 1. Edit path to Perl at top of script if it differs on your server. Usual and # default path is [/usr/bin/perl]. However, on some servers it may be # /usr/local/bin/perl. If in doubt, then refer to a script on your server that # does work, or ask your web host. # 2. FTP upload script to server in ASCII (text), and CHMOD 755 (rwxr-xr-x). # Then, rename to servercheck.cgi (or servercheck.pl if your server uses # the .pl extension for CGI-Perl scripts). ############################################################## # Do NOT change or alter the code below! ############################################################## use strict; print "Content-type: text/html\n\n"; use vars qw ($action $subaction); eval { ($0 =~ m,(.*)/[^/]+,) && unshift(@INC, $1); require 5.004; }; if ($@) { print $@; exit; } my @mod; eval { &main; }; if ($@) { print $@; } exit; ############################################### # Main ############################################### sub main { ($action, $subaction) = split(/\&/, $ENV{'QUERY_STRING'}); $subaction = "all" if ! $subaction; CASE: { ($action eq "header") and do { &top_header; last CASE; }; ($action eq "compile") and do { &compile; last CASE; }; &body; } } ############################################### # Body ############################################### sub body { print < HTML } ############################################### # Compile ############################################### sub compile { my @usr = qw/REMOTE_ADDR REMOTE_HOST HTTP_USER_AGENT HTTP_ACCEPT_LANGUAGE HTTP_X_FORWARDED_FOR HTTP_VIA/; my @svr = qw/SERVER_SOFTWARE GATEWAY_INTERFACE DOCUMENT_ROOT SERVER_PROTOCOL SERVER_SIGNATURE PATH HTTP_CONNECTION REMOTE_PORT SERVER_ADDR SCRIPT_NAME SCRIPT_FILENAME SERVER_NAME HTTP_PRAGMA REQUEST_URI SERVER_PORT HTTP_HOST SERVER_ADMIN/; my %server; $server{'SERVER_OS1'} = (ucfirst($^O) ? ucfirst($^O) : "Unknown"); $server{'SERVER_OS2'} = (`uname -r` ? `uname -r` : "Unknown"); $server{'SERVER_VER'} = (server('version') ? server('version') : "Unknown"); $server{'SERVER_CPU'} = (server('cpuinfo') ? server('cpuinfo') : "Unknown"); $server{'SERVER_MEM'} = (server('meminfo') ? server('meminfo') : "Unknown"); $server{'SERVER_UPT'} = (`uptime` ? `uptime` : "Unknown"); $server{'SERVER_DSK'} = (`df` ? `df` : "Unknown"); if ($server{'SERVER_DSK'}) { my @lines = split(/\n/, $server{'SERVER_DSK'}); my $num = (@lines + 1); $server{'SERVER_DSK'} = qq~ Server Disk Space ~; } my $time = &get_time(); my $dir = `pwd`; &bottom_header; if (($subaction == 1) || ($subaction eq "all")) { print <
$server{'SERVER_DSK'}
Server Information TOP
Name $ENV{"SERVER_NAME"}
IP Address $ENV{"SERVER_ADDR"}
Server Software $server{"SERVER_OS1"} $server{"SERVER_OS2"}

$server{"SERVER_VER"}
Server CPU $server{"SERVER_CPU"}
Server Memory $server{"SERVER_MEM"}
Server Uptime / Load Average $server{"SERVER_UPT"}
Current Server Local Time $time
Current Working Directory Path $dir

HTML } if (($subaction == 2) || ($subaction eq "all")) { print <

HTML foreach (@usr) { $ENV{$_} =~ s/<[\/a-z]+>//gi; $ENV{$_} =~ s/\n//g; $ENV{$_} = qq~Unknown~ if ! $ENV{$_}; print qq~ \n~; print qq~ \n~; print qq~ \n~; print qq~ \n~; } print <
Remote User Environment Variables TOP
$_$ENV{$_}

HTML } if (($subaction == 3) || ($subaction eq "all")) { my $textarea = "Perl Version: $]\n"; $textarea .= join("\n", split(/\s+/, qx/whereis perl/)); my @lines = split(/\n/, $textarea); my $num = (@lines + 1); print <

Perl Program TOP

HTML } if (($subaction == 4) || ($subaction eq "all")) { my $textarea .= join("\n", split(/\s+/, qx/whereis sendmail/)); my @lines = split(/\n/, $textarea); my $num = (@lines + 1); print <

Mail Program TOP

HTML } if (($subaction == 5) || ($subaction eq "all")) { print <

HTML foreach (@svr) { $ENV{$_} =~ s/<[\/a-z]+>//gi; $ENV{$_} =~ s/\n//g; $ENV{$_} = qq~Unknown~ if ! $ENV{$_}; print qq~ \n~; print qq~ \n~; print qq~ \n~; print qq~ \n~; } print <
Server Environment Variables TOP
$_$ENV{$_}

HTML } if (($subaction == 6) || ($subaction eq "all")) { my $libraries; eval { require CGI }; if ($@) { $libraries .= " Library CGI not installed
\n"; } else { $libraries .= " Library CGI v$CGI::VERSION installed
\n"; } eval { require DBI }; if ($@) { $libraries .= " Library DBI not installed
\n"; } else { $libraries .= " Library DBI v$DBI::VERSION installed
\n"; } eval { require LWP }; if ($@) { $libraries .= " Library LWP not installed
\n"; } else { $libraries .= " Library LWP v$LWP::VERSION installed
\n"; } eval { require LWP::Simple }; if ($@) { $libraries .= " Library LWP::Simple not installed
\n"; } else { $libraries .= " Library LWP::Simple v$LWP::Simple::VERSION installed
\n"; } eval { require LWP::UserAgent }; if ($@) { $libraries .= " Library LWP::UserAgent not installed
\n"; } else { $libraries .= " Library LWP::UserAgent v$LWP::VERSION installed
\n"; } eval { require mod_perl }; if ($@) { $libraries .= " Library mod_perl not installed
\n"; } else { $libraries .= " Library mod_perl v$mod_perl::VERSION installed
\n"; } print <

Installed Perl Libraries TOP
$libraries

HTML } if (($subaction == 7) || ($subaction eq "all")) { my @list; use File::Find; my (%done, $dir); find (\&compile_modules, grep { -r and -d } @INC); @mod = grep (! $done{$_}++, @mod); foreach $dir (sort { length $b <=> length $a } @INC) { foreach (@mod) { next if s,^\Q$dir,,; } } foreach (sort(@mod)) { s,^/(.*)\.pm$,$1,; s,/,::,g; push(@list, $_); } my $num = ($#mod + 1); print <

Installed Perl Modules[$num] TOP
HTML my $index; for ($index = 0; $index < ($num / 2); $index++) { print qq~ \n~; print qq~ ~; print ($index + 1); print qq~. $list[$index]
\n~; } print < 		HTML my $index; for ($index = (int($num / 2) + 1); $index < $num; $index++) { print qq~ \n~; print qq~ ~; print ($index + 1); print qq~. $list[$index]
\n~; } print <
HTML } print < HTML } ######################################################## # Top Header ######################################################## sub top_header { print < Virtual Solutions : ServerCheck
Powered by ServerCheck [Version 2.10] © Copyright 1999 - 2009 Virtual Solutions. All Rights Reserved.

Show All | Server Information | Remote User Environment Variables | Perl Program | Mail Program
Server Environment Variables | Installed Perl Libraries | Installed Perl Modules

HTML } ######################################################## # Bottom Header ######################################################## sub bottom_header { print < Virtual Solutions : ServerCheck
HTML } ######################################################## # Server ######################################################## sub server { my ($parameter) = @_; open(S, "", ); close(S); return $parameter; } ######################################################## # Compile Modules ######################################################## sub compile_modules { /^.*\.pm$/ && /$ARGV[1]/i && push @mod, $File::Find::name; } ############################################### # Get Time ############################################### sub get_time { my @tb = localtime(time); my $ap = "am"; $ap = "pm" if ($tb[2] >= 12); $tb[2] -= 12 if ($tb[2] > 12); $tb[4]++; for (0..4) { $tb[$_] = sprintf("%02d", $tb[$_]); } $tb[5] += 1900; return "$tb[2]:$tb[1]:$tb[0]$ap $tb[4]/$tb[3]/$tb[5]"; }