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 typedef int (__stdcall *PFNDllRegisterServer)(void);
  12 typedef int (__stdcall *PFNDllUnregisterServer)(void);
  13 #ifndef CSIDL_FLAG_CREATE
  14 #   define CSIDL_FLAG_CREATE               0x8000
  15 #endif
  16
  17 static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
  18
  19 #define ONE_K_BUFSIZE   1024
  20
  21 int
  22 IsWin95(void)
  23 {
  24     return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);
  25 }
  26
  27 int
  28 IsWinNT(void)
  29 {
  30     return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);
  31 }
  32
  33 #ifdef __CYGWIN__
  34
  35 #define isSLASH(c) ((c) == '/' || (c) == '\\')
  36 #define SKIP_SLASHES(s) \
  37     STMT_START {                                \
  38         while (*(s) && isSLASH(*(s)))           \
  39             ++(s);                              \
  40     } STMT_END
  41 #define COPY_NONSLASHES(d,s) \
  42     STMT_START {                                \
  43         while (*(s) && !isSLASH(*(s)))          \
  44             *(d)++ = *(s)++;                    \
  45     } STMT_END
  46
  47 /* Find the longname of a given path.  path is destructively modified.
  48  * It should have space for at least MAX_PATH characters. */
  49 char *
  50 win32_longpath(char *path)
  51 {
  52     WIN32_FIND_DATA fdata;
  53     HANDLE fhand;
  54     char tmpbuf[MAX_PATH+1];
  55     char *tmpstart = tmpbuf;
  56     char *start = path;
  57     char sep;
  58     if (!path)
  59         return Nullch;
  60
  61     /* drive prefix */
  62     if (isALPHA(path[0]) && path[1] == ':') {
  63         start = path + 2;
  64         *tmpstart++ = path[0];
  65         *tmpstart++ = ':';
  66     }
  67     /* UNC prefix */
  68     else if (isSLASH(path[0]) && isSLASH(path[1])) {
  69         start = path + 2;
  70         *tmpstart++ = path[0];
  71         *tmpstart++ = path[1];
  72         SKIP_SLASHES(start);
  73         COPY_NONSLASHES(tmpstart,start);        /* copy machine name */
  74         if (*start) {
  75             *tmpstart++ = *start++;
  76             SKIP_SLASHES(start);
  77             COPY_NONSLASHES(tmpstart,start);    /* copy share name */
  78         }
  79     }
  80     *tmpstart = '\0';
  81     while (*start) {
  82         /* copy initial slash, if any */
  83         if (isSLASH(*start)) {
  84             *tmpstart++ = *start++;
  85             *tmpstart = '\0';
  86             SKIP_SLASHES(start);
  87         }
  88
  89         /* FindFirstFile() expands "." and "..", so we need to pass
  90          * those through unmolested */
  91         if (*start == '.'
  92             && (!start[1] || isSLASH(start[1])
  93                 || (start[1] == '.' && (!start[2] || isSLASH(start[2])))))
  94         {
  95             COPY_NONSLASHES(tmpstart,start);    /* copy "." or ".." */
  96             *tmpstart = '\0';
  97             continue;
  98         }
  99
 100         /* if this is the end, bust outta here */
 101         if (!*start)
 102             break;
 103
 104         /* now we're at a non-slash; walk up to next slash */
 105         while (*start && !isSLASH(*start))
 106             ++start;
 107
 108         /* stop and find full name of component */
 109         sep = *start;
 110         *start = '\0';
 111         fhand = FindFirstFile(path,&fdata);
 112         *start = sep;
 113         if (fhand != INVALID_HANDLE_VALUE) {
 114             STRLEN len = strlen(fdata.cFileName);
 115             if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) {
 116                 strcpy(tmpstart, fdata.cFileName);
 117                 tmpstart += len;
 118                 FindClose(fhand);
 119             }
 120             else {
 121                 FindClose(fhand);
 122                 errno = ERANGE;
 123                 return Nullch;
 124             }
 125         }
 126         else {
 127             /* failed a step, just return without side effects */
 128             /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/
 129             errno = EINVAL;
 130             return Nullch;
 131         }
 132     }
 133     strcpy(path,tmpbuf);
 134     return path;
 135 }
 136
 137 char*
 138 get_childdir(void)
 139 {
 140     dTHX;
 141     char* ptr;
 142     char szfilename[MAX_PATH+1];
 143
 144     GetCurrentDirectoryA(MAX_PATH+1, szfilename);
 145     New(0, ptr, strlen(szfilename)+1, char);
 146     strcpy(ptr, szfilename);
 147     return ptr;
 148 }
 149
 150 void
 151 free_childdir(char* d)
 152 {
 153     dTHX;
 154     Safefree(d);
 155 }
 156
 157 void*
 158 get_childenv(void)
 159 {
 160     return NULL;
 161 }
 162
 163 void
 164 free_childenv(void* d)
 165 {
 166 }
 167
 168 #  define PerlDir_mapA(dir) (dir)
 169
 170 #endif
 171
 172 XS(w32_ExpandEnvironmentStrings)
 173 {
 174     dXSARGS;
 175     BYTE buffer[4096];
 176
 177     if (items != 1)
 178         croak("usage: Win32::ExpandEnvironmentStrings($String);\n");
 179
 180     ExpandEnvironmentStringsA(SvPV_nolen(ST(0)), (char*)buffer, sizeof(buffer));
 181     XSRETURN_PV((char*)buffer);
 182 }
 183
 184 XS(w32_IsAdminUser)
 185 {
 186     dXSARGS;
 187     HINSTANCE                   hAdvApi32;
 188     BOOL (__stdcall *pfnOpenThreadToken)(HANDLE hThr, DWORD dwDesiredAccess,
 189                                 BOOL bOpenAsSelf, PHANDLE phTok);
 190     BOOL (__stdcall *pfnOpenProcessToken)(HANDLE hProc, DWORD dwDesiredAccess,
 191                                 PHANDLE phTok);
 192     BOOL (__stdcall *pfnGetTokenInformation)(HANDLE hTok,
 193                                 TOKEN_INFORMATION_CLASS TokenInformationClass,
 194                                 LPVOID lpTokInfo, DWORD dwTokInfoLen,
 195                                 PDWORD pdwRetLen);
 196     BOOL (__stdcall *pfnAllocateAndInitializeSid)(
 197                                 PSID_IDENTIFIER_AUTHORITY pIdAuth,
 198                                 BYTE nSubAuthCount, DWORD dwSubAuth0,
 199                                 DWORD dwSubAuth1, DWORD dwSubAuth2,
 200                                 DWORD dwSubAuth3, DWORD dwSubAuth4,
 201                                 DWORD dwSubAuth5, DWORD dwSubAuth6,
 202                                 DWORD dwSubAuth7, PSID pSid);
 203     BOOL (__stdcall *pfnEqualSid)(PSID pSid1, PSID pSid2);
 204     PVOID (__stdcall *pfnFreeSid)(PSID pSid);
 205     HANDLE                      hTok;
 206     DWORD                       dwTokInfoLen;
 207     TOKEN_GROUPS                *lpTokInfo;
 208     SID_IDENTIFIER_AUTHORITY    NtAuth = SECURITY_NT_AUTHORITY;
 209     PSID                        pAdminSid;
 210     int                         iRetVal;
 211     unsigned int                i;
 212     OSVERSIONINFO               osver;
 213
 214     if (items)
 215         croak("usage: Win32::IsAdminUser()");
 216
 217     /* There is no concept of "Administrator" user accounts on Win9x systems,
 218        so just return true. */
 219     memset(&osver, 0, sizeof(OSVERSIONINFO));
 220     osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
 221     GetVersionEx(&osver);
 222     if (osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS)
 223         XSRETURN_YES;
 224
 225     hAdvApi32 = LoadLibrary("advapi32.dll");
 226     if (!hAdvApi32) {
 227         warn("Cannot load advapi32.dll library");
 228         XSRETURN_UNDEF;
 229     }
 230
 231     pfnOpenThreadToken = (BOOL (__stdcall *)(HANDLE, DWORD, BOOL, PHANDLE))
 232         GetProcAddress(hAdvApi32, "OpenThreadToken");
 233     pfnOpenProcessToken = (BOOL (__stdcall *)(HANDLE, DWORD, PHANDLE))
 234         GetProcAddress(hAdvApi32, "OpenProcessToken");
 235     pfnGetTokenInformation = (BOOL (__stdcall *)(HANDLE,
 236         TOKEN_INFORMATION_CLASS, LPVOID, DWORD, PDWORD))
 237         GetProcAddress(hAdvApi32, "GetTokenInformation");
 238     pfnAllocateAndInitializeSid = (BOOL (__stdcall *)(
 239         PSID_IDENTIFIER_AUTHORITY, BYTE, DWORD, DWORD, DWORD, DWORD, DWORD,
 240         DWORD, DWORD, DWORD, PSID))
 241         GetProcAddress(hAdvApi32, "AllocateAndInitializeSid");
 242     pfnEqualSid = (BOOL (__stdcall *)(PSID, PSID))
 243         GetProcAddress(hAdvApi32, "EqualSid");
 244     pfnFreeSid = (PVOID (__stdcall *)(PSID))
 245         GetProcAddress(hAdvApi32, "FreeSid");
 246
 247     if (!(pfnOpenThreadToken && pfnOpenProcessToken &&
 248           pfnGetTokenInformation && pfnAllocateAndInitializeSid &&
 249           pfnEqualSid && pfnFreeSid))
 250     {
 251         warn("Cannot load functions from advapi32.dll library");
 252         FreeLibrary(hAdvApi32);
 253         XSRETURN_UNDEF;
 254     }
 255
 256     if (!pfnOpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) {
 257         if (!pfnOpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) {
 258             warn("Cannot open thread token or process token");
 259             FreeLibrary(hAdvApi32);
 260             XSRETURN_UNDEF;
 261         }
 262     }
 263
 264     pfnGetTokenInformation(hTok, TokenGroups, NULL, 0, &dwTokInfoLen);
 265     if (!New(1, lpTokInfo, dwTokInfoLen, TOKEN_GROUPS)) {
 266         warn("Cannot allocate token information structure");
 267         CloseHandle(hTok);
 268         FreeLibrary(hAdvApi32);
 269         XSRETURN_UNDEF;
 270     }
 271
 272     if (!pfnGetTokenInformation(hTok, TokenGroups, lpTokInfo, dwTokInfoLen,
 273             &dwTokInfoLen))
 274     {
 275         warn("Cannot get token information");
 276         Safefree(lpTokInfo);
 277         CloseHandle(hTok);
 278         FreeLibrary(hAdvApi32);
 279         XSRETURN_UNDEF;
 280     }
 281
 282     if (!pfnAllocateAndInitializeSid(&NtAuth, 2, SECURITY_BUILTIN_DOMAIN_RID,
 283             DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &pAdminSid))
 284     {
 285         warn("Cannot allocate administrators' SID");
 286         Safefree(lpTokInfo);
 287         CloseHandle(hTok);
 288         FreeLibrary(hAdvApi32);
 289         XSRETURN_UNDEF;
 290     }
 291
 292     iRetVal = 0;
 293     for (i = 0; i < lpTokInfo->GroupCount; ++i) {
 294         if (pfnEqualSid(lpTokInfo->Groups[i].Sid, pAdminSid)) {
 295             iRetVal = 1;
 296             break;
 297         }
 298     }
 299
 300     pfnFreeSid(pAdminSid);
 301     Safefree(lpTokInfo);
 302     CloseHandle(hTok);
 303     FreeLibrary(hAdvApi32);
 304
 305     EXTEND(SP, 1);
 306     ST(0) = sv_2mortal(newSViv(iRetVal));
 307     XSRETURN(1);
 308 }
 309
 310 XS(w32_LookupAccountName)
 311 {
 312     dXSARGS;
 313     char SID[400];
 314     DWORD SIDLen;
 315     SID_NAME_USE snu;
 316     char Domain[256];
 317     DWORD DomLen;
 318     BOOL bResult;
 319
 320     if (items != 5)
 321         croak("usage: Win32::LookupAccountName($system, $account, $domain, "
 322               "$sid, $sidtype);\n");
 323
 324     SIDLen = sizeof(SID);
 325     DomLen = sizeof(Domain);
 326
 327     bResult = LookupAccountNameA(SvPV_nolen(ST(0)),     /* System */
 328                                  SvPV_nolen(ST(1)),     /* Account name */
 329                                  &SID,                  /* SID structure */
 330                                  &SIDLen,               /* Size of SID buffer */
 331                                  Domain,                /* Domain buffer */
 332                                  &DomLen,               /* Domain buffer size */
 333                                  &snu);                 /* SID name type */
 334     if (bResult) {
 335         sv_setpv(ST(2), Domain);
 336         sv_setpvn(ST(3), SID, SIDLen);
 337         sv_setiv(ST(4), snu);
 338         XSRETURN_YES;
 339     }
 340     XSRETURN_NO;
 341 }
 342
 343
 344 XS(w32_LookupAccountSID)
 345 {
 346     dXSARGS;
 347     PSID sid;
 348     char Account[256];
 349     DWORD AcctLen = sizeof(Account);
 350     char Domain[256];
 351     DWORD DomLen = sizeof(Domain);
 352     SID_NAME_USE snu;
 353     BOOL bResult;
 354
 355     if (items != 5)
 356         croak("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n");
 357
 358     sid = SvPV_nolen(ST(1));
 359     if (IsValidSid(sid)) {
 360         bResult = LookupAccountSidA(SvPV_nolen(ST(0)),  /* System */
 361                                     sid,                /* SID structure */
 362                                     Account,            /* Account name buffer */
 363                                     &AcctLen,           /* name buffer length */
 364                                     Domain,             /* Domain buffer */
 365                                     &DomLen,            /* Domain buffer length */
 366                                     &snu);              /* SID name type */
 367         if (bResult) {
 368             sv_setpv(ST(2), Account);
 369             sv_setpv(ST(3), Domain);
 370             sv_setiv(ST(4), (IV)snu);
 371             XSRETURN_YES;
 372         }
 373     }
 374     XSRETURN_NO;
 375 }
 376
 377 XS(w32_InitiateSystemShutdown)
 378 {
 379     dXSARGS;
 380     HANDLE hToken;              /* handle to process token   */
 381     TOKEN_PRIVILEGES tkp;       /* pointer to token structure  */
 382     BOOL bRet;
 383     char *machineName, *message;
 384
 385     if (items != 5)
 386         croak("usage: Win32::InitiateSystemShutdown($machineName, $message, "
 387               "$timeOut, $forceClose, $reboot);\n");
 388
 389     machineName = SvPV_nolen(ST(0));
 390
 391     if (OpenProcessToken(GetCurrentProcess(),
 392                          TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
 393                          &hToken))
 394     {
 395         LookupPrivilegeValueA(machineName,
 396                               SE_SHUTDOWN_NAMEA,
 397                               &tkp.Privileges[0].Luid);
 398
 399         tkp.PrivilegeCount = 1; /* only setting one */
 400         tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
 401
 402         /* Get shutdown privilege for this process. */
 403         AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
 404                               (PTOKEN_PRIVILEGES)NULL, 0);
 405     }
 406
 407     message = SvPV_nolen(ST(1));
 408     bRet = InitiateSystemShutdownA(machineName, message,
 409                                    SvIV(ST(2)), SvIV(ST(3)), SvIV(ST(4)));
 410
 411     /* Disable shutdown privilege. */
 412     tkp.Privileges[0].Attributes = 0;
 413     AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
 414                           (PTOKEN_PRIVILEGES)NULL, 0);
 415     CloseHandle(hToken);
 416     XSRETURN_IV(bRet);
 417 }
 418
 419 XS(w32_AbortSystemShutdown)
 420 {
 421     dXSARGS;
 422     HANDLE hToken;              /* handle to process token   */
 423     TOKEN_PRIVILEGES tkp;       /* pointer to token structure  */
 424     BOOL bRet;
 425     char *machineName;
 426
 427     if (items != 1)
 428         croak("usage: Win32::AbortSystemShutdown($machineName);\n");
 429
 430     machineName = SvPV_nolen(ST(0));
 431
 432     if (OpenProcessToken(GetCurrentProcess(),
 433                          TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
 434                          &hToken))
 435     {
 436         LookupPrivilegeValueA(machineName,
 437                               SE_SHUTDOWN_NAMEA,
 438                               &tkp.Privileges[0].Luid);
 439
 440         tkp.PrivilegeCount = 1; /* only setting one */
 441         tkp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
 442
 443         /* Get shutdown privilege for this process. */
 444         AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
 445                               (PTOKEN_PRIVILEGES)NULL, 0);
 446     }
 447
 448     bRet = AbortSystemShutdownA(machineName);
 449
 450     /* Disable shutdown privilege. */
 451     tkp.Privileges[0].Attributes = 0;
 452     AdjustTokenPrivileges(hToken, FALSE, &tkp, 0,
 453                           (PTOKEN_PRIVILEGES)NULL, 0);
 454     CloseHandle(hToken);
 455     XSRETURN_IV(bRet);
 456 }
 457
 458
 459 XS(w32_MsgBox)
 460 {
 461     dXSARGS;
 462     char *msg;
 463     char *title = "Perl";
 464     DWORD flags = MB_ICONEXCLAMATION;
 465     I32 result;
 466
 467     if (items < 1 || items > 3)
 468         croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n");
 469
 470     msg = SvPV_nolen(ST(0));
 471     if (items > 1) {
 472         flags = SvIV(ST(1));
 473         if (items > 2)
 474             title = SvPV_nolen(ST(2));
 475     }
 476     result = MessageBoxA(GetActiveWindow(), msg, title, flags);
 477     XSRETURN_IV(result);
 478 }
 479
 480 XS(w32_LoadLibrary)
 481 {
 482     dXSARGS;
 483     HANDLE hHandle;
 484
 485     if (items != 1)
 486         croak("usage: Win32::LoadLibrary($libname)\n");
 487     hHandle = LoadLibraryA(SvPV_nolen(ST(0)));
 488     XSRETURN_IV((long)hHandle);
 489 }
 490
 491 XS(w32_FreeLibrary)
 492 {
 493     dXSARGS;
 494
 495     if (items != 1)
 496         croak("usage: Win32::FreeLibrary($handle)\n");
 497     if (FreeLibrary(INT2PTR(HINSTANCE, SvIV(ST(0))))) {
 498         XSRETURN_YES;
 499     }
 500     XSRETURN_NO;
 501 }
 502
 503 XS(w32_GetProcAddress)
 504 {
 505     dXSARGS;
 506
 507     if (items != 2)
 508         croak("usage: Win32::GetProcAddress($hinstance, $procname)\n");
 509     XSRETURN_IV(PTR2IV(GetProcAddress(INT2PTR(HINSTANCE, SvIV(ST(0))), SvPV_nolen(ST(1)))));
 510 }
 511
 512 XS(w32_RegisterServer)
 513 {
 514     dXSARGS;
 515     BOOL result = FALSE;
 516     HINSTANCE hnd;
 517
 518     if (items != 1)
 519         croak("usage: Win32::RegisterServer($libname)\n");
 520
 521     hnd = LoadLibraryA(SvPV_nolen(ST(0)));
 522     if (hnd) {
 523         PFNDllRegisterServer func;
 524         func = (PFNDllRegisterServer)GetProcAddress(hnd, "DllRegisterServer");
 525         if (func && func() == 0)
 526             result = TRUE;
 527         FreeLibrary(hnd);
 528     }
 529     ST(0) = boolSV(result);
 530     XSRETURN(1);
 531 }
 532
 533 XS(w32_UnregisterServer)
 534 {
 535     dXSARGS;
 536     BOOL result = FALSE;
 537     HINSTANCE hnd;
 538
 539     if (items != 1)
 540         croak("usage: Win32::UnregisterServer($libname)\n");
 541
 542     hnd = LoadLibraryA(SvPV_nolen(ST(0)));
 543     if (hnd) {
 544         PFNDllUnregisterServer func;
 545         func = (PFNDllUnregisterServer)GetProcAddress(hnd, "DllUnregisterServer");
 546         if (func && func() == 0)
 547             result = TRUE;
 548         FreeLibrary(hnd);
 549     }
 550     ST(0) = boolSV(result);
 551     XSRETURN(1);
 552 }
 553
 554 /* XXX rather bogus */
 555 XS(w32_GetArchName)
 556 {
 557     dXSARGS;
 558     XSRETURN_PV(getenv("PROCESSOR_ARCHITECTURE"));
 559 }
 560
 561 XS(w32_GetChipName)
 562 {
 563     dXSARGS;
 564     SYSTEM_INFO sysinfo;
 565
 566     Zero(&sysinfo,1,SYSTEM_INFO);
 567     GetSystemInfo(&sysinfo);
 568     /* XXX docs say dwProcessorType is deprecated on NT */
 569     XSRETURN_IV(sysinfo.dwProcessorType);
 570 }
 571
 572 XS(w32_GuidGen)
 573 {
 574     dXSARGS;
 575     GUID guid;
 576     char szGUID[50] = {'\0'};
 577     HRESULT  hr     = CoCreateGuid(&guid);
 578
 579     if (SUCCEEDED(hr)) {
 580         LPOLESTR pStr = NULL;
 581         if (SUCCEEDED(StringFromCLSID(&guid, &pStr))) {
 582             WideCharToMultiByte(CP_ACP, 0, pStr, wcslen(pStr), szGUID,
 583                                 sizeof(szGUID), NULL, NULL);
 584             CoTaskMemFree(pStr);
 585             XSRETURN_PV(szGUID);
 586         }
 587     }
 588     XSRETURN_UNDEF;
 589 }
 590
 591 XS(w32_GetFolderPath)
 592 {
 593     dXSARGS;
 594     char path[MAX_PATH+1];
 595     int folder;
 596     int create = 0;
 597     HMODULE module;
 598
 599     if (items != 1 && items != 2)
 600         croak("usage: Win32::GetFolderPath($csidl [, $create])\n");
 601
 602     folder = SvIV(ST(0));
 603     if (items == 2)
 604         create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0;
 605
 606     module = LoadLibrary("shfolder.dll");
 607     if (module) {
 608         PFNSHGetFolderPath pfn;
 609         pfn = (PFNSHGetFolderPath)GetProcAddress(module, "SHGetFolderPathA");
 610         if (pfn && SUCCEEDED(pfn(NULL, folder|create, NULL, 0, path))) {
 611             FreeLibrary(module);
 612             XSRETURN_PV(path);
 613         }
 614         FreeLibrary(module);
 615     }
 616
 617     module = LoadLibrary("shell32.dll");
 618     if (module) {
 619         PFNSHGetSpecialFolderPath pfn;
 620         pfn = (PFNSHGetSpecialFolderPath)
 621             GetProcAddress(module, "SHGetSpecialFolderPathA");
 622         if (pfn && pfn(NULL, path, folder, !!create)) {
 623             FreeLibrary(module);
 624             XSRETURN_PV(path);
 625         }
 626         FreeLibrary(module);
 627     }
 628     XSRETURN_UNDEF;
 629 }
 630
 631 XS(w32_GetFileVersion)
 632 {
 633     dXSARGS;
 634     DWORD size;
 635     DWORD handle;
 636     char *filename;
 637     char *data;
 638
 639     if (items != 1)
 640         croak("usage: Win32::GetFileVersion($filename)\n");
 641
 642     filename = SvPV_nolen(ST(0));
 643     size = GetFileVersionInfoSize(filename, &handle);
 644     if (!size)
 645         XSRETURN_UNDEF;
 646
 647     New(0, data, size, char);
 648     if (!data)
 649         XSRETURN_UNDEF;
 650
 651     if (GetFileVersionInfo(filename, handle, size, data)) {
 652         VS_FIXEDFILEINFO *info;
 653         UINT len;
 654         if (VerQueryValue(data, "\\", (void**)&info, &len)) {
 655             int dwValueMS1 = (info->dwFileVersionMS>>16);
 656             int dwValueMS2 = (info->dwFileVersionMS&0xffff);
 657             int dwValueLS1 = (info->dwFileVersionLS>>16);
 658             int dwValueLS2 = (info->dwFileVersionLS&0xffff);
 659
 660             if (GIMME_V == G_ARRAY) {
 661                 EXTEND(SP, 4);
 662                 XST_mIV(0, dwValueMS1);
 663                 XST_mIV(1, dwValueMS2);
 664                 XST_mIV(2, dwValueLS1);
 665                 XST_mIV(3, dwValueLS2);
 666                 items = 4;
 667             }
 668             else {
 669                 char version[50];
 670                 sprintf(version, "%d.%d.%d.%d", dwValueMS1, dwValueMS2, dwValueLS1, dwValueLS2);
 671                 XST_mPV(0, version);
 672             }
 673         }
 674     }
 675     else
 676         items = 0;
 677
 678     Safefree(data);
 679     XSRETURN(items);
 680 }
 681
 682 #ifdef __CYGWIN__
 683 XS(w32_SetChildShowWindow)
 684 {
 685     /* This function doesn't do anything useful for cygwin.  In the
 686      * MSWin32 case it modifies w32_showwindow, which is used by
 687      * win32_spawnvp().  Since w32_showwindow is an internal variable
 688      * inside the thread_intern structure, the MSWin32 implementation
 689      * lives in win32/win32.c in the core Perl distribution.
 690      */
 691     dXSARGS;
 692     XSRETURN_UNDEF;
 693 }
 694 #endif
 695
 696 XS(w32_GetCwd)
 697 {
 698     dXSARGS;
 699     /* Make the host for current directory */
 700     char* ptr = PerlEnv_get_childdir();
 701     /*
 702      * If ptr != Nullch
 703      *   then it worked, set PV valid,
 704      *   else return 'undef'
 705      */
 706     if (ptr) {
 707         SV *sv = sv_newmortal();
 708         sv_setpv(sv, ptr);
 709         PerlEnv_free_childdir(ptr);
 710
 711 #ifndef INCOMPLETE_TAINTS
 712         SvTAINTED_on(sv);
 713 #endif
 714
 715         EXTEND(SP,1);
 716         SvPOK_on(sv);
 717         ST(0) = sv;
 718         XSRETURN(1);
 719     }
 720     XSRETURN_UNDEF;
 721 }
 722
 723 XS(w32_SetCwd)
 724 {
 725     dXSARGS;
 726     if (items != 1)
 727         Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)");
 728     if (!PerlDir_chdir(SvPV_nolen(ST(0))))
 729         XSRETURN_YES;
 730
 731     XSRETURN_NO;
 732 }
 733
 734 XS(w32_GetNextAvailDrive)
 735 {
 736     dXSARGS;
 737     char ix = 'C';
 738     char root[] = "_:\\";
 739
 740     EXTEND(SP,1);
 741     while (ix <= 'Z') {
 742         root[0] = ix++;
 743         if (GetDriveType(root) == 1) {
 744             root[2] = '\0';
 745             XSRETURN_PV(root);
 746         }
 747     }
 748     XSRETURN_UNDEF;
 749 }
 750
 751 XS(w32_GetLastError)
 752 {
 753     dXSARGS;
 754     EXTEND(SP,1);
 755     XSRETURN_IV(GetLastError());
 756 }
 757
 758 XS(w32_SetLastError)
 759 {
 760     dXSARGS;
 761     if (items != 1)
 762         Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
 763     SetLastError(SvIV(ST(0)));
 764     XSRETURN_EMPTY;
 765 }
 766
 767 XS(w32_LoginName)
 768 {
 769     dXSARGS;
 770     char name[128];
 771     DWORD size = sizeof(name);
 772     EXTEND(SP,1);
 773     if (GetUserName(name,&size)) {
 774         /* size includes NULL */
 775         ST(0) = sv_2mortal(newSVpvn(name,size-1));
 776         XSRETURN(1);
 777     }
 778     XSRETURN_UNDEF;
 779 }
 780
 781 XS(w32_NodeName)
 782 {
 783     dXSARGS;
 784     char name[MAX_COMPUTERNAME_LENGTH+1];
 785     DWORD size = sizeof(name);
 786     EXTEND(SP,1);
 787     if (GetComputerName(name,&size)) {
 788         /* size does NOT include NULL :-( */
 789         ST(0) = sv_2mortal(newSVpvn(name,size));
 790         XSRETURN(1);
 791     }
 792     XSRETURN_UNDEF;
 793 }
 794
 795
 796 XS(w32_DomainName)
 797 {
 798     dXSARGS;
 799     HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll");
 800     DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer);
 801     DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level,
 802                                           void *bufptr);
 803
 804     if (hNetApi32) {
 805         pfnNetApiBufferFree = (DWORD (__stdcall *)(void *))
 806             GetProcAddress(hNetApi32, "NetApiBufferFree");
 807         pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *))
 808             GetProcAddress(hNetApi32, "NetWkstaGetInfo");
 809     }
 810     EXTEND(SP,1);
 811     if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
 812         /* this way is more reliable, in case user has a local account. */
 813         char dname[256];
 814         DWORD dnamelen = sizeof(dname);
 815         struct {
 816             DWORD   wki100_platform_id;
 817             LPWSTR  wki100_computername;
 818             LPWSTR  wki100_langroup;
 819             DWORD   wki100_ver_major;
 820             DWORD   wki100_ver_minor;
 821         } *pwi;
 822         /* NERR_Success *is* 0*/
 823         if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) {
 824             if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
 825                 WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup,
 826                                     -1, (LPSTR)dname, dnamelen, NULL, NULL);
 827             }
 828             else {
 829                 WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername,
 830                                     -1, (LPSTR)dname, dnamelen, NULL, NULL);
 831             }
 832             pfnNetApiBufferFree(pwi);
 833             FreeLibrary(hNetApi32);
 834             XSRETURN_PV(dname);
 835         }
 836         FreeLibrary(hNetApi32);
 837     }
 838     else {
 839         /* Win95 doesn't have NetWksta*(), so do it the old way */
 840         char name[256];
 841         DWORD size = sizeof(name);
 842         if (hNetApi32)
 843             FreeLibrary(hNetApi32);
 844         if (GetUserName(name,&size)) {
 845             char sid[ONE_K_BUFSIZE];
 846             DWORD sidlen = sizeof(sid);
 847             char dname[256];
 848             DWORD dnamelen = sizeof(dname);
 849             SID_NAME_USE snu;
 850             if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
 851                                   dname, &dnamelen, &snu)) {
 852                 XSRETURN_PV(dname);             /* all that for this */
 853             }
 854         }
 855     }
 856     XSRETURN_UNDEF;
 857 }
 858
 859 XS(w32_FsType)
 860 {
 861     dXSARGS;
 862     char fsname[256];
 863     DWORD flags, filecomplen;
 864     if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
 865                          &flags, fsname, sizeof(fsname))) {
 866         if (GIMME_V == G_ARRAY) {
 867             XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));
 868             XPUSHs(sv_2mortal(newSViv(flags)));
 869             XPUSHs(sv_2mortal(newSViv(filecomplen)));
 870             PUTBACK;
 871             return;
 872         }
 873         EXTEND(SP,1);
 874         XSRETURN_PV(fsname);
 875     }
 876     XSRETURN_EMPTY;
 877 }
 878
 879 XS(w32_GetOSVersion)
 880 {
 881     dXSARGS;
 882     /* Use explicit struct definition because wSuiteMask and
 883      * wProductType are not defined in the VC++ 6.0 headers.
 884      * WORD type has been replaced by unsigned short because
 885      * WORD is already used by Perl itself.
 886      */
 887     struct {
 888         DWORD dwOSVersionInfoSize;
 889         DWORD dwMajorVersion;
 890         DWORD dwMinorVersion;
 891         DWORD dwBuildNumber;
 892         DWORD dwPlatformId;
 893         CHAR  szCSDVersion[128];
 894         unsigned short wServicePackMajor;
 895         unsigned short wServicePackMinor;
 896         unsigned short wSuiteMask;
 897         BYTE  wProductType;
 898         BYTE  wReserved;
 899     }   osver;
 900     BOOL bEx = TRUE;
 901
 902     osver.dwOSVersionInfoSize = sizeof(osver);
 903     if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
 904         bEx = FALSE;
 905         osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
 906         if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
 907             XSRETURN_EMPTY;
 908         }
 909     }
 910     if (GIMME_V == G_SCALAR) {
 911         XSRETURN_IV(osver.dwPlatformId);
 912     }
 913     XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
 914
 915     XPUSHs(newSViv(osver.dwMajorVersion));
 916     XPUSHs(newSViv(osver.dwMinorVersion));
 917     XPUSHs(newSViv(osver.dwBuildNumber));
 918     XPUSHs(newSViv(osver.dwPlatformId));
 919     if (bEx) {
 920         XPUSHs(newSViv(osver.wServicePackMajor));
 921         XPUSHs(newSViv(osver.wServicePackMinor));
 922         XPUSHs(newSViv(osver.wSuiteMask));
 923         XPUSHs(newSViv(osver.wProductType));
 924     }
 925     PUTBACK;
 926 }
 927
 928 XS(w32_IsWinNT)
 929 {
 930     dXSARGS;
 931     EXTEND(SP,1);
 932     XSRETURN_IV(IsWinNT());
 933 }
 934
 935 XS(w32_IsWin95)
 936 {
 937     dXSARGS;
 938     EXTEND(SP,1);
 939     XSRETURN_IV(IsWin95());
 940 }
 941
 942 XS(w32_FormatMessage)
 943 {
 944     dXSARGS;
 945     DWORD source = 0;
 946     char msgbuf[ONE_K_BUFSIZE];
 947
 948     if (items != 1)
 949         Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
 950
 951     if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
 952                        &source, SvIV(ST(0)), 0,
 953                        msgbuf, sizeof(msgbuf)-1, NULL))
 954     {
 955         XSRETURN_PV(msgbuf);
 956     }
 957
 958     XSRETURN_UNDEF;
 959 }
 960
 961 XS(w32_Spawn)
 962 {
 963     dXSARGS;
 964     char *cmd, *args;
 965     void *env;
 966     char *dir;
 967     PROCESS_INFORMATION stProcInfo;
 968     STARTUPINFO stStartInfo;
 969     BOOL bSuccess = FALSE;
 970
 971     if (items != 3)
 972         Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
 973
 974     cmd = SvPV_nolen(ST(0));
 975     args = SvPV_nolen(ST(1));
 976
 977     env = PerlEnv_get_childenv();
 978     dir = PerlEnv_get_childdir();
 979
 980     memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
 981     stStartInfo.cb = sizeof(stStartInfo);           /* Set the structure size */
 982     stStartInfo.dwFlags = STARTF_USESHOWWINDOW;     /* Enable wShowWindow control */
 983     stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
 984
 985     if (CreateProcess(
 986                 cmd,                    /* Image path */
 987                 args,                   /* Arguments for command line */
 988                 NULL,                   /* Default process security */
 989                 NULL,                   /* Default thread security */
 990                 FALSE,                  /* Must be TRUE to use std handles */
 991                 NORMAL_PRIORITY_CLASS,  /* No special scheduling */
 992                 env,                    /* Inherit our environment block */
 993                 dir,                    /* Inherit our currrent directory */
 994                 &stStartInfo,           /* -> Startup info */
 995                 &stProcInfo))           /* <- Process info (if OK) */
 996     {
 997         int pid = (int)stProcInfo.dwProcessId;
 998         if (IsWin95() && pid < 0)
 999             pid = -pid;
1000         sv_setiv(ST(2), pid);
1001         CloseHandle(stProcInfo.hThread);/* library source code does this. */
1002         bSuccess = TRUE;
1003     }
1004     PerlEnv_free_childenv(env);
1005     PerlEnv_free_childdir(dir);
1006     XSRETURN_IV(bSuccess);
1007 }
1008
1009 XS(w32_GetTickCount)
1010 {
1011     dXSARGS;
1012     DWORD msec = GetTickCount();
1013     EXTEND(SP,1);
1014     if ((IV)msec > 0)
1015         XSRETURN_IV(msec);
1016     XSRETURN_NV(msec);
1017 }
1018
1019 XS(w32_GetShortPathName)
1020 {
1021     dXSARGS;
1022     SV *shortpath;
1023     DWORD len;
1024
1025     if (items != 1)
1026         Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
1027
1028     shortpath = sv_mortalcopy(ST(0));
1029     SvUPGRADE(shortpath, SVt_PV);
1030     if (!SvPVX(shortpath) || !SvLEN(shortpath))
1031         XSRETURN_UNDEF;
1032
1033     /* src == target is allowed */
1034     do {
1035         len = GetShortPathName(SvPVX(shortpath),
1036                                SvPVX(shortpath),
1037                                SvLEN(shortpath));
1038     } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
1039     if (len) {
1040         SvCUR_set(shortpath,len);
1041         *SvEND(shortpath) = '\0';
1042         ST(0) = shortpath;
1043         XSRETURN(1);
1044     }
1045     XSRETURN_UNDEF;
1046 }
1047
1048 XS(w32_GetFullPathName)
1049 {
1050     dXSARGS;
1051     SV *filename;
1052     SV *fullpath;
1053     char *filepart;
1054     DWORD len;
1055     STRLEN filename_len;
1056     char *filename_p;
1057
1058     if (items != 1)
1059         Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
1060
1061     filename = ST(0);
1062     filename_p = SvPV(filename, filename_len);
1063     fullpath = sv_2mortal(newSVpvn(filename_p, filename_len));
1064     if (!SvPVX(fullpath) || !SvLEN(fullpath))
1065         XSRETURN_UNDEF;
1066
1067     do {
1068         len = GetFullPathName(SvPVX(filename),
1069                               SvLEN(fullpath),
1070                               SvPVX(fullpath),
1071                               &filepart);
1072     } while (len >= SvLEN(fullpath) && sv_grow(fullpath,len+1));
1073     if (len) {
1074         if (GIMME_V == G_ARRAY) {
1075             EXTEND(SP,1);
1076             if (filepart) {
1077                 XST_mPV(1,filepart);
1078                 len = filepart - SvPVX(fullpath);
1079             }
1080             else {
1081                 XST_mPVN(1,"",0);
1082             }
1083             items = 2;
1084         }
1085         SvCUR_set(fullpath,len);
1086         *SvEND(fullpath) = '\0';
1087         ST(0) = fullpath;
1088         XSRETURN(items);
1089     }
1090     XSRETURN_EMPTY;
1091 }
1092
1093 XS(w32_GetLongPathName)
1094 {
1095     dXSARGS;
1096     SV *path;
1097     char tmpbuf[MAX_PATH+1];
1098     char *pathstr;
1099     STRLEN len;
1100
1101     if (items != 1)
1102         Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
1103
1104     path = ST(0);
1105     pathstr = SvPV(path,len);
1106     strcpy(tmpbuf, pathstr);
1107     pathstr = win32_longpath(tmpbuf);
1108     if (pathstr) {
1109         ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
1110         XSRETURN(1);
1111     }
1112     XSRETURN_EMPTY;
1113 }
1114
1115 XS(w32_Sleep)
1116 {
1117     dXSARGS;
1118     if (items != 1)
1119         Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
1120     Sleep(SvIV(ST(0)));
1121     XSRETURN_YES;
1122 }
1123
1124 XS(w32_CopyFile)
1125 {
1126     dXSARGS;
1127     BOOL bResult;
1128     char szSourceFile[MAX_PATH+1];
1129
1130     if (items != 3)
1131         Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
1132     strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));
1133     bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));
1134     if (bResult)
1135         XSRETURN_YES;
1136     XSRETURN_NO;
1137 }
1138
1139 XS(boot_Win32)
1140 {
1141     dXSARGS;
1142     char *file = __FILE__;
1143
1144     if (g_osver.dwOSVersionInfoSize == 0) {
1145         g_osver.dwOSVersionInfoSize = sizeof(g_osver);
1146         GetVersionEx(&g_osver);
1147     }
1148
1149     newXS("Win32::LookupAccountName", w32_LookupAccountName, file);
1150     newXS("Win32::LookupAccountSID", w32_LookupAccountSID, file);
1151     newXS("Win32::InitiateSystemShutdown", w32_InitiateSystemShutdown, file);
1152     newXS("Win32::AbortSystemShutdown", w32_AbortSystemShutdown, file);
1153     newXS("Win32::ExpandEnvironmentStrings", w32_ExpandEnvironmentStrings, file);
1154     newXS("Win32::MsgBox", w32_MsgBox, file);
1155     newXS("Win32::LoadLibrary", w32_LoadLibrary, file);
1156     newXS("Win32::FreeLibrary", w32_FreeLibrary, file);
1157     newXS("Win32::GetProcAddress", w32_GetProcAddress, file);
1158     newXS("Win32::RegisterServer", w32_RegisterServer, file);
1159     newXS("Win32::UnregisterServer", w32_UnregisterServer, file);
1160     newXS("Win32::GetArchName", w32_GetArchName, file);
1161     newXS("Win32::GetChipName", w32_GetChipName, file);
1162     newXS("Win32::GuidGen", w32_GuidGen, file);
1163     newXS("Win32::GetFolderPath", w32_GetFolderPath, file);
1164     newXS("Win32::IsAdminUser", w32_IsAdminUser, file);
1165     newXS("Win32::GetFileVersion", w32_GetFileVersion, file);
1166
1167     newXS("Win32::GetCwd", w32_GetCwd, file);
1168     newXS("Win32::SetCwd", w32_SetCwd, file);
1169     newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
1170     newXS("Win32::GetLastError", w32_GetLastError, file);
1171     newXS("Win32::SetLastError", w32_SetLastError, file);
1172     newXS("Win32::LoginName", w32_LoginName, file);
1173     newXS("Win32::NodeName", w32_NodeName, file);
1174     newXS("Win32::DomainName", w32_DomainName, file);
1175     newXS("Win32::FsType", w32_FsType, file);
1176     newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
1177     newXS("Win32::IsWinNT", w32_IsWinNT, file);
1178     newXS("Win32::IsWin95", w32_IsWin95, file);
1179     newXS("Win32::FormatMessage", w32_FormatMessage, file);
1180     newXS("Win32::Spawn", w32_Spawn, file);
1181     newXS("Win32::GetTickCount", w32_GetTickCount, file);
1182     newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
1183     newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
1184     newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
1185     newXS("Win32::CopyFile", w32_CopyFile, file);
1186     newXS("Win32::Sleep", w32_Sleep, file);
1187 #ifdef __CYGWIN__
1188     newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
1189 #endif
1190
1191     XSRETURN_YES;
1192 }