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