view release on metacpan or  search on metacpan

SecSess/DBI.pm  view on Meta::CPAN

	## read login info from file
	unless ($fh = IO::File->new($file)) {
		die "Cannot open DBI login file '$file'\n";
	}
	chomp($self->{dbistr} = <$fh>); 
	chomp($self->{dbiuser} = <$fh>); 
	chomp($self->{dbipw} = <$fh>);
	unless ($self->{dbistr} && $self->{dbiuser} && $self->{dbipw}) { 
		die "DBI login file has missing data."; 
	}
}

## initiate or restart the database connection
sub refresh_dbh {
	my $self = shift;

	unless (ref($self->{dbh}) && $self->{dbh}->ping) {
		$self->{dbh} = DBI->connect(
			$self->{dbistr}, $self->{dbiuser}, $self->{dbipw}
		) || die "WARNING: cannot connect to database.";
	}
}

#
# query methods
#

## is the user ID valid (whether or not enabled)
sub is_valid_user {
	my $self = shift;
	my($uid) = @_;

	unless ($self->get_user_record($uid)) { return 0; }
	return 1;
}

## retrieve user's status field
sub get_user_status {
	my $self = shift;
	my($uid) = @_;

	my $rec = $self->get_user_record($uid);
	unless ($rec) { return 'unknown'; }
	return $rec->{status};
}

## get the full name
sub get_full_name {
	my $self = shift;
	my($uid) = @_;

	my $rec = $self->get_user_record($uid);
	unless ($rec) { return undef; }
	return $rec->{name};
}

## get UNIX-style password hash
sub get_pwhash {
	my $self = shift;
	my($uid) = @_;
	return $self->get_stored_token($uid, 'unixpw');
}

## get stored token 
sub get_stored_token {
	my $self = shift;
	my($uid, $authid) = @_;
	my($uasth, $token);

	# set up DB query statement
	$self->refresh_dbh;
	$uasth = $self->{dbh}->prepare(<<'ENDSQL');
		SELECT token
		FROM userauthen
		WHERE usrid = ? AND authid = ?
ENDSQL
	$uasth->execute($uid, $authid);
	
	# process query output
	($token) = $uasth->fetchrow_array;
	$uasth->finish;

	return $self->dbunquote($token);
}

## valid a user/password against database
sub validate_user_pass {
	my $self = shift;
	my($uid, $pw) = @_;

	## this little extra step is necessary for crypt() to work
	unless ($uid && $pw) { return 'empty'; }
	my $pwhash = $self->get_pwhash($uid);

	return $self->validate_stored_token($uid, crypt($pw, $pwhash), 'unixpw');
}

## validate a general stored token (eg, password, PIN, etc)
sub validate_stored_token {
	my $self = shift;
	my($uid, $token, $authid) = @_;
	my($status);

	unless ($uid) { return 'empty'; } # empty uid argument
	$status = $self->get_user_status($uid);
	unless ($status eq 'enabled') { return $status; } # disabled or unknown
	unless ($token) { return 'empty'; } # empty token argument
	unless ($token eq $self->get_stored_token($uid, $authid)) {
		$self->note_auth_failure($uid, $authid);
		return 'again'; # 'again' means 'wrong' but may be visible in URL
	}
	$self->note_auth_success($uid, $authid);
	return 'OK';
}

