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