最近上司部署了个研究防盗链的任务.经过多方搜索找到使用mod_perl实现防盗链的文章,但是整个安装配置过程阻碍甚多.故作此文以为梳理.

?

首先是依赖模块的安装.

1.安装ApacheHttpServer2.2(这是废话)

2.安装Perl5.8.*.或Perl5.12.*

3.使用PerlPPM安装mod_perl,命令如下

对于Perl5.8

ppm install?http://theoryx5.uwinnipeg.ca/ppms/mod_perl.ppd

对于Per5.12

ppm install?http://cpan.uwinnipeg.ca/PPMPackages/12xx/mod_perl.ppd

?? 还要安装libapreq2

对于Perl5.8

ppm install?http://theoryx5.uwinnipeg.ca/ppms/libapreq2.ppd

对于Perl5.12 ?暂时还是没找到使用PPM的安装仓库,所以还是建议使用Perl5.8吧.

?

两个模块的安装过程中会提示指定ApacheHttpServer的安装目录,依实填写即可.

?

4.配置httpd.conf(都知道这个是ApahceHttpServer的配置文件吧?)

增加如下片段(其中的PERL_HOME,APACHE_HOME在使用时要替换为真实的文件系统路径)

LoadFile "%PERL_HOME%/bin/perl58.dll" LoadModule perl_module modules/mod_perl.so LoadFile "%APACHE_HOME%/bin/libapreq2.dll" LoadModule apreq_module modules/mod_apreq2.so

?

PerlPostConfigRequire %APACHE_HOME%/modperl/startup.pl <Location / >?#这里对整个域都要求验证,可以自定义 SetHandler modperl?#设置处理器 PerlAccessHandler KeyAccess?#使用的perl编写的处理器 PerlSetVar key 123?#下面的脚本使用这里的key值做密钥进行加密验证 </Location>

5.编写Perl脚本

第4步中有一个modperl目录,在这个目录中增加两个文件

startup.pl

use strict;
use lib qw(d:/ProgramFiles/ApacheSoftwareFoundation/Apache2.2/modperl); # 把这个路径加入到perl lib路径
#d:/ProgramFiles/ApacheSoftwareFoundation/Apache2.2  这部分替换成实际的目录
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::Connection ();
use Apache2::RequestUtil ();
use Apache2::ServerUtil ();
use Apache2::Log ();
use Apache2::Request ();

1;

?

KeyAccess.pm

?

?

package KeyAccess;
use strict;
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::Connection ();
use Apache2::RequestUtil ();
use Apache2::ServerUtil ();
use Apache2::Log ();
use Apache2::Const -compile => qw(OK FORBIDDEN);
use Apache2::Request ();
use Digest::MD5 qw(md5 md5_hex md5_base64);

sub handler {
    my $r = shift;
    my $req = Apache2::Request->new($r);
    my $ip = $r->connection->remote_ip;
    my $k = $req->param('key') || ''; # 判断访问时是否带key参数
    my $key = $r->dir_config('key') || '123'; # 加载httpd.conf配置中的key值
	my $md5value=md5_hex($key.$ip); #使用MD5加密验证
    if ($md5value eq $k) { # 相等可以正常访问
        return Apache2::Const::OK;
    } else { # 否则显示拒绝访问
        my $s = Apach