sscgi.pm

稀饭伊人相册系统继承了新天堂多用户相册系统的功能

package SSCGI;
require 5.005;
# Writed by LeoBBS Team
# Hacked by EasunLee 2005
# Edited by nsnake 2006.7
# mod_perl支持不确定
use strict;
use Exporter;
use CGI qw (header param cookie redirect);
@SSCGI::ISA = qw (Exporter CGI);
@SSCGI::EXPORT = qw (header param cookie redirect uri_escape temppost cleaninput unclean unHTML HTML cleanarea stripMETA dateformatshort dateformat myrand unescape db_con %conf $dbh $template);
use vars qw($dbh %conf $template);
require 'config.pl';
initialize_globals();

sub new {
    my $class = shift;
    my $this = $class->SUPER::new( @_ );
       $this ->_initCGI(); #('gb2312');

    if ($CGI::MOD_PERL) {
        if ($CGI::MOD_PERL == 1) {
        my $r = Apache->request;
            $r->register_cleanup(\&SSCGI::_reset_globals);
        } elsif ($CGI::MOD_PERL == 2) {
            my $r = Apache2::RequestUtil->request;
            $r->pool->cleanup_register(\&SSCGI::_reset_globals);
        }
    }
    $class->_reset_globals if $CGI::PERLEX;

    return bless $this, $class;
}

sub _reset_globals {
   initialize_globals();
   #以下3行完全没有必要，写到这里仅仅是为了_reset_globals 调用，即MOD_PERL使用。
   $CGI::HEADERS_ONCE = $SSCGI::HEADERS_ONCE;
   $CGI::POST_MAX = $SSCGI::POST_MAX;
   $CGI::DISABLE_UPLOADS = $SSCGI::DISABLE_UPLOADS;
}

sub initialize_globals {
   $CGI::DefaultClass = __PACKAGE__;
   $SSCGI::AutoloadClass = 'CGI';

   # 初始值
   $SSCGI::HEADERS_ONCE = 1;
   $SSCGI::POST_MAX=2000;
   $SSCGI::DISABLE_UPLOADS = 1;
   # 初始 END

   $SSCGI::VERSION='1.0';  #  版本号码
   $SSCGI::randseed = 0;
}

sub _initCGI {  #外部敷值
   # my($self,$str)= @_;
   my $self = shift;
   #$self ->charset($str);
   $CGI::HEADERS_ONCE = $SSCGI::HEADERS_ONCE;
   $CGI::POST_MAX = $SSCGI::POST_MAX;
   $CGI::DISABLE_UPLOADS = $SSCGI::DISABLE_UPLOADS;
   return;
}

sub escape {
        my($self,$str)= CGI::self_or_CGI(@_);
        return $str if ($str =~ /\%/);
        return if !defined $str;
        $str=~ s/([^@\w\.\*\-\x20\:\/])/uc sprintf('%%%02x',ord($1))/eg;
        $str=~ tr/ /+/;
        $str;
}

