From: Ivan Kohler Date: Fri, 10 May 2013 19:55:52 +0000 (-0700) Subject: merge NG auth, RT#21563 X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=63973c641c4be00765fa27e55c57cc5b9aa4da19;hp=7b5a266236857fbb4bbf8d4ac3031c3fec75cac2 merge NG auth, RT#21563 --- diff --git a/FS/FS.pm b/FS/FS.pm index 77dd4ff20..042c756d0 100644 --- a/FS/FS.pm +++ b/FS/FS.pm @@ -87,6 +87,8 @@ L - Mixin class for records in tables that contain payinfo. L - Employees / internal users +L - Access sessions + L - Employee preferences L - Employee groups 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 => "DEPRECATED", type => "text" }, { key => "apachemachine", section => "deprecated", description => "DEPRECATED", type => "text" }, { key => "apachemachines", section => "deprecated", description => "DEPRECATED", 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) or Apache (see L) -object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup. +Returns the CGI (see L) 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) object. +Sets the CGI (see L) 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) or an Apache object (see L). 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) + +=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; + 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; diff --git a/FS/MANIFEST b/FS/MANIFEST index 94232905e..ee184071e 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 @@ -690,3 +694,5 @@ FS/cdr_cust_pkg_usage.pm t/cdr_cust_pkg_usage.t FS/part_pkg_msgcat.pm t/part_pkg_msgcat.t +FS/access_user_session.pm +t/access_user_session.t 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 3d1c2e072..5bd141538 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); 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"; diff --git a/Makefile b/Makefile index dd7adb0bd..5e425311e 100644 --- a/Makefile +++ b/Makefile @@ -179,7 +179,6 @@ install-docs: docs " ${MASON_HANDLER} || true mkdir -p ${FREESIDE_EXPORT}/profile chown freeside ${FREESIDE_EXPORT}/profile - cp htetc/htpasswd.logout ${FREESIDE_CONF} [ ! -e ${MASONDATA} ] && mkdir ${MASONDATA} || true chown -R freeside ${MASONDATA} diff --git a/bin/fs-migrate-svc_acct_sm b/bin/fs-migrate-svc_acct_sm deleted file mode 100755 index 07f7b611c..000000000 --- a/bin/fs-migrate-svc_acct_sm +++ /dev/null @@ -1,227 +0,0 @@ -#!/usr/bin/perl -Tw -# -# jeff@cmh.net 01-Jul-20 - -#to delay loading dbdef until we're ready -#BEGIN { $FS::Record::setup_hack = 1; } - -use strict; -use Term::Query qw(query); -#use DBI; -#use DBIx::DBSchema; -#use DBIx::DBSchema::Table; -#use DBIx::DBSchema::Column; -#use DBIx::DBSchema::ColGroup::Unique; -#use DBIx::DBSchema::ColGroup::Index; -use FS::Conf; -use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets); -use FS::Record qw(qsearch qsearchs); -use FS::svc_domain; -use FS::svc_forward; -use vars qw( $conf $old_default_domain %part_domain_svc %part_acct_svc %part_forward_svc $svc_acct $svc_acct_sm $error); - -die "Not running uid freeside!" unless checkeuid(); - -my $user = shift or die &usage; -getsecrets($user); - -$conf = new FS::Conf; -$old_default_domain = $conf->config('domain'); - -#needs to match FS::Record -#my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc; - -### -# This section would be the appropriate place to manipulate -# the schema & tables. -### - -## we need to add the domsvc to svc_acct -## we must add a svc_forward record.... -## I am thinking that the fields svcnum (int), destsvc (int), and -## dest (varchar (80)) are appropriate, with destsvc/dest an either/or -## much in the spirit of cust_main_invoice - -### -# massage the data -### - -my($dbh)=adminsuidsetup $user; - -$|=1; - -$FS::svc_Common::noexport_hack = 1; -$FS::svc_domain::whois_hack = 1; - -%part_domain_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'}); -%part_acct_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_acct'}); -%part_forward_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_forward'}); - -die "No services with svcdb svc_domain!\n" unless %part_domain_svc; -die "No services with svcdb svc_acct!\n" unless %part_acct_svc; -die "No services with svcdb svc_forward!\n" unless %part_forward_svc; - -my($svc_domain) = qsearchs('svc_domain', { 'domain' => $old_default_domain }); -if (! $svc_domain || $svc_domain->domain != $old_default_domain) { - print <); - chop $response; - if ($response =~ /^[yY]/) { - print "\n\n", &menu_domain_svc, "\n", < $old_default_domain, - 'svcpart' => $domain_svcpart, - 'action' => 'M', - }; -# $error=$svc_domain->insert && die "Error adding domain $old_default_domain: $error"; - $error=$svc_domain->insert; - die "Error adding domain $old_default_domain: $error" if $error; - }else{ - print <svc, sort keys %part_domain_svc ). "\n"; -} -sub menu_acct_svc { - ( join "\n", map "$_: ".$part_acct_svc{$_}->svc, sort keys %part_acct_svc ). "\n"; -} -sub menu_forward_svc { - ( join "\n", map "$_: ".$part_forward_svc{$_}->svc, sort keys %part_forward_svc ). "\n"; -} -sub getdomainpart { - $^W=0; # Term::Query isn't -w-safe - my $return = query "Enter part number:", 'irk', [ keys %part_domain_svc ]; - $^W=1; - $return; -} -sub getacctpart { - $^W=0; # Term::Query isn't -w-safe - my $return = query "Enter part number:", 'irk', [ keys %part_acct_svc ]; - $^W=1; - $return; -} -sub getforwardpart { - $^W=0; # Term::Query isn't -w-safe - my $return = query "Enter part number:", 'irk', [ keys %part_forward_svc ]; - $^W=1; - $return; -} - - -#migrate data - -my(@svc_accts) = qsearch('svc_acct', {}); -foreach $svc_acct (@svc_accts) { - my(@svc_acct_sms) = qsearch('svc_acct_sm', { - domuid => $svc_acct->getfield('uid'), - } - ); - - # Ok.. we've got the svc_acct record, and an array of svc_acct_sm's - # What do we do from here? - - # The intuitive: - # plop the svc_acct into the 'default domain' - # and then represent the svc_acct_sm's with svc_forwards - # they can be gussied up manually, later - # - # Perhaps better: - # when no svc_acct_sm exists, place svc_acct in 'default domain' - # when one svc_acct_sm exists, place svc_acct in corresponding - # domain & possibly create a svc_forward in 'default domain' - # when multiple svc_acct_sm's exists (in different domains) we'd - # better use the 'intuitive' approach. - # - # Specific way: - # as 'perhaps better,' but we may be able to guess which domain - # is correct by comparing the svcnum of domains to the username - # of the svc_acct - # - - # The intuitive way: - - my $def_acct = new FS::svc_acct ( { $svc_acct->hash } ); - $def_acct->setfield('domsvc' => $svc_domain->getfield('svcnum')); - $error = $def_acct->replace($svc_acct); - die "Error replacing svc_acct for " . $def_acct->username . " : $error" if $error; - - foreach $svc_acct_sm (@svc_acct_sms) { - - my($domrec)=qsearchs('svc_domain', { - svcnum => $svc_acct_sm->getfield('domsvc'), - }) || die "svc_acct_sm references invalid domsvc $svc_acct_sm->getfield('domsvc')\n"; - - if ($svc_acct_sm->getfield('domuser') =~ /^\*$/) { - - my($newdom) = new FS::svc_domain ( { $domrec->hash } ); - $newdom->setfield('catchall', $svc_acct->svcnum); - $newdom->setfield('action', "M"); - $error = $newdom->replace($domrec); - die "Error replacing svc_domain for (anything)@" . $domrec->domain . " : $error" if $error; - - } else { - - my($newacct) = new FS::svc_acct { - 'svcpart' => $pop_svcpart, - 'username' => $svc_acct_sm->getfield('domuser'), - 'domsvc' => $svc_acct_sm->getfield('domsvc'), - 'dir' => '/dev/null', - }; - $error = $newacct->insert; - die "Error adding svc_acct for " . $newacct->username . " : $error" if $error; - - my($newforward) = new FS::svc_forward { - 'svcpart' => $forward_svcpart, - 'srcsvc' => $newacct->getfield('svcnum'), - 'dstsvc' => $def_acct->getfield('svcnum'), - }; - $error = $newforward->insert; - die "Error adding svc_forward for " . $newacct->username ." : $error" if $error; - } - - $error = $svc_acct_sm->delete; - die "Error deleting svc_acct_sm for " . $svc_acct_sm->domuser ." : $error" if $error; - - }; - -}; - - -$dbh->commit or die $dbh->errstr; -$dbh->disconnect or die $dbh->errstr; - -print "svc_acct_sm records sucessfully migrated\n"; - -sub usage { - die "Usage:\n fs-migrate-svc_acct_sm user\n"; -} - diff --git a/bin/fs-radius-add-check b/bin/fs-radius-add-check index 4e4769e58..ee093b375 100755 --- a/bin/fs-radius-add-check +++ b/bin/fs-radius-add-check @@ -1,20 +1,18 @@ #!/usr/bin/perl -Tw # quick'n'dirty hack of fs-setup to add radius attributes +# (i'm not sure this even works in the new world of schema changes - everyone +# uses attributes via groups now) use strict; use DBI; -use FS::UID qw(adminsuidsetup checkeuid getsecrets); +use FS::UID qw(adminsuidsetup); use FS::raddb; -die "Not running uid freeside!" unless checkeuid(); - my %attrib2db = map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib; my $user = shift or die &usage; -getsecrets($user); - my $dbh = adminsuidsetup $user; ### diff --git a/bin/fs-radius-add-reply b/bin/fs-radius-add-reply index 3de01374f..c6c24e039 100755 --- a/bin/fs-radius-add-reply +++ b/bin/fs-radius-add-reply @@ -1,20 +1,18 @@ #!/usr/bin/perl -Tw # quick'n'dirty hack of fs-setup to add radius attributes +# (i'm not sure this even works in the new world of schema changes - everyone +# uses attributes via groups now) use strict; use DBI; -use FS::UID qw(adminsuidsetup checkeuid getsecrets); +use FS::UID qw(adminsuidsetup); use FS::raddb; -die "Not running uid freeside!" unless checkeuid(); - my %attrib2db = map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib; my $user = shift or die &usage; -getsecrets($user); - my $dbh = adminsuidsetup $user; ### diff --git a/eg/Auth-my_external_auth.pm b/eg/Auth-my_external_auth.pm new file mode 100644 index 000000000..8eda462f8 --- /dev/null +++ b/eg/Auth-my_external_auth.pm @@ -0,0 +1,28 @@ +package FS::Auth::my_external_auth; +use base qw( FS::Auth::external ); #need to inherit from ::external + +use strict; + +sub authenticate { + my($self, $username, $check_password, $info ) = @_; + + #your magic happens here + + if ( $auth_good ) { + + #optionally return a real name + #$info->{'first'} = "Jean"; + #$info->{'last'} = "D'eau"; + + #optionally return a template username to copy access groups from that user + #$info->{'template_user'} = 'username'; + + return 1; + + } else { + return 0; + } + +} + +1; diff --git a/htetc/freeside-base2.conf b/htetc/freeside-base2.conf index 49b4a243d..1bbe90a59 100644 --- a/htetc/freeside-base2.conf +++ b/htetc/freeside-base2.conf @@ -14,28 +14,48 @@ PerlRequire "%%%MASON_HANDLER%%%" # AddDefaultCharset UTF-8 +PerlModule FS::AuthCookieHandler + +#XXX need to also work properly for installs w/o /freeside/ in path +PerlSetVar FreesideLoginScript /freeside/loginout/login.html + +#PerlSetVar FreesideEverSecure 1 +PerlSetVar FreesideHttpOnly 1 + -AuthName Freeside -AuthType Basic -AuthUserFile %%%FREESIDE_CONF%%%/htpasswd -require valid-user - -SetHandler perl-script -PerlHandler HTML::Mason + + AuthName Freeside + AuthType FS::AuthCookieHandler + PerlAuthenHandler FS::AuthCookieHandler->authenticate + PerlAuthzHandler FS::AuthCookieHandler->authorize + require valid-user + + + SetHandler perl-script + PerlHandler HTML::Mason + + + + + + AuthName Freeside + AuthType FS::AuthCookieHandler + SetHandler perl-script + PerlHandler FS::AuthCookieHandler->login + + + + Satisfy any + + -SetHandler perl-script -PerlHandler HTML::Mason + SetHandler perl-script + PerlHandler HTML::Mason - -AuthName Freeside -AuthType Basic -AuthUserFile %%%FREESIDE_CONF%%%/htpasswd.logout -require valid-user - -SetHandler default-handler - + + Satisfy any diff --git a/htetc/htpasswd.logout b/htetc/htpasswd.logout deleted file mode 100644 index 3523f2357..000000000 --- a/htetc/htpasswd.logout +++ /dev/null @@ -1 +0,0 @@ -magic:Jgvaxb502SIqQ diff --git a/httemplate/autohandler b/httemplate/autohandler index c326e3e18..b5b1071c1 100644 --- a/httemplate/autohandler +++ b/httemplate/autohandler @@ -46,5 +46,5 @@ if ( UNIVERSAL::can(dbh, 'sprintProfile') ) { <%cleanup> - dbh->commit(); + dbh->commit() if dbh; diff --git a/httemplate/edit/access_user.html b/httemplate/edit/access_user.html index 86ce25374..b087943c2 100644 --- a/httemplate/edit/access_user.html +++ b/httemplate/edit/access_user.html @@ -3,8 +3,7 @@ 'table' => 'access_user', 'fields' => [ 'username', - { field=>'_password', type=>'password' }, - { field=>'_password2', type=>'password' }, + @pw_fields, 'last', 'first', { field=>'user_custnum', type=>'search-cust_main', }, @@ -50,6 +49,13 @@ die "access denied" unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); +my @pw_fields = + FS::Auth->auth_class->can('change_password') + ? ( { field=>'_password', type=>'password' }, + { field=>'_password2', type=>'password' }, + ) + : (); + my $check_user_custnum_search = < function check_user_custnum_search(what) { diff --git a/httemplate/edit/cust_credit.cgi b/httemplate/edit/cust_credit.cgi index 4dba1e769..09300c629 100755 --- a/httemplate/edit/cust_credit.cgi +++ b/httemplate/edit/cust_credit.cgi @@ -8,7 +8,6 @@ - <% ntable("#cccccc", 2) %> @@ -74,7 +73,6 @@ die "access denied" my $custnum = $cgi->param('custnum'); my $amount = $cgi->param('amount'); my $_date = time; -my $otaker = getotaker; my $p1 = popurl(1); diff --git a/httemplate/edit/cust_main.cgi b/httemplate/edit/cust_main.cgi index 2908848c6..d597d0bc2 100755 --- a/httemplate/edit/cust_main.cgi +++ b/httemplate/edit/cust_main.cgi @@ -299,7 +299,6 @@ if ( $cgi->param('error') ) { $cust_main = new FS::cust_main ( {} ); $cust_main->agentnum( $conf->config('default_agentnum') ) if $conf->exists('default_agentnum'); - $cust_main->otaker( &getotaker ); $cust_main->referral_custnum( $cgi->param('referral_custnum') ); @invoicing_list = (); push @invoicing_list, 'POST' diff --git a/httemplate/edit/elements/ApplicationCommon.html b/httemplate/edit/elements/ApplicationCommon.html index 7b1050ade..acc3368b8 100644 --- a/httemplate/edit/elements/ApplicationCommon.html +++ b/httemplate/edit/elements/ApplicationCommon.html @@ -441,8 +441,6 @@ if ( $cgi->param('error') ) { $dst_pkeyvalue = ''; } -my $otaker = getotaker; - my $p1 = popurl(1); my $src = qsearchs($src_table, { $src_pkey => $src_pkeyvalue } ); diff --git a/httemplate/edit/process/access_user.html b/httemplate/edit/process/access_user.html index 8e7e70a06..7fc7c25e1 100644 --- a/httemplate/edit/process/access_user.html +++ b/httemplate/edit/process/access_user.html @@ -3,14 +3,15 @@ % print $cgi->redirect(popurl(2) . "access_user.html?" . $cgi->query_string); % } else { <% include( 'elements/process.html', - 'table' => 'access_user', - 'viewall_dir' => 'browse', - 'copy_on_empty' => [ '_password' ], + 'table' => 'access_user', + 'viewall_dir' => 'browse', + 'copy_on_empty' => [ '_password', '_password_encoding' ], 'clear_on_error' => [ '_password', '_password2' ], - 'process_m2m' => { 'link_table' => 'access_usergroup', - 'target_table' => 'access_group', - }, - 'precheck_callback'=> \&precheck_callback, + 'process_m2m' => { 'link_table' => 'access_usergroup', + 'target_table' => 'access_group', + }, + 'precheck_callback' => \&precheck_callback, + 'post_new_object_callback' => \&post_new_object_callback, ) %> % } @@ -26,11 +27,24 @@ if ( FS::Conf->new->exists('disable_acl_changes') ) { sub precheck_callback { my $cgi = shift; + my $o = FS::access_user->new({username => $cgi->param('username')}); if( $o->is_system_user and !$cgi->param('usernum') ) { $cgi->param('username',''); return "username '".$o->username."' reserved for system account." } + return ''; } + +sub post_new_object_callback { + my( $cgi, $access_user ) = @_; + + if ( length($cgi->param('_password')) ) { + my $password = scalar($cgi->param('_password')); + $access_user->change_password_fields($password); + } + +} + diff --git a/httemplate/edit/process/elements/process.html b/httemplate/edit/process/elements/process.html index fb1ee7a27..0439d4e9c 100644 --- a/httemplate/edit/process/elements/process.html +++ b/httemplate/edit/process/elements/process.html @@ -70,6 +70,9 @@ Example: #return an error string or empty for no error 'precheck_callback' => sub { my( $cgi ) = @_; }, + #after the new object is created + 'post_new_object_callback' => sub { my( $cgi, $object ) = @_; }, + #after everything's inserted 'noerror_callback' => sub { my( $cgi, $object ) = @_; }, @@ -201,7 +204,7 @@ my %hash = my @values = ( 1 ); if ( $bfield ) { @values = $cgi->param($bfield); - warn join(',', @values); + #warn join(',', @values); } my $new; @@ -226,6 +229,10 @@ foreach my $value ( @values ) { } } + if ( $opt{'post_new_object_callback'} ) { + &{ $opt{'post_new_object_callback'} }( $cgi, $new ); + } + if ( $opt{'agent_virt'} ) { if ( ! $new->agentnum diff --git a/httemplate/edit/svc_acct.cgi b/httemplate/edit/svc_acct.cgi index 627791ba7..574fb51eb 100755 --- a/httemplate/edit/svc_acct.cgi +++ b/httemplate/edit/svc_acct.cgi @@ -482,8 +482,6 @@ my $action = $svcnum ? 'Edit' : 'Add'; my $svc = $part_svc->getfield('svc'); -my $otaker = getotaker; - my $username = $svc_acct->username; my $password = ''; diff --git a/httemplate/edit/svc_cert.cgi b/httemplate/edit/svc_cert.cgi index 93194228e..dc2cc3200 100644 --- a/httemplate/edit/svc_cert.cgi +++ b/httemplate/edit/svc_cert.cgi @@ -185,8 +185,6 @@ my $action = $svcnum ? 'Edit' : 'Add'; my $svc = $part_svc->getfield('svc'); -#my $otaker = getotaker; - my $p1 = popurl(1); my $link_query = "?svcnum=$svcnum;pkgnum=$pkgnum;svcpart=$svcpart"; diff --git a/httemplate/edit/svc_domain.cgi b/httemplate/edit/svc_domain.cgi index c3307fa8c..417b1b4c5 100755 --- a/httemplate/edit/svc_domain.cgi +++ b/httemplate/edit/svc_domain.cgi @@ -148,8 +148,6 @@ my $export = $exports[0]; # If we have a domain registration export, get the registrar object my $registrar = $export ? $export->registrar : ''; -my $otaker = getotaker; - my $domain = $svc_domain->domain; my $p1 = popurl(1); diff --git a/httemplate/elements/header.html b/httemplate/elements/header.html index c6ad3c387..7a7dc088d 100644 --- a/httemplate/elements/header.html +++ b/httemplate/elements/header.html @@ -2,18 +2,18 @@ Example: - include( '/elements/header.html', - { - 'title' => 'Title', - 'menubar' => \@menubar, - 'etc' => '', #included in tag, for things like onLoad= - 'head' => '', #included before closing tag - 'nobr' => 0, #1 for no

