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
1 #include <windows.h>
2
3 #include "EXTERN.h"
4 #include "perl.h"
5 #include "XSUB.h"
6
7 #define SE_SHUTDOWN_NAMEA   "SeShutdownPrivilege"
8
9 typedef BOOL (WINAPI *PFNSHGetSpecialFolderPath)(HWND, char*, int, BOOL);
10 typedef HRESULT (WINAPI *PFNSHGetFolderPath)(HWND, int, HANDLE, DWORD, LPTSTR);
11 #ifndef CSIDL_FLAG_CREATE
12 #   define CSIDL_FLAG_CREATE               0x8000
13 #endif
14
15 XS(w32_ExpandEnvironmentStrings)
16 {
17     dXSARGS;
18     BYTE buffer[4096];
19
20     if (items != 1)
21         croak("usage: Win32::ExpandEnvironmentStrings($String);\n");
22
23     ExpandEnvironmentStringsA(SvPV_nolen(ST(0)), (char*)buffer, sizeof(buffer));
24     XSRETURN_PV((char*)buffer);
25 }
26
27 XS(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
153 XS(w32_LookupAccountName)
154 {
155     dXSARGS;
156     char SID[400];
157     DWORD SIDLen;
158     SID_NAME_USE snu;
159     char Domain[256];
160     DWORD DomLen;
161     BOOL bResult;
162
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
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 */
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     }
183     XSRETURN_NO;
184 }
185
186
187 XS(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;
196     BOOL bResult;
197
198     if (items != 5)
199         croak("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n");
200
201     sid = SvPV_nolen(ST(1));
202     if (IsValidSid(sid)) {
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 */
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         }
216     }
217     XSRETURN_NO;
218 }
219
220 XS(w32_InitiateSystemShutdown)
221 {
222     dXSARGS;
223     HANDLE hToken;              /* handle to process token   */
224     TOKEN_PRIVILEGES tkp;       /* pointer to token structure  */
225     BOOL bRet;
226     char *machineName, *message;
227
228     if (items != 5)
229         croak("usage: Win32::InitiateSystemShutdown($machineName, $message, "
230               "$timeOut, $forceClose, $reboot);\n");
231
232     machineName = SvPV_nolen(ST(0));
233
234     if (OpenProcessToken(GetCurrentProcess(),
235                          TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
236                          &hToken))
237     {
238         LookupPrivilegeValueA(machineName,
239                               SE_SHUTDOWN_NAMEA,
240                               &tkp.Privileges[0].Luid);
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
250     message = SvPV_nolen(ST(1));
251     bRet = InitiateSystemShutdownA(machineName, message,
252                                    SvIV(ST(2)), SvIV(ST(3)), SvIV(ST(4)));
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
262 XS(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;
269
270     if (items != 1)
271         croak("usage: Win32::AbortSystemShutdown($machineName);\n");
272
273     machineName = SvPV_nolen(ST(0));
274
275     if (OpenProcessToken(GetCurrentProcess(),
276                          TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
277                          &hToken))
278     {
279         LookupPrivilegeValueA(machineName,
280                               SE_SHUTDOWN_NAMEA,
281                               &tkp.Privileges[0].Luid);
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
291     bRet = AbortSystemShutdownA(machineName);
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
302 XS(w32_MsgBox)
303 {
304     dXSARGS;
305     char *msg;
306     char *title = "Perl";
307     DWORD flags = MB_ICONEXCLAMATION;
308     I32 result;
309
310     if (items < 1 || items > 3)
311         croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n");
312
313     msg = SvPV_nolen(ST(0));
314     if (items > 1) {
315         flags = SvIV(ST(1));
316         if (items > 2)
317             title = SvPV_nolen(ST(2));
318     }
319     result = MessageBoxA(GetActiveWindow(), msg, title, flags);
320     XSRETURN_IV(result);
321 }
322
323 XS(w32_LoadLibrary)
324 {
325     dXSARGS;
326     HANDLE hHandle;
327
328     if (items != 1)
329         croak("usage: Win32::LoadLibrary($libname)\n");
330     hHandle = LoadLibraryA(SvPV_nolen(ST(0)));
331     XSRETURN_IV((long)hHandle);
332 }
333
334 XS(w32_FreeLibrary)
335 {
336     dXSARGS;
337
338     if (items != 1)
339         croak("usage: Win32::FreeLibrary($handle)\n");
340     if (FreeLibrary(INT2PTR(HINSTANCE, SvIV(ST(0))))) {
341         XSRETURN_YES;
342     }
343     XSRETURN_NO;
344 }
345
346 XS(w32_GetProcAddress)
347 {
348     dXSARGS;
349
350     if (items != 2)
351         croak("usage: Win32::GetProcAddress($hinstance, $procname)\n");
352     XSRETURN_IV(PTR2IV(GetProcAddress(INT2PTR(HINSTANCE, SvIV(ST(0))), SvPV_nolen(ST(1)))));
353 }
354
355 XS(w32_RegisterServer)
356 {
357     dXSARGS;
358     BOOL result = FALSE;
359     HINSTANCE hnd;
360     FARPROC func;
361
362     if (items != 1)
363         croak("usage: Win32::RegisterServer($libname)\n");
364
365     hnd = LoadLibraryA(SvPV_nolen(ST(0)));
366     if (hnd) {
367         func = GetProcAddress(hnd, "DllRegisterServer");
368         if (func && func() == 0)
369             result = TRUE;
370         FreeLibrary(hnd);
371     }
372     ST(0) = boolSV(result);
373     XSRETURN(1);
374 }
375
376 XS(w32_UnregisterServer)
377 {
378     dXSARGS;
379     BOOL result = FALSE;
380     HINSTANCE hnd;
381     FARPROC func;
382
383     if (items != 1)
384         croak("usage: Win32::UnregisterServer($libname)\n");
385
386     hnd = LoadLibraryA(SvPV_nolen(ST(0)));
387     if (hnd) {
388         func = GetProcAddress(hnd, "DllUnregisterServer");
389         if (func && func() == 0)
390             result = TRUE;
391         FreeLibrary(hnd);
392     }
393     ST(0) = boolSV(result);
394     XSRETURN(1);
395 }
396
397 /* XXX rather bogus */
398 XS(w32_GetArchName)
399 {
400     dXSARGS;
401     XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));
402 }
403
404 XS(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
415 XS(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;
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         }
430     }
431     XSRETURN_UNDEF;
432 }
433
434 XS(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
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
474 XS(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
525 XS(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);
546     newXS("Win32::GetFileVersion", w32_GetFileVersion, file);
547
548     XSRETURN_YES;
549 }