view release on metacpan or  search on metacpan

lib/CGI/Application/Plugin/Authentication.pm  view on Meta::CPAN

        # Fetch the configuration parameters for the store
        my ($store_module, @store_config);
        ($store_module, @store_config) = @{ $config->{STORE} } if $config->{STORE} && ref $config->{STORE} eq 'ARRAY';
        if (!$store_module) {
            # No STORE configuration was provided
            if ($self->_cgiapp->can('session') && UNIVERSAL::isa($self->_cgiapp->session, 'CGI::Session')) {
                # The user is already using the Session plugin
                ($store_module, @store_config) = ( 'Session' );
            } else {
                # Fall back to the Cookie Store
                ($store_module, @store_config) = ( 'Cookie' );
            }
        }

        # Load the the class for this store
        my $store_class = _find_deligate_class(
            'CGI::Application::Plugin::Authentication::Store::' . $store_module,
            $store_module
        ) || die "Store $store_module can not be found";

        # Create the store object
        $self->{store} = $store_class->new( $self, @store_config )
          || die "Could not create new $store_class object";
    }

    return $self->{store};
}

=head2 initialize

This does most of the heavy lifting for the Authentication plugin.  It will
check to see if the user is currently attempting to login by looking for the
credential form fields in the query object.  It will load the required driver
objects and authenticate the user.  It is OK to call this method multiple times
as it checks to see if it has already been executed and will just return
without doing anything if called multiple times.  This allows us to call
initialize as late as possible in the request so that no unnecessary work is
done.

The user will be logged out by calling the C<logout()> method if the login
session has been idle for too long, if it has been too long since the last
login, or if the login has timed out.  If you need to know if a user was logged
out because of a time out, you can call the C<is_login_timeout> method.

If all goes well, a true value will be returned, although it is usually not
necessary to check.

This function will initiate a session or cookie if one has not been created already.

=cut

