view release on metacpan or  search on metacpan

AuthCookiePAM.pm  view on Meta::CPAN

#===============================================================================
#
# Apache::AuthCookiePAM
#
# An AuthCookie module backed by a PAM.
#
# Copyright (C) 2002 SF Interactive.
#
# Author:  Vandana Awasthi
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
# 
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
# 
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#===============================================================================

package Apache::AuthCookiePAM;

use strict;
use 5.004;
use vars qw( $VERSION );
( $VERSION ) = '$Revision: 1.0 $' =~ /([\d.]+)/;

use Apache;
use Apache::Table;
use Apache::Constants qw(:common M_GET FORBIDDEN REDIRECT);
use Apache::AuthCookie::Util;
use Apache::Util qw(escape_uri);
use Apache::AuthCookie;
use Authen::PAM;
use vars qw( @ISA );
@ISA = qw( Apache::AuthCookie );

use Apache::File;
use Digest::MD5 qw( md5_hex );
use Date::Calc qw( Today_and_Now Add_Delta_DHMS );
# Also uses Crypt::CBC if you're using encrypted cookies.

#===============================================================================
# F U N C T I O N   D E C L A R A T I O N S
#===============================================================================

sub _log_not_set($$);
sub _dir_config_var($$);
sub _config_vars($);
sub _now_year_month_day_hour_minute_second();
sub _percent_encode($);
sub _percent_decode($);

sub authen_cred($$\@);
sub authen_ses_key($$$);
sub group($$\@);

#===============================================================================
# P A C K A G E   G L O B A L S
#===============================================================================

use vars qw( %CIPHERS );
# Stores Cipher::CBC objects in $CIPHERS{ idea:AuthName },
# $CIPHERS{ des:AuthName } etc.

use vars qw( %SECRET_KEYS );
# Stores secret keys for MD5 checksums and encryption for each auth realm in
# $SECRET_KEYS{ AuthName }.

#===============================================================================
# S E R V E R   S T A R T   I N I T I A L I Z A T I O N
#===============================================================================

BEGIN {
	my (@keyfile_vars, $keyfile_var);
	@keyfile_vars = grep {
		$_ =~ /PAM_SecretKeyFile$/
	} keys %{ Apache->server->dir_config() };
	
	foreach  $keyfile_var ( @keyfile_vars ) {
		my $keyfile ;
		$keyfile = Apache->server->dir_config( $keyfile_var );
		my $auth_name ; $auth_name = $keyfile_var;
		
		$auth_name =~ s/PAM_SecretKeyFile$//;
		unless ( open( KEY, "<$keyfile" ) ) {
			Apache::log_error( "Could not open keyfile for $auth_name in file $keyfile" );
		} else {
			$SECRET_KEYS{ $auth_name } = <KEY>;
		close KEY;
		}
	}

AuthCookiePAM.pm  view on Meta::CPAN

	# If we're being paranoid about timing-out long-lived sessions,
	# check that the issue time + the current (server-set) session lifetime
	# hasn't passed too (in case we issued long-lived session tickets
	# in the past that we want to get rid of). *** DEBUG ***
	# if ( lc $c{ PAM_AlwaysUseCurrentSessionLifetime } eq 'on' ) 

	# They must be okay, so return the user.
	return $user;
}


sub changepwd_form 
{  
  my $self; $self = shift;
  my $user; $user = shift;

  my $r; $r = Apache->request or die "no request";
  $r->log_error(" $self ");
  $r->subprocess_env("AuthenChangePwdUser","$user");
  my $auth_name; $auth_name = $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';

  # There should be a PerlSetVar directive that gives us the URI of
  # the script to execute for the login form.
  
  my $script;
  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;