summaryrefslogtreecommitdiff
path: root/FS/FS/UID.pm
diff options
context:
space:
mode:
Diffstat (limited to 'FS/FS/UID.pm')
-rw-r--r--FS/FS/UID.pm405
1 files changed, 0 insertions, 405 deletions
diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm
deleted file mode 100644
index e042c05..0000000
--- a/FS/FS/UID.pm
+++ /dev/null
@@ -1,405 +0,0 @@
-package FS::UID;
-
-use strict;
-use vars qw(
- @ISA @EXPORT_OK $DEBUG $me $cgi $freeside_uid $user $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 Exporter;
-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);
-
-$DEBUG = 0;
-$me = '[FS::UID]';
-
-$freeside_uid = scalar(getpwnam('freeside'));
-
-$conf_dir = "%%%FREESIDE_CONF%%%";
-$cache_dir = "%%%FREESIDE_CACHE%%%";
-
-$AutoCommit = 1; #ours, not DBI
-$use_confcompat = 1;
-$callback_hack = 0;
-
-=head1 NAME
-
-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;
-
- $cgi = new CGI;
- $dbh = cgisuidsetup($cgi);
-
- $dbh = dbh;
-
- $datasrc = datasrc;
-
- $driver_name = driver_name;
-
-=head1 DESCRIPTION
-
-Provides a hodgepodge of subroutines.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item adminsuidsetup USER
-
-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).
-
-=cut
-
-sub adminsuidsetup {
- $dbh->disconnect if $dbh;
- &forksuidsetup(@_);
-}
-
-sub forksuidsetup {
- $user = shift;
- my $olduser = $user;
- 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{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
- $ENV{'SHELL'} = '/bin/sh';
- $ENV{'IFS'} = " \t\n";
- $ENV{'CDPATH'} = '';
- $ENV{'ENV'} = '';
- $ENV{'BASH_ENV'} = '';
-
- croak "Not running uid freeside (\$>=$>, \$<=$<)\n" unless checkeuid();
-
- warn "$me forksuidsetup connecting to database\n" if $DEBUG;
- if ( $FS::CurrentUser::upgrade_hack && $olduser ) {
- $dbh = &myconnect($olduser);
- } else {
- $dbh = &myconnect();
- }
- warn "$me forksuidsetup connected to database with handle $dbh\n" if $DEBUG;
-
- warn "$me forksuidsetup loading schema\n" if $DEBUG;
- use FS::Schema qw(reload_dbdef dbdef);
- reload_dbdef("$conf_dir/dbdef.$datasrc")
- unless $FS::Schema::setup_hack;
-
- warn "$me forksuidsetup deciding upon config system to use\n" if $DEBUG;
-
- if ( ! $FS::Schema::setup_hack && dbdef->table('conf') ) {
-
- my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
- $sth->execute or die $sth->errstr;
- my $confcount = $sth->fetchrow_arrayref->[0];
-
- if ($confcount) {
- $use_confcompat = 0;
- }else{
- warn "NO CONFIGURATION RECORDS FOUND";
- }
-
- } else {
- warn "NO CONFIGURATION TABLE FOUND" unless $FS::Schema::setup_hack;
- }
-
- unless ( $callback_hack ) {
- warn "$me calling callbacks\n" if $DEBUG;
- foreach ( keys %callback ) {
- &{$callback{$_}};
- # breaks multi-database installs # delete $callback{$_}; #run once
- }
-
- &{$_} foreach @callback;
- } else {
- warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
- }
-
- 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,
- }
- )
- or die "DBI->connect error: $DBI::errstr\n";
-
- 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 $@;
- }
- }
-
- $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 cgisuidsetup CGI_object
-
-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.
-
-=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);
-}
-
-=item cgi
-
-Returns the CGI (see L<CGI>) object.
-
-=cut
-
-sub cgi {
- carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
- $cgi;
-}
-
-=item dbh
-
-Returns the DBI database handle.
-
-=cut
-
-sub dbh {
- $dbh;
-}
-
-=item datasrc
-
-Returns the DBI data source.
-
-=cut
-
-sub datasrc {
- $datasrc;
-}
-
-=item driver_name
-
-Returns just the driver name portion of the DBI data source.
-
-=cut
-
-sub driver_name {
- return $driver_name if defined $driver_name;
- $driver_name = ( split(':', $datasrc) )[1];
-}
-
-sub suidsetup {
- croak "suidsetup depriciated";
-}
-
-=item getotaker
-
-Returns the current Freeside user.
-
-=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;
-}
-
-=item checkeuid
-
-Returns true if effective UID is that of the freeside user.
-
-=cut
-
-sub checkeuid {
- #$> = $freeside_uid unless $>; #huh. mpm-itk hack
- ( $> == $freeside_uid );
-}
-
-=item checkruid
-
-Returns true if the real UID is that of the freeside user.
-
-=cut
-
-sub checkruid {
- ( $< == $freeside_uid );
-}
-
-=item getsecrets [ USER ]
-
-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.
-
-=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";
- undef $driver_name;
-
- ($datasrc, $db_user, $db_pass);
-}
-
-=item use_confcompat
-
-Returns true whenever we should use 1.7 configuration compatibility.
-
-=cut
-
-sub use_confcompat {
- $use_confcompat;
-}
-
-=back
-
-=head1 CALLBACKS
-
-Warning: this interface is (still) likely to change in future releases.
-
-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->install_callback($coderef);
-
- install_callback FS::UID sub {
- warn "Hi, I'm returning your call!"
- };
-
-Old (deprecated) callback interface:
-
-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
-
-Too many package-global variables.
-
-Not OO.
-
-No capabilities yet. When mod_perl and Authen::DBI are implemented,
-cgisuidsetup will go away as well.
-
-Goes through contortions to support non-OO syntax with multiple datasrc's.
-
-Callbacks are (still) inelegant.
-
-=head1 SEE ALSO
-
-L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.
-
-=cut
-
-1;
-
generated by cgit v1.1 at 2024-05-24 08:31:30 +0000