summaryrefslogtreecommitdiff
path: root/cpan
diff options
context:
space:
mode:
authorTomasz Konojacki <me@xenu.pl>2021-03-08 11:56:35 +0100
committerTomasz Konojacki <me@xenu.pl>2021-03-08 11:56:35 +0100
commitedfcb93db2c5e42e47f867b5f2b73a3320a6487e (patch)
tree3c0018fc8817cb22848dda72c4007e1dd429cc55 /cpan
parent8af7382772b33d14f520a86cb29b421f124bfadb (diff)
downloadperl-edfcb93db2c5e42e47f867b5f2b73a3320a6487e.tar.gz
Update Win32 from version 0.54 to 0.56
Diffstat (limited to 'cpan')
-rw-r--r--cpan/Win32/Makefile.PL22
-rw-r--r--cpan/Win32/Win32.pm53
-rw-r--r--cpan/Win32/Win32.xs606
-rw-r--r--cpan/Win32/t/Privileges.t55
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;
+ }
+});
+