projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
stray closing /TABLE in the no-ticket case
[freeside.git] / FS / FS / UID.pm
diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm
index 7891019..50a9178 100644 (file)
--- a/FS/FS/UID.pm
+++ b/FS/FS/UID.pm
@@ -1,28 +1,33 @@
 package FS::UID;
 package FS::UID;
+use base qw( Exporter );
 
 use strict;
 use vars qw(
 
 use strict;
 use vars qw(
-  @ISA @EXPORT_OK $cgi $dbh $freeside_uid $user 
-  $conf_dir $secrets $datasrc $db_user $db_pass %callback $driver_name
-  $AutoCommit
+  @EXPORT_OK $DEBUG $me $cgi $freeside_uid $conf_dir $cache_dir
+  $secrets $datasrc $db_user $db_pass $schema $dbh $driver_name
+  $AutoCommit %callback @callback $callback_hack
 );
 );
-use subs qw(
-  getsecrets cgisetotaker
-);
-use Exporter;
-use Carp qw(carp croak cluck);
+use subs qw( getsecrets );
+use Carp qw( carp croak cluck confess );
 use DBI;
 use DBI;
-use FS::Conf;
+use IO::File;
+use FS::CurrentUser;
+
+@EXPORT_OK = qw( checkeuid checkruid cgi setcgi adminsuidsetup forksuidsetup
+                 preuser_setup load_schema
+                 getotaker dbh datasrc getsecrets driver_name myconnect
+               );
 
 
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
-                getotaker dbh datasrc getsecrets driver_name );
+$DEBUG = 0;
+$me = '[FS::UID]';
 
 $freeside_uid = scalar(getpwnam('freeside'));
 
 
 $freeside_uid = scalar(getpwnam('freeside'));
 
-$conf_dir = "/usr/local/etc/freeside/";
+$conf_dir  = "%%%FREESIDE_CONF%%%";
+$cache_dir = "%%%FREESIDE_CACHE%%%";
 
 $AutoCommit = 1; #ours, not DBI
 
 $AutoCommit = 1; #ours, not DBI
+$callback_hack = 0;
 
 =head1 NAME
 
 
 =head1 NAME
 
@@ -30,13 +35,9 @@ FS::UID - Subroutines for database login and assorted other stuff
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 
-  use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
-  checkeuid checkruid);
-
-  adminsuidsetup $user;
+  use FS::UID qw(adminsuidsetup dbh datasrc checkeuid checkruid);
 
 
-  $cgi = new CGI;
-  $dbh = cgisuidsetup($cgi);
+  $dbh = adminsuidsetup $user;
 
   $dbh = dbh;
 
 
   $dbh = dbh;
 
@@ -58,7 +59,6 @@ Sets the user to USER (see config.html from the base documentation).
 Cleans the environment.
 Make sure the script is running as freeside, or setuid freeside.
 Opens a connection to the database.
 Cleans the environment.
 Make sure the script is running as freeside, or setuid freeside.
 Opens a connection to the database.
