serverinfo.pl - DriveHQ Cloud IT/Storage service

Yes No
Do you want to visit DriveHQ English website?
serverinfo.pl - Hosted on DriveHQ Cloud IT Platform
返回上层目录
上传
下载
共享
发布
新建文件夹
新建文件
复制
剪切
删除
粘贴
评论
升级服务
路径: \\LITTLELEV\ImageFolioLite\main\serverinfo.pl
旋转
特效
属性
历史版本
###############################################################################
# BizDesign ImageFolio Lite Edition 4.2 (Four-dot-Two)
###############################################################################
#
#          ##          ###        VERSION       :  4.2
#        ####        ##   ##      RELEASED ON   :  02/15/2007
#      ##  ##              ##     LAST MODIFIED :  02/15/2007
#    ##########          ##       
#          ##   ###    ##         
#          ##   ###  ########     
#
###############################################################################
# Released by BizDesign, Inc.
# written by Dirk Koppers and Greg Raaum of BizDesign
#
# Purchasing :  http://imagefolio.com/purchase/
# Support    :  http://imagefolio.com/support/
# Phone      :  (214) 642-9787
# Email      :  sales@bizdesign.com
###############################################################################
# COPYRIGHT AND LICENSE INFORMATION :
#
# Copyright (c) 1999-2007 BizDesign, Inc. All rights reserved.
#
# Selling or distributing the code for this program without prior written
# consent is expressly forbidden.
#
# One licensed copy of the program may reside on a single server, in use by a
# single domain.  For each installed instance of the program, a separate
# license is required.
#
# Licensed users may alter or modify this software, at their own risk, of
# course.  They may also hire others to modify their own copy of the code, as
# long as the code is not transferred to or retained by the individual who is
# hired (unless he/she is also a license holder). Although license-holders
# may modify the code for their use, modified code may NOT be resold or
# distributed.
#
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
# FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL BIZDESIGN,
# INC. OR ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
# IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# BizDesign, Inc. is not liable for any conduct associated with image gallery
# activity, nor for any binary media posted using this program, including but
# not imited to images, photographs, movies, and clipart.
#
# The user must assume the entire risk of using the program.  Although this
# program has been thoroughly tested on BizDesign's servers, BizDesign does 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.  ANY
# LIABILITY OF THE SELLER WILL BE LIMITED EXCLUSIVELY TO PRODUCT REPLACEMENT
# OR REFUND OF PURCHASE PRICE.  Use at your own risk!
###############################################################################
# Do not modify below this line unless you know what you are doing.
###############################################################################
# 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; }
   $currdir =~ s/\\/\//ig;

   # 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/ /<br>/g; }

   # get the environmental variables
   foreach $item (sort keys %ENV) {
      $legitem = uc $item;
      $legitem =~ s/_/ /g;
      if ($legitem eq "PATH")        { $ENV{$item} =~ s/;/<br>\n/g;  }
      if ($legitem eq "HTTP ACCEPT") { $ENV{$item} =~ s/, /<br>\n/g; }
      if ($legitem eq "PATHEXT")     { $ENV{$item} =~ s/;/<br>\n/g;  }

      $variables .= qq|
      <tr><td align=right nowrap bgcolor="#eeeeee"><$font><b>| . $legitem . qq|:</b></font></td>
      <td bgcolor="#ffffff"><code>| . $ENV{$item} . qq|</code></td></tr>
      |;
   }
}

