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 $driver_name
   7   $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
  17 @ISA = qw(Exporter);
  18 @EXPORT_OK = qw(checkeuid checkruid swapuid cgisuidsetup
  19                 adminsuidsetup getotaker dbh datasrc getsecrets driver_name );
  20
  21 $freeside_uid = scalar(getpwnam('freeside'));
  22
  23 $conf_dir = "/usr/local/etc/freeside/";
  24
  25 $AutoCommit = 1; #ours, not DBI
  26
  27 =head1 NAME
  28
  29 FS::UID - Subroutines for database login and assorted other stuff
  30
  31 =head1 SYNOPSIS
  32
  33   use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
  34   checkeuid checkruid swapuid);
  35
  36   adminsuidsetup $user;
  37
  38   $cgi = new CGI;
  39   $dbh = cgisuidsetup($cgi);
  40
  41   $dbh = dbh;
  42
  43   $datasrc = datasrc;
  44
  45   $driver_name = driver_name;
  46
  47 =head1 DESCRIPTION
  48
  49 Provides a hodgepodge of subroutines.
  50
  51 =head1 SUBROUTINES
  52
  53 =over 4
  54
  55 =item adminsuidsetup USER
  56
  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).
  64
  65 =cut
  66
  67 sub adminsuidsetup {
  68
  69   $user = shift;
  70   croak "fatal: adminsuidsetup called without arguements" unless $user;
  71
  72   $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
  73   $ENV{'SHELL'} = '/bin/sh';
  74   $ENV{'IFS'} = " \t\n";
  75   $ENV{'CDPATH'} = '';
  76   $ENV{'ENV'} = '';
  77   $ENV{'BASH_ENV'} = '';
  78
  79   croak "Not running uid freeside!" unless checkeuid();
  80   getsecrets;
  81   $dbh->disconnect if $dbh;
  82   $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
  83                           'AutoCommit' => 0,
  84                           'ChopBlanks' => 1,
  85   } ) or die "DBI->connect error: $DBI::errstr\n";
  86
  87   swapuid(); #go to non-privledged user if running setuid freeside
  88
  89   foreach ( keys %callback ) {
  90     &{$callback{$_}};
  91   }
  92
  93   $dbh;
  94 }
  95
  96 =item cgisuidsetup CGI_object
  97
  98 Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
  99 object (CGI::Base is depriciated).  Runs cgisetotaker and then adminsuidsetup.
 100
 101 =cut
 102
 103 sub cgisuidsetup {
 104   $cgi=shift;
 105   if ( $cgi->isa('CGI::Base') ) {
 106     carp "Use of CGI::Base is depriciated";
 107   } elsif ( $cgi->isa('Apache') ) {
 108
 109   } elsif ( ! $cgi->isa('CGI') ) {
 110     croak "fatal: unrecognized object $cgi";
 111   }
 112   cgisetotaker;
 113   adminsuidsetup($user);
 114 }
 115
 116 =item cgi
 117
 118 Returns the CGI (see L<CGI>) object.
 119
 120 =cut
 121
 122 sub cgi {
 123   carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
 124   $cgi;
 125 }
 126
 127 =item dbh
 128
 129 Returns the DBI database handle.
 130
 131 =cut
 132
 133 sub dbh {
 134   $dbh;
 135 }
 136
 137 =item datasrc
 138
 139 Returns the DBI data source.
 140
 141 =cut
 142
 143 sub datasrc {
 144   $datasrc;
 145 }
 146
 147 =item driver_name
 148
 149 Returns just the driver name portion of the DBI data source.
 150
 151 =cut
 152
 153 sub driver_name {
 154   return $driver_name if defined $driver_name;
 155   $driver_name = ( split(':', $datasrc) )[1];
 156 }
 157
 158 sub suidsetup {
 159   croak "suidsetup depriciated";
 160 }
 161
 162 =item getotaker
 163
 164 Returns the current Freeside user.
 165
 166 =cut
 167
 168 sub getotaker {
 169   $user;
 170 }
 171
 172 =item cgisetotaker
 173
 174 Sets and returns the CGI REMOTE_USER.  $cgi should be defined as a CGI.pm
 175 object (see L<CGI>) or an Apache object (see L<Apache>).  Support for CGI::Base
 176 and derived classes is depriciated.
 177
 178 =cut
 179
 180 sub cgisetotaker {
 181   if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
 182     carp "Use of CGI::Base is depriciated";
 183     $user = lc ( $cgi->var('REMOTE_USER') );
 184   } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
 185     $user = lc ( $cgi->remote_user );
 186   } elsif ( $cgi && $cgi->isa('Apache') ) {
 187     $user = lc ( $cgi->connection->user );
 188   } else {
 189     die "fatal: Can't get REMOTE_USER! for cgi $cgi";
 190   }
 191   $user;
 192 }
 193
 194 =item checkeuid
 195
 196 Returns true if effective UID is that of the freeside user.
 197
 198 =cut
 199
 200 sub checkeuid {
 201   ( $> == $freeside_uid );
 202 }
 203
 204 =item checkruid
 205
 206 Returns true if the real UID is that of the freeside user.
 207
 208 =cut
 209
 210 sub checkruid {
 211   ( $< == $freeside_uid );
 212 }
 213
 214 =item swapuid
 215
 216 Swaps real and effective UIDs.
 217
 218 =cut
 219
 220 sub swapuid {
 221   ($<,$>) = ($>,$<) if $< != $>;
 222 }
 223
 224 =item getsecrets [ USER ]
 225
 226 Sets the user to USER, if supplied.
 227 Sets and returns the DBI datasource, username and password for this user from
 228 the `/usr/local/etc/freeside/mapsecrets' file.
 229
 230 =cut
 231
 232 sub getsecrets {
 233   my($setuser) = shift;
 234   $user = $setuser if $setuser;
 235   die "No user!" unless $user;
 236   my($conf) = new FS::Conf $conf_dir;
 237   my($line) = grep /^\s*$user\s/, $conf->config('mapsecrets');
 238   die "User not found in mapsecrets!" unless $line;
 239   $line =~ /^\s*$user\s+(.*)$/;
 240   $secrets = $1;
 241   die "Illegal mapsecrets line for user?!" unless $secrets;
 242   ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
 243     or die "Can't get secrets: $!";
 244   $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
 245   undef $driver_name;
 246   ($datasrc, $db_user, $db_pass);
 247 }
 248
 249 =back
 250
 251 =head1 CALLBACKS
 252
 253 Warning: this interface is likely to change in future releases.
 254
 255 A package can install a callback to be run in adminsuidsetup by putting a
 256 coderef into the hash %FS::UID::callback :
 257
 258     $coderef = sub { warn "Hi, I'm returning your call!" };
 259     $FS::UID::callback{'Package::Name'};
 260
 261 =head1 VERSION
 262
 263 $Id: UID.pm,v 1.6 2001-04-23 09:00:06 ivan Exp $
 264
 265 =head1 BUGS
 266
 267 Too many package-global variables.
 268
 269 Not OO.
 270
 271 No capabilities yet.  When mod_perl and Authen::DBI are implemented,
 272 cgisuidsetup will go away as well.
 273
 274 Goes through contortions to support non-OO syntax with multiple datasrc's.
 275
 276 Callbacks are inelegant.
 277
 278 =head1 SEE ALSO
 279
 280 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.
 281
 282 =cut
 283
 284 1;
 285