5 @ISA @EXPORT_OK $DEBUG $me $cgi $freeside_uid $conf_dir $cache_dir
6 $secrets $datasrc $db_user $db_pass $schema $dbh $driver_name
7 $AutoCommit %callback @callback $callback_hack $use_confcompat
9 use subs qw( getsecrets );
11 use Carp qw( carp croak cluck confess );
17 @EXPORT_OK = qw( checkeuid checkruid cgi setcgi adminsuidsetup forksuidsetup
19 getotaker dbh datasrc getsecrets driver_name myconnect
26 $freeside_uid = scalar(getpwnam('freeside'));
28 $conf_dir = "%%%FREESIDE_CONF%%%";
29 $cache_dir = "%%%FREESIDE_CACHE%%%";
31 $AutoCommit = 1; #ours, not DBI
37 FS::UID - Subroutines for database login and assorted other stuff
41 use FS::UID qw(adminsuidsetup dbh datasrc checkeuid checkruid);
43 $dbh = adminsuidsetup $user;
49 $driver_name = driver_name;
53 Provides a hodgepodge of subroutines.
59 =item adminsuidsetup USER
61 Sets the user to USER (see config.html from the base documentation).
62 Cleans the environment.
63 Make sure the script is running as freeside, or setuid freeside.
64 Opens a connection to the database.
65 Runs any defined callbacks (see below).
66 Returns the DBI database handle (usually you don't need this).
71 $dbh->disconnect if $dbh;
77 warn "$me forksuidsetup starting for $user\n" if $DEBUG;
79 if ( $FS::CurrentUser::upgrade_hack ) {
80 $user = 'fs_bootstrap';
82 croak "fatal: adminsuidsetup called without arguements" unless $user;
84 $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
94 warn "$me forksuidsetup loading user\n" if $DEBUG;
95 FS::CurrentUser->load_user($user);
101 $dbh->disconnect if $dbh;
110 $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/bin';
111 $ENV{'SHELL'} = '/bin/sh';
112 $ENV{'IFS'} = " \t\n";
115 $ENV{'BASH_ENV'} = '';
120 croak "Not running uid freeside (\$>=$>, \$<=$<)\n" unless checkeuid();
122 warn "$me forksuidsetup connecting to database\n" if $DEBUG;
125 warn "$me forksuidsetup connected to database with handle $dbh\n" if $DEBUG;
127 warn "$me forksuidsetup loading schema\n" if $DEBUG;
128 use FS::Schema qw(reload_dbdef dbdef);
129 reload_dbdef("$conf_dir/dbdef.$datasrc")
130 unless $FS::Schema::setup_hack;
132 warn "$me forksuidsetup deciding upon config system to use\n" if $DEBUG;
134 if ( ! $FS::Schema::setup_hack && dbdef->table('conf') ) {
136 my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
137 $sth->execute or die $sth->errstr;
138 my $confcount = $sth->fetchrow_arrayref->[0];
143 die "NO CONFIGURATION RECORDS FOUND";
147 die "NO CONFIGURATION TABLE FOUND" unless $FS::Schema::setup_hack;
155 unless ( $callback_hack ) {
156 warn "$me calling callbacks\n" if $DEBUG;
157 foreach ( keys %callback ) {
159 # breaks multi-database installs # delete $callback{$_}; #run once
162 &{$_} foreach @callback;
164 warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
170 my $handle = DBI->connect( getsecrets(), { 'AutoCommit' => 0,
172 'ShowErrorStatement' => 1,
173 'pg_enable_utf8' => 1,
174 #'mysql_enable_utf8' => 1,
177 or die "DBI->connect error: $DBI::errstr\n";
180 use DBIx::DBSchema::_util qw(_load_driver ); #quelle hack
181 my $driver = _load_driver($handle);
182 if ( $driver =~ /^Pg/ ) {
183 no warnings 'redefine';
184 eval "sub DBIx::DBSchema::DBD::${driver}::default_db_schema {'$schema'}";
192 =item install_callback
194 A package can install a callback to be run in adminsuidsetup by passing
195 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
196 run already, the callback will also be run immediately.
198 $coderef = sub { warn "Hi, I'm returning your call!" };
199 FS::UID->install_callback($coderef);
201 install_callback FS::UID sub {
202 warn "Hi, I'm returning your call!"
207 sub install_callback {
209 my $callback = shift;
210 push @callback, $callback;
211 &{$callback} if $dbh;
216 Returns the CGI (see L<CGI>) object.
221 carp "warning: \$FS::UID::cgi is undefined" unless defined($cgi);
222 #carp "warning: \$FS::UID::cgi isa Apache" if $cgi && $cgi->isa('Apache');
228 Sets the CGI (see L<CGI>) object.
238 Returns the DBI database handle.
248 Returns the DBI data source.
258 Returns just the driver name portion of the DBI data source.
263 return $driver_name if defined $driver_name;
264 $driver_name = ( split(':', $datasrc) )[1];
268 croak "suidsetup depriciated";
273 (Deprecated) Returns the current Freeside user's username.
278 carp "FS::UID::getotaker deprecated";
279 $FS::CurrentUser::CurrentUser->username;
284 Returns true if effective UID is that of the freeside user.
289 #$> = $freeside_uid unless $>; #huh. mpm-itk hack
290 ( $> == $freeside_uid );
295 Returns true if the real UID is that of the freeside user.
300 ( $< == $freeside_uid );
305 Sets and returns the DBI datasource, username and password from
306 the `/usr/local/etc/freeside/secrets' file.
312 ($datasrc, $db_user, $db_pass, $schema) =
313 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/secrets")
314 or die "Can't get secrets: $conf_dir/secrets: $!\n";
317 ($datasrc, $db_user, $db_pass);
322 Returns true whenever we should use 1.7 configuration compatibility.
334 Warning: this interface is (still) likely to change in future releases.
336 New (experimental) callback interface:
338 A package can install a callback to be run in adminsuidsetup by passing
339 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
340 run already, the callback will also be run immediately.
342 $coderef = sub { warn "Hi, I'm returning your call!" };
343 FS::UID->install_callback($coderef);
345 install_callback FS::UID sub {
346 warn "Hi, I'm returning your call!"
349 Old (deprecated) callback interface:
351 A package can install a callback to be run in adminsuidsetup by putting a
352 coderef into the hash %FS::UID::callback :
354 $coderef = sub { warn "Hi, I'm returning your call!" };
355 $FS::UID::callback{'Package::Name'} = $coderef;
359 Too many package-global variables.
363 No capabilities yet. (What does this mean again?)
365 Goes through contortions to support non-OO syntax with multiple datasrc's.
367 Callbacks are (still) inelegant.
371 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.