DLAuth2.pm内容:
package DLAuth2;
use strict;
use Socket qw(inet_aton);
use POSIX qw(strftime);
use Digest::MD5 qw(md5_hex);
#use Apache2::RequestIO ();
use Apache2::RequestRec ();
use Apache2::Connection ();
use Apache2::RequestUtil ();
use Apache2::ServerUtil ();
use Apache2::Log ();
use Apache2::Request ();
use Apache2::Const -compile => qw(OK FORBIDDEN);
sub handler {
my $r = shift;
my $q = Apache2::Request->new($r);
my $s = Apache2::ServerUtil->server;
# get request ip
my $ip = $r->connection->remote_ip;
# get client's UserAgent
my $ua = $r->headers_in->{'User-Agent'} || '';
# convert ip to int
my $ip_int = ip2int($ip);
# get share key from config file
my $shareKey = $r->dir_config('ShareKey') || '';
# get whitelist ip from config file
my @passip = $r->dir_config->get('PassAuthIPs');
# get whitelist UserAgent Keyword from config file
my @passuakey = $r->dir_config->get('PassUAKeyword');
# 将白名单IP转换为整数数组
my @single_ip;
my @range_ip;
for (@passip) {
if (/-/) {
my ($start,$end) = split/-/;
my $start_int = ip2int($start);
my $end_int = ip2int($end);
push @range_ip,[$start_int,$end_int];
} else {
push @single_ip,ip2int($_);
}
}
# 支持IP白名单
for (@single_ip) {
return Apache2::Const::OK if $ip_int == $_;
}
for (@range_ip) {
if ( $ip_int >= $_->[0] and $ip_int <= $_->[1] ) {
return Apache2::Const::OK;
}
}
# 支持UserAgent白名单
for (@passuakey) {
my $key = quotemeta($_);
return Apache2::Const::OK if $ua =~ /$key/i;
}
# 从URL路径得到mid,该函数请自己定制
my $movieid = getmid($r->uri);
if ( ! defined $movieid ) {
$s->log_error("[$ip FORBIDDEN] can't get movieid");
return Apache2::Const::FORBIDDEN;
}
# get current date
my $date= strftime("%Y%m%d",localtime);
# 根据IP、mid、共享字符串、日期产生验证串
# 通常是md5加密的一个串,该函数请自己定制
my $key = genAuthString($ip_int, $movieid, $shareKey, $date);
# 获取请求路径里的验证串
my $str = $q->param('a') || '';
# 假如两串相等,则通过
if ($str eq $key ){
return Apache2::Const::OK;
# 否则拒绝并记日志到error_log
} else {
$s->log_error("[$ip FORBIDDEN] Auth failed");
return Apache2::Const::FORBIDDEN;
}
# 若未满足任何条件,默认放行
return Apache2::Const::OK;
}
# 将IP转换为整数的函数
sub ip2int {
my $ip = shift;
my $nl = inet_aton($ip);
die "wrong ip $!" unless defined $nl;
return unpack('N',$nl);
}
1;