forum/hostinfo

   1 #!/usr/bin/perl
   2 use Cwd;
   3 use strict;
   4 use CGI;
   5 use CGI::Carp qw(fatalsToBrowser);
   6
   7 #
   8 # List of modules, required direcrty by your application
   9 #
  10 my @modules=qw(MIME::Lite Image::Size HTML::TreeBuilder
  11 POSIX Storable Fcntl Date::Parse
  12 LWP::UserAgent Net::OpenID::Consumer Email::Valid);
  13
  14 #
  15 # This array have to be filled manually by looking into Makefile.PL:
  16 # of neccessary CPAN modules and copying contents of PREREQ_PM argument
  17 # of it. Of course, recursively.
  18 #
  19 my %prereq=(
  20         "Net::OpenID::Consumer" => {
  21                    'LWP::UserAgent' => 0,
  22                    'HTTP::Request'  => 0,
  23                    'MIME::Base64'   => 0,
  24                    'Digest::SHA1'   => 0,
  25                    'URI'            => 0,
  26                    'Time::Local'    => 0,
  27                    'URI::Fetch'     => 0.02,
  28                    'Crypt::DH'      => 0.05,
  29                 },
  30          "HTML::TreeBuilder" => {
  31                 "HTML::Parser" => 2.19,
  32                 'HTML::Tagset' => 3.02,
  33           },
  34         'URI::Fetch' => {
  35                         'Class::ErrorHandler' =>0,
  36                         'LWP'=>0,
  37                         'URI'=>0,
  38                         'Storable'=>0,
  39         },
  40         'URI::URL' => {
  41                 'URI::Escape' => 0,
  42         },
  43         'URI' => {
  44                 'MIME::Base64' => 2,
  45                 },
  46         'Crypt::DH' => {
  47                 'Math::BigInt' =>0,
  48         },
  49         'Email::Valid'=> {
  50                 "Mail::Address"=>0,
  51                 'File::Spec'=>0,
  52                 'IO::File'=>0,
  53                 'Carp'=>0,
  54         }
  55         );
  56 my %modver;
  57
  58 my $cgi= new CGI;
  59 print $cgi->header(-type=>'text/html',-charset=>'windows-1251'),
  60         $cgi->start_html(-title=>'Hosting information');
  61
  62 print $cgi->h1("Hosting information");
  63 print $cgi->h2("Perl information");
  64 print "Perl version:",$cgi->escapeHTML($]),"<br>\n";
  65 print "\@INC:",$cgi->escapeHTML(join(" ",@INC)),"<br>\n";
  66 print "CGI.pm version: $CGI::VERSION<br>";
  67 print $cgi->h2("Required modules");
  68 my ($module,$ver);
  69 for $module (@modules) {
  70         if (exists $modver{$module}) {
  71                 $ver = $modver{$module}
  72         } else {
  73                 eval "use $module; \$ver=\$${module}::VERSION;";
  74                 if ($@) {
  75                         print "$module : <font color=\"red\">not found</font><br>";
  76                         if (exists $prereq{$module}) {
  77                                 scan_prereq($module);
  78                         }
  79                         next;
  80                 }
  81                 $modver{$module} = $ver;
  82         }
  83         print "$module: $ver<br>";
  84 }
  85
  86 print $cgi->h2("Execution environment"),"\n";
  87
  88 print "Script execution directory: <tt>",getcwd,"</tt><br>\n";
  89 print "Invoking user id ",$(+0," name(getpwuid) <tt>".(getpwuid($())[0]."</tt><br>\n";
  90 print "User home directory (getpwuid): <tt>".(getpwuid($())[7]."</tt><br>\n";
  91 print "User home directory(environment): <tt>",$ENV{'HOME'},"</tt><br>\n";
  92 print "Script name (\$0): <tt>$0</tt><br>\n";
  93 print "Script filename (from <b>SCRIPT_FILENAME</b> env var)
  94 <tt>$ENV{'SCRIPT_FILENAME'}</tt.<br>\n";
  95 print "Document root: <tt>$ENV{'DOCUMENT_ROOT'}</tt><br>\n";
  96 print "<b>LANG</b>: <tt>$ENV{LANG}</tt><br>\n";
  97 print "<b>SERVER_ADDR</b>: <tt>$ENV{SERVER_ADDR}</tt><br>\n";
  98 print "<b>PATH</b>: $ENV{'PATH'}<br>\n";
  99 eval {
 100  use POSIX;
 101  my ($sysname, $nodename, $release, $version, $machine) = POSIX::uname();
 102  print "System: $sysname $release $version (from POSIX::uname)<br>\n";
 103 };
 104 if ($@) {
 105         print "System: `uname -a` (from OS uname command)<br>\n";
 106 }
 107 sub scan_prereq {
 108         my $module = shift;
 109         print "<br><b>Prerequistes for $module</b>:<br><blockquote>\n";
 110         my $ver;
 111         MODULE:
 112         while (my ($mod,$needed_ver) = each %{$prereq{$module}}) {
 113                 if (exists $modver{$module}) {
 114                         $ver = $modver{$module};
 115                 } else {
 116                         eval "use $mod; \$ver=\$${mod}::VERSION;";
 117                         if ($@) {
 118                                 print "$mod : <font color=\"red\">not found</font><br>";
 119                                 if (exists $prereq{$mod}) {
 120                                         scan_prereq($mod);
 121                                 }
 122                                 next MODULE;
 123                         }
 124                         $modver{$mod} = $ver;
 125                 }
 126                 if ($ver < $needed_ver) {
 127                         print "$mod: <font color=\"red\">$ver</font> (need $needed_ver<br>\n";
 128                 } else {
 129                         print "$mod: $ver<br>\n";
 130                 }
 131         }
 132         print "</blockquote>\n";
 133 }
 134