view release on metacpan or  search on metacpan

util/anno_server  view on Meta::CPAN

* verify the message-digest against the PUT|POSTed content

=cut

sub check_auth {
  my $self = shift;
  my ($string, $server) = @_;

  # bits from HTTPD::Authen (corrected) and LWP
  my %cdata = $self->parse_digest_request($string);
  exists($cdata{username}) or return;

  # XXX may not have a cleartext password, but I need at least H(A1)
  my $password = $server->can('get_password') ?
    $server->get_password($cdata{username}) : undef;
  #warn "user's password: $password\n";

  
  return($self->verify_digest(
    %cdata,
    _server => $server,
    _password => $password,
  ));
} # end subroutine check_auth definition
########################################################################

=head2 parse_digest_request

See rfc2617 "3.2.2 The Authorization Request Header"
(http://www.ietf.org/rfc/rfc2617.txt).

  my %cdata = $self->parse_digest_request($string);

=cut

sub parse_digest_request {
  my $self = shift;
  my ($string) = @_;

  my %cdata;
  while($string =~ s/^([a-z-]+)=((?:"[^"]+")|[^,]+)(?:, *|$)//) {
    my ($k, $v) = ($1, $2);
    ($v =~ s/^"//) and ($v =~ s/"$//); # could be harsher
    exists($cdata{$k}) and die "duplicate key $k";
    $cdata{$k} = $v;
  }
  $string and die "now I'm mad ($string)";
  0 and warn "we parsed: ",
    join(", ", map({"$_ => $cdata{$_}"} keys %cdata));
  return(%cdata);
} # end subroutine parse_digest_request definition
########################################################################

=head2 verify_digest

  $username = $self->verify_digest(
    %cdata,
    _server => $server,
    _password => $password,
  );

=cut

sub verify_digest {
  my $self = shift;
  my (%args) = @_;