apache防盗链(modperl试用二)

package Test;
use strict;
use warnings;
use Socket qw(inet_aton);
use POSIX qw(difftime mktime);
use Digest::MD5 qw(md5_hex);
use Apache2::RequestRec ();
use Apache2::Connection ();
use Apache2::RequestUtil ();
use Apache2::ServerUtil ();
use Apache2::Log ();
use Apache2::Request ();
use Apache2::Const qw(DECLINED FORBIDDEN);
sub handler {
    my $r = shift;
    my $s = Apache2::ServerUtil->server;
    my $secret = $r->dir_config('Secret') || '';
    my $uri = $r->uri() || '';
    my $expire = 2 * 3600;
    if ($uri =~ m#^/(d{4})(d{2})(d{2})(d{2})(d{2})/(w{32})(/S+.mp3)$#oi) {
        my ($year, $mon, $mday, $hour, $min, $md5, $path) = ($1, $2, $3, $4, $5, $6, $7);
        my $str = md5_hex($secret . $year . $mon . $mday . $hour . $min . $path);
        my $reqtime = mktime(00, $min, $hour, $mday, $mon - 1, $year - 1900);
        my $now = time;
        if ( $now - $reqtime < $expire){
            if ($str eq $md5) {
                $r->uri("$path");
                return Apache2::Const::DECLINED;
            }
        }
    }
}
1;