package FS::UID;
+use base qw( Exporter );
use strict;
use vars qw(
- @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
- $conf_dir $secrets $datasrc $db_user $db_pass %callback $driver_name
- $AutoCommit
+ @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 subs qw(
- getsecrets cgisetotaker
-);
-use Exporter;
-use Carp qw(carp croak cluck);
+use subs qw( getsecrets );
+use Carp qw( carp croak cluck confess );
use DBI;
-use FS::Conf;
+use IO::File;
+use FS::CurrentUser;
+
+@EXPORT_OK = qw( checkeuid checkruid cgi setcgi adminsuidsetup forksuidsetup
+ preuser_setup load_schema
+ getotaker dbh datasrc getsecrets driver_name myconnect
+ );
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
- getotaker dbh datasrc getsecrets driver_name );
+$DEBUG = 0;
+$me = '[FS::UID]';
$freeside_uid = scalar(getpwnam('freeside'));
-$conf_dir = "/usr/local/etc/freeside/";
+$conf_dir = "%%%FREESIDE_CONF%%%";
+$cache_dir = "%%%FREESIDE_CACHE%%%";
$AutoCommit = 1; #ours, not DBI
+$callback_hack = 0;
=head1 NAME
=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;
- croak "fatal: adminsuidsetup called without arguements" unless $user;
+ my $user = shift;
+ warn "$me forksuidsetup starting for $user\n" if $DEBUG;
+
+ if ( $FS::CurrentUser::upgrade_hack ) {
+ $user = 'fs_bootstrap';
+ } else {
+ croak "fatal: adminsuidsetup called without arguements" unless $user;
+
+ $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
+ $user = $1;
+ }
+
+ env_setup();
+
+ db_setup();
+
+ 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;
+}
- $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
- $user = $1;
+sub env_setup {
- $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
+ $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/bin';
$ENV{'SHELL'} = '/bin/sh';
$ENV{'IFS'} = " \t\n";
$ENV{'CDPATH'} = '';
$ENV{'ENV'} = '';
$ENV{'BASH_ENV'} = '';
- croak "Not running uid freeside!" unless checkeuid();
- getsecrets;
- $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
- 'AutoCommit' => 0,
- 'ChopBlanks' => 1,
- } ) or die "DBI->connect error: $DBI::errstr\n";
+}
+
+sub load_schema {
+ warn "$me loading schema\n" if $DEBUG;
+ getsecrets() unless $datasrc;
+ use FS::Schema qw(reload_dbdef dbdef);
+ reload_dbdef("$conf_dir/dbdef.$datasrc")
+ unless $FS::Schema::setup_hack;
+}
+
+sub db_setup {
+ croak "Not running uid freeside (\$>=$>, \$<=$<)\n" unless checkeuid();
+
+ warn "$me forksuidsetup connecting to database\n" if $DEBUG;
+ $dbh = &myconnect();
+
+ warn "$me forksuidsetup connected to database with handle $dbh\n" if $DEBUG;
+
+ load_schema();
+
+ warn "$me forksuidsetup deciding upon config system to use\n" if $DEBUG;
+
+ unless ( $FS::Schema::setup_hack ) {
+
+ #how necessary is this now that we're no longer possibly a pre-1.9 db?
+ my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
+ $sth->execute or die $sth->errstr;
+ $sth->fetchrow_arrayref->[0] or die "NO CONFIGURATION RECORDS FOUND";
- foreach ( keys %callback ) {
- &{$callback{$_}};
}
- $dbh;
+
}
-=item cgisuidsetup CGI_object
+sub callback_setup {
-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.
+ unless ( $callback_hack ) {
+ warn "$me calling callbacks\n" if $DEBUG;
+ foreach ( keys %callback ) {
+ &{$callback{$_}};
+ # breaks multi-database installs # delete $callback{$_}; #run once
+ }
-=cut
+ &{$_} foreach @callback;
+ } else {
+ warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
+ }
-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";
+sub myconnect {
+ 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";
+
+ $FS::Conf::conf_cache = undef;
+
+ if ( $schema ) {
+ use DBIx::DBSchema::_util qw(_load_driver ); #quelle hack
+ my $driver = _load_driver($handle);
+ if ( $driver =~ /^Pg/ ) {
+ no warnings 'redefine';
+ eval "sub DBIx::DBSchema::DBD::${driver}::default_db_schema {'$schema'}";
+ die $@ if $@;
+ }
}
- cgisetotaker;
- adminsuidsetup($user);
+
+ $handle;
+}
+
+=item install_callback
+
+A package can install a callback to be run in adminsuidsetup by passing
+a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
+run already, the callback will also be run immediately.
+
+ $coderef = sub { warn "Hi, I'm returning your call!" };
+ FS::UID->install_callback($coderef);
+
+ install_callback FS::UID sub {
+ warn "Hi, I'm returning your call!"
+ };
+
+=cut
+
+sub install_callback {
+ my $class = shift;
+ my $callback = shift;
+ push @callback, $callback;
+ &{$callback} if $dbh;
}
=item cgi
=cut
sub cgi {
- carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
+ 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 CGI_OBJECT
+
+Sets the CGI (see L<CGI>) object.
+
+=cut
+
+sub setcgi {
+ $cgi = shift;
+}
+
=item dbh
Returns the DBI database handle.
=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 httemplate/docs/install.html";
- }
- $user;
+ carp "FS::UID::getotaker deprecated";
+ $FS::CurrentUser::CurrentUser->username;
}
=item checkeuid
=cut
sub checkeuid {
+ #$> = $freeside_uid unless $>; #huh. mpm-itk hack
( $> == $freeside_uid );
}
( $< == $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;
- die "No user!" unless $user;
- my($conf) = new FS::Conf $conf_dir;
- my($line) = grep /^\s*$user\s/, $conf->config('mapsecrets');
- die "User $user not found in mapsecrets!" unless $line;
- $line =~ /^\s*$user\s+(.*)$/;
- $secrets = $1;
- die "Illegal mapsecrets line for user?!" unless $secrets;
- ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
- or die "Can't get secrets: $!";
- $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
+
+ ($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";
undef $driver_name;
+
($datasrc, $db_user, $db_pass);
}
=head1 CALLBACKS
-Warning: this interface is likely to change in future releases.
+Warning: this interface is (still) likely to change in future releases.
-A package can install a callback to be run in adminsuidsetup by putting a
-coderef into the hash %FS::UID::callback :
+New (experimental) callback interface:
+
+A package can install a callback to be run in adminsuidsetup by passing
+a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
+run already, the callback will also be run immediately.
$coderef = sub { warn "Hi, I'm returning your call!" };
- $FS::UID::callback{'Package::Name'};
+ FS::UID->install_callback($coderef);
+
+ install_callback FS::UID sub {
+ warn "Hi, I'm returning your call!"
+ };
-=head1 VERSION
+Old (deprecated) callback interface:
-$Id: UID.pm,v 1.14 2002-02-23 07:00:21 ivan Exp $
+A package can install a callback to be run in adminsuidsetup by putting a
+coderef into the hash %FS::UID::callback :
+
+ $coderef = sub { warn "Hi, I'm returning your call!" };
+ $FS::UID::callback{'Package::Name'} = $coderef;
=head1 BUGS
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.
-Callbacks are inelegant.
+Callbacks are (still) inelegant.
=head1 SEE ALSO
projects / freeside.git / blobdiff