after the title - } - ); - - #old-style - include( '/elements/header.html', 'Title', $menubar, $etc, $head); + <& /elements/header.html', + { + 'title' => 'Title', + 'menubar' => \@menubar, + 'etc' => '', #included in tag, for things like onLoad= + 'head' => '', #included before closing tag + 'nobr' => 0, #1 for no

after the title + } + &> + + %#old-style + <& /elements/header.html, 'Title', $menubar, $etc, $head &> @@ -41,13 +41,6 @@ Example: <% include('init_overlib.html') |n %> <% include('rs_init_object.html') |n %> - <% include('logout.html') |n %> -% my $timeout = $conf->config('logout-timeout'); -% if ( $timeout && $timeout =~ /^\s*\d+\s*$/ ) { - -% } <% $head |n %> @@ -59,7 +52,7 @@ Example: <% $company_name || 'ExampleCo' %> - Logged in as <% getotaker %>  logout
Preferences + Logged in as <% $FS::CurrentUser::CurrentUser->username |h %>  logout
Preferences % if ( $conf->config("ticket_system") % && FS::TicketSystem->access_right(\%session, 'ModifySelf') ) { | Ticketing preferences diff --git a/httemplate/elements/logout.html b/httemplate/elements/logout.html deleted file mode 100644 index 313dbfaf1..000000000 --- a/httemplate/elements/logout.html +++ /dev/null @@ -1,44 +0,0 @@ -<%doc> - -Example: - - include( '/elements/logout.html'); - This is the logout link. - - - diff --git a/httemplate/index.html b/httemplate/index.html index bc51e6a52..d563fa0b2 100644 --- a/httemplate/index.html +++ b/httemplate/index.html @@ -21,7 +21,7 @@ % ORDER BY history_date desc" # LIMIT 10 % ) or die dbh->errstr; % -% $sth->execute( getotaker() ) or die $sth->errstr; +% $sth->execute( $FS::CurrentUser::CurrentUser->username ) or die $sth->errstr; % % my %saw = (); % my @custnums = grep { !$saw{$_}++ } map $_->[0], @{ $sth->fetchall_arrayref }; diff --git a/httemplate/loginout/login.html b/httemplate/loginout/login.html new file mode 100644 index 000000000..d06d0a8fc --- /dev/null +++ b/httemplate/loginout/login.html @@ -0,0 +1,71 @@ +<& /elements/header-minimal.html, 'Login' &> + + +
+ +
+ Login +

+ +% if ( $error ) { + <% $error |h %> +

+% } + +%#
+ + + + + + + + + + + + +
Username:
Password:
+
+ + + +
+ +
+ + +<%init> + +my %error = ( + 'no_cookie' => '', #First login, don't display an error + 'bad_cookie' => 'Bad Cookie', #timed out? + 'bad_credentials' => 'Incorrect username / password', + #'logout' => 'You have been logged out.', +); + +my $error = # $cgi->param('logout') || + $r->prev->subprocess_env("AuthCookieReason"); + +$error = exists($error{$error}) ? $error{$error} : $error; + + +my $url_string = $r->uri; + +#fake a freeside path for /login so we get our .css. shrug +$url_string =~ s/login$/freeside\/login/ unless $url_string =~ /freeside\//; + +#even though this is kludgy and false laziness w/CGI.pm +$url_string =~ s{ / index\.html /? $ } + {/}x; +$url_string =~ + s{ + /(login|loginout) + ([\w\-\.\/]*) + $ + } + {}ix; + +$url_string .= '/' unless $url_string =~ /\/$/; + + diff --git a/httemplate/loginout/logout.html b/httemplate/loginout/logout.html index d8e1c634a..5626aa4a1 100644 --- a/httemplate/loginout/logout.html +++ b/httemplate/loginout/logout.html @@ -1,18 +1,13 @@ - - - - - Logout page - - - -

-
- You have logged out. -
-

-
- You can log in again. -
- - +<% $cgi->redirect($redirect) %> +<%init> + +# Delete the server-side session +$FS::CurrentUser::CurrentSession->logout; + +# Delete the browser cookie, etc. +my $auth_type = $r->auth_type; +$auth_type->logout($r); + +my $redirect = $fsurl; #.'?logout=logout'; + + diff --git a/httemplate/pref/pref-process.html b/httemplate/pref/pref-process.html index 6b94f7175..962ee51b6 100644 --- a/httemplate/pref/pref-process.html +++ b/httemplate/pref/pref-process.html @@ -13,34 +13,35 @@ if ( FS::Conf->new->exists('disable_acl_changes') ) { } my $error = ''; -my $access_user = ''; -if ( grep { $cgi->param($_) !~ /^\s*$/ } - qw(_password new_password new_password2) +if ( FS::Auth->auth_class->can('change_password') + && grep { $cgi->param($_) !~ /^\s*$/ } + qw(_password new_password new_password2) ) { - $access_user = qsearchs( 'access_user', { - 'username' => getotaker, - '_password' => scalar($cgi->param('_password')), - } ); + if ( $cgi->param('new_password') ne $cgi->param('new_password2') ) { + $error = "New passwords don't match"; - $error = 'Current password incorrect; password not changed' - unless $access_user; + } elsif ( ! length($cgi->param('new_password')) ) { + $error = 'No new password entered'; - $error ||= "New passwords don't match" - unless $cgi->param('new_password') eq $cgi->param('new_password2'); + } elsif ( ! FS::Auth->authenticate( $FS::CurrentUser::CurrentUser, + scalar($cgi->param('_password')) ) + ) { + $error = 'Current password incorrect; password not changed'; - $error ||= "No new password entered" - unless length($cgi->param('new_password')); + } else { - $access_user->_password($cgi->param('new_password')) unless $error; + $error = $FS::CurrentUser::CurrentUser->change_password( + scalar($cgi->param('new_password')) + ); -} else { - - $access_user = $FS::CurrentUser::CurrentUser; + } } +my $access_user = $FS::CurrentUser::CurrentUser; + #well, if you got your password change wrong, you don't get anything else #changed right now. but it should be sticky on the form unless ( $error ) { # if ($access_user) { diff --git a/httemplate/pref/pref.html b/httemplate/pref/pref.html index 5babb0181..dc44db0b0 100644 --- a/httemplate/pref/pref.html +++ b/httemplate/pref/pref.html @@ -1,31 +1,33 @@ -<% include('/elements/header.html', 'Preferences for '. getotaker ) %> +<% include('/elements/header.html', 'Preferences for '. $FS::CurrentUser::CurrentUser->username ) %>
<% include('/elements/error.html') %> +% if ( FS::Auth->auth_class->can('change_password') ) { -<% mt('Change password (leave blank for no change)') |h %> -<% ntable("#cccccc",2) %> + <% mt('Change password (leave blank for no change)') |h %> + <% ntable("#cccccc",2) %> - - Current password: - - + + Current password: + + - - New password: - - + + New password: + + - - Re-enter new password: - - + + Re-enter new password: + + - -
+ +
+% } Interface <% ntable("#cccccc",2) %>