This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Win32 from version 0.53 to 0.54
authorSteve Hay <steve.m.hay@googlemail.com>
Mon, 12 Oct 2020 16:36:24 +0000 (17:36 +0100)
committerSteve Hay <steve.m.hay@googlemail.com>
Mon, 12 Oct 2020 16:36:24 +0000 (17:36 +0100)
Porting/Maintainers.pl
cpan/Win32/Win32.pm
cpan/Win32/t/GetOSName.t
cpan/Win32/t/GetShortPathName.t
cpan/Win32/t/Unicode.t

index 5b01855..72336b6 100755 (executable)
@@ -1273,7 +1273,7 @@ use File::Glob qw(:case);
     },
 
     'Win32' => {
-        'DISTRIBUTION' => "JDB/Win32-0.53.tar.gz",
+        'DISTRIBUTION' => "JDB/Win32-0.54.tar.gz",
         'FILES'        => q[cpan/Win32],
     },
 
index 5a197e9..bb091f5 100644 (file)
@@ -8,7 +8,7 @@ package Win32;
     require DynaLoader;
 
     @ISA = qw|Exporter DynaLoader|;
-    $VERSION = '0.53';
+    $VERSION = '0.54';
     $XS_VERSION = $VERSION;
     $VERSION = eval $VERSION;
 
@@ -174,6 +174,7 @@ sub VER_SUITE_STORAGE_SERVER           () { 0x00002000 } # Windows Storage Serve
 sub VER_SUITE_TERMINAL                 () { 0x00000010 } # Terminal Services is installed. This value is always set.
 # If VER_SUITE_TERMINAL is set but VER_SUITE_SINGLEUSERTS is not set, the system is running in application server mode.
 sub VER_SUITE_WH_SERVER                () { 0x00008000 } # Windows Home Server is installed.
+sub VER_SUITE_MULTIUSERTS              () { 0x00020000 } # AppServer mode is enabled.
 
 
 sub SM_TABLETPC                ()       { 86 }
@@ -359,7 +360,8 @@ sub GetOSDisplayName {
                $desc =~ s/^\s*//;
                s/(200.)/$name Server $1/;
            }
-           s/^Windows (20(03|08|12))/Windows Server $1/;
+           s/^Windows (20(03|08|12|16|19))/Windows Server $1/;
+            s/^Windows SAC/Windows Server/;
        }
     }
     $name .= " $desc" if length $desc;
