Fix [perl #66970] Incorrect coderef in MODIFY_CODE_ATTRIBUTES
[p5sagit/p5-mst-13.2.git] / ext / Win32 / Win32.xs
index cf3c8fe..ae2bad2 100644 (file)
@@ -37,48 +37,73 @@ typedef BOOL (__stdcall *PFNAllocateAndInitializeSid)(PSID_IDENTIFIER_AUTHORITY,
                                                       DWORD, DWORD, DWORD, DWORD, DWORD, DWORD, PSID*);
 typedef BOOL (__stdcall *PFNEqualSid)(PSID, PSID);
 typedef void* (__stdcall *PFNFreeSid)(PSID);
-typedef BOOL (__stdcall *PFNIsUserAnAdmin)();
+typedef BOOL (__stdcall *PFNIsUserAnAdmin)(void);
 
-#ifndef CSIDL_FLAG_CREATE
-#   define CSIDL_FLAG_CREATE               0x8000
+#ifndef CSIDL_MYMUSIC
+#   define CSIDL_MYMUSIC              0x000D
 #endif
-
-#ifndef CSIDL_ADMINTOOLS
-#   define CSIDL_ADMINTOOLS           0x0030
-#   define CSIDL_COMMON_ADMINTOOLS    0x002F
-#   define CSIDL_COMMON_APPDATA       0x0023
-#   define CSIDL_COMMON_DOCUMENTS     0x002E
-#   define CSIDL_COMMON_TEMPLATES     0x002D
+#ifndef CSIDL_MYVIDEO
+#   define CSIDL_MYVIDEO              0x000E
+#endif
+#ifndef CSIDL_LOCAL_APPDATA
 #   define CSIDL_LOCAL_APPDATA        0x001C
+#endif
+#ifndef CSIDL_COMMON_FAVORITES
+#   define CSIDL_COMMON_FAVORITES     0x001F
+#endif
+#ifndef CSIDL_INTERNET_CACHE
+#   define CSIDL_INTERNET_CACHE       0x0020
+#endif
+#ifndef CSIDL_COOKIES
+#   define CSIDL_COOKIES              0x0021
+#endif
+#ifndef CSIDL_HISTORY
+#   define CSIDL_HISTORY              0x0022
+#endif
+#ifndef CSIDL_COMMON_APPDATA
+#   define CSIDL_COMMON_APPDATA       0x0023
+#endif
+#ifndef CSIDL_WINDOWS
+#   define CSIDL_WINDOWS              0x0024
+#endif
+#ifndef CSIDL_PROGRAM_FILES
+#   define CSIDL_PROGRAM_FILES        0x0026
+#endif
+#ifndef CSIDL_MYPICTURES
 #   define CSIDL_MYPICTURES           0x0027
+#endif
+#ifndef CSIDL_PROFILE
 #   define CSIDL_PROFILE              0x0028
-#   define CSIDL_PROGRAM_FILES        0x0026
+#endif
+#ifndef CSIDL_PROGRAM_FILES_COMMON
 #   define CSIDL_PROGRAM_FILES_COMMON 0x002B
-#   define CSIDL_WINDOWS              0x0024
 #endif
-
-#ifndef CSIDL_CDBURN_AREA
-#   define CSIDL_CDBURN_AREA          0x003B
+#ifndef CSIDL_COMMON_TEMPLATES
+#   define CSIDL_COMMON_TEMPLATES     0x002D
+#endif
+#ifndef CSIDL_COMMON_DOCUMENTS
+#   define CSIDL_COMMON_DOCUMENTS     0x002E
+#endif
+#ifndef CSIDL_COMMON_ADMINTOOLS
+#   define CSIDL_COMMON_ADMINTOOLS    0x002F
+#endif
+#ifndef CSIDL_ADMINTOOLS
+#   define CSIDL_ADMINTOOLS           0x0030
 #endif
-
 #ifndef CSIDL_COMMON_MUSIC
 #   define CSIDL_COMMON_MUSIC         0x0035
 #endif
-
 #ifndef CSIDL_COMMON_PICTURES
 #   define CSIDL_COMMON_PICTURES      0x0036
 #endif
-
 #ifndef CSIDL_COMMON_VIDEO
 #   define CSIDL_COMMON_VIDEO         0x0037
 #endif
-
-#ifndef CSIDL_MYMUSIC
-#   define CSIDL_MYMUSIC              0x000D
+#ifndef CSIDL_CDBURN_AREA
+#   define CSIDL_CDBURN_AREA          0x003B
 #endif
-
-#ifndef CSIDL_MYVIDEO
-#   define CSIDL_MYVIDEO              0x000E
+#ifndef CSIDL_FLAG_CREATE
+#   define CSIDL_FLAG_CREATE          0x8000
 #endif
 
 /* Use explicit struct definition because wSuiteMask and
@@ -133,9 +158,9 @@ sv_to_wstr(pTHX_ SV *sv)
     char *str = SvPV(sv, len);
     UINT cp = SvUTF8(sv) ? CP_UTF8 : CP_ACP;
 
-    wlen = MultiByteToWideChar(cp, 0, str, len+1, NULL, 0);
+    wlen = MultiByteToWideChar(cp, 0, str, (int)(len+1), NULL, 0);
     New(0, wstr, wlen, WCHAR);
-    MultiByteToWideChar(cp, 0, str, len+1, wstr, wlen);
+    MultiByteToWideChar(cp, 0, str, (int)(len+1), wstr, wlen);
 
     return wstr;
 }
@@ -146,7 +171,7 @@ sv_to_wstr(pTHX_ SV *sv)
 SV *
 wstr_to_sv(pTHX_ WCHAR *wstr)
 {
-    size_t wlen = wcslen(wstr)+1;
+    int wlen = (int)wcslen(wstr)+1;
     BOOL use_default = FALSE;
     int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, NULL, 0, NULL, NULL);
     SV *sv = sv_2mortal(newSV(len));
@@ -277,7 +302,7 @@ my_ansipath(const WCHAR *widename)
 {
     char *name;
     BOOL use_default = FALSE;
-    size_t widelen = wcslen(widename)+1;
+    int widelen = (int)wcslen(widename)+1;
     int len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, widename, widelen,
                                   NULL, 0, NULL, NULL);
     New(0, name, len, char);
@@ -594,8 +619,8 @@ XS(w32_InitiateSystemShutdown)
     }
 
     message = SvPV_nolen(ST(1));
-    bRet = InitiateSystemShutdownA(machineName, message,
-                                   SvIV(ST(2)), SvIV(ST(3)), SvIV(ST(4)));
+    bRet = InitiateSystemShutdownA(machineName, message, (DWORD)SvIV(ST(2)),
+                                   (BOOL)SvIV(ST(3)), (BOOL)SvIV(ST(4)));
 
     /* Disable shutdown privilege. */
     tkp.Privileges[0].Attributes = 0; 
@@ -655,7 +680,7 @@ XS(w32_MsgBox)
        croak("usage: Win32::MsgBox($message [, $flags [, $title]]);\n");
 
     if (items > 1)
-        flags = SvIV(ST(1));
+        flags = (DWORD)SvIV(ST(1));
 
     if (IsWin2000()) {
         WCHAR *title = NULL;
@@ -685,7 +710,11 @@ XS(w32_LoadLibrary)
     if (items != 1)
        croak("usage: Win32::LoadLibrary($libname)\n");
     hHandle = LoadLibraryA(SvPV_nolen(ST(0)));
-    XSRETURN_IV((long)hHandle);
+#ifdef _WIN64
+    XSRETURN_IV((DWORD_PTR)hHandle);
+#else
+    XSRETURN_IV((DWORD)hHandle);
+#endif
 }
 
 XS(w32_FreeLibrary)
@@ -779,7 +808,7 @@ XS(w32_GuidGen)
     if (SUCCEEDED(hr)) {
        LPOLESTR pStr = NULL;
        if (SUCCEEDED(StringFromCLSID(&guid, &pStr))) {
-            WideCharToMultiByte(CP_ACP, 0, pStr, wcslen(pStr), szGUID,
+            WideCharToMultiByte(CP_ACP, 0, pStr, (int)wcslen(pStr), szGUID,
                                 sizeof(szGUID), NULL, NULL);
             CoTaskMemFree(pStr);
             XSRETURN_PV(szGUID);
@@ -800,7 +829,7 @@ XS(w32_GetFolderPath)
     if (items != 1 && items != 2)
        croak("usage: Win32::GetFolderPath($csidl [, $create])\n");
 
-    folder = SvIV(ST(0));
+    folder = (int)SvIV(ST(0));
     if (items == 2)
         create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0;
 
@@ -1087,7 +1116,7 @@ XS(w32_SetLastError)
     dXSARGS;
     if (items != 1)
        Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
-    SetLastError(SvIV(ST(0)));
+    SetLastError((DWORD)SvIV(ST(0)));
     XSRETURN_EMPTY;
 }
 
@@ -1153,8 +1182,10 @@ XS(w32_DomainName)
            DWORD   wki100_ver_major;
            DWORD   wki100_ver_minor;
        } *pwi;
+       DWORD retval;
+       retval = pfnNetWkstaGetInfo(NULL, 100, &pwi);
        /* NERR_Success *is* 0*/
-       if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) {
+       if (retval == 0) {
            if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
                WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup,
                                    -1, (LPSTR)dname, dnamelen, NULL, NULL);
@@ -1168,6 +1199,7 @@ XS(w32_DomainName)
            XSRETURN_PV(dname);
        }
        FreeLibrary(module);
+       SetLastError(retval);
     }
     else {
        /* Win95 doesn't have NetWksta*(), so do it the old way */
@@ -1217,17 +1249,17 @@ XS(w32_GetOSVersion)
     if (GIMME_V == G_SCALAR) {
         XSRETURN_IV(g_osver.dwPlatformId);
     }
-    XPUSHs(newSVpvn(g_osver.szCSDVersion, strlen(g_osver.szCSDVersion)));
+    XPUSHs(sv_2mortal(newSVpvn(g_osver.szCSDVersion, strlen(g_osver.szCSDVersion))));
 
-    XPUSHs(newSViv(g_osver.dwMajorVersion));
-    XPUSHs(newSViv(g_osver.dwMinorVersion));
-    XPUSHs(newSViv(g_osver.dwBuildNumber));
-    XPUSHs(newSViv(g_osver.dwPlatformId));
+    XPUSHs(sv_2mortal(newSViv(g_osver.dwMajorVersion)));
+    XPUSHs(sv_2mortal(newSViv(g_osver.dwMinorVersion)));
+    XPUSHs(sv_2mortal(newSViv(g_osver.dwBuildNumber)));
+    XPUSHs(sv_2mortal(newSViv(g_osver.dwPlatformId)));
     if (g_osver_ex) {
-        XPUSHs(newSViv(g_osver.wServicePackMajor));
-        XPUSHs(newSViv(g_osver.wServicePackMinor));
-        XPUSHs(newSViv(g_osver.wSuiteMask));
-        XPUSHs(newSViv(g_osver.wProductType));
+        XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMajor)));
+        XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMinor)));
+        XPUSHs(sv_2mortal(newSViv(g_osver.wSuiteMask)));
+        XPUSHs(sv_2mortal(newSViv(g_osver.wProductType)));
     }
     PUTBACK;
 }
