File Coverage

blib/lib/LWP/Authen/Negotiate.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package LWP::Authen::Negotiate;

use strict;
use warnings;

use LWP::Debug;

require Exporter;
use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use LWP::Authen::Negotiate ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.08';


use MIME::Base64 "2.12";
use GSSAPI 0.18;


sub authenticate
  {
    LWP::Debug::debug("authenticate() version $VERSION called");
    my ($class,$ua,$proxy,$auth_param,$response,$request,$arg,$size) = @_;

    my $uri = URI->new($request->uri);
    my $targethost = $request->uri()->host();

    my $otoken;
    my $status;
    TRY: {
        my ($target, $tname);

	# import the servername from LWP request
	# to a GSSAPI tokenname. Import can fail
	# in case of broken DNS or /etc/hosts
	# or missing Kerberosprincipal for target system
	#
        LWP::Debug::debug("target hostname $targethost");
        $status  = GSSAPI::Name->import(
                      $target,
                      join( '@', 'HTTP', $targethost ),
		      GSSAPI::OID::gss_nt_hostbased_service
		 );
	last TRY if  ( $status->major != GSS_S_COMPLETE );
        $status  = $target->display( $tname );
	last TRY if  ( $status->major != GSS_S_COMPLETE );

        LWP::Debug::debug("GSSAPI servicename $tname");
        my $auth_header = $proxy ? 'Proxy-Authorization'
	                :          'Authorization';

        my $itoken = q{};
        foreach ($response->header('WWW-Authenticate')) {
          last if /^Negotiate (.+)/ && ($itoken=decode_base64($1));
        }

	# Preload gss_init_security_context parameters
	# see RFC 2744 5.19. gss_init_sec_context
	#
        my $ctx = GSSAPI::Context->new();
        my $imech = GSSAPI::OID::gss_mech_krb5;

        my $iflags = GSS_C_REPLAY_FLAG;
	if ( $ENV{LWP_AUTHEN_NEGOTIATE_DELEGATE} ) {
	   $iflags =    $iflags
	              | GSS_C_MUTUAL_FLAG
		      | GSS_C_DELEG_FLAG;
	}
        my $bindings = GSS_C_NO_CHANNEL_BINDINGS;
        my $creds    = GSS_C_NO_CREDENTIAL;
        my $itime    = 0;
	#
	# let's go with init_security_context!
	#
	$status = $ctx->init( $creds, $target,
	                      $imech, $iflags, $itime , $bindings,$itoken,
	                      undef, $otoken, undef, undef);
        if  (    $status->major == GSS_S_COMPLETE
	      or $status->major == GSS_S_CONTINUE_NEEDED   ) {
            LWP::Debug::debug( 'successfull $ctx->init()');
	    my $referral = $request->clone;
	    $referral->header( $auth_header => "Negotiate ".encode_base64($otoken,""));
	    return $ua->request( $referral, $arg, $size, $response );
	}
    }
    #
    # this is the errorhandler,
    # the try block is normally leaved via return
    #
    LWP::Debug::debug( $status->generic_message());
    LWP::Debug::debug( $status->specific_message() );
    return $response;

}

1;
__END__