NG auth: use database session keys, RT#21563

10 files changed, 327 insertions, 51 deletions

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 );
+@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>