[freeside-commits] branch FREESIDE_2_3_BRANCH updated. f6cd8c64f3237b6b98351385adedc5b5c727258b

Ivan ivan at 420.am
Thu Dec 26 12:39:49 PST 2013


The branch, FREESIDE_2_3_BRANCH has been updated
       via  f6cd8c64f3237b6b98351385adedc5b5c727258b (commit)
      from  aa8c6cf683adc4684f169915a6bb0e82b36be824 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit f6cd8c64f3237b6b98351385adedc5b5c727258b
Author: Ivan Kohler <ivan at freeside.biz>
Date:   Thu Dec 26 12:39:38 2013 -0800

    backport some unused new-style auth stuff from master for development purposes, should be harmless, RT#21563, RT#26097

diff --git a/FS/FS/Auth.pm b/FS/FS/Auth.pm
new file mode 100644
index 0000000..543978e
--- /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/Auth/external.pm b/FS/FS/Auth/external.pm
new file mode 100644
index 0000000..51f1f04
--- /dev/null
+++ b/FS/FS/Auth/external.pm
@@ -0,0 +1,9 @@
+package FS::Auth::external;
+#use base qw( FS::Auth );
+
+use strict;
+
+sub autocreate { 1; }
+
+1;
+
diff --git a/FS/FS/Auth/internal.pm b/FS/FS/Auth/internal.pm
new file mode 100644
index 0000000..f6d1a00
--- /dev/null
+++ b/FS/FS/Auth/internal.pm
@@ -0,0 +1,78 @@
+package FS::Auth::internal;
+#use base qw( FS::Auth );
+
+use strict;
+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 =
+    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 = en_base64( bcrypt_hash( { key_nul => 1,
+                                               cost    => $cost,
+                                               salt    => de_base64($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 autocreate { 0; }
+
+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/Auth/legacy.pm b/FS/FS/Auth/legacy.pm
new file mode 100644
index 0000000..1133197
--- /dev/null
+++ b/FS/FS/Auth/legacy.pm
@@ -0,0 +1,27 @@
+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);
+}
+
+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
+#sub change_password {
+#}
+
+1;
diff --git a/FS/FS/AuthCookieHandler.pm b/FS/FS/AuthCookieHandler.pm
new file mode 100644
index 0000000..b571e47
--- /dev/null
+++ b/FS/FS/AuthCookieHandler.pm
@@ -0,0 +1,46 @@
+package FS::AuthCookieHandler;
+use base qw( Apache2::AuthCookie );
+
+use strict;
+use FS::UID qw( adminsuidsetup preuser_setup );
+use FS::CurrentUser;
+use FS::Auth;
+
+sub authen_cred {
+  my( $self, $r, $username, $password ) = @_;
+
+  preuser_setup();
+
+  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,
+                              'autocreate' => FS::Auth->auth_class->autocreate,
+                              %$info,
+                            );
+
+  FS::CurrentUser->new_session;
+}
+
+sub authen_ses_key {
+  my( $self, $r, $sessionkey ) = @_;
+
+  preuser_setup();
+
+  my $curuser = FS::CurrentUser->load_user_session( $sessionkey );
+
+  unless ( $curuser ) {
+    warn "bad session $sessionkey from ". $r->connection->remote_ip. "\n";
+    return undef;
+  }
+
+  $curuser->username;
+}
+
+1;
diff --git a/FS/FS/AuthCookieHandler24.pm b/FS/FS/AuthCookieHandler24.pm
new file mode 100644
index 0000000..fa24890
--- /dev/null
+++ b/FS/FS/AuthCookieHandler24.pm
@@ -0,0 +1,46 @@
+package FS::AuthCookieHandler24;
+use base qw( Apache2::AuthCookie );
+
+use strict;
+use FS::UID qw( adminsuidsetup preuser_setup );
+use FS::CurrentUser;
+use FS::Auth;
+
+sub authen_cred {
+  my( $self, $r, $username, $password ) = @_;
+
+  preuser_setup();
+
+  my $info = {};
+
+  unless ( FS::Auth->authenticate($username, $password, $info) ) {
+    warn "failed auth $username from ". $r->useragent_ip. "\n";
+    return undef;
+  }
+
+  warn "authenticated $username from ". $r->useragent_ip. "\n";
+
+  FS::CurrentUser->load_user( $username,
+                              'autocreate' => FS::Auth->auth_class->autocreate,
+                              %$info,
+                            );
+
+  FS::CurrentUser->new_session;
+}
+
+sub authen_ses_key {
+  my( $self, $r, $sessionkey ) = @_;
+
+  preuser_setup();
+
+  my $curuser = FS::CurrentUser->load_user_session( $sessionkey );
+
+  unless ( $curuser ) {
+    warn "bad session $sessionkey from ". $r->useragent_ip. "\n";
+    return undef;
+  }
+
+  $curuser->username;
+}
+
+1;
diff --git a/FS/FS/CurrentUser.pm b/FS/FS/CurrentUser.pm
index bcd337d..a1b57cb 100644
--- a/FS/FS/CurrentUser.pm
+++ b/FS/FS/CurrentUser.pm
@@ -44,6 +44,62 @@ sub load_user {
   $CurrentUser;
 }
 
+=item new_session
+
+Creates a new session for the current user and returns the session key
+
+=cut
+
+use vars qw( @saltset );
+ at saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '+' , '/' );
+
+sub new_session {
+  my( $class ) = @_;
+
+  #not the best thing in the world...
+  eval "use FS::access_user_session;";
+  die $@ if $@;
+
+  my $sessionkey = join('', map $saltset[int(rand(scalar @saltset))], 0..39);
+
+  my $access_user_session = new FS::access_user_session {
+    'sessionkey' => $sessionkey,
+    'usernum'    => $CurrentUser->usernum,
+    'start_date' => time,
+  };
+  my $error = $access_user_session->insert;
+  die $error if $error;
+
+  return $sessionkey;
+
+}
+
+=item load_user_session SESSION_KEY
+
+Sets the current user via the provided session key
+
+=cut
+
+sub load_user_session {
+  my( $class, $sessionkey ) = @_;
+
+  #not the best thing in the world...
+  eval "use FS::Record qw(qsearchs);";
+  die $@ if $@;
+  eval "use FS::access_user_session;";
+  die $@ if $@;
+
+  $CurrentSession = qsearchs('access_user_session', {
+    'sessionkey' => $sessionkey,
+    #XXX check for timed out but not-yet deleted sessions here
+  }) or return '';
+
+  $CurrentSession->touch_last_date;
+
+  $CurrentUser = $CurrentSession->access_user;
+
+}
+
 =head1 BUGS
 
 Creepy crawlies
diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm
index 67bb75f..9592447 100644
--- a/FS/FS/UID.pm
+++ b/FS/FS/UID.pm
@@ -16,9 +16,11 @@ use IO::File;
 use FS::CurrentUser;
 
 @ISA = qw(Exporter);
- at EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
-                getotaker dbh datasrc getsecrets driver_name myconnect
-                use_confcompat);
+ at EXPORT_OK = qw( checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
+                 preuser_setup
+                 getotaker dbh datasrc getsecrets driver_name myconnect
+                 use_confcompat
+               );
 
 $DEBUG = 0;
 $me = '[FS::UID]';
@@ -149,6 +151,84 @@ sub forksuidsetup {
   $dbh;
 }
 
+# start of backported functions from HEAD/4.x only used in development w/
+#  a new style AuthCookie setup
+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;
+  if ( $FS::CurrentUser::upgrade_hack && $olduser ) {
+    $dbh = &myconnect($olduser);
+  } else {
+    $dbh = &myconnect();
+  }
+  warn "$me forksuidsetup connected to database with handle $dbh\n" if $DEBUG;
+
+  warn "$me forksuidsetup loading schema\n" if $DEBUG;
+  use FS::Schema qw(reload_dbdef dbdef);
+  reload_dbdef("$conf_dir/dbdef.$datasrc")
+    unless $FS::Schema::setup_hack;
+
+  warn "$me forksuidsetup deciding upon config system to use\n" if $DEBUG;
+
+  if ( ! $FS::Schema::setup_hack && dbdef->table('conf') ) {
+
+    my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
+    $sth->execute or die $sth->errstr;
+    my $confcount = $sth->fetchrow_arrayref->[0];
+  
+    if ($confcount) {
+      $use_confcompat = 0;
+    }else{
+      die "NO CONFIGURATION RECORDS FOUND";
+    }
+
+  } else {
+    die "NO CONFIGURATION TABLE FOUND" unless $FS::Schema::setup_hack;
+  }
+
+
+}
+# end of backported functions from HEAD/4.x only used in development
+
+sub callback_setup {
+
+  unless ( $callback_hack ) {
+    warn "$me calling callbacks\n" if $DEBUG;
+    foreach ( keys %callback ) {
+      &{$callback{$_}};
+      # breaks multi-database installs # delete $callback{$_}; #run once
+    }
+
+    &{$_} foreach @callback;
+  } else {
+    warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
+  }
+
+}
+
+
 sub myconnect {
   my $handle = DBI->connect( getsecrets(@_), { 'AutoCommit'         => 0,
                                                'ChopBlanks'         => 1,
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;
+

-----------------------------------------------------------------------

Summary of changes:
 FS/FS/Auth.pm                |   25 +++++++
 FS/FS/Auth/external.pm       |    9 +++
 FS/FS/Auth/internal.pm       |   78 +++++++++++++++++++++
 FS/FS/Auth/legacy.pm         |   27 +++++++
 FS/FS/AuthCookieHandler.pm   |   46 ++++++++++++
 FS/FS/AuthCookieHandler24.pm |   46 ++++++++++++
 FS/FS/CurrentUser.pm         |   56 +++++++++++++++
 FS/FS/UID.pm                 |   86 ++++++++++++++++++++++-
 FS/FS/access_user_session.pm |  158 ++++++++++++++++++++++++++++++++++++++++++
 9 files changed, 528 insertions(+), 3 deletions(-)
 create mode 100644 FS/FS/Auth.pm
 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
 create mode 100644 FS/FS/AuthCookieHandler24.pm
 create mode 100644 FS/FS/access_user_session.pm




More information about the freeside-commits mailing list