Merge pull request #27 from xenu/xenu/win32-symlink

implement a function checking whether symlink creation is permitted

Author: jandubois

Makefile.PL

@@ -11,6 +11,13 @@ my %param = (
     NAME          => 'Win32',
     VERSION_FROM  => 'Win32.pm',
     INSTALLDIRS   => ($] >= 5.008004 && $] < 5.012 ? 'perl' : 'site'),
+    PREREQ_PM     => {
+        strict => 0,
+        warnings => 0,
+        vars => 0,
+        Exporter => 0,
+        DynaLoader => 0
+    }
 );
 $param{NO_META} = 1 if eval "$ExtUtils::MakeMaker::VERSION" >= 6.10_03;
 
@@ -21,4 +28,11 @@ else {
     $param{LIBS} = ['-luserenv']
 }
 
+my $test_requires = $ExtUtils::MakeMaker::VERSION >= 6.64
+    ? 'TEST_REQUIRES'
+    : 'PREREQ_PM';
+
+$param{$test_requires}{'Test'} = 0;
+$param{$test_requires}{'File::Temp'} = 0;
+
 WriteMakefile(%param);

Win32.pm

@@ -713,6 +713,27 @@ sub _GetOSName {
     return ("Win$os", $desc);
 }
 
+sub IsSymlinkCreationAllowed {
+    my(undef, $major, $minor, $build) = GetOSVersion();
+
+    # Vista was the first Windows version with symlink support
+    return !!0 if $major < 6;
+
+    # Since Windows 10 1703, enabling the developer mode allows to create
+    # symlinks regardless of process privileges
+    if ($major > 10 || ($major == 10 && ($minor > 0 || $build > 15063))) {
+        return !!1 if IsDeveloperModeEnabled();
+    }
+
+    my $privs = GetProcessPrivileges();
+
+    return !!0 unless $privs;
+
+    # It doesn't matter if the permission is enabled or not, it just has to
+    # exist. CreateSymbolicLink() will automatically enable it when needed.
+    return exists $privs->{SeCreateSymbolicLinkPrivilege};
+}
+
 # "no warnings 'redefine';" doesn't work for 5.8.7 and earlier
 local $^W = 0;
 bootstrap Win32;
@@ -1233,6 +1254,25 @@ information about what you can do with this address has been lost in
 the mist of time.  Use the Win32::API module instead of this deprecated
 function.
 
+=item Win32::GetProcessPrivileges([PID])
+
+Returns a reference to a hash holding the information about the privileges
+held by the specified process. The keys are privilege names, and the values
+are booleans indicating whether a given privilege is currently enabled or not.
+
+If the optional PID parameter is omitted, the function queries the current
+process.
+
+Example return value:
+
+    {
+        SeTimeZonePrivilege => 0,
+        SeShutdownPrivilege => 0,
+        SeUndockPrivilege => 0,
+        SeIncreaseWorkingSetPrivilege => 0,
+        SeChangeNotifyPrivilege => 1
+    }
+
 =item Win32::GetProductInfo(OSMAJOR, OSMINOR, SPMAJOR, SPMINOR)
 
 Retrieves the product type for the operating system on the local
@@ -1285,6 +1325,17 @@ actually running with elevated privileges.  Returns C<undef>
 and prints a warning if an error occurred.  This function always
 returns 1 on Win9X.
 
+=item Win32::IsDeveloperModeEnabled()
+
+Returns true if the developer mode is currently enabled. It always returns
+false on Windows versions older than Windows 10.
+
+=item Win32::IsSymlinkCreationAllowed()
+
+Returns true if the current process is allowed to create symbolic links. This
+function is a convenience wrapper around Win32::GetProcessPrivileges() and
+Win32::IsDeveloperModeEnabled().
+
 =item Win32::IsWinNT()
 
 [CORE] Returns non zero if the Win32 subsystem is Windows NT.

Win32.xs

@@ -30,6 +30,7 @@ typedef int (__stdcall *PFNDllUnregisterServer)(void);
 typedef BOOL (__stdcall *PFNIsUserAnAdmin)(void);
 typedef BOOL (WINAPI *PFNGetProductInfo)(DWORD, DWORD, DWORD, DWORD, DWORD*);
 typedef void (WINAPI *PFNGetNativeSystemInfo)(LPSYSTEM_INFO lpSystemInfo);
+typedef LONG (*PFNRegGetValueA)(HKEY, LPCSTR, LPCSTR, DWORD, LPDWORD, PVOID, LPDWORD);
 
 #ifndef CSIDL_MYMUSIC
 #   define CSIDL_MYMUSIC              0x000D
@@ -1557,6 +1558,130 @@ XS(w32_SetConsoleOutputCP)
     XSRETURN_IV(SetConsoleOutputCP((int)SvIV(ST(0))));
 }
 
