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 myconnect );
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();
90 foreach ( keys %callback ) {
92 # breaks multi-database installs # delete $callback{$_}; #run once
95 &{$_} foreach @callback;
101 $dbh = DBI->connect( getsecrets, {'AutoCommit' => 0, 'ChopBlanks' => 1, } )
102 or die "DBI->connect error: $DBI::errstr\n";
105 =item install_callback
107 A package can install a callback to be run in adminsuidsetup by passing
108 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
109 run already, the callback will also be run immediately.
111 $coderef = sub { warn "Hi, I'm returning your call!" };
112 FS::UID->install_callback($coderef);
114 install_callback FS::UID sub {
115 warn "Hi, I'm returning your call!"
120 sub install_callback {
122 my $callback = shift;
123 push @callback, $callback;
124 &{$callback} if $dbh;
127 =item cgisuidsetup CGI_object
129 Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
130 object (CGI::Base is depriciated). Runs cgisetotaker and then adminsuidsetup.
136 if ( $cgi->isa('CGI::Base') ) {
137 carp "Use of CGI::Base is depriciated";
138 } elsif ( $cgi->isa('Apache') ) {
140 } elsif ( ! $cgi->isa('CGI') ) {
141 croak "fatal: unrecognized object $cgi";
144 adminsuidsetup($user);
149 Returns the CGI (see L<CGI>) object.
154 carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
160 Returns the DBI database handle.
170 Returns the DBI data source.
180 Returns just the driver name portion of the DBI data source.
185 return $driver_name if defined $driver_name;
186 $driver_name = ( split(':', $datasrc) )[1];
190 croak "suidsetup depriciated";
195 Returns the current Freeside user.
201 #stupid kludge until schema otaker fields are not 8 chars
207 Sets and returns the CGI REMOTE_USER. $cgi should be defined as a CGI.pm
208 object (see L<CGI>) or an Apache object (see L<Apache>). Support for CGI::Base
209 and derived classes is depriciated.
214 if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
215 carp "Use of CGI::Base is depriciated";
216 $user = lc ( $cgi->var('REMOTE_USER') );
217 } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
218 $user = lc ( $cgi->remote_user );
219 } elsif ( $cgi && $cgi->isa('Apache') ) {
220 $user = lc ( $cgi->connection->user );
222 die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
223 "Apache user authentication as documented in httemplate/docs/install.html";
230 Returns true if effective UID is that of the freeside user.
235 ( $> == $freeside_uid );
240 Returns true if the real UID is that of the freeside user.
245 ( $< == $freeside_uid );
248 =item getsecrets [ USER ]
250 Sets the user to USER, if supplied.
251 Sets and returns the DBI datasource, username and password for this user from
252 the `/usr/local/etc/freeside/mapsecrets' file.
257 my($setuser) = shift;
258 $user = $setuser if $setuser;
259 die "No user!" unless $user;
260 my($conf) = new FS::Conf $conf_dir;
261 my($line) = grep /^\s*$user\s/, $conf->config('mapsecrets');
262 die "User $user not found in mapsecrets!" unless $line;
263 $line =~ /^\s*$user\s+(.*)$/;
265 die "Illegal mapsecrets line for user?!" unless $secrets;
266 ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
267 or die "Can't get secrets: $!";
268 $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
270 ($datasrc, $db_user, $db_pass);
277 Warning: this interface is (still) likely to change in future releases.
279 New (experimental) callback interface:
281 A package can install a callback to be run in adminsuidsetup by passing
282 a coderef to the FS::UID->install_callback class method. If adminsuidsetup has
283 run already, the callback will also be run immediately.
285 $coderef = sub { warn "Hi, I'm returning your call!" };
286 FS::UID->install_callback($coderef);
288 install_callback FS::UID sub {
289 warn "Hi, I'm returning your call!"
292 Old (deprecated) callback interface:
294 A package can install a callback to be run in adminsuidsetup by putting a
295 coderef into the hash %FS::UID::callback :
297 $coderef = sub { warn "Hi, I'm returning your call!" };
298 $FS::UID::callback{'Package::Name'} = $coderef;
302 Too many package-global variables.
306 No capabilities yet. When mod_perl and Authen::DBI are implemented,
307 cgisuidsetup will go away as well.
309 Goes through contortions to support non-OO syntax with multiple datasrc's.
311 Callbacks are (still) inelegant.
315 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.