discourse-legacysite-perl/site/slowtwitch.com/cgi-bin/articles/admin/Links/Authenticate.pm
2024-06-17 21:49:12 +10:00

245 lines
8.5 KiB
Perl

# ==================================================================
# Gossamer Links - enhanced directory management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info : 087,071,086,086,085
# Revision : $Id: Authenticate.pm,v 1.34 2008/10/06 17:41:18 brewt Exp $
#
# Copyright (c) 2001 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
package Links::Authenticate;
# ==================================================================
use strict;
use Links qw/:objects/;
use GT::Session::SQL;
# This package lets you integrate Gossamer Links into another authentication
# system. You can do this by replacing the functions with your own
# code. Note: to return error results, simply set error => message in
# the passed in hash.
sub auth {
# -----------------------------------------------------------------------------
# Runs the request auth function through the plugin system.
#
shift if UNIVERSAL::isa($_[0], 'Links::Authenticate');
my ($auth, $args) = @_;
my $code = exists $Links::Authenticate::{"auth_$auth"}
? $Links::Authenticate::{"auth_$auth"}
: die "Invalid Authenticate method 'auth_$auth' called";
$PLG->dispatch("auth_$auth", $code, $args);
}
sub auth_init {
# -----------------------------------------------------------------------------
# This function is guaranteed to be called before any other authentication
# function, but may be called multiple times during one request.
#
return 1;
}
sub auth_add_user {
# -----------------------------------------------------------------------------
# This function is called whenever a user is added to the database. It takes a
# hash reference with Username and Password as input. If there is an error, set
# $args->{error} to the message.
#
my $args = shift;
return { Username => $args->{Username}, Password => $args->{Password} };
}
sub auth_del_user {
# -----------------------------------------------------------------------------
# This function is called whenever a user is trying to be deleted. It returns
# the username on success, or undef on failure.
#
my $args = shift;
return $args->{Username};
}
sub auth_valid_user {
# -----------------------------------------------------------------------------
# This function returns true if the user/pass combo is valid, 0/undef
# otherwise.
#
my $args = shift;
return int $DB->table('Users')->count({ Username => $args->{Username}, Password => $args->{Password} });
}
sub auth_valid_format {
# -----------------------------------------------------------------------------
# This function returns 1 if the user format is valid, undef otherwise.
#
my $args = shift;
my $user = $args->{Username};
return if length $user > 50 or $user !~ /^[\w\s\-\@\.]+$/;
return 1;
}
sub auth_change_pass {
# -----------------------------------------------------------------------------
# This function takes the username, old pass and new pass and returns 1 if
# successful, false otherwise.
#
my $args = shift;
return 1;
}
sub auth_get_pass {
# -----------------------------------------------------------------------------
# This function returns the password (if available) of a given user, undef
# otherwise.
#
my $args = shift;
my $user = $args->{Username};
my $pass = $DB->table('Users')->select(Password => { Username => $user })->fetchrow;
return $pass;
}
sub auth_get_user {
# -----------------------------------------------------------------------------
# This function returns user information for a given user, auto creating if it
# doesn't exist.
#
my $args = shift;
my $user = $args->{Username};
my $pass = $args->{Password};
my $db = $DB->table('Users');
my $user_r = $db->get($user);
if (!$user_r and $args->{auto_create}) {
$user_r->{Username} = $user;
$user_r->{Password} = defined $pass ? $pass : Links::Authenticate::auth('get_pass', { Username => $user });
$user_r->{Email} = $user . '@noemail.nodomain';
$user_r->{ReceiveMail} = 'No';
$user_r->{Password} = '' unless defined $user_r->{Password};
my $defaults = $db->default();
for (keys %$defaults) {
$user_r->{$_} = $defaults->{$_} unless exists $user_r->{$_};
}
$db->insert($user_r) or die "Unable to auto-create user: $user. Reason: $GT::SQL::error";
}
return $user_r;
}
sub auth_valid_session {
# -----------------------------------------------------------------------------
# This functions checks to see if the session is valid, and returns the
# username.
#
my $args = shift;
my $session_id = $IN->param('s') || $IN->cookie($CFG->{user_cookie_prefix} . 's') || return;
my $session;
unless ($session = GT::Session::SQL->new({
_debug => $CFG->{debug_level},
tb => $DB->table('Sessions'),
session_id => $session_id,
expires => $CFG->{user_session_length},
session_data => { sessions => $CFG->{user_sessions}, d => scalar($IN->param('d')) },
})) { # Possibly an expired session
GT::Session::SQL->new({
tb => $DB->table('Sessions'),
expires => $CFG->{user_session_length}
})->cleanup; # Clear out old sessions
return;
}
return $session->{info}->{session_user_id};
}
sub auth_create_session {
# -----------------------------------------------------------------------------
# This function creates a session, and prints the header and returns a hash
# reference with session => $id, and redirect => 0/1.
#
my $args = shift;
my $user = $args->{Username};
my $remember = ($CFG->{user_sessions} eq 'Cookies' and ($args->{Remember} or $IN->param('Remember')));
# Create a new session.
my $session = GT::Session::SQL->new({
_debug => $CFG->{debug_level},
tb => $DB->table('Sessions'),
session_user_id => $user,
session_data => { sessions => $CFG->{user_sessions}, d => scalar($IN->param('d')) },
expires => ($remember ? 0 : $CFG->{user_session_length}),
});
# Clear out old sessions.
$session->cleanup;
# Get session id
my $session_id = $session->{info}->{session_id};
# Now redirect to another URL and set cookies, or set URL string.
my $url = $IN->param('url');
my $redirect = 0;
if ($CFG->{user_sessions} eq 'Cookies') {
my $session_cookie = $IN->cookie(
-name => $CFG->{user_cookie_prefix} . 's',
-value => $session_id,
-path => '/',
-domain => $CFG->{user_cookie_domain},
-expires => ($remember ? '+10y' : '')
);
if ($url) {
print $IN->redirect(-force => 1, -cookie => [$session_cookie], -url => $url);
$redirect = 1;
}
else {
print $IN->header(-force => 1, -cookie => [$session_cookie]);
}
}
else {
# If URL sessions are used, then the user will be forced into dynamic mode
# since there's no way to pass around the session id with the static URLs.
if ($url) {
unless ($url =~ s/([;&\?]s=)([^&;]+)/$1$session_id/) {
$url .= ($url =~ /\?/ ? ';' : '?') . "s=$session_id";
}
unless ($url =~ /([;&\?]d=)([^&;]+)/) {
$url .= ($url =~ /\?/ ? ';' : '?') . "d=1";
}
print $IN->redirect($url);
$redirect = 1;
}
else {
$IN->param(s => $session_id);
$IN->param(d => 1);
print $IN->header();
}
}
return { session => $session_id, redirect => $redirect };
}
sub auth_delete_session {
# -----------------------------------------------------------------------------
# This function removes a session, returns 1 on success, undef on failure.
#
print $IN->header(
-cookie => $IN->cookie(
-name => $CFG->{user_cookie_prefix} . 's',
-value => '',
-path => '/',
-domain => $CFG->{user_cookie_domain},
-expires => '-1y'
)
);
my $session_id = $IN->cookie($CFG->{user_cookie_prefix} . 's') || $IN->param('s') || return;
my $session = GT::Session::SQL->new({
_debug => $CFG->{debug_level},
tb => $DB->table('Sessions'),
session_id => $session_id
}) or return;
# Delete the cookie
$session->delete or return;
1;
}
1;