-Swaps real and effective UIDs.
 Runs any defined callbacks (see below).
 Returns the DBI database handle (usually you don't need this).
 
 Runs any defined callbacks (see below).
 Returns the DBI database handle (usually you don't need this).
 
@@ -70,51 +70,142 @@ sub adminsuidsetup {
 }
 
 sub forksuidsetup {
 }
 
 sub forksuidsetup {
-  $user = shift;
-  croak "fatal: adminsuidsetup called without arguements" unless $user;
+  my $user = shift;
+  warn "$me forksuidsetup starting for $user\n" if $DEBUG;
+
+  if ( $FS::CurrentUser::upgrade_hack ) {
+    $user = 'fs_bootstrap';
+  } else {
+    croak "fatal: adminsuidsetup called without arguements" unless $user;
+
+    $user =~ /^([\w\-\.]+)$/ or croak "fatal: illegal user $user";
+    $user = $1;
+  }
+
+  env_setup();
+
+  db_setup();
+
+  callback_setup();
+
+  warn "$me forksuidsetup loading user\n" if $DEBUG;
+  FS::CurrentUser->load_user($user);
+
+  $dbh;
+}
+
+sub preuser_setup {
+  $dbh->disconnect if $dbh;
+  env_setup();
+  db_setup();
+  callback_setup();
+  $dbh;
+}
 
 
-  $user =~ /^([\w\-\.]+)/ or croak "fatal: illegal user $user";
-  $user = $1;
+sub env_setup {
 
 
-  $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
+  $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/bin';
   $ENV{'SHELL'} = '/bin/sh';
   $ENV{'IFS'} = " \t\n";
   $ENV{'CDPATH'} = '';
   $ENV{'ENV'} = '';
   $ENV{'BASH_ENV'} = '';
 
   $ENV{'SHELL'} = '/bin/sh';
   $ENV{'IFS'} = " \t\n";
   $ENV{'CDPATH'} = '';
   $ENV{'ENV'} = '';
   $ENV{'BASH_ENV'} = '';
 
-  croak "Not running uid freeside!" unless checkeuid();
-  getsecrets;
-  $dbh = DBI->connect($datasrc,$db_user,$db_pass, {
-                          'AutoCommit' => 0,
-                          'ChopBlanks' => 1,
-  } ) or die "DBI->connect error: $DBI::errstr\n";
+}
+
+sub load_schema {
+  warn "$me loading schema\n" if $DEBUG;
+  getsecrets() unless $datasrc;
+  use FS::Schema qw(reload_dbdef dbdef);
+  reload_dbdef("$conf_dir/dbdef.$datasrc")
+    unless $FS::Schema::setup_hack;
+}
+
+sub db_setup {
+  croak "Not running uid freeside (\$>=$>, \$<=$<)\n" unless checkeuid();
+
+  warn "$me forksuidsetup connecting to database\n" if $DEBUG;
+  $dbh = &myconnect();
+
+  warn "$me forksuidsetup connected to database with handle $dbh\n" if $DEBUG;
+
+  load_schema();
+
+  warn "$me forksuidsetup deciding upon config system to use\n" if $DEBUG;
+
+  unless ( $FS::Schema::setup_hack ) {
+
+    #how necessary is this now that we're no longer possibly a pre-1.9 db?
+    my $sth = $dbh->prepare("SELECT COUNT(*) FROM conf") or die $dbh->errstr;
+    $sth->execute or die $sth->errstr;
+    $sth->fetchrow_arrayref->[0] or die "NO CONFIGURATION RECORDS FOUND";
 
 
-  foreach ( keys %callback ) {
-    &{$callback{$_}};
   }
 
   }
 
-  $dbh;
+
 }
 
 }
 
-=item cgisuidsetup CGI_object
+sub callback_setup {
 
 
-Takes a single argument, which is a CGI (see L<CGI>) or Apache (see L<Apache>)
-object (CGI::Base is depriciated).  Runs cgisetotaker and then adminsuidsetup.
+  unless ( $callback_hack ) {
+    warn "$me calling callbacks\n" if $DEBUG;
+    foreach ( keys %callback ) {
+      &{$callback{$_}};
+      # breaks multi-database installs # delete $callback{$_}; #run once
+    }
 
 
-=cut
+    &{$_} foreach @callback;
+  } else {
+    warn "$me skipping callbacks (callback_hack set)\n" if $DEBUG;
+  }
 
 
-sub cgisuidsetup {
-  $cgi=shift;
-  if ( $cgi->isa('CGI::Base') ) {
-    carp "Use of CGI::Base is depriciated";
-  } elsif ( $cgi->isa('Apache') ) {
+}
 
 
-  } elsif ( ! $cgi->isa('CGI') ) {
-    croak "fatal: unrecognized object $cgi";
+sub myconnect {
+  my $handle = DBI->connect( getsecrets(), { 'AutoCommit'         => 0,
+                                             'ChopBlanks'         => 1,
+                                             'ShowErrorStatement' => 1,
+                                             'pg_enable_utf8'     => 1,
+                                             #'mysql_enable_utf8'  => 1,
+                                           }
+                           )
+    or die "DBI->connect error: $DBI::errstr\n";
+
+  $FS::Conf::conf_cache = undef;
+
+  if ( $schema ) {
+    use DBIx::DBSchema::_util qw(_load_driver ); #quelle hack
+    my $driver = _load_driver($handle);
+    if ( $driver =~ /^Pg/ ) {
+      no warnings 'redefine';
+      eval "sub DBIx::DBSchema::DBD::${driver}::default_db_schema {'$schema'}";
+      die $@ if $@;
+    }
   }
   }
-  cgisetotaker; 
-  adminsuidsetup($user);
+
+  $handle;
+}
+
+=item install_callback
+
+A package can install a callback to be run in adminsuidsetup by passing
+a coderef to the FS::UID->install_callback class method.  If adminsuidsetup has
+run already, the callback will also be run immediately.
+
+    $coderef = sub { warn "Hi, I'm returning your call!" };
+    FS::UID->install_callback($coderef);
+
+    install_callback FS::UID sub { 
+      warn "Hi, I'm returning your call!"
+    };
+
+=cut
+
+sub install_callback {
+  my $class = shift;
+  my $callback = shift;
+  push @callback, $callback;
+  &{$callback} if $dbh;
 }
 
 =item cgi
 }
 
 =item cgi
@@ -124,10 +215,21 @@ Returns the CGI (see L<CGI>) object.
 =cut
 
 sub cgi {
 =cut
 
 sub cgi {
-  carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
+  carp "warning: \$FS::UID::cgi is undefined" unless defined($cgi);
+  #carp "warning: \$FS::UID::cgi isa Apache" if $cgi && $cgi->isa('Apache');
   $cgi;
 }
 
   $cgi;
 }
 
+=item cgi CGI_OBJECT
+
+Sets the CGI (see L<CGI>) object.
+
+=cut
+
+sub setcgi {
+  $cgi = shift;
+}
+
 =item dbh
 
 Returns the DBI database handle.
 =item dbh
 
 Returns the DBI database handle.
@@ -165,35 +267,13 @@ sub suidsetup {
 
 =item getotaker
 
 
 =item getotaker
 
-Returns the current Freeside user.
+(Deprecated) Returns the current Freeside user's username.
 
 =cut
 
 sub getotaker {
 
 =cut
 
 sub getotaker {
-  $user;
-}
-
-=item cgisetotaker
-
-Sets and returns the CGI REMOTE_USER.  $cgi should be defined as a CGI.pm
-object (see L<CGI>) or an Apache object (see L<Apache>).  Support for CGI::Base
-and derived classes is depriciated.
-
-=cut
-
-sub cgisetotaker {
-  if ( $cgi && $cgi->isa('CGI::Base') && defined $cgi->var('REMOTE_USER')) {
-    carp "Use of CGI::Base is depriciated";
-    $user = lc ( $cgi->var('REMOTE_USER') );
-  } elsif ( $cgi && $cgi->isa('CGI') && defined $cgi->remote_user ) {
-    $user = lc ( $cgi->remote_user );
-  } elsif ( $cgi && $cgi->isa('Apache') ) {
-    $user = lc ( $cgi->connection->user );
-  } else {
-    die "fatal: Can't get REMOTE_USER! for cgi $cgi - you need to setup ".
-        "Apache user authentication as documented in httemplate/docs/install.html";
-  }
-  $user;
+  carp "FS::UID::getotaker deprecated";
+  $FS::CurrentUser::CurrentUser->username;
 }
 
 =item checkeuid
 }
 
 =item checkeuid
@@ -203,6 +283,7 @@ Returns true if effective UID is that of the freeside user.
 =cut
 
 sub checkeuid {
 =cut
 
 sub checkeuid {
+  #$> = $freeside_uid unless $>; #huh.  mpm-itk hack
   ( $> == $freeside_uid );
 }
 
   ( $> == $freeside_uid );
 }
 
@@ -216,28 +297,20 @@ sub checkruid {
   ( $< == $freeside_uid );
 }
 
   ( $< == $freeside_uid );
 }
 
-=item getsecrets [ USER ]
+=item getsecrets
 
 
-Sets the user to USER, if supplied.
-Sets and returns the DBI datasource, username and password for this user from
-the `/usr/local/etc/freeside/mapsecrets' file.
+Sets and returns the DBI datasource, username and password from
+the `/usr/local/etc/freeside/secrets' file.
 
 =cut
 
 sub getsecrets {
 
 =cut
 
 sub getsecrets {
-  my($setuser) = shift;
-  $user = $setuser if $setuser;
-  die "No user!" unless $user;
-  my($conf) = new FS::Conf $conf_dir;
-  my($line) = grep /^\s*$user\s/, $conf->config('mapsecrets');
-  die "User not found in mapsecrets!" unless $line;
-  $line =~ /^\s*$user\s+(.*)$/;
-  $secrets = $1;
-  die "Illegal mapsecrets line for user?!" unless $secrets;
-  ($datasrc, $db_user, $db_pass) = $conf->config($secrets)
-    or die "Can't get secrets: $!";
-  $FS::Conf::default_dir = $conf_dir. "/conf.$datasrc";
+
+  ($datasrc, $db_user, $db_pass, $schema) = 
+    map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/secrets")
+      or die "Can't get secrets: $conf_dir/secrets: $!\n";
   undef $driver_name;
   undef $driver_name;
+
   ($datasrc, $db_user, $db_pass);
 }
 
   ($datasrc, $db_user, $db_pass);
 }
 
@@ -245,17 +318,28 @@ sub getsecrets {
 
 =head1 CALLBACKS
 
 
 =head1 CALLBACKS
 
-Warning: this interface is likely to change in future releases.
+Warning: this interface is (still) likely to change in future releases.
 
 
-A package can install a callback to be run in adminsuidsetup by putting a
-coderef into the hash %FS::UID::callback :
+New (experimental) callback interface:
+
+A package can install a callback to be run in adminsuidsetup by passing
+a coderef to the FS::UID->install_callback class method.  If adminsuidsetup has
+run already, the callback will also be run immediately.
 
     $coderef = sub { warn "Hi, I'm returning your call!" };
 
     $coderef = sub { warn "Hi, I'm returning your call!" };
-    $FS::UID::callback{'Package::Name'};
+    FS::UID->install_callback($coderef);
+
+    install_callback FS::UID sub { 
+      warn "Hi, I'm returning your call!"
+    };
 
 
-=head1 VERSION
+Old (deprecated) callback interface:
 
 
-$Id: UID.pm,v 1.13 2002-02-23 02:14:25 jeff Exp $
+A package can install a callback to be run in adminsuidsetup by putting a
+coderef into the hash %FS::UID::callback :
+
+    $coderef = sub { warn "Hi, I'm returning your call!" };
+    $FS::UID::callback{'Package::Name'} = $coderef;
 
 =head1 BUGS
 
 
 =head1 BUGS
 
@@ -263,12 +347,11 @@ Too many package-global variables.
 
 Not OO.
 
 
 Not OO.
 
-No capabilities yet.  When mod_perl and Authen::DBI are implemented, 
-cgisuidsetup will go away as well.
+No capabilities yet. (What does this mean again?)
 
 Goes through contortions to support non-OO syntax with multiple datasrc's.
 
 
 Goes through contortions to support non-OO syntax with multiple datasrc's.
 
-Callbacks are inelegant.
+Callbacks are (still) inelegant.
 
 =head1 SEE ALSO
 
 
 =head1 SEE ALSO
 
Freeside billing, trouble ticketing, network monitoring and provisioning