perl – LWP :: UserAgent HTTP基本身份验证

我试图运行这个perl5程序：

#!/usr/bin/env perl                                                             
 
use strict;                                                                     
use warnings;                                                                   
use LWP;                                                                        
 
my $ua = LWP::UserAgent->new('Mozilla');                                        
$ua->credentials("test.server.com:39272","realm-name",'user_name','some_pass');                       
my $res = $ua->get('http://test.server.com:39272/');                  
 
print $res->content;

另一方面我有HTTP ::守护进程：

#!/usr/bin/env perl                                                                                       
 
use strict;                                                                     
use warnings;                                                                   
 
use HTTP::Daemon;                                                               
 
my $hd = HTTP::Daemon->new or die;                                              
 
print "Contact URL: ",$hd->url,"\n";                                          
while (my $hc = $hd->accept) {                                                  
  while (my $hr = $hc->get_request) {                                           
    if ($hr->method eq 'GET') {                                                 
      print $hr->as_string,"\n";                                               
    }                                                                           
  }                                                                             
  $hc->close;                                                                   
  undef($hc);                                                                   
}

它只是打印：

Contact URL: http://test.server.com:39272/
GET / HTTP/1.1
Connection: TE,close
Host: test.server.com:39272
TE: deflate,gzip;q=0.3
User-Agent: libwww-perl/6.03

所以我看到LWP :: UserAgent不发送HTTP Basic auth,但是我不知道为什么.

我在这个网站上看到一些帖子,但是他们有这个相同的基本代码,它没有
工作…

如果我使用HTTP :: Request,它的工作原理：

my $req = GET 'http://test.server.com:39272/';                        
$req->authorization_basic('my_id','my_pass');                                  
my $res = $ua->request($req);

输出：

GET / HTTP/1.1
Connection: TE,close
Authorization: Basic bXlfaWQ6bXlfcGFzcw==
Host: test.server.com:39272
TE: deflate,gzip;q=0.3
User-Agent: libwww-perl/6.03

之前我做过错了吗？

解决方法

如果服务器告诉它试图访问该领域,LWP将只发送一个领域的凭据.特定用户可能只能访问特定领域或为不同的领域使用不同的密码. LWP不知道哪一个在没有领域的情况下选择其凭据.此外,LWP不会使用您存储在凭据中的数据,除非受到挑战.你没有这样做

如果通过指定授权标题直接提供凭据,则不进行任何领域检查.如果您自己设置它,您可以随时发送任何标题,所以看到它并不奇怪.

你只需要一个更好的测试服务器：

use strict;                                                                     
use warnings;                                                                   
 
use HTTP::Daemon;                                                               
use HTTP::Status;
 
my $server = HTTP::Daemon->new or die;                                              
 
print "Contact URL: ",$server->url,"\n";                                          
while (my $connection = $server->accept) {                                                  
    while (my $request = $connection->get_request) {                                           
        print $request->as_string;
        unless( $request->header( 'Authorization' ) ) {                                                 
            $connection->send_response( make_challenge() )                                               
            }
        else {
            $connection->send_response( make_response() )                                               
            }   
        }                                                                             
    $connection->close;                                                                   
    }  
 
sub make_challenge {
    my $response = HTTP::Response->new( 
        401 => 'Authorization required',[ 'WWW-Authenticate' => 'Basic realm="Buster"' ],);
    }
 
sub make_response {
    my $response = HTTP::Response->new( 
        200 => 'Huzzah!',[ 'Content-type' => 'text/plain' ],);
 
    $response->message( 'Huzzah!' );
    }

当您运行客户端一次,应该有两个请求：

GET / HTTP/1.1
Connection: TE,close
Host: macpro.local:52902
TE: deflate,gzip;q=0.3
User-Agent: libwww-perl/6.02
 
GET / HTTP/1.1
Connection: TE,close
Authorization: Basic dXNlcl9uYW1lOnNvbWVfcGFzcw==
Host: macpro.local:52902
TE: deflate,gzip;q=0.3
User-Agent: libwww-perl/6.02

perl – LWP :: UserAgent HTTP基本身份验证

解决方法

猜你在找的Perl相关文章