2 use base qw( Exporter );
6 @EXPORT_OK $DEBUG $me $cgi $freeside_uid $conf_dir $cache_dir
7 $secrets $datasrc $db_user $db_pass $schema $dbh $driver_name
8 $AutoCommit $ForceObeyAutoCommit %callback @callback $callback_hack
10 use subs qw( getsecrets );
11 use Carp qw( carp croak cluck confess );
16 @EXPORT_OK = qw( checkeuid checkruid cgi setcgi adminsuidsetup forksuidsetup
17 preuser_setup load_schema
18 getotaker dbh datasrc getsecrets driver_name myconnect
24 $freeside_uid = scalar(getpwnam('freeside'));
26 $conf_dir = "%%%FREESIDE_CONF%%%";
27 $cache_dir = "%%%FREESIDE_CACHE%%%";
29 # Code wanting to issue a COMMIT statement to the database is expected to
30 # obey the convention of checking this flag first. Setting $AutoCommit = 0
31 # should (usually) suppress COMMIT statements.
32 $AutoCommit = 1; #ours, not DBI
34 # Not all methods obey $AutoCommit, by design choice. Setting
35 # $ForceObeyAutoCommit = 1 will override that design choice for:
36 # &FS::cust_main::Billing::collect
37 # &FS::cust_main::Billing::do_cust_event
38 $ForceObeyAutoCommit = 0;
44 FS::UID - Subroutines for database login and assorted other stuff
48 use FS::UID qw(adminsuidsetup dbh datasrc checkeuid checkruid);
50 $dbh = adminsuidsetup $user;
56 $driver_name = driver_name;
60 Provides a hodgepodge of subroutines.
66 =item adminsuidsetup USER
68 Sets the user to USER (see config.html from the base documentation).
69 Cleans the environment.
70 Make sure the script is running as freeside, or setuid freeside.
71 Opens a connection to the database.
72 Runs any defined callbacks (see below).
73 Returns the DBI database handle (usually you don't need this).
78 $dbh->disconnect if $dbh;
84 warn "$me forksuidsetup starting for $user\n" if $DEBUG;
86 if ( $FS::CurrentUser::upgrade_hack ) {
87 $user = 'fs_bootstrap';
89 croak "fatal: adminsuidsetup called without arguements" unless $user;
91 $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
101 warn "$me forksuidsetup loading user\n" if $DEBUG;
102 FS::CurrentUser->load_user($user);
108 $dbh->disconnect if $dbh;
117 $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/bin';
118 $ENV{'SHELL'} = '/bin/sh';
119 $ENV{'IFS'} = " \t\n";
122 $ENV{'BASH_ENV'} = '';
127 warn "$me loading schema\n" if $DEBUG;
128 getsecrets() unless $datasrc;
129 use FS::Schema qw(reload_dbdef dbdef);
130 reload_dbdef("$conf_dir/dbdef.$datasrc")
131 unless $FS::Schema::setup_hack;
135 croak "Not running uid freeside (\$>=$>, \$<=$<)\n" unless checkeuid();
137 warn "$me forksuidsetup connecting to database\n" if $DEBUG;
140 warn "$me forksuidsetup connected to database with handle $dbh\n" if $DEBUG;
144 warn "$me forksuidsetup deciding upon config system to use\n" if $DEBUG;
146 unless ( $FS::Schema::setup_hack ) {
148 #how necessary is this now that we're no longer possibly a pre-1.9 db?
149 my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
150 $sth->execute or die $sth->errstr;
151 $sth->fetchrow_arrayref->[0] or die "NO CONFIGURATION RECORDS FOUND";
160 unless ( $callback_hack ) {
161 warn "$me calling callbacks\n" if $DEBUG;
162 foreach ( keys %callback ) {
164 # breaks multi-database installs # delete $callback{$_}; #run once
167 &{$_} foreach @callback;
169 warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
175 my $handle = DBI->connect( getsecrets(), { 'AutoCommit' => 0,
177 'ShowErrorStatement' => 1,
178 'pg_enable_utf8' => 1,
179 #'mysql_enable_utf8' => 1,
182 or die "DBI->connect error: $DBI::errstr\n";
184 $FS::Conf::conf_cache = undef;
187 use DBIx::DBSchema::_util qw(_load_driver ); #quelle hack
188 my $driver = _load_driver($handle);
189 if ( $driver =~ /^Pg/ ) {
190 no warnings 'redefine';
191 eval "sub DBIx::DBSchema::DBD::${driver}::default_db_schema {'$schema'}";
199 =item install_callback
201 A package can install a callback to be run in adminsuidsetup by passing
202 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
203 run already, the callback will also be run immediately.
205 $coderef = sub { warn "Hi, I'm returning your call!" };
206 FS::UID->install_callback($coderef);
208 install_callback FS::UID sub {
209 warn "Hi, I'm returning your call!"
214 sub install_callback {
216 my $callback = shift;
217 push @callback, $callback;
218 &{$callback} if $dbh;
223 (Deprecated) Returns the CGI (see L<CGI>) object.
228 carp "warning: \$FS::UID::cgi is undefined" unless defined($cgi);
229 #carp "warning: \$FS::UID::cgi isa Apache" if $cgi && $cgi->isa('Apache');
233 =item setcgi CGI_OBJECT
235 (Deprecated) Sets the CGI (see L<CGI>) object.
245 Returns the DBI database handle.
255 Returns the DBI data source.
265 Returns just the driver name portion of the DBI data source.
270 return $driver_name if defined $driver_name;
271 $driver_name = ( split(':', $datasrc) )[1];
275 croak "suidsetup depriciated";
280 (Deprecated) Returns the current Freeside user's username.
285 carp "FS::UID::getotaker deprecated";
286 $FS::CurrentUser::CurrentUser->username;
291 Returns true if effective UID is that of the freeside user.
296 #$> = $freeside_uid unless $>; #huh. mpm-itk hack
297 ( $> == $freeside_uid );
302 Returns true if the real UID is that of the freeside user.
307 ( $< == $freeside_uid );
312 Sets and returns the DBI datasource, username and password from
313 the `/usr/local/etc/freeside/secrets' file.
319 ($datasrc, $db_user, $db_pass, $schema) =
320 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/secrets")
321 or die "Can't get secrets: $conf_dir/secrets: $!\n";
324 ($datasrc, $db_user, $db_pass);
331 Warning: this interface is (still) likely to change in future releases.
333 New (experimental) callback interface:
335 A package can install a callback to be run in adminsuidsetup by passing
336 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
337 run already, the callback will also be run immediately.
339 $coderef = sub { warn "Hi, I'm returning your call!" };
340 FS::UID->install_callback($coderef);
342 install_callback FS::UID sub {
343 warn "Hi, I'm returning your call!"
346 Old (deprecated) callback interface:
348 A package can install a callback to be run in adminsuidsetup by putting a
349 coderef into the hash %FS::UID::callback :
351 $coderef = sub { warn "Hi, I'm returning your call!" };
352 $FS::UID::callback{'Package::Name'} = $coderef;
356 Too many package-global variables.
360 No capabilities yet. (What does this mean again?)
362 Goes through contortions to support non-OO syntax with multiple datasrc's.
364 Callbacks are (still) inelegant.
368 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.