login/login pages and cookie/session-based auth

9 files changed, 144 insertions, 93 deletions

diff --git a/FS/FS/Auth/external.pm b/FS/FS/Auth/external.pm
new file mode 100644
index 000000000..d2bc74600
--- /dev/null
+++ b/FS/FS/Auth/external.pm
@@ -0,0 +1,18 @@
+packages FS::Auth::external;
+#use base qw( FS::Auth );
+
+use strict;
+
+sub autocreate {
+  my $username = shift;
+  my $access_user = new FS::access_user {
+    'username' => $username,
+    #'_password' => #XXX something random so a switch to internal auth doesn't
+                    #let people on?
+  };
+  my $error = $access_user->insert;
+  #die $error if $error;
+}
+
+1;
+
diff --git a/FS/FS/access_user/internal.pm b/FS/FS/Auth/internal.pm
index 94f932dee..86fddd237 100644
--- a/FS/FS/access_user/internal.pm
+++ b/FS/FS/Auth/internal.pm
@@ -1,5 +1,5 @@
-package FS::access_user::internal;
-use base qw( FS::access_user );
+package FS::Auth::internal;
+#use base qw( FS::Auth );
 
 use strict;
 
diff --git a/FS/FS/Auth/legacy.pm b/FS/FS/Auth/legacy.pm
new file mode 100644
index 000000000..72122029e
--- /dev/null
+++ b/FS/FS/Auth/legacy.pm
@@ -0,0 +1,25 @@
+package FS::Auth::legacy;
+#use base qw( FS::Auth ); #::internal ?
+
+use strict;
+use Apache::Htpasswd;
+
+#substitute in?  we're trying to make it go away...
+my $htpasswd_file = '/usr/local/etc/freeside/htpasswd';
+
+sub authenticate {
+  my($self, $username, $check_password ) = @_;
+
+  Apache::Htpasswd->new( { passwdFile => $htpasswd_file,
+                           ReadOnly   => 1,
+                         }
+    )->htCheckPassword($username, $check_password);
+}
+
+#don't support this in legacy?  change in both htpasswd and database like 3.x
+# for easier transitioning?  hoping its really only me+employees that have a
+# mismatch in htpasswd vs access_user, so maybe that's not necessary
+#sub change_password {
+#}
+
+1;
diff --git a/FS/FS/AuthCookieHandler.pm b/FS/FS/AuthCookieHandler.pm
new file mode 100644
index 000000000..a4a31188e
--- /dev/null
+++ b/FS/FS/AuthCookieHandler.pm
@@ -0,0 +1,56 @@
+package FS::AuthCookieHandler;
+use base qw( Apache2::AuthCookie );
+
+use strict;
+use Digest::SHA qw( sha1_hex );
+use FS::UID qw( adminsuidsetup );
+
+my $secret = "XXX temporary"; #XXX move to a DB session with random number as key
+
+my $module = 'legacy'; #XXX i am set in a conf somehow?  or a config file
+
+sub authen_cred {
+  my( $self, $r, $username, $password ) = @_;
+
+  if ( _is_valid_user($username, $password) ) {
+      warn "authenticated $username from ". $r->connection->remote_ip. "\n";
+      adminsuidsetup($username);
+      my $session_key =
+        $username . '::' . sha1_hex( $username, $secret );
+      return $session_key;
+  } else {
+      warn "failed authentication $username from ". $r->connection->remote_ip. "\n";
+  }
+
+  return undef; #?
+}
+
+sub _is_valid_user {
+  my( $username, $password ) = @_;
+  my $class = 'FS::Auth::'.$module;
+
+  #earlier?
+  eval "use $class;";
+  die $@ if $@;
+
+  $class->authenticate($username, $password);
+
+}
+
+sub authen_ses_key {
+  my( $self, $r, $session_key ) = @_;
+
+  my ($username, $mac) = split /::/, $session_key;
+
+  if ( sha1_hex( $username, $secret ) eq $mac ) {
+    adminsuidsetup($username);
+    return $username;
+  } else {
+    warn "bad session $session_key from ". $r->connection->remote_ip. "\n";
+  }
+
+  return undef;
+
+}
+
+1;
diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm
index 972625ff6..5ac31dbec 100644
--- a/FS/FS/CGI.pm
+++ b/FS/FS/CGI.pm
@@ -6,7 +6,7 @@ use Exporter;
 use CGI;
 use URI::URL;
 #use CGI::Carp qw(fatalsToBrowser);