@@ -1256,7 +1288,7 @@ XS(w32_FormatMessage)
        Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
 
     if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
-                       &source, SvIV(ST(0)), 0,
+                       &source, (DWORD)SvIV(ST(0)), 0,
                        msgbuf, sizeof(msgbuf)-1, NULL))
     {
         XSRETURN_PV(msgbuf);
@@ -1337,7 +1369,7 @@ XS(w32_GetShortPathName)
         WCHAR *wlong = sv_to_wstr(aTHX_ ST(0));
         len = GetShortPathNameW(wlong, wshort, countof(wshort));
         Safefree(wlong);
-        if (len < sizeof(wshort)) {
+        if (len && len < sizeof(wshort)) {
             ST(0) = wstr_to_sv(aTHX_ wshort);
             XSRETURN(1);
         }
@@ -1353,7 +1385,7 @@ XS(w32_GetShortPathName)
     do {
        len = GetShortPathName(SvPVX(shortpath),
                               SvPVX(shortpath),
-                              SvLEN(shortpath));
+                              (DWORD)SvLEN(shortpath));
     } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
     if (len) {
        SvCUR_set(shortpath,len);
@@ -1522,7 +1554,7 @@ XS(w32_Sleep)
     dXSARGS;
     if (items != 1)
        Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
-    Sleep(SvIV(ST(0)));
+    Sleep((DWORD)SvIV(ST(0)));
     XSRETURN_YES;
 }
 
@@ -1558,6 +1590,13 @@ XS(w32_OutputDebugString)
     XSRETURN_EMPTY;
 }
 
+XS(w32_GetCurrentProcessId)
+{
+    dXSARGS;
+    EXTEND(SP,1);
+    XSRETURN_IV(GetCurrentProcessId());
+}
+
 XS(w32_GetCurrentThreadId)
 {
     dXSARGS;
@@ -1669,6 +1708,7 @@ BOOT:
     newXS("Win32::CopyFile", w32_CopyFile, file);
     newXS("Win32::Sleep", w32_Sleep, file);
     newXS("Win32::OutputDebugString", w32_OutputDebugString, file);
+    newXS("Win32::GetCurrentProcessId", w32_GetCurrentProcessId, file);
     newXS("Win32::GetCurrentThreadId", w32_GetCurrentThreadId, file);
     newXS("Win32::CreateDirectory", w32_CreateDirectory, file);
     newXS("Win32::CreateFile", w32_CreateFile, file);