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;
78 warn "$me forksuidsetup starting for $user\n" if $DEBUG;
80 if ( $FS::CurrentUser::upgrade_hack ) {
81 $user = 'fs_bootstrap';
83 croak "fatal: adminsuidsetup called without arguements" unless $user;
85 $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
95 warn "$me forksuidsetup loading user\n" if $DEBUG;
96 FS::CurrentUser->load_user($user);
102 $dbh->disconnect if $dbh;
111 $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/bin';
112 $ENV{'SHELL'} = '/bin/sh';
113 $ENV{'IFS'} = " \t\n";
116 $ENV{'BASH_ENV'} = '';
123 croak "Not running uid freeside (\$>=$>, \$<=$<)\n" unless checkeuid();
125 warn "$me forksuidsetup connecting to database\n" if $DEBUG;
126 if ( $FS::CurrentUser::upgrade_hack && $olduser ) {
127 $dbh = &myconnect($olduser);
131 warn "$me forksuidsetup connected to database with handle $dbh\n" if $DEBUG;
133 warn "$me forksuidsetup loading schema\n" if $DEBUG;
134 use FS::Schema qw(reload_dbdef dbdef);
135 reload_dbdef("$conf_dir/dbdef.$datasrc")
136 unless $FS::Schema::setup_hack;
138 warn "$me forksuidsetup deciding upon config system to use\n" if $DEBUG;
140 if ( ! $FS::Schema::setup_hack && dbdef->table('conf') ) {
142 my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
143 $sth->execute or die $sth->errstr;
144 my $confcount = $sth->fetchrow_arrayref->[0];
149 die "NO CONFIGURATION RECORDS FOUND";
153 die "NO CONFIGURATION TABLE FOUND" unless $FS::Schema::setup_hack;
161 unless ( $callback_hack ) {
162 warn "$me calling callbacks\n" if $DEBUG;
163 foreach ( keys %callback ) {
165 # breaks multi-database installs # delete $callback{$_}; #run once
168 &{$_} foreach @callback;
170 warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
176 my $handle = DBI->connect( getsecrets(), { 'AutoCommit' => 0,
178 'ShowErrorStatement' => 1,
179 'pg_enable_utf8' => 1,
180 #'mysql_enable_utf8' => 1,
183 or die "DBI->connect error: $DBI::errstr\n";
186 use DBIx::DBSchema::_util qw(_load_driver ); #quelle hack
187 my $driver = _load_driver($handle);
188 if ( $driver =~ /^Pg/ ) {
189 no warnings 'redefine';
190 eval "sub DBIx::DBSchema::DBD::${driver}::default_db_schema {'$schema'}";
198 =item install_callback
200 A package can install a callback to be run in adminsuidsetup by passing
201 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
202 run already, the callback will also be run immediately.
204 $coderef = sub { warn "Hi, I'm returning your call!" };
205 FS::UID->install_callback($coderef);
207 install_callback FS::UID sub {
208 warn "Hi, I'm returning your call!"
213 sub install_callback {
215 my $callback = shift;
216 push @callback, $callback;
217 &{$callback} if $dbh;
222 Returns the CGI (see L<CGI>) object.
227 carp "warning: \$FS::UID::cgi is undefined" unless defined($cgi);
228 #carp "warning: \$FS::UID::cgi isa Apache" if $cgi && $cgi->isa('Apache');
234 Sets the CGI (see L<CGI>) object.
244 Returns the DBI database handle.
254 Returns the DBI data source.
264 Returns just the driver name portion of the DBI data source.
269 return $driver_name if defined $driver_name;
270 $driver_name = ( split(':', $datasrc) )[1];
274 croak "suidsetup depriciated";
279 (Deprecated) Returns the current Freeside user's username.
284 carp "FS::UID::getotaker deprecated";
285 $FS::CurrentUser::CurrentUser->username;
290 Returns true if effective UID is that of the freeside user.
295 #$> = $freeside_uid unless $>; #huh. mpm-itk hack
296 ( $> == $freeside_uid );
301 Returns true if the real UID is that of the freeside user.
306 ( $< == $freeside_uid );
311 Sets and returns the DBI datasource, username and password from
312 the `/usr/local/etc/freeside/secrets' file.
318 ($datasrc, $db_user, $db_pass, $schema) =
319 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/secrets")
320 or die "Can't get secrets: $conf_dir/secrets: $!\n";
323 ($datasrc, $db_user, $db_pass);
328 Returns true whenever we should use 1.7 configuration compatibility.
340 Warning: this interface is (still) likely to change in future releases.
342 New (experimental) callback interface:
344 A package can install a callback to be run in adminsuidsetup by passing
345 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
346 run already, the callback will also be run immediately.
348 $coderef = sub { warn "Hi, I'm returning your call!" };
349 FS::UID->install_callback($coderef);
351 install_callback FS::UID sub {
352 warn "Hi, I'm returning your call!"
355 Old (deprecated) callback interface:
357 A package can install a callback to be run in adminsuidsetup by putting a
358 coderef into the hash %FS::UID::callback :
360 $coderef = sub { warn "Hi, I'm returning your call!" };
361 $FS::UID::callback{'Package::Name'} = $coderef;
365 Too many package-global variables.
369 No capabilities yet. (What does this mean again?)
371 Goes through contortions to support non-OO syntax with multiple datasrc's.
373 Callbacks are (still) inelegant.
377 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.