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);
18 @EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
19 getotaker dbh datasrc getsecrets driver_name );
21 $freeside_uid = scalar(getpwnam('freeside'));
23 $conf_dir = "/usr/local/etc/freeside/";
25 $AutoCommit = 1; #ours, not DBI
29 FS::UID - Subroutines for database login and assorted other stuff
33 use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
39 $dbh = cgisuidsetup($cgi);
45 $driver_name = driver_name;
49 Provides a hodgepodge of subroutines.
55 =item adminsuidsetup USER
57 Sets the user to USER (see config.html from the base documentation).
58 Cleans the environment.
59 Make sure the script is running as freeside, or setuid freeside.
60 Opens a connection to the database.
61 Swaps real and effective UIDs.
62 Runs any defined callbacks (see below).
63 Returns the DBI database handle (usually you don't need this).
68 $dbh->disconnect if $dbh;
74 croak "fatal: adminsuidsetup called without arguements" unless $user;
76 $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
79 $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
80 $ENV{'SHELL'} = '/bin/sh';
81 $ENV{'IFS'} = " \t\n";
84 $ENV{'BASH_ENV'} = '';
86 croak "Not running uid freeside!" unless checkeuid();
88 $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
91 } ) or die "DBI->connect error: $DBI::errstr\n";
93 foreach ( keys %callback ) {
95 # breaks multi-database installs # delete $callback{$_}; #run once
98 &{$_} foreach @callback;
103 =item install_callback
105 A package can install a callback to be run in adminsuidsetup by passing
106 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
107 run already, the callback will also be run immediately.
109 $coderef = sub { warn "Hi, I'm returning your call!" };
110 FS::UID->install_callback($coderef);
112 install_callback FS::UID sub {
113 warn "Hi, I'm returning your call!"
118 sub install_callback {
120 my $callback = shift;
121 push @callback, $callback;
122 &{$callback} if $dbh;
125 =item cgisuidsetup CGI_object
127 Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
128 object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup.
134 if ( $cgi->isa('CGI::Base') ) {
135 carp "Use of CGI::Base is depriciated";
136 } elsif ( $cgi->isa('Apache') ) {
138 } elsif ( ! $cgi->isa('CGI') ) {
139 croak "fatal: unrecognized object $cgi";
142 adminsuidsetup($user);
147 Returns the CGI (see L<CGI>) object.
152 carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
158 Returns the DBI database handle.
168 Returns the DBI data source.
178 Returns just the driver name portion of the DBI data source.
183 return $driver_name if defined $driver_name;
184 $driver_name = ( split(':', $datasrc) )[1];
188 croak "suidsetup depriciated";
193 Returns the current Freeside user.
203 Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
204 object (see L<CGI>) or an Apache object (see L<Apache>). Support for CGI::Base
205 and derived classes is depriciated.
210 if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
211 carp "Use of CGI::Base is depriciated";
212 $user = lc ( $cgi->var('REMOTE_USER') );
213 } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
214 $user = lc ( $cgi->remote_user );
215 } elsif ( $cgi && $cgi->isa('Apache') ) {
216 $user = lc ( $cgi->connection->user );
218 die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
219 "Apache user authentication as documented in httemplate/docs/install.html";
226 Returns true if effective UID is that of the freeside user.
231 ( $> == $freeside_uid );
236 Returns true if the real UID is that of the freeside user.
241 ( $< == $freeside_uid );
244 =item getsecrets [ USER ]
246 Sets the user to USER, if supplied.
247 Sets and returns the DBI datasource, username and password for this user from
248 the `/usr/local/etc/freeside/mapsecrets' file.
253 my($setuser) = shift;
254 $user = $setuser if $setuser;
255 die "No user!" unless $user;
256 my($conf) = new FS::Conf $conf_dir;
257 my($line) = grep /^\s*$user\s/, $conf->config('mapsecrets');
258 die "User $user not found in mapsecrets!" unless $line;
259 $line =~ /^\s*$user\s+(.*)$/;
261 die "Illegal mapsecrets line for user?!" unless $secrets;
262 ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
263 or die "Can't get secrets: $!";
264 $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
266 ($datasrc, $db_user, $db_pass);
273 Warning: this interface is (still) likely to change in future releases.
275 New (experimental) callback interface:
277 A package can install a callback to be run in adminsuidsetup by passing
278 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
279 run already, the callback will also be run immediately.
281 $coderef = sub { warn "Hi, I'm returning your call!" };
282 FS::UID->install_callback($coderef);
284 install_callback FS::UID sub {
285 warn "Hi, I'm returning your call!"
288 Old (deprecated) callback interface:
290 A package can install a callback to be run in adminsuidsetup by putting a
291 coderef into the hash %FS::UID::callback :
293 $coderef = sub { warn "Hi, I'm returning your call!" };
294 $FS::UID::callback{'Package::Name'} = $coderef;
298 Too many package-global variables.
302 No capabilities yet. When mod_perl and Authen::DBI are implemented,
303 cgisuidsetup will go away as well.
305 Goes through contortions to support non-OO syntax with multiple datasrc's.
307 Callbacks are (still) inelegant.
311 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.