This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: Win32API::File now in core
[perl5.git] / win32 / ext / Win32 / Win32.xs
CommitLineData
b4ad57f4
NC
1#include <windows.h>
2
3#include "EXTERN.h"
4#include "perl.h"
5#include "XSUB.h"
6
7#define SE_SHUTDOWN_NAMEA "SeShutdownPrivilege"
b4ad57f4
NC
8
9typedef BOOL (WINAPI *PFNSHGetSpecialFolderPath)(HWND, char*, int, BOOL);
10typedef HRESULT (WINAPI *PFNSHGetFolderPath)(HWND, int, HANDLE, DWORD, LPTSTR);
11#ifndef CSIDL_FLAG_CREATE
12# define CSIDL_FLAG_CREATE 0x8000
13#endif
14
15XS(w32_ExpandEnvironmentStrings)
16{
17 dXSARGS;
b4ad57f4 18 BYTE buffer[4096];
b4ad57f4
NC
19
20 if (items != 1)
21 croak("usage: Win32::ExpandEnvironmentStrings($String);\n");
22
8c56068e 23 ExpandEnvironmentStringsA(SvPV_nolen(ST(0)), (char*)buffer, sizeof(buffer));
b4ad57f4
NC
24 XSRETURN_PV((char*)buffer);
25}
26
27XS(w32_IsAdminUser)
28{
29 dXSARGS;
30 HINSTANCE hAdvApi32;
31 BOOL (__stdcall *pfnOpenThreadToken)(HANDLE hThr, DWORD dwDesiredAccess,
32 BOOL bOpenAsSelf, PHANDLE phTok);
33 BOOL (__stdcall *pfnOpenProcessToken)(HANDLE hProc, DWORD dwDesiredAccess,
34 PHANDLE phTok);
35 BOOL (__stdcall *pfnGetTokenInformation)(HANDLE hTok,
36 TOKEN_INFORMATION_CLASS TokenInformationClass,
37 LPVOID lpTokInfo, DWORD dwTokInfoLen,
38 PDWORD pdwRetLen);
39 BOOL (__stdcall *pfnAllocateAndInitializeSid)(
40 PSID_IDENTIFIER_AUTHORITY pIdAuth,
41 BYTE nSubAuthCount, DWORD dwSubAuth0,
42 DWORD dwSubAuth1, DWORD dwSubAuth2,
43 DWORD dwSubAuth3, DWORD dwSubAuth4,
44 DWORD dwSubAuth5, DWORD dwSubAuth6,
45 DWORD dwSubAuth7, PSID pSid);
46 BOOL (__stdcall *pfnEqualSid)(PSID pSid1, PSID pSid2);
47 PVOID (__stdcall *pfnFreeSid)(PSID pSid);
48 HANDLE hTok;
49 DWORD dwTokInfoLen;
50 TOKEN_GROUPS *lpTokInfo;
51 SID_IDENTIFIER_AUTHORITY NtAuth = SECURITY_NT_AUTHORITY;
52 PSID pAdminSid;
53 int iRetVal;
54 unsigned int i;
55 OSVERSIONINFO osver;
56
57 if (items)
58 croak("usage: Win32::IsAdminUser()");
59
60 /* There is no concept of "Administrator" user accounts on Win9x systems,
61 so just return true. */
62 memset(&osver, 0, sizeof(OSVERSIONINFO));
63 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
64 GetVersionEx(&osver);
65 if (osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS)
66 XSRETURN_YES;
67
68 hAdvApi32 = LoadLibrary("advapi32.dll");
69 if (!hAdvApi32) {
70 warn("Cannot load advapi32.dll library");
71 XSRETURN_UNDEF;
72 }
73
74 pfnOpenThreadToken = (BOOL (__stdcall *)(HANDLE, DWORD, BOOL, PHANDLE))
75 GetProcAddress(hAdvApi32, "OpenThreadToken");
76 pfnOpenProcessToken = (BOOL (__stdcall *)(HANDLE, DWORD, PHANDLE))
77 GetProcAddress(hAdvApi32, "OpenProcessToken");
78 pfnGetTokenInformation = (BOOL (__stdcall *)(HANDLE,
79 TOKEN_INFORMATION_CLASS, LPVOID, DWORD, PDWORD))
80 GetProcAddress(hAdvApi32, "GetTokenInformation");
81 pfnAllocateAndInitializeSid = (BOOL (__stdcall *)(
82 PSID_IDENTIFIER_AUTHORITY, BYTE, DWORD, DWORD, DWORD, DWORD, DWORD,
83 DWORD, DWORD, DWORD, PSID))
84 GetProcAddress(hAdvApi32, "AllocateAndInitializeSid");
85 pfnEqualSid = (BOOL (__stdcall *)(PSID, PSID))
86 GetProcAddress(hAdvApi32, "EqualSid");
87 pfnFreeSid = (PVOID (__stdcall *)(PSID))
88 GetProcAddress(hAdvApi32, "FreeSid");
89
90 if (!(pfnOpenThreadToken && pfnOpenProcessToken &&
91 pfnGetTokenInformation && pfnAllocateAndInitializeSid &&
92 pfnEqualSid && pfnFreeSid))
93 {
94 warn("Cannot load functions from advapi32.dll library");
95 FreeLibrary(hAdvApi32);
96 XSRETURN_UNDEF;
97 }
98
99 if (!pfnOpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) {
100 if (!pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) {
101 warn("Cannot open thread token or process token");
102 FreeLibrary(hAdvApi32);
103 XSRETURN_UNDEF;
104 }
105 }
106
107 pfnGetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen);
108 if (!New(1, lpTokInfo, dwTokInfoLen, TOKEN_GROUPS)) {
109 warn("Cannot allocate token information structure");
110 CloseHandle(hTok);
111 FreeLibrary(hAdvApi32);
112 XSRETURN_UNDEF;
113 }
114
115 if (!pfnGetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen,
116 &dwTokInfoLen))
117 {
118 warn("Cannot get token information");
119 Safefree(lpTokInfo);
120 CloseHandle(hTok);
121 FreeLibrary(hAdvApi32);
122 XSRETURN_UNDEF;
123 }
124
125 if (!pfnAllocateAndInitializeSid(&NtAuth, 2, SECURITY_BUILTIN_DOMAIN_RID,
126 DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &pAdminSid))
127 {
128 warn("Cannot allocate administrators' SID");
129 Safefree(lpTokInfo);
130 CloseHandle(hTok);
131 FreeLibrary(hAdvApi32);
132 XSRETURN_UNDEF;
133 }
134
135 iRetVal = 0;
136 for (i = 0; i < lpTokInfo->GroupCount; ++i) {
137 if (pfnEqualSid(lpTokInfo->Groups[i].Sid, pAdminSid)) {
138 iRetVal = 1;
139 break;
140 }
141 }
142
143 pfnFreeSid(pAdminSid);
144 Safefree(lpTokInfo);
145 CloseHandle(hTok);
146 FreeLibrary(hAdvApi32);
147
148 EXTEND(SP, 1);
149 ST(0) = sv_2mortal(newSViv(iRetVal));
150 XSRETURN(1);
151}
152
153XS(w32_LookupAccountName)
154{
155 dXSARGS;
156 char SID[400];
157 DWORD SIDLen;
158 SID_NAME_USE snu;
159 char Domain[256];
160 DWORD DomLen;
b4ad57f4 161 BOOL bResult;
8c56068e 162
b4ad57f4
NC
163 if (items != 5)
164 croak("usage: Win32::LookupAccountName($system, $account, $domain, "
165 "$sid, $sidtype);\n");
166
167 SIDLen = sizeof(SID);
168 DomLen = sizeof(Domain);
169
8c56068e
JD
170 bResult = LookupAccountNameA(SvPV_nolen(ST(0)), /* System */
171 SvPV_nolen(ST(1)), /* Account name */
172 &SID, /* SID structure */
173 &SIDLen, /* Size of SID buffer */
174 Domain, /* Domain buffer */
175 &DomLen, /* Domain buffer size */
176 &snu); /* SID name type */
b4ad57f4
NC
177 if (bResult) {
178 sv_setpv(ST(2), Domain);
179 sv_setpvn(ST(3), SID, SIDLen);
180 sv_setiv(ST(4), snu);
181 XSRETURN_YES;
182 }
8c56068e
JD
183 XSRETURN_NO;
184}
b4ad57f4
NC
185
186
187XS(w32_LookupAccountSID)
188{
189 dXSARGS;
190 PSID sid;
191 char Account[256];
192 DWORD AcctLen = sizeof(Account);
193 char Domain[256];
194 DWORD DomLen = sizeof(Domain);
195 SID_NAME_USE snu;
b4ad57f4
NC
196 BOOL bResult;
197
198 if (items != 5)
199 croak("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n");
200
8c56068e 201 sid = SvPV_nolen(ST(1));
b4ad57f4 202 if (IsValidSid(sid)) {
8c56068e
JD
203 bResult = LookupAccountSidA(SvPV_nolen(ST(0)), /* System */
204 sid, /* SID structure */
205 Account, /* Account name buffer */
206 &AcctLen, /* name buffer length */
207 Domain, /* Domain buffer */
208 &DomLen, /* Domain buffer length */
209 &snu); /* SID name type */
b4ad57f4
NC
210 if (bResult) {
211 sv_setpv(ST(2), Account);
212 sv_setpv(ST(3), Domain);
213 sv_setiv(ST(4), (IV)snu);
214 XSRETURN_YES;
215 }
b4ad57f4 216 }
8c56068e
JD
217 XSRETURN_NO;
218}
b4ad57f4
NC
219
220XS(w32_InitiateSystemShutdown)
221{
222 dXSARGS;
223 HANDLE hToken; /* handle to process token */
224 TOKEN_PRIVILEGES tkp; /* pointer to token structure */
225 BOOL bRet;
b4ad57f4 226 char *machineName, *message;
b4ad57f4
NC
227
228 if (items != 5)
229 croak("usage: Win32::InitiateSystemShutdown($machineName, $message, "
230 "$timeOut, $forceClose, $reboot);\n");
231
8c56068e 232 machineName = SvPV_nolen(ST(0));
b4ad57f4
NC
233
234 if (OpenProcessToken(GetCurrentProcess(),
235 TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
236 &hToken))
237 {
8c56068e
JD
238 LookupPrivilegeValueA(machineName,
239 SE_SHUTDOWN_NAMEA,
240 &tkp.Privileges[0].Luid);
b4ad57f4
NC
241
242 tkp.PrivilegeCount = 1; /* only setting one */
243 tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
244
245 /* Get shutdown privilege for this process. */
246 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
247 (PTOKEN_PRIVILEGES)NULL, 0);
248 }
249
8c56068e
JD
250 message = SvPV_nolen(ST(1));
251 bRet = InitiateSystemShutdownA(machineName, message,
252 SvIV(ST(2)), SvIV(ST(3)), SvIV(ST(4)));
b4ad57f4
NC
253
254 /* Disable shutdown privilege. */
255 tkp.Privileges[0].Attributes = 0;
256 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
257 (PTOKEN_PRIVILEGES)NULL, 0);
258 CloseHandle(hToken);
259 XSRETURN_IV(bRet);
260}
261
262XS(w32_AbortSystemShutdown)
263{
264 dXSARGS;
265 HANDLE hToken; /* handle to process token */
266 TOKEN_PRIVILEGES tkp; /* pointer to token structure */
267 BOOL bRet;
268 char *machineName;
b4ad57f4
NC
269
270 if (items != 1)
271 croak("usage: Win32::AbortSystemShutdown($machineName);\n");
272
8c56068e 273 machineName = SvPV_nolen(ST(0));
b4ad57f4
NC
274
275 if (OpenProcessToken(GetCurrentProcess(),
276 TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
277 &hToken))
278 {
8c56068e
JD
279 LookupPrivilegeValueA(machineName,
280 SE_SHUTDOWN_NAMEA,
281 &tkp.Privileges[0].Luid);
b4ad57f4
NC
282
283 tkp.PrivilegeCount = 1; /* only setting one */
284 tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
285
286 /* Get shutdown privilege for this process. */
287 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
288 (PTOKEN_PRIVILEGES)NULL, 0);
289 }
290
8c56068e 291 bRet = AbortSystemShutdownA(machineName);
b4ad57f4
NC
292
293 /* Disable shutdown privilege. */
294 tkp.Privileges[0].Attributes = 0;
295 AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
296 (PTOKEN_PRIVILEGES)NULL, 0);
297 CloseHandle(hToken);
298 XSRETURN_IV(bRet);
299}
300
301
302XS(w32_MsgBox)
303{
304 dXSARGS;
305 char *msg;
306 char *title = "Perl";
307 DWORD flags = MB_ICONEXCLAMATION;
b4ad57f4
NC
308 I32 result;
309
310 if (items < 1 || items > 3)
311 croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n");
312
8c56068e 313 msg = SvPV_nolen(ST(0));
b4ad57f4
NC
314 if (items > 1) {
315 flags = SvIV(ST(1));
316 if (items > 2)
8c56068e 317 title = SvPV_nolen(ST(2));
b4ad57f4 318 }
8c56068e 319 result = MessageBoxA(GetActiveWindow(), msg, title, flags);
b4ad57f4
NC
320 XSRETURN_IV(result);
321}
322
323XS(w32_LoadLibrary)
324{
325 dXSARGS;
b4ad57f4 326 HANDLE hHandle;
b4ad57f4
NC
327
328 if (items != 1)
329 croak("usage: Win32::LoadLibrary($libname)\n");
8c56068e 330 hHandle = LoadLibraryA(SvPV_nolen(ST(0)));
b4ad57f4
NC
331 XSRETURN_IV((long)hHandle);
332}
333
334XS(w32_FreeLibrary)
335{
336 dXSARGS;
8c56068e 337
b4ad57f4
NC
338 if (items != 1)
339 croak("usage: Win32::FreeLibrary($handle)\n");
8c56068e 340 if (FreeLibrary(INT2PTR(HINSTANCE, SvIV(ST(0))))) {
b4ad57f4
NC
341 XSRETURN_YES;
342 }
343 XSRETURN_NO;
344}
345
346XS(w32_GetProcAddress)
347{
348 dXSARGS;
8c56068e 349
b4ad57f4
NC
350 if (items != 2)
351 croak("usage: Win32::GetProcAddress($hinstance, $procname)\n");
8c56068e 352 XSRETURN_IV(PTR2IV(GetProcAddress(INT2PTR(HINSTANCE, SvIV(ST(0))), SvPV_nolen(ST(1)))));
b4ad57f4
NC
353}
354
355XS(w32_RegisterServer)
356{
357 dXSARGS;
358 BOOL result = FALSE;
359 HINSTANCE hnd;
360 FARPROC func;
b4ad57f4
NC
361
362 if (items != 1)
363 croak("usage: Win32::RegisterServer($libname)\n");
364
8c56068e 365 hnd = LoadLibraryA(SvPV_nolen(ST(0)));
b4ad57f4
NC
366 if (hnd) {
367 func = GetProcAddress(hnd, "DllRegisterServer");
368 if (func && func() == 0)
369 result = TRUE;
370 FreeLibrary(hnd);
371 }
8c56068e
JD
372 ST(0) = boolSV(result);
373 XSRETURN(1);
b4ad57f4
NC
374}
375
376XS(w32_UnregisterServer)
377{
378 dXSARGS;
379 BOOL result = FALSE;
380 HINSTANCE hnd;
381 FARPROC func;
b4ad57f4
NC
382
383 if (items != 1)
384 croak("usage: Win32::UnregisterServer($libname)\n");
385
8c56068e 386 hnd = LoadLibraryA(SvPV_nolen(ST(0)));
b4ad57f4
NC
387 if (hnd) {
388 func = GetProcAddress(hnd, "DllUnregisterServer");
389 if (func && func() == 0)
390 result = TRUE;
391 FreeLibrary(hnd);
392 }
8c56068e
JD
393 ST(0) = boolSV(result);
394 XSRETURN(1);
b4ad57f4
NC
395}
396
397/* XXX rather bogus */
398XS(w32_GetArchName)
399{
400 dXSARGS;
401 XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));
402}
403
404XS(w32_GetChipName)
405{
406 dXSARGS;
407 SYSTEM_INFO sysinfo;
408
409 Zero(&sysinfo,1,SYSTEM_INFO);
410 GetSystemInfo(&sysinfo);
411 /* XXX docs say dwProcessorType is deprecated on NT */
412 XSRETURN_IV(sysinfo.dwProcessorType);
413}
414
415XS(w32_GuidGen)
416{
417 dXSARGS;
418 GUID guid;
419 char szGUID[50] = {'\0'};
420 HRESULT hr = CoCreateGuid(&guid);
421
422 if (SUCCEEDED(hr)) {
423 LPOLESTR pStr = NULL;
e364e11c
JD
424 if (SUCCEEDED(StringFromCLSID(&guid, &pStr))) {
425 WideCharToMultiByte(CP_ACP, 0, pStr, wcslen(pStr), szGUID,
426 sizeof(szGUID), NULL, NULL);
427 CoTaskMemFree(pStr);
428 XSRETURN_PV(szGUID);
429 }
b4ad57f4 430 }
e364e11c 431 XSRETURN_UNDEF;
b4ad57f4
NC
432}
433
434XS(w32_GetFolderPath)
435{
436 dXSARGS;
437 char path[MAX_PATH+1];
438 int folder;
439 int create = 0;
440 HMODULE module;
441
442 if (items != 1 && items != 2)
443 croak("usage: Win32::GetFolderPath($csidl [, $create])\n");
444
445 folder = SvIV(ST(0));
446 if (items == 2)
447 create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0;
448
b4ad57f4
NC
449 module = LoadLibrary("shfolder.dll");
450 if (module) {
451 PFNSHGetFolderPath pfn;
452 pfn = (PFNSHGetFolderPath)GetProcAddress(module, "SHGetFolderPathA");
453 if (pfn && SUCCEEDED(pfn(NULL, folder|create, NULL, 0, path))) {
454 FreeLibrary(module);
455 XSRETURN_PV(path);
456 }
457 FreeLibrary(module);
458 }
459
460 module = LoadLibrary("shell32.dll");
461 if (module) {
462 PFNSHGetSpecialFolderPath pfn;
463 pfn = (PFNSHGetSpecialFolderPath)
464 GetProcAddress(module, "SHGetSpecialFolderPathA");
465 if (pfn && pfn(NULL, path, folder, !!create)) {
466 FreeLibrary(module);
467 XSRETURN_PV(path);
468 }
469 FreeLibrary(module);
470 }
471 XSRETURN_UNDEF;
472}
473
e364e11c
JD
474XS(w32_GetFileVersion)
475{
476 dXSARGS;
477 DWORD size;
478 DWORD handle;
479 char *filename;
480 char *data;
481
482 if (items != 1)
483 croak("usage: Win32::GetFileVersion($filename)\n");
484
485 filename = SvPV_nolen(ST(0));
486 size = GetFileVersionInfoSize(filename, &handle);
487 if (!size)
488 XSRETURN_UNDEF;
489
490 New(0, data, size, char);
491 if (!data)
492 XSRETURN_UNDEF;
493
494 if (GetFileVersionInfo(filename, handle, size, data)) {
495 VS_FIXEDFILEINFO *info;
496 UINT len;
497 if (VerQueryValue(data, "\\", (void**)&info, &len)) {
498 int dwValueMS1 = (info->dwFileVersionMS>>16);
499 int dwValueMS2 = (info->dwFileVersionMS&0xffff);
500 int dwValueLS1 = (info->dwFileVersionLS>>16);
501 int dwValueLS2 = (info->dwFileVersionLS&0xffff);
502
503 if (GIMME_V == G_ARRAY) {
504 EXTEND(SP, 4);
505 XST_mIV(0, dwValueMS1);
506 XST_mIV(1, dwValueMS2);
507 XST_mIV(2, dwValueLS1);
508 XST_mIV(3, dwValueLS2);
509 items = 4;
510 }
511 else {
512 char version[50];
513 sprintf(version, "%d.%d.%d.%d", dwValueMS1, dwValueMS2, dwValueLS1, dwValueLS2);
514 XST_mPV(0, version);
515 }
516 }
517 }
518 else
519 items = 0;
520
521 Safefree(data);
522 XSRETURN(items);
523}
524
b4ad57f4
NC
525XS(boot_Win32)
526{
527 dXSARGS;
528 char *file = __FILE__;
529
530 newXS("Win32::LookupAccountName", w32_LookupAccountName, file);
531 newXS("Win32::LookupAccountSID", w32_LookupAccountSID, file);
532 newXS("Win32::InitiateSystemShutdown", w32_InitiateSystemShutdown, file);
533 newXS("Win32::AbortSystemShutdown", w32_AbortSystemShutdown, file);
534 newXS("Win32::ExpandEnvironmentStrings", w32_ExpandEnvironmentStrings, file);
535 newXS("Win32::MsgBox", w32_MsgBox, file);
536 newXS("Win32::LoadLibrary", w32_LoadLibrary, file);
537 newXS("Win32::FreeLibrary", w32_FreeLibrary, file);
538 newXS("Win32::GetProcAddress", w32_GetProcAddress, file);
539 newXS("Win32::RegisterServer", w32_RegisterServer, file);
540 newXS("Win32::UnregisterServer", w32_UnregisterServer, file);
541 newXS("Win32::GetArchName", w32_GetArchName, file);
542 newXS("Win32::GetChipName", w32_GetChipName, file);
543 newXS("Win32::GuidGen", w32_GuidGen, file);
544 newXS("Win32::GetFolderPath", w32_GetFolderPath, file);
545 newXS("Win32::IsAdminUser", w32_IsAdminUser, file);
e364e11c 546 newXS("Win32::GetFileVersion", w32_GetFileVersion, file);
b4ad57f4
NC
547
548 XSRETURN_YES;
549}