Expose HTTP status codes in Win32::HttpGetFile

There are no corresponding system error codes, but setting bit 29 denotes
a user-defined error code.  Conveniently, adding 1e9 to the HTTP status
sets bit 29, and calling SetLastError() with the result gives us a value
that is easy to coerce into the actual HTTP status.

Author: Craig Berry

Win32.pm

@@ -1322,7 +1322,8 @@ context also returns, in addition to the boolean status, a second
 value containing message text related to the status.
 
 If the call fails, C<Win32::GetLastError()> will return a numeric
-error code, which may be either a system error or a WinHttp error.
+error code, which may be a system error, a WinHttp error, or a
+user-defined error composed of 1e9 plus the HTTP status code.
 
 Scalar context example:
 
@@ -1339,6 +1340,10 @@ List context example:
     }
     else {
         print "Failure!: $msg\n";
+        my $err = Win32::GetLastError();
+        if ($err > 1e9) {
+            printf "HTTP status: %d\n", ($err - 1e9);
+        }
     }
 
 =item Win32::InitiateSystemShutdown

Win32.xs

@@ -1939,26 +1939,33 @@ XS(w32_HttpGetFile)
     Safefree(hostName);
     Safefree(urlPath);
 
-    /* Retrieve system and WinHttp error messages, but not if we already
-     * got a failed HTTP status text above.
+    /* Retrieve system and WinHttp error messages, or compose a user-defined
+     * error code if we got a failed HTTP status text above.  Conveniently, adding
+     * 1e9 to the HTTP status sets bit 29, denoting a user-defined error code,
+     * and also makes it easy to lop off the upper part and just get HTTP status.
      */
-    if (bAborted && !bHttpError) {
-        DWORD msgFlags = bFileError
-                         ? FORMAT_MESSAGE_FROM_SYSTEM
-                         : FORMAT_MESSAGE_FROM_HMODULE;
-        msgFlags |= FORMAT_MESSAGE_IGNORE_INSERTS;
-
-        ZeroMemory(&msgbuf, ONE_K_BUFSIZE * 2);
-        if (!FormatMessageW(msgFlags,
-                            GetModuleHandleW(L"winhttp.dll"),
-                            error,
-                            0,
-                            msgbuf,
-                            ONE_K_BUFSIZE - 1, /* TCHARs, not bytes */
-                            NULL)) {
-            wcsncpy(msgbuf, L"unable to format error message", ONE_K_BUFSIZE - 1);
+    if (bAborted) {
+        if (bHttpError) {
+            SetLastError(dwHttpStatusCode + 1000000000);
+        }
+        else {
+            DWORD msgFlags = bFileError
+                            ? FORMAT_MESSAGE_FROM_SYSTEM
+                            : FORMAT_MESSAGE_FROM_HMODULE;
+            msgFlags |= FORMAT_MESSAGE_IGNORE_INSERTS;
+
+            ZeroMemory(&msgbuf, ONE_K_BUFSIZE * 2);
+            if (!FormatMessageW(msgFlags,
+                                GetModuleHandleW(L"winhttp.dll"),
+                                error,
+                                0,
+                                msgbuf,
+                                ONE_K_BUFSIZE - 1, /* TCHARs, not bytes */
+                                NULL)) {
+                wcsncpy(msgbuf, L"unable to format error message", ONE_K_BUFSIZE - 1);
+            }
+            SetLastError(error);
         }
-        SetLastError(error);
     }
 
     if (GIMME_V == G_SCALAR) {

t/HttpGetFile.t

@@ -18,7 +18,7 @@ my $english_locale = (Win32::FormatMessage(1) eq "Incorrect function.\r\n");
 # We may not always have an internet connection, so don't
 # attempt remote connections unless the user has done
 #   set PERL_WIN32_INTERNET_OK=1
-plan tests => $ENV{PERL_WIN32_INTERNET_OK} ? 19 : 7;
+plan tests => $ENV{PERL_WIN32_INTERNET_OK} ? 20 : 7;
 
 # On Cygwin the test_harness will invoke additional Win32 APIs that
 # will reset the Win32::GetLastError() value, so capture it immediately.
@@ -64,6 +64,7 @@ if ($ENV{PERL_WIN32_INTERNET_OK}) {
 
     my ($ok, $message) = HttpGetFileList('https://cpan.metacpan.org/authors/id/Z/ZZ/ZILCH/nonesuch.tar.gz', 'NUL:');
     ok($ok, '', 'Download of nonexistent file from real site should fail with 404');
+    ok($LastError - 1e9, '404', 'Correct 404 HTTP status for not found');
     if ($english_locale) {
         ok($message, 'Not Found', 'Should get text of 404 message');
     }
@@ -76,7 +77,6 @@ if ($ENV{PERL_WIN32_INTERNET_OK}) {
        '1',
        "successfully downloaded a zipball via redirect");
 
-    $sha = undef;
     $sha = Digest::SHA->new('sha1');
     $sha->addfile($tmpfile, 'b');
     ok($sha->hexdigest,