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