File Coverage

blib/lib/Plack/Middleware/Auth/Digest.pm

Criterion	Covered	Total	%
statement	27	79	34.1
branch	2	18	11.1
condition	1	18	5.5
subroutine	9	19	47.3
pod	2	11	18.1
total	41	145	28.2

package Plack::Middleware::Auth::Digest;
use 5.008001;
use strict;
use warnings;
use parent qw/Plack::Middleware/;
use Plack::Util::Accessor qw/realm authenticator password_hashed secret nonce_ttl/;

use MIME::Base64 ();
use Digest::MD5 ();
use Digest::HMAC_SHA1 ();

our $VERSION = '0.04';

sub hash {
    Digest::MD5::md5_hex(join ":", @_);
}

sub prepare_app {
    my $self = shift;

    if ($self->authenticator && ref $self->authenticator ne 'CODE') {
        die 'authenticator should be a code reference';
    }

    unless ($self->secret) {
        die "Auth::Digest secret key is not set.";
    }
}

sub call {
    my ($self, $env) = @_;

    my $auth = $env->{HTTP_AUTHORIZATION} or return $self->unauthorized;

    if ($auth =~ /^Digest (.*)/) {
        my $auth = $self->parse_challenge($1) || {};
        $auth->{method} = $env->{REQUEST_METHOD};

        if ($auth->{uri} ne $env->{REQUEST_URI}) {
            return [ 400, ['Content-Type', 'text/plain'], [ "Bad Request" ] ];
        }

        my $password = $self->authenticator->($auth->{username}, $env);
        if (   defined $password
            && $self->valid_nonce($auth)
            && $self->digest($password, $auth) eq $auth->{response}) {

            if ($self->stale_nonce($auth)) {
                return $self->unauthorized(stale => "true");
            }

            $env->{REMOTE_USER} = $auth->{username};
            return $self->app->($env);
        }
    }

    return $self->unauthorized;
}

sub parse_challenge {
    my($self, $header) = @_;

    my $auth;
    while ($header =~ /(\w+)\=("[^\"]+"|[^,]+)/g ) {
        $auth->{$1} = dequote($2);
    }

    return $auth;
}

sub dequote {
    my $s = shift;
    $s =~ s/^"(.*)"$/$1/;
    $s =~ s/\\(.)/$1/g;
    $s;
}

sub digest {
    my($self, $password, $auth) = @_;

    my $hashed = $self->password_hashed
        ? $password : hash($auth->{username}, $auth->{realm}, $password);

    return hash($hashed, @{$auth}{qw(nonce nc cnonce qop)}, hash("$auth->{method}:$auth->{uri}"));
}

sub unauthorized {
    my $self = shift;
    my %params = @_;

    my $body      = '401 Authorization required';
    my $realm     = $self->realm || "restricted area";
    my $nonce     = $self->generate_nonce(time);
    my $algorithm = 'MD5';
    my $qop       = 'auth';

    my $challenge  = qq|Digest realm="$realm", nonce="$nonce", algorithm=$algorithm, qop="$qop"|;
       $challenge .= qq(, stale=true) if $params{stale};

    return [
        401,
        [
            'Content-Type'     => 'text/plain',
            'Content-Length'   => length $body,
            'WWW-Authenticate' => $challenge,
        ],
        [ $body ],
    ];
}

sub valid_nonce {
    my($self, $auth) = @_;

    my($time, $digest) = split / /, MIME::Base64::decode_base64($auth->{nonce});
    $auth->{_nonce_time} = $time; # cache for stale check

    return $time && $digest && $digest eq $self->hmac($time);
}

sub stale_nonce {
    my($self, $auth) = @_;

    $auth->{_nonce_time} < time - ($self->nonce_ttl || 60);
}

sub generate_nonce {
    my($self, $time) = @_;

    my $nonce = MIME::Base64::encode_base64(join " ", $time, $self->hmac($time));
    chomp $nonce;

    return $nonce;
}

sub hmac {
    my($self, $time) = @_;
    Digest::HMAC_SHA1::hmac_sha1_hex($time, $self->secret);
}

1;
__END__