L<FS::access_user> - Employees / internal users
+L<FS::access_user_session> - Access sessions
+
L<FS::access_user_pref> - Employee preferences
L<FS::access_group> - Employee groups
use base qw( Apache2::AuthCookie );
use strict;
-use Digest::SHA qw( sha1_hex );
-use FS::UID qw( adminsuidsetup );
-
-my $secret = "XXX temporary"; #XXX move to a DB session with random number as key
+use FS::UID qw( adminsuidsetup preuser_setup );
+use FS::CurrentUser;
my $module = 'legacy'; #XXX i am set in a conf somehow? or a config file
sub authen_cred {
my( $self, $r, $username, $password ) = @_;
- if ( _is_valid_user($username, $password) ) {
- warn "authenticated $username from ". $r->connection->remote_ip. "\n";
- adminsuidsetup($username);
- my $session_key =
- $username . '::' . sha1_hex( $username, $secret );
- return $session_key;
- } else {
- warn "failed authentication $username from ". $r->connection->remote_ip. "\n";
+ unless ( _is_valid_user($username, $password) ) {
+ warn "failed auth $username from ". $r->connection->remote_ip. "\n";
+ return undef;
}
- return undef; #?
+ warn "authenticated $username from ". $r->connection->remote_ip. "\n";
+ adminsuidsetup($username);
+
+ FS::CurrentUser->new_session;
+
}
sub _is_valid_user {
}
sub authen_ses_key {
- my( $self, $r, $session_key ) = @_;
+ my( $self, $r, $sessionkey ) = @_;
+
+ preuser_setup();
- my ($username, $mac) = split /::/, $session_key;
+ my $curuser = FS::CurrentUser->load_user_session( $sessionkey );
- if ( sha1_hex( $username, $secret ) eq $mac ) {
- adminsuidsetup($username);
- return $username;
- } else {
- warn "bad session $session_key from ". $r->connection->remote_ip. "\n";
+ unless ( $curuser ) {
+ warn "bad session $sessionkey from ". $r->connection->remote_ip. "\n";
+ return undef;
}
- return undef;
+ $curuser->username;
}
package FS::CurrentUser;
-use vars qw($CurrentUser $upgrade_hack);
+use vars qw($CurrentUser $CurrentSession $upgrade_hack);
#not at compile-time, circular dependancey causes trouble
#use FS::Record qw(qsearchs);
=head1 NAME
-FS::CurrentUser - Package representing the current user
+FS::CurrentUser - Package representing the current user (and session)
=head1 SYNOPSIS
=head1 DESCRIPTION
+=head1 CLASS METHODS
+
+=over 4
+
+=item load_user USERNAME
+
+Sets the current user to the provided username
+
=cut
sub load_user {
$CurrentUser;
}
+=item new_session
+
+Creates a new session for the current user and returns the session key
+
+=cut
+
+use vars qw( @saltset );
+@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '+' , '/' );
+
+sub new_session {
+ my( $class ) = @_;
+
+ #not the best thing in the world...
+ eval "use FS::access_user_session;";
+ die $@ if $@;
+
+ my $sessionkey = join('', map $saltset[int(rand(scalar @saltset))], 0..39);
+
+ my $access_user_session = new FS::access_user_session {
+ 'sessionkey' => $sessionkey,
+ 'usernum' => $CurrentUser->usernum,
+ 'start_date' => time,
+ };
+ my $error = $access_user_session->insert;
+ die $error if $error;
+
+ return $sessionkey;
+
+}
+
+=item load_user_session SESSION_KEY
+
+Sets the current user via the provided session key
+
+=cut
+
+sub load_user_session {
+ my( $class, $sessionkey ) = @_;
+
+ #not the best thing in the world...
+ eval "use FS::Record qw(qsearchs);";
+ die $@ if $@;
+ eval "use FS::access_user_session;";
+ die $@ if $@;
+
+ $CurrentSession = qsearchs('access_user_session', {
+ 'sessionkey' => $sessionkey,
+ #XXX check for timed out but not-yet deleted sessions here
+ }) or return '';
+
+ $CurrentSession->touch_last_date;
+
+ $CurrentUser = $CurrentSession->access_user;
+
+}
+
=head1 BUGS
-Creepy crawlies
+Minimal docs
=head1 SEE ALSO
my $tables_hashref_torrus = tables_hashref_torrus();
- #create history tables (false laziness w/create-history-tables)
+ #create history tables
foreach my $table (
- grep { ! /^clientapi_session/
+ grep { ! /^(clientapi|access_user)_session/
&& ! /^h_/
&& ! /^log(_context)?$/
&& ! $tables_hashref_torrus->{$_}
'index' => [],
},
+ 'access_user_session' => {
+ 'columns' => [
+ 'sessionnum', 'serial', '', '', '', '',
+ 'sessionkey', 'varchar', '', $char_d, '', '',
+ 'usernum', 'int', '', '', '', '',
+ 'start_date', @date_type, '', '',
+ 'last_date', @date_type, '', '',
+ ],
+ 'primary_key' => 'sessionnum',
+ 'unique' => [ [ 'sessionkey' ] ],
+ 'index' => [],
+ },
+
'access_user' => {
'columns' => [
'usernum', 'serial', '', '', '', '',
@ISA = qw(Exporter);
@EXPORT_OK = qw( checkeuid checkruid cgi setcgi adminsuidsetup forksuidsetup
+ preuser_setup
getotaker dbh datasrc getsecrets driver_name myconnect
use_confcompat
);
Cleans the environment.
Make sure the script is running as freeside, or setuid freeside.
Opens a connection to the database.
-Swaps real and effective UIDs.
Runs any defined callbacks (see below).
Returns the DBI database handle (usually you don't need this).
$user = $1;
}
- $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
+ env_setup();
+
+ db_setup($olduser);
+
+ callback_setup();
+
+ warn "$me forksuidsetup loading user\n" if $DEBUG;
+ FS::CurrentUser->load_user($user);
+
+ $dbh;
+}
+
+sub preuser_setup {
+ $dbh->disconnect if $dbh;
+ env_setup();
+ db_setup();
+ callback_setup();
+ $dbh;
+}
+
+sub env_setup {
+
+ $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/bin';
$ENV{'SHELL'} = '/bin/sh';
$ENV{'IFS'} = " \t\n";
$ENV{'CDPATH'} = '';
$ENV{'ENV'} = '';
$ENV{'BASH_ENV'} = '';
+}
+
+sub db_setup {
+ my $olduser = shift;
+
croak "Not running uid freeside (\$>=$>, \$<=$<)\n" unless checkeuid();
warn "$me forksuidsetup connecting to database\n" if $DEBUG;
die "NO CONFIGURATION TABLE FOUND" unless $FS::Schema::setup_hack;
}
+
+}
+
+sub callback_setup {
+
unless ( $callback_hack ) {
warn "$me calling callbacks\n" if $DEBUG;
foreach ( keys %callback ) {
warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
}
- warn "$me forksuidsetup loading user\n" if $DEBUG;
- FS::CurrentUser->load_user($user);
-
- $dbh;
}
sub myconnect {
--- /dev/null
+package FS::access_user_session;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearchs ); # qsearch );
+use FS::access_user;
+
+=head1 NAME
+
+FS::access_user_session - Object methods for access_user_session records
+
+=head1 SYNOPSIS
+
+ use FS::access_user_session;
+
+ $record = new FS::access_user_session \%hash;
+ $record = new FS::access_user_session { 'column' => 'value' };
+
+ $error = $record->insert;
+
+ $error = $new_record->replace($old_record);
+
+ $error = $record->delete;
+
+ $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::access_user_session object represents a backoffice web session.
+FS::access_user_session inherits from FS::Record. The following fields are
+currently supported:
+
+=over 4
+
+=item sessionnum
+
+Database primary key
+
+=item sessionkey
+
+Session key
+
+=item usernum
+
+Employee (see L<FS::access_user>)
+
+=item start_date
+
+Session start timestamp
+
+=item last_date
+
+Last session activity timestamp
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new session. To add the session to the database, see L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to. You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'access_user_session'; }
+
+=item insert
+
+Adds this record to the database. If there is an error, returns the error,
+otherwise returns false.
+
+=item delete
+
+Delete this record from the database.
+
+=item replace OLD_RECORD
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+=item check
+
+Checks all fields to make sure this is a valid session. If there is
+an error, returns the error, otherwise returns false. Called by the insert
+and replace methods.
+
+=cut
+
+sub check {
+ my $self = shift;
+
+ my $error =
+ $self->ut_numbern('sessionnum')
+ || $self->ut_text('sessionkey')
+ || $self->ut_foreign_key('usernum', 'access_user', 'usernum')
+ || $self->ut_number('start_date')
+ || $self->ut_numbern('last_date')
+ ;
+ return $error if $error;
+
+ $self->last_date( $self->start_date ) unless $self->last_date;
+
+ $self->SUPER::check;
+}
+
+=item access_user
+
+Returns the employee (see L<FS::access_user>) for this session.
+
+=cut
+
+sub access_user {
+ my $self = shift;
+ qsearchs('access_user', { 'usernum' => $self->usernum });
+}
+
+=item touch_last_date
+
+=cut
+
+sub touch_last_date {
+ my $self = shift;
+ my $old_last_date = $self->last_date;
+ $self->last_date(time);
+ return if $old_last_date >= $self->last_date;
+ my $error = $self->replace;
+ die $error if $error;
+}
+
+=item logout
+
+=cut
+
+sub logout {
+ my $self = shift;
+ my $error = $self->delete;
+ die $error if $error;
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
t/part_pkg_usage.t
FS/cdr_cust_pkg_usage.pm
t/cdr_cust_pkg_usage.t
+FS/access_user_session.pm
+t/access_user_session.t
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::access_user_session;
+$loaded=1;
+print "ok 1\n";
my %error = (
'no_cookie' => '', #First login, don't display an error
- 'bad_cookie' => 'Bad Cookie', #timed out? server reboot?
+ 'bad_cookie' => 'Bad Cookie', #timed out?
'bad_credentials' => 'Incorrect username / password',
- 'logout' => 'You have been logged out.',
+ #'logout' => 'You have been logged out.',
);
-my $url_string = CGI->new->url;
+my $error = # $cgi->param('logout') ||
+ $r->prev->subprocess_env("AuthCookieReason");
-my $error = $cgi->param('logout') || $r->prev->subprocess_env("AuthCookieReason");
$error = exists($error{$error}) ? $error{$error} : $error;
+
+#my $url_string = CGI->new->url;
+my $url_string = $cgi->url;
+
#fake a freeside path for /login so we get our .css. shrug
$url_string =~ s/login$/freeside\/login/ unless $url_string =~ /freeside\//;
#even though this is kludgy and false laziness w/CGI.pm
- $url_string =~ s{ / index\.html /? $ }
- {/}x;
- $url_string =~
- s{
- /(login|loginout)
- ([\w\-\.\/]*)
- $
- }
- {}ix;
-
- $url_string .= '/' unless $url_string =~ /\/$/;
+$url_string =~ s{ / index\.html /? $ }
+ {/}x;
+$url_string =~
+ s{
+ /(login|loginout)
+ ([\w\-\.\/]*)
+ $
+ }
+ {}ix;
+
+$url_string .= '/' unless $url_string =~ /\/$/;
</%init>
-<% $cgi->redirect($fsurl.'?logout=logout') %>
+<% $cgi->redirect($redirect) %>
<%init>
-my $auth_type = $r->auth_type;
+# Delete the server-side session
+$FS::CurrentUser::CurrentSession->logout;
-# Delete the cookie, etc.
+# Delete the browser cookie, etc.
+my $auth_type = $r->auth_type;
$auth_type->logout($r);
-#XXX etc: should delete the server-side session
+
+my $redirect = $fsurl; #.'?logout=logout';
</%init>
projects / freeside.git / commitdiff