From: Ivan Kohler Date: Thu, 26 Dec 2013 20:39:38 +0000 (-0800) Subject: backport some unused new-style auth stuff from master for development purposes, shoul... X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=f6cd8c64f3237b6b98351385adedc5b5c727258b 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 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/Auth/external.pm b/FS/FS/Auth/external.pm new file mode 100644 index 000000000..51f1f0496 --- /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 000000000..f6d1a0086 --- /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 000000000..1133197bc --- /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 000000000..b571e4705 --- /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 000000000..fa24890cc --- /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 bcd337d2c..a1b57cbfb 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 ); +@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 67bb75fe3..95924477c 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -16,9 +16,11 @@ 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 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 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) + +=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 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) 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, schema.html from the base documentation. + +=cut + +1; +