sub initialize {
    my $self = shift;
    return 1 if $self->{initialized};

    # It would seem to make more sense to do this at the /end/ of the routine
    # but that causes an infinite loop. 
    $self->{initialized} = 1;

    if (UNIVERSAL::can($self->_cgiapp, 'devpopup')) {
        $self->_cgiapp->add_callback( 'devpopup_report', \&_devpopup_report );
    }

    my $config = $self->_config;

    # See if the user is trying to log in
    #  We do this before checking to see if the user is already logged in, since
    #  a logged in user may want to log in as a different user.
    my $field_names = $config->{CREDENTIALS} || [qw(authen_username authen_password)];

    my $query = $self->_cgiapp->query;
    my @credentials = map { scalar $query->param($_) } @$field_names;
    if ($credentials[0]) {
        # The user is trying to login
        # make sure if they are already logged in, that we log them out first
        my $store = $self->store;
        $store->clear if $store->fetch('username');
        foreach my $driver ($self->drivers) {
            if (my $username = $driver->verify_credentials(@credentials)) {
                # This user provided the correct credentials
                # so save this new login in the store
                my $now = time();
                $store->save( username => $username,  login_attempts => 0, last_login => $now, last_access => $now );
                $self->{is_new_login} = 1;
                # See if we are remembering the username for this user
                my $login_config = $config->{LOGIN_FORM} || {};
                if ($login_config->{REMEMBERUSER_OPTION} && scalar $query->param('authen_rememberuser')) {
                    my $cookie = $query->cookie(
                        -name   => $login_config->{REMEMBERUSER_COOKIENAME} || 'CAPAUTHTOKEN',
                        -value  => $username,
                        -expiry => '10y',
                    );
                    $self->_cgiapp->header_add(-cookie => [$cookie]);
                }
                last;
            }
        }
        unless ($self->username) {
            # password mismatch - increment failed login attempts
            my $attempts = $store->fetch('login_attempts') || 0; 
            $store->save( login_attempts => $attempts + 1 );
        }

        $config->{POST_LOGIN_CALLBACK}->($self->_cgiapp) 
          if($config->{POST_LOGIN_CALLBACK});
    }

    # Check the user name last of all because only this check might create a session behind the scenes.
    # In other words if a website works perfectly well without authentication,
    # then adding a protected run mode should not add session to the unprotected modes.
    # See 60_parsimony.t for the test.
    if ($config->{LOGIN_SESSION_TIMEOUT} && !$self->{is_new_login} && $self->username) {
        # This is not a fresh login, and there are time out rules, so make sure the login is still valid
        if ($config->{LOGIN_SESSION_TIMEOUT}->{IDLE_FOR} && time() - $self->last_access >= $config->{LOGIN_SESSION_TIMEOUT}->{IDLE_FOR}) {
            # this login has been idle for too long
            $self->{is_login_timeout} = 1;
            $self->logout;
        } elsif ($config->{LOGIN_SESSION_TIMEOUT}->{EVERY} && time() - $self->last_login >=  $config->{LOGIN_SESSION_TIMEOUT}->{EVERY}) {
            # it has been too long since the last login
            $self->{is_login_timeout} = 1;
            $self->logout;

lib/CGI/Application/Plugin/Authentication.pm  view on Meta::CPAN

    my $destination = "";
    my $regexp = $self->_config->{DETAINT_URL_REGEXP};
    if ($query->self_url =~ /$regexp/) {
        $destination = $1;
    }
    return $destination;
}

sub _detaint_url {
    my $self = shift;
    my $query       = $self->_cgiapp->query;
    my $regexp = $self->_config->{DETAINT_URL_REGEXP};
    my $url = "";
    if ($query->url( -absolute => 1, -path_info => 1 ) =~ /$regexp/) {
        $url = $1;
    }
    return $url;
}

sub _detaint_username {
    my $self = shift;
    my $username = shift;
    my $cookiename = shift;
    my $query       = $self->_cgiapp->query;
    my $regexp = $self->_config->{DETAINT_USERNAME_REGEXP};
    my $username_value = "";
    if ((scalar $query->param($username) || $query->cookie($cookiename) || '') =~ /$regexp/) {
        $username_value = $1;
    }
    return $username_value;
}
 
###
### Helper methods
###

sub _cgiapp {
    return $_[0]->{cgiapp};
}

sub _find_deligate_class {
    foreach my $class (@_) {
        $class->require && return $class;
    }
    return;
}

sub _config {
    my $self  = shift;
    my $class = ref $self ? ref $self : $self;
    my $config;
    if ( ref $self ) {
        $config = $self->{__CAP_AUTHENTICATION_CONFIG} ||= $__CONFIG{$class} || {};
    } else {
        $__CONFIG{$class} ||= {};
        $config = $__CONFIG{$class};
    }
    return $config;
}

sub _devpopup_report {
    my $cgiapp = shift;
    my @list;
    my $self=$cgiapp->authen;
    if ($self->username) {
        push @list,['username',$self->username];
    }
    my $config = $self->_config;
    my $field_names = $config->{CREDENTIALS} || [qw(authen_username authen_password)];
    my $query = $cgiapp->query;
    foreach my $name (@$field_names) {
        push @list, [ $name, scalar $query->param($name) || ''];
    }
    my $r=0;
    my $text = join $/, map {
                    $r=1-$r;
                    qq(<tr class="@{[$r?'odd':'even']}"><td valign="top">$_->[0]</td><td>$_->[1]</td></tr>)
                    }
                    @list;
    $cgiapp->devpopup->add_report(
        title   => 'Authentication',
        summary => '',
        report  => qq(
            <style type="text/css">
              tr.even{background-color:#eee}
            </style>
            <div style="font-size: 80%">
              <table>
                <thead><tr><th>Parameter</th><th>Value</th></tr></thead>
                <tbody>$text</tbody>
              </table>
            </div>
        ),
    );
}

###
### Helper functions
###

sub _time_to_seconds {
    my $time = shift;
    return unless defined $time;

    # Most of this function is borrowed from CGI::Util v1.4 by Lincoln Stein
    my (%mult) = (
        's' => 1,
        'm' => 60,
        'h' => 60 * 60,
        'd' => 60 * 60 * 24,
        'w' => 60 * 60 * 24 * 7,
        'M' => 60 * 60 * 24 * 30,
        'y' => 60 * 60 * 24 * 365
    );
    # format for time can be in any of the forms...
    # "180" -- in 180 seconds
    # "180s" -- in 180 seconds
    # "2m" -- in 2 minutes
    # "12h" -- in 12 hours
    # "1d"  -- in 1 day
    # "4w"  -- in 4 weeks
    # "3M"  -- in 3 months
    # "2y"  -- in 2 years
    my $offset;
    if ( $time =~ /^([+-]?(?:\d+|\d*\.\d*))([smhdwMy]?)$/ ) {
        return if (!$2 || $2 eq 's') && $1 != int $1; # 
        $offset = int ( ( $mult{$2} || 1 ) * $1 );
    }
    return $offset;
}


=head1 EXAMPLE

In a CGI::Application module:

  use base qw(CGI::Application);
  use CGI::Application::Plugin::AutoRunmode;
  use CGI::Application::Plugin::Session;
  use CGI::Application::Plugin::Authentication;