view release on metacpan or  search on metacpan

DigestMD5.pm  view on Meta::CPAN

sub set {
    my $this=shift;
    while (@_) {
	my $k=shift;
	my $v=shift;
	$this->{$k}=$v;
    }
}

sub get {
    my $this=shift;
    return wantarray
	? (map { $this->{$_} } @_)
	    : $this->{$_[0]};
}

sub reset {
    my $this=shift;
    for my $k ($this->_public) {
	delete $this->{$k}
    }
}

package Authen::DigestMD5::Request;
our @ISA=qw(Authen::DigestMD5::Packet);

use strict;
use warnings;

sub auth_ok {
    my $this=shift;
    return defined $this->{rspauth};
}

package Authen::DigestMD5::Response;
our @ISA=qw(Authen::DigestMD5::Packet);

use strict;
use warnings;

use Digest::MD5 qw(md5_hex md5);
use Carp;

sub new {
    my $this=shift->SUPER::new(@_);
    $this->{_nc}={};
    return $this;
}

sub _public {
    my $this=shift;
    return grep { $_=~/^[a-z]/i and
		      $_ ne 'password' } keys(%$this);
}

sub got_request {
    my $this=shift;
    my $req=shift;
    # $this->{_r}=$req;
    for my $k (qw(nonce realm charset)) {
	$this->{$k}=$req->{$k} if exists $req->{$k};
    }
    #$this->{nc}=sprintf("%08d", ++$this->{_nc}{$req->{nonce}})
    #  if exists $req->{nonce};
    if (exists $req->{qop}) {
	my @qop=split(/\s*,\s*/, $req->{qop});
	if (grep {$_ eq 'auth-int'} @qop) {
	    $this->{qop}='auth-int'
	}
	elsif (grep {$_ eq 'auth'} @qop) {
	    $this->{qop}='auth'
	}
	else { croak "not supported qop found ($req->{qop})" }
    }
}

sub add_digest {
    my $this=shift;

    $this->{cnonce}=md5_hex(join(':', time, rand, $$));
      # unless defined $this->{cnonce};

    $this->{nc}=sprintf("%08d", ++$this->{_nc}{$this->{nonce}})
	if exists $this->{nonce};

    my %pair=((map { $_, $this->{$_} } $this->_public), @_);

    my $A1=join (":",
		 md5(join (":", @pair{qw(username realm password)}, )),
		 @pair{qw(nonce cnonce)} );

    my $A2 = "AUTHENTICATE:" . $pair{'digest-uri'};

    $A2 .= ":00000000000000000000000000000000"
	if (defined $pair{'qop'} and
	    $pair{'qop'} =~ /^auth-(conf|int)$/);

    $this->{response} =
	md5_hex(join (":", md5_hex($A1),
		      @pair{qw(nonce nc cnonce qop)},
		      md5_hex($A2)) );
}


1;
__END__

=head1 NAME

Authen::DigestMD5 - SASL DIGEST-MD5 authentication (RFC2831)

=head1 SYNOPSIS

  use Authen::DigestMD5;

  use OnLDAP;
  $ld=OnLDAP::Client->new($host);
  ($rc, $id)=$ld->sasl_bind(undef, 'DIGEST-MD5');
  ($rc, $msg)=$ld->result($id);
  ($rc, $req)=$ld->parse_sasl_bind_result($msg);