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