5 @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
6 $conf_dir $secrets $datasrc $db_user $db_pass %callback @callback
7 $driver_name $AutoCommit
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 );
22 $freeside_uid = scalar(getpwnam('freeside'));
24 $conf_dir = "%%%FREESIDE_CONF%%%/";
26 $AutoCommit = 1; #ours, not DBI
30 FS::UID - Subroutines for database login and assorted other stuff
34 use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
40 $dbh = cgisuidsetup($cgi);
46 $driver_name = driver_name;
50 Provides a hodgepodge of subroutines.
56 =item adminsuidsetup USER
58 Sets the user to USER (see config.html from the base documentation).
59 Cleans the environment.
60 Make sure the script is running as freeside, or setuid freeside.
61 Opens a connection to the database.
62 Swaps real and effective UIDs.
63 Runs any defined callbacks (see below).
64 Returns the DBI database handle (usually you don't need this).
69 $dbh->disconnect if $dbh;
77 if ( $FS::CurrentUser::upgrade_hack ) {
78 $user = 'fs_bootstrap';
80 croak "fatal: adminsuidsetup called without arguements" unless $user;
82 $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
86 $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
87 $ENV{'SHELL'} = '/bin/sh';
88 $ENV{'IFS'} = " \t\n";
91 $ENV{'BASH_ENV'} = '';
93 croak "Not running uid freeside!" unless checkeuid();
95 if ( $FS::CurrentUser::upgrade_hack && $olduser ) {
96 $dbh = &myconnect($olduser);
101 use FS::Schema qw(reload_dbdef);
102 reload_dbdef("$conf_dir/dbdef.$datasrc")
103 unless $FS::Schema::setup_hack;
105 FS::CurrentUser->load_user($user);
107 foreach ( keys %callback ) {
109 # breaks multi-database installs # delete $callback{$_}; #run once
112 &{$_} foreach @callback;
118 DBI->connect( getsecrets(@_), { 'AutoCommit' => 0,
120 'ShowErrorStatement' => 1,
123 or die "DBI->connect error: $DBI::errstr\n";
126 =item install_callback
128 A package can install a callback to be run in adminsuidsetup by passing
129 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
130 run already, the callback will also be run immediately.
132 $coderef = sub { warn "Hi, I'm returning your call!" };
133 FS::UID->install_callback($coderef);
135 install_callback FS::UID sub {
136 warn "Hi, I'm returning your call!"
141 sub install_callback {
143 my $callback = shift;
144 push @callback, $callback;
145 &{$callback} if $dbh;
148 =item cgisuidsetup CGI_object
150 Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
151 object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup.
157 if ( $cgi->isa('CGI::Base') ) {
158 carp "Use of CGI::Base is depriciated";
159 } elsif ( $cgi->isa('Apache') ) {
161 } elsif ( ! $cgi->isa('CGI') ) {
162 croak "fatal: unrecognized object $cgi";
165 adminsuidsetup($user);
170 Returns the CGI (see L<CGI>) object.
175 carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
181 Returns the DBI database handle.
191 Returns the DBI data source.
201 Returns just the driver name portion of the DBI data source.
206 return $driver_name if defined $driver_name;
207 $driver_name = ( split(':', $datasrc) )[1];
211 croak "suidsetup depriciated";
216 Returns the current Freeside user.
226 Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
227 object (see L<CGI>) or an Apache object (see L<Apache>). Support for CGI::Base
228 and derived classes is depriciated.
233 if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
234 carp "Use of CGI::Base is depriciated";
235 $user = lc ( $cgi->var('REMOTE_USER') );
236 } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
237 $user = lc ( $cgi->remote_user );
238 } elsif ( $cgi && $cgi->isa('Apache') ) {
239 $user = lc ( $cgi->connection->user );
241 die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
242 "Apache user authentication as documented in httemplate/docs/install.html";
249 Returns true if effective UID is that of the freeside user.
254 ( $> == $freeside_uid );
259 Returns true if the real UID is that of the freeside user.
264 ( $< == $freeside_uid );
267 =item getsecrets [ USER ]
269 Sets the user to USER, if supplied.
270 Sets and returns the DBI datasource, username and password for this user from
271 the `/usr/local/etc/freeside/mapsecrets' file.
276 my($setuser) = shift;
277 $user = $setuser if $setuser;
278 my($conf) = new FS::Conf $conf_dir;
280 if ( $conf->exists('mapsecrets') ) {
281 die "No user!" unless $user;
282 my($line) = grep /^\s*($user|\*)\s/, $conf->config('mapsecrets');
283 confess "User $user not found in mapsecrets!" unless $line;
284 $line =~ /^\s*($user|\*)\s+(.*)$/;
286 die "Illegal mapsecrets line for user?!" unless $secrets;
288 # no mapsecrets file at all, so do the default thing
289 $secrets = 'secrets';
292 ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
293 or die "Can't get secrets: $secrets: $!\n";
294 $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
296 ($datasrc, $db_user, $db_pass);
303 Warning: this interface is (still) likely to change in future releases.
305 New (experimental) callback interface:
307 A package can install a callback to be run in adminsuidsetup by passing
308 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
309 run already, the callback will also be run immediately.
311 $coderef = sub { warn "Hi, I'm returning your call!" };
312 FS::UID->install_callback($coderef);
314 install_callback FS::UID sub {
315 warn "Hi, I'm returning your call!"
318 Old (deprecated) callback interface:
320 A package can install a callback to be run in adminsuidsetup by putting a
321 coderef into the hash %FS::UID::callback :
323 $coderef = sub { warn "Hi, I'm returning your call!" };
324 $FS::UID::callback{'Package::Name'} = $coderef;
328 Too many package-global variables.
332 No capabilities yet. When mod_perl and Authen::DBI are implemented,
333 cgisuidsetup will go away as well.
335 Goes through contortions to support non-OO syntax with multiple datasrc's.
337 Callbacks are (still) inelegant.
341 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.