sub uri_escape{
        my ($self, $str) = CGI::self_or_CGI(@_);
        return $str if ($str =~ /\%/);
        return unless (defined($str));
        $str =~ s/([^;\/?:@&=+\$,A-Za-z0-9\-_.!~*'()])/uc sprintf('%%%02x', ord($1))/eg;
        $str =~ tr/ /+/;
        return $str;
}

sub unescape {
        my($self,$str)= CGI::self_or_CGI(@_);
        return if !defined $str;
        $str=~ tr/+/ /;
        $str=~ s/%([0-9a-fA-F]{2})/chr hex($1)/eg;
        $str;
}
sub toGMTstring {
        my($self,$time,$format)= CGI::self_or_CGI(@_);
        $format ||= 'http';
        my @MON=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
        my @WDAY=qw/Sun Mon Tue Wed Thu Fri Sat/;
        my %mult=( 's'=>1,'m'=>60,'h'=>60*60,'d'=>60*60*24,'M'=>60*60*24*30,'y'=>60*60*24*365);
        if (!$time || (lc($time) eq 'now') || $time =~/^\s*$/) {$time = time;}
        elsif ($time=~ /^\s*\d+\s*$/){$time = scalar($time);}
        elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {$time = time+($mult{$2} || 1)*$1;}
        else{return $time;}
        my($sc)=($format eq "cookie") ? '-' : ' ';
        my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
        return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT",$WDAY[$wday],$mday,$MON[$mon],$year+1900,$hour,$min,$sec);
}


sub dateformatshort
{
        my ($self, $time) = CGI::self_or_CGI (@_);
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($time);
        sprintf ('%04d/%02d/%02d %02d:%02d', $year + 1900, $mon + 1, $mday, $hour, $min);
}

sub dateformat
{
        my ($self, $time) = CGI::self_or_CGI (@_);
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($time);
        sprintf ('%04d/%02d/%02d %02d:%02d%s', $year + 1900, $mon + 1, $mday, ($hour % 12), $min, ($hour > 11) ? 'pm' : 'am');
}



sub unHTML {
        my ($self, $text) = CGI::self_or_CGI(@_);
        $text =~ s/\&/\&/g;
        $text =~ s/"/\"/g;
        $text =~ s/  / \ /g;
        $text =~ s/</\&lt;/g;
        $text =~ s/>/\&gt;/g;
        $text =~ s/[\a\f\e\0\r\t]//isg;
        $text =~ s/document.cookie/documents\&\#46\;cookie/isg;
        $text =~ s/'/\&\#039\;/g;
        $text =~ s/\$/&#36;/isg;
        return $text;
}
sub HTML {
        my ($self, $text) = CGI::self_or_CGI(@_);
        $text =~ s/\&amp;/\&/g;
        $text =~ s/\&quot;/"/g;
        $text =~ s/ \&nbsp;/　/g;
        $text =~ s/\&lt;/</g;
        $text =~ s/\&gt;/>/g;
        $text =~ s/documents\&\#46\;cookie/document.cookie/isg;
        $text =~ s/\&\#039\;/'/g;
        $text =~ s/&#36;/\$/isg;

        return $text;
}
sub cleanarea {
        my ($self, $text) = CGI::self_or_CGI(@_);
        study($text);
        $text =~ s/[\a\f\e\0\r\t]//isg;
        $text =~ s/\&nbsp;/ /g;
        $text =~ s/\@ARGV/\&\#64\;ARGV/isg;
        $text =~ s/\;/\&\#59\;/isg;
        $text =~ s/\&/\&amp;/g;
        $text =~ s/\&amp;\#/\&\#/isg;
        $text =~ s/\&amp\;(.{1,6})\&\#59\;/\&$1\;/isg;
        $text =~ s/\&\#([0-9]{1,6})\&\#59\;/\&\#$1\;/isg;
        $text =~ s/"/\&quot;/g;
        $text =~ s/  / \&nbsp;/g;
        $text =~ s/</\&lt;/g;
        $text =~ s/>/\&gt;/g;
        $text =~ s/  / /g;
        $text =~ s/\n\n/<p>/g;
        $text =~ s/\n/<br>/g;
        $text =~ s/document.cookie/documents\&\#46\;cookie/isg;
        $text =~ s/'/\&\#039\;/g;
        $text =~ s/\$/&#36;/isg;
        $text =~ s/#/&#35;/isg;
        $text =~ s/&&#35;/&#/isg;
        $text =~ s/'/\\'/isg;
        return $text;
}

#SQL注入过滤

sub sql
      {
        my ($self, $sql) = CGI::self_or_CGI(@_);
        study($sql);
        $sql =~ s/select//isg;
        $sql =~ s/insert//isg;
        $sql =~ s/delete//isg;
        $sql =~ s/drop//isg;
        $sql =~ s/update//isg;
        $sql =~ s/truncate//isg;
        $sql =~ s/exec//isg;
        $sql =~ s/chr(34)//isg;
        $sql =~ s/chr(39)//isg;
        $sql =~ s/chr(91)//isg;
        $sql =~ s/chr(93)//isg;
        $sql =~ s/chr(37)//isg;
        $sql =~ s/chr(58)//isg;
        $sql =~ s/chr(59)//isg;
        $sql =~ s/chr(43)//isg;
        $sql =~ s/'/\\'/isg;
        return $sql;
}

sub stripMETA {
        my ($self, $file) = CGI::self_or_CGI(@_);
        $file =~ s/[<>\^\(\)\{\}\a\f\n\e\0\r\"\`\&\;\|\*\?]//g;
        return $file;
}

#创建随机数，返回小数形式的随机数
sub myrand{
        my ($self, $max) = CGI::self_or_CGI(@_);
        my $result;
        my $randseed =$SSCGI::randseed ;
        $max ||= 1;
        eval("\$result = rand($max);");
        return $result unless ($@);
        $randseed = time unless ($randseed);
        my $x = 0xffffffff;
        $x++;
        $randseed *= 134775813;
        $randseed++;
        $randseed %= $x;
        return $randseed * $max / $x;
}

#创建随机数，返回字母形式的随机数
sub textrand
{
       my ($self, $max) = CGI::self_or_CGI(@_);
       $max=9 unless $max;
       my $textrand;
       $textrand = myrand($textrand);
       $textrand = crypt ($textrand,'ssn');
       $textrand =~ s/%([a-fA-F0-9]{2})/pack("C", hex($1))/eg;
       $textrand =~ s/[^\w\d]//g;
       $textrand = substr($textrand,2,$max);
       return $textrand;
}

#创建随机数，返回数字形式的随机数
sub numrand
{
my ($self, $max,$numrand) = CGI::self_or_CGI(@_);
        $numrand = int(&myrand($max));
        $numrand = sprintf("%04d", $numrand);
        return $numrand
}

#########################
# 数据库连接
sub db_con
{
# # 类的使用
# # $dbh=DBI->connect("DBI:mysql:$conf{dataname}:$conf{server}:$conf{port}",$conf{user},$conf{mysql_password});
#
# # 对象的使用
#         $SSCGI::dbh = DBI->connect("DBI:mysql:$conf{dataname}:$conf{server}:$conf{port}",$conf{user},$conf{mysql_password})|| warn $dbi::errstr;
# # 关闭警报
#          $SSCGI::dbh->{'Warn'} = 1;

         my($self) = CGI::self_or_CGI(@_);
            $dbh = DBI->connect("DBI:mysql:$conf{dataname}:$conf{server}:$conf{port}",$conf{user},$conf{mysql_password})|| warn $dbh->errstr();
            $dbh->{'Warn'} = 1;
}

sub db_discon
{
$SSCGI::dbh->disconnect() || warn $dbi::errstr;
}

#测试时间
# sub used_times {
#         my ($self, $max) = CGI::self_or_CGI(@_);
#         my($user, $system);
#         if ( $_[0] eq 0 ) {
#                 ( $user, $system ) = times();
#         }
#         elsif ( $_[0] eq 1 ) {
#                 my ( $user_1, $system_1 ) = times();
#                 my $usertimes   = $user_1 - $user;
#                 my $systemtimes = $system_1 - $system;
#                 if ( $usertimes != 0 ) {
#                         $usertimes = int( $usertimes * 1000 );
#                 }
#                 if ( $systemtimes != 0 ) {
#                         $systemtimes = int( $systemtimes * 1000 );
#                 }
#                 if ($systemtimes==0){$systemtimes=1;}
#                 my $totltimes  = $usertimes + $systemtimes;
#                 my $view_times =
#                 qq~Processed in cpu:$systemtimes ms,  webpage:$totltimes ms~;
#         }
# }

#获取真实IP

sub get_ip
{
my ($self, $max) = CGI::self_or_CGI(@_);
my $ipaddress     = $ENV{"REMOTE_ADDR"};
my $trueipaddress = $ENV{"HTTP_CLIENT_IP"};
   $trueipaddress = $ENV{"HTTP_X_FORWARDED_FOR"} if ($trueipaddress eq '' || $trueipaddress eq 'unknown' || $trueipaddress =~ m/^192\.168\./ ||   $trueipaddress =~ m/^10\./);
   $trueipaddress = $ipaddress if ($trueipaddress eq '' || $trueipaddress eq 'unknown' || $trueipaddress =~ m/^192\.168\./ || $trueipaddress =~ m/^10\./);
return $trueipaddress;
}


#用户COOKIE验证
sub check_cook
{
my ($self,$cook) = CGI::self_or_CGI(@_);
unless($cook     = cookie('member_login')){return 0;}
my ($cuid,$loginname,$loginpass)=split (/\|/,$cook);
    $loginname =~ s/[\a\f\n\e\0\r\t\`\~\!\@\#\$\%\^\&\*\(\)\+\=\\\{\}\;\'\:\"\,\.\/\<\>\?]//isg;
#     $loginpass =~ s/[\a\f\n\e\0\r\t\|\@\;\#\{\}\$]//isg;
    $loginname =  sql($loginname);
#SSCGI::db_con();
   db_con();
my($uid,$uloginname,$upassword) =$dbh->selectrow_array("SELECT u_id,u_loginname,u_password FROM user WHERE u_loginname LIKE '$loginname'");
#  $uid =crypt $uid,'ss';
   if(($uloginname eq $loginname) && ($upassword eq $loginpass))
#通过验证返回uid数值
   {return $uid;}
   else
   {return 'fail';}
}

#加密相册登录用户cookie验证
sub guest_cook
{
my ($self,$aid,$aneedname,$aneedpass,$cook) = CGI::self_or_CGI(@_);
unless($cook    = cookie("guest_login_$aid")){return 0;}
my ($gloginname,$gloginpass)=split (/\|/,$cook);
    $gloginname =~ s/[\a\f\n\e\0\r\t\`\~\!\@\#\$\%\^\&\*\(\)\+\=\\\{\}\;\'\:\"\,\.\/\<\>\?]//isg;
#  $uid =crypt $uid,'ss';
   if(($aneedname eq $gloginname) && ($aneedpass eq $gloginpass))
#通过验证返回1
   {return 1;}
   else
   {return 0;}
}

#显示错误信息页面
sub error_html
{
my ($self,$message) = CGI::self_or_CGI(@_);
# print head('charset=utf-8');
print "Content-type: text/html\n\n";
print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">';
print $conf{$message};
exit;
}

#服务器错误，记录在日志文件里
sub error_log
{
my ($self,$message,$log) = CGI::self_or_CGI(@_);
print "Content-type: text/html\n\n";
print $message;
exit;
}

#显示成功信息页面
sub succ_html
{
my ($self,$message) = CGI::self_or_CGI(@_);
# print $self->head(-charset=>'utf-8');
print "Content-type: text/html\n\n";
print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">';
print $conf{$message};
}

#显示成功信息页面,不显示标题
sub succ_nohtml
{
my ($self,$message) = CGI::self_or_CGI(@_);
print $conf{$message};
}

#模板文件调用
sub tmpl_html
{
 my ($self,$tmpl) = CGI::self_or_CGI(@_);
 $SSCGI::template = HTML::Template->new(filename => $tmpl,
                                            path => $conf{themes_tmpl},
                                            #错误警告0关闭
                                            die_on_bad_params=>1,
                  #缓存设置 MOD_PERL下使用
                  #需要IPC::SharedCache模块
                  #shared_cache=>1,
                  #double_cache=>1,

#                   #CGI环境下使用
#                   #文件缓存 1开启，0关闭
                   file_cache=>1,
#                   #文件缓存目录
                   file_cache_dir=>"$conf{base_path}/temp",
#                   #文件缓存属性
                   file_cache_dir_mode=> 0777,
#                   #双倍文件缓存开启
#                   double_file_cache=>1,
                                      );

}

#mod_perl环境检测
sub check_mod
{
my ($self) = CGI::self_or_CGI(@_);
if(exists $ENV{MOD_PERL})
{
  print "Running as a mod_perl application";
}
else
{
  print "Running as a CGI script";
}
}

#通用分页 需要总个数，每页个数，返回数值：页数
sub pages
{
my ($self,$num,$pn) = CGI::self_or_CGI(@_);
my  $pages=$num%$pn ? $num/$pn+1 : $num/$pn;
return $pages;
}

#文件锁定
# 所需元素      :   文件路径
sub filelock {
my ($self,$file,$i) = CGI::self_or_CGI(@_);
while (-e "$file.lock") {
        $i++;
        select(undef,undef,undef,0.1);
    if ($i >10){
             my $locktime=(-M "$file.lock");
             if ($locktime > 0.001){unlink"$file.lock";}
            error_html(530);
                                         }
                                                               }
                                 }

# 文件写入
# 所需元素      :   $[0]文件路径,$[1]需要写入的内容
# 返回结果      :   1
sub writefile {
my ($self,$file,$datas) = CGI::self_or_CGI(@_);
    &filelock($file);
    open( FILE, ">$file.lock" );
    close(FILE);
    chmod(0666, "$file.lock");

    open( FILE, ">$file" ) or return 0;
    #select FILE;
    #binmode FILE;
    print FILE "$datas";
    close(FILE);
    chmod (0666, "$file");
    unlink("$file.lock");
}


1;