view release on metacpan or  search on metacpan

AuthenNTLM.pm  view on Meta::CPAN

	}
    else
	{
	$self -> {domain} = $self -> {defaultdomain} ;
	}

    $self -> {userdomain} = $self -> {domain} ; 

    if ($debug)
        {
        print STDERR "[$$] AuthenNTLM: basic auth username = $self->{domain}\\$self->{username}\n" ;
        }

    return -1 ;
    }


sub DESTROY

    {
    my ($self) = @_ ;

    Authen::Smb::Valid_User_Disconnect ($self -> {smbhandle}) if ($self -> {smbhandle}) ;
    }

sub handler1 ($$) { &run }
sub handler2 : method { &run }

*handler = MP2 ? \&handler2 : \&handler1;

sub run
   {
    my ($class, $r) = @_ ;
    my $type ;
    my $nonce = '' ;
    my $self ;
    my $conn = $r -> connection ;
    my $connhdr = MP2 ? $r -> headers_in -> {'Connection'} : $r -> header_in ('Connection') ;

    my $fh = select (STDERR) ;
    $| = 1 ;
    select ($fh) ;

    if (MP2)
    {
    	my $addr = $conn -> remote_addr -> ip_get ;
    	my $port = MP2 ? $conn -> remote_addr -> port : $conn -> remote_addr -> port_get ;
    }
    else
    {
    	my ($addr, $port) = sockaddr_in ($conn -> remote_addr) ;
    }

    print STDERR "[$$] AuthenNTLM: Start NTLM Authen handler pid = $$, connection = " 
	           . "$$conn conn_http_hdr = $connhdr  main = " . ($r -> main) 
		     . " cuser = " . $r -> user . ' remote_ip = ' . $conn -> remote_ip 
		      . " remote_port = " . unpack('n', $port) . ' remote_host = <' 
		       . $conn -> remote_host . "> version = $VERSION "
                        . "smbhandle = " . $self -> {smbhandle} . "\n" if ($debug) ;

    # we cannot attach our object to the connection record. Since in
    # Apache 1.3 there is only one connection at a time per process
    # we can cache our object and check if the connection has changed.
    # The check is done by slightly changing the remote_host member, which
    # persists as long as the connection does
    # This has to be reworked to work with Apache 2.0
     my $table;
     $table = $conn->notes() if MP2;
     if (ref ($cache) ne $class || $$conn != $cache->{connectionid} ||
       (!MP2 && $conn->remote_host ne $cache->{remote_host}) ||
       (MP2 && $table->get('status') ne "AUTHSTARTED"))
       {
         if (!MP2) 
	 {
	     $conn->remote_host ($conn->remote_host . ' ');
	     $self = {connectionid => $$conn, remote_host => $conn -> remote_host} ;
         } 
	 elsif (MP2) 
	 {
	     $table->add('status','AUTHSTARTED');
	     $conn->notes($table);
	     $self = {connectionid => $$conn } ;
        }
         bless $self, $class ;
	 $cache = $self ;
	 print STDERR "[$$] AuthenNTLM: Setup new object\n" if ($debug) ;
      }
    else
        {
        $self = $cache ;
	print STDERR "[$$] AuthenNTLM: Object exists user = $self->{userdomain}\\$self->{username}\n" if ($debug) ;
	
	if ($self -> {ok})
            {
            $r -> user($self->{mappedusername}) ;

            # we accept the user because we are on the same connection
            $type = $self -> get_msg ($r);
            my $content_len = MP2 ? $r->headers_in->{'content-length'} : $r -> header_in('content-length') ;
            my $method      = $r -> method ;
            print STDERR "[$$] AuthenNTLM: Same connection pid = $$, connection = $$conn cuser = " .
                                $r -> user . ' ip = ' . $conn -> remote_ip . ' method = ' . 
				   $method . ' Content-Length = ' .
                                      $content_len . ' type = ' . $type . "\n" if ($debug) ;


            # IE (5.5, 6.0, probably others) can send a type 1 message 
            # after authenticating on the same connection.  This is a
            # problem for POST messages, because IE also sends a
            # "Content-length: 0" with no POST data.
            if ($method eq 'GET' || $method eq 'HEAD' || $method eq 'OPTION' || $method eq 'DELETE' ||
                            $content_len > 0 || $type == 3)
                {
                print STDERR "[$$] AuthenNTLM: OK because same connection\n" if ($debug) ;
                return MP2 ? Apache::OK : Apache::Constants::OK ;
                }
            }
        }
    # end of if statement

    $self -> get_config ($r) ;