Понимание того, что не так с моим заголовком авторизации с использованием Perl, HTTP, LWP

У меня есть фрагмент кода PHP, который создает запрос PUT хранилища BLOB-объектов к контейнеру в моей учетной записи хранения Azure. После значительных возни я, наконец, получил правильный заголовок, и все хорошо. К сожалению, приложение, в котором я хочу это использовать, написано на Perl. Поэтому я подумал, что будет относительно легко портировать его. Это оказывается сложнее, чем я ожидал.

Я сравнил все (ну, очевидно, не все, иначе это бы чертовски сработало) между кодом PHP и кодом Perl, но продолжаю получать ошибку аутентификации, связанную с заголовком.

Сценарий PHP использует Curl для выполнения запроса пользовательского агента. У меня нет такой возможности в качестве прямой замены в моей установке Perl. Не уверен, что я могу многое сделать без локальной установки и C-компилятора для Net::Curl. (Может быть, я что-то там упускаю?) Поскольку все между двумя версиями (PHP и Perl), похоже, совпадает, т.е. сообщение, ключ, закодированные/декодированные версии строк, хешированные подписи (я жестко запрограммировал дату проверки между двумя реализациями) , я в недоумении, что еще попробовать. Сегодня третий день, и я чувствую, что, вероятно, запутался в проблеме, которую эта группа уже решила.

PHP-код, который отлично работает:

<?php

date_default_timezone_set ( 'GMT' );
$date = date ( "D, d M Y H:i:s T" );

$version = "2009-09-19";

$account_name = 'emiliolizardo';
$account_key = "uXwt+WJ14kkV6zDALOuiDCsJtqrGDMK7W5xtNhuXXUcsfP1HIC1s7IJ+PZS7dgyXPBufad46ncBSQQK5rNs6Qw==";
$container_name = 'containertest';

$blobname = "foobar.txt";
$fdata    = file_get_contents('testfile.txt');

$utfStr = "PUT"
        . "\n\n\n"
        . strlen($fdata)
        . "\n\n"
        . "text/plain; charset=UTF-8"
        . "\n\n\n\n\n\n\n"
        . "x-ms-blob-type:BlockBlob"
        . "\n"
        . "x-ms-date:$date"
        . "\n"
        . "x-ms-version:$version"
        . "\n"
        . "/$account_name/$container_name/$blobname";

$utf8_encode_str = utf8_encode ( $utfStr );

echo "utfStr : " . $utfStr . "\n";
echo "utf8_encode_str:" . $utf8_encode_str . "\n";

$signature_str = base64_encode(hash_hmac('sha256',    $utf8_encode_str, base64_decode($account_key), true));

echo "signature_str:" . $signature_str . "\n";

  $header = array (
   "x-ms-blob-type: BlockBlob",
   "x-ms-date: " . $date,
   "x-ms-version: " . $version,
   "Authorization: SharedKey " . $account_name . ":" . $signature_str,
   "Content-Type: text/plain; charset=UTF-8",
   "Content-Length: " . strlen($fdata),
   );

print_r($header);

$url="https://$account_name.blob.core.windows.net/$container_name/$blobname";
echo "url:" . $url . "\n";

# Check our variables
#echo "account_name: " . $account_name . "\n";
#echo "account_key : " . $account_key . "\n";
#echo "signature   : " . $signature_str . "\n";
#echo "url         : " . $url . "\n";
#var_dump($header);

# Execute curl commands to create container
$ch = curl_init ();

curl_setopt ($ch, CURLOPT_SSL_VERIFYPEER, false);
curl_setopt ($ch, CURLOPT_CUSTOMREQUEST, 'PUT' );
curl_setopt ($ch, CURLOPT_URL, $url );
curl_setopt ($ch, CURLOPT_RETURNTRANSFER, true );
curl_setopt ($ch, CURLOPT_HTTPHEADER, $header);
curl_setopt ($ch, CURLOPT_POSTFIELDS, $fdata);
curl_setopt ($ch, CURLOPT_HEADER, True );

$result = curl_exec ( $ch );

И код Perl, который близок, но чего-то не хватает:

#!/usr/bin/perl

use strict;
use DateTime;
use DateTime::TimeZone;
use Data::Dumper;
use Encode qw(decode encode);
use MIME::Base64 qw( encode_base64 decode_base64 );
use Digest::SHA qw(hmac_sha256 hmac_sha256_base64);
use HTTP::Request;
use LWP::UserAgent;

my $account_name = "emiliolizardo";
my $account_key  = "uXwt+WJ14kkV6zDALOuiDCsJtqrGDMK7W5xtNhuXXUcsfP1HIC1s7IJ+PZS7dgyXPBufad46ncBSQQK5rNs6Qw==";
my $container    = 'containertest';

#my $file = 'YhJCUjrcEi0q.mp3';
my $file = 'testfile.txt';

