Perl中的NTLM授权

我正在尝试为用Perl(或者可能是XS模块)编写的Web服务器实现NTLM授权.我的理解是它应该以下列方式工作:
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

为了生成Type3消息,我使用了Authen::Perl::NTLMAuthen::NTLM::HTTP,这两个似乎都可以完美地生成消息,但是,它们没有提供检查Type3消息的功能.

我的下一步是尝试使用Win32::IntAuth来验证NTLM令牌.这是我遇到麻烦的地方,开发人员和搜索到的其他信息片段说这个模块应该能够验证NTLM二进制令牌.

该模块包含一些Win32 API调用,即AcquireCredntialsHandle,AcceptSecurityContext,CompleteAuthToken和ImpersonateSecurityContext.

不幸的是,我在AcceptSecurityContext上验证NTLM令牌的所有尝试都失败了,SEC_E_INVALID_TOKEN或SEC_E_INSUFFICIENT_MEMORY导致我建议我的NTLM令牌不正确.下面是一些代码片段,以帮助显示我的方法.

# 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);
} 
..

完整的代码可以在这里查看:http://codepad.org/cpMWnFru

解决方法

我设法通过实施Win32 :: IntAuth(我相信它有一个错误)来实现这一点.基本上我没有持有在创建Type 2令牌期间创建的部分上下文,这和Win32 :: IntAuth中存在错误的事实:
my $buf_size     = 4096;
my $sec_inbuf    = pack("L L P$buf_size",$buf_size,SECBUFFER_TOKEN,$token);

这导致令牌错误,因为它不是令牌的正确长度,因此:

my $sec_inbuf    = pack("L L P" . length($token),length($token),$token);

产生了正确的结果.

之前的代码已更改为:

...
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 - ","\n";
    if (acceptSecurityContext(${$message})) {
        ${$response}->status(200);
    } else {
        ${$response}->status(401);
    }
}
...

acceptSecurityContext是一个遵循这个伪代码函数

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

希望这可以帮助那些可能在类似船上的人.请随时与我联系以获取完整演示.

相关文章

忍不住在 PerlChina 邮件列表中盘点了一下 Perl 里的 Web 应用框架(巧的是 PerlBuzz 最近也有一篇相关...
bless有两个参数:对象的引用、类的名称。 类的名称是一个字符串,代表了类的类型信息,这是理解bless的...
gb2312转Utf的方法: use Encode; my $str = "中文"; $str_cnsoftware = encode("utf-8...
  perl 计算硬盘利用率, 以%来查看硬盘资源是否存在IO消耗cpu资源情况; 部份代码参考了iostat源码;...
1 简单变量 Perl 的 Hello World 是怎么写的呢?请看下面的程序: #!/usr/bin/perl print "Hello W...
本文介绍Perl的Perl的简单语法,包括基本输入输出、分支循环控制结构、函数、常用系统调用和文件操作,...