[freeside-commits] branch FREESIDE_3_BRANCH updated. 7b42fc3d69f111b2e79f2a43263c129fd3505938
Ivan
ivan at 420.am
Thu Dec 26 12:39:47 PST 2013
The branch, FREESIDE_3_BRANCH has been updated
via 7b42fc3d69f111b2e79f2a43263c129fd3505938 (commit)
from d3c4d0df775c4dc2f8346ac29b7075753216bcb5 (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 7b42fc3d69f111b2e79f2a43263c129fd3505938
Author: Ivan Kohler <ivan at freeside.biz>
Date: Thu Dec 26 12:39:36 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