view release on metacpan or  search on metacpan

AuthCookiePAM.pm  view on Meta::CPAN

# the supplied string.

sub _percent_decode($)
{
	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); 
      
    ref($pamh = new Authen::PAM($service, $user,$funcref)) || die "Error code $pamh during PAM init!";
    # call auth module to authenticate user
    $res = $pamh->pam_authenticate;
    $funcref=0;
    if ( $res != PAM_SUCCESS()) {
        $r->log_error("ERROR: Authentication for $user Failed\n");
        $r->subprocess_env('AuthenReason', 'Authentication failed. Username/Password provided incorrect.');
        $pamh=0;
	undef $pamh;
        return undef;
    } 
    else { # Now check if account is valid
        $res = $pamh->pam_acct_mgmt();
	if ( $res == PAM_ACCT_EXPIRED() ) {
           $r->log_error("ERROR: Account for $user is locked. Contact your Administrator.\n");
           $r->subprocess_env('AuthenReason', 'Account for $user is locked. Contact your Administrator.');
           return 'bad';
	}
	if ( $res == PAM_NEW_AUTHTOK_REQD() ) {
           $r->log_error("ERROR: PAssword for $user expired. Change Password\n");
           $r->subprocess_env('AuthenReason', 'Password Expired. Please Change your password.');
	   return $r->auth_type->changepwd_form ($user);
	}
	if ( $res == PAM_SUCCESS() ) {
           # Create the expire time for the ticket.
           my $expire_time;
           # expire time in a zillion years if it's forever.
           if ( lc $c{ PAM_sessionlifetime } eq 'forever' ) {
              $expire_time = '9999-01-01-01-01-01';
           } else {
	      my( $deltaday, $deltahour, $deltaminute, $deltasecond ) = split /-/, $c{ PAM_sessionlifetime };
	      # Figure out the expire time.
	      $expire_time = sprintf( '%04d-%02d-%02d-%02d-%02d-%02d',
					Add_Delta_DHMS( Today_and_Now,
					                $deltaday, $deltahour,
							$deltaminute, $deltasecond ));
          }

	   # Now we need to %-encode non-alphanumberics in the username so we
	   # can stick it in the cookie safely.  *** DEBUG *** check this
	   my $enc_user; $enc_user = _percent_encode $user;

	   # OK, now we stick the username and the current time and the expire
	   # time together to make the public part of the session key:
	   my $current_time; $current_time = _now_year_month_day_hour_minute_second;
	   my $public_part; $public_part = "$enc_user:$current_time:$expire_time";

	   # Now we calculate the hash of this and the secret key and then
	   # calculate the hash of *that* and the secret key again.
	   my $secret_key; $secret_key = $SECRET_KEYS{ $auth_name };
	   unless ( defined $secret_key ) {
		$r->log_reason( "Apache::AuthCookiePAM: didn't have the secret key for auth realm $auth_name", $r->uri );
		return 'bad';
	   }
	   my $hash ; $hash = md5_hex( join ':', $secret_key, md5_hex(
	                  	join ':', $public_part, $secret_key
	                     ) );

	   # Now we add this hash to the end of the public part.
	   my $session_key; $session_key = "$public_part:$hash";

	   # Now we encrypt this and return it.
	   my $encrypted_session_key;
	   if ( $c{ PAM_encryptiontype } eq 'none' ) {
		$encrypted_session_key = $session_key;
	   } elsif ( lc $c{ PAM_encryptiontype } eq 'des'      ) {
		$CIPHERS{ "des:$auth_name"      }
		   ||= Crypt::CBC->new( $secret_key, 'DES'      );
		$encrypted_session_key = $CIPHERS{
			"des:$auth_name"
		}->encrypt_hex( $session_key );
	   } elsif ( lc $c{ PAM_encryptiontype } eq 'idea'     ) {
		$CIPHERS{ "idea:$auth_name"      }
		   ||= Crypt::CBC->new( $secret_key, 'IDEA'     );
		$encrypted_session_key = $CIPHERS{
			"idea:$auth_name"