5 @ISA @EXPORT_OK $DEBUG $me $cgi $dbh $freeside_uid $user
6 $conf_dir $cache_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%%%";
29 $cache_dir = "%%%FREESIDE_CACHE%%%";
31 $AutoCommit = 1; #ours, not DBI
37 FS::UID - Subroutines for database login and assorted other stuff
41 use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
47 $dbh = cgisuidsetup($cgi);
53 $driver_name = driver_name;
57 Provides a hodgepodge of subroutines.
63 =item adminsuidsetup USER
65 Sets the user to USER (see config.html from the base documentation).
66 Cleans the environment.
67 Make sure the script is running as freeside, or setuid freeside.
68 Opens a connection to the database.
69 Swaps real and effective UIDs.
70 Runs any defined callbacks (see below).
71 Returns the DBI database handle (usually you don't need this).
76 $dbh->disconnect if $dbh;
83 warn "$me forksuidsetup starting for $user\n" if $DEBUG;
85 if ( $FS::CurrentUser::upgrade_hack ) {
86 $user = 'fs_bootstrap';
88 croak "fatal: adminsuidsetup called without arguements" unless $user;
90 $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
94 $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
95 $ENV{'SHELL'} = '/bin/sh';
96 $ENV{'IFS'} = " \t\n";
99 $ENV{'BASH_ENV'} = '';
101 croak "Not running uid freeside!" unless checkeuid();
103 warn "$me forksuidsetup connecting to database\n" if $DEBUG;
104 if ( $FS::CurrentUser::upgrade_hack && $olduser ) {
105 $dbh = &myconnect($olduser);
109 warn "$me forksuidsetup connected to database with handle $dbh\n" if $DEBUG;
111 warn "$me forksuidsetup loading schema\n" if $DEBUG;
112 use FS::Schema qw(reload_dbdef dbdef);
113 reload_dbdef("$conf_dir/dbdef.$datasrc")
114 unless $FS::Schema::setup_hack;
116 warn "$me forksuidsetup deciding upon config system to use\n" if $DEBUG;
118 if ( ! $FS::Schema::setup_hack && dbdef->table('conf') ) {
120 my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
121 $sth->execute or die $sth->errstr;
122 my $confcount = $sth->fetchrow_arrayref->[0];
127 warn "NO CONFIGURATION RECORDS FOUND";
131 warn "NO CONFIGURATION TABLE FOUND";
134 unless ( $callback_hack ) {
135 warn "$me calling callbacks\n" if $DEBUG;
136 foreach ( keys %callback ) {
138 # breaks multi-database installs # delete $callback{$_}; #run once
141 &{$_} foreach @callback;
143 warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
146 warn "$me forksuidsetup loading user\n" if $DEBUG;
147 FS::CurrentUser->load_user($user);
153 DBI->connect( getsecrets(@_), { 'AutoCommit' => 0,
155 'ShowErrorStatement' => 1,
158 or die "DBI->connect error: $DBI::errstr\n";
161 =item install_callback
163 A package can install a callback to be run in adminsuidsetup by passing
164 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
165 run already, the callback will also be run immediately.
167 $coderef = sub { warn "Hi, I'm returning your call!" };
168 FS::UID->install_callback($coderef);
170 install_callback FS::UID sub {
171 warn "Hi, I'm returning your call!"
176 sub install_callback {
178 my $callback = shift;
179 push @callback, $callback;
180 &{$callback} if $dbh;
183 =item cgisuidsetup CGI_object
185 Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
186 object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup.
192 if ( $cgi->isa('CGI::Base') ) {
193 carp "Use of CGI::Base is depriciated";
194 } elsif ( $cgi->isa('Apache') ) {
196 } elsif ( ! $cgi->isa('CGI') ) {
197 croak "fatal: unrecognized object $cgi";
200 adminsuidsetup($user);
205 Returns the CGI (see L<CGI>) object.
210 carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
216 Returns the DBI database handle.
226 Returns the DBI data source.
236 Returns just the driver name portion of the DBI data source.
241 return $driver_name if defined $driver_name;
242 $driver_name = ( split(':', $datasrc) )[1];
246 croak "suidsetup depriciated";
251 Returns the current Freeside user.
261 Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
262 object (see L<CGI>) or an Apache object (see L<Apache>). Support for CGI::Base
263 and derived classes is depriciated.
268 if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
269 carp "Use of CGI::Base is depriciated";
270 $user = lc ( $cgi->var('REMOTE_USER') );
271 } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
272 $user = lc ( $cgi->remote_user );
273 } elsif ( $cgi && $cgi->isa('Apache') ) {
274 $user = lc ( $cgi->connection->user );
276 die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
277 "Apache user authentication as documented in httemplate/docs/install.html";
284 Returns true if effective UID is that of the freeside user.
289 ( $> == $freeside_uid );
294 Returns true if the real UID is that of the freeside user.
299 ( $< == $freeside_uid );
302 =item getsecrets [ USER ]
304 Sets the user to USER, if supplied.
305 Sets and returns the DBI datasource, username and password for this user from
306 the `/usr/local/etc/freeside/mapsecrets' file.
311 my($setuser) = shift;
312 $user = $setuser if $setuser;
314 if ( -e "$conf_dir/mapsecrets" ) {
315 die "No user!" unless $user;
316 my($line) = grep /^\s*($user|\*)\s/,
317 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/mapsecrets");
318 confess "User $user not found in mapsecrets!" unless $line;
319 $line =~ /^\s*($user|\*)\s+(.*)$/;
321 die "Illegal mapsecrets line for user?!" unless $secrets;
323 # no mapsecrets file at all, so do the default thing
324 $secrets = 'secrets';
327 ($datasrc, $db_user, $db_pass) =
328 map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/$secrets")
329 or die "Can't get secrets: $conf_dir/$secrets: $!\n";
331 ($datasrc, $db_user, $db_pass);
336 Returns true whenever we should use 1.7 configuration compatibility.
348 Warning: this interface is (still) likely to change in future releases.
350 New (experimental) callback interface:
352 A package can install a callback to be run in adminsuidsetup by passing
353 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
354 run already, the callback will also be run immediately.
356 $coderef = sub { warn "Hi, I'm returning your call!" };
357 FS::UID->install_callback($coderef);
359 install_callback FS::UID sub {
360 warn "Hi, I'm returning your call!"
363 Old (deprecated) callback interface:
365 A package can install a callback to be run in adminsuidsetup by putting a
366 coderef into the hash %FS::UID::callback :
368 $coderef = sub { warn "Hi, I'm returning your call!" };
369 $FS::UID::callback{'Package::Name'} = $coderef;
373 Too many package-global variables.
377 No capabilities yet. When mod_perl and Authen::DBI are implemented,
378 cgisuidsetup will go away as well.
380 Goes through contortions to support non-OO syntax with multiple datasrc's.
382 Callbacks are (still) inelegant.
386 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.