+XS(w32_GetProcessPrivileges)
+{
+    dXSARGS;
+    BOOL ret;
+    HV *priv_hv;
+    HANDLE proc_handle, token;
+    char *priv_name = NULL;
+    TOKEN_PRIVILEGES *privs = NULL;
+    DWORD i, pid, priv_name_len = 100, privs_len = 300;
+
+    if (items > 1)
+        Perl_croak(aTHX_ "usage: Win32::GetProcessPrivileges([$pid])");
+
+    if (items == 0) {
+        EXTEND(SP, 1);
+        pid = GetCurrentProcessId();
+    }
+    else {
+        pid = (DWORD)SvUV(ST(0));
+    }
+
+    proc_handle = OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, pid);
+
+    if (!proc_handle)
+        XSRETURN_NO;
+
+    ret = OpenProcessToken(proc_handle, TOKEN_QUERY, &token);
+    CloseHandle(proc_handle);
+
+    if (!ret)
+        XSRETURN_NO;
+
+    do {
+        Renewc(privs, privs_len, char, TOKEN_PRIVILEGES);
+        ret = GetTokenInformation(
+            token, TokenPrivileges, privs, privs_len, &privs_len
+        );
+    } while (!ret && GetLastError() == ERROR_INSUFFICIENT_BUFFER);
+
+    CloseHandle(token);
+
+    if (!ret) {
+        Safefree(privs);
+        XSRETURN_NO;
+    }
+
+    priv_hv = newHV();
+    New(0, priv_name, priv_name_len, char);
+
+    for (i = 0; i < privs->PrivilegeCount; ++i) {
+        DWORD ret_len = 0;
+        LUID_AND_ATTRIBUTES *priv = &privs->Privileges[i];
+        BOOL is_enabled = !!(priv->Attributes & SE_PRIVILEGE_ENABLED);
+
+        if (priv->Attributes & SE_PRIVILEGE_REMOVED)
+            continue;
+
+        do {
+            ret_len = priv_name_len;
+            ret = LookupPrivilegeNameA(
+                NULL, &priv->Luid, priv_name, &ret_len
+            );
+
+            if (ret_len > priv_name_len) {
+                priv_name_len = ret_len + 1;
+                Renew(priv_name, priv_name_len, char);
+            }
+        } while (!ret && GetLastError() == ERROR_INSUFFICIENT_BUFFER);
+
+        if (!ret) {
+            SvREFCNT_dec((SV*)priv_hv);
+            Safefree(privs);
+            Safefree(priv_name);
+            XSRETURN_NO;
+        }
+
+        hv_store(priv_hv, priv_name, ret_len, newSViv(is_enabled), 0);
+    }
+
+    Safefree(privs);
+    Safefree(priv_name);
+
+    ST(0) = sv_2mortal(newRV_noinc((SV*)priv_hv));
+    XSRETURN(1);
+}
+
+XS(w32_IsDeveloperModeEnabled)
+{
+    dXSARGS;
+    LONG status;
+    DWORD val, val_size = sizeof(val);
+    PFNRegGetValueA pfnRegGetValueA;
+    HMODULE module;
+
+    if (items)
+        Perl_croak(aTHX_ "usage: Win32::IsDeveloperModeEnabled()");
+
+    EXTEND(SP, 1);
+
+    /* developer mode was introduced in Windows 10 */
+    if (g_osver.dwMajorVersion < 10)
+        XSRETURN_NO;
+
+    module = GetModuleHandleA("advapi32.dll");
+    GETPROC(RegGetValueA);
+    if (!pfnRegGetValueA)
+        XSRETURN_NO;
+
+    status = pfnRegGetValueA(
+        HKEY_LOCAL_MACHINE,
+        "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\AppModelUnlock",
+        "AllowDevelopmentWithoutDevLicense",
+        RRF_RT_REG_DWORD | KEY_WOW64_64KEY,
+        NULL,
+        &val,
+        &val_size
+    );
+
+    if (status == ERROR_SUCCESS && val == 1)
+        XSRETURN_YES;
+
+    XSRETURN_NO;
+}
+
 MODULE = Win32            PACKAGE = Win32
 
 PROTOTYPES: DISABLE
@@ -1626,6 +1751,8 @@ BOOT:
     newXS("Win32::GetOEMCP", w32_GetOEMCP, file);
     newXS("Win32::SetConsoleCP", w32_SetConsoleCP, file);
     newXS("Win32::SetConsoleOutputCP", w32_SetConsoleOutputCP, file);
+    newXS("Win32::GetProcessPrivileges", w32_GetProcessPrivileges, file);
+    newXS("Win32::IsDeveloperModeEnabled", w32_IsDeveloperModeEnabled, file);
 #ifdef __CYGWIN__
     newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
 #endif

t/Privileges.t

@@ -0,0 +1,55 @@
+use strict;
+use warnings;
+
+use Test;
+use Win32;
+use Config;
+use File::Temp;
+
+plan tests => 7;
+
+ok(ref(Win32::GetProcessPrivileges()) eq 'HASH');
+ok(ref(Win32::GetProcessPrivileges(Win32::GetCurrentProcessId())) eq 'HASH');
+
+# All Windows PIDs are divisible by 4. It's an undocumented implementation
+# detail, but it means it's extremely unlikely that the PID below is valid.
+ok(!Win32::GetProcessPrivileges(3423237));
+
+my $whoami = `whoami /priv 2>&1`;
+my $skip = ($? == -1 || $? >> 8) ? '"whoami" command is missing' : 0;
+
+skip($skip, sub{
+    my $privs = Win32::GetProcessPrivileges();
+
+    while ($whoami =~ /^(Se\w+)/mg) {
+        return 0 unless exists $privs->{$1};
+    }
+
+    return 1;
+});
+
+# there isn't really anything to test, we just want to make sure that the
+# function doesn't segfault
+Win32::IsDeveloperModeEnabled();
+ok(1);
+
+Win32::IsSymlinkCreationAllowed();
+ok(1);
+
+$skip = $^O ne 'MSWin32' ? 'MSWin32-only test' : 0;
+$skip ||= !$Config{d_symlink} ? 'this perl doesn\'t have symlink()' : 0;
+
+skip($skip, sub {
+    my $tmpdir = File::Temp->newdir;
+    my $dirname = $tmpdir->dirname;
+
+    if (Win32::IsSymlinkCreationAllowed()) {
+        # we expect success
+        return symlink("foo", $tmpdir->dirname . "/new_symlink") == 1;
+    }
+    else {
+        # we expect failure
+        return symlink("foo", $tmpdir->dirname . "/new_symlink") == 0;
+    }
+});
+