[freeside-commits] branch 21563 updated. e62544064299324ab04abae64cc33afef12a24aa
Ivan
ivan at 420.am
Mon May 6 21:32:12 PDT 2013
The branch, 21563 has been updated
via e62544064299324ab04abae64cc33afef12a24aa (commit)
from 3ff1fb4e10fdaef86527c10bd416e988d2a62a49 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit e62544064299324ab04abae64cc33afef12a24aa
Author: Ivan Kohler <ivan at freeside.biz>
Date: Mon May 6 21:31:04 2013 -0700
NG auth: use database session keys, RT#21563
diff --git a/FS/FS.pm b/FS/FS.pm
index 2517c1f..741d815 100644
--- a/FS/FS.pm
+++ b/FS/FS.pm
@@ -87,6 +87,8 @@ L<FS::payinfo_Mixin> - Mixin class for records in tables that contain payinfo.
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
diff --git a/FS/FS/AuthCookieHandler.pm b/FS/FS/AuthCookieHandler.pm
index a4a3118..a8ee370 100644
--- a/FS/FS/AuthCookieHandler.pm
+++ b/FS/FS/AuthCookieHandler.pm
@@ -2,27 +2,24 @@ package FS::AuthCookieHandler;
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 {
@@ -38,18 +35,18 @@ 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;
}
diff --git a/FS/FS/CurrentUser.pm b/FS/FS/CurrentUser.pm
index bcd337d..7b0fe28 100644
--- a/FS/FS/CurrentUser.pm
+++ b/FS/FS/CurrentUser.pm
@@ -1,6 +1,6 @@
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);
@@ -10,12 +10,20 @@ $upgrade_hack = 0;
=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 {
@@ -44,9 +52,65 @@ 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 );
+ at 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
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index cd42e4e..923f1fd 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -187,9 +187,9 @@ sub dbdef_dist {
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->{$_}
@@ -3569,6 +3569,19 @@ sub tables_hashref {
'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', '', '', '', '',
diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm
index 44d3870..6596a98 100644
--- a/FS/FS/UID.pm
+++ b/FS/FS/UID.pm
@@ -15,6 +15,7 @@ use FS::CurrentUser;
@ISA = qw(Exporter);
@EXPORT_OK = qw( checkeuid checkruid cgi setcgi adminsuidsetup forksuidsetup
+ preuser_setup
getotaker dbh datasrc getsecrets driver_name myconnect
use_confcompat
);
@@ -61,7 +62,6 @@ Sets the user to USER (see config.html from the base documentation).
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).
@@ -86,13 +86,40 @@ sub forksuidsetup {
$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;
@@ -126,6 +153,11 @@ sub forksuidsetup {
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 ) {
@@ -138,10 +170,6 @@ sub forksuidsetup {
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 {
diff --git a/FS/FS/access_user_session.pm b/FS/FS/access_user_session.pm
new file mode 100644
index 0000000..df112f9
--- /dev/null
+++ b/FS/FS/access_user_session.pm
@@ -0,0 +1,158 @@
+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;
+
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 43f36ab..d2b7013 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -690,3 +690,5 @@ FS/part_pkg_usage.pm
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
diff --git a/FS/t/access_user_session.t b/FS/t/access_user_session.t
new file mode 100644
index 0000000..ab3a59a
--- /dev/null
+++ b/FS/t/access_user_session.t
@@ -0,0 +1,5 @@
+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";
diff --git a/httemplate/loginout/login.html b/httemplate/loginout/login.html
index e5b4589..a67ea4b 100644
--- a/httemplate/loginout/login.html
+++ b/httemplate/loginout/login.html
@@ -39,30 +39,34 @@
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>
diff --git a/httemplate/loginout/logout.html b/httemplate/loginout/logout.html
index 33b87fe..5626aa4 100644
--- a/httemplate/loginout/logout.html
+++ b/httemplate/loginout/logout.html
@@ -1,10 +1,13 @@
-<% $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>
-----------------------------------------------------------------------
Summary of changes:
FS/FS.pm | 2 +
FS/FS/AuthCookieHandler.pm | 39 +++----
FS/FS/CurrentUser.pm | 70 +++++++++++-
FS/FS/Schema.pm | 17 +++-
FS/FS/UID.pm | 40 ++++++-
FS/FS/access_user_session.pm | 158 +++++++++++++++++++++++++
FS/MANIFEST | 2 +
FS/t/{AccessRight.t => access_user_session.t} | 2 +-
httemplate/loginout/login.html | 34 +++---
httemplate/loginout/logout.html | 11 +-
10 files changed, 323 insertions(+), 52 deletions(-)
create mode 100644 FS/FS/access_user_session.pm
copy FS/t/{AccessRight.t => access_user_session.t} (77%)
More information about the freeside-commits
mailing list