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);
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;
119 my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf");
121 if ( $sth->execute ) {
122 $confcount = $sth->fetchrow_arrayref->[0];
129 warn "NO CONFIGURATION RECORDS FOUND";
132 unless ( $callback_hack ) {
133 warn "$me calling callbacks\n" if $DEBUG;
134 foreach ( keys %callback ) {
136 # breaks multi-database installs # delete $callback{$_}; #run once
139 &{$_} foreach @callback;
141 warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
144 warn "$me forksuidsetup loading user\n" if $DEBUG;
145 FS::CurrentUser->load_user($user);
151 DBI->connect( getsecrets(@_), { 'AutoCommit' => 0,
153 'ShowErrorStatement' => 1,
156 or die "DBI->connect error: $DBI::errstr\n";
159 =item install_callback
161 A package can install a callback to be run in adminsuidsetup by passing
162 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
163 run already, the callback will also be run immediately.
165 $coderef = sub { warn "Hi, I'm returning your call!" };
166 FS::UID->install_callback($coderef);
168 install_callback FS::UID sub {
169 warn "Hi, I'm returning your call!"
174 sub install_callback {
176 my $callback = shift;
177 push @callback, $callback;
178 &{$callback} if $dbh;
181 =item cgisuidsetup CGI_object
183 Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
184 object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup.
190 if ( $cgi->isa('CGI::Base') ) {
191 carp "Use of CGI::Base is depriciated";
192 } elsif ( $cgi->isa('Apache') ) {
194 } elsif ( ! $cgi->isa('CGI') ) {
195 croak "fatal: unrecognized object $cgi";
198 adminsuidsetup($user);
203 Returns the CGI (see L<CGI>) object.
208 carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
214 Returns the DBI database handle.
224 Returns the DBI data source.
234 Returns just the driver name portion of the DBI data source.
239 return $driver_name if defined $driver_name;
240 $driver_name = ( split(':', $datasrc) )[1];
244 croak "suidsetup depriciated";
249 Returns the current Freeside user.
259 Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
260 object (see L<CGI>) or an Apache object (see L<Apache>). Support for CGI::Base
261 and derived classes is depriciated.
266 if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
267 carp "Use of CGI::Base is depriciated";
268 $user = lc ( $cgi->var('REMOTE_USER') );
269 } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
270 $user = lc ( $cgi->remote_user );
271 } elsif ( $cgi && $cgi->isa('Apache') ) {
272 $user = lc ( $cgi->connection->user );
274 die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
275 "Apache user authentication as documented in httemplate/docs/install.html";
282 Returns true if effective UID is that of the freeside user.
287 ( $> == $freeside_uid );
292 Returns true if the real UID is that of the freeside user.
297 ( $< == $freeside_uid );
300 =item getsecrets [ USER ]
302 Sets the user to USER, if supplied.
303 Sets and returns the DBI datasource, username and password for this user from
304 the `/usr/local/etc/freeside/mapsecrets' file.
309 my($setuser) = shift;
310 $user = $setuser if $setuser;
312 if ( -e "$conf_dir/mapsecrets" ) {
313 die "No user!" unless $user;
314 my($line) = grep /^\s*($user|\*)\s/,
315 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/mapsecrets");
316 confess "User $user not found in mapsecrets!" unless $line;
317 $line =~ /^\s*($user|\*)\s+(.*)$/;
319 die "Illegal mapsecrets line for user?!" unless $secrets;
321 # no mapsecrets file at all, so do the default thing
322 $secrets = 'secrets';
325 ($datasrc, $db_user, $db_pass) =
326 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/$secrets")
327 or die "Can't get secrets: $conf_dir/$secrets: $!\n";
329 ($datasrc, $db_user, $db_pass);
334 Returns true whenever we should use 1.7 configuration compatibility.
346 Warning: this interface is (still) likely to change in future releases.
348 New (experimental) callback interface:
350 A package can install a callback to be run in adminsuidsetup by passing
351 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
352 run already, the callback will also be run immediately.
354 $coderef = sub { warn "Hi, I'm returning your call!" };
355 FS::UID->install_callback($coderef);
357 install_callback FS::UID sub {
358 warn "Hi, I'm returning your call!"
361 Old (deprecated) callback interface:
363 A package can install a callback to be run in adminsuidsetup by putting a
364 coderef into the hash %FS::UID::callback :
366 $coderef = sub { warn "Hi, I'm returning your call!" };
367 $FS::UID::callback{'Package::Name'} = $coderef;
371 Too many package-global variables.
375 No capabilities yet. When mod_perl and Authen::DBI are implemented,
376 cgisuidsetup will go away as well.
378 Goes through contortions to support non-OO syntax with multiple datasrc's.
380 Callbacks are (still) inelegant.
384 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.