User::Simple - Simple user sessions management

  $usr = User::Simple->new(db => $db,
                           [tbl => $user_table],
                           [durat => $duration],
                           [debug => $debug]);

  $ok = $usr->ck_session($session);
  $ok = $usr->ck_login($login, $passwd, [$no_sess]);
  $ok = $usr->set_passwd($new_pass);
  $usr->end_session;

  $id = $usr->id;
  $session = $usr->session;

  $otherattrib = $user->otherattrib
  $ok = $user->set_otherattrib($value);

  $usr = User::Simple->new(db => $db, [tbl => $table], [durat => $duration],
                           [debug => $debug]);

  $ok = $usr->ck_session($session);
  $ok = $usr->ck_login($login, $passwd, [$no_sess]);

  $ok = $usr->end_session;

  $ok = $usr->is_valid;

  $login = $usr->login;
  $id = $usr->id;

  $otherattrib = $user->otherattrib;

  $name = $user->name
  $login = $usr->login;

  $ok = $usr->set_passwd($new_pass);

  $ok = $usr->set_otherattrib($new_value);

use warnings;
use strict;

package User::Simple;

use Carp;
use Date::Calc qw(Today_and_Now Add_Delta_DHMS Delta_DHMS);
use Digest::MD5 qw(md5_hex);
use UNIVERSAL qw(isa);

our $AUTOLOAD;
our $VERSION = '1.43';

######################################################################
# Constructor/destructor

sub new {
    my ($class, $self, %init, $sth);
    $class = shift;
    %init = @_;

    # Verify we got the right arguments
    for my $key (keys %init) {
	next if $key =~ /^(db|debug|durat|tbl|adm_level)$/;
	carp "Unknown argument received: $key";
	return undef;
    }

    if (defined($init{adm_level})) {
	carp "adm_level is deprecated and will be dropped in future releases";
    }

    # Default values
    $init{tbl} = 'user_simple' unless defined $init{tbl};
    $init{durat} = 30 unless defined $init{durat};
    $init{debug} = 2 unless defined $init{debug};
    $init{adm_level} = 1 unless defined $init{adm_level};

    unless (defined($init{db}) and isa($init{db}, 'DBI::db')) {
	carp "Mandatory db argument must be a valid (DBI) database handle";
	return undef;
    }

    # In order to check if the table exists, check if it consists only of
    # valid characters and query for a random user
    unless ($init{tbl} =~ /^[\w\_]+$/) {
	carp "Invalid table name $init{tbl}";
	return undef;
    }
    unless ($sth=$init{db}->prepare("SELECT id, login FROM $init{tbl}") and
	    $sth->execute) {
	carp "Table $init{tbl} does not exist or has wrong structure";
	return undef;
    }

    unless ($init{durat} =~ /^\d+$/) {
	carp "Duration must be set to a positive integer";
	return undef;
    }

    unless ($init{debug} =~ /^\d+$/ and $init{debug} >= 0 and
	    $init{debug} <= 5) {
	carp "Debug level must be an integer between 0 and 5";
	return undef;
    }

    $self = { %init };
    bless $self, $class;

    $self->_debug(5, "$class object successfully created");

    return $self;
}

# As we are using autoload, better explicitly leave this as an empty sub
sub DESTROY {}

######################################################################
# User validation

