5 @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
6 $conf_dir $secrets $datasrc $db_user $db_pass %callback @callback
7 $driver_name $AutoCommit $callback_hack $use_confcompat
10 getsecrets cgisetotaker
13 use Carp qw(carp croak cluck confess);
19 @EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
20 getotaker dbh datasrc getsecrets driver_name myconnect
23 $freeside_uid = scalar(getpwnam('freeside'));
25 $conf_dir = "%%%FREESIDE_CONF%%%";
27 $AutoCommit = 1; #ours, not DBI
33 FS::UID - Subroutines for database login and assorted other stuff
37 use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
43 $dbh = cgisuidsetup($cgi);
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 Swaps real and effective UIDs.
66 Runs any defined callbacks (see below).
67 Returns the DBI database handle (usually you don't need this).
72 $dbh->disconnect if $dbh;
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!" unless checkeuid();
98 if ( $FS::CurrentUser::upgrade_hack && $olduser ) {
99 $dbh = &myconnect($olduser);
104 use FS::Schema qw(reload_dbdef);
105 reload_dbdef("$conf_dir/dbdef.$datasrc")
106 unless $FS::Schema::setup_hack;
108 FS::CurrentUser->load_user($user);
110 if ($dbh && ! $callback_hack) {
111 my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
112 $sth->execute or die $sth->errstr;
113 my $confcount = $sth->fetchrow_arrayref->[0];
118 warn "NO CONFIGURATION RECORDS FOUND";
122 unless($callback_hack) {
123 foreach ( keys %callback ) {
125 # breaks multi-database installs # delete $callback{$_}; #run once
128 &{$_} foreach @callback;
135 DBI->connect( getsecrets(@_), { 'AutoCommit' => 0,
137 'ShowErrorStatement' => 1,
140 or die "DBI->connect error: $DBI::errstr\n";
143 =item install_callback
145 A package can install a callback to be run in adminsuidsetup by passing
146 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
147 run already, the callback will also be run immediately.
149 $coderef = sub { warn "Hi, I'm returning your call!" };
150 FS::UID->install_callback($coderef);
152 install_callback FS::UID sub {
153 warn "Hi, I'm returning your call!"
158 sub install_callback {
160 my $callback = shift;
161 push @callback, $callback;
162 &{$callback} if $dbh;
165 =item cgisuidsetup CGI_object
167 Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
168 object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup.
174 if ( $cgi->isa('CGI::Base') ) {
175 carp "Use of CGI::Base is depriciated";
176 } elsif ( $cgi->isa('Apache') ) {
178 } elsif ( ! $cgi->isa('CGI') ) {
179 croak "fatal: unrecognized object $cgi";
182 adminsuidsetup($user);
187 Returns the CGI (see L<CGI>) object.
192 carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
198 Returns the DBI database handle.
208 Returns the DBI data source.
218 Returns just the driver name portion of the DBI data source.
223 return $driver_name if defined $driver_name;
224 $driver_name = ( split(':', $datasrc) )[1];
228 croak "suidsetup depriciated";
233 Returns the current Freeside user.
243 Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
244 object (see L<CGI>) or an Apache object (see L<Apache>). Support for CGI::Base
245 and derived classes is depriciated.
250 if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
251 carp "Use of CGI::Base is depriciated";
252 $user = lc ( $cgi->var('REMOTE_USER') );
253 } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
254 $user = lc ( $cgi->remote_user );
255 } elsif ( $cgi && $cgi->isa('Apache') ) {
256 $user = lc ( $cgi->connection->user );
258 die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
259 "Apache user authentication as documented in httemplate/docs/install.html";
266 Returns true if effective UID is that of the freeside user.
271 ( $> == $freeside_uid );
276 Returns true if the real UID is that of the freeside user.
281 ( $< == $freeside_uid );
284 =item getsecrets [ USER ]
286 Sets the user to USER, if supplied.
287 Sets and returns the DBI datasource, username and password for this user from
288 the `/usr/local/etc/freeside/mapsecrets' file.
293 my($setuser) = shift;
294 $user = $setuser if $setuser;
296 if ( -e "$conf_dir/mapsecrets" ) {
297 die "No user!" unless $user;
298 my($line) = grep /^\s*($user|\*)\s/,
299 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/mapsecrets");
300 confess "User $user not found in mapsecrets!" unless $line;
301 $line =~ /^\s*($user|\*)\s+(.*)$/;
303 die "Illegal mapsecrets line for user?!" unless $secrets;
305 # no mapsecrets file at all, so do the default thing
306 $secrets = 'secrets';
309 ($datasrc, $db_user, $db_pass) =
310 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/$secrets")
311 or die "Can't get secrets: $conf_dir/$secrets: $!\n";
313 ($datasrc, $db_user, $db_pass);
318 Returns true whenever we should use 1.7 configuration compatibility.
330 Warning: this interface is (still) likely to change in future releases.
332 New (experimental) callback interface:
334 A package can install a callback to be run in adminsuidsetup by passing
335 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
336 run already, the callback will also be run immediately.
338 $coderef = sub { warn "Hi, I'm returning your call!" };
339 FS::UID->install_callback($coderef);
341 install_callback FS::UID sub {
342 warn "Hi, I'm returning your call!"
345 Old (deprecated) callback interface:
347 A package can install a callback to be run in adminsuidsetup by putting a
348 coderef into the hash %FS::UID::callback :
350 $coderef = sub { warn "Hi, I'm returning your call!" };
351 $FS::UID::callback{'Package::Name'} = $coderef;
355 Too many package-global variables.
359 No capabilities yet. When mod_perl and Authen::DBI are implemented,
360 cgisuidsetup will go away as well.
362 Goes through contortions to support non-OO syntax with multiple datasrc's.
364 Callbacks are (still) inelegant.
368 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.