我试图运行这个perl5程序：
工作… @H_403_4@如果我使用HTTP :: Request,它的工作原理：
#!/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;
@H_403_4@另一方面我有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);
}
@H_403_4@它只是打印：
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@H_403_4@所以我看到LWP :: UserAgent不发送HTTP Basic auth,但是我不知道为什么. @H_403_4@我在这个网站上看到一些帖子,但是他们有这个相同的基本代码,它没有
工作… @H_403_4@如果我使用HTTP :: Request,它的工作原理：
my $req = GET 'http://test.server.com:39272/';
$req->authorization_basic('my_id','my_pass');
my $res = $ua->request($req);
@H_403_4@输出：
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@H_403_4@之前我做过错了吗？
解决方法
如果服务器告诉它试图访问该领域,LWP将只发送一个领域的凭据.特定用户可能只能访问特定领域或为不同的领域使用不同的密码. LWP不知道哪一个在没有领域的情况下选择其凭据.此外,LWP不会使用您存储在凭据中的数据,除非受到挑战.你没有这样做
@H_403_4@如果通过指定授权标题直接提供凭据,则不进行任何领域检查.如果您自己设置它,您可以随时发送任何标题,所以看到它并不奇怪.
@H_403_4@你只需要一个更好的测试服务器：
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!' );
}
@H_403_4@当您运行客户端一次,应该有两个请求：
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