sub ck_session {
    my ($self, $sess, $sth, $id, $exp);
    $self = shift;
    $sess = shift;

    $self->_debug(5, "Checking session $sess");

    # Before checking anything, make sure we don't retain an expired 
    # authorization
    $self->{id} = undef;

    unless ($sth = $self->{db}->prepare("SELECT id, session_exp 
                        FROM $self->{tbl} WHERE session = ?") and $sth->execute($sess) 
	    and ($id, $exp) = $sth->fetchrow_array) {
	# Session does not exist
	$self->_debug(3,"Inexistent session");
	return undef;
    }

    unless ($self->_ck_session_expiry($exp)) {
	$self->_debug(3,"Expired session");
	return undef;
    }

    $self->{id} = $id;
    $self->_refresh_session;
    $self->_debug(5,"Session successfully checked for ID $id");

    return $self->id;
}

sub ck_login {
    my ($self, $login, $pass, $no_sess, $crypted, $sth, $id, $db_pass);
    $self = shift;
    $login = shift;
    $pass = shift;
    $no_sess = shift;
 
    $self->_debug(5, "Verifying login: $login/$pass");

    # Before checking anything, make sure we don't retain an expired 
    # authorization
    $self->{id} = undef;

    # Is this login/password valid?
    unless ($sth = $self->{db}->prepare("SELECT id, passwd FROM $self->{tbl}
                        WHERE login = ?") and $sth->execute($login) and
	    ($id, $db_pass) = $sth->fetchrow_array) {
	$self->_debug(3,"Invalid login $login");
	return undef;
    }

    $crypted = md5_hex($pass, $id);
    if ($crypted ne $db_pass) {
	$self->_debug(3,"Invalid password ($crypted)");
	return undef;
    }

    $self->_debug(5, "login/password verified successfully");

    # User authenticated. Now create the session - Use a MD5 hash of the
    # current timestamp. Skip this step if $no_sess is true.
    if ($no_sess) {
	$self->_debug(3, "Not touching session");

    } else {
	my $salt = _session_salt();
	unless ($sth = $self->{db}->prepare("UPDATE $self->{tbl} SET 
                                session = ? WHERE id = ?") and 
		$sth->execute(md5_hex(join('-', $salt, Today_and_Now)), $id)) {
	    $self->_debug(1,'Could not create user session');
	    return undef;
	}
    }

    # Populate the object with the user's data
    $self->{id} = $id;
    $self->_refresh_session;
    $self->_debug(5,"Login successfully checked for ID $id");
    return $self->id;
}

sub end_session {
    my ($self, $sth);
    $self = shift;
    $self->_debug(5, 'Closing session for ' .$self->id);

    return undef unless ($self->id);

    $sth = $self->{db}->prepare("UPDATE $self->{tbl} SET session = NULL,
                session_exp = NULL WHERE id = ?");
    $sth->execute($self->id);

    $self->{id} = undef;

    return 1;
}

######################################################################
# Accessors, mutators

sub is_valid { 
    my $self = shift; 
    return $self->id ? 1 : 0; 
}

sub id { 
    my $self = shift; 
    return $self->{id}; 
}

sub set_passwd {
    my ($self, $pass, $crypted, $sth);
    $self = shift;
    $pass = shift;

    return undef unless ($self->id and $pass);

    $crypted = md5_hex($pass, $self->id);

    $self->_debug(5, sprintf('Setting %s\'s password to %s (%s)', 
			     $self->login, $pass, $crypted));

    unless ($sth = $self->{db}->prepare("UPDATE $self->{tbl} SET passwd = ? 
                        WHERE id = ?") and 
	    $sth->execute($crypted, $self->id)) {
	$self->_debug(1,"Could not set the requested password");
	return undef;
    }

    return 1;
}

# Other attributes are retreived via AUTOLOAD
sub AUTOLOAD {
    my ($self, $newval, $name, $myclass, $set, $raise_error, $value, $valid);
    $self = shift;
    $newval = shift;
    $name = $AUTOLOAD;

    # Autoload gives us the fully qualified method name being called - Get our
    # class name and strip it off $name. And why the negated index? Just to be
    # sure we don't discard what we don't want to - Either it is at the
    # beginning, or we don't discard a thing
    $name = $AUTOLOAD;
    $myclass = ref($self);
    if (!index($name, $myclass)) {
	# Substitute in $name from the beginning (0) to the length of the class
	# name plus two (that is, strip the '::') with nothing.
	substr($name,0,length($myclass)+2,'');
    }

    # Is the user requesting a value or modifying it?
    $set = 0;
    if ($name =~ /^set_(.+)$/) {
	$set = 1;
	$name = $1;
    }

    $self->_debug(5, sprintf('%s for autoloaded field "%s"', 
			     ($set ? 'Modifying' : 'Querying'), $name));

    # We require the name to consist only of alphanumeric characters or 
    # underscores
    $name =~ /^[\w\d\_]+$/ or croak "Invalid field name '$name'";

    # Store the RaiseError, as we don't want to change state outside our
    # scope
    $raise_error = $self->{db}{RaiseError};

    # In order to check if $name is a valid field in the DB, query for it -
    # but do it inside an eval, as we might get killed!
    eval {
	my ($sth);
	$self->{db}{RaiseError} = 1;

	if ($set) {
	    if ($name =~ /^(session|login|adm_)/) {
		# The field is valid, the access is not - $valid will be used
		# to decide how to die.
		$valid = 1;
		die "Invalid field $name";
	    }

	    $sth = $self->{db}->prepare("UPDATE $self->{tbl} SET $name = ?
                                WHERE id = ?");
	    $sth->execute($newval, $self->id);

	    # We should return success/failure - This is a good and easy way to
	    # check - although, yes, it's a second call to AUTOLOAD.
	    $value = ($self->$name eq $newval) ? 1 : 0;
	} else {
	    $sth = $self->{db}->prepare("SELECT $name FROM $self->{tbl} WHERE
                                id = ?");
	    $sth->execute($self->id);
	    ($value) = $sth->fetchrow_array;
	}
    };
    if ($@) {
	# Yes, we will croak and die - But this call might be also trapped.
	# Restore the RaiseError anyway.
	$self->{db}{RaiseError} = $raise_error;
	if ($valid) {
	    croak "Access to '$name' restricted";
	} 
	croak "Field '$name' does not exist in the User::Simple table!";
    }

    # Restore the RaiseError
    $self->{db}{RaiseError} = $raise_error;

    return $value;
}

######################################################################
# Private methods

# Warns the message received as the second parameter if the debug level is
# >= the first parameter
sub _debug {
    my ($self, $level, $text);
    $self = shift;
    $level = shift;
    $text = shift;

    carp $text if $self->{debug} >= $level;
    return 1;
}

# Checks if a session's expiration time is still in the future.
# Receives as its only parameter the expiration time as a string as stored in
# the database (this is, year-month-day-hour-minute-second). Returns 1 if
# the session is still valid, 0 if it has expired.
sub _ck_session_expiry {
    my ($self, $exp, @exp, @now, @diff, $diff);
    $self = shift;
    $exp = shift;

    return undef unless $exp;
    @exp = split (/-/, $exp);
    @now = Today_and_Now();

    if (scalar @exp != 6) {
	$self->_debug(1,"Invalid session format");
	return undef;
    }

    @diff = Delta_DHMS(@now, @exp);
    $diff = ((shift(@diff) * 24 + shift(@diff)) * 60 + 
	     shift(@diff)) * 60 + shift(@diff);

    return ($diff > 0) ? 1 : 0;
}

sub _refresh_session {
    my ($self, $sth, $new_exp);
    $self = shift;

    # Do we have an identified user?
    unless ($self->id) {
	$self->_debug(3,"Cannot refresh session: User not yet identified");
	return undef;
    }

    # The new expiration time is set to the current timestamp plus 
    # $self->{durat} minutes
    $new_exp = join('-', Add_Delta_DHMS(Today_and_Now, 
					0, 0, $self->{durat}, 0));

    unless ($sth = $self->{db}->prepare("UPDATE $self->{tbl} SET 
                        session_exp = ? WHERE id = ?") and
	    $sth->execute($new_exp, $self->id)) {
	$self->_debug(1,"Couldn't refresh session.");
	return undef;
    }
}

# Generates a random, printable (ASCII 46-126), 10 character long salt
# to mix in the session generation.
sub _session_salt {
    join("", map { chr(rand()*78 + 46) } (0..10))
}


1;