Add list context return to Win32::HttpGetFile

craigberry · craigberry · commit 88807a7e228f · 2021-12-29T18:06:21.000-06:00
Don't croak or warn, but make the status message available along with
the return status when called in list context.  In scalar context, we'll
still just get thumbs up or thumbs down, but can get some idea of what
went wrong on failure from Win32::GetLastError(), although we won't know
whether that's a system error or WinHttp error.

Win32::HttpGetFile optionally ignores certificate errors

Make Win32::HttpGetFile fail on HTTP failure

There's not much point in successfully downloading an error page from
the server and saving it to a file, and in fact it's a bit unfriendly
because the user would be unlikely to know there is a problem until
inspecting file contents some time later.
diff --git a/Win32.pm b/Win32.pm
@@ -1305,19 +1305,47 @@ of hex digits with surrounding braces.  For example:
 
     {09531CF1-D0C7-4860-840C-1C8C8735E2AD}
 
-=item Win32::HttpGetFile(URL, FILENAME)
+=item Win32::HttpGetFile(URL, FILENAME [, IGNORE_CERT_ERRORS])
 
 Uses the WinHttp library to download the file specified by the URL
-parameter to the local file specified by FILENAME. Only http and https
-protocols are supported.  Authentication is not supported.  The function
-is not available when building with gcc prior to 4.8.0 because the
-winhttp library is not available.
+parameter to the local file specified by FILENAME. The optional third
+parameter, if true, indicates that certficate errors are to be ignored
+for https connections; please use with caution in a safe environment,
+such as when testing locally using a self-signed certificate.
+
+Only http and https protocols are supported.  Authentication is not
+supported.  The function is not available when building with gcc prior to
+4.8.0 because the WinHttp library is not available.
+
+In scalar context returns a boolean success or failure, and in list
+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.
+
+Scalar context example:
+
+    print Win32::GetLastError()
+        unless Win32::HttpGetFile('http://example.com/somefile.tar.gz',
+                                  '.\file.tgz');
+
+List context example:
+
+    my ($ok, $msg) = Win32::HttpGetFile('http://example.com/somefile.tar.gz',
+                                        '.\file.tgz');
+    if ($ok) {
+        print "Success!: $msg\n";
+    }
+    else {
+        print "Failure!: $msg\n";
+    }
 
 =item Win32::InitiateSystemShutdown
 
 (MACHINE, MESSAGE, TIMEOUT, FORCECLOSE, REBOOT)
 
-Shutsdown the specified MACHINE, notifying users with the
+Shuts down the specified MACHINE, notifying users with the
 supplied MESSAGE, within the specified TIMEOUT interval.  Forces
 closing of all documents without prompting the user if FORCECLOSE is
 true, and reboots the machine if REBOOT is true.  This function works
diff --git a/Win32.xs b/Win32.xs
@@ -1691,24 +1691,31 @@ XS(w32_HttpGetFile)
 {
     dXSARGS;
     WCHAR *url = NULL, *file = NULL, *hostName = NULL, *urlPath = NULL;
+    bool bIgnoreCertErrors = FALSE;
+    WCHAR msgbuf[ONE_K_BUFSIZE];
     BOOL  bResults = FALSE;
     HINTERNET  hSession = NULL,
                hConnect = NULL,
                hRequest = NULL;
     HANDLE hOut = NULL;
     BOOL   bParsed = FALSE,
            bAborted = FALSE,
-           bFileError = FALSE;
+           bFileError = FALSE,
+           bHttpError = FALSE;
     DWORD error = 0;
     URL_COMPONENTS urlComp;
     LPCWSTR acceptTypes[] = { L"*/*", NULL };
+    DWORD dwHttpStatusCode = 0, dwQuerySize = 0;
 
-    if (items != 2)
-        croak("usage: Win32::HttpGetFile($url, $file)");
+    if (items < 2 || items > 3)
+        croak("usage: Win32::HttpGetFile($url, $file[, $ignore_cert_errors])");
 
     url = sv_to_wstr(aTHX_ ST(0));
     file = sv_to_wstr(aTHX_ ST(1));
 
+    if (items == 3)
+        bIgnoreCertErrors = (BOOL)SvIV(ST(2));
+
     /* Initialize the URL_COMPONENTS structure, setting the required
      * component lengths to non-zero so that they get populated.
      */
@@ -1766,13 +1773,29 @@ XS(w32_HttpGetFile)
                                                       ? WINHTTP_FLAG_SECURE
                                                       : 0);
 
