view release on metacpan or  search on metacpan

lib/Authen/SASL/Perl/DIGEST_MD5.pm  view on Meta::CPAN

  $self->{khc}       = undef;
  $self->{khs}       = undef;
  $self->{sndseqnum} = 0;
  $self->{rcvseqnum} = 0;

  # reset properties for new session
  $self->property(maxout => undef);
  $self->property(ssf    => undef);
}

# no initial value passed to the server
sub client_start {
  my $self = shift;

  $self->{need_step} = 1;
  $self->{error}     = undef;
  $self->{state}     = 0;
  $self->init_sec_layer;
  '';
}

sub server_start {
  my $self       = shift;
  my $challenge  = shift;
  my $cb         = shift || sub {};

  $self->{need_step} = 1;
  $self->{error}     = undef;
  $self->{nonce}     = $NONCE ? md5_hex($NONCE) : unpack('H32',urandom(16));

  $self->init_sec_layer;

  my $qop = [ sort keys %{$self->{supported_qop}} ];

  ## get the realm using callbacks but default to the host specified
  ## during the instantiation of the SASL object
  my $realm = $self->_call('realm');
  $realm  ||= $self->host;

  my %response = (
    nonce         => $self->{nonce},
    charset       => 'utf-8',
    algorithm     => 'md5-sess',
    realm         => $realm,
    maxbuf        => $self->property('maxbuf'),

## IN DRAFT ONLY:
# If this directive is present multiple times the client MUST treat
# it as if it received a single qop directive containing a comma
# separated value from all instances. I.e.,
# 'qop="auth",qop="auth-int"' is the same as 'qop="auth,auth-int"

    'qop'         => $qop,
    'cipher'      => [ map { $_->{name} } @ourciphers ],
  );
  my $final_response = _response(\%response);
  $cb->($final_response);
  return;
}

sub client_step {   # $self, $server_sasl_credentials
  my ($self, $challenge) = @_;
  $self->{server_params} = \my %sparams;

  # Parse response parameters
  $self->_parse_challenge(\$challenge, server => $self->{server_params})
    or return $self->set_error("Bad challenge: '$challenge'");

  if ($self->{state} == 1) {
    # check server's `rspauth' response
    return $self->set_error("Server did not send rspauth in step 2")
      unless ($sparams{rspauth});
    return $self->set_error("Invalid rspauth in step 2")
      unless ($self->{rspauth} eq $sparams{rspauth});

    # all is well
    $self->set_success;
    return '';
  }

  # check required fields in server challenge
  if (my @missing = grep { !exists $sparams{$_} } @server_required) {
    return $self->set_error("Server did not provide required field(s): @missing")
  }

  my %response = (
    nonce        => $sparams{'nonce'},
    cnonce       => $CNONCE ? md5_hex($CNONCE) : unpack('H32',urandom(16)),
    'digest-uri' => $self->service . '/' . $self->host,
    # calc how often the server nonce has been seen; server expects "00000001"
    nc           => sprintf("%08d",     ++$self->{nonce_counts}{$sparams{'nonce'}}),
    charset      => $sparams{'charset'},
  );

  return $self->set_error("Server qop too weak (qop = $sparams{'qop'})")
    unless ($self->_client_layer(\%sparams,\%response));

  # let caller-provided fields override defaults: authorization ID, service name, realm

  my $s_realm = $sparams{realm} || [];
  my $realm = $self->_call('realm', @$s_realm);
  unless (defined $realm) {
    # If the user does not pick a realm, use the first from the server
    $realm = $s_realm->[0];
  }
  if (defined $realm) {
    $response{realm} = $realm;
  }

  my $authzid = $self->_call('authname');
  if (defined $authzid) {
    $response{authzid} = $authzid;
  }

  my $serv_name = $self->_call('serv');
  if (defined $serv_name) {
    $response{'digest-uri'} .= '/' . $serv_name;
  }

  my $user = $self->_call('user');
  return $self->set_error("Username is required")