5 @ISA @EXPORT_OK $DEBUG $me $cgi $freeside_uid $user $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
18 getotaker dbh datasrc getsecrets driver_name myconnect
25 $freeside_uid = scalar(getpwnam('freeside'));
27 $conf_dir = "%%%FREESIDE_CONF%%%";
28 $cache_dir = "%%%FREESIDE_CACHE%%%";
30 $AutoCommit = 1; #ours, not DBI
36 FS::UID - Subroutines for database login and assorted other stuff
40 use FS::UID qw(adminsuidsetup dbh datasrc getotaker checkeuid checkruid);
42 $dbh = adminsuidsetup $user;
48 $driver_name = driver_name;
52 Provides a hodgepodge of subroutines.
58 =item adminsuidsetup USER
60 Sets the user to USER (see config.html from the base documentation).
61 Cleans the environment.
62 Make sure the script is running as freeside, or setuid freeside.
63 Opens a connection to the database.
64 Swaps real and effective UIDs.
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";
89 $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
90 $ENV{'SHELL'} = '/bin/sh';
91 $ENV{'IFS'} = " \t\n";
94 $ENV{'BASH_ENV'} = '';
96 croak "Not running uid freeside (\$>=$>, \$<=$<)\n" unless checkeuid();
98 warn "$me forksuidsetup connecting to database\n" if $DEBUG;
99 if ( $FS::CurrentUser::upgrade_hack && $olduser ) {
100 $dbh = &myconnect($olduser);
104 warn "$me forksuidsetup connected to database with handle $dbh\n" if $DEBUG;
106 warn "$me forksuidsetup loading schema\n" if $DEBUG;
107 use FS::Schema qw(reload_dbdef dbdef);
108 reload_dbdef("$conf_dir/dbdef.$datasrc")
109 unless $FS::Schema::setup_hack;
111 warn "$me forksuidsetup deciding upon config system to use\n" if $DEBUG;
113 if ( ! $FS::Schema::setup_hack && dbdef->table('conf') ) {
115 my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
116 $sth->execute or die $sth->errstr;
117 my $confcount = $sth->fetchrow_arrayref->[0];
122 die "NO CONFIGURATION RECORDS FOUND";
126 die "NO CONFIGURATION TABLE FOUND" unless $FS::Schema::setup_hack;
129 unless ( $callback_hack ) {
130 warn "$me calling callbacks\n" if $DEBUG;
131 foreach ( keys %callback ) {
133 # breaks multi-database installs # delete $callback{$_}; #run once
136 &{$_} foreach @callback;
138 warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
141 warn "$me forksuidsetup loading user\n" if $DEBUG;
142 FS::CurrentUser->load_user($user);
148 my $handle = DBI->connect( getsecrets(@_), { 'AutoCommit' => 0,
150 'ShowErrorStatement' => 1,
151 'pg_enable_utf8' => 1,
152 #'mysql_enable_utf8' => 1,
155 or die "DBI->connect error: $DBI::errstr\n";
158 use DBIx::DBSchema::_util qw(_load_driver ); #quelle hack
159 my $driver = _load_driver($handle);
160 if ( $driver =~ /^Pg/ ) {
161 no warnings 'redefine';
162 eval "sub DBIx::DBSchema::DBD::${driver}::default_db_schema {'$schema'}";
170 =item install_callback
172 A package can install a callback to be run in adminsuidsetup by passing
173 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
174 run already, the callback will also be run immediately.
176 $coderef = sub { warn "Hi, I'm returning your call!" };
177 FS::UID->install_callback($coderef);
179 install_callback FS::UID sub {
180 warn "Hi, I'm returning your call!"
185 sub install_callback {
187 my $callback = shift;
188 push @callback, $callback;
189 &{$callback} if $dbh;
194 Returns the CGI (see L<CGI>) object.
199 carp "warning: \$FS::UID::cgi is undefined" unless defined($cgi);
200 #carp "warning: \$FS::UID::cgi isa Apache" if $cgi && $cgi->isa('Apache');
206 Sets the CGI (see L<CGI>) object.
216 Returns the DBI database handle.
226 Returns the DBI data source.
236 Returns just the driver name portion of the DBI data source.
241 return $driver_name if defined $driver_name;
242 $driver_name = ( split(':', $datasrc) )[1];
246 croak "suidsetup depriciated";
251 Returns the current Freeside user.
261 Returns true if effective UID is that of the freeside user.
266 #$> = $freeside_uid unless $>; #huh. mpm-itk hack
267 ( $> == $freeside_uid );
272 Returns true if the real UID is that of the freeside user.
277 ( $< == $freeside_uid );
280 =item getsecrets [ USER ]
282 Sets the user to USER, if supplied.
283 Sets and returns the DBI datasource, username and password for this user from
284 the `/usr/local/etc/freeside/mapsecrets' file.
289 my($setuser) = shift;
290 $user = $setuser if $setuser;
292 if ( -e "$conf_dir/mapsecrets" ) {
293 die "No user!" unless $user;
294 my($line) = grep /^\s*($user|\*)\s/,
295 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/mapsecrets");
296 confess "User $user not found in mapsecrets!" unless $line;
297 $line =~ /^\s*($user|\*)\s+(.*)$/;
299 die "Illegal mapsecrets line for user?!" unless $secrets;
301 # no mapsecrets file at all, so do the default thing
302 $secrets = 'secrets';
305 ($datasrc, $db_user, $db_pass, $schema) =
306 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/$secrets")
307 or die "Can't get secrets: $conf_dir/$secrets: $!\n";
310 ($datasrc, $db_user, $db_pass);
315 Returns true whenever we should use 1.7 configuration compatibility.
327 Warning: this interface is (still) likely to change in future releases.
329 New (experimental) callback interface:
331 A package can install a callback to be run in adminsuidsetup by passing
332 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
333 run already, the callback will also be run immediately.
335 $coderef = sub { warn "Hi, I'm returning your call!" };
336 FS::UID->install_callback($coderef);
338 install_callback FS::UID sub {
339 warn "Hi, I'm returning your call!"
342 Old (deprecated) callback interface:
344 A package can install a callback to be run in adminsuidsetup by putting a
345 coderef into the hash %FS::UID::callback :
347 $coderef = sub { warn "Hi, I'm returning your call!" };
348 $FS::UID::callback{'Package::Name'} = $coderef;
352 Too many package-global variables.
356 No capabilities yet. (What does this mean again?)
358 Goes through contortions to support non-OO syntax with multiple datasrc's.
360 Callbacks are (still) inelegant.
364 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.