X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;ds=sidebyside;f=FS%2FFS%2FUID.pm;h=44d3870cc712078a54505576ea615da1a9058ea5;hb=3ff1fb4e10fdaef86527c10bd416e988d2a62a49;hp=065db61c1e076d43b98c05fde98dd455fa75de34;hpb=5e05724a635a22776f1b973f5d7e77989da4e048;p=freeside.git diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index 065db61c1..44d3870cc 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -2,27 +2,30 @@ package FS::UID; use strict; use vars qw( - @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user - $conf_dir $secrets $datasrc $db_user $db_pass %callback @callback - $driver_name $AutoCommit $callback_hack $use_confcompat -); -use subs qw( - getsecrets cgisetotaker + @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 ); 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 + getotaker dbh datasrc getsecrets driver_name myconnect + use_confcompat + ); + +$DEBUG = 0; +$me = '[FS::UID]'; $freeside_uid = scalar(getpwnam('freeside')); -$conf_dir = "%%%FREESIDE_CONF%%%"; +$conf_dir = "%%%FREESIDE_CONF%%%"; +$cache_dir = "%%%FREESIDE_CACHE%%%"; $AutoCommit = 1; #ours, not DBI $use_confcompat = 1; @@ -34,13 +37,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 getotaker checkeuid checkruid); - $cgi = new CGI; - $dbh = cgisuidsetup($cgi); + $dbh = adminsuidsetup $user; $dbh = dbh; @@ -76,6 +75,7 @@ sub adminsuidsetup { sub forksuidsetup { $user = shift; my $olduser = $user; + warn "$me forksuidsetup starting for $user\n" if $DEBUG; if ( $FS::CurrentUser::upgrade_hack ) { $user = 'fs_bootstrap'; @@ -93,51 +93,78 @@ sub forksuidsetup { $ENV{'ENV'} = ''; $ENV{'BASH_ENV'} = ''; - croak "Not running uid freeside!" unless checkeuid(); + 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; - use FS::Schema qw(reload_dbdef); + 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; - FS::CurrentUser->load_user($user); + warn "$me forksuidsetup deciding upon config system to use\n" if $DEBUG; + + if ( ! $FS::Schema::setup_hack && dbdef->table('conf') ) { - if ($dbh && ! $callback_hack) { 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"; + die "NO CONFIGURATION RECORDS FOUND"; } + + } else { + die "NO CONFIGURATION TABLE FOUND" unless $FS::Schema::setup_hack; } - unless($callback_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 { - DBI->connect( getsecrets(@_), { 'AutoCommit' => 0, - 'ChopBlanks' => 1, - 'ShowErrorStatement' => 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"; + + 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 @@ -162,35 +189,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 @@ -238,29 +256,6 @@ 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 httemplate/docs/install.html"; - } - $user; -} - =item checkeuid Returns true if effective UID is that of the freeside user. @@ -268,6 +263,7 @@ Returns true if effective UID is that of the freeside user. =cut sub checkeuid { + #$> = $freeside_uid unless $>; #huh. mpm-itk hack ( $> == $freeside_uid ); } @@ -306,10 +302,11 @@ sub getsecrets { $secrets = 'secrets'; } - ($datasrc, $db_user, $db_pass) = + ($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); } @@ -356,8 +353,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.