FS/FS/UID.pm

   1 package FS::UID;
   2
   3 use strict;
   4 use vars qw(
   5   @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
   6   $conf_dir $secrets $datasrc $db_user $db_pass %callback @callback
   7   $driver_name $AutoCommit
   8 );
   9 use subs qw(
  10   getsecrets cgisetotaker
  11 );
  12 use Exporter;
  13 use Carp qw(carp croak cluck);
  14 use DBI;
  15 use FS::Conf;
  16 use FS::CurrentUser;
  17
  18 @ISA = qw(Exporter);
  19 @EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
  20                 getotaker dbh datasrc getsecrets driver_name myconnect );
  21
  22 $freeside_uid = scalar(getpwnam('freeside'));
  23
  24 $conf_dir = "/usr/local/etc/freeside/";
  25
  26 $AutoCommit = 1; #ours, not DBI
  27
  28 =head1 NAME
  29
  30 FS::UID - Subroutines for database login and assorted other stuff
  31
  32 =head1 SYNOPSIS
  33
  34   use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
  35   checkeuid checkruid);
  36
  37   adminsuidsetup $user;
  38
  39   $cgi = new CGI;
  40   $dbh = cgisuidsetup($cgi);
  41
  42   $dbh = dbh;
  43
  44   $datasrc = datasrc;
  45
  46   $driver_name = driver_name;
  47
  48 =head1 DESCRIPTION
  49
  50 Provides a hodgepodge of subroutines.
  51
  52 =head1 SUBROUTINES
  53
  54 =over 4
  55
  56 =item adminsuidsetup USER
  57
  58 Sets the user to USER (see config.html from the base documentation).
  59 Cleans the environment.
  60 Make sure the script is running as freeside, or setuid freeside.
  61 Opens a connection to the database.
  62 Swaps real and effective UIDs.
  63 Runs any defined callbacks (see below).
  64 Returns the DBI database handle (usually you don't need this).
  65
  66 =cut
  67
  68 sub adminsuidsetup {
  69   $dbh->disconnect if $dbh;
  70   &forksuidsetup(@_);
  71 }
  72
  73 sub forksuidsetup {
  74   $user = shift;
  75
  76   if ( $FS::CurrentUser::upgrade_hack ) {
  77     $user = 'fs_bootstrap';
  78   } else {
  79     croak "fatal: adminsuidsetup called without arguements" unless $user;
  80
  81     $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
  82     $user = $1;
  83   }
  84
  85   $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
  86   $ENV{'SHELL'} = '/bin/sh';
  87   $ENV{'IFS'} = " \t\n";
  88   $ENV{'CDPATH'} = '';
  89   $ENV{'ENV'} = '';
  90   $ENV{'BASH_ENV'} = '';
  91
  92   croak "Not running uid freeside!" unless checkeuid();
  93
  94   $dbh = &myconnect;
  95
  96   use FS::Schema qw(reload_dbdef);
  97   reload_dbdef("/usr/local/etc/freeside/dbdef.$datasrc")
  98     unless $FS::Schema::setup_hack;
  99
 100   FS::CurrentUser->load_user($user);
 101
 102   foreach ( keys %callback ) {
 103     &{$callback{$_}};
 104     # breaks multi-database installs # delete $callback{$_}; #run once
 105   }
 106
 107   &{$_} foreach @callback;
 108
 109   $dbh;
 110 }
 111
 112 sub myconnect {
 113   DBI->connect( getsecrets, { 'AutoCommit'         => 0,
 114                               'ChopBlanks'         => 1,
 115                               'ShowErrorStatement' => 1,
 116                             }
 117               )
 118     or die "DBI->connect error: $DBI::errstr\n";
 119 }
 120
 121 =item install_callback
 122
 123 A package can install a callback to be run in adminsuidsetup by passing
 124 a coderef to the FS::UID->install_callback class method.  If adminsuidsetup has
 125 run already, the callback will also be run immediately.
 126
 127     $coderef = sub { warn "Hi, I'm returning your call!" };
 128     FS::UID->install_callback($coderef);
 129
 130     install_callback FS::UID sub {
 131       warn "Hi, I'm returning your call!"
 132     };
 133
 134 =cut
 135
 136 sub install_callback {
 137   my $class = shift;
 138   my $callback = shift;
 139   push @callback, $callback;
 140   &{$callback} if $dbh;
 141 }
 142
 143 =item cgisuidsetup CGI_object
 144
 145 Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
 146 object (CGI::Base is depriciated).  Runs cgisetotaker and then adminsuidsetup.
 147
 148 =cut
 149
 150 sub cgisuidsetup {
 151   $cgi=shift;
 152   if ( $cgi->isa('CGI::Base') ) {
 153     carp "Use of CGI::Base is depriciated";
 154   } elsif ( $cgi->isa('Apache') ) {
 155
 156   } elsif ( ! $cgi->isa('CGI') ) {
 157     croak "fatal: unrecognized object $cgi";
 158   }
 159   cgisetotaker;
 160   adminsuidsetup($user);
 161 }
 162
 163 =item cgi
 164
 165 Returns the CGI (see L<CGI>) object.
 166
 167 =cut
 168
 169 sub cgi {
 170   carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
 171   $cgi;
 172 }
 173
 174 =item dbh
 175
 176 Returns the DBI database handle.
 177
 178 =cut
 179
 180 sub dbh {
 181   $dbh;
 182 }
 183
 184 =item datasrc
 185
 186 Returns the DBI data source.
 187
 188 =cut
 189
 190 sub datasrc {
 191   $datasrc;
 192 }
 193
 194 =item driver_name
 195
 196 Returns just the driver name portion of the DBI data source.
 197
 198 =cut
 199
 200 sub driver_name {
 201   return $driver_name if defined $driver_name;
 202   $driver_name = ( split(':', $datasrc) )[1];
 203 }
 204
 205 sub suidsetup {
 206   croak "suidsetup depriciated";
 207 }
 208
 209 =item getotaker
 210
 211 Returns the current Freeside user.
 212
 213 =cut
 214
 215 sub getotaker {
 216   $user;
 217 }
 218
 219 =item cgisetotaker
 220
 221 Sets and returns the CGI REMOTE_USER.  $cgi should be defined as a CGI.pm
 222 object (see L<CGI>) or an Apache object (see L<Apache>).  Support for CGI::Base
 223 and derived classes is depriciated.
 224
 225 =cut
 226
 227 sub cgisetotaker {
 228   if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
 229     carp "Use of CGI::Base is depriciated";
 230     $user = lc ( $cgi->var('REMOTE_USER') );
 231   } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
 232     $user = lc ( $cgi->remote_user );
 233   } elsif ( $cgi && $cgi->isa('Apache') ) {
 234     $user = lc ( $cgi->connection->user );
 235   } else {
 236     die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
 237         "Apache user authentication as documented in httemplate/docs/install.html";
 238   }
 239   $user;
 240 }
 241
 242 =item checkeuid
 243
 244 Returns true if effective UID is that of the freeside user.
 245
 246 =cut
 247
 248 sub checkeuid {
 249   ( $> == $freeside_uid );
 250 }
 251
 252 =item checkruid
 253
 254 Returns true if the real UID is that of the freeside user.
 255
 256 =cut
 257
 258 sub checkruid {
 259   ( $< == $freeside_uid );
 260 }
 261
 262 =item getsecrets [ USER ]
 263
 264 Sets the user to USER, if supplied.
 265 Sets and returns the DBI datasource, username and password for this user from
 266 the `/usr/local/etc/freeside/mapsecrets' file.
 267
 268 =cut
 269
 270 sub getsecrets {
 271   my($setuser) = shift;
 272   $user = $setuser if $setuser;
 273   my($conf) = new FS::Conf $conf_dir;
 274
 275   if ( $conf->exists('mapsecrets') ) {
 276     die "No user!" unless $user;
 277     my($line) = grep /^\s*($user|\*)\s/, $conf->config('mapsecrets');
 278     die "User $user not found in mapsecrets!" unless $line;
 279     $line =~ /^\s*($user|\*)\s+(.*)$/;
 280     $secrets = $2;
 281     die "Illegal mapsecrets line for user?!" unless $secrets;
 282   } else {
 283     # no mapsecrets file at all, so do the default thing
 284     $secrets = 'secrets';
 285   }
 286
 287   ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
 288     or die "Can't get secrets: $secrets: $!\n";
 289   $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
 290   undef $driver_name;
 291   ($datasrc, $db_user, $db_pass);
 292 }
 293
 294 =back
 295
 296 =head1 CALLBACKS
 297
 298 Warning: this interface is (still) likely to change in future releases.
 299
 300 New (experimental) callback interface:
 301
 302 A package can install a callback to be run in adminsuidsetup by passing
 303 a coderef to the FS::UID->install_callback class method.  If adminsuidsetup has
 304 run already, the callback will also be run immediately.
 305
 306     $coderef = sub { warn "Hi, I'm returning your call!" };
 307     FS::UID->install_callback($coderef);
 308
 309     install_callback FS::UID sub {
 310       warn "Hi, I'm returning your call!"
 311     };
 312
 313 Old (deprecated) callback interface:
 314
 315 A package can install a callback to be run in adminsuidsetup by putting a
 316 coderef into the hash %FS::UID::callback :
 317
 318     $coderef = sub { warn "Hi, I'm returning your call!" };
 319     $FS::UID::callback{'Package::Name'} = $coderef;
 320
 321 =head1 BUGS
 322
 323 Too many package-global variables.
 324
 325 Not OO.
 326
 327 No capabilities yet.  When mod_perl and Authen::DBI are implemented,
 328 cgisuidsetup will go away as well.
 329
 330 Goes through contortions to support non-OO syntax with multiple datasrc's.
 331
 332 Callbacks are (still) inelegant.
 333
 334 =head1 SEE ALSO
 335
 336 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.
 337
 338 =cut
 339
 340 1;
 341