+    /* If specified, disable certificate-related errors for https connections. */
+    if (hRequest
+        && bIgnoreCertErrors
+        && urlComp.nScheme == INTERNET_SCHEME_HTTPS) {
+        DWORD secFlags = SECURITY_FLAG_IGNORE_CERT_CN_INVALID
+                         | SECURITY_FLAG_IGNORE_CERT_DATE_INVALID
+                         | SECURITY_FLAG_IGNORE_UNKNOWN_CA
+                         | SECURITY_FLAG_IGNORE_CERT_WRONG_USAGE;
+        if(!WinHttpSetOption(hRequest,
+                             WINHTTP_OPTION_SECURITY_FLAGS,
+                             &secFlags,
+                             sizeof(secFlags))) {
+            bAborted = TRUE;
+        }
+    }
+
     /* Call WinHttpGetProxyForUrl with our target URL. If auto-proxy succeeds,
      * then set the proxy info on the request handle. If auto-proxy fails,
      * ignore the error and attempt to send the HTTP request directly to the
      * target server (using the default WINHTTP_ACCESS_TYPE_NO_PROXY
      * configuration, which the request handle will inherit from the session).
      */
-    if (hRequest) {
+    if (hRequest && !bAborted) {
         WINHTTP_AUTOPROXY_OPTIONS  AutoProxyOptions;
         WINHTTP_PROXY_INFO         ProxyInfo;
         DWORD                      cbProxyInfoSize = sizeof(ProxyInfo);
@@ -1815,6 +1838,39 @@ XS(w32_HttpGetFile)
     if (bResults)
         bResults = WinHttpReceiveResponse(hRequest, NULL);
 
+    /* Retrieve HTTP status code. */
+    if (bResults) {
+        dwQuerySize = sizeof(dwHttpStatusCode);
+        bResults = WinHttpQueryHeaders(hRequest,
+                                       WINHTTP_QUERY_STATUS_CODE | WINHTTP_QUERY_FLAG_NUMBER,
+                                       WINHTTP_HEADER_NAME_BY_INDEX,
+                                       &dwHttpStatusCode,
+                                       &dwQuerySize,
+                                       WINHTTP_NO_HEADER_INDEX);
+    }
+
+    /* Retrieve HTTP status text. Note this may be a success message. */
+    if (bResults) {
+        dwQuerySize = ONE_K_BUFSIZE * 2 - 2;
+        ZeroMemory(&msgbuf, ONE_K_BUFSIZE * 2);
+        bResults = WinHttpQueryHeaders(hRequest,
+                                       WINHTTP_QUERY_STATUS_TEXT,
+                                       WINHTTP_HEADER_NAME_BY_INDEX,
+                                       msgbuf,
+                                       &dwQuerySize,
+                                       WINHTTP_NO_HEADER_INDEX);
+    }
+
+    /* There is no point in successfully downloading an error page from
+     * the server, so consider HTTP errors to be failures.
+     */
+    if (bResults) {
+        if (dwHttpStatusCode < 200 || dwHttpStatusCode > 299) {
+            bResults = FALSE;
+            bHttpError = TRUE;
+        }
+    }
+
     /* Create output file for download. */
     if (bResults) {
         hOut = CreateFileW(file,
@@ -1883,26 +1939,42 @@ XS(w32_HttpGetFile)
     Safefree(hostName);
     Safefree(urlPath);
 
-    if (bAborted) {
-        char msgbuf[ONE_K_BUFSIZE];
+    /* Retrieve system and WinHttp error messages, but not if we already
+     * got a failed HTTP status text above.
+     */
+    if (bAborted && !bHttpError) {
         DWORD msgFlags = bFileError
                          ? FORMAT_MESSAGE_FROM_SYSTEM
                          : FORMAT_MESSAGE_FROM_HMODULE;
-
-        if (FormatMessageA(msgFlags,
-                           GetModuleHandleA("winhttp.dll"),
-                           error,
-                           0,
-                           msgbuf,
-                           sizeof(msgbuf) - 1,
-                           NULL)) {
-            Perl_warn(aTHX_ "Error %lu in Win32::HttpGetFile: %s", error, msgbuf);
+        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);
-        XSRETURN_NO;
     }
 
-    XSRETURN_YES;
+    if (GIMME_V == G_SCALAR) {
+        EXTEND(SP, 1);
+        ST(0) = !bAborted ? &PL_sv_yes : &PL_sv_no;
+        XSRETURN(1);
+    }
+    else if (GIMME_V == G_ARRAY) {
+        EXTEND(SP, 2);
+        ST(0) = !bAborted ? &PL_sv_yes : &PL_sv_no;
+        ST(1) = wstr_to_sv(aTHX_ msgbuf);
+        XSRETURN(2);
+    }
+    else {
+        XSRETURN_EMPTY;
+    }
 }
 
 #endif
diff --git a/t/HttpGetFile.t b/t/HttpGetFile.t
@@ -3,6 +3,8 @@ use warnings;
 use Test;
 use Win32;
 use Digest::SHA;
+use POSIX qw(locale_h);
+setlocale(LC_ALL, "C"); # to make error messages predictable
 
 my $tmpfile = "http-download-test-$$.tgz";
 END { 1 while unlink $tmpfile; }
@@ -15,7 +17,7 @@ unless (defined &Win32::HttpGetFile) {
 # 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} ? 6 : 4;
+plan tests => $ENV{PERL_WIN32_INTERNET_OK} ? 12 : 7;
 
 # On Cygwin the test_harness will invoke additional Win32 APIs that
 # will reset the Win32::GetLastError() value, so capture it immediately.
@@ -26,11 +28,22 @@ sub HttpGetFile {
     return $ok;
 }
 
+sub HttpGetFileList {
+    my ($ok, $message) = Win32::HttpGetFile(@_);
+    $LastError = Win32::GetLastError();
+    return ($ok, $message);
+}
+
 ok(HttpGetFile('nonesuch://example.com', 'NUL:'), "", "'nonesuch://' is not a real protocol");
 ok($LastError, '12006', "correct error code for unrecognized protocol");
 ok(HttpGetFile('http://!#@!&@$', 'NUL:'), "", "invalid URL");
 ok($LastError, '12005', "correct error code for invalid URL");
 
+my ($ok, $message) = HttpGetFileList('nonesuch://example.com', 'NUL:');
+ok($ok, "", "'nonesuch://' is not a real protocol");
+ok($message, "The URL does not use a recognized protocol\r\n", "correct bad protocol message");
+ok($LastError, '12006', "correct error code for unrecognized protocol with list context return");
+
 if ($ENV{PERL_WIN32_INTERNET_OK}) {
     # The digest for version 0.57 should obviously stay the same even after new versions are released
     ok(Win32::HttpGetFile('https://cpan.metacpan.org/authors/id/J/JD/JDB/Win32-0.57.tar.gz', $tmpfile),
@@ -42,4 +55,13 @@ if ($ENV{PERL_WIN32_INTERNET_OK}) {
     ok($sha->hexdigest,
        '44a6d7d1607d7267b0dbcacbb745cec204f1c1a4',
        "downloaded tarball has correct digest");
-}
+
+    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($message, 'Not Found', 'Should get text of 404 message');
+
+    # Since all GitHub downloads use redirects, we can test that they work.
+    ok(Win32::HttpGetFile('https://github.com/perl-libwin32/win32/archive/refs/tags/v0.57.zip', $tmpfile),
+       '1',
+       "successfully downloaded a zipball via redirect");
+}
