perl-modperl mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Curtis Jewell <curtis_wha...@yahoo.com>
Subject [mp2] Okay. Where's my error here... (Authen module)
Date Tue, 13 Jan 2004 21:49:21 GMT
This is an Authen module that's letting everything through at the moment 
(it was ported from a 1.0 routine that worked)

I even tried an incorrect password and it didn't catch it!

I'm going "Okay. What happened? What's wrong here?" at the moment.

Here's the .htaccess for what is supposed to be going on:

<Files index.html>
  SetHandler perl-script

  PerlAuthenHandler Local::LDSMN::AuthenMDL
  PerlSetVar Cookie 1

  AuthName "LDSMN Administrators"
  AuthType Basic

  <Limit GET POST>
   require valid-user
  </Limit>

  PerlHandler Local::LDSMN::TOC::View
  PerlSetVar TOCType admin
</Files>

And below is the AuthenMDL module. It seems to execute (I get the "No 
Username" error in the log, but none of the other log lines seem to come 
up!)

Help!

--Curtis

package Local::LDSMN::AuthenMDL;

# use strict; doesn't work with the constants.
use mod_perl 1.99;
require Apache::Const;
require Apache::Access;
require Apache::Connection;
require Apache::Log;
require Apache::RequestRec;
require Apache::RequestUtil;
Apache::Const->import(-compile => 
'HTTP_UNAUTHORIZED','OK','HTTP_SERVICE_UNAVAILABLE');
use APR::Table;
use CGI::Cookie;
use DBI;

sub handler {

   my($r) = @_;

   my($res, $sent_pwd);

   return OK unless $r->is_initial_req; # only the first internal request

   ($res, $sent_pwd) = $r->get_basic_auth_pw;
   return $res if $res; #decline if not Basic

   my $sent_user = $r->user;

   if ($sent_user == "") {
     $r->log_error("No username was given for ", $r->uri);
     $r->note_basic_auth_failure;
     return Apache::HTTP_UNAUTHORIZED;
   }

   $r->log_error("[TEST] Authenticating at ", $r->uri);

   my $dbh = DBI->connect("dbi:Pg(AutoCommit=>0):dbname=missinfo",
                          "postgres", "",
                          {RaiseError => 0, AutoCommit => 0});

   if (!defined($dbh)) {
     $r->log_error("Authentication database could not be opened for ",
       $r->uri);
     $r->note_basic_auth_failure;
     return Apache::HTTP_SERVICE_UNAVAILABLE;
   }

   my $sql_command = <<EOF;
SELECT m.username, m.password, m.maintid
FROM maintainers m, admin a
WHERE a.maintid = m.maintid
   AND m.username = ?
EOF

   my ($db_user, $db_passwd, $db_id) =
     $dbh->selectrow_array($sql_command, undef, $sent_user);

   $dbh->disconnect;

   unless (defined $db_user) {
     $r->log_error("User '$sent_user' not found at ", $r->uri);
     $r->note_basic_auth_failure;
     return Apache::HTTP_UNAUTHORIZED;
   }

   unless ($sent_pwd eq $db_passwd) {
     $r->log_error("user $sent_user: password mismatch at ", $r->uri);
     $r->note_basic_auth_failure;
     return Apache::HTTP_UNAUTHORIZED;
   }

   my $bake_cookie = $r->dir_config('Cookie') || 0;

   if ($bake_cookie) {
     $r->log_error("[TEST] Creating cookies at ", $r->uri);

     my $cookie0 = new CGI::Cookie(
       -name => 'mn_passwd', -value => 'access!', -domain => 
'.mission.net', -path =>  '/',);

     my $cookie1 = new CGI::Cookie(
       -name => 'mnw_user', -value => $db_user, -domain => 
'.mission.net', -path =>  '/',);

     my $cookie2 = new CGI::Cookie(
       -name => 'mnw_passwd', -value => $db_passwd, -domain => 
'.mission.net', -path =>  '/',);

     my $cookie3 = new CGI::Cookie(
       -name => 'mnw_id', -value => $db_id, -domain => '.mission.net', 
-path =>  '/',);

     my $filename = $r->filename;

     if ($filename =~ m#logout\.html$#) {
       # expire it now!
       $cookie0->expires('-1d');
       $cookie1->expires('-1d');
       $cookie2->expires('-1d');
       $cookie3->expires('-1d');
     }

     $r->err_headers_out->add('Set-Cookie' => $cookie0);
     $r->err_headers_out->add('Set-Cookie' => $cookie1);
     $r->err_headers_out->add('Set-Cookie' => $cookie2);
     $r->err_headers_out->add('Set-Cookie' => $cookie3);

   } else {
     $r->log_error("[UHOH] NOT Creating cookies at ", $r->uri);
   }

   return Apache::OK;
}

1;

-- 
LDS Mission Network(sm)
The mission home of the World Wide Web.(sm)
www.mission.net / www.ldsmissions.net
Curtis Jewell, curtis.jewell@mission.net


-- 
Reporting bugs: http://perl.apache.org/bugs/
Mail list info: http://perl.apache.org/maillist/modperl.html


Mime
View raw message