# -----------------------------------------------------------
# --
# -----------------------------------------------------------
sub uploadblob {
        my ($fname, $accname, $acckey, $cont) = @_;

        my $date = `/bin/date -u +"%a, %d %b %Y %T GMT"`; chomp $date;
#       my $date = 'Mon, 01 Jul 2019 13:14:43 GMT';     # -- JUST FOR TESTING

#       my $version = "2018-03-28";
        my $version = "2009-09-19";                     # -- JUST FOR TESTING TO MIMIC PHP CODE

        my ($blobname, $ctype);
        for ($fname) {
                /\.mp3$/i and do { $ctype = 'audio/mpeg'; last; };
                /\.wav$/i and do { $ctype = 'audio/wav'; last; };
                /\.txt$/i and do { $ctype = 'text/plain'; last; };
                die "Failed to match an acceptable extension";
        }
        my $blobname = $fname;

        open FILE, "< $fname" or die "Can't open file $fname for read: $!";
        my $fdata = <FILE>;
        close FILE;

        my $fsize = -s $fname;

        my $str = qq{PUT\n\n\n$fsize\n\n$ctype; charset=UTF-8\n\n\n\n\n\n\nx-ms-blob-type:BlockBlob\nx-ms-date:$date\nx-ms-version:$version\n/$accname/$cont/$blobname};
print "utfStr : $str\n";

        my $message = encode("UTF-8", $str);
print "utf8_encode_str:$message\n";

        my $secret  = decode_base64($acckey);

        my $signature_str = encode_base64( hmac_sha256($message, $secret) );
        chomp $signature_str;
print "signature_str:$signature_str\n";

#       while(length($digest) %4) { $digest .= '='; }   # -- Is this necessary for the hmac_sha256 digest?

        my $header = [
                'x-ms-blob-type' => "BlockBlob",
                'x-ms-date' => $date,
                'x-ms-version' => $version,
                'Authorization' => "SharedKey $accname:$signature_str",
                'Content-Type' => "$ctype; charset=UTF-8",
                'Content-Length' => $fsize
        ];
        my $url = "https://$accname.blob.core.windows.net/$cont/$blobname";
print "url:$url\n";

        sendPut($header,$url,$fdata);
}


# -----------------------------------------------------------
# --
# -----------------------------------------------------------
sub sendPut {
        my ($header,$url,$data) = @_;
print "\n\nIn sendPut()\n\n\n==============================================\n\n\n";

        my $r = HTTP::Request->new('POST', $url, $header, $data);

        my $ua = LWP::UserAgent->new();
        my $res = $ua->request($r);

        print "res: ", Dumper $res, "\n";
}

uploadblob($file, $account_name, $account_key, $container);

Сообщение об ошибке дает мне подсказку о том, что может быть проблемой, но я не знаю, как ее исправить: неправильный заголовок длины содержимого, исправлено. Кажется, это существующая проблема с LWP (или была в 2006 году, что я и нашел).

Используя Data::Dumper для просмотра объекта HTTP::Request перед его отправкой с помощью LWP, мне кажется, что все в порядке. Так же, как объект запроса PHP. В какой-то момент я перепишу код Perl старой школы на PHP, Node.js или что-то более актуальное, но на данный момент мне бы очень хотелось, чтобы это работало на Perl.

Спасибо заранее за любые предложения. Извиняюсь, если я нарушил какой-либо этикет SO - все еще довольно новый здесь.

Спасибо - Энди

Вот полный ответ на запрос UserAgent->:

