diff options
author | Tomasz Konojacki <me@xenu.pl> | 2021-03-08 11:56:35 +0100 |
---|---|---|
committer | Tomasz Konojacki <me@xenu.pl> | 2021-03-08 11:56:35 +0100 |
commit | edfcb93db2c5e42e47f867b5f2b73a3320a6487e (patch) | |
tree | 3c0018fc8817cb22848dda72c4007e1dd429cc55 /cpan | |
parent | 8af7382772b33d14f520a86cb29b421f124bfadb (diff) | |
download | perl-edfcb93db2c5e42e47f867b5f2b73a3320a6487e.tar.gz |
Update Win32 from version 0.54 to 0.56
Diffstat (limited to 'cpan')
-rw-r--r-- | cpan/Win32/Makefile.PL | 22 | ||||
-rw-r--r-- | cpan/Win32/Win32.pm | 53 | ||||
-rw-r--r-- | cpan/Win32/Win32.xs | 606 | ||||
-rw-r--r-- | cpan/Win32/t/Privileges.t | 55 |
4 files changed, 370 insertions, 366 deletions
diff --git a/cpan/Win32/Makefile.PL b/cpan/Win32/Makefile.PL index 0f16594aad..d6ca5c68ae 100644 --- a/cpan/Win32/Makefile.PL +++ b/cpan/Win32/Makefile.PL @@ -11,8 +11,28 @@ 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; -$param{LIBS} = ['-L/lib/w32api -lole32 -lversion'] if $^O eq "cygwin"; + +if ($^O eq 'cygwin') { + $param{LIBS} = ['-L/lib/w32api -lole32 -lversion -luserenv -lnetapi32'] +} +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); diff --git a/cpan/Win32/Win32.pm b/cpan/Win32/Win32.pm index bb091f5f31..ac4b0bcd60 100644 --- a/cpan/Win32/Win32.pm +++ b/cpan/Win32/Win32.pm @@ -8,7 +8,7 @@ package Win32; require DynaLoader; @ISA = qw|Exporter DynaLoader|; - $VERSION = '0.54'; + $VERSION = '0.56'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -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. diff --git a/cpan/Win32/Win32.xs b/cpan/Win32/Win32.xs index 03519cbc3a..b65c231c88 100644 --- a/cpan/Win32/Win32.xs +++ b/cpan/Win32/Win32.xs @@ -1,9 +1,12 @@ #define WIN32_LEAN_AND_MEAN +#define _WIN32_WINNT 0x0500 #include <wchar.h> #include <wctype.h> #include <windows.h> #include <shlobj.h> #include <wchar.h> +#include <userenv.h> +#include <lm.h> #define PERL_NO_GET_CONTEXT #include "EXTERN.h" @@ -22,27 +25,12 @@ #define GETPROC(fn) pfn##fn = (PFN##fn)GetProcAddress(module, #fn) -typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathA)(HWND, char*, int, BOOL); -typedef BOOL (WINAPI *PFNSHGetSpecialFolderPathW)(HWND, WCHAR*, int, BOOL); -typedef HRESULT (WINAPI *PFNSHGetFolderPathA)(HWND, int, HANDLE, DWORD, LPTSTR); -typedef HRESULT (WINAPI *PFNSHGetFolderPathW)(HWND, int, HANDLE, DWORD, LPWSTR); -typedef BOOL (WINAPI *PFNCreateEnvironmentBlock)(void**, HANDLE, BOOL); -typedef BOOL (WINAPI *PFNDestroyEnvironmentBlock)(void*); typedef int (__stdcall *PFNDllRegisterServer)(void); typedef int (__stdcall *PFNDllUnregisterServer)(void); -typedef DWORD (__stdcall *PFNNetApiBufferFree)(void*); -typedef DWORD (__stdcall *PFNNetWkstaGetInfo)(LPWSTR, DWORD, void*); - -typedef BOOL (__stdcall *PFNOpenProcessToken)(HANDLE, DWORD, HANDLE*); -typedef BOOL (__stdcall *PFNOpenThreadToken)(HANDLE, DWORD, BOOL, HANDLE*); -typedef BOOL (__stdcall *PFNGetTokenInformation)(HANDLE, TOKEN_INFORMATION_CLASS, void*, DWORD, DWORD*); -typedef BOOL (__stdcall *PFNAllocateAndInitializeSid)(PSID_IDENTIFIER_AUTHORITY, BYTE, DWORD, DWORD, - DWORD, DWORD, DWORD, DWORD, DWORD, DWORD, PSID*); -typedef BOOL (__stdcall *PFNEqualSid)(PSID, PSID); -typedef void* (__stdcall *PFNFreeSid)(PSID); 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 @@ -133,24 +121,6 @@ BOOL g_osver_ex = TRUE; #define ONE_K_BUFSIZE 1024 -int -IsWin95(void) -{ - return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS); -} - -int -IsWinNT(void) -{ - return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT); -} - -int -IsWin2000(void) -{ - return (g_osver.dwMajorVersion > 4); -} - /* Convert SV to wide character string. The return value must be * freed using Safefree(). */ @@ -208,70 +178,38 @@ get_unicode_env(pTHX_ const WCHAR *name) SV *sv = NULL; void *env; HANDLE token; - HMODULE module; - PFNOpenProcessToken pfnOpenProcessToken; /* Get security token for the current process owner */ - module = LoadLibrary("advapi32.dll"); - if (!module) - return NULL; - - GETPROC(OpenProcessToken); - - if (pfnOpenProcessToken == NULL || - !pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY | TOKEN_DUPLICATE, &token)) + if (!OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY | TOKEN_DUPLICATE, &token)) { - FreeLibrary(module); return NULL; } - FreeLibrary(module); /* Create a Unicode environment block for this process */ - module = LoadLibrary("userenv.dll"); - if (module) { - PFNCreateEnvironmentBlock pfnCreateEnvironmentBlock; - PFNDestroyEnvironmentBlock pfnDestroyEnvironmentBlock; - - GETPROC(CreateEnvironmentBlock); - GETPROC(DestroyEnvironmentBlock); - - if (pfnCreateEnvironmentBlock && pfnDestroyEnvironmentBlock && - pfnCreateEnvironmentBlock(&env, token, FALSE)) - { - size_t name_len = wcslen(name); - WCHAR *entry = (WCHAR *)env; - while (*entry) { - size_t i; - size_t entry_len = wcslen(entry); - BOOL equal = (entry_len > name_len) && (entry[name_len] == '='); - - for (i=0; equal && i < name_len; ++i) - equal = (towupper(entry[i]) == towupper(name[i])); - - if (equal) { - sv = wstr_to_sv(aTHX_ entry+name_len+1); - break; - } - entry += entry_len+1; + if (CreateEnvironmentBlock(&env, token, FALSE)) + { + size_t name_len = wcslen(name); + WCHAR *entry = (WCHAR *)env; + while (*entry) { + size_t i; + size_t entry_len = wcslen(entry); + BOOL equal = (entry_len > name_len) && (entry[name_len] == '='); + + for (i=0; equal && i < name_len; ++i) + equal = (towupper(entry[i]) == towupper(name[i])); + + if (equal) { + sv = wstr_to_sv(aTHX_ entry+name_len+1); + break; } - pfnDestroyEnvironmentBlock(env); + entry += entry_len+1; } - FreeLibrary(module); + DestroyEnvironmentBlock(env); } CloseHandle(token); return sv; } -/* Define both an ANSI and a Wide version of win32_longpath */ - -#define CHAR_T char -#define WIN32_FIND_DATA_T WIN32_FIND_DATAA -#define FN_FINDFIRSTFILE FindFirstFileA -#define FN_STRLEN strlen -#define FN_STRCPY strcpy -#define LONGPATH my_longpathA -#include "longpath.inc" - #define CHAR_T WCHAR #define WIN32_FIND_DATA_T WIN32_FIND_DATAW #define FN_FINDFIRSTFILE FindFirstFileW @@ -347,20 +285,10 @@ char* get_childdir(void) { dTHX; - char* ptr; + WCHAR filename[MAX_PATH+1]; - if (IsWin2000()) { - WCHAR filename[MAX_PATH+1]; - GetCurrentDirectoryW(MAX_PATH+1, filename); - ptr = my_ansipath(filename); - } - else { - char filename[MAX_PATH+1]; - GetCurrentDirectoryA(MAX_PATH+1, filename); - New(0, ptr, strlen(filename)+1, char); - strcpy(ptr, filename); - } - return ptr; + GetCurrentDirectoryW(MAX_PATH+1, filename); + return my_ansipath(filename); } void @@ -389,23 +317,17 @@ free_childenv(void *d) XS(w32_ExpandEnvironmentStrings) { dXSARGS; + WCHAR value[31*1024]; + WCHAR *source; if (items != 1) croak("usage: Win32::ExpandEnvironmentStrings($String)"); - if (IsWin2000()) { - WCHAR value[31*1024]; - WCHAR *source = sv_to_wstr(aTHX_ ST(0)); - ExpandEnvironmentStringsW(source, value, countof(value)-1); - ST(0) = wstr_to_sv(aTHX_ value); - Safefree(source); - XSRETURN(1); - } - else { - char value[31*1024]; - ExpandEnvironmentStringsA(SvPV_nolen(ST(0)), value, countof(value)-2); - XSRETURN_PV(value); - } + source = sv_to_wstr(aTHX_ ST(0)); + ExpandEnvironmentStringsW(source, value, countof(value)-1); + ST(0) = wstr_to_sv(aTHX_ value); + Safefree(source); + XSRETURN(1); } XS(w32_IsAdminUser) @@ -413,12 +335,6 @@ XS(w32_IsAdminUser) dXSARGS; HMODULE module; PFNIsUserAnAdmin pfnIsUserAnAdmin; - PFNOpenThreadToken pfnOpenThreadToken; - PFNOpenProcessToken pfnOpenProcessToken; - PFNGetTokenInformation pfnGetTokenInformation; - PFNAllocateAndInitializeSid pfnAllocateAndInitializeSid; - PFNEqualSid pfnEqualSid; - PFNFreeSid pfnFreeSid; HANDLE hTok; DWORD dwTokInfoLen; TOKEN_GROUPS *lpTokInfo; @@ -430,97 +346,61 @@ XS(w32_IsAdminUser) if (items) croak("usage: Win32::IsAdminUser()"); - /* There is no concept of "Administrator" user accounts on Win9x systems, - so just return true. */ - if (IsWin95()) - XSRETURN_YES; - /* Use IsUserAnAdmin() when available. On Vista this will only return TRUE * if the process is running with elevated privileges and not just when the * process owner is a member of the "Administrators" group. */ - module = LoadLibrary("shell32.dll"); - if (module) { - GETPROC(IsUserAnAdmin); - if (pfnIsUserAnAdmin) { - EXTEND(SP, 1); - ST(0) = sv_2mortal(newSViv(pfnIsUserAnAdmin() ? 1 : 0)); - FreeLibrary(module); - XSRETURN(1); - } - FreeLibrary(module); - } - - module = LoadLibrary("advapi32.dll"); - if (!module) { - warn("Cannot load advapi32.dll library"); - XSRETURN_UNDEF; - } - - GETPROC(OpenThreadToken); - GETPROC(OpenProcessToken); - GETPROC(GetTokenInformation); - GETPROC(AllocateAndInitializeSid); - GETPROC(EqualSid); - GETPROC(FreeSid); - - if (!(pfnOpenThreadToken && pfnOpenProcessToken && - pfnGetTokenInformation && pfnAllocateAndInitializeSid && - pfnEqualSid && pfnFreeSid)) - { - warn("Cannot load functions from advapi32.dll library"); - FreeLibrary(module); - XSRETURN_UNDEF; + module = GetModuleHandleA("shell32.dll"); + GETPROC(IsUserAnAdmin); + if (pfnIsUserAnAdmin) { + EXTEND(SP, 1); + ST(0) = sv_2mortal(newSViv(pfnIsUserAnAdmin() ? 1 : 0)); + XSRETURN(1); } - if (!pfnOpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) { - if (!pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) { + if (!OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) { + if (!OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) { warn("Cannot open thread token or process token"); - FreeLibrary(module); XSRETURN_UNDEF; } } - pfnGetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen); + GetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen); if (!New(1, lpTokInfo, dwTokInfoLen, TOKEN_GROUPS)) { warn("Cannot allocate token information structure"); CloseHandle(hTok); - FreeLibrary(module); XSRETURN_UNDEF; } - if (!pfnGetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen, + if (!GetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen, &dwTokInfoLen)) { warn("Cannot get token information"); Safefree(lpTokInfo); CloseHandle(hTok); - FreeLibrary(module); XSRETURN_UNDEF; } - if (!pfnAllocateAndInitializeSid(&NtAuth, 2, SECURITY_BUILTIN_DOMAIN_RID, + if (!AllocateAndInitializeSid(&NtAuth, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &pAdminSid)) { warn("Cannot allocate administrators' SID"); Safefree(lpTokInfo); CloseHandle(hTok); - FreeLibrary(module); XSRETURN_UNDEF; } iRetVal = 0; for (i = 0; i < lpTokInfo->GroupCount; ++i) { - if (pfnEqualSid(lpTokInfo->Groups[i].Sid, pAdminSid)) { + if (EqualSid(lpTokInfo->Groups[i].Sid, pAdminSid)) { iRetVal = 1; break; } } - pfnFreeSid(pAdminSid); + FreeSid(pAdminSid); Safefree(lpTokInfo); CloseHandle(hTok); - FreeLibrary(module); EXTEND(SP, 1); ST(0) = sv_2mortal(newSViv(iRetVal)); @@ -681,30 +561,23 @@ XS(w32_MsgBox) dXSARGS; DWORD flags = MB_ICONEXCLAMATION; I32 result; + WCHAR *title = NULL, *msg; if (items < 1 || items > 3) croak("usage: Win32::MsgBox($message [, $flags [, $title]])"); + msg = sv_to_wstr(aTHX_ ST(0)); if (items > 1) flags = (DWORD)SvIV(ST(1)); + if (items > 2) + title = sv_to_wstr(aTHX_ ST(2)); + + result = MessageBoxW(GetActiveWindow(), msg, title ? title : L"Perl", flags); + + Safefree(msg); + if (title) + Safefree(title); - if (IsWin2000()) { - WCHAR *title = NULL; - WCHAR *msg = sv_to_wstr(aTHX_ ST(0)); - if (items > 2) - title = sv_to_wstr(aTHX_ ST(2)); - result = MessageBoxW(GetActiveWindow(), msg, title ? title : L"Perl", flags); - Safefree(msg); - if (title) - Safefree(title); - } - else { - const char *title = "Perl"; - char *msg = SvPV_nolen(ST(0)); - if (items > 2) - title = SvPV_nolen(ST(2)); - result = MessageBoxA(GetActiveWindow(), msg, title, flags); - } XSRETURN_IV(result); } @@ -845,11 +718,9 @@ XS(w32_GuidGen) XS(w32_GetFolderPath) { dXSARGS; - char path[MAX_PATH+1]; WCHAR wpath[MAX_PATH+1]; int folder; int create = 0; - HMODULE module; if (items != 1 && items != 2) croak("usage: Win32::GetFolderPath($csidl [, $create])\n"); @@ -858,51 +729,21 @@ XS(w32_GetFolderPath) if (items == 2) create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0; - module = LoadLibrary("shfolder.dll"); - if (module) { - PFNSHGetFolderPathA pfna; - if (IsWin2000()) { - PFNSHGetFolderPathW pfnw; - pfnw = (PFNSHGetFolderPathW)GetProcAddress(module, "SHGetFolderPathW"); - if (pfnw && SUCCEEDED(pfnw(NULL, folder|create, NULL, 0, wpath))) { - FreeLibrary(module); - ST(0) = wstr_to_ansipath(aTHX_ wpath); - XSRETURN(1); - } - } - pfna = (PFNSHGetFolderPathA)GetProcAddress(module, "SHGetFolderPathA"); - if (pfna && SUCCEEDED(pfna(NULL, folder|create, NULL, 0, path))) { - FreeLibrary(module); - XSRETURN_PV(path); - } - FreeLibrary(module); + if (SUCCEEDED(SHGetFolderPathW(NULL, folder|create, NULL, 0, wpath))) { + ST(0) = wstr_to_ansipath(aTHX_ wpath); + XSRETURN(1); } - module = LoadLibrary("shell32.dll"); - if (module) { - PFNSHGetSpecialFolderPathA pfna; - if (IsWin2000()) { - PFNSHGetSpecialFolderPathW pfnw; - pfnw = (PFNSHGetSpecialFolderPathW)GetProcAddress(module, "SHGetSpecialFolderPathW"); - if (pfnw && pfnw(NULL, wpath, folder, !!create)) { - FreeLibrary(module); - ST(0) = wstr_to_ansipath(aTHX_ wpath); - XSRETURN(1); - } - } - pfna = (PFNSHGetSpecialFolderPathA)GetProcAddress(module, "SHGetSpecialFolderPathA"); - if (pfna && pfna(NULL, path, folder, !!create)) { - FreeLibrary(module); - XSRETURN_PV(path); - } - FreeLibrary(module); + if (SHGetSpecialFolderPathW(NULL, wpath, folder, !!create)) { + ST(0) = wstr_to_ansipath(aTHX_ wpath); + XSRETURN(1); } /* SHGetFolderPathW() and SHGetSpecialFolderPathW() may fail on older * Perl versions that have replaced the Unicode environment with an * ANSI version. Let's go spelunking in the registry now... */ - if (IsWin2000()) { + { SV *sv; HKEY hkey; HKEY root = HKEY_CURRENT_USER; @@ -1101,7 +942,7 @@ XS(w32_SetCwd) if (items != 1) Perl_croak(aTHX_ "usage: Win32::SetCwd($cwd)"); - if (IsWin2000() && SvUTF8(ST(0))) { + if (SvUTF8(ST(0))) { WCHAR *wide = sv_to_wstr(aTHX_ ST(0)); char *ansi = my_ansipath(wide); int rc = PerlDir_chdir(ansi); @@ -1158,26 +999,19 @@ XS(w32_SetLastError) XS(w32_LoginName) { dXSARGS; + WCHAR name[128]; + DWORD size = countof(name); + if (items) Perl_croak(aTHX_ "usage: Win32::LoginName()"); + EXTEND(SP,1); - if (IsWin2000()) { - WCHAR name[128]; - DWORD size = countof(name); - if (GetUserNameW(name, &size)) { - ST(0) = wstr_to_sv(aTHX_ name); - XSRETURN(1); - } - } - else { - char name[128]; - DWORD size = countof(name); - if (GetUserNameA(name, &size)) { - /* size includes NULL */ - ST(0) = sv_2mortal(newSVpvn(name, size-1)); - XSRETURN(1); - } + + if (GetUserNameW(name, &size)) { + ST(0) = wstr_to_sv(aTHX_ name); + XSRETURN(1); } + XSRETURN_UNDEF; } @@ -1201,65 +1035,31 @@ XS(w32_NodeName) XS(w32_DomainName) { dXSARGS; - HMODULE module = LoadLibrary("netapi32.dll"); - PFNNetApiBufferFree pfnNetApiBufferFree = NULL; - PFNNetWkstaGetInfo pfnNetWkstaGetInfo = NULL; + char dname[256]; + DWORD dnamelen = sizeof(dname); + WKSTA_INFO_100 *pwi; + DWORD retval; if (items) Perl_croak(aTHX_ "usage: Win32::DomainName()"); - if (module) { - GETPROC(NetApiBufferFree); - GETPROC(NetWkstaGetInfo); - } + EXTEND(SP,1); - if (module && pfnNetWkstaGetInfo && pfnNetApiBufferFree) { - /* this way is more reliable, in case user has a local account. */ - char dname[256]; - DWORD dnamelen = sizeof(dname); - struct { - DWORD wki100_platform_id; - LPWSTR wki100_computername; - LPWSTR wki100_langroup; - DWORD wki100_ver_major; - DWORD wki100_ver_minor; - } *pwi; - DWORD retval; - retval = pfnNetWkstaGetInfo(NULL, 100, &pwi); - /* NERR_Success *is* 0*/ - if (retval == 0) { - if (pwi->wki100_langroup && *(pwi->wki100_langroup)) { - WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup, - -1, (LPSTR)dname, dnamelen, NULL, NULL); - } - else { - WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername, - -1, (LPSTR)dname, dnamelen, NULL, NULL); - } - pfnNetApiBufferFree(pwi); - FreeLibrary(module); - XSRETURN_PV(dname); - } - FreeLibrary(module); - SetLastError(retval); - } - else { - /* Win95 doesn't have NetWksta*(), so do it the old way */ - char name[256]; - DWORD size = sizeof(name); - if (module) - FreeLibrary(module); - if (GetUserName(name,&size)) { - char sid[ONE_K_BUFSIZE]; - DWORD sidlen = sizeof(sid); - char dname[256]; - DWORD dnamelen = sizeof(dname); - SID_NAME_USE snu; - if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen, - dname, &dnamelen, &snu)) { - XSRETURN_PV(dname); /* all that for this */ - } - } + + retval = NetWkstaGetInfo(NULL, 100, (LPBYTE*)&pwi); + /* NERR_Success *is* 0*/ + if (retval == 0) { + if (pwi->wki100_langroup && *(pwi->wki100_langroup)) { + WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup, + -1, (LPSTR)dname, dnamelen, NULL, NULL); + } + else { + WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername, + -1, (LPSTR)dname, dnamelen, NULL, NULL); + } + NetApiBufferFree(pwi); + XSRETURN_PV(dname); } + SetLastError(retval); XSRETURN_UNDEF; } @@ -1315,7 +1115,7 @@ XS(w32_IsWinNT) if (items) Perl_croak(aTHX_ "usage: Win32::IsWinNT()"); EXTEND(SP,1); - XSRETURN_IV(IsWinNT()); + XSRETURN_IV(g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT); } XS(w32_IsWin95) @@ -1324,7 +1124,7 @@ XS(w32_IsWin95) if (items) Perl_croak(aTHX_ "usage: Win32::IsWin95()"); EXTEND(SP,1); - XSRETURN_IV(IsWin95()); + XSRETURN_IV(g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS); } XS(w32_FormatMessage) @@ -1383,8 +1183,6 @@ XS(w32_Spawn) &stProcInfo)) /* <- Process info (if OK) */ { int pid = (int)stProcInfo.dwProcessId; - if (IsWin95() && pid < 0) - pid = -pid; sv_setiv(ST(2), pid); CloseHandle(stProcInfo.hThread);/* library source code does this. */ bSuccess = TRUE; @@ -1409,41 +1207,21 @@ XS(w32_GetTickCount) XS(w32_GetShortPathName) { dXSARGS; - SV *shortpath; DWORD len; + WCHAR wshort[MAX_PATH+1], *wlong; if (items != 1) Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)"); - if (IsWin2000()) { - WCHAR wshort[MAX_PATH+1]; - WCHAR *wlong = sv_to_wstr(aTHX_ ST(0)); - len = GetShortPathNameW(wlong, wshort, countof(wshort)); - Safefree(wlong); - if (len && len < sizeof(wshort)) { - ST(0) = wstr_to_sv(aTHX_ wshort); - XSRETURN(1); - } - XSRETURN_UNDEF; - } - - shortpath = sv_mortalcopy(ST(0)); - SvUPGRADE(shortpath, SVt_PV); - if (!SvPVX(shortpath) || !SvLEN(shortpath)) - XSRETURN_UNDEF; + wlong = sv_to_wstr(aTHX_ ST(0)); + len = GetShortPathNameW(wlong, wshort, countof(wshort)); + Safefree(wlong); - /* src == target is allowed */ - do { - len = GetShortPathName(SvPVX(shortpath), - SvPVX(shortpath), - (DWORD)SvLEN(shortpath)); - } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1)); - if (len) { - SvCUR_set(shortpath,len); - *SvEND(shortpath) = '\0'; - ST(0) = shortpath; - XSRETURN(1); + if (len && len < sizeof(wshort)) { + ST(0) = wstr_to_sv(aTHX_ wshort); + XSRETURN(1); } + XSRETURN_UNDEF; } @@ -1467,7 +1245,7 @@ XS(w32_GetFullPathName) Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)"); #if __CYGWIN__ || !defined(PERL_IMPLICIT_SYS) - if (IsWin2000()) { + { WCHAR *filename = sv_to_wstr(aTHX_ ST(0)); WCHAR full[2*MAX_PATH]; DWORD len = GetFullPathNameW(filename, countof(full), full, NULL); @@ -1476,12 +1254,6 @@ XS(w32_GetFullPathName) XSRETURN_EMPTY; ansi = fullname = my_ansipath(full); } - else { - DWORD len = GetFullPathNameA(SvPV_nolen(ST(0)), countof(buffer), buffer, NULL); - if (len == 0 || len >= countof(buffer)) - XSRETURN_EMPTY; - fullname = buffer; - } #else /* Don't use my_ansipath() unless the $filename argument is in Unicode. * If the relative path doesn't exist, GetShortPathName() will fail and @@ -1492,7 +1264,7 @@ XS(w32_GetFullPathName) * XXX The one missing case is where we could downgrade $filename * XXX from UTF8 into the current codepage. */ - if (IsWin2000() && SvUTF8(ST(0))) { + if (SvUTF8(ST(0))) { WCHAR *filename = sv_to_wstr(aTHX_ ST(0)); WCHAR *mappedname = PerlDir_mapW(filename); Safefree(filename); @@ -1552,43 +1324,23 @@ XS(w32_GetFullPathName) XS(w32_GetLongPathName) { dXSARGS; + WCHAR *wstr, *long_path, wide_path[MAX_PATH+1]; if (items != 1) Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)"); - if (IsWin2000()) { - WCHAR *wstr = sv_to_wstr(aTHX_ ST(0)); - WCHAR wide_path[MAX_PATH+1]; - WCHAR *long_path; - - if (wcslen(wstr) < (size_t)countof(wide_path)) { - wcscpy(wide_path, wstr); - long_path = my_longpathW(wide_path); - if (long_path) { - Safefree(wstr); - ST(0) = wstr_to_sv(aTHX_ long_path); - XSRETURN(1); - } - } - Safefree(wstr); - } - else { - SV *path; - char tmpbuf[MAX_PATH+1]; - char *pathstr; - STRLEN len; + wstr = sv_to_wstr(aTHX_ ST(0)); - path = ST(0); - pathstr = SvPV(path,len); - if (len < sizeof(tmpbuf)) { - strcpy(tmpbuf, pathstr); - pathstr = my_longpathA(tmpbuf); - if (pathstr) { - ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr))); - XSRETURN(1); - } + if (wcslen(wstr) < (size_t)countof(wide_path)) { + wcscpy(wide_path, wstr); + long_path = my_longpathW(wide_path); + if (long_path) { + Safefree(wstr); + ST(0) = wstr_to_sv(aTHX_ long_path); + XSRETURN(1); } } + Safefree(wstr); XSRETURN_EMPTY; } @@ -1678,7 +1430,7 @@ XS(w32_CreateDirectory) if (items != 1) Perl_croak(aTHX_ "usage: Win32::CreateDirectory($dir)"); - if (IsWin2000() && SvUTF8(ST(0))) { + if (SvUTF8(ST(0))) { WCHAR *dir = sv_to_wstr(aTHX_ ST(0)); result = CreateDirectoryW(dir, NULL); Safefree(dir); @@ -1699,7 +1451,7 @@ XS(w32_CreateFile) if (items != 1) Perl_croak(aTHX_ "usage: Win32::CreateFile($file)"); - if (IsWin2000() && SvUTF8(ST(0))) { + if (SvUTF8(ST(0))) { WCHAR *file = sv_to_wstr(aTHX_ ST(0)); handle = CreateFileW(file, GENERIC_WRITE, FILE_SHARE_WRITE, NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL); @@ -1806,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 @@ -1875,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 diff --git a/cpan/Win32/t/Privileges.t b/cpan/Win32/t/Privileges.t new file mode 100644 index 0000000000..61a349520a --- /dev/null +++ b/cpan/Win32/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; + } +}); + |