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 $FS::Conf::conf_cache = undef;
183 use DBIx::DBSchema::_util qw(_load_driver ); #quelle hack
184 my $driver = _load_driver($handle);
185 if ( $driver =~ /^Pg/ ) {
186 no warnings 'redefine';
187 eval "sub DBIx::DBSchema::DBD::${driver}::default_db_schema {'$schema'}";
195 =item install_callback
197 A package can install a callback to be run in adminsuidsetup by passing
198 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
199 run already, the callback will also be run immediately.
201 $coderef = sub { warn "Hi, I'm returning your call!" };
202 FS::UID->install_callback($coderef);
204 install_callback FS::UID sub {
205 warn "Hi, I'm returning your call!"
210 sub install_callback {
212 my $callback = shift;
213 push @callback, $callback;
214 &{$callback} if $dbh;
219 Returns the CGI (see L<CGI>) object.
224 carp "warning: \$FS::UID::cgi is undefined" unless defined($cgi);
225 #carp "warning: \$FS::UID::cgi isa Apache" if $cgi && $cgi->isa('Apache');
231 Sets the CGI (see L<CGI>) object.
241 Returns the DBI database handle.
251 Returns the DBI data source.
261 Returns just the driver name portion of the DBI data source.
266 return $driver_name if defined $driver_name;
267 $driver_name = ( split(':', $datasrc) )[1];
271 croak "suidsetup depriciated";
276 (Deprecated) Returns the current Freeside user's username.
281 carp "FS::UID::getotaker deprecated";
282 $FS::CurrentUser::CurrentUser->username;
287 Returns true if effective UID is that of the freeside user.
292 #$> = $freeside_uid unless $>; #huh. mpm-itk hack
293 ( $> == $freeside_uid );
298 Returns true if the real UID is that of the freeside user.
303 ( $< == $freeside_uid );
308 Sets and returns the DBI datasource, username and password from
309 the `/usr/local/etc/freeside/secrets' file.
315 ($datasrc, $db_user, $db_pass, $schema) =
316 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/secrets")
317 or die "Can't get secrets: $conf_dir/secrets: $!\n";
320 ($datasrc, $db_user, $db_pass);
325 Returns true whenever we should use 1.7 configuration compatibility.
337 Warning: this interface is (still) likely to change in future releases.
339 New (experimental) callback interface:
341 A package can install a callback to be run in adminsuidsetup by passing
342 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
343 run already, the callback will also be run immediately.
345 $coderef = sub { warn "Hi, I'm returning your call!" };
346 FS::UID->install_callback($coderef);
348 install_callback FS::UID sub {
349 warn "Hi, I'm returning your call!"
352 Old (deprecated) callback interface:
354 A package can install a callback to be run in adminsuidsetup by putting a
355 coderef into the hash %FS::UID::callback :
357 $coderef = sub { warn "Hi, I'm returning your call!" };
358 $FS::UID::callback{'Package::Name'} = $coderef;
362 Too many package-global variables.
366 No capabilities yet. (What does this mean again?)
368 Goes through contortions to support non-OO syntax with multiple datasrc's.
370 Callbacks are (still) inelegant.
374 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.