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