@@ -528,12 +530,12 @@ sub _GetOSName {
                }
            }
            elsif ($minor == 2) {
-           if ($producttype == VER_NT_WORKSTATION) {
-               $os = "8";
-           }
-           else {
-               $os = "2012";
-           }
+                if ($producttype == VER_NT_WORKSTATION) {
+                    $os = "8";
+                }
+                else {
+                    $os = "2012";
+                }
            }
            elsif ($minor == 3) {
                if ($producttype == VER_NT_WORKSTATION) {
@@ -546,64 +548,130 @@ sub _GetOSName {
            }
         }
        elsif ($major == 10) {
-            $os = '10';
+            if ($producttype == VER_NT_WORKSTATION) {
+                # Build numbers from https://en.wikipedia.org/wiki/Windows_10_version_history
+                $os = '10';
+                if (9841 <= $build && $build <= 10240) {
+                    $desc = " Version 1507";
+                    $desc .= " (Preview Build $build)" if $build < 10240;
+                    $desc .= " (RTM)" if $build == 10240;
+                }
+                elsif (10525 <= $build && $build <= 10586) {
+                    $desc = " Version 1511 (November Update)";
+                    $desc .= " (Preview Build $build)" if $build < 10586;
+                }
+                elsif (11082 <= $build && $build <= 14393) {
+                    $desc = " Version 1607 (Anniversary Update)";
+                    $desc .= " (Preview Build $build)" if $build < 14393;
+                }
+                elsif (14901 <= $build && $build <= 15063) {
+                    $desc = " Version 1703 (Creators Update)";
+                    $desc .= " (Preview Build $build)" if $build < 15063;
+                }
+                elsif (16170 <= $build && $build <= 16299) {
+                    $desc = " Version 1709 (Fall Creators Update)";
+                    $desc .= " (Preview Build $build)" if $build < 16299;
+                }
+                elsif (16353 <= $build && $build <= 17134) {
+                    $desc = " Version 1803 (April 2018 Update)";
+                    $desc .= " (Preview Build $build)" if $build < 17134;
+                }
+                elsif (17604 <= $build && $build <= 17763) {
+                    $desc = " Version 1809 (October 2018 Update)";
+                    $desc .= " (Preview Build $build)" if $build < 17763;
+                }
+                elsif (18204 <= $build && $build <= 18362) {
+                    $desc = " Version 1903 (May 2019 Update)";
+                    $desc .= " (Preview Build $build)" if $build < 18362;
+                }
+                else {
+                    $desc = " Build $build";
+                }
+            }
+            else {
+                if ($build == 14393) {
+                    $os = "2016";
+                    $desc = "Version 1607";
+                }
+                elsif ($build == 17763) {
+                    $os = "2019";
+                    $desc = "Version 1809";
+                }
+                else {
+                    $os = "Server";
+                    if ($build == 16299) {
+                        $desc = "Version 1709";
+                    }
+                    elsif ($build == 17134) {
+                        $desc = "Version 1803";
+                    }
+                    elsif ($build == 18362) {
+                        $desc = "Version 1903";
+                    }
+                    else {
+                        $desc = "Build $build";
+                    }
+                }
+            }
         }
 
         if ($major >= 6) {
-            if ($productinfo == PRODUCT_ULTIMATE) {
-               $desc .= " Ultimate";
-           }
-            elsif ($productinfo == PRODUCT_HOME_PREMIUM) {
-               $desc .= " Home Premium";
-            }
-            elsif ($productinfo == PRODUCT_HOME_BASIC) {
-               $desc .= " Home Basic";
-            }
-            elsif ($productinfo == PRODUCT_ENTERPRISE) {
-               $desc .= " Enterprise";
-            }
-            elsif ($productinfo == PRODUCT_BUSINESS) {
-              # "Windows 7 Business" had a name change to "Windows 7 Professional"
-               $desc .= $minor == 0 ? " Business" : " Professional";
-            }
-            elsif ($productinfo == PRODUCT_STARTER) {
-               $desc .= " Starter";
-            }
-            elsif ($productinfo == PRODUCT_CLUSTER_SERVER) {
-               $desc .= " HPC Server";
-            }
-            elsif ($productinfo == PRODUCT_DATACENTER_SERVER) {
-               $desc .= " Datacenter";
-            }
-            elsif ($productinfo == PRODUCT_DATACENTER_SERVER_CORE) {
-               $desc .= " Datacenter Edition (core installation)";
-            }
-            elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER) {
-               $desc .= " Enterprise";
-            }
-            elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER_CORE) {
-               $desc .= " Enterprise Edition (core installation)";
-            }
-            elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER_IA64) {
-               $desc .= " Enterprise Edition for Itanium-based Systems";
-            }
-            elsif ($productinfo == PRODUCT_SMALLBUSINESS_SERVER) {
-               $desc .= " Small Business Server";
-            }
-            elsif ($productinfo == PRODUCT_SMALLBUSINESS_SERVER_PREMIUM) {
-               $desc .= " Small Business Server Premium Edition";
-            }
-            elsif ($productinfo == PRODUCT_STANDARD_SERVER) {
-               $desc .= " Standard";
-            }
-            elsif ($productinfo == PRODUCT_STANDARD_SERVER_CORE) {
-               $desc .= " Standard Edition (core installation)";
-            }
-            elsif ($productinfo == PRODUCT_WEB_SERVER) {
-               $desc .= " Web Server";
-            }
-            elsif ($productinfo == PRODUCT_PROFESSIONAL) {
-               $desc .= " Professional";
+            if ($major == 6) {
+                if ($productinfo == PRODUCT_ULTIMATE) {
+                    $desc .= " Ultimate";
+                }
+                elsif ($productinfo == PRODUCT_HOME_PREMIUM) {
+                    $desc .= " Home Premium";
+                }
+                elsif ($productinfo == PRODUCT_HOME_BASIC) {
+                    $desc .= " Home Basic";
+                }
+                elsif ($productinfo == PRODUCT_ENTERPRISE) {
+                    $desc .= " Enterprise";
+                }
+                elsif ($productinfo == PRODUCT_BUSINESS) {
+                    # "Windows 7 Business" had a name change to "Windows 7 Professional"
+                    $desc .= $minor == 0 ? " Business" : " Professional";
+                }
+                elsif ($productinfo == PRODUCT_STARTER) {
+                    $desc .= " Starter";
+                }
+                elsif ($productinfo == PRODUCT_CLUSTER_SERVER) {
+                    $desc .= " HPC Server";
+                }
+                elsif ($productinfo == PRODUCT_DATACENTER_SERVER) {
+                    $desc .= " Datacenter";
+                }
+                elsif ($productinfo == PRODUCT_DATACENTER_SERVER_CORE) {
+                    $desc .= " Datacenter Edition (core installation)";
+                }
+                elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER) {
+                    $desc .= " Enterprise";
+                }
+                elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER_CORE) {
+                    $desc .= " Enterprise Edition (core installation)";
+                }
+                elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER_IA64) {
+                    $desc .= " Enterprise Edition for Itanium-based Systems";
+                }
+                elsif ($productinfo == PRODUCT_SMALLBUSINESS_SERVER) {
+                    $desc .= " Small Business Server";
+                }
+                elsif ($productinfo == PRODUCT_SMALLBUSINESS_SERVER_PREMIUM) {
+                    $desc .= " Small Business Server Premium Edition";
+                }
+                elsif ($productinfo == PRODUCT_STANDARD_SERVER) {
+                    $desc .= " Standard";
+                }
+                elsif ($productinfo == PRODUCT_STANDARD_SERVER_CORE) {
+                    $desc .= " Standard Edition (core installation)";
+                }
+                elsif ($productinfo == PRODUCT_WEB_SERVER) {
+                    $desc .= " Web Server";
+                }
+                elsif ($productinfo == PRODUCT_PROFESSIONAL) {
+                    $desc .= " Professional";
+                }
             }
 
            if ($arch == PROCESSOR_ARCHITECTURE_INTEL) {
@@ -612,7 +680,7 @@ sub _GetOSName {
            elsif ($arch == PROCESSOR_ARCHITECTURE_AMD64) {
                $desc .= " (64-bit)";
            }
-       } 
+       }
     }
 
     unless (defined $os) {
@@ -998,6 +1066,10 @@ GetOSVersion() in list context.
 The description will also include tags for other special editions,
 like "R2", "Media Center", "Tablet PC", or "Starter Edition".
 
+In the Windows 10 / Server Semi-Annual Channel era, the description may
+contain the relevant ReleaseId value, but this is only inferred from
+the build number, not determined absolutely.
+
 Currently the possible values for the OS name are
 
     WinWin32s
@@ -1013,6 +1085,12 @@ Currently the possible values for the OS name are
     WinVista
     Win2008
     Win7
+    Win8
+    Win8.1
+    Win10
+    Win2016
+    Win2019
+    WinSAC
 
 This routine is just a simple interface into GetOSVersion().  More
 specific or demanding situations should use that instead.  Another
@@ -1038,30 +1116,36 @@ For the ID, the values are 0 for Win32s, 1 for Windows 9X/Me and 2 for
 Windows NT/2000/XP/2003/Vista/2008/7.  In scalar context it returns just
 the ID.
 
-Currently known values for ID MAJOR and MINOR are as follows:
-
-    OS                      ID    MAJOR   MINOR
-    Win32s                   0      -       -
-    Windows 95               1      4       0
-    Windows 98               1      4      10
-    Windows Me               1      4      90
-
-    Windows NT 3.51          2      3      51
-    Windows NT 4             2      4       0
-
-    Windows 2000             2      5       0
-    Windows XP               2      5       1
-    Windows Server 2003      2      5       2
-    Windows Server 2003 R2   2      5       2
-    Windows Home Server      2      5       2
-
-    Windows Vista            2      6       0
-    Windows Server 2008      2      6       0
-    Windows 7                2      6       1
-    Windows Server 2008 R2   2      6       1
-    Windows 8                2      6       2
-    Windows Server 2012      2      6       2
-
+Currently known values for ID MAJOR MINOR and BUILD are as follows:
+
+    OS                      ID    MAJOR   MINOR   BUILD
+    Win32s                   0      -       -       -
+    Windows 95               1      4       0       -
+    Windows 98               1      4      10       -
+    Windows Me               1      4      90       -
+
+    Windows NT 3.51          2      3      51       -
+    Windows NT 4             2      4       0       -
+
+    Windows 2000             2      5       0       -
+    Windows XP               2      5       1       -
+    Windows Server 2003      2      5       2       -
+    Windows Server 2003 R2   2      5       2       -
+    Windows Home Server      2      5       2       -
+
+    Windows Vista            2      6       0       -
+    Windows Server 2008      2      6       0       -
+    Windows 7                2      6       1       -
+    Windows Server 2008 R2   2      6       1       -
+    Windows 8                2      6       2       -
+    Windows Server 2012      2      6       2       -
+    Windows 8.1              2      6       2       -
+    Windows Server 2012 R2   2      6       2       -
+    
+    Windows 10               2     10       0       -
+    Windows Server 2016      2     10       0   14393
+    Windows Server 2019      2     10       0   17677
+    
 On Windows NT 4 SP6 and later this function returns the following
 additional values: SPMAJOR, SPMINOR, SUITEMASK, PRODUCTTYPE.
 
@@ -1081,8 +1165,14 @@ The version numbers for Windows 8 and Windows Server 2012 are
 identical; the PRODUCTTYPE field must be used to differentiate between
 them.
 
+For modern Windows releases, the major and minor version numbers are
+identical. The PRODUCTTYPE field must be used to differentiate between
+Windows 10 and Server releases. The BUILD field is used to
+differentiate Windows Server versions: currently 2016, 2019, and
+Semi-Annual Channel releases.
+
 SPMAJOR and SPMINOR are the version numbers of the latest
-installed service pack.
+installed service pack. (In the Windows 10 era, these are unused.)
 
 SUITEMASK is a bitfield identifying the product suites available on
 the system.  Known bits are:
@@ -1103,6 +1193,7 @@ the system.  Known bits are:
     VER_SUITE_STORAGE_SERVER            0x00002000
     VER_SUITE_COMPUTE_SERVER            0x00004000
     VER_SUITE_WH_SERVER                 0x00008000
+    VER_SUITE_MULTIUSERTS               0x00020000
 
 The VER_SUITE_xxx names are listed here to cross reference the Microsoft
 documentation.  The Win32 module does not provide symbolic names for these
@@ -1332,4 +1423,37 @@ DllUnregisterServer.
 
 =back
 
+=head1 CAVEATS
+
+=head2 Short Path Names
+
+There are many situations in which modern Windows systems will not have
+the L<short path name|https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file#short-vs-long-names>
+(also called 8.3 or MS-DOS) alias for long file names available.
+
+Short path support can be configured system-wide via the registry,
+but the default on modern systems is to configure short path usage per
+volume. The configuration for a volume can be queried in a number of ways,
+but these may either be unreliable or require elevated (administrator)
+privileges.
+
+Typically, the configuration for a volume can be queried using the C<fsutil>
+utility, e.g. C<fsutil 8dot3name query d:>. On the C level, it can be queried
+with a C<FSCTL_QUERY_PERSISTENT_VOLUME_STATE> request to the
+C<DeviceIOControl> API call, as described in
+L<this article|https://www.codeproject.com/Articles/304374/Query-Volume-Setting-for-State-Windows>.
+However, both of these methods require administrator privileges to work.
+
+The Win32 module does not perform any per-volume check and simply fetches
+short path names in the same manner as the underlying Windows API call it
+uses: If short path names are disabled, the call will still succeed but the
+long name will actually be returned.
+
+Note that on volumes where this happens, C<GetANSIPathName> usually cannot be
+used to return useful filenames for files that contain unicode characters.
+(In code page 65001, this may still work.) Handling unicode filenames in this
+legacy manner relies upon C<GetShortPathName> returning 8.3 filenames, but
+without short name support, it will return the filename with all unicode
+characters replaced by question mark characters.
+
 =cut
index fd9e5ec..219f39a 100644 (file)
@@ -100,14 +100,50 @@ my @dual_tests = (
 ["7 [Ultimate]",                    "7",       2, 6, 1, 0x01         ],
 
 ["8",                               "8",       2, 6, 2               ],
-["2008 [R2]",                       "2008",    2, 6, 1, 0x00, 2, 89  ],
-["2012",                            "2012",    2, 6, 2, 0x00, 2, 89  ],
+["2008 [R2 Standard]",              "2008",    2, 6, 1, 0x07, 2, 89  ],
+["2012 [Standard]",                 "2012",    2, 6, 2, 0x07, 2, 89  ],
 ["[Small Business Server] 2008 R2", "2008",    2, 6, 1, 0x09, 2, 89  ],
 
 ["8.1",                             "8.1",     2, 6, 3               ],
 ["2012 [R2]",                       "2012",    2, 6, 3, 0x00, 2, 89  ],
+);
+
+my @win10_tests = (
+["10 [Build 9840]",                                                "10", 2, 10, 0, 0x00, 0, 0, 9840],
+
+["10 [Version 1507 (Preview Build 9841)]",                         "10", 2, 10, 0, 0x00, 0, 0, 9841],
+["10 [Version 1507 (RTM)]",                                        "10", 2, 10, 0, 0x00, 0, 0, 10240],
+
+["10 [Version 1511 (November Update) (Preview Build 10525)]",      "10", 2, 10, 0, 0x00, 0, 0, 10525],
+["10 [Version 1511 (November Update)]",                            "10", 2, 10, 0, 0x00, 0, 0, 10586],
+
+["10 [Version 1607 (Anniversary Update) (Preview Build 11082)]",   "10", 2, 10, 0, 0x00, 0, 0, 11082],
+["10 [Version 1607 (Anniversary Update)]",                         "10", 2, 10, 0, 0x00, 0, 0, 14393],
+
+["10 [Version 1703 (Creators Update) (Preview Build 14901)]",      "10", 2, 10, 0, 0x00, 0, 0, 14901],
+["10 [Version 1703 (Creators Update)]",                            "10", 2, 10, 0, 0x00, 0, 0, 15063],
 
-["10",                              "10",      2, 10, 0              ],
+["10 [Version 1709 (Fall Creators Update) (Preview Build 16170)]", "10", 2, 10, 0, 0x00, 0, 0, 16170],
+["10 [Version 1709 (Fall Creators Update)]",                       "10", 2, 10, 0, 0x00, 0, 0, 16299],
+
+["10 [Version 1803 (April 2018 Update) (Preview Build 16353)]",    "10", 2, 10, 0, 0x00, 0, 0, 16353],
+["10 [Version 1803 (April 2018 Update)]",                          "10", 2, 10, 0, 0x00, 0, 0, 17134],
+
+["10 [Version 1809 (October 2018 Update) (Preview Build 17604)]",  "10", 2, 10, 0, 0x00, 0, 0, 17604],
+["10 [Version 1809 (October 2018 Update)]",                        "10", 2, 10, 0, 0x00, 0, 0, 17763],
+
+["10 [Version 1903 (May 2019 Update) (Preview Build 18204)]",      "10", 2, 10, 0, 0x00, 0, 0, 18204],
+["10 [Version 1903 (May 2019 Update)]",                            "10", 2, 10, 0, 0x00, 0, 0, 18362],
+
+["2016 [Version 1607]",                                    "2016",    2, 10, 0, 0x07, 2, 0, 14393],
+["2019 [Version 1809]",                                    "2019",    2, 10, 0, 0x07, 2, 0, 17763],
+
+["Server [Version 1709]",                                  "Server",  2, 10, 0, 0x07, 2, 0, 16299],
+["Server [Version 1803]",                                  "Server",  2, 10, 0, 0x07, 2, 0, 17134],
+# The 1809 version from the semi-annual channel will identify as "Windows Server 2019 Version 1809"
+#["Server [Version 1809]",                                 "Server",  2, 10, 0, 0x07, 2, 0, 17763],
+["Server [Version 1903]",                                  "Server",  2, 10, 0, 0x07, 2, 0, 18362],
+["Server [Build 12345]",                                   "Server",  2, 10, 0, 0x07, 2, 0, 12345],
 
 );
 
@@ -116,12 +152,12 @@ my @ia64_tests = (
 ["2003 [Enterprise Edition for Itanium-based Systems]", "2003", 2, 5, 2, 0x0002, 2, 0],
 );
 
-plan tests => 6 * (@intel_tests + @amd64_tests + 2*@dual_tests + @ia64_tests);
+plan tests => 6 * (@intel_tests + @amd64_tests + 2*@dual_tests + @ia64_tests) + 3 * @win10_tests;
 
 # Test internal implementation function
 sub check {
     my($test, $arch) = @_;
-    my($pretty, $expect, $id, $major, $minor, $sm, $pt, $metrics) = @$test;
+    my($pretty, $expect, $id, $major, $minor, $sm, $pt, $metrics, $build) = @$test;
     $metrics = [$metrics] if defined($metrics) && not ref $metrics;
 
     my $tag = "";
@@ -133,7 +169,7 @@ sub check {
     # and 2003/2008 start with "Windows Server"
     unless ($pretty eq "Win32s") {
        my $prefix = "Windows";
-       $prefix .= " Server" if $pretty =~ /^20(03|08|12)/;
+       $prefix .= " Server" if $pretty =~ /^20(03|08|12|16|19)/;
        $pretty = "$prefix $pretty";
     }
 
@@ -148,7 +184,7 @@ sub check {
 
     # We pass the same value for $suitemask and $productinfo.  The former is
     # used for Windows up to 2003, the latter is used for Vista and later.
-    my($os, $desc) = Win32::_GetOSName("", $major||0, $minor||0, 0,
+    my($os, $desc) = Win32::_GetOSName("", $major||0, $minor||0, $build,
                                       $id, $sm||0, $pt||1, $sm||0, $arch, $metrics);
     my $display = Win32::GetOSDisplayName($os, $desc);
 
@@ -157,6 +193,8 @@ sub check {
     is($os, "Win$expect", "os:   $os");
     is($desc, $tag, "desc: $desc");
 
+    next if $major == 10;
+
     my $sp = "Service Pack 42";
     ($os, $desc) = Win32::_GetOSName($sp, $major||0, $minor||0, 0,
                                     $id, $sm||0, $pt||1, $sm||0, $arch, $metrics);
@@ -168,7 +206,7 @@ sub check {
     is($desc,    $expect,       "desc:    $desc");
 }
 
-check($_, Win32::PROCESSOR_ARCHITECTURE_INTEL) for @intel_tests, @dual_tests;
+check($_, Win32::PROCESSOR_ARCHITECTURE_INTEL) for @intel_tests, @dual_tests, @win10_tests;
 check($_, Win32::PROCESSOR_ARCHITECTURE_AMD64) for @amd64_tests, @dual_tests;
 check($_, Win32::PROCESSOR_ARCHITECTURE_IA64)  for @ia64_tests;
 
index 4553854..649420a 100644 (file)
@@ -2,6 +2,16 @@ use strict;
 use Test;
 use Win32;
 
+BEGIN {
+    Win32::CreateFile("8dot3test_canary_GetShortPathName $$");
+    my $canary = Win32::GetShortPathName("8dot3test_canary_GetShortPathName $$");
+    unlink("8dot3test_canary_GetShortPathName $$");
+    if ( length $canary > 12 ) {
+        print "1..0 # Skip: The system and/or current volume is not configured to support short names.\n";
+        exit 0;        
+    }
+}
+
 my $path = "Long Path $$";
 unlink($path);
 END { unlink $path }
index 2d03fd6..8362853 100644 (file)
@@ -18,6 +18,13 @@ BEGIN {
        print "1..0 # Skip: Unicode support requires Windows 2000 or later\n";
        exit 0;
     }
+    Win32::CreateFile("8dot3test_canary_Unicode $$");
+    my $canary = Win32::GetShortPathName("8dot3test_canary_Unicode $$");
+    unlink("8dot3test_canary_Unicode $$");
+    if ( length $canary > 12 ) {
+        print "1..0 # Skip: The system and/or current volume is not configured to support short names.\n";
+        exit 0;        
+    }
 }
 
 my $home = Win32::GetCwd();