## protect against online guessing attacks
sub note_auth_failure {
	my $self = shift;
	my($uid, $authid) = @_;
	my($asth, $maxfail, $uasth, $failcount, $usth);

	## determine if we must count failures at all
	$self->refresh_dbh;
	$asth = $self->{dbh}->prepare(<<'ENDSQL');
		SELECT maxfail
		FROM authens
		WHERE authid = ?
ENDSQL
	$asth->execute($authid);
	$maxfail = $asth->fetchrow_array;
	$asth->finish;
	unless ($maxfail) { return; }

	## get current failure count
	$uasth = $self->{dbh}->prepare(<<'ENDSQL');
		SELECT failcount
		FROM userauthen
		WHERE usrid = ? AND authid = ?
ENDSQL
	$uasth->execute($uid, $authid);
	$failcount = $uasth->fetchrow_array;
	$uasth->finish;

	if (++$failcount <= $maxfail) { # bump count
		$uasth = $self->{dbh}->prepare(<<'ENDSQL');
			UPDATE userauthen
			SET failcount = ?
			WHERE usrid = ? AND authid = ?
ENDSQL
		$uasth->execute($failcount, $uid, $authid);
		$uasth->finish;
		return;
	}

	## warn of impending doom

SecSess/DBI.pm  view on Meta::CPAN

		FROM authens
		WHERE authid = ?
ENDSQL
	$asth->execute($authid);
	$maxfail = $asth->fetchrow_array;
	$asth->finish;
	unless ($maxfail) { return; }

	## if we're counting consecutive failures, we must reset the count
	$uasth = $self->{dbh}->prepare(<<'ENDSQL');
		UPDATE userauthen
		SET failcount = ?
		WHERE usrid = ? AND authid = ?
ENDSQL
	$uasth->execute(0, $uid, $authid);
	$uasth->finish;
}

## (re)enable a user and reset failure counts
sub enable_user {
	my $self = shift;
	my($uid) = @_;
	my($usth, $uasth);

	## set status field
	$usth = $self->{dbh}->prepare(<<'ENDSQL');
		UPDATE users
		SET status = ?
		WHERE usrid = ?
ENDSQL
	$usth->execute('enabled', $uid);
	$usth->finish;

	## reset *all* failure counts at once
	$uasth = $self->{dbh}->prepare(<<'ENDSQL');
		UPDATE userauthen
		SET failcount = ?
		WHERE usrid = ?
ENDSQL
	$uasth->execute(0, $uid);
	$uasth->finish;
}

## change user's password
sub change_password {
	my $self = shift;
	my($uid, $pw) = @_;
	my(@salt, $hash, $sth);

	# prepare new hash
	@salt = ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand(64), rand(64)];
	$hash = crypt($pw, join('', @salt));

	# prepare set statement
	$self->refresh_dbh;
	$sth = $self->{dbh}->prepare(<<'ENDSQL');
		UPDATE userauthen
		SET token = ?
		WHERE usrid = ? AND authid = ? 
ENDSQL
	$sth->execute($self->dbquote($hash), $uid, 'unixpw');
	$sth->finish;
}

## return list of groups to which user belongs
sub get_groups {
	my $self = shift;
	my($uid) = @_;
	my($h);
	unless ($h = $self->get_groups_hash($uid)) { return undef; }
	return keys %$h;
}

## extraordinary privileges (in group w/ ID 'super' or 'admin')
sub is_super_user {
	my $self = shift;
	my($uid) = @_;
	return scalar(grep(/^super$/, $self->get_groups($uid)));
}
sub is_administrator {
	my $self = shift;
	my($uid) = @_;
	return scalar(grep(/^admin$/, $self->get_groups($uid)));
}

## return user's default group
sub get_default_group {
	my $self = shift;
	my($uid) = @_;

	my $rec = $self->get_user_record($uid);
	unless ($rec) { return undef; }
	return $rec->{grpid};
}

## get user record
sub get_user_record {
	my $self = shift;
	my($uid) = @_;
	my($usth, $rec);

	# fetch record from users relation
	$self->refresh_dbh;
	$usth = $self->{dbh}->prepare(<<'ENDSQL');
		SELECT *
		FROM users
		WHERE usrid = ?
ENDSQL
	$usth->execute($uid);
	$rec = $usth->fetchrow_hashref;
	$usth->finish;
	unless ($rec) { return undef; }

	# unquote the values
	for (keys %{$rec}) {
		$rec->{$_} = $self->dbunquote($rec->{$_});
	}

	return $rec;
}