L<FS::access_user> - Employees / internal users
+L<FS::access_user_session> - Access sessions
+
L<FS::access_user_pref> - Employee preferences
L<FS::access_group> - Employee groups
--- /dev/null
+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;
--- /dev/null
+package FS::Auth::external;
+#use base qw( FS::Auth );
+
+use strict;
+
+sub autocreate { 1; }
+
+1;
+
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
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
$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;
}
$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\-\.\/]*)
$
'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" },
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);
=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);";
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
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
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
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' ) {
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');
}
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;
"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
+ ).
")"
;
}
#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 } );
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->{$_}
'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' ] ],
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);
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 {
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]';
=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;
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).
}
sub forksuidsetup {
- $user = shift;
+ my $user = shift;
my $olduser = $user;
warn "$me forksuidsetup starting for $user\n" if $DEBUG;
$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;
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 ) {
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";
&{$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
=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
( $< == $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);
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.
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;
$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
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- $error = $self->htpasswd_kludge();
if ( $error ) {
$dbh->rollback or die $dbh->errstr if $oldAutoCommit;
return $error;
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;
'';
}
-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.
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;
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, @_);
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' ] )
;
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;
}
=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
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
--- /dev/null
+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;
+
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
);
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;
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;
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);
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]';
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;
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;
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;
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;
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;
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
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
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;
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);
--- /dev/null
+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";
" ${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}
+++ /dev/null
-#!/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 <<EOF;
-
-Your database currently does not contain a svc_domain record for the
-domain $old_default_domain. Would you like me to add one for you?
-EOF
-
- my($response)=scalar(<STDIN>);
- chop $response;
- if ($response =~ /^[yY]/) {
- print "\n\n", &menu_domain_svc, "\n", <<END;
-I need to create new domain accounts. Which service shall I use for that?
-END
- my($domain_svcpart)=&getdomainpart;
-
- $svc_domain = new FS::svc_domain {
- 'domain' => $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 <<EOF;
-
- This program cannot function properly until a svc_domain record matching
-your conf_dir/domain file exists.
-EOF
-
- exit 1;
- }
-}
-
-print "\n\n", &menu_acct_svc, "\n", <<END;
-I may need to create some new pop accounts and set up forwarding to them
-for some users. Which service shall I use for that?
-END
-my($pop_svcpart)=&getacctpart;
-
-print "\n\n", &menu_forward_svc, "\n", <<END;
-I may need to create some new forwarding for some users. Which service
-shall I use for that?
-END
-my($forward_svcpart)=&getforwardpart;
-
-sub menu_domain_svc {
- ( join "\n", map "$_: ".$part_domain_svc{$_}->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";
-}
-
#!/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;
###
#!/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;
###
--- /dev/null
+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;
#
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
+
<Directory %%%FREESIDE_DOCUMENT_ROOT%%%>
-AuthName Freeside
-AuthType Basic
-AuthUserFile %%%FREESIDE_CONF%%%/htpasswd
-require valid-user
-<Files ~ "(\.cgi|\.html)$">
-SetHandler perl-script
-PerlHandler HTML::Mason
+
+ AuthName Freeside
+ AuthType FS::AuthCookieHandler
+ PerlAuthenHandler FS::AuthCookieHandler->authenticate
+ PerlAuthzHandler FS::AuthCookieHandler->authorize
+ require valid-user
+
+ <Files ~ "(\.cgi|\.html)$">
+ SetHandler perl-script
+ PerlHandler HTML::Mason
+ </Files>
+
+</Directory>
+
+<Files login>
+ AuthName Freeside
+ AuthType FS::AuthCookieHandler
+ SetHandler perl-script
+ PerlHandler FS::AuthCookieHandler->login
</Files>
+
+<Directory %%%FREESIDE_DOCUMENT_ROOT%%%/elements/>
+ <Files "freeside.css">
+ Satisfy any
+ </Files>
</Directory>
+
<Directory %%%FREESIDE_DOCUMENT_ROOT%%%/rt/Helpers/>
-SetHandler perl-script
-PerlHandler HTML::Mason
+ SetHandler perl-script
+ PerlHandler HTML::Mason
</Directory>
-<Directory %%%FREESIDE_DOCUMENT_ROOT%%%/loginout>
-AuthName Freeside
-AuthType Basic
-AuthUserFile %%%FREESIDE_CONF%%%/htpasswd.logout
-require valid-user
-<Files ~ "(\.cgi|\.html)$">
-SetHandler default-handler
-</Files>
+<Directory %%%FREESIDE_DOCUMENT_ROOT%%%/rt/REST/1.0/NoAuth/>
+ Satisfy any
</Directory>
+++ /dev/null
-magic:Jgvaxb502SIqQ
</%filter>
<%cleanup>
- dbh->commit();
+ dbh->commit() if dbh;
</%cleanup>
'table' => 'access_user',
'fields' => [
'username',
- { field=>'_password', type=>'password' },
- { field=>'_password2', type=>'password' },
+ @pw_fields,
'last',
'first',
{ field=>'user_custnum', type=>'search-cust_main', },
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 = <<END;
<SCRIPT TYPE="text/javascript">
function check_user_custnum_search(what) {
<INPUT TYPE="hidden" NAME="paybatch" VALUE="">
<INPUT TYPE="hidden" NAME="_date" VALUE="<% $_date %>">
<INPUT TYPE="hidden" NAME="credited" VALUE="">
-<INPUT TYPE="hidden" NAME="otaker" VALUE="<% $otaker %>">
<% ntable("#cccccc", 2) %>
my $custnum = $cgi->param('custnum');
my $amount = $cgi->param('amount');
my $_date = time;
-my $otaker = getotaker;
my $p1 = popurl(1);
</%init>
$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'
$dst_pkeyvalue = '';
}
-my $otaker = getotaker;
-
my $p1 = popurl(1);
my $src = qsearchs($src_table, { $src_pkey => $src_pkeyvalue } );
% 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,
)
%>
% }
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);
+ }
+
+}
+
</%init>
#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 ) = @_; },
my @values = ( 1 );
if ( $bfield ) {
@values = $cgi->param($bfield);
- warn join(',', @values);
+ #warn join(',', @values);
}
my $new;
}
}
+ if ( $opt{'post_new_object_callback'} ) {
+ &{ $opt{'post_new_object_callback'} }( $cgi, $new );
+ }
+
if ( $opt{'agent_virt'} ) {
if ( ! $new->agentnum
my $svc = $part_svc->getfield('svc');
-my $otaker = getotaker;
-
my $username = $svc_acct->username;
my $password = '';
my $svc = $part_svc->getfield('svc');
-#my $otaker = getotaker;
-
my $p1 = popurl(1);
my $link_query = "?svcnum=$svcnum;pkgnum=$pkgnum;svcpart=$svcpart";
# 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);
Example:
- include( '/elements/header.html',
- {
- 'title' => 'Title',
- 'menubar' => \@menubar,
- 'etc' => '', #included in <BODY> tag, for things like onLoad=
- 'head' => '', #included before closing </HEAD> tag
- 'nobr' => 0, #1 for no <BR><BR> after the title
- }
- );
-
- #old-style
- include( '/elements/header.html', 'Title', $menubar, $etc, $head);
+ <& /elements/header.html',
+ {
+ 'title' => 'Title',
+ 'menubar' => \@menubar,
+ 'etc' => '', #included in <BODY> tag, for things like onLoad=
+ 'head' => '', #included before closing </HEAD> tag
+ 'nobr' => 0, #1 for no <BR><BR> after the title
+ }
+ &>
+
+ %#old-style
+ <& /elements/header.html, 'Title', $menubar, $etc, $head &>
</%doc>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<% 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*$/ ) {
- <script type="text/javascript">
- setTimeout('logout()', <% 60000 * $timeout %>);
- </script>
-% }
<% $head |n %>
<td align=left BGCOLOR="#ffffff"> <!-- valign="top" -->
<font size=6><% $company_name || 'ExampleCo' %></font>
</td>
- <td align=right valign=top BGCOLOR="#ffffff"><FONT SIZE="-1">Logged in as <b><%
getotaker %> </b> <FONT SIZE="-2"><a href="javascript:void(0);" onClick="logout();">logout</a></FONT><br></FONT><FONT SIZE="-2"><a href="<%$fsurl%>pref/pref.html" STYLE="color: #000000">Preferences</a>
+ <td align=right valign=top BGCOLOR="#ffffff"><FONT SIZE="-1">Logged in as <b><%
$FS::CurrentUser::CurrentUser->username |h %> </b> <FONT SIZE="-2"><a href="<%$fsurl%>loginout/logout.html">logout</a></FONT><br></FONT><FONT SIZE="-2"><a href="<%$fsurl%>pref/pref.html" STYLE="color: #000000">Preferences</a>
% if ( $conf->config("ticket_system")
% && FS::TicketSystem->access_right(\%session, 'ModifySelf') ) {
| <a href="<%$fsurl%>rt/Prefs/Other.html" STYLE="color: #000000">Ticketing preferences</a>
+++ /dev/null
-<%doc>
-
-Example:
-
- include( '/elements/logout.html');
- This is the <a href="javascript:void()" onClick="logout();">logout</a> link.
-
-</%doc>
-<SCRIPT TYPE="text/javascript">
-
- function logout() {
- // count args; build URL
- var url = "<% $fsurl. 'loginout/logout.html' %>";
-
- var xmlhttp = rs_init_object();
- xmlhttp.open("GET", url, false, "magic", "notyet");
- xmlhttp.setRequestHeader("If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT");
- xmlhttp.send(null);
-
- if (xmlhttp.readyState != 4) {
- alert("Logout failed: readyState is " + xmlhttp.readyState);
- return;
- }
-
- if (xmlhttp.status != 200) {
- alert("Logout failed: status is " + xmlhttp.status);
- } else {
- var data = xmlhttp.responseText;
- // alert('received response: ' + data);
- if ( data.indexOf("<b>System error</b>") > -1 ) {
- var w;
- if ( w = window.open("about:blank") ) {
- w.document.write(data);
- } else {
- // popup blocking? should use an overlib popup instead
- alert("Error popup disabled; try disabling popup blocking to see");
- }
- } else {
- window.location = "<% $fsurl. 'loginout/logout.html' %>";
- }
- }
- }
-
-</SCRIPT>
% 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 };
--- /dev/null
+<& /elements/header-minimal.html, 'Login' &>
+<link href="<%$url_string%>elements/freeside.css" type="text/css" rel="stylesheet">
+
+<CENTER>
+
+ <BR>
+ <FONT SIZE=5>Login</FONT>
+ <BR><BR>
+
+% if ( $error ) {
+ <FONT SIZE="+1" COLOR="#ff0000"><% $error |h %></FONT>
+ <BR><BR>
+% }
+
+%# <FORM METHOD="POST" ACTION="<%$url_string%>loginout/login">
+ <FORM METHOD="POST" ACTION="/login">
+ <INPUT TYPE="hidden" NAME="destination" VALUE="<% $r->prev->uri %>">
+
+ <TABLE CELLSPACING=0 CELLPADDING=4 BGCOLOR="#cccccc">
+ <TR>
+ <TD ALIGN="right">Username: </TD>
+ <TD><INPUT TYPE="text" NAME="credential_0" SIZE="13"></TD>
+ </TR>
+ <TR>
+ <TD ALIGN="right">Password: </TD>
+ <TD><INPUT TYPE="password" NAME="credential_1" SIZE="13"></TD>
+ </TR>
+ </TABLE>
+ <BR>
+
+ <INPUT TYPE="submit" VALUE="Login">
+
+ </FORM>
+
+</CENTER>
+
+</BODY></HTML>
+<%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 =~ /\/$/;
+
+</%init>
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
-<HTML>
- <HEAD>
- <TITLE>
- Logout page
- </TITLE>
- </HEAD>
- <BODY>
- <BR><BR>
- <CENTER>
- You have logged out.
- </CENTER>
- <BR><BR>
- <CENTER>
- You can <a href="..">log in</a> again.
- </CENTER>
- </BODY>
-</HTML>
+<% $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';
+
+</%init>
}
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) {
-<% include('/elements/header.html', 'Preferences for '. getotaker ) %>
+<% include('/elements/header.html', 'Preferences for '. $FS::CurrentUser::CurrentUser->username ) %>
<FORM METHOD="POST" NAME="pref_form" ACTION="pref-process.html">
<% 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) %>
- <TR>
- <TH ALIGN="right">Current password: </TH>
- <TD><INPUT TYPE="password" NAME="_password"></TD>
- </TR>
+ <TR>
+ <TH ALIGN="right">Current password: </TH>
+ <TD><INPUT TYPE="password" NAME="_password"></TD>
+ </TR>
- <TR>
- <TH ALIGN="right">New password: </TH>
- <TD><INPUT TYPE="password" NAME="new_password"></TD>
- </TR>
+ <TR>
+ <TH ALIGN="right">New password: </TH>
+ <TD><INPUT TYPE="password" NAME="new_password"></TD>
+ </TR>
- <TR>
- <TH ALIGN="right">Re-enter new password: </TH>
- <TD><INPUT TYPE="password" NAME="new_password2"></TD>
- </TR>
+ <TR>
+ <TH ALIGN="right">Re-enter new password: </TH>
+ <TD><INPUT TYPE="password" NAME="new_password2"></TD>
+ </TR>
-</TABLE>
-<BR>
+ </TABLE>
+ <BR>
+% }
Interface
<% ntable("#cccccc",2) %>
projects / freeside.git / commitdiff