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 = FS::DBI->connect(
180 'ShowErrorStatement' => 1,
181 'pg_enable_utf8' => 1,
182 # 'mysql_enable_utf8' => 1,
184 ) or die "FS::DBI->connect error: $FS::DBI::errstr\n";
186 $FS::Conf::conf_cache = undef;
189 use DBIx::DBSchema::_util qw(_load_driver ); #quelle hack
190 my $driver = _load_driver($handle);
191 if ( $driver =~ /^Pg/ ) {
192 no warnings 'redefine';
193 eval "sub DBIx::DBSchema::DBD::${driver}::default_db_schema {'$schema'}";
201 =item install_callback
203 A package can install a callback to be run in adminsuidsetup by passing
204 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
205 run already, the callback will also be run immediately.
207 $coderef = sub { warn "Hi, I'm returning your call!" };
208 FS::UID->install_callback($coderef);
210 install_callback FS::UID sub {
211 warn "Hi, I'm returning your call!"
216 sub install_callback {
218 my $callback = shift;
219 push @callback, $callback;
220 &{$callback} if $dbh;
225 (Deprecated) Returns the CGI (see L<CGI>) object.
230 carp "warning: \$FS::UID::cgi is undefined" unless defined($cgi);
231 #carp "warning: \$FS::UID::cgi isa Apache" if $cgi && $cgi->isa('Apache');
235 =item setcgi CGI_OBJECT
237 (Deprecated) Sets the CGI (see L<CGI>) object.
247 Returns the DBI database handle.
257 Returns the DBI data source.
267 Returns just the driver name portion of the DBI data source.
272 return $driver_name if defined $driver_name;
273 $driver_name = ( split(':', $datasrc) )[1];
277 croak "suidsetup depriciated";
282 (Deprecated) Returns the current Freeside user's username.
287 carp "FS::UID::getotaker deprecated";
288 $FS::CurrentUser::CurrentUser->username;
293 Returns true if effective UID is that of the freeside user.
298 #$> = $freeside_uid unless $>; #huh. mpm-itk hack
299 ( $> == $freeside_uid );
304 Returns true if the real UID is that of the freeside user.
309 ( $< == $freeside_uid );
314 Sets and returns the DBI datasource, username and password from
315 the `/usr/local/etc/freeside/secrets' file.
321 ($datasrc, $db_user, $db_pass, $schema) =
322 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/secrets")
323 or die "Can't get secrets: $conf_dir/secrets: $!\n";
326 ($datasrc, $db_user, $db_pass);
333 Warning: this interface is (still) likely to change in future releases.
335 New (experimental) callback interface:
337 A package can install a callback to be run in adminsuidsetup by passing
338 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
339 run already, the callback will also be run immediately.
341 $coderef = sub { warn "Hi, I'm returning your call!" };
342 FS::UID->install_callback($coderef);
344 install_callback FS::UID sub {
345 warn "Hi, I'm returning your call!"
348 Old (deprecated) callback interface:
350 A package can install a callback to be run in adminsuidsetup by putting a
351 coderef into the hash %FS::UID::callback :
353 $coderef = sub { warn "Hi, I'm returning your call!" };
354 $FS::UID::callback{'Package::Name'} = $coderef;
358 Too many package-global variables.
362 No capabilities yet. (What does this mean again?)
364 Goes through contortions to support non-OO syntax with multiple datasrc's.
366 Callbacks are (still) inelegant.
370 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.