view release on metacpan or  search on metacpan

AuthCookiePAM.pm  view on Meta::CPAN

	my( $str ) = @_;
	$str =~ s/%([0-9a-fA-F]{2})/ pack( "c",hex( $1 ) ) /ge;
	return $str;
}

#===============================================================================
# P U B L I C   F U N C T I O N S
#===============================================================================

#-------------------------------------------------------------------------------
# Take the credentials for a user and check that they match; if so, return
# a new session key for this user that can be stored in the cookie.
# If there is a problem, return a bogus session key.

sub authen_cred($$\@)
{
    my( $self, $r, @credentials ) ;
    ( $self, $r, @credentials ) = @_;

    my $auth_name; $auth_name = $r->auth_name;
    my %c ; %c = _config_vars $r;

    # Username goes in credential_0
    my $user; $user = $credentials[ 0 ];
    $user=~ tr/A-Z/a-z/;
    unless ( $user =~ /^.+$/ ) {
	$r->log_reason( "Apache::AuthCookiePAM: no username supplied for auth realm $auth_name", $r->uri );
        $r->subprocess_env('AuthenReason', 'No username provided. Try again.');
	return undef;
    }
    # Password goes in credential_1
    my $password; $password = $credentials[ 1 ];
    unless ( $password =~ /^.+$/ ) {
	$r->log_reason( "Apache::AuthCookiePAM: no password supplied for auth realm $auth_name", $r->uri );
        $r->subprocess_env('AuthenReason', 'No password provided. Try again.');
	return undef;
    }
    # service to be used for authentication
    my $service; $service = $c{PAM_service};
    my ($pamh,$res,$funcref);
    $funcref=create_conv_func($r,$user,$password); 
      

AuthCookiePAM.pm  view on Meta::CPAN

  $self->_convert_to_get($r, \%args) if $r->method eq 'POST';

  unless (exists $args{'destination'}) {
    $r->log_error("No key 'destination' found in form data");
    $r->subprocess_env('AuthenReason', 'no_cookie');
    return $auth_type->login_form;
  }
  $r->subprocess_env('AuthenReason', 'Password Change requested/required');
  
  # Get the credentials from the data posted by the client
  my @credentials;
  #user in credential_0
  my $user; $user = $args{"credential_0"};
  $user=~ tr/A-Z/a-z/;
  unless ( $user =~ /^.+$/ ) {
	$r->log_reason( "Apache::AuthCookiePAM: no username supplied for auth realm $auth_name", $r->uri );
  }
  # Old Password goes in credential_1
  my $oldpassword; $oldpassword = $args{"credential_1"};
  unless ( $oldpassword =~ /^.+$/ ) {
	$r->log_reason( "Apache::AuthCookiePAM: no password supplied ", $r->uri );