NTLM Permission in Perl

Question

I am trying to implement NTLM authorization for a web server written in Perl (or possibly in an XS module). I understand that it should work as follows:

c -> s: GET s -> c: 401, WWW-Authenticate: NTLM c -> s: GET, Authorization: NTLM [Type1 Message] s -> c: 401, WWW-Authenticate: NTLM [Type2 Message] c -> s: GET, Authorization: NTLM [Type3 Message] IF s.Check([Type3 Message]): s -> c: 200 ELSE: s -> c: 401 

To generate a Type3 message, I used Authen :: Perl :: NTLM and Authen :: NTLM :: HTTP , both of them seem to generate messages fine, however they do not offer any functions for checking Type3 messages.

The next step, I tried to use Win32 :: IntAuth to authenticate the NTLM token. This is where I ran into the problem, the developer and other pieces of the information search found say that this module should be able to authenticate the NTLM binary token.

The module wraps some Win32 API calls, namely AcquireCredntialsHandle, AcceptSecurityContext, CompleteAuthToken and ImpersonateSecurityContext.

Unfortunately, all my NTLM token authentication attempts failed in AcceptSecurityContext with SEC_E_INVALID_TOKEN or SEC_E_INSUFFICIENT_MEMORY , which led me to conclude that the NTLM token is incorrect. Below are some code snippets that will help show my methods.

 # other code ... if (not defined $headers->header('Authorization')) { initHandshake($response); } else { my $authHeader = $headers->header('Authorization'); if ($authHeader =~ m/^NTLM\s(.+)$/i) { my $message = $1; if (length($message) == 56) { handleType1($response, $message); } else { handleType3($response, $message); } } else { printf "ERROR - Unable to pull out an NTLM message.\n"; print $authHeader . "\n"; } } ... sub handleType3 { my $response = shift(); my $message = shift(); print "handleType3 - ", $message, "\n"; my $auth = Win32::IntAuth->new(debug => 1); my $token = $auth->get_token_upn(decode_base64($message)) or die "Couldn'timpersonate user, ", $auth->last_err_txt(); print "Hurrargh. User ", $auth->get_username(), " authed!\n"; $response->status(200); } .. 

The full code can be found here: http://codepad.org/cpMWnFru

Answer 1

I managed to get this working by inheriting Win32 :: IntAuth (in which I believe there is an error). In fact, I did not execute the partial context created during the creation of the Type 2 token, this and the fact that an error occurred in Win32 :: IntAuth:

 my $buf_size = 4096; my $sec_inbuf = pack("LLP$buf_size", $buf_size, SECBUFFER_TOKEN, $token); 

This caused a token error, because it was not the correct token length, therefore:

 my $sec_inbuf = pack("LLP" . length($token), length($token), SECBUFFER_TOKEN, $token); 

The correct results are produced.

The previous code has been changed to:

 ... sub handleType1 { my $response = shift(); my $message = shift(); print "handleType1 - |", ${$message}, "|\n"; my $challenge = acceptSecurityContext(${$message}); ${$response}->status(401); ${$response}->header("WWW-Authenticate" => "NTLM " . $challenge); } ... sub handleType3 { my $response = shift(); my $message = shift(); print "handleType3 - ", ${$message}, "\n"; if (acceptSecurityContext(${$message})) { ${$response}->status(200); } else { ${$response}->status(401); } } ... 

acceptSecurityContext is the function that follows this pseudo-language code:

 credentials = Win32->AcquireCredentialsHandle(...) challenge = Win32->AcceptSecurityContext(credentials, token, globalCtx ? globalCtx : 0, ...) 

Hope this helps people who might be in a similar boat. Feel free to contact me for a full demonstration.