-use FS::UID;
+use FS::UID qw( cgi );
 
 @ISA = qw(Exporter);
 @EXPORT_OK = qw( header menubar idiot eidiot popurl rooturl table itable ntable
@@ -232,7 +232,7 @@ sub rooturl {
     $url_string = shift;
   } else {
     # better to start with the client-provided URL
-    my $cgi = &FS::UID::cgi;
+    my $cgi = cgi;
     $url_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url;
   }
 
@@ -244,7 +244,7 @@ sub rooturl {
   $url_string =~
     s{
        /
-       (browse|config|docs|edit|graph|misc|search|view|pref|elements|rt|torrus)
+       (browse|config|docs|edit|graph|misc|search|view|loginout|pref|elements|rt|torrus)
        (/process)?
        ([\w\-\.\/]*)
        $
diff --git a/FS/FS/Mason/Request.pm b/FS/FS/Mason/Request.pm
index 36c46dc41..1e2555a76 100644
--- a/FS/FS/Mason/Request.pm
+++ b/FS/FS/Mason/Request.pm
@@ -69,7 +69,7 @@ sub freeside_setup {
       FS::Trace->log('    handling RT REST/NoAuth file');
 
       package HTML::Mason::Commands; #?
-      use FS::UID qw( adminsuidsetup );
+      use FS::UID qw( adminsuidsetup setcgi );
 
       #need to log somebody in for the mail gw
 
@@ -86,14 +86,15 @@ sub freeside_setup {
       package HTML::Mason::Commands;
       use vars qw( $cgi $p $fsurl ); # $lh ); #not using /mt
       use Encode;
-      use FS::UID qw( cgisuidsetup );
+      #use FS::UID qw( cgisuidsetup );
       use FS::CGI qw( popurl rooturl );
 
       if ( $mode eq 'apache' ) {
         $cgi = new CGI;
-        FS::Trace->log('    cgisuidsetup');
-        &cgisuidsetup($cgi);
-        #&cgisuidsetup($r);
+        setcgi($cgi);
+
+        #cgisuidsetup is gone, adminsuidsetup is now done in AuthCookieHandler
+
         $fsurl = rooturl();
         $p = popurl(2);
       } elsif ( $mode eq 'standalone' ) {
@@ -106,19 +107,19 @@ sub freeside_setup {
         die "unknown mode $mode";
       }
 
-    FS::Trace->log('    UTF-8-decoding form data');
-    #
-    foreach my $param ( $cgi->param ) {
-      my @values = $cgi->param($param);
-      next if $cgi->uploadInfo($values[0]);
-      #warn $param;
-      @values = map decode(utf8=>$_), @values;
-      $cgi->param($param, @values);
+      FS::Trace->log('    UTF-8-decoding form data');
+      #
+      foreach my $param ( $cgi->param ) {
+        my @values = $cgi->param($param);
+        next if $cgi->uploadInfo($values[0]);
+        #warn $param;
+        @values = map decode(utf8=>$_), @values;
+        $cgi->param($param, @values);
+      }
+
     }
-    
-  }
 
-  FS::Trace->log('    done');
+    FS::Trace->log('    done');
 
 }
 
diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm
index 67bb75fe3..44d3870cc 100644
--- a/FS/FS/UID.pm
+++ b/FS/FS/UID.pm
@@ -6,19 +6,18 @@ use vars qw(
   $secrets $datasrc $db_user $db_pass $schema $dbh $driver_name
   $AutoCommit %callback @callback $callback_hack $use_confcompat
 );
-use subs qw(
-  getsecrets cgisetotaker
-);
+use subs qw( getsecrets );
 use Exporter;
-use Carp qw(carp croak cluck confess);
+use Carp qw( carp croak cluck confess );
 use DBI;
 use IO::File;
 use FS::CurrentUser;
 
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup
-                getotaker dbh datasrc getsecrets driver_name myconnect
-                use_confcompat);
+@EXPORT_OK = qw( checkeuid checkruid cgi setcgi adminsuidsetup forksuidsetup
+                 getotaker dbh datasrc getsecrets driver_name myconnect
+                 use_confcompat
+               );
 
 $DEBUG = 0;
 $me = '[FS::UID]';
@@ -38,13 +37,9 @@ FS::UID - Subroutines for database login and assorted other stuff
 
 =head1 SYNOPSIS
 
-  use FS::UID qw(adminsuidsetup cgisuidsetup dbh datasrc getotaker
-  checkeuid checkruid);
-
-  adminsuidsetup $user;
+  use FS::UID qw(adminsuidsetup dbh datasrc getotaker checkeuid checkruid);
 
-  $cgi = new CGI;
-  $dbh = cgisuidsetup($cgi);
+  $dbh = adminsuidsetup $user;
 
   $dbh = dbh;
 
@@ -194,35 +189,26 @@ sub install_callback {
   &{$callback} if $dbh;
 }
 
-=item cgisuidsetup CGI_object
+=item cgi
 
-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.
+Returns the CGI (see L<CGI>) object.
 
 =cut
 
-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";
-  }
-  cgisetotaker; 
-  adminsuidsetup($user);
+sub cgi {
+  carp "warning: \$FS::UID::cgi is undefined" unless defined($cgi);
+  #carp "warning: \$FS::UID::cgi isa Apache" if $cgi && $cgi->isa('Apache');
+  $cgi;
 }
 
-=item cgi
+=item cgi CGI_OBJECT
 
-Returns the CGI (see L<CGI>) object.
+Sets the CGI (see L<CGI>) object.
 
 =cut
 
-sub cgi {
-  carp "warning: \$FS::UID::cgi isa Apache" if $cgi->isa('Apache');
-  $cgi;
+sub setcgi {
+  $cgi = shift;
 }
 
 =item dbh
@@ -270,29 +256,6 @@ 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 the installation instructions";
-  }
-  $user;
-}
-
 =item checkeuid
 
 Returns true if effective UID is that of the freeside user.
@@ -390,8 +353,7 @@ Too many package-global variables.
 
 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.
 
diff --git a/FS/FS/access_user/legacy.pm b/FS/FS/access_user/legacy.pm
deleted file mode 100644
index f8dcdc015..000000000
--- a/FS/FS/access_user/legacy.pm
+++ /dev/null
@@ -1,15 +0,0 @@
-package FS::access_user::legacy;
-use base qw( FS::access_user ); #::internal ?
-
-use strict;
-
-sub authenticate {
-  my( $username, $check_password ) = @_;
-
-
-}
-
-sub change_password {
-}
-
-1;
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 95b11f8e5..43f36abf6 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -27,6 +27,10 @@ bin/freeside-sqlradius-seconds
 bin/freeside-torrus-srvderive
 FS.pm
 FS/AccessRight.pm
+FS/AuthCookieHandler.pm
+FS/Auth/external.pm
+FS/Auth/internal.pm
+FS/Auth/legacy.pm
 FS/CGI.pm
 FS/InitHandler.pm
 FS/ClientAPI.pm