view release on metacpan or  search on metacpan

AuthCookiePAM.pm  view on Meta::CPAN

=cut

	$c{ PAM_encryptiontype } = _dir_config_var( $r, 'PAM_EncryptionType' )
	            || 'none';
	# If we used encryption we need to pull in Crypt::CBC.
	if ( $c{ PAM_encryptiontype } ne 'none' ) {
		require Crypt::CBC;
	}

=item C<WhatEverPAM_service>

The service that will be using PAM libraries for authentication.
These will be one of the services configured in  /etc/pam.conf or /etc/pam.d/<service>

This directive defaults to "login"

=cut

	$c{ PAM_service } = _dir_config_var ( $r, 'PAM_service' ) || 'login';

	return %c;
}

#-------------------------------------------------------------------------------
# _now_year_month_day_hour_minute_second -- Return a string with the time in
# this order separated by dashes.

sub _now_year_month_day_hour_minute_second()
{
	return sprintf '%04d-%02d-%02d-%02d-%02d-%02d', Today_and_Now;
}

#-------------------------------------------------------------------------------
# _percent_encode -- Percent-encode (like URI encoding) any non-alphanumberics
# in the supplied string.

sub _percent_encode($)
{
	my( $str ) = @_;
	$str =~ s/([^\w])/ uc sprintf '%%%02x', ord $1 /eg;
	return $str;
}

#-------------------------------------------------------------------------------
# _percent_decode -- Percent-decode (like URI decoding) any %XX sequences in
# 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 };

AuthCookiePAM.pm  view on Meta::CPAN

  unless ($script = $r->dir_config($auth_name . "ChangePwdScript")) {
    $r->log_reason("PerlSetVar '${auth_name}ChangePwdScript' not set", $r->uri);
    return SERVER_ERROR;
  }
  $r->log_error("Redirecting to $script");
  $r->custom_response(REDIRECT, $script);
  
  return REDIRECT;
}

sub _convert_to_get 
{
    my ($self, $r, $args) ;
    ($self, $r, $args) = @_;

    return unless $r->method eq 'POST';

    my $debug ; $debug = $r->dir_config("AuthCookieDebug") || 0;

    $r->log_error("Converting POST -> GET") if $debug >= 2;

    my @pairs ; @pairs =();
    my ($name, $value);
    
    while ( ($name, $value) = each %$args) {
      # we dont want to copy login data, only extra data
      next if $name eq 'destination'
           or $name =~ /^credential_\d+$/;

      $value = '' unless defined $value;
      push @pairs, escape_uri($name) . '=' . escape_uri($value);
    }
    $r->args(join '&', @pairs) if scalar(@pairs) > 0;

    $r->method('GET');
    $r->method_number(M_GET);
    $r->headers_in->unset('Content-Length');
}

sub changepwd ($$) 
{
  my ($self, $r) ;
  ($self, $r) = @_;
  
  my $debug; $debug = $r->dir_config("AuthCookieDebug") || 0;

  my ($auth_type, $auth_name);  
  ($auth_type, $auth_name) = ($r->auth_type, $r->auth_name);

  my %args; %args = $r->method eq 'POST' ? $r->content : $r->args;

  $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 );
  }
  # New Password goes in credential_2
  my $newpassword ; $newpassword = $args{"credential_2"};
  unless ( $newpassword =~ /^.+$/ ) {
	$r->log_reason( "Apache::AuthCookiePAM: no password supplied ", $r->uri );
  }
  # Repeat Password goes in credential_3
  my $confirmpassword; $confirmpassword = $args{"credential_3"};
  unless ( $confirmpassword =~ /^.+$/  ) {
	$r->log_reason( "Apache::AuthCookiePAM: passwords don't match", $r->uri );
  }
  
  # Now do password change
  #
  my ($pamh,$res);
  my $funcref;
  $funcref=create_conv_func($r,$user,$oldpassword,$newpassword,$confirmpassword);
									  
  my %c; %c = _config_vars $r;

  my $service; $service = $c{PAM_service};
  ref($pamh = new Authen::PAM($service, $user,$funcref)) || die "Error code $pamh during PAM init!";
  $res = $pamh->pam_chauthtok();
  $pamh=0;
  undef $pamh;

  if ( $res == PAM_SUCCESS()) {
       $r->subprocess_env('AuthenReason', 'Password Updated. Please login with your new password');
       $r->log_reason("AuthenCookiePAM:". $args{'destination'}."Password for $user Updated. Please login with your new password");
       # 
       $auth_type->logout($r);
       $r->err_header_out("Location" => $args{'destination'});
       return REDIRECT;
  }
  else { 
       $r->subprocess_env('AuthenReason', "Password Not Updated. New password did not satisfy specified rules or failed authentication");
       $r->log_reason("AuthenCookiePAM: Password for $user Not Updated. ");
       return $auth_type->changepwd_form($user);
    }
}

#-------------------------------------------------------------------------------
# Take a list of groups and make sure that the current remote user is a member
# of one of them.

__END__

=back