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