5 @ISA @EXPORT_OK $DEBUG $me $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
26 $freeside_uid = scalar(getpwnam('freeside'));
28 $conf_dir = "%%%FREESIDE_CONF%%%";
30 $AutoCommit = 1; #ours, not DBI
36 FS::UID - Subroutines for database login and assorted other stuff
40 use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
46 $dbh = cgisuidsetup($cgi);
52 $driver_name = driver_name;
56 Provides a hodgepodge of subroutines.
62 =item adminsuidsetup USER
64 Sets the user to USER (see config.html from the base documentation).
65 Cleans the environment.
66 Make sure the script is running as freeside, or setuid freeside.
67 Opens a connection to the database.
68 Swaps real and effective UIDs.
69 Runs any defined callbacks (see below).
70 Returns the DBI database handle (usually you don't need this).
75 $dbh->disconnect if $dbh;
82 warn "$me forksuidsetup starting for $user\n" if $DEBUG;
84 if ( $FS::CurrentUser::upgrade_hack ) {
85 $user = 'fs_bootstrap';
87 croak "fatal: adminsuidsetup called without arguements" unless $user;
89 $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
93 $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
94 $ENV{'SHELL'} = '/bin/sh';
95 $ENV{'IFS'} = " \t\n";
98 $ENV{'BASH_ENV'} = '';
100 croak "Not running uid freeside!" unless checkeuid();
102 warn "$me forksuidsetup connecting to database\n" if $DEBUG;
103 if ( $FS::CurrentUser::upgrade_hack && $olduser ) {
104 $dbh = &myconnect($olduser);
108 warn "$me forksuidsetup connected to database with handle $dbh\n" if $DEBUG;
110 warn "$me forksuidsetup loading schema\n" if $DEBUG;
111 use FS::Schema qw(reload_dbdef dbdef);
112 reload_dbdef("$conf_dir/dbdef.$datasrc")
113 unless $FS::Schema::setup_hack;
115 warn "$me forksuidsetup deciding upon config system to use\n" if $DEBUG;
117 if ( ! $FS::Schema::setup_hack && dbdef->table('conf') ) {
119 my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
120 $sth->execute or die $sth->errstr;
121 my $confcount = $sth->fetchrow_arrayref->[0];
126 warn "NO CONFIGURATION RECORDS FOUND";
130 warn "NO CONFIGURATION TABLE FOUND";
133 unless ( $callback_hack ) {
134 warn "$me calling callbacks\n" if $DEBUG;
135 foreach ( keys %callback ) {
137 # breaks multi-database installs # delete $callback{$_}; #run once
140 &{$_} foreach @callback;
142 warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
145 warn "$me forksuidsetup loading user\n" if $DEBUG;
146 FS::CurrentUser->load_user($user);
152 DBI->connect( getsecrets(@_), { 'AutoCommit' => 0,
154 'ShowErrorStatement' => 1,
157 or die "DBI->connect error: $DBI::errstr\n";
160 =item install_callback
162 A package can install a callback to be run in adminsuidsetup by passing
163 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
164 run already, the callback will also be run immediately.
166 $coderef = sub { warn "Hi, I'm returning your call!" };
167 FS::UID->install_callback($coderef);
169 install_callback FS::UID sub {
170 warn "Hi, I'm returning your call!"
175 sub install_callback {
177 my $callback = shift;
178 push @callback, $callback;
179 &{$callback} if $dbh;
182 =item cgisuidsetup CGI_object
184 Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
185 object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup.
191 if ( $cgi->isa('CGI::Base') ) {
192 carp "Use of CGI::Base is depriciated";
193 } elsif ( $cgi->isa('Apache') ) {
195 } elsif ( ! $cgi->isa('CGI') ) {
196 croak "fatal: unrecognized object $cgi";
199 adminsuidsetup($user);
204 Returns the CGI (see L<CGI>) object.
209 carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
215 Returns the DBI database handle.
225 Returns the DBI data source.
235 Returns just the driver name portion of the DBI data source.
240 return $driver_name if defined $driver_name;
241 $driver_name = ( split(':', $datasrc) )[1];
245 croak "suidsetup depriciated";
250 Returns the current Freeside user.
260 Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
261 object (see L<CGI>) or an Apache object (see L<Apache>). Support for CGI::Base
262 and derived classes is depriciated.
267 if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
268 carp "Use of CGI::Base is depriciated";
269 $user = lc ( $cgi->var('REMOTE_USER') );
270 } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
271 $user = lc ( $cgi->remote_user );
272 } elsif ( $cgi && $cgi->isa('Apache') ) {
273 $user = lc ( $cgi->connection->user );
275 die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
276 "Apache user authentication as documented in httemplate/docs/install.html";
283 Returns true if effective UID is that of the freeside user.
288 ( $> == $freeside_uid );
293 Returns true if the real UID is that of the freeside user.
298 ( $< == $freeside_uid );
301 =item getsecrets [ USER ]
303 Sets the user to USER, if supplied.
304 Sets and returns the DBI datasource, username and password for this user from
305 the `/usr/local/etc/freeside/mapsecrets' file.
310 my($setuser) = shift;
311 $user = $setuser if $setuser;
313 if ( -e "$conf_dir/mapsecrets" ) {
314 die "No user!" unless $user;
315 my($line) = grep /^\s*($user|\*)\s/,
316 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/mapsecrets");
317 confess "User $user not found in mapsecrets!" unless $line;
318 $line =~ /^\s*($user|\*)\s+(.*)$/;
320 die "Illegal mapsecrets line for user?!" unless $secrets;
322 # no mapsecrets file at all, so do the default thing
323 $secrets = 'secrets';
326 ($datasrc, $db_user, $db_pass) =
327 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/$secrets")
328 or die "Can't get secrets: $conf_dir/$secrets: $!\n";
330 ($datasrc, $db_user, $db_pass);
335 Returns true whenever we should use 1.7 configuration compatibility.
347 Warning: this interface is (still) likely to change in future releases.
349 New (experimental) callback interface:
351 A package can install a callback to be run in adminsuidsetup by passing
352 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
353 run already, the callback will also be run immediately.
355 $coderef = sub { warn "Hi, I'm returning your call!" };
356 FS::UID->install_callback($coderef);
358 install_callback FS::UID sub {
359 warn "Hi, I'm returning your call!"
362 Old (deprecated) callback interface:
364 A package can install a callback to be run in adminsuidsetup by putting a
365 coderef into the hash %FS::UID::callback :
367 $coderef = sub { warn "Hi, I'm returning your call!" };
368 $FS::UID::callback{'Package::Name'} = $coderef;
372 Too many package-global variables.
376 No capabilities yet. When mod_perl and Authen::DBI are implemented,
377 cgisuidsetup will go away as well.
379 Goes through contortions to support non-OO syntax with multiple datasrc's.
381 Callbacks are (still) inelegant.
385 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.