#!/usr/bin/perl -w # #*********************************************************************** # # PURPOSE: Freeware Perl script to display some server-side information # including environment variables and installed modules. # # DATE: 21 August, 2002 # VERSION: 0.2.1 # # LICENSE: # Copyright (C) Shashank Tripathi (shanx@shanx.com) # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. # #======================================================================= # # I N S T A L L A T I O N: #----------------------------------------------------------------------- # 1. Copy and paste all this text into a file, e.g., perldigger.cgi # 2. Upload this file into your CGI-BIN or an equivalent CGI directory. # 3. CHMOD the file to 755 so it can be executed. # 4. It is common for Perl to reside on most servers at "/usr/bin/perl" # but if it doesn't, please replace the first line of this program # with the appropriate path (e.g., "/usr/local/bin/perl"). # # That should be all. If you have any problems, please feel free to # write to me at shanx@shanx.com. # #*********************************************************************** use CGI qw(:standard); use CGI::Carp qw(fatalsToBrowser); print "Content-type: text/html\n\n"; # You can set the page title here $PAGE_TITLE = "PERL DIGGER °| Free CGI script to list environment information and installed Perl modules"; #----------------------------------------------------------------------- # NO NEED TO TOUCH ANYTHING BEYOND THIS POINT #========================= #Location of Perl $whereperl = join("
", split(/\s+/, qx/whereis perl/)); #Location of Sendmail $wheresendmail = join("
", split(/\s+/, qx/whereis sendmail/)); #Location of Current Directory $currentdirectory = `pwd`; # List of processes $processes = qx/ps aux/; $processes =~ s/
/\n/gi; $processes =~ s/
/\n\n/gi; $processes =~ s/<(?:[^>'"]*|(['"]).*?\1)*>//gs; #Perl Variables $perlversion = $]; $path_tar = join("
", split(/\s+/, qx/whereis tar/)); $path_gzip = join("
", split(/\s+/, qx/whereis gzip/)); $path_apache = join("
", split(/\s+/, qx/whereis apache/)); $path_httpd = join("
", split(/\s+/, qx/whereis httpd/)); $path_php = join("
", split(/\s+/, qx/whereis php/)); $path_mysql = join("
", split(/\s+/, qx/whereis mysql/)); $path_man = join("
", split(/\s+/, qx/whereis man/)); $path_perldoc = join("
", split(/\s+/, qx/whereis perldoc/)); #Perl Os $perlos = $^O; $perlos_version = get_server('version'); $perlos_version =~ s/#/
#/s; $perlos_version =~ s/\(/
(/s; $perlos_cpu = get_server_detail('cpuinfo'); $perlos_mem = get_server_detail('meminfo'); $perlos_mem =~ s/^.*?\n.*?\n.*?\n//s; $perlos_dsk = `df`; sub get_server { open PROC, "", ); close PROC; return $res ? $res : undef; } sub get_server_detail { open PROC, "); close PROC; return $res ? $res : undef; } #Module Paths foreach $line (@INC) { $modulepaths .= "$line
"; } #Environment Variables $environment = qq~ ~; $PAGE_FOOTER = "Powered by Get PERL DIGGER (it's free!)   |   Copyright © Shashank Tripathi "; @allkeys = keys(%ENV); foreach $key (@allkeys) { $value = $ENV{$key}; if ($value eq "") {$value = "-";} $environment .= qq~ ~; } $environment .= qq~
ENVIRONMENT VARIABLES ⇑
$key $value
~; $documentroot = $ENV{'DOCUMENT_ROOT'}; if ($documentroot ne "") { @lines = `du -c -k $documentroot`; $lastline = @lines-1; ($diskusage) = split/[\t| ]/,$lines[$lastline]; } #Server Software $serverip = $ENV{'SERVER_ADDR'}; $servername = $ENV{'SERVER_NAME'}; $serverport = $ENV{'SERVER_PORT'}; $serversoftware = $ENV{'SERVER_SOFTWARE'}; $serveruptime =`uptime`; #Localtime ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); @months = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"); $date = sprintf("%02d-%s-%04d",$mday,$months[$mon],$year+1900); $time = sprintf("%02d:%02d:%02d",$hour,$min,$sec); $localtime = "$date, $time"; #GMTtime ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time); @months = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"); $date = sprintf("%02d-%s-%04d",$mday,$months[$mon],$year+1900); $time = sprintf("%02d:%02d:%02d",$hour,$min,$sec); $gmttime = "$date, $time"; print qq~ $PAGE_TITLE

Perl Digger

Get Perl code here		 Perl Digger is a freeware Perl script to dig for information about the server-side environment including a list of all installed Perl modules with a handy link to their documentation at CPAN. This page is based on easy CSS so you can easily change the look if you wish.
PERL INFORMATION   |   SERVER INFORMATION   |   ENVIRONMENT VARIABLES   |   INSTALLED PERL MODULES


PERL INFORMATION ⇑
Perl version $perlversion
Perl $whereperl
Sendmail $wheresendmail


SERVER INFORMATION ⇑
Name $servername
IP $serverip
Listing Port $serverport
Document Root $documentroot
Disk Usage by Root $diskusage KB
Server stamp $serversoftware
Server Time (Local) $localtime
Server Time (GMT) $gmttime
Server Details

OPERATING SYSTEM:
$perlos_version

CPU UTILIZATION:

MEMORY UTILIZATION:

DISK UTILIZATION:
Module Paths $modulepaths
Path(s) to TAR $path_tar
Path(s) to GZIP $path_gzip
Path to APACHE/HTTPD $path_apache

$path_httpd
Path to PHP $path_php
Path to MYSQL $path_mysql
Path to MAN (Unix manual) $path_man
Path to PERLDOC $path_perldoc
Processes currently on the server


$environment
LIST OF ALL INSTALLED PERL MODULES ⇑
~; &vars; find(\&wanted,@INC); $modcount = 0; foreach $line(@foundmods) { $match = lc($line); if ($found{$line}[0] >0) {$found{$line} = [$found{$line}[0]+1,$match]} else {$found{$line} = ["1",$match];$modcount++} } @foundmods = sort count keys(%found); chomp @foundmods; sub count { return $found{$a}[1] cmp $found{$b}[1] } print "$modcount modules found
\n"; $third = $modcount/3; $count=0; $firstroundtotal = 0; foreach $mod(@foundmods) { $count++; if ($count <= $third) { $firstroundtotal++; print qq~ $firstroundtotal. $mod
~; } else { push (@mod1,$mod) } } $count = 0; print qq~ 		~; foreach $mod1(@mod1) { $count++; if ($count <= $third) { $firstroundtotal++; print qq~ $firstroundtotal. $mod1
~; } else { push (@mod2,$mod1) } } $count = 0; print qq~ 		~; foreach $mod2(@mod2) { $count++; $firstroundtotal++; print qq~ $firstroundtotal. $mod2
~; } sub vars {use File::Find;} sub wanted { $count = 0; if ($File::Find::name =~ /\.pm$/) { open(MODFILE,$File::Find::name) || return; while(){ if (/^ *package +(\S+);/){ push (@foundmods, $1); last; } } } } print qq~

 

⇑ $PAGE_FOOTER


~;