#!/usr/bin/perl ############################################################################### # serverinfo.cgi # ############################################################################### # # Server Info v 1.0 by BizDesign, Inc. # written by Greg Raaum, gregraaum@bizdesign.com # --------------------------------------------------------------------------- # PROGRAM NAME : Server Info # VERSION : 1.1 # LAST MODIFIED : 9/05/2001 # =========================================================================== # COPYRIGHT NOTICE : # # Copyright (c) 2000 BizDesign, Inc. All Rights Reserved. # Selling the code for this program without prior written consent is # expressly forbidden. # # Obtain written permission before redistributing this software over the # Internet or in any other medium. In all cases copyright and header must # remain intact. # # Feel free to modify the code of this program to suit your likings. # # Although this program has been thoroughly tested on BizDesign's servers, we # do not warrant that it works on all servers and will not be held liable # for anything, including but not limited to, misusage, error, or loss of data. # # Use at your own risk! ############################################################################### # INSTRUCTIONS : # # 1. Rename this file 'serverinfo.cgi' or 'serverinfo.pl' # 2. Set the path to Perl at the top of the script # 3. Place this file in a executable directory on your server # 4. Set permissions on this file to 755 (if applicable) # 5. Call from any Web browser ############################################################################### $| = 1; #flush output &get_info; &find_module; &print_html; exit; ############################################################################### # GET INFO # Gets some information about this server ############################################################################### sub get_info { $font = 'font face="Verdana,Arial,Helvetica" size=1'; $bigfont = 'font face="Verdana,Arial,Helvetica" size=2'; # let's get the current directory path if ($0=~m#^(.*)(\\|/)#) { $currdir = $1; } else { $currdir = `pwd`; chomp $currdir; } # determine the mail program $mail = "/usr/lib/sendmail"; $result = get_mail($mail); if (! $result) { $mail = "/usr/sbin/sendmail"; $result = get_mail($mail); if (!$result) { $mail = "/var/qmail/bin/qmail-inject"; $result = get_mail($mail); if (! $result) { $mail = "Mail Program Unknown"; } } } $perlversion = $]; # get the perl version $time=localtime; # get the time $perlloc = `whereis perl`; # get the perl location if (!$perlloc) { $perlloc = $^X; } else { $perlloc =~ s/perl: //g; $perlloc =~ s/ /
/g; } # get the environmental variables foreach $item (sort keys %ENV) { $legitem = uc $item; $legitem =~ s/_/ /g; if ($legitem eq "PATH") { $ENV{$item} =~ s/;/
\n/g; } if ($legitem eq "HTTP ACCEPT") { $ENV{$item} =~ s/, /
\n/g; } if ($legitem eq "PATHEXT") { $ENV{$item} =~ s/;/
\n/g; } $variables .= qq| <$font>| . $legitem . qq|: | . $ENV{$item} . qq| |; } } ############################################################################### # PRINT HTML # Displays the results ############################################################################### sub print_html { print qq|Content-type: text/html Server Info
$variables
<$bigfont color="#ffffff">Server Info
<$bigfont>Please Note...
<$bigfont>If you are using this program to configure paths for a Perl script configuration file, on a Windows server, you MUST substitute all instances of backslashes "\\" with forward slashes "/" in your paths. Failure to do so may result in Internal Server Errors.
<$bigfont>Miscellaneous Information...
<$font>SERVER TIME: $time
<$font>CURRENT DIRECTORY PATH: $currdir
<$font>PERL VERSION: $perlversion
<$font>PATH(S) TO PERL: $perlloc
<$font>PATH TO MAIL: $mail
<$bigfont>Installed CPAN Modules...
<$font>IMAGE::MAGICK: $im
<$font>COMPRESS::ZLIB: $cz
<$font>ARCHIVE::ZIP: $az
<$font>IMAGE::IPTCINFO: $ii
<$bigfont>Environmental Variables...

<$font>Copyright 2000 BizDesign, Inc. All rights reserved.
Send email to: gregraaum\@bizdesign.com

|; } ############################################################################### # FIND MAIL # helps to find the server mail program ############################################################################### sub get_mail { my $mailpath = shift (@_); if (-e "$mailpath") { return 1; } else { return 0; } } ######################################################## # Get Module ######################################################## sub get_module { /^.*\.pm$/ && /$ARGV[0]/i && push @mod, $File::Find::name; } ######################################################## # Find Module ######################################################## sub find_module { $curr_dir = `pwd`; use File::Find; find (\&get_module, 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 (@mod) { s,^/(.*)\.pm$,$1,; s,/,::,g; if ($_ =~ /Image::Magick/i){ $im = qq|Installed (Needed for Picture Post Mod and Batch Thumbnail Mod)|; } elsif ($_ =~ /Archive::Zip/i){ $az = qq|Installed (Needed for Lightbox Mod zipping and IFC downloads)|; } elsif ($_ =~ /Compress::ZLib/i){ $cz = qq|Installed (Needed for Lightbox Mod zipping and IFC downloads)|; } elsif ($_ =~ /Image::IPTCInfo/i){ $ii = qq|Installed (Needed for IPTC Mod)|; } } if (! $im) { $im = qq|NOT installed (Needed for Picture Post Mod and Batch Thumbnail Mod)|; } if (! $az) { $az = qq|NOT installed (Needed for Lightbox Mod zipping and IFC downloads)|; } if (! $cz) { $cz = qq|NOT installed (Needed for Lightbox Mod zipping and IFC downloads)|; } if (! $ii) { $ii = qq|NOT installed (Needed for IPTC Mod)|; } }