From 24dee535417570307d82c5f5302c116dec9cf21f Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Wed, 27 Mar 2013 02:56:33 -0700
Subject: start of auth plugin work

---
 FS/FS/Conf.pm                 |  8 ++++++++
 FS/FS/access_user/internal.pm | 15 +++++++++++++++
 FS/FS/access_user/legacy.pm   | 15 +++++++++++++++
 3 files changed, 38 insertions(+)
 create mode 100644 FS/FS/access_user/internal.pm
 create mode 100644 FS/FS/access_user/legacy.pm

(limited to 'FS')

diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index e8b3333de..869ce1e73 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -5423,6 +5423,14 @@ and customer address. Include units.',
     'type'        => 'checkbox',
   },
 
+  {
+    'key'         => 'authentication_module',
+    'section'     => 'UI',
+    'description' => '"Internal" is the default , which authenticates against the internal database.  "Legacy" is similar, but matches passwords against a legacy htpasswd file.',
+    'type'        => 'select',
+    'select_enum' => [qw( Internal Legacy )],
+  },
+
   { key => "apacheroot", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
   { key => "apachemachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
   { key => "apachemachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
diff --git a/FS/FS/access_user/internal.pm b/FS/FS/access_user/internal.pm
new file mode 100644
index 000000000..94f932dee
--- /dev/null
+++ b/FS/FS/access_user/internal.pm
@@ -0,0 +1,15 @@
+package FS::access_user::internal;
+use base qw( FS::access_user );
+
+use strict;
+
+sub authenticate {
+  my( $username, $check_password ) = @_;
+
+
+}
+
+sub change_password {
+}
+
+1;
diff --git a/FS/FS/access_user/legacy.pm b/FS/FS/access_user/legacy.pm
new file mode 100644
index 000000000..f8dcdc015
--- /dev/null
+++ b/FS/FS/access_user/legacy.pm
@@ -0,0 +1,15 @@
+package FS::access_user::legacy;
+use base qw( FS::access_user ); #::internal ?
+
+use strict;
+
+sub authenticate {
+  my( $username, $check_password ) = @_;
+
+
+}
+
+sub change_password {
+}
+
+1;
-- 
cgit v1.2.1


From 3ff1fb4e10fdaef86527c10bd416e988d2a62a49 Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Fri, 5 Apr 2013 01:03:44 -0700
Subject: login/login pages and cookie/session-based auth

---
 FS/FS/Auth/external.pm        | 18 ++++++++++
 FS/FS/Auth/internal.pm        | 15 +++++++++
 FS/FS/Auth/legacy.pm          | 25 ++++++++++++++
 FS/FS/AuthCookieHandler.pm    | 56 +++++++++++++++++++++++++++++++
 FS/FS/CGI.pm                  |  6 ++--
 FS/FS/Mason/Request.pm        | 33 ++++++++++---------
 FS/FS/UID.pm                  | 76 +++++++++++--------------------------------
 FS/FS/access_user/internal.pm | 15 ---------
 FS/FS/access_user/legacy.pm   | 15 ---------
 FS/MANIFEST                   |  4 +++
 10 files changed, 157 insertions(+), 106 deletions(-)
 create mode 100644 FS/FS/Auth/external.pm
 create mode 100644 FS/FS/Auth/internal.pm
 create mode 100644 FS/FS/Auth/legacy.pm
 create mode 100644 FS/FS/AuthCookieHandler.pm
 delete mode 100644 FS/FS/access_user/internal.pm
 delete mode 100644 FS/FS/access_user/legacy.pm

(limited to 'FS')

diff --git a/FS/FS/Auth/external.pm b/FS/FS/Auth/external.pm
new file mode 100644
index 000000000..d2bc74600
--- /dev/null
+++ b/FS/FS/Auth/external.pm
@@ -0,0 +1,18 @@
+packages FS::Auth::external;
+#use base qw( FS::Auth );
+
+use strict;
+
+sub autocreate {
+  my $username = shift;
+  my $access_user = new FS::access_user {
+    'username' => $username,
+    #'_password' => #XXX something random so a switch to internal auth doesn't
+                    #let people on?
+  };
+  my $error = $access_user->insert;
+  #die $error if $error;
+}
+
+1;
+
diff --git a/FS/FS/Auth/internal.pm b/FS/FS/Auth/internal.pm
new file mode 100644
index 000000000..86fddd237
--- /dev/null
+++ b/FS/FS/Auth/internal.pm
@@ -0,0 +1,15 @@
+package FS::Auth::internal;
+#use base qw( FS::Auth );
+
+use strict;
+
+sub authenticate {
+  my( $username, $check_password ) = @_;
+
+
+}
+
+sub change_password {
+}
+
+1;
diff --git a/FS/FS/Auth/legacy.pm b/FS/FS/Auth/legacy.pm
new file mode 100644
index 000000000..72122029e
--- /dev/null
+++ b/FS/FS/Auth/legacy.pm
@@ -0,0 +1,25 @@
+package FS::Auth::legacy;
+#use base qw( FS::Auth ); #::internal ?
+
+use strict;
+use Apache::Htpasswd;
+
+#substitute in?  we're trying to make it go away...
+my $htpasswd_file = '/usr/local/etc/freeside/htpasswd';
+
+sub authenticate {
+  my($self, $username, $check_password ) = @_;
+
+  Apache::Htpasswd->new( { passwdFile => $htpasswd_file,
+                           ReadOnly   => 1,
+                         }
+    )->htCheckPassword($username, $check_password);
+}
+
+#don't support this in legacy?  change in both htpasswd and database like 3.x
+# for easier transitioning?  hoping its really only me+employees that have a
+# mismatch in htpasswd vs access_user, so maybe that's not necessary
+#sub change_password {
+#}
+
+1;
diff --git a/FS/FS/AuthCookieHandler.pm b/FS/FS/AuthCookieHandler.pm
new file mode 100644
index 000000000..a4a31188e
--- /dev/null
+++ b/FS/FS/AuthCookieHandler.pm
@@ -0,0 +1,56 @@
+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
+
+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";
+  }
+
+  return undef; #?
+}
+
+sub _is_valid_user {
+  my( $username, $password ) = @_;
+  my $class = 'FS::Auth::'.$module;
+
+  #earlier?
+  eval "use $class;";
+  die $@ if $@;
+
+  $class->authenticate($username, $password);
+
+}
+
+sub authen_ses_key {
+  my( $self, $r, $session_key ) = @_;
+
+  my ($username, $mac) = split /::/, $session_key;
+
+  if ( sha1_hex( $username, $secret ) eq $mac ) {
+    adminsuidsetup($username);
+    return $username;
+  } else {
+    warn "bad session $session_key from ". $r->connection->remote_ip. "\n";
+  }
+
+  return undef;
+
+}
+
+1;
diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm
index 972625ff6..5ac31dbec 100644
--- a/FS/FS/CGI.pm
+++ b/FS/FS/CGI.pm
@@ -6,7 +6,7 @@ use Exporter;
 use CGI;
 use URI::URL;
 #use CGI::Carp qw(fatalsToBrowser);
-use FS::UID;
+use FS::UID qw( cgi );
 
 @ISA = qw(Exporter);
 @EXPORT_OK = qw( header menubar idiot eidiot popurl rooturl table itable ntable
@@ -232,7 +232,7 @@ sub rooturl {
     $url_string = shift;
   } else {
     # better to start with the client-provided URL
-    my $cgi = &FS::UID::cgi;
+    my $cgi = cgi;
     $url_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url;
   }
 
@@ -244,7 +244,7 @@ sub rooturl {
   $url_string =~
     s{
        /
-       (browse|config|docs|edit|graph|misc|search|view|pref|elements|rt|torrus)
+       (browse|config|docs|edit|graph|misc|search|view|loginout|pref|elements|rt|torrus)
        (/process)?
        ([\w\-\.\/]*)
        $
diff --git a/FS/FS/Mason/Request.pm b/FS/FS/Mason/Request.pm
index 36c46dc41..1e2555a76 100644
--- a/FS/FS/Mason/Request.pm
+++ b/FS/FS/Mason/Request.pm
@@ -69,7 +69,7 @@ sub freeside_setup {
       FS::Trace->log('    handling RT REST/NoAuth file');
 
       package HTML::Mason::Commands; #?
-      use FS::UID qw( adminsuidsetup );
+      use FS::UID qw( adminsuidsetup setcgi );
 
       #need to log somebody in for the mail gw
 
@@ -86,14 +86,15 @@ sub freeside_setup {
       package HTML::Mason::Commands;
       use vars qw( $cgi $p $fsurl ); # $lh ); #not using /mt
       use Encode;
-      use FS::UID qw( cgisuidsetup );
+      #use FS::UID qw( cgisuidsetup );
       use FS::CGI qw( popurl rooturl );
 
       if ( $mode eq 'apache' ) {
         $cgi = new CGI;
-        FS::Trace->log('    cgisuidsetup');
-        &cgisuidsetup($cgi);
-        #&cgisuidsetup($r);
+        setcgi($cgi);
+
+        #cgisuidsetup is gone, adminsuidsetup is now done in AuthCookieHandler
+
         $fsurl = rooturl();
         $p = popurl(2);
       } elsif ( $mode eq 'standalone' ) {
@@ -106,19 +107,19 @@ sub freeside_setup {
         die "unknown mode $mode";
       }
 
-    FS::Trace->log('    UTF-8-decoding form data');
-    #
-    foreach my $param ( $cgi->param ) {
-      my @values = $cgi->param($param);
-      next if $cgi->uploadInfo($values[0]);
-      #warn $param;
-      @values = map decode(utf8=>$_), @values;
-      $cgi->param($param, @values);
+      FS::Trace->log('    UTF-8-decoding form data');
+      #
+      foreach my $param ( $cgi->param ) {
+        my @values = $cgi->param($param);
+        next if $cgi->uploadInfo($values[0]);
+        #warn $param;
+        @values = map decode(utf8=>$_), @values;
+        $cgi->param($param, @values);
+      }
+
     }
-    
-  }
 
-  FS::Trace->log('    done');
+    FS::Trace->log('    done');
 
 }
 
diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm
index 67bb75fe3..44d3870cc 100644
--- a/FS/FS/UID.pm
+++ b/FS/FS/UID.pm
@@ -6,19 +6,18 @@ use vars qw(
   $secrets $datasrc $db_user $db_pass $schema $dbh $driver_name
   $AutoCommit %callback @callback $callback_hack $use_confcompat
 );
-use subs qw(
-  getsecrets cgisetotaker
-);
+use subs qw( getsecrets );
 use Exporter;
-use Carp qw(carp croak cluck confess);
+use Carp qw( carp croak cluck confess );
 use DBI;
 use IO::File;
 use FS::CurrentUser;
 
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
-                getotaker dbh datasrc getsecrets driver_name myconnect
-                use_confcompat);
+@EXPORT_OK = qw( checkeuid checkruid cgi setcgi adminsuidsetup forksuidsetup
+                 getotaker dbh datasrc getsecrets driver_name myconnect
+                 use_confcompat
+               );
 
 $DEBUG = 0;
 $me = '[FS::UID]';
@@ -38,13 +37,9 @@ FS::UID - Subroutines for database login and assorted other stuff
 
 =head1 SYNOPSIS
 
-  use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
-  checkeuid checkruid);
-
-  adminsuidsetup $user;
+  use FS::UID qw(adminsuidsetup dbh datasrc getotaker checkeuid checkruid);
 
-  $cgi = new CGI;
-  $dbh = cgisuidsetup($cgi);
+  $dbh = adminsuidsetup $user;
 
   $dbh = dbh;
 
@@ -194,35 +189,26 @@ sub install_callback {
   &{$callback} if $dbh;
 }
 
-=item cgisuidsetup CGI_object
+=item cgi
 
-Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
-object (CGI::Base is depriciated).  Runs cgisetotaker and then adminsuidsetup.
+Returns the CGI (see L<CGI>) object.
 
 =cut
 
-sub cgisuidsetup {
-  $cgi=shift;
-  if ( $cgi->isa('CGI::Base') ) {
-    carp "Use of CGI::Base is depriciated";
-  } elsif ( $cgi->isa('Apache') ) {
-
-  } elsif ( ! $cgi->isa('CGI') ) {
-    croak "fatal: unrecognized object $cgi";
-  }
-  cgisetotaker; 
-  adminsuidsetup($user);
+sub cgi {
+  carp "warning: \$FS::UID::cgi is undefined" unless defined($cgi);
+  #carp "warning: \$FS::UID::cgi isa Apache" if $cgi && $cgi->isa('Apache');
+  $cgi;
 }
 
-=item cgi
+=item cgi CGI_OBJECT
 
-Returns the CGI (see L<CGI>) object.
+Sets the CGI (see L<CGI>) object.
 
 =cut
 
-sub cgi {
-  carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
-  $cgi;
+sub setcgi {
+  $cgi = shift;
 }
 
 =item dbh
@@ -270,29 +256,6 @@ sub getotaker {
   $user;
 }
 
-=item cgisetotaker
-
-Sets and returns the CGI REMOTE_USER.  $cgi should be defined as a CGI.pm
-object (see L<CGI>) or an Apache object (see L<Apache>).  Support for CGI::Base
-and derived classes is depriciated.
-
-=cut
-
-sub cgisetotaker {
-  if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
-    carp "Use of CGI::Base is depriciated";
-    $user = lc ( $cgi->var('REMOTE_USER') );
-  } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
-    $user = lc ( $cgi->remote_user );
-  } elsif ( $cgi && $cgi->isa('Apache') ) {
-    $user = lc ( $cgi->connection->user );
-  } else {
-    die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
-        "Apache user authentication as documented in the installation instructions";
-  }
-  $user;
-}
-
 =item checkeuid
 
 Returns true if effective UID is that of the freeside user.
@@ -390,8 +353,7 @@ Too many package-global variables.
 
 Not OO.
 
-No capabilities yet.  When mod_perl and Authen::DBI are implemented, 
-cgisuidsetup will go away as well.
+No capabilities yet. (What does this mean again?)
 
 Goes through contortions to support non-OO syntax with multiple datasrc's.
 
diff --git a/FS/FS/access_user/internal.pm b/FS/FS/access_user/internal.pm
deleted file mode 100644
index 94f932dee..000000000
--- a/FS/FS/access_user/internal.pm
+++ /dev/null
@@ -1,15 +0,0 @@
-package FS::access_user::internal;
-use base qw( FS::access_user );
-
-use strict;
-
-sub authenticate {
-  my( $username, $check_password ) = @_;
-
-
-}
-
-sub change_password {
-}
-
-1;
diff --git a/FS/FS/access_user/legacy.pm b/FS/FS/access_user/legacy.pm
deleted file mode 100644
index f8dcdc015..000000000
--- a/FS/FS/access_user/legacy.pm
+++ /dev/null
@@ -1,15 +0,0 @@
-package FS::access_user::legacy;
-use base qw( FS::access_user ); #::internal ?
-
-use strict;
-
-sub authenticate {
-  my( $username, $check_password ) = @_;
-
-
-}
-
-sub change_password {
-}
-
-1;
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 95b11f8e5..43f36abf6 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -27,6 +27,10 @@ bin/freeside-sqlradius-seconds
 bin/freeside-torrus-srvderive
 FS.pm
 FS/AccessRight.pm
+FS/AuthCookieHandler.pm
+FS/Auth/external.pm
+FS/Auth/internal.pm
+FS/Auth/legacy.pm
 FS/CGI.pm
 FS/InitHandler.pm
 FS/ClientAPI.pm
-- 
cgit v1.2.1


From e62544064299324ab04abae64cc33afef12a24aa Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Mon, 6 May 2013 21:31:04 -0700
Subject: NG auth: use database session keys, RT#21563

---
 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/access_user_session.t   |   5 ++
 8 files changed, 301 insertions(+), 32 deletions(-)
 create mode 100644 FS/FS/access_user_session.pm
 create mode 100644 FS/t/access_user_session.t

(limited to 'FS')

diff --git a/FS/FS.pm b/FS/FS.pm
index 2517c1fd6..741d8159f 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 a4a31188e..a8ee37079 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 bcd337d2c..7b0fe28a6 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 cd42e4e9c..923f1fd9d 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 44d3870cc..6596a983b 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 000000000..df112f984
--- /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 43f36abf6..d2b7013a4 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 000000000..ab3a59acc
--- /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";
-- 
cgit v1.2.1


From 9d35792778885932c09102bd011b518eb47c5131 Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Mon, 6 May 2013 23:13:11 -0700
Subject: NG auth: fix new customer, remove mapsecrets support, RT#21563

---
 FS/FS/Mason.pm            |  2 +-
 FS/FS/Record.pm           | 13 ++++++-------
 FS/FS/UI/Web.pm           |  4 ++--
 FS/FS/UID.pm              | 49 ++++++++++++++++-------------------------------
 FS/FS/banned_pay.pm       |  1 -
 FS/FS/cust_credit.pm      |  2 +-
 FS/FS/cust_credit_bill.pm |  1 -
 FS/FS/cust_main.pm        |  2 +-
 FS/FS/cust_main/Status.pm |  5 +----
 FS/FS/cust_pay.pm         |  1 -
 FS/FS/cust_pay_refund.pm  |  1 -
 FS/FS/cust_pay_void.pm    |  1 -
 FS/FS/cust_pkg.pm         |  2 +-
 FS/FS/cust_refund.pm      |  1 -
 FS/bin/freeside-setup     |  2 +-
 FS/bin/freeside-upgrade   |  2 +-
 16 files changed, 32 insertions(+), 57 deletions(-)

(limited to 'FS')

diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index ae75539ac..43e9b0653 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -126,7 +126,7 @@ if ( -e $addl_handler_use_file ) {
   use LWP::UserAgent;
   use Storable qw( nfreeze thaw );
   use FS;
-  use FS::UID qw( getotaker dbh datasrc driver_name );
+  use FS::UID qw( dbh datasrc driver_name );
   use FS::Record qw( qsearch qsearchs fields dbdef
                     str2time_sql str2time_sql_closing
                     midnight_sql
diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 42af68ca5..a868d4892 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -18,7 +18,7 @@ use Text::CSV_XS;
 use File::Slurp qw( slurp );
 use DBI qw(:sql_types);
 use DBIx::DBSchema 0.38;
-use FS::UID qw(dbh getotaker datasrc driver_name);
+use FS::UID qw(dbh datasrc driver_name);
 use FS::CurrentUser;
 use FS::Schema qw(dbdef);
 use FS::SearchCache;
@@ -1901,7 +1901,11 @@ sub _h_statement {
   "INSERT INTO h_". $self->table. " ( ".
       join(', ', qw(history_date history_user history_action), @fields ).
     ") VALUES (".
-      join(', ', $time, dbh->quote(getotaker()), dbh->quote($action), @values).
+      join(', ', $time,
+                 dbh->quote( $FS::CurrentUser::CurrentUser->username ),
+                 dbh->quote($action),
+                 @values
+      ).
     ")"
   ;
 }
@@ -1932,11 +1936,6 @@ sub unique {
   #warn "field $field is tainted" if is_tainted($field);
 
   my($counter) = new File::CounterFile "$table.$field",0;
-# hack for web demo
-#  getotaker() =~ /^([\w\-]{1,16})$/ or die "Illegal CGI REMOTE_USER!";
-#  my($user)=$1;
-#  my($counter) = new File::CounterFile "$user/$table.$field",0;
-# endhack
 
   my $index = $counter->inc;
   $index = $counter->inc while qsearchs($table, { $field=>$index } );
diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm
index 792680876..c11e6c951 100644
--- a/FS/FS/UI/Web.pm
+++ b/FS/FS/UI/Web.pm
@@ -579,7 +579,7 @@ use Carp;
 use Storable qw(nfreeze);
 use MIME::Base64;
 use JSON;
-use FS::UID qw(getotaker);
+use FS::CurrentUser;
 use FS::Record qw(qsearchs);
 use FS::queue;
 use FS::CGI qw(rooturl);
@@ -653,7 +653,7 @@ sub start_job {
       push @{$param{$field}}, $value;
     }
   }
-  $param{CurrentUser} = getotaker();
+  $param{CurrentUser} = $FS::CurrentUser::CurrentUser->username;
   $param{RootURL} = rooturl($self->{cgi}->self_url);
   warn "FS::UI::Web::start_job\n".
        join('', map {
diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm
index 6596a983b..9c52f0883 100644
--- a/FS/FS/UID.pm
+++ b/FS/FS/UID.pm
@@ -2,7 +2,7 @@ package FS::UID;
 
 use strict;
 use vars qw(
-  @ISA @EXPORT_OK $DEBUG $me $cgi $freeside_uid $user $conf_dir $cache_dir
+  @ISA @EXPORT_OK $DEBUG $me $cgi $freeside_uid $conf_dir $cache_dir
   $secrets $datasrc $db_user $db_pass $schema $dbh $driver_name
   $AutoCommit %callback @callback $callback_hack $use_confcompat
 );
@@ -38,7 +38,7 @@ FS::UID - Subroutines for database login and assorted other stuff
 
 =head1 SYNOPSIS
 
-  use FS::UID qw(adminsuidsetup dbh datasrc getotaker checkeuid checkruid);
+  use FS::UID qw(adminsuidsetup dbh datasrc checkeuid checkruid);
 
   $dbh = adminsuidsetup $user;
 
@@ -73,7 +73,7 @@ sub adminsuidsetup {
 }
 
 sub forksuidsetup {
-  $user = shift;
+  my $user = shift;
   my $olduser = $user;
   warn "$me forksuidsetup starting for $user\n" if $DEBUG;
 
@@ -173,12 +173,12 @@ sub callback_setup {
 }
 
 sub myconnect {
-  my $handle = DBI->connect( getsecrets(@_), { 'AutoCommit'         => 0,
-                                               'ChopBlanks'         => 1,
-                                               'ShowErrorStatement' => 1,
-                                               'pg_enable_utf8'     => 1,
-                                               #'mysql_enable_utf8'  => 1,
-                                             }
+  my $handle = DBI->connect( getsecrets(), { 'AutoCommit'         => 0,
+                                             'ChopBlanks'         => 1,
+                                             'ShowErrorStatement' => 1,
+                                             'pg_enable_utf8'     => 1,
+                                             #'mysql_enable_utf8'  => 1,
+                                           }
                            )
     or die "DBI->connect error: $DBI::errstr\n";
 
@@ -276,12 +276,13 @@ sub suidsetup {
 
 =item getotaker
 
-Returns the current Freeside user.
+(Deprecated) Returns the current Freeside user's username.
 
 =cut
 
 sub getotaker {
-  $user;
+  carp "FS::UID::getotaker deprecated";
+  $FS::CurrentUser::CurrentUser->username;
 }
 
 =item checkeuid
@@ -305,34 +306,18 @@ sub checkruid {
   ( $< == $freeside_uid );
 }
 
-=item getsecrets [ USER ]
+=item getsecrets
 
-Sets the user to USER, if supplied.
-Sets and returns the DBI datasource, username and password for this user from
-the `/usr/local/etc/freeside/mapsecrets' file.
+Sets and returns the DBI datasource, username and password from
+the `/usr/local/etc/freeside/secrets' file.
 
 =cut
 
 sub getsecrets {
-  my($setuser) = shift;
-  $user = $setuser if $setuser;
-
-  if ( -e "$conf_dir/mapsecrets" ) {
-    die "No user!" unless $user;
-    my($line) = grep /^\s*($user|\*)\s/,
-      map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/mapsecrets");
-    confess "User $user not found in mapsecrets!" unless $line;
-    $line =~ /^\s*($user|\*)\s+(.*)$/;
-    $secrets = $2;
-    die "Illegal mapsecrets line for user?!" unless $secrets;
-  } else {
-    # no mapsecrets file at all, so do the default thing
-    $secrets = 'secrets';
-  }
 
   ($datasrc, $db_user, $db_pass, $schema) = 
-    map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/$secrets")
-      or die "Can't get secrets: $conf_dir/$secrets: $!\n";
+    map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/secrets")
+      or die "Can't get secrets: $conf_dir/secrets: $!\n";
   undef $driver_name;
 
   ($datasrc, $db_user, $db_pass);
diff --git a/FS/FS/banned_pay.pm b/FS/FS/banned_pay.pm
index b93f67bbe..713c81adf 100644
--- a/FS/FS/banned_pay.pm
+++ b/FS/FS/banned_pay.pm
@@ -4,7 +4,6 @@ use strict;
 use base qw( FS::otaker_Mixin FS::Record );
 use Digest::MD5 qw(md5_base64);
 use FS::Record qw( qsearch qsearchs );
-use FS::UID qw( getotaker );
 use FS::CurrentUser;
 
 =head1 NAME
diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index ba279a26c..0376f1dc4 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -7,7 +7,7 @@ use vars qw( $conf $unsuspendauto $me $DEBUG
            );
 use List::Util qw( min );
 use Date::Format;
-use FS::UID qw( dbh getotaker );
+use FS::UID qw( dbh );
 use FS::Misc qw(send_email);
 use FS::Record qw( qsearch qsearchs dbdef );
 use FS::CurrentUser;
diff --git a/FS/FS/cust_credit_bill.pm b/FS/FS/cust_credit_bill.pm
index 900a5c0d5..9ecb7e048 100644
--- a/FS/FS/cust_credit_bill.pm
+++ b/FS/FS/cust_credit_bill.pm
@@ -2,7 +2,6 @@ package FS::cust_credit_bill;
 
 use strict;
 use vars qw( @ISA $conf );
-use FS::UID qw( getotaker );
 use FS::Record qw( qsearch qsearchs );
 use FS::cust_main_Mixin;
 use FS::cust_bill_ApplicationCommon;
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 2a4602e19..3c0702fc1 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -32,7 +32,7 @@ use Date::Format;
 use File::Temp; #qw( tempfile );
 use Business::CreditCard 0.28;
 use Locale::Country;
-use FS::UID qw( getotaker dbh driver_name );
+use FS::UID qw( dbh driver_name );
 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
 use FS::Misc qw( generate_email send_email generate_ps do_print );
 use FS::Msgcat qw(gettext);
diff --git a/FS/FS/cust_main/Status.pm b/FS/FS/cust_main/Status.pm
index e5803e0db..f84ff0f0e 100644
--- a/FS/FS/cust_main/Status.pm
+++ b/FS/FS/cust_main/Status.pm
@@ -2,13 +2,10 @@ package FS::cust_main::Status;
 
 use strict;
 use vars qw( $conf ); # $module ); #$DEBUG $me );
+use Tie::IxHash;
 use FS::UID;
 use FS::cust_pkg;
 
-#use Tie::IxHash;
-
-use FS::UID qw( getotaker dbh driver_name );
-
 #$DEBUG = 0;
 #$me = '[FS::cust_main::Status]';
 
diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm
index 6d09f8908..4491f780c 100644
--- a/FS/FS/cust_pay.pm
+++ b/FS/FS/cust_pay.pm
@@ -9,7 +9,6 @@ use vars qw( $DEBUG $me $conf @encrypted_fields
 use Date::Format;
 use Business::CreditCard;
 use Text::Template;
-use FS::UID qw( getotaker );
 use FS::Misc qw( send_email );
 use FS::Record qw( dbh qsearch qsearchs );
 use FS::CurrentUser;
diff --git a/FS/FS/cust_pay_refund.pm b/FS/FS/cust_pay_refund.pm
index cb9dbcef2..b799f69e7 100644
--- a/FS/FS/cust_pay_refund.pm
+++ b/FS/FS/cust_pay_refund.pm
@@ -2,7 +2,6 @@ package FS::cust_pay_refund;
 
 use strict;
 use vars qw( @ISA ); #$conf );
-use FS::UID qw( getotaker );
 use FS::Record qw( qsearchs ); # qsearch );
 use FS::cust_main;
 use FS::cust_pay;
diff --git a/FS/FS/cust_pay_void.pm b/FS/FS/cust_pay_void.pm
index 42fc2966c..92a96cb96 100644
--- a/FS/FS/cust_pay_void.pm
+++ b/FS/FS/cust_pay_void.pm
@@ -5,7 +5,6 @@ use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
              FS::Record );
 use vars qw( @encrypted_fields $otaker_upgrade_kludge );
 use Business::CreditCard;
-use FS::UID qw(getotaker);
 use FS::Record qw(qsearch qsearchs dbh fields);
 use FS::CurrentUser;
 use FS::access_user;
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 374cf7a12..19337c4d6 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -10,7 +10,7 @@ use List::Util qw(min max);
 use Tie::IxHash;
 use Time::Local qw( timelocal timelocal_nocheck );
 use MIME::Entity;
-use FS::UID qw( getotaker dbh driver_name );
+use FS::UID qw( dbh driver_name );
 use FS::Misc qw( send_email );
 use FS::Record qw( qsearch qsearchs fields );
 use FS::CurrentUser;
diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm
index 45a170ba0..064992955 100644
--- a/FS/FS/cust_refund.pm
+++ b/FS/FS/cust_refund.pm
@@ -5,7 +5,6 @@ use base qw( FS::otaker_Mixin FS::payinfo_transaction_Mixin FS::cust_main_Mixin
              FS::Record );
 use vars qw( @encrypted_fields );
 use Business::CreditCard;
-use FS::UID qw(getotaker);
 use FS::Record qw( qsearch qsearchs dbh );
 use FS::CurrentUser;
 use FS::cust_credit;
diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup
index 155c74aa0..07da88dea 100755
--- a/FS/bin/freeside-setup
+++ b/FS/bin/freeside-setup
@@ -32,7 +32,7 @@ $config_dir =~ /^([\w.:=\/]+)$/
   or die "unacceptable configuration directory name";
 $config_dir = $1;
 
-getsecrets($opt_u);
+getsecrets();
 
 #needs to match FS::Record
 my($dbdef_file) = "%%%FREESIDE_CONF%%%/dbdef.". datasrc;
diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade
index b08a8401f..399c11994 100755
--- a/FS/bin/freeside-upgrade
+++ b/FS/bin/freeside-upgrade
@@ -5,7 +5,7 @@ use vars qw($opt_d $opt_s $opt_q $opt_v $opt_r);
 use vars qw($DEBUG $DRY_RUN);
 use Getopt::Std;
 use DBIx::DBSchema 0.31; #0.39
-use FS::UID qw(adminsuidsetup checkeuid datasrc driver_name);  #getsecrets);
+use FS::UID qw(adminsuidsetup checkeuid datasrc driver_name);
 use FS::CurrentUser;
 use FS::Schema qw( dbdef dbdef_dist reload_dbdef );
 use FS::Misc::prune qw(prune_applications);
-- 
cgit v1.2.1


From 92a3df0360d3df6b6ace99fee3d4cc443e6154d0 Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Tue, 7 May 2013 23:55:11 -0700
Subject: NG auth: internal db auth, RT#21563

---
 FS/FS/Auth.pm              | 25 +++++++++++++++++++++++++
 FS/FS/AuthCookieHandler.pm | 18 ++++++------------
 FS/FS/Mason/Request.pm     |  2 +-
 FS/FS/Schema.pm            | 15 ++++++++-------
 4 files changed, 40 insertions(+), 20 deletions(-)
 create mode 100644 FS/FS/Auth.pm

(limited to 'FS')

diff --git a/FS/FS/Auth.pm b/FS/FS/Auth.pm
new file mode 100644
index 000000000..543978e8b
--- /dev/null
+++ b/FS/FS/Auth.pm
@@ -0,0 +1,25 @@
+package FS::Auth;
+
+use strict;
+use FS::Conf;
+
+sub authenticate {
+  my $class = shift;
+
+  $class->auth_class->authenticate(@_);
+}
+
+sub auth_class {
+  #my($class) = @_;
+
+  my $conf = new FS::Conf;
+  my $module = lc($conf->config('authentication_module')) || 'internal';
+
+  my $auth_class = 'FS::Auth::'.$module;
+  eval "use $auth_class;";
+  die $@ if $@;
+
+  $auth_class;
+}
+
+1;
diff --git a/FS/FS/AuthCookieHandler.pm b/FS/FS/AuthCookieHandler.pm
index a8ee37079..cd89f55af 100644
--- a/FS/FS/AuthCookieHandler.pm
+++ b/FS/FS/AuthCookieHandler.pm
@@ -4,34 +4,29 @@ use base qw( Apache2::AuthCookie );
 use strict;
 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
+use FS::Auth;
 
 sub authen_cred {
   my( $self, $r, $username, $password ) = @_;
 
+  preuser_setup();
+
   unless ( _is_valid_user($username, $password) ) {
     warn "failed auth $username from ". $r->connection->remote_ip. "\n";
     return undef;
   }
 
   warn "authenticated $username from ". $r->connection->remote_ip. "\n";
-  adminsuidsetup($username);
 
-  FS::CurrentUser->new_session;
+  FS::CurrentUser->load_user($username);
 
+  FS::CurrentUser->new_session;
 }
 
 sub _is_valid_user {
   my( $username, $password ) = @_;
-  my $class = 'FS::Auth::'.$module;
-
-  #earlier?
-  eval "use $class;";
-  die $@ if $@;
-
-  $class->authenticate($username, $password);
 
+  FS::Auth->authenticate($username, $password);
 }
 
 sub authen_ses_key {
@@ -47,7 +42,6 @@ sub authen_ses_key {
   }
 
   $curuser->username;
-
 }
 
 1;
diff --git a/FS/FS/Mason/Request.pm b/FS/FS/Mason/Request.pm
index 1e2555a76..5d6fc4cd4 100644
--- a/FS/FS/Mason/Request.pm
+++ b/FS/FS/Mason/Request.pm
@@ -93,7 +93,7 @@ sub freeside_setup {
         $cgi = new CGI;
         setcgi($cgi);
 
-        #cgisuidsetup is gone, adminsuidsetup is now done in AuthCookieHandler
+        #cgisuidsetup is gone, equivalent is now done in AuthCookieHandler
 
         $fsurl = rooturl();
         $p = popurl(2);
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 923f1fd9d..899b67b35 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -3584,13 +3584,14 @@ sub tables_hashref {
 
     'access_user' => {
       'columns' => [
-        'usernum',   'serial',  '',      '', '', '',
-        'username',  'varchar', '', $char_d, '', '',
-        '_password', 'varchar', '', $char_d, '', '',
-        'last',      'varchar', '', $char_d, '', '', 
-        'first',     'varchar', '', $char_d, '', '', 
-        'user_custnum',  'int', 'NULL',  '', '', '',
-        'disabled',     'char', 'NULL',   1, '', '', 
+        'usernum',             'serial',     '',      '', '', '',
+        'username',           'varchar',     '', $char_d, '', '',
+        '_password',          'varchar',     '', $char_d, '', '',
+        '_password_encoding', 'varchar', 'NULL', $char_d, '', '',
+        'last',               'varchar',     '', $char_d, '', '', 
+        'first',              'varchar',     '', $char_d, '', '', 
+        'user_custnum',           'int', 'NULL',      '', '', '',
+        'disabled',              'char', 'NULL',       1, '', '', 
       ],
       'primary_key' => 'usernum',
       'unique' => [ [ 'username' ] ],
-- 
cgit v1.2.1


From 199450cf528a5ac6b4fe739c38f9adf99a913712 Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Tue, 7 May 2013 23:55:36 -0700
Subject: NG auth: internal db auth, RT#21563

---
 FS/FS/Auth/internal.pm | 36 +++++++++++++++++++++++++++++++++---
 1 file changed, 33 insertions(+), 3 deletions(-)

(limited to 'FS')

diff --git a/FS/FS/Auth/internal.pm b/FS/FS/Auth/internal.pm
index 86fddd237..5d9170e23 100644
--- a/FS/FS/Auth/internal.pm
+++ b/FS/FS/Auth/internal.pm
@@ -2,14 +2,44 @@ package FS::Auth::internal;
 #use base qw( FS::Auth );
 
 use strict;
+use Crypt::Eksblowfish::Bcrypt qw(bcrypt_hash);
+use FS::Record qw( qsearchs );
+use FS::access_user;
 
 sub authenticate {
-  my( $username, $check_password ) = @_;
+  my($self, $username, $check_password ) = @_;
 
+  my $access_user = qsearchs('access_user', { 'username' => $username,
+                                              'disabled' => '',
+                                            }
+                            )
+    or return 0;
 
-}
+  if ( $access_user->_password_encoding eq 'bcrypt' ) {
+
+    my( $cost, $salt, $hash ) = split(',', $access_user->_password);
+
+    my $check_hash = bcrypt_hash( { key_nul => 1,
+                                    cost    => $cost,
+                                    salt    => $salt,
+                                  },
+                                  $check_password
+                                );
+
+    $hash eq $check_hash;
+
+  } else { 
+
+    return 0 if $access_user->_password eq 'notyet'
+             || $access_user->_password eq '';
+
+    $access_user->_password eq $check_password;
+
+  }
 
-sub change_password {
 }
 
+#sub change_password {
+#}
+
 1;
-- 
cgit v1.2.1


From d139a46390d127753877e8e55766e864df788d0b Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Wed, 8 May 2013 02:11:01 -0700
Subject: fix CCH update adding a TAXCAT, RT#21687

---
 FS/FS/tax_class.pm | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

(limited to 'FS')

diff --git a/FS/FS/tax_class.pm b/FS/FS/tax_class.pm
index bfec2c06c..eeb8993ee 100644
--- a/FS/FS/tax_class.pm
+++ b/FS/FS/tax_class.pm
@@ -259,13 +259,15 @@ sub batch_import {
                                  'description' => $type->[1].':'.$cat->[1],
                              } );
           my $error = $tax_class->insert;
-          return $error if $error;
+          return "can't insert tax_class for old TAXTYPE $type and new TAXCAT $cat: $error" if $error;
           $imported++;
         }
       }
 
+      my %cats = map { $_=>1 } ( @old_cats, @{$data->{'taxcat'}} );
+
       foreach my $type (@{$data->{'taxtype'}}) {
-        foreach my $cat (@old_cats, @{$data->{'taxcat'}}) {
+        foreach my $cat (keys %cats) {
 
           if ( $job ) {  # progress bar
             if ( time - $min_sec > $last ) {
@@ -283,7 +285,7 @@ sub batch_import {
                                  'description' => $type->[1].':'.$cat->[1],
                              } );
           my $error = $tax_class->insert;
-          return $error if $error;
+          return "can't insert tax_class for new TAXTYPE $type and TAXCAT $cat: $error" if $error;
           $imported++;
         }
       }
@@ -363,7 +365,7 @@ sub batch_import {
   my $error = &{$endhook}();
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
-    return "can't insert tax_class for $line: $error";
+    return "can't run end hook: $error";
   }
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-- 
cgit v1.2.1


From 9732b34df2fad5f09751766378c05eacd671e4fb Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Wed, 8 May 2013 02:55:51 -0700
Subject: fix CCH update adding a TAXCAT, RT#21687

---
 FS/FS/tax_class.pm | 27 +++++++++++++++++----------
 1 file changed, 17 insertions(+), 10 deletions(-)

(limited to 'FS')

diff --git a/FS/FS/tax_class.pm b/FS/FS/tax_class.pm
index eeb8993ee..15f9a42a6 100644
--- a/FS/FS/tax_class.pm
+++ b/FS/FS/tax_class.pm
@@ -253,21 +253,28 @@ sub batch_import {
             }
           }
 
-          my $tax_class =
-            new FS::tax_class( { 'data_vendor' => 'cch',
-                                 'taxclass'    => $type->[0].':'.$cat->[0],
-                                 'description' => $type->[1].':'.$cat->[1],
-                             } );
-          my $error = $tax_class->insert;
-          return "can't insert tax_class for old TAXTYPE $type and new TAXCAT $cat: $error" if $error;
+          my %hash = ( 'data_vendor' => 'cch',
+                       'taxclass'    => $type->[0].':'.$cat->[0],
+                       'description' => $type->[1].':'.$cat->[1],
+                     );
+          unless ( qsearchs('tax_class', \%hash) ) {
+            my $tax_class = new FS::tax_class \%hash;
+            my $error = $tax_class->insert;
+
+            return "can't insert tax_class for ".
+                   " old TAXTYPE ". $type->[0].':'.$type->[1].
+                   " and new TAXCAT ". $cat->[0].':'. $cat->[1].
+                   " : $error"
+              if $error;
+          }
+
           $imported++;
+          
         }
       }
 
-      my %cats = map { $_=>1 } ( @old_cats, @{$data->{'taxcat'}} );
-
       foreach my $type (@{$data->{'taxtype'}}) {
-        foreach my $cat (keys %cats) {
+        foreach my $cat (@old_cats, @{$data->{'taxcat'}}) {
 
           if ( $job ) {  # progress bar
             if ( time - $min_sec > $last ) {
-- 
cgit v1.2.1


From 56094325213b403e787bbfce7f3db7870b707173 Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Wed, 8 May 2013 03:31:32 -0700
Subject: debug CCH update replacing a TAXCAT, RT#21687

---
 FS/FS/tax_class.pm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'FS')

diff --git a/FS/FS/tax_class.pm b/FS/FS/tax_class.pm
index 15f9a42a6..376a1ad40 100644
--- a/FS/FS/tax_class.pm
+++ b/FS/FS/tax_class.pm
@@ -169,7 +169,7 @@ sub batch_import {
 
     $hook = sub { 
       my $hash = shift;
-
+warn Dumper($hash);
       if ($hash->{'table'} eq 'DETAIL') {
         push @{$data->{'taxcat'}}, [ $hash->{'value'}, $hash->{'description'} ]
           if ($hash->{'name'} eq 'TAXCAT' &&
@@ -194,6 +194,7 @@ sub batch_import {
                                        ($name eq 'TAXCAT' ? $value : '%')."'",
                                    );
             foreach (@tax_class) {
+warn "deleting ". $_->taxclass. ' '. $_->description. "\n";
               my $error = $_->delete;
               return $error if $error;
             }
-- 
cgit v1.2.1


From f744f757a01e1750afa55072c7208714f16d1d13 Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Wed, 8 May 2013 03:46:41 -0700
Subject: debug CCH update replacing a TAXCAT, RT#21687

---
 FS/FS/tax_class.pm | 1 +
 1 file changed, 1 insertion(+)

(limited to 'FS')

diff --git a/FS/FS/tax_class.pm b/FS/FS/tax_class.pm
index 376a1ad40..c8fe88968 100644
--- a/FS/FS/tax_class.pm
+++ b/FS/FS/tax_class.pm
@@ -169,6 +169,7 @@ sub batch_import {
 
     $hook = sub { 
       my $hash = shift;
+use Data::Dumper;
 warn Dumper($hash);
       if ($hash->{'table'} eq 'DETAIL') {
         push @{$data->{'taxcat'}}, [ $hash->{'value'}, $hash->{'description'} ]
-- 
cgit v1.2.1


From d8843f184a7f6ee87eec99724f2d6430c1df34ea Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Wed, 8 May 2013 03:51:33 -0700
Subject: revert changes checked into this branch by accident

---
 FS/FS/tax_class.pm | 31 ++++++++++---------------------
 1 file changed, 10 insertions(+), 21 deletions(-)

(limited to 'FS')

diff --git a/FS/FS/tax_class.pm b/FS/FS/tax_class.pm
index c8fe88968..bfec2c06c 100644
--- a/FS/FS/tax_class.pm
+++ b/FS/FS/tax_class.pm
@@ -169,8 +169,7 @@ sub batch_import {
 
     $hook = sub { 
       my $hash = shift;
-use Data::Dumper;
-warn Dumper($hash);
+
       if ($hash->{'table'} eq 'DETAIL') {
         push @{$data->{'taxcat'}}, [ $hash->{'value'}, $hash->{'description'} ]
           if ($hash->{'name'} eq 'TAXCAT' &&
@@ -195,7 +194,6 @@ warn Dumper($hash);
                                        ($name eq 'TAXCAT' ? $value : '%')."'",
                                    );
             foreach (@tax_class) {
-warn "deleting ". $_->taxclass. ' '. $_->description. "\n";
               my $error = $_->delete;
               return $error if $error;
             }
@@ -255,23 +253,14 @@ warn "deleting ". $_->taxclass. ' '. $_->description. "\n";
             }
           }
 
-          my %hash = ( 'data_vendor' => 'cch',
-                       'taxclass'    => $type->[0].':'.$cat->[0],
-                       'description' => $type->[1].':'.$cat->[1],
-                     );
-          unless ( qsearchs('tax_class', \%hash) ) {
-            my $tax_class = new FS::tax_class \%hash;
-            my $error = $tax_class->insert;
-
-            return "can't insert tax_class for ".
-                   " old TAXTYPE ". $type->[0].':'.$type->[1].
-                   " and new TAXCAT ". $cat->[0].':'. $cat->[1].
-                   " : $error"
-              if $error;
-          }
-
+          my $tax_class =
+            new FS::tax_class( { 'data_vendor' => 'cch',
+                                 'taxclass'    => $type->[0].':'.$cat->[0],
+                                 'description' => $type->[1].':'.$cat->[1],
+                             } );
+          my $error = $tax_class->insert;
+          return $error if $error;
           $imported++;
-          
         }
       }
 
@@ -294,7 +283,7 @@ warn "deleting ". $_->taxclass. ' '. $_->description. "\n";
                                  'description' => $type->[1].':'.$cat->[1],
                              } );
           my $error = $tax_class->insert;
-          return "can't insert tax_class for new TAXTYPE $type and TAXCAT $cat: $error" if $error;
+          return $error if $error;
           $imported++;
         }
       }
@@ -374,7 +363,7 @@ warn "deleting ". $_->taxclass. ' '. $_->description. "\n";
   my $error = &{$endhook}();
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
-    return "can't run end hook: $error";
+    return "can't insert tax_class for $line: $error";
   }
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-- 
cgit v1.2.1


From 120718856665ca90ad852535d1155f8ea8ecb6b6 Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Thu, 9 May 2013 01:42:39 -0700
Subject: NG auth: pw changes, RT#21563

---
 FS/FS/Auth/internal.pm | 57 ++++++++++++++++++++++++++++++++++++++------------
 FS/FS/access_user.pm   | 23 +++++++++++++++++++-
 2 files changed, 66 insertions(+), 14 deletions(-)

(limited to 'FS')

diff --git a/FS/FS/Auth/internal.pm b/FS/FS/Auth/internal.pm
index 5d9170e23..bb116ce75 100644
--- a/FS/FS/Auth/internal.pm
+++ b/FS/FS/Auth/internal.pm
@@ -2,29 +2,32 @@ package FS::Auth::internal;
 #use base qw( FS::Auth );
 
 use strict;
-use Crypt::Eksblowfish::Bcrypt qw(bcrypt_hash);
+use Crypt::Eksblowfish::Bcrypt qw(bcrypt_hash en_base64 de_base64);
 use FS::Record qw( qsearchs );
 use FS::access_user;
 
 sub authenticate {
   my($self, $username, $check_password ) = @_;
 
-  my $access_user = qsearchs('access_user', { 'username' => $username,
-                                              'disabled' => '',
-                                            }
-                            )
+  my $access_user =
+    ref($username) ? $username
+                   : qsearchs('access_user', { 'username' => $username,
+                                               'disabled' => '',
+                                             }
+                             )
     or return 0;
 
   if ( $access_user->_password_encoding eq 'bcrypt' ) {
 
     my( $cost, $salt, $hash ) = split(',', $access_user->_password);
 
-    my $check_hash = bcrypt_hash( { key_nul => 1,
-                                    cost    => $cost,
-                                    salt    => $salt,
-                                  },
-                                  $check_password
-                                );
+    my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
+                                               cost    => $cost,
+                                               salt    => de_base64($salt),
+                                             },
+                                             $check_password
+                                           )
+                              );
 
     $hash eq $check_hash;
 
@@ -39,7 +42,35 @@ sub authenticate {
 
 }
 
-#sub change_password {
-#}
+sub change_password {
+  my($self, $access_user, $new_password) = @_;
+
+  $self->change_password_fields( $access_user, $new_password );
+
+  $access_user->replace;
+
+}
+
+sub change_password_fields {
+  my($self, $access_user, $new_password) = @_;
+
+  $access_user->_password_encoding('bcrypt');
+
+  my $cost = 8;
+
+  my $salt = pack( 'C*', map int(rand(256)), 1..16 );
+
+  my $hash = bcrypt_hash( { key_nul => 1,
+                            cost    => $cost,
+                            salt    => $salt,
+                          },
+                          $new_password,
+                        );
+
+  $access_user->_password(
+    join(',', $cost, en_base64($salt), en_base64($hash) )
+  );
+
+}
 
 1;
diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm
index 509cc0950..cdee3773b 100644
--- a/FS/FS/access_user.pm
+++ b/FS/FS/access_user.pm
@@ -4,6 +4,7 @@ use strict;
 use base qw( FS::m2m_Common FS::option_Common ); 
 use vars qw( $DEBUG $me $conf $htpasswd_file );
 use FS::UID;
+use FS::Auth;
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs dbh );
 use FS::access_user_pref;
@@ -563,7 +564,27 @@ sub is_system_user {
     fs_signup
     fs_bootstrap
     fs_selfserv
-) );
+  ) );
+}
+
+=item change_password NEW_PASSWORD
+
+=cut
+
+sub change_password {
+  #my( $self, $password ) = @_;
+  #FS::Auth->auth_class->change_password( $self, $password );
+  FS::Auth->auth_class->change_password( @_ );
+}
+
+=item change_password_fields NEW_PASSWORD
+
+=cut
+
+sub change_password_fields {
+  #my( $self, $password ) = @_;
+  #FS::Auth->auth_class->change_password_fields( $self, $password );
+  FS::Auth->auth_class->change_password_fields( @_ );
 }
 
 =back
-- 
cgit v1.2.1


From 19eef2ec0e68587304cd597fc5b2f8e1f151e424 Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Thu, 9 May 2013 02:09:09 -0700
Subject: NG auth: pw changes, RT#21563

---
 FS/FS/access_user.pm | 58 ++++++++--------------------------------------------
 1 file changed, 8 insertions(+), 50 deletions(-)

(limited to 'FS')

diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm
index cdee3773b..79e863bde 100644
--- a/FS/FS/access_user.pm
+++ b/FS/FS/access_user.pm
@@ -2,7 +2,7 @@ package FS::access_user;
 
 use strict;
 use base qw( FS::m2m_Common FS::option_Common ); 
-use vars qw( $DEBUG $me $conf $htpasswd_file );
+use vars qw( $DEBUG $me $conf );
 use FS::UID;
 use FS::Auth;
 use FS::Conf;
@@ -15,12 +15,6 @@ use FS::cust_main;
 $DEBUG = 0;
 $me = '[FS::access_user]';
 
-#kludge htpasswd for now (i hope this bootstraps okay)
-FS::UID->install_callback( sub {
-  $conf = new FS::Conf;
-  $htpasswd_file = $conf->base_dir. '/htpasswd';
-} );
-
 =head1 NAME
 
 FS::access_user - Object methods for access_user records
@@ -106,7 +100,6 @@ sub insert {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  $error = $self->htpasswd_kludge();
   if ( $error ) {
     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
     return $error;
@@ -116,14 +109,7 @@ sub insert {
 
   if ( $error ) {
     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
-
-    #make sure it isn't a dup username?  or you could nuke people's passwords
-    #blah.  really just should do our own login w/cookies
-    #and auth out of the db in the first place
-    #my $hterror = $self->htpasswd_kludge('-D');
-    #$error .= " - additionally received error cleaning up htpasswd file: $hterror"
     return $error;
-
   } else {
     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
     '';
@@ -131,26 +117,6 @@ sub insert {
 
 }
 
-sub htpasswd_kludge {
-  my $self = shift;
-
-  return '' if $self->is_system_user;
-
-  unshift @_, '-c' unless -e $htpasswd_file;
-  if ( 
-       system('htpasswd', '-b', @_,
-                          $htpasswd_file,
-                          $self->username,
-                          $self->_password,
-             ) == 0
-     )
-  {
-    return '';
-  } else {
-    return 'htpasswd exited unsucessfully';
-  }
-}
-
 =item delete
 
 Delete this record from the database.
@@ -171,10 +137,7 @@ sub delete {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $error =
-       $self->SUPER::delete(@_)
-    || $self->htpasswd_kludge('-D')
-  ;
+  my $error = $self->SUPER::delete(@_);
 
   if ( $error ) {
     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
@@ -211,16 +174,11 @@ sub replace {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  if ( $new->_password ne $old->_password ) {
-    my $error = $new->htpasswd_kludge();
-    if ( $error ) {
-      $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
-      return $error;
-    }
-  } elsif ( $old->disabled && !$new->disabled
-              && $new->_password =~ /changeme/i ) {
-    return "Must change password when enabling this account";
-  }
+  return "Must change password when enabling this account"
+    if $old->disabled && !$new->disabled
+    && (      $new->_password =~ /changeme/i
+           || $new->_password eq 'notyet'
+       );
 
   my $error = $new->SUPER::replace($old, @_);
 
@@ -551,7 +509,7 @@ sub spreadsheet_format {
 =item is_system_user
 
 Returns true if this user has the name of a known system account.  These 
-users will not appear in the htpasswd file and can't have passwords set.
+users cannot log into the web interface and can't have passwords set.
 
 =cut
 
-- 
cgit v1.2.1


From 56f9dffcd409d2a10e7a2cbe4c15b397f6f3abe1 Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Thu, 9 May 2013 21:42:37 -0700
Subject: NG auth: autocreate records for external users, RT#21563

---
 FS/FS/Auth/external.pm     | 13 ++---------
 FS/FS/Auth/internal.pm     |  2 ++
 FS/FS/Auth/legacy.pm       |  2 ++
 FS/FS/AuthCookieHandler.pm | 15 ++++++-------
 FS/FS/CurrentUser.pm       | 55 +++++++++++++++++++++++++++++++++++++++-------
 FS/FS/Schema.pm            |  6 ++---
 FS/FS/access_user.pm       |  9 ++++----
 7 files changed, 68 insertions(+), 34 deletions(-)

(limited to 'FS')

diff --git a/FS/FS/Auth/external.pm b/FS/FS/Auth/external.pm
index d2bc74600..51f1f0496 100644
--- a/FS/FS/Auth/external.pm
+++ b/FS/FS/Auth/external.pm
@@ -1,18 +1,9 @@
-packages FS::Auth::external;
+package FS::Auth::external;
 #use base qw( FS::Auth );
 
 use strict;
 
-sub autocreate {
-  my $username = shift;
-  my $access_user = new FS::access_user {
-    'username' => $username,
-    #'_password' => #XXX something random so a switch to internal auth doesn't
-                    #let people on?
-  };
-  my $error = $access_user->insert;
-  #die $error if $error;
-}
+sub autocreate { 1; }
 
 1;
 
diff --git a/FS/FS/Auth/internal.pm b/FS/FS/Auth/internal.pm
index bb116ce75..f6d1a0086 100644
--- a/FS/FS/Auth/internal.pm
+++ b/FS/FS/Auth/internal.pm
@@ -42,6 +42,8 @@ sub authenticate {
 
 }
 
+sub autocreate { 0; }
+
 sub change_password {
   my($self, $access_user, $new_password) = @_;
 
diff --git a/FS/FS/Auth/legacy.pm b/FS/FS/Auth/legacy.pm
index 72122029e..1133197bc 100644
--- a/FS/FS/Auth/legacy.pm
+++ b/FS/FS/Auth/legacy.pm
@@ -16,6 +16,8 @@ sub authenticate {
     )->htCheckPassword($username, $check_password);
 }
 
+sub autocreate { 0; }
+
 #don't support this in legacy?  change in both htpasswd and database like 3.x
 # for easier transitioning?  hoping its really only me+employees that have a
 # mismatch in htpasswd vs access_user, so maybe that's not necessary
diff --git a/FS/FS/AuthCookieHandler.pm b/FS/FS/AuthCookieHandler.pm
index cd89f55af..b571e4705 100644
--- a/FS/FS/AuthCookieHandler.pm
+++ b/FS/FS/AuthCookieHandler.pm
@@ -11,24 +11,23 @@ sub authen_cred {
 
   preuser_setup();
 
-  unless ( _is_valid_user($username, $password) ) {
+  my $info = {};
+
+  unless ( FS::Auth->authenticate($username, $password, $info) ) {
     warn "failed auth $username from ". $r->connection->remote_ip. "\n";
     return undef;
   }
 
   warn "authenticated $username from ". $r->connection->remote_ip. "\n";
 
-  FS::CurrentUser->load_user($username);
+  FS::CurrentUser->load_user( $username,
+                              'autocreate' => FS::Auth->auth_class->autocreate,
+                              %$info,
+                            );
 
   FS::CurrentUser->new_session;
 }
 
-sub _is_valid_user {
-  my( $username, $password ) = @_;
-
-  FS::Auth->authenticate($username, $password);
-}
-
 sub authen_ses_key {
   my( $self, $r, $sessionkey ) = @_;
 
diff --git a/FS/FS/CurrentUser.pm b/FS/FS/CurrentUser.pm
index 7b0fe28a6..d272066e0 100644
--- a/FS/FS/CurrentUser.pm
+++ b/FS/FS/CurrentUser.pm
@@ -27,13 +27,13 @@ Sets the current user to the provided username
 =cut
 
 sub load_user {
-  my( $class, $user ) = @_; #, $pass
+  my( $class, $username, %opt ) = @_;
 
   if ( $upgrade_hack ) {
     return $CurrentUser = new FS::CurrentUser::BootstrapUser;
   }
 
-  #return "" if $user =~ /^fs_(queue|selfservice)$/;
+  #return "" if $username =~ /^fs_(queue|selfservice)$/;
 
   #not the best thing in the world...
   eval "use FS::Record qw(qsearchs);";
@@ -41,13 +41,52 @@ sub load_user {
   eval "use FS::access_user;";
   die $@ if $@;
 
-  $CurrentUser = qsearchs('access_user', {
-    'username' => $user,
-    #'_password' =>
-    'disabled' => '',
-  } );
+  my %hash = ( 'username' => $username,
+               'disabled' => '',
+             );
 
-  die "unknown user: $user" unless $CurrentUser; # or bad password
+  $CurrentUser = qsearchs('access_user', \%hash) and return $CurrentUser;
+
+  die "unknown user: $username" unless $opt{'autocreate'};
+
+  $CurrentUser = new FS::access_user \%hash;
+  $CurrentUser->set($_, $opt{$_}) foreach qw( first last );
+  my $error = $CurrentUser->insert;
+  die $error if $error; #better way to handle this error?
+
+  my $template_user =
+    $opt{'template_user'}
+      || FS::Conf->new->config('external_auth-access_group-template_user');
+
+  if ( $template_user ) {
+
+    my $tmpl_access_user =
+       qsearchs('access_user', { 'username' => $template_user } );
+
+    if ( $tmpl_access_user ) {
+      eval "use FS::access_usergroup;";
+      die $@ if $@;
+
+      foreach my $tmpl_access_usergroup
+                ($tmpl_access_user->access_usergroup) {
+        my $access_usergroup = new FS::access_usergroup {
+          'usernum'  => $CurrentUser->usernum,
+          'groupnum' => $tmpl_access_usergroup->groupnum,
+        };
+        my $error = $access_usergroup->insert;
+        if ( $error ) {
+          #shouldn't happen, but seems better to proceed than to die
+          warn "error inserting access_usergroup: $error";
+        };
+      }
+
+    } else {
+      warn "template username $template_user not found\n";
+    }
+
+  } else {
+    warn "no access template user for autocreated user $username\n";
+  }
 
   $CurrentUser;
 }
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 899b67b35..633e59cb6 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -3586,10 +3586,10 @@ sub tables_hashref {
       'columns' => [
         'usernum',             'serial',     '',      '', '', '',
         'username',           'varchar',     '', $char_d, '', '',
-        '_password',          'varchar',     '', $char_d, '', '',
+        '_password',          'varchar', 'NULL', $char_d, '', '',
         '_password_encoding', 'varchar', 'NULL', $char_d, '', '',
-        'last',               'varchar',     '', $char_d, '', '', 
-        'first',              'varchar',     '', $char_d, '', '', 
+        'last',               'varchar', 'NULL', $char_d, '', '', 
+        'first',              'varchar', 'NULL', $char_d, '', '', 
         'user_custnum',           'int', 'NULL',      '', '', '',
         'disabled',              'char', 'NULL',       1, '', '', 
       ],
diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm
index 79e863bde..7c25acbe3 100644
--- a/FS/FS/access_user.pm
+++ b/FS/FS/access_user.pm
@@ -209,9 +209,9 @@ sub check {
   my $error = 
     $self->ut_numbern('usernum')
     || $self->ut_alpha_lower('username')
-    || $self->ut_text('_password')
-    || $self->ut_text('last')
-    || $self->ut_text('first')
+    || $self->ut_textn('_password')
+    || $self->ut_textn('last')
+    || $self->ut_textn('first')
     || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
     || $self->ut_enum('disabled', [ '', 'Y' ] )
   ;
@@ -229,7 +229,8 @@ Returns a name string for this user: "Last, First".
 sub name {
   my $self = shift;
   return $self->username
-    if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname';
+    if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname'
+    or $self->get('last') eq ''         && $self->first eq '';
   return $self->get('last'). ', '. $self->first;
 }
 
-- 
cgit v1.2.1


From 0832972047a36d19ffcf7d1462abc48de7045d3d Mon Sep 17 00:00:00 2001
From: Ivan Kohler <ivan@freeside.biz>
Date: Thu, 9 May 2013 21:42:51 -0700
Subject: NG auth: autocreate records for external users, RT#21563

---
 FS/FS/Conf.pm | 7 +++++++
 1 file changed, 7 insertions(+)

(limited to 'FS')

diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 869ce1e73..831ffe2a3 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -5431,6 +5431,13 @@ and customer address. Include units.',
     'select_enum' => [qw( Internal Legacy )],
   },
 
+  {
+    'key'         => 'external_auth-access_group-template_user',
+    'section'     => 'UI',
+    'description' => 'When using an external authentication module, specifies the default access groups for autocreated users, via a template user.',
+    'type'        => 'text',
+  },
+
   { key => "apacheroot", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
   { key => "apachemachine", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
   { key => "apachemachines", section => "deprecated", description => "<b>DEPRECATED</b>", type => "text" },
-- 
cgit v1.2.1