diff options
author | Ivan Kohler <ivan@freeside.biz> | 2013-05-10 12:55:52 -0700 |
---|---|---|
committer | Ivan Kohler <ivan@freeside.biz> | 2013-05-10 12:55:52 -0700 |
commit | 63973c641c4be00765fa27e55c57cc5b9aa4da19 (patch) | |
tree | 68ea71023d7116229e97fd27b38b87b5ac65228a /FS/FS | |
parent | 7b5a266236857fbb4bbf8d4ac3031c3fec75cac2 (diff) | |
parent | 0832972047a36d19ffcf7d1462abc48de7045d3d (diff) |
merge NG auth, RT#21563
Diffstat (limited to 'FS/FS')
-rw-r--r-- | FS/FS/Auth.pm | 25 | ||||
-rw-r--r-- | FS/FS/Auth/external.pm | 9 | ||||
-rw-r--r-- | FS/FS/Auth/internal.pm | 78 | ||||
-rw-r--r-- | FS/FS/Auth/legacy.pm | 27 | ||||
-rw-r--r-- | FS/FS/AuthCookieHandler.pm | 46 | ||||
-rw-r--r-- | FS/FS/CGI.pm | 6 | ||||
-rw-r--r-- | FS/FS/Conf.pm | 15 | ||||
-rw-r--r-- | FS/FS/CurrentUser.pm | 125 | ||||
-rw-r--r-- | FS/FS/Mason.pm | 2 | ||||
-rw-r--r-- | FS/FS/Mason/Request.pm | 33 | ||||
-rw-r--r-- | FS/FS/Record.pm | 13 | ||||
-rw-r--r-- | FS/FS/Schema.pm | 32 | ||||
-rw-r--r-- | FS/FS/UI/Web.pm | 4 | ||||
-rw-r--r-- | FS/FS/UID.pm | 163 | ||||
-rw-r--r-- | FS/FS/access_user.pm | 90 | ||||
-rw-r--r-- | FS/FS/access_user_session.pm | 158 | ||||
-rw-r--r-- | FS/FS/banned_pay.pm | 1 | ||||
-rw-r--r-- | FS/FS/cust_credit.pm | 2 | ||||
-rw-r--r-- | FS/FS/cust_credit_bill.pm | 1 | ||||
-rw-r--r-- | FS/FS/cust_main.pm | 2 | ||||
-rw-r--r-- | FS/FS/cust_main/Status.pm | 5 | ||||
-rw-r--r-- | FS/FS/cust_pay.pm | 1 | ||||
-rw-r--r-- | FS/FS/cust_pay_refund.pm | 1 | ||||
-rw-r--r-- | FS/FS/cust_pay_void.pm | 1 | ||||
-rw-r--r-- | FS/FS/cust_pkg.pm | 2 | ||||
-rw-r--r-- | FS/FS/cust_refund.pm | 1 |
26 files changed, 632 insertions, 211 deletions
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/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/Conf.pm b/FS/FS/Conf.pm index d955f34ae..3c445200c 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -5454,6 +5454,21 @@ 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' => '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" }, diff --git a/FS/FS/CurrentUser.pm b/FS/FS/CurrentUser.pm index bcd337d2c..d272066e0 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,22 +10,30 @@ $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 { - 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);"; @@ -33,20 +41,115 @@ sub load_user { eval "use FS::access_user;"; die $@ if $@; - $CurrentUser = qsearchs('access_user', { - 'username' => $user, - #'_password' => - 'disabled' => '', - } ); + my %hash = ( 'username' => $username, + 'disabled' => '', + ); + + $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 $@; - die "unknown user: $user" unless $CurrentUser; # or bad password + 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; } +=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/Mason.pm b/FS/FS/Mason.pm index 1553a42df..6653fb7e1 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/Mason/Request.pm b/FS/FS/Mason/Request.pm index 36c46dc41..5d6fc4cd4 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, equivalent 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/Record.pm b/FS/FS/Record.pm index bdf3bcf3a..15636af9c 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; @@ -1909,7 +1909,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 + ). ")" ; } @@ -1940,11 +1944,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/Schema.pm b/FS/FS/Schema.pm index bbc4f1d21..28c7fc465 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->{$_} @@ -3592,15 +3592,29 @@ 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', '', '', '', '', - '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', 'NULL', $char_d, '', '', + '_password_encoding', 'varchar', 'NULL', $char_d, '', '', + 'last', 'varchar', 'NULL', $char_d, '', '', + 'first', 'varchar', 'NULL', $char_d, '', '', + 'user_custnum', 'int', 'NULL', '', '', '', + 'disabled', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'usernum', 'unique' => [ [ 'username' ] ], diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index c8ad430b2..f63854ca0 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -582,7 +582,7 @@ use Carp; use Storable qw(nfreeze); use MIME::Base64; use JSON::XS; -use FS::UID qw(getotaker); +use FS::CurrentUser; use FS::Record qw(qsearchs); use FS::queue; use FS::CGI qw(rooturl); @@ -656,7 +656,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 67bb75fe3..9c52f0883 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -2,23 +2,23 @@ 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 ); -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 + preuser_setup + getotaker dbh datasrc getsecrets driver_name myconnect + use_confcompat + ); $DEBUG = 0; $me = '[FS::UID]'; @@ -38,13 +38,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 checkeuid checkruid); - $cgi = new CGI; - $dbh = cgisuidsetup($cgi); + $dbh = adminsuidsetup $user; $dbh = dbh; @@ -66,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). @@ -78,7 +73,7 @@ sub adminsuidsetup { } sub forksuidsetup { - $user = shift; + my $user = shift; my $olduser = $user; warn "$me forksuidsetup starting for $user\n" if $DEBUG; @@ -91,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; @@ -131,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 ) { @@ -143,19 +170,15 @@ 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 { - 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"; @@ -194,35 +217,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 @@ -262,35 +276,13 @@ sub suidsetup { =item getotaker -Returns the current Freeside user. +(Deprecated) Returns the current Freeside user's username. =cut 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; + carp "FS::UID::getotaker deprecated"; + $FS::CurrentUser::CurrentUser->username; } =item checkeuid @@ -314,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); @@ -390,8 +366,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.pm b/FS/FS/access_user.pm index 509cc0950..7c25acbe3 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -2,8 +2,9 @@ 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; use FS::Record qw( qsearch qsearchs dbh ); use FS::access_user_pref; @@ -14,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 @@ -105,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; @@ -115,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; ''; @@ -130,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. @@ -170,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; @@ -210,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, @_); @@ -250,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' ] ) ; @@ -270,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; } @@ -550,7 +510,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 @@ -563,7 +523,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 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/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 f21932cf6..1d6e84588 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 0e9e8a716..da9143909 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 c49007ce1..4dced5461 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -11,7 +11,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; |