###############################################################################
# PRINT HTML
# Displays the results
###############################################################################
sub print_html {

print qq|Content-type: text/html

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title>Server Info</title>
</head>
<body bgcolor="#ffffff">
<center><table border=0 cellspacing=0 cellpadding=0 bgcolor="#00000" width=600><tr><td>
<table border=0 cellspacing=1 cellpadding=3 width="100%">
<tr><td colspan=2><$bigfont color="#ffffff"><b>Server Info</b></font></td></tr>
<tr bgcolor="#ffcc00"><td colspan=2><$bigfont><b>Please Note...</b></font></td></tr>

<tr bgcolor="#ffffff"><td colspan=2><$bigfont>If you are using this program to configure
paths for a Perl script configuration file, <b>on a Windows server</b>,
you MUST substitute all instances of backslashes "\\" with forward slashes "/" in your paths.
Failure to do so may result in Internal Server Errors.</font></td></tr>

<tr bgcolor="#ffcc00"><td colspan=2><$bigfont><b>Miscellaneous Information...</b></font></td></tr>
<tr><td align=right nowrap bgcolor="#eeeeee"><$font><b>SERVER TIME:</b></font></td>
  <td bgcolor="#ffffff"><code>$time</code></td></tr>
<tr><td align=right nowrap bgcolor="#eeeeee"><$font><b>CURRENT DIRECTORY PATH:</b></font></td>
  <td bgcolor="#ffffff"><code>$currdir</code></td></tr>
<tr><td align=right nowrap bgcolor="#eeeeee"><$font><b>PERL VERSION:</b></font></td>
  <td bgcolor="#ffffff"><code>$perlversion</code></td></tr>
<tr><td align=right nowrap bgcolor="#eeeeee"><$font><b>PATH(S) TO PERL:</b></font></td>
  <td bgcolor="#ffffff"><code>$perlloc</code></td></tr>
<tr><td align=right nowrap bgcolor="#eeeeee"><$font><b>PATH TO MAIL:</b></font></td>
  <td bgcolor="#ffffff"><code>$mail</code></td></tr>
<tr bgcolor="#ffcc00"><td colspan=2><$bigfont><b>Installed <a href="http://www.cpan.org/" target="_blank">CPAN</a> Modules...</b></font></td></tr>
<tr><td align=right nowrap bgcolor="#eeeeee"><$font><b>IMAGE::MAGICK:</b></font></td>
  <td bgcolor="#ffffff"><code>$im</code></td></tr>
<tr><td align=right nowrap bgcolor="#eeeeee"><$font><b>COMPRESS::ZLIB:</b></font></td>
  <td bgcolor="#ffffff"><code>$cz</code></td></tr>
<tr bgcolor="#ffcc00"><td colspan=2><$bigfont><b>Environmental Variables...</b></font></td></tr>
$variables</table></td></tr></table><br><$font>Copyright 2000 BizDesign, Inc.  All rights reserved.<br>
Send email to: <a href="mailto:gregraaum\@bizdesign.com">gregraaum\@bizdesign.com</a><br><br></center>
</body>
</html>
|;
}

###############################################################################
# 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|<nobr>Installed (Needed for <a href="http://www.imagefolio.com/add-ons/picpost/" target="_blank">Picture Post Mod</a> and Batch Thumbnail Mod)</nobr>|;
      }
      elsif ($_ =~ /Compress::ZLib/i){
         $cz = qq|<nobr>Installed (Needed for <a href="http://demo.imagefolio.com/lightbox/" target="_blank">Lightbox Mod</a> zipping and <a href="http://www.imagefolio.com/purchase/commerce/" target="_blank">IFC</a> downloads)</nobr>|;
      }
   }
   if (! $im) {
      $im = qq|<nobr><b>NOT</b> installed (Needed for <a href="http://www.imagefolio.com/add-ons/picpost/" target="_blank">Picture Post Mod</a> and Batch Thumbnail Mod)</nobr>|;
   }
   if (! $cz) {
      $cz = qq|<nobr><b>NOT</b> installed (Needed for <a href="http://demo.imagefolio.com/lightbox/" target="_blank">Lightbox Mod</a> zipping and <a href="http://www.imagefolio.com/purchase/commerce/" target="_blank">IFC</a> downloads)</nobr>|;
   }
}
serverinfo.pl
网页地址
文件地址
下载 ( 9 KB )
Comments
Total ratings: 0 Average rating: 无评论 of 10