Content-Length header value was wrong, fixed at /usr/share/perl5/vendor_perl/LWP/Protocol/http.pm line 189.
res: $VAR1 = bless( {
                 '_protocol' => 'HTTP/1.1',
                 '_content' => '<?xml version="1.0" encoding="utf-8"?><Error><Code>AuthenticationFailed</Code><Message>Server failed to authenticate the request. Make sure the value of Authorization header is formed correctly including the signature.
RequestId:62589eac-301e-00bd-3e1e-30c15e000000
Time:2019-07-01T15:04:08.0485043Z</Message><AuthenticationErrorDetail>The MAC signature found in the HTTP request \'PUUgk2meSoiB9o+inlYomIq96Bf13IdAQoIZ4BSu4sE=\' is not the same as any computed signature. Server used following string to sign: \'POST


26

text/plain; charset=UTF-8






x-ms-blob-type:BlockBlob
x-ms-date:Mon, 01 Jul 2019 15:04:07 GMT
x-ms-version:2009-09-19
/emiliolizardo/containertest/testfile.txt\'.</AuthenticationErrorDetail></Error>',
                 '_rc' => '403',
                 '_headers' => bless( {
                                        'client-response-num' => 1,
                                        'date' => 'Mon, 01 Jul 2019 15:04:07 GMT',
                                        'client-ssl-cert-issuer' => '/C=US/ST=Washington/L=Redmond/O=Microsoft Corporation/OU=Microsoft IT/CN=Microsoft IT TLS CA 4',
                                        'client-ssl-cipher' => 'ECDHE-RSA-AES256-GCM-SHA384',
                                        'client-peer' => '52.239.177.68:443',
                                        'content-length' => '723',
                                        'client-date' => 'Mon, 01 Jul 2019 15:04:08 GMT',
                                        'client-ssl-warning' => 'Peer certificate not verified',
                                        'content-type' => 'application/xml',
                                        'x-ms-request-id' => '62589eac-301e-00bd-3e1e-30c15e000000',
                                        'client-ssl-cert-subject' => '/CN=*.blob.core.windows.net',
                                        'server' => 'Microsoft-HTTPAPI/2.0',
                                        'client-ssl-socket-class' => 'IO::Socket::SSL'
                                      }, 'HTTP::Headers' ),
                 '_msg' => 'Server failed to authenticate the request. Make sure the value of Authorization header is formed correctly including the signature.',
                 '_request' => bless( {
                                        '_content' => 'Test file for blob upload
',
                                        '_uri' => bless( do{\(my $o = 'https://emiliolizardo.blob.core.windows.net/containertest/testfile.txt')}, 'URI::https' ),
                                        '_headers' => bless( {
                                                               'user-agent' => 'libwww-perl/5.833',
                                                               'x-ms-date' => 'Mon, 01 Jul 2019 15:04:07 GMT',
                                                               'content-type' => 'text/plain; charset=UTF-8',
                                                               'x-ms-version' => '2009-09-19',
                                                               'x-ms-blob-type' => 'BlockBlob',
                                                               'content-length' => 28,
                                                               'authorization' => 'SharedKey emiliolizardo:PUUgk2meSoiB9o+inlYomIq96Bf13IdAQoIZ4BSu4sE='
                                                             }, 'HTTP::Headers' ),
                                        '_method' => 'POST',
                                        '_uri_canonical' => $VAR1->{'_request'}{'_uri'}
                                      }, 'HTTP::Request' )
               }, 'HTTP::Response' );
$VAR2 = '
';

person mifydnu    schedule 01.07.2019    source источник
comment
my $fdata = <FILE>; будет читать только первую строку файла. my $fdata = do { local $/; <FILE> }; будет читать все это. Вы, вероятно, также захотите binmode дескриптора, чтобы не было преобразований слоев возможных двоичных данных (например, строки окончания в Windows).   -  person Grinnz    schedule 01.07.2019
comment
Вам не нужно указывать Content-Length вручную, так как LWP должен установить его на основе предоставленного вами контента.   -  person Grinnz    schedule 01.07.2019
comment
Небольшие проблемы со стилем кода: вы должны использовать use warnings;, вы должны использовать open с тремя аргументами, и вы должны использовать лексические дескрипторы файлов, а не глобальные голые слова: open my $fh, '<:raw', $fname or die ...; my $fdata = do { local $/; <$fh> }; (слой :raw эквивалентен вызову binmode позже без слоев)   -  person Grinnz    schedule 01.07.2019
comment
Или используйте read_binary() из File::Slurper.   -  person Shawn    schedule 01.07.2019
comment
@Гриннз - спасибо. Это быстрый взлом, чтобы увидеть, могу ли я заставить его работать. Я использовал «строгий», чтобы предотвратить самые вопиющие ошибки. Это явно не самый чистый код. :-) Спасибо за комментарии: ‹ФАЙЛ› — это всего лишь одна строка текста, насколько мне известно. CONtent-length является частью подписанного хэша, поэтому он должен совпадать с вычислениями LWP из заголовка (строка 47 кода Perl). Однако... это привело меня к тому, что не так...   -  person mifydnu    schedule 01.07.2019
comment
Одна проблема, которую я вижу, заключается в том, что в вашем методе sendPut() вы отправляете POST как метод HTTP вместо PUT. Это определенно приведет к сбою запроса. Пожалуйста, измените это на PUT и посмотрите, успешно ли выполнен запрос.   -  person Gaurav Mantri    schedule 01.07.2019
comment
@Gaurav Mantri - да, это была одна проблема. Просто увидел и исправил. Проблема с длиной контента. Для этого файла LWP говорит 26, и я вычисляю 28. Если я жестко запрограммирую 26 в подписи (и использую PUT в HTTP::Request), код работает. Не знаю, как исправить это программно.   -  person mifydnu    schedule 01.07.2019


Ответы (1)


Решено в комментариях. @Grinnz и @Guarav Mantri - вы, ребята, были правы.

  1. У меня была вторая строка (точка, которую я не видел) в моем тестовом файле. Таким образом, чтение одной строки из файла, но вычисление всего размера файла с -s приведет к несоответствию. Теперь длина содержимого вычисляется правильно.

  2. Я вслепую набираю «POST» в вызове HTTP::Request-new(), когда PUT использовался в хэше подписи. Упс.

Спасибо, парни. Не уверен, как проголосовать за два ответа, поскольку у обоих были части ответа.

person mifydnu    schedule 01.07.2019
comment
Это нормально, поскольку здесь нет четкого вопроса-ответа, просто процесс отладки. Вот почему я не отправил ответ. - person Grinnz; 01.07.2019