site_perl/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);
  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 = $cgi->var('REMOTE_USER');
 168   } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
 169     $user = $cgi->remote_user;
 170   } else {
 171     die "fatal: Can't get REMOTE_USER!";
 172   }
 173   return $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   ($<,$>) = ($>,$<);
 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   $line =~ /^\s*$user\s+(.*)$/;
 221   $secrets = $1;
 222   die "User not found in mapsecrets file!" unless $secrets;
 223   ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
 224     or die "Can't get secrets: $!";
 225   $FS::Conf::default_dir .= "/conf.$datasrc";
 226   ($datasrc, $db_user, $db_pass);
 227 }
 228
 229 =back
 230
 231 =head1 CALLBACKS
 232
 233 Warning: this interface is likely to change in future releases.
 234
 235 A package can install a callback to be run in adminsuidsetup by putting a
 236 coderef into the hash %FS::UID::callback :
 237
 238     $coderef = sub { warn "Hi, I'm returning your call!" };
 239     $FS::UID::callback{'Package::Name'};
 240
 241 =head1 BUGS
 242
 243 Too many package-global variables.
 244
 245 Not OO.
 246
 247 No capabilities yet.  When mod_perl and Authen::DBI are implemented,
 248 cgisuidsetup will go away as well.
 249
 250 Goes through contortions to support non-OO syntax with multiple datasrc's.
 251
 252 Callbacks are inelegant.
 253
 254 =head1 SEE ALSO
 255
 256 L<FS::Record>, L<CGI>, L<DBI>, config.html from the base documentation.
 257
 258 =head1 HISTORY
 259
 260 ivan@voicenet.com 97-jun-4 - 9
 261
 262 untaint otaker ivan@voicenet.com 97-jul-7
 263
 264 generalize and auto-get uid (getotaker still needs to be db'ed)
 265 ivan@sisd.com 97-nov-10
 266
 267 &cgisuidsetup logs into database.  other cleaning.
 268 ivan@sisd.com 97-nov-22,23
 269
 270 &adminsuidsetup logs into database with otaker='freeside' (for
 271 automated tasks like billing)
 272 ivan@sisd.com 97-dec-13
 273
 274 added sub datasrc for fs-setup ivan@sisd.com 98-feb-21
 275
 276 datasrc, user and pass now come from conf/secrets ivan@sisd.com 98-jun-28
 277
 278 added ChopBlanks to DBI call (see man DBI) ivan@sisd.com 98-aug-16
 279
 280 pod, use FS::Conf, implemented cgisuidsetup as adminsuidsetup,
 281 inlined suidsetup
 282 ivan@sisd.com 98-sep-12
 283
 284 $Log: UID.pm,v $
 285 Revision 1.4  1998-11-13 09:56:52  ivan
 286 change configuration file layout to support multiple distinct databases (with
 287 own set of config files, export, etc.)
 288
 289 Revision 1.3  1998/11/08 10:45:42  ivan
 290 got sub cgi for FS::CGI
 291
 292 Revision 1.2  1998/11/08 09:38:43  ivan
 293 cgisuidsetup complains if you pass it a isa CGI::Base instead of an isa CGI
 294 (first step in migrating from CGI-modules to CGI.pm)
 295
 296
 297 =cut
 298
 299 1;
 300