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;
117 my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
118 $sth->execute or die $sth->errstr;
119 my $confcount = $sth->fetchrow_arrayref->[0];
124 warn "NO CONFIGURATION RECORDS FOUND";
127 unless ( $callback_hack ) {
128 warn "$me calling callbacks\n" if $DEBUG;
129 foreach ( keys %callback ) {
131 # breaks multi-database installs # delete $callback{$_}; #run once
134 &{$_} foreach @callback;
136 warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
139 warn "$me forksuidsetup loading user\n" if $DEBUG;
140 FS::CurrentUser->load_user($user);
146 DBI->connect( getsecrets(@_), { 'AutoCommit' => 0,
148 'ShowErrorStatement' => 1,
151 or die "DBI->connect error: $DBI::errstr\n";
154 =item install_callback
156 A package can install a callback to be run in adminsuidsetup by passing
157 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
158 run already, the callback will also be run immediately.
160 $coderef = sub { warn "Hi, I'm returning your call!" };
161 FS::UID->install_callback($coderef);
163 install_callback FS::UID sub {
164 warn "Hi, I'm returning your call!"
169 sub install_callback {
171 my $callback = shift;
172 push @callback, $callback;
173 &{$callback} if $dbh;
176 =item cgisuidsetup CGI_object
178 Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
179 object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup.
185 if ( $cgi->isa('CGI::Base') ) {
186 carp "Use of CGI::Base is depriciated";
187 } elsif ( $cgi->isa('Apache') ) {
189 } elsif ( ! $cgi->isa('CGI') ) {
190 croak "fatal: unrecognized object $cgi";
193 adminsuidsetup($user);
198 Returns the CGI (see L<CGI>) object.
203 carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
209 Returns the DBI database handle.
219 Returns the DBI data source.
229 Returns just the driver name portion of the DBI data source.
234 return $driver_name if defined $driver_name;
235 $driver_name = ( split(':', $datasrc) )[1];
239 croak "suidsetup depriciated";
244 Returns the current Freeside user.
254 Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
255 object (see L<CGI>) or an Apache object (see L<Apache>). Support for CGI::Base
256 and derived classes is depriciated.
261 if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
262 carp "Use of CGI::Base is depriciated";
263 $user = lc ( $cgi->var('REMOTE_USER') );
264 } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
265 $user = lc ( $cgi->remote_user );
266 } elsif ( $cgi && $cgi->isa('Apache') ) {
267 $user = lc ( $cgi->connection->user );
269 die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
270 "Apache user authentication as documented in httemplate/docs/install.html";
277 Returns true if effective UID is that of the freeside user.
282 ( $> == $freeside_uid );
287 Returns true if the real UID is that of the freeside user.
292 ( $< == $freeside_uid );
295 =item getsecrets [ USER ]
297 Sets the user to USER, if supplied.
298 Sets and returns the DBI datasource, username and password for this user from
299 the `/usr/local/etc/freeside/mapsecrets' file.
304 my($setuser) = shift;
305 $user = $setuser if $setuser;
307 if ( -e "$conf_dir/mapsecrets" ) {
308 die "No user!" unless $user;
309 my($line) = grep /^\s*($user|\*)\s/,
310 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/mapsecrets");
311 confess "User $user not found in mapsecrets!" unless $line;
312 $line =~ /^\s*($user|\*)\s+(.*)$/;
314 die "Illegal mapsecrets line for user?!" unless $secrets;
316 # no mapsecrets file at all, so do the default thing
317 $secrets = 'secrets';
320 ($datasrc, $db_user, $db_pass) =
321 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/$secrets")
322 or die "Can't get secrets: $conf_dir/$secrets: $!\n";
324 ($datasrc, $db_user, $db_pass);
329 Returns true whenever we should use 1.7 configuration compatibility.
341 Warning: this interface is (still) likely to change in future releases.
343 New (experimental) callback interface:
345 A package can install a callback to be run in adminsuidsetup by passing
346 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
347 run already, the callback will also be run immediately.
349 $coderef = sub { warn "Hi, I'm returning your call!" };
350 FS::UID->install_callback($coderef);
352 install_callback FS::UID sub {
353 warn "Hi, I'm returning your call!"
356 Old (deprecated) callback interface:
358 A package can install a callback to be run in adminsuidsetup by putting a
359 coderef into the hash %FS::UID::callback :
361 $coderef = sub { warn "Hi, I'm returning your call!" };
362 $FS::UID::callback{'Package::Name'} = $coderef;
366 Too many package-global variables.
370 No capabilities yet. When mod_perl and Authen::DBI are implemented,
371 cgisuidsetup will go away as well.
373 Goes through contortions to support non-OO syntax with multiple datasrc's.
375 Callbacks are (still) inelegant.
379 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.