What is this? This is a QR Code: a machine-readable image-based code consisting of black and white squares. QR Codes are typically used for storing URLs and other information for reading by a smart devices like smart phones.
When scanned by an appropriate app on your mobile device, you are redirected to the embedded URL of this page. View this page with one device (desktop or another mobile device), and then scan the
QR Code with your mobile device. This makes it quicker and easier to browse a page discovered on one device on your mobile device without manually entering the URL in the mobile device browser address bar.
⚬ If you are using an Android phone, you can find a QR Code reading app at Google Play on your device.
⚬ If you are using an iOS device (iPhone, iPad, etc.), you can find a QR Code reading app at the Apple iTunes App Store on your device.
⚬ If you are using a Windows phone, you can find a QR Code reading app at the Microsoft Store on your device.
We provide this tool for FREE! However, we would greatly appreciate your support so we can continue to develop more tools (online tools and downloadable tools). You can show your support by sharing / liking this tool
on Facebook. You can also tweet this page to your Twitter followers and following us on Twitter.
The Server Snapshotter app (serversnapshotter.cgi) is a CGI-Perl script which checks your server configuration including: environmental variables, server setup including server specs / Perl / Sendmail version and paths, and installed
Perl modules. To install and run the app on your web server, your server needs to be a Unix or related server running Apache. Server must have Perl version 5.004+ installed, and the File::Find Apache module must be installed.
1. Copy the code below into a file called serversnapshotter.cgi. If your server uses the .pl extension for CGI-Perl scripts, rename as serversnapshotter.pl.
2. Edit path to Perl at top of script if it differs on your server. The 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.
3. FTP upload script to server in ASCII (text), and CHMOD as 755 (rwxr-xr-x).
serversnapshotter.cgi
#!/usr/bin/perl
#############################################################################
# Server Snapshotter Version 1.00201509041
# Copyright: 2017 Password Sentry. All Rights Reserved
# URL: https://www.password-sentry.com/server-snapshotter/
#############################################################################
#############################################################################
# Copyright Notice
#############################################################################
# Any redistribution of this script without the expressed written consent
# of Password Sentry 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 Password Sentry from any liability
# that might arise from its use.
#############################################################################
# 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).
# If your server uses the .pl extension for CGI-Perl scripts), rename as
# serversnapshotter.pl.
#############################################################################
# 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;
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;
}
}
sub body {
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time - 10800);
$year = ($year + 1900);
print <<HTML;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Server Snapshotter</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<style type="text/css">
a.link {
color: #000000;
font-family: Verdana, Helvetica, sans-serif;
font-size: 12px;
font-style: normal;
font-weight: bold;
text-decoration: none;
}
a.link:hover {
color: #000000;
font-family: Verdana, Helvetica, sans-serif;
font-size: 12px;
font-style: normal;
font-weight: bold;
text-decoration: underline;
}
.main_box {
background: rgba(227,162,11,0.5);
border: 1px solid #FFFF00;
border-radius: 30px;
box-shadow: #B3B3B3 15px 15px 15px;
height: 720px;
margin-left: auto;
margin-right: auto;
width: 78%;
-webkit-border-radius: 30px;
-moz-border-radius: 30px;
-webkit-box-shadow: #B3B3B3 15px 15px 15px;
-moz-box-shadow: #B3B3B3 15px 15px 15px;
}
.special {
color: #337147;
text-decoration: none;
font-weight: bold;
}
.special:hover {
color: #337147;
text-decoration: underline;
font-weight: bold;
}
.title_bar {
color: #FFF;
font-weight: bold;
margin: 10px;
padding: 10px;
text-align: center;
background: #f2825b;
background: -moz-linear-gradient(top, #f2825b 0%, #e55b2b 50%, #f07146 100%);
background: -webkit-gradient(linear, left top, left bottom, color-stop(0%,#f2825b),
color-stop(50%,#e55b2b), color-stop(100%,#f07146));
background: -webkit-linear-gradient(top, #f2825b 0%,#e55b2b 50%,#f07146 100%);
background: -o-linear-gradient(top, #f2825b 0%,#e55b2b 50%,#f07146 100%);
background: -ms-linear-gradient(top, #f2825b 0%,#e55b2b 50%,#f07146 100%);
background: linear-gradient(to bottom, #f2825b 0%,#e55b2b 50%,#f07146 100%);
filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#f2825b',
endColorstr='#f07146',GradientType=0 );
}
.errorbox {
background-color: #FFEBE8;
border: 1px solid #DD3C10;
color: #333333;
padding: 10px;
font-size: 13px;
font-weight: bold;
text-align: center;
width: 100%;
}
</style>
</head>
<body>
<div class="main_box">
<table align="center" width="90%" border="0">
<tr>
<td class="title_bar">Server Snapshotter</td>
</tr>
<tr>
<td>
<a class="special" href="?compile" target="targetwin">Show All</a> |
<a class="special" href="?compile&1" target="targetwin">Server Info</a> |
<a class="special" href="?compile&2" target="targetwin">User Environment Variables</a> |
<a class="special" href="?compile&3" target="targetwin">Perl Program</a> |
<a class="special" href="?compile&4" target="targetwin">Mail Program</a> |
<a class="special" href="?compile&5" target="targetwin">Server Environment Variables</a> |
<a class="special" href="?compile&6" target="targetwin">Perl Libraries</a> |
<a class="special" href="?compile&7" target="targetwin">Perl Modules</a>
<iframe style="background-color:#FFFFFF;" name="targetwin" src="?compile" width="100%" height="500" frameborder="0"></iframe>
</td>
</tr>
<tr>
<td colspan="2" align="center"><b>Copyright
<a class="link" href="https://www.password-sentry.com/server-snapshotter/">Password Sentry</a>.
All Rights Reserved.</b></td>
</tr>
</table>
</div>
</body>
</html>
HTML
}
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) : "<font color=\"red\">Unknown</font>");
$server{'SERVER_OS2'} = (`uname -r` ? `uname -r` : "<font color=\"red\">Unknown</font>");
$server{'SERVER_VER'} = (server('version') ? server('version') : "<font color=\"red\">Unknown</font>");
$server{'SERVER_CPU'} = (server('cpuinfo') ? server('cpuinfo') : "<font color=\"red\">Unknown</font>");
$server{'SERVER_MEM'} = (server('meminfo') ? server('meminfo') : "<font color=\"red\">Unknown</font>");
$server{'SERVER_UPT'} = (`uptime` ? `uptime` : "<font color=\"red\">Unknown</font>");
$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~ <tr>
<td width="30%" class="cellstyle3"><font class="fontstyle3">Server Disk Space</font></td>
<td width="70%" class="cellstyle4"><textarea rows="$num" cols="75">$num-$server{'SERVER_DSK'}</textarea></td>
</tr>~;
}
my $time = &get_time();
my $dir = `pwd`;
&bottom_header;
if (($subaction == 1) || ($subaction eq "all")) {
print <<HTML;
<table bgcolor="#7384BD" width="90%" cellpadding="0" cellspacing="0" border="0">
<tr>
<th>
<center>
<table bgcolor="#C0C0C0" width="100%" cellpadding="4" cellspacing="1" border="0">
<tr>
<th colspan="2" width="95%" class="cellstyle2"><font class="fontstyle2">Server Info</font>
<a class="specialw" href="#0"><sup>TOP</sup></a></th>
</tr>
<tr>
<td width="30%" class="cellstyle3"><font class="fontstyle3">Name</font></td>
<td width="70%" class="cellstyle4"><font class="fontstyle4">$ENV{"SERVER_NAME"}</font></td>
</tr>
<tr>
<td width="30%" class="cellstyle3"><font class="fontstyle3">IP Address</font></td>
<td width="70%" class="cellstyle4"><font class="fontstyle4">$ENV{"SERVER_ADDR"}</font></td>
</tr>
<tr>
<td width="30%" class="cellstyle3"><font class="fontstyle3">Server Software</font></td>
<td width="70%" class="cellstyle4"><font class="fontstyle4">$server{"SERVER_OS1"} $server{"SERVER_OS2"}<br/>
$server{"SERVER_VER"}</font></td>
</tr>
<tr>
<td width="30%" class="cellstyle3"><font class="fontstyle3">Server CPU</font></td>
<td width="70%" class="cellstyle4"><font class="fontstyle4">$server{"SERVER_CPU"}</font></td>
</tr>
<tr>
<td width="30%" class="cellstyle3"><font class="fontstyle3">Server Memory</font></td>
<td width="70%" class="cellstyle4"><font class="fontstyle4">$server{"SERVER_MEM"}</font></td>
</tr>
$server{'SERVER_DSK'}
<tr>
<td width="30%" class="cellstyle3"><font class="fontstyle3">Server Uptime / Load Average</font></td>
<td width="70%" class="cellstyle4"><font class="fontstyle4">$server{"SERVER_UPT"}</font></td>
</tr>
<tr>
<td width="30%" class="cellstyle3"><font class="fontstyle3">Current Server Local Time</font></td>
<td width="70%" class="cellstyle4"><font class="fontstyle4">$time</font></td>
</tr>
<tr>
<td width="30%" class="cellstyle3"><font class="fontstyle3">Current Working Directory Path</font></td>
<td width="70%" class="cellstyle4"><font class="fontstyle4">$dir</font></td>
</tr>
</table>
</center>
</th>
</tr>
</table><br/>
HTML
}
if (($subaction == 2) || ($subaction eq "all")) {
print <<HTML;
<table bgcolor="#7384BD" width="90%" cellpadding="0" cellspacing="0" border="0">
<tr>
<th>
<center>
<table bgcolor="#C0C0C0" width="100%" cellpadding="4" cellspacing="1" border="0">
<tr>
<th colspan="2" width="95%" class="cellstyle2"><font class="fontstyle2">User Environment Variables</font>
<a class="specialw" href="#0"><sup>TOP</sup></a></th>
</tr>
HTML
foreach (@usr) {
$ENV{$_} =~ s/<[\/a-z]+>//gi;
$ENV{$_} =~ s/\n//g;
$ENV{$_} = qq~<font color="red">Unknown</font>~ if ! $ENV{$_};
print qq~ <tr>\n~;
print qq~ <td width="30%" class="cellstyle3"><font class="fontstyle3">$_</font></td>\n~;
print qq~ <td width="70%" class="cellstyle4"><font class="fontstyle4">$ENV{$_}</font></td>\n~;
print qq~ </tr>\n~;
}
print <<HTML;
</table>
</center>
</th>
</tr>
</table><br/>
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 <<HTML;
<table bgcolor="#7384BD" width="90%" cellpadding="0" cellspacing="0" border="0">
<tr>
<th>
<center>
<table bgcolor="#C0C0C0" width="100%" cellpadding="4" cellspacing="1" border="0">
<tr>
<th colspan="2" width="100%" class="cellstyle2"><font class="fontstyle2">Perl Program</font>
<a class="specialw" href="#0"><sup>TOP</sup></a></th>
</tr>
<tr>
<th bgcolor="#FFFFFF">
<center>
<form action="">
<textarea rows="$num" cols="80">$textarea</textarea>
</form>
</center>
</th>
</tr>
</table>
</center>
</th>
</tr>
</table><br/>
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 <<HTML;
<table bgcolor="#7384BD" width="90%" cellpadding="0" cellspacing="0" border="0">
<tr>
<th>
<center>
<table bgcolor="#C0C0C0" width="100%" cellpadding="4" cellspacing="1" border="0">
<tr>
<th colspan="2" width="95%" class="cellstyle2"><font class="fontstyle2">Mail Program</font>
<a class="specialw" href="#0"><sup>TOP</sup></a></th>
</tr>
<tr>
<th bgcolor="#FFFFFF">
<center>
<form action="">
<textarea rows="$num" cols="80">$textarea</textarea>
</form>
</center>
</th>
</tr>
</table>
</center>
</th>
</tr>
</table><br/>
HTML
}
if (($subaction == 5) || ($subaction eq "all")) {
print <<HTML;
<table bgcolor="#7384BD" width="90%" cellpadding="0" cellspacing="0" border="0">
<tr>
<th>
<center>
<table bgcolor="#C0C0C0" width="100%" cellpadding="4" cellspacing="1" border="0">
<tr>
<th colspan="2" width="95%" class="cellstyle2"><font class="fontstyle2">Server Environment Variables</font>
<a class="specialw" href="#0"><sup>TOP</sup></a></th>
</tr>
HTML
foreach (@svr) {
$ENV{$_} =~ s/<[\/a-z]+>//gi;
$ENV{$_} =~ s/\n//g;
$ENV{$_} = qq~<font color="red">Unknown</font>~ if ! $ENV{$_};
print qq~ <tr>\n~;
print qq~ <td width="30%" class="cellstyle3"><font class="fontstyle3">$_</font></td>\n~;
print qq~ <td width="70%" class="cellstyle4"><font class="fontstyle4">$ENV{$_}</font></td>\n~;
print qq~ </tr>\n~;
}
print <<HTML;
</table>
</center>
</th>
</tr>
</table><br/>
HTML
}
if (($subaction == 6) || ($subaction eq "all")) {
my $libraries;
eval { require CGI };
if ($@) { $libraries .= " <font color=\"red\">Library CGI not installed</font><br/>\n"; }
else { $libraries .= " <font color=\"green\">Library CGI v$CGI::VERSION installed</font><br/>\n"; }
eval { require DBI };
if ($@) { $libraries .= " <font color=\"red\">Library DBI not installed</font><br/>\n"; }
else { $libraries .= " <font color=\"green\">Library DBI v$DBI::VERSION installed</font><br/>\n"; }
eval { require LWP };
if ($@) { $libraries .= " <font color=\"red\">Library LWP not installed</font><br/>\n"; }
else { $libraries .= " <font color=\"green\">Library LWP v$LWP::VERSION installed</font><br/>\n"; }
eval { require LWP::Simple };
if ($@) { $libraries .= " <font color=\"red\">Library LWP::Simple not installed</font><br/>\n"; }
else { $libraries .= " <font color=\"green\">Library LWP::Simple v$LWP::Simple::VERSION installed</font><br/>\n"; }
eval { require LWP::UserAgent };
if ($@) { $libraries .= " <font color=\"red\">Library LWP::UserAgent not installed</font><br/>\n"; }
else { $libraries .= " <font color=\"green\">Library LWP::UserAgent v$LWP::VERSION installed</font><br/>\n"; }
eval { require mod_perl };
if ($@) { $libraries .= " <font color=\"red\">Library mod_perl not installed</font><br/>\n"; }
else { $libraries .= " <font color=\"green\">Library mod_perl v$mod_perl::VERSION installed</font><br/>\n"; }
print <<HTML;
<table bgcolor="#7384BD" width="90%" cellpadding="0" cellspacing="0" border="0">
<tr>
<th>
<center>
<table bgcolor="#C0C0C0" width="100%" cellpadding="4" cellspacing="1" border="0">
<tr>
<th colspan="2" width="95%" class="cellstyle2"><font class="fontstyle2">Perl Libraries</font>
<a class="specialw" href="#0"><sup>TOP</sup></a></th>
</tr>
<tr>
<td bgcolor="#FFFFFF">
$libraries
</td>
</tr>
</table>
</center>
</th>
</tr>
</table><br/>
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 <<HTML;
<table bgcolor="#7384BD" width="90%" cellpadding="0" cellspacing="0" border="0">
<tr>
<th>
<center>
<table bgcolor="#C0C0C0" width="100%" cellpadding="4" cellspacing="1" border="0">
<tr>
<th colspan="2" width="95%" class="cellstyle2"><font class="fontstyle2">Perl Modules[$num]</font>
<a class="specialw" href="#0"><sup>TOP</sup></a></th>
</tr>
<tr>
<td width="50%" bgcolor="#FFFFFF">
HTML
my $index;
for ($index = 0; $index < ($num / 2); $index++) {
print qq~ <a class="special" href="http://search.cpan.org/search?module=$list[$index]">\n~;
print qq~ ~;
print ($index + 1);
print qq~. $list[$index]</a><br/>\n~;
}
print <<HTML;
</td>
<td width="50%" bgcolor="#FFFFFF">
HTML
my $index;
for ($index = (int($num / 2) + 1); $index < $num; $index++) {
print qq~ <a class="special" href="http://search.cpan.org/search?module=$list[$index]">\n~;
print qq~ ~;
print ($index + 1);
print qq~. $list[$index]</a><br/>\n~;
}
print <<HTML;
</td>
</tr>
</table>
</center>
</th>
</tr>
</table>
HTML
}
print <<HTML;
</center>
</body>
</html>
HTML
}
sub bottom_header {
print <<HTML;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Server Snapshotter</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<style type="text/css">
body {
background: rgba(227,162,11,0.5);
}
.cellstyle2 {
background-color: orange;
}
.cellstyle3 {
background-color: #EFEFEF;
}
.cellstyle4 {
background-color: #FFFFFF;
}
.fontstyle2 {
color: #000000;
font-family: Verdana, Arial, Helvetica, sans-serif;
font-size: 12px;
}
.fontstyle3 {
color: #000000;
font-family: Verdana, Arial, Helvetica, sans-serif;
font-size: 10px;
}
.fontstyle4 {
color: #000000;
font-family: Verdana, Arial, Helvetica, sans-serif;
font-size: 10px;
}
.link {
color: orange;
font-family: arial, helvetica, sans-serif;
font-weight: bold;
font-size: 10px;
text-decoration: none;
}
.link:hover {
color: orange;
font-family: arial, helvetica, sans-serif;
font-weight: bold;
font-size: 10px;
text-decoration: underline;
}
.special {
color: orange;
text-decoration: none;
}
.special:hover {
color: orange;
text-decoration: underline;
}
.specialw {
color: #FFFFFF;
text-decoration: none;
}
.specialw:hover {
color: #FFFFFF;
text-decoration: underline;
}
</style>
</head>
<body bgcolor="#E5E5E5" text="#000080">
<center>
HTML
}
sub server {
my ($parameter) = @_;
open(S, "</proc/$parameter");
$parameter = join("<br/>", <S>);
close(S);
return $parameter;
}
sub compile_modules {
/^.*\.pm$/ && /$ARGV[1]/i && push @mod, $File::Find::name;
}
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]";
}
