NG auth: use database session keys, RT#21563
authorIvan Kohler <ivan@freeside.biz>
Tue, 7 May 2013 04:31:04 +0000 (21:31 -0700)
committerIvan Kohler <ivan@freeside.biz>
Tue, 7 May 2013 04:31:04 +0000 (21:31 -0700)
FS/FS.pm
FS/FS/AuthCookieHandler.pm
FS/FS/CurrentUser.pm
FS/FS/Schema.pm
FS/FS/UID.pm
FS/FS/access_user_session.pm [new file with mode: 0644]
FS/MANIFEST
FS/t/access_user_session.t [new file with mode: 0644]
httemplate/loginout/login.html
httemplate/loginout/logout.html

index 2517c1f..741d815 100644 (file)
--- 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> - Employees / internal users
 
+L<FS::access_user_session> - Access sessions
+
 L<FS::access_user_pref> - Employee preferences
 
 L<FS::access_group> - Employee groups
 L<FS::access_user_pref> - Employee preferences
 
 L<FS::access_group> - Employee groups
index a4a3118..a8ee370 100644 (file)
@@ -2,27 +2,24 @@ package FS::AuthCookieHandler;
 use base qw( Apache2::AuthCookie );
 
 use strict;
 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 ) = @_;
 
 
 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 _is_valid_user {
@@ -38,18 +35,18 @@ sub _is_valid_user {
 }
 
 sub authen_ses_key {
 }
 
 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;
 
 }
 
 
 }
 
index bcd337d..7b0fe28 100644 (file)
@@ -1,6 +1,6 @@
 package FS::CurrentUser;
 
 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);
 
 #not at compile-time, circular dependancey causes trouble
 #use FS::Record qw(qsearchs);
@@ -10,12 +10,20 @@ $upgrade_hack = 0;
 
 =head1 NAME
 
 
 =head1 NAME
 
-FS::CurrentUser - Package representing the current user
+FS::CurrentUser - Package representing the current user (and session)
 
 =head1 SYNOPSIS
 
 =head1 DESCRIPTION
 
 
 =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 {
 =cut
 
 sub load_user {
@@ -44,9 +52,65 @@ sub load_user {
   $CurrentUser;
 }
 
   $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
 
 =head1 BUGS
 
-Creepy crawlies
+Minimal docs
 
 =head1 SEE ALSO
 
 
 =head1 SEE ALSO
 
index cd42e4e..923f1fd 100644 (file)
@@ -187,9 +187,9 @@ sub dbdef_dist {
 
   my $tables_hashref_torrus = tables_hashref_torrus();
 
 
   my $tables_hashref_torrus = tables_hashref_torrus();
 
-  #create history tables (false laziness w/create-history-tables)
+  #create history tables
   foreach my $table (
   foreach my $table (
-    grep {    ! /^clientapi_session/
+    grep {    ! /^(clientapi|access_user)_session/
            && ! /^h_/
            && ! /^log(_context)?$/
            && ! $tables_hashref_torrus->{$_}
            && ! /^h_/
            && ! /^log(_context)?$/
            && ! $tables_hashref_torrus->{$_}
@@ -3569,6 +3569,19 @@ sub tables_hashref {
       'index'  => [],
     },
 
       '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',  '',      '', '', '',
     'access_user' => {
       'columns' => [
         'usernum',   'serial',  '',      '', '', '',
index 44d3870..6596a98 100644 (file)
@@ -15,6 +15,7 @@ use FS::CurrentUser;
 
 @ISA = qw(Exporter);
 @EXPORT_OK = qw( checkeuid checkruid cgi setcgi adminsuidsetup forksuidsetup
 
 @ISA = qw(Exporter);
 @EXPORT_OK = qw( checkeuid checkruid cgi setcgi adminsuidsetup forksuidsetup
+                 preuser_setup
                  getotaker dbh datasrc getsecrets driver_name myconnect
                  use_confcompat
                );
                  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.
 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).
 
 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;
   }
 
     $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'} = '';
 
   $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;
   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;
   }
 
     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 ) {
   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 skipping callbacks (callback_hack set)\n" if $DEBUG;
   }
 
-  warn "$me forksuidsetup loading user\n" if $DEBUG;
-  FS::CurrentUser->load_user($user);
-
-  $dbh;
 }
 
 sub myconnect {
 }
 
 sub myconnect {
diff --git a/FS/FS/access_user_session.pm b/FS/FS/access_user_session.pm
new file mode 100644 (file)
index 0000000..df112f9
--- /dev/null
@@ -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;
+
index 43f36ab..d2b7013 100644 (file)
@@ -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
 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 (file)
index 0000000..ab3a59a
--- /dev/null
@@ -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";
index e5b4589..a67ea4b 100644 (file)
 
 my %error = (
   'no_cookie'       => '', #First login, don't display an error
 
 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',
   '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;
 
 $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
 #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>
 
 </%init>
index 33b87fe..5626aa4 100644 (file)
@@ -1,10 +1,13 @@
-<% $cgi->redirect($fsurl.'?logout=logout') %>
+<% $cgi->redirect($redirect) %>
 <%init>
 
 <%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);
 $auth_type->logout($r);
-#XXX etc: should delete the server-side session
+
+my $redirect = $fsurl; #.'?logout=logout';
 
 </%init>
 
 </%init>