From 655152ba964dc9bbe407b309d5e23060ae38aed4 Mon Sep 17 00:00:00 2001 From: bulk88 Date: Fri, 18 Oct 2024 07:46:01 -0400 Subject: [PATCH 1/3] add LoadLibrary("winhttp.dll")-fix GCC 8.3.0 link fail in blead perl When compiling blead perl 5.41 with GCC 8.3.0 i686, Win32.xs has a link failure breaking blead. C:/Strawberry/c/bin/../lib/gcc/i686-w64-mingw32/8.3.0/../../../../i686-w64-mingw 32/bin/ld.exe: C:\sources\perl5\cpan\Win32/Win32.xs:1880: undefined reference to `WinHttpQueryHeaders@24' Switch to loading winhttp.dll on demand with GetProcAddrees, not static DLL linking. Plus winhttp.dll has a huge tree of sub-dependency DLLs to many other MS WinOS DLLs. Most Win32.pm users and most perl.exe processes instances will never call Win32::HttpGetFile. Win32::HttpGetFile is a great feature, but it will never have the usage demand of Win32::GetLastError() for example, so load it on demand. Fixing the GCC link failure is most important. This patch minimalistic to get blead perl+GCC to compile. I see other cleanup that can be done but this patch is minimalistic. Reference count the DLL Library handle for ithread reasons and libperl unloads. --- Win32.xs | 289 ++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 273 insertions(+), 16 deletions(-) diff --git a/Win32.xs b/Win32.xs index 3166c29..910f54b 100644 --- a/Win32.xs +++ b/Win32.xs @@ -26,6 +26,19 @@ # define WC_NO_BEST_FIT_CHARS 0x00000400 #endif +#ifdef WINHTTPAPI + +#define MY_CXT_KEY "Win32::Win32pm_guts" +typedef struct { + HMODULE winhttp; +} my_cxt_t; + +START_MY_CXT + +XS(w32_HttpGetFile); + +#endif + #define GETPROC(fn) pfn##fn = (PFN##fn)GetProcAddress(module, #fn) typedef int (__stdcall *PFNDllRegisterServer)(void); @@ -35,6 +48,137 @@ typedef BOOL (WINAPI *PFNGetProductInfo)(DWORD, DWORD, DWORD, DWORD, DWORD*); typedef void (WINAPI *PFNGetNativeSystemInfo)(LPSYSTEM_INFO lpSystemInfo); typedef LONG (WINAPI *PFNRegGetValueA)(HKEY, LPCSTR, LPCSTR, DWORD, LPDWORD, PVOID, LPDWORD); +#ifdef WINHTTPAPI + +typedef BOOL (__stdcall * PFNWinHttpCrackUrl) ( +LPCWSTR pwszUrl, +DWORD dwUrlLength, +DWORD dwFlags, +LPURL_COMPONENTS lpUrlComponents +); + +typedef HINTERNET (__stdcall * PFNWinHttpOpen) ( +LPCWSTR pszAgentW, +DWORD dwAccessType, +LPCWSTR pszProxyW, +LPCWSTR pszProxyBypassW, +DWORD dwFlags +); + +typedef BOOL (__stdcall * PFNWinHttpCloseHandle) ( +HINTERNET hInternet +); + +typedef HINTERNET (__stdcall * PFNWinHttpConnect) ( +HINTERNET hSession, +LPCWSTR pswzServerName, +INTERNET_PORT nServerPort, +DWORD dwReserved +); + +typedef BOOL (__stdcall * PFNWinHttpReadData) ( +HINTERNET hRequest, +LPVOID lpBuffer, +DWORD dwNumberOfBytesToRead, +LPDWORD lpdwNumberOfBytesRead +); + +typedef BOOL (__stdcall * PFNWinHttpSetOption) ( +HINTERNET hInternet, +DWORD dwOption, +LPVOID lpBuffer, +DWORD dwBufferLength +); + +typedef HINTERNET (__stdcall * PFNWinHttpOpenRequest) ( +HINTERNET hConnect, +LPCWSTR pwszVerb, +LPCWSTR pwszObjectName, +LPCWSTR pwszVersion, +LPCWSTR pwszReferrer OPTIONAL, +LPCWSTR FAR * ppwszAcceptTypes, +DWORD dwFlags +); + +typedef BOOL (__stdcall * PFNWinHttpAddRequestHeaders) ( +HINTERNET hRequest, +LPCWSTR lpszHeaders, +DWORD dwHeadersLength, +DWORD dwModifiers +); + +typedef BOOL (__stdcall * PFNWinHttpSendRequest) ( +HINTERNET hRequest, +LPCWSTR lpszHeaders, +DWORD dwHeadersLength, +LPVOID lpOptional, +DWORD dwOptionalLength, +DWORD dwTotalLength, +DWORD_PTR dwContext +); + +typedef BOOL (__stdcall * PFNWinHttpReceiveResponse) ( +HINTERNET hRequest, +LPVOID lpReserved +); + +typedef BOOL (__stdcall * PFNWinHttpQueryHeaders) ( + HINTERNET hRequest, + DWORD dwInfoLevel, + LPCWSTR pwszName, + LPVOID lpBuffer, + LPDWORD lpdwBufferLength, + LPDWORD lpdwIndex +); + +typedef BOOL (__stdcall * PFNWinHttpGetProxyForUrl) ( + HINTERNET hSession, + LPCWSTR lpcwszUrl, + WINHTTP_AUTOPROXY_OPTIONS * pAutoProxyOptions, + WINHTTP_PROXY_INFO * pProxyInfo +); + +volatile LONG WinHttpRefCnt = 0; +volatile LONG WinHttpLoaded = 0; +PFNWinHttpCrackUrl pfnWinHttpCrackUrl = NULL; +PFNWinHttpOpen pfnWinHttpOpen = NULL; +PFNWinHttpCloseHandle pfnWinHttpCloseHandle = NULL; +PFNWinHttpConnect pfnWinHttpConnect = NULL; +PFNWinHttpReadData pfnWinHttpReadData = NULL; +PFNWinHttpSetOption pfnWinHttpSetOption = NULL; +PFNWinHttpOpenRequest pfnWinHttpOpenRequest = NULL; +PFNWinHttpAddRequestHeaders pfnWinHttpAddRequestHeaders = NULL; +PFNWinHttpSendRequest pfnWinHttpSendRequest = NULL; +PFNWinHttpReceiveResponse pfnWinHttpReceiveResponse = NULL; +PFNWinHttpQueryHeaders pfnWinHttpQueryHeaders = NULL; +PFNWinHttpGetProxyForUrl pfnWinHttpGetProxyForUrl = NULL; + + +static void DecRefWinHttp() { + LONG old = InterlockedDecrement(&WinHttpRefCnt); + if(old == 0) { + old = InterlockedExchange(&WinHttpLoaded,1); + if(old != 1) { + pfnWinHttpCrackUrl = NULL; + pfnWinHttpOpen = NULL; + pfnWinHttpCloseHandle = NULL; + pfnWinHttpConnect = NULL; + pfnWinHttpReadData = NULL; + pfnWinHttpSetOption = NULL; + pfnWinHttpOpenRequest = NULL; + pfnWinHttpAddRequestHeaders = NULL; + pfnWinHttpSendRequest = NULL; + pfnWinHttpReceiveResponse = NULL; + pfnWinHttpQueryHeaders = NULL; + pfnWinHttpGetProxyForUrl = NULL; + InterlockedExchange(&WinHttpLoaded,0); + } + } +} + +#endif + + #ifndef CSIDL_MYMUSIC # define CSIDL_MYMUSIC 0x000D #endif @@ -1705,7 +1849,117 @@ XS(w32_IsDeveloperModeEnabled) XSRETURN_NO; } +XS(w32_CLONE) +{ + dXSARGS; +#ifdef WINHTTPAPI + HMODULE h; + WCHAR buf [MAX_PATH*2]; /* times 2 why not? 32KB paths one day lol*/ + + { + MY_CXT_CLONE; /* a redundant memcpy() on this line */ + h = MY_CXT.winhttp; + if(h) { /* bump ref count on dll */ + InterlockedIncrement(&WinHttpRefCnt); + if(!GetModuleFileNameW(h, (WCHAR *)buf, (sizeof(buf)/sizeof(WCHAR))-1)) { + DecRefWinHttp(); + Perl_croak_nocontext("Win32.pm WinHttp DLL load failed %u", GetLastError()); + } + h = LoadLibraryW((WCHAR *)buf); + MY_CXT.winhttp = h; + if(!h) { + DecRefWinHttp(); + Perl_croak_nocontext("Win32.pm WinHttp DLL load failed %u", GetLastError()); + } + } + } +#endif +} + +XS(w32_END) +{ + dXSARGS; + SP = MARK; + PUTBACK; #ifdef WINHTTPAPI + { + dMY_CXT; + HMODULE h = MY_CXT.winhttp; + if(h) { + MY_CXT.winhttp = NULL; + DecRefWinHttp(); + FreeLibrary(h); + } + } +#endif +} + +#ifdef WINHTTPAPI + +XS(w32_StubLoadWinHttp) { + HMODULE module; + LONG old; + old = InterlockedCompareExchange(&WinHttpLoaded, 1, 0); + if(old) { + retry: + if(old == 1) { + Sleep(1); + old = WinHttpLoaded; + goto retry; + } + else if(old == 2) { + InterlockedIncrement(&WinHttpRefCnt); + module = LoadLibraryW(L"winhttp"); + if(!module) { + DecRefWinHttp(); + Perl_croak_nocontext("Win32.pm WinHttp DLL load failed %u", GetLastError()); + } + else { + dMY_CXT; + MY_CXT.winhttp = module; + CvXSUB(cv) = w32_HttpGetFile; + w32_HttpGetFile(aTHX_ cv); + return; + } + } + else { + Perl_croak_nocontext("Win32.pm WinHttp thread race load failure state %u", old); + } + } + InterlockedIncrement(&WinHttpRefCnt); + module = LoadLibraryW(L"winhttp"); + if(!module) { + InterlockedExchange(&WinHttpLoaded, 3); + DecRefWinHttp(); + InterlockedExchange(&WinHttpLoaded, 3); + Perl_croak_nocontext("Win32.pm WinHttp DLL load failed %u", GetLastError()); + } + GETPROC(WinHttpCrackUrl); + GETPROC(WinHttpOpen); + GETPROC(WinHttpCloseHandle); + GETPROC(WinHttpConnect); + GETPROC(WinHttpReadData); + GETPROC(WinHttpSetOption); + GETPROC(WinHttpOpenRequest); + GETPROC(WinHttpAddRequestHeaders); + GETPROC(WinHttpSendRequest); + GETPROC(WinHttpReceiveResponse); + GETPROC(WinHttpQueryHeaders); + GETPROC(WinHttpGetProxyForUrl); + old = InterlockedExchange(&WinHttpLoaded, 2); + if(old != 1) { + DecRefWinHttp(); + FreeLibrary(module); + Perl_croak_nocontext("Win32.pm WinHttp thread race load failure state %u", old); + } + else { + dMY_CXT; + MY_CXT.winhttp = module; + CvXSUB(cv) = w32_HttpGetFile; + w32_HttpGetFile(aTHX_ cv); + return; + } +} XS(w32_HttpGetFile) { @@ -1747,7 +2001,7 @@ XS(w32_HttpGetFile) urlComp.dwExtraInfoLength = (DWORD)-1; /* Parse the URL. */ - bParsed = WinHttpCrackUrl(url, (DWORD)wcslen(url), 0, &urlComp); + bParsed = pfnWinHttpCrackUrl(url, (DWORD)wcslen(url), 0, &urlComp); /* Only support http and htts, not ftp, gopher, etc. */ if (bParsed @@ -1767,7 +2021,7 @@ XS(w32_HttpGetFile) urlPath[urlComp.dwUrlPathLength + urlComp.dwExtraInfoLength] = 0; /* Use WinHttpOpen to obtain a session handle. */ - hSession = WinHttpOpen(L"Perl", + hSession = pfnWinHttpOpen(L"Perl", WINHTTP_ACCESS_TYPE_NO_PROXY, WINHTTP_NO_PROXY_NAME, WINHTTP_NO_PROXY_BYPASS, @@ -1776,14 +2030,14 @@ XS(w32_HttpGetFile) /* Specify an HTTP server. */ if (hSession) - hConnect = WinHttpConnect(hSession, + hConnect = pfnWinHttpConnect(hSession, hostName, urlComp.nPort, 0); /* Create an HTTP request handle. */ if (hConnect) - hRequest = WinHttpOpenRequest(hConnect, + hRequest = pfnWinHttpOpenRequest(hConnect, L"GET", urlPath, NULL, @@ -1801,7 +2055,7 @@ XS(w32_HttpGetFile) | SECURITY_FLAG_IGNORE_CERT_DATE_INVALID | SECURITY_FLAG_IGNORE_UNKNOWN_CA | SECURITY_FLAG_IGNORE_CERT_WRONG_USAGE; - if(!WinHttpSetOption(hRequest, + if(!pfnWinHttpSetOption(hRequest, WINHTTP_OPTION_SECURITY_FLAGS, &secFlags, sizeof(secFlags))) { @@ -1828,11 +2082,11 @@ XS(w32_HttpGetFile) WINHTTP_AUTO_DETECT_TYPE_DNS_A; AutoProxyOptions.fAutoLogonIfChallenged = TRUE; - if(WinHttpGetProxyForUrl(hSession, + if(pfnWinHttpGetProxyForUrl(hSession, url, &AutoProxyOptions, &ProxyInfo)) { - if(!WinHttpSetOption(hRequest, + if(!pfnWinHttpSetOption(hRequest, WINHTTP_OPTION_PROXY, &ProxyInfo, cbProxyInfoSize)) { @@ -1846,7 +2100,7 @@ XS(w32_HttpGetFile) /* Send a request. */ if (hRequest && !bAborted) - bResults = WinHttpSendRequest(hRequest, + bResults = pfnWinHttpSendRequest(hRequest, WINHTTP_NO_ADDITIONAL_HEADERS, 0, WINHTTP_NO_REQUEST_DATA, @@ -1856,12 +2110,12 @@ XS(w32_HttpGetFile) /* End the request. */ if (bResults) - bResults = WinHttpReceiveResponse(hRequest, NULL); + bResults = pfnWinHttpReceiveResponse(hRequest, NULL); /* Retrieve HTTP status code. */ if (bResults) { dwQuerySize = sizeof(dwHttpStatusCode); - bResults = WinHttpQueryHeaders(hRequest, + bResults = pfnWinHttpQueryHeaders(hRequest, WINHTTP_QUERY_STATUS_CODE | WINHTTP_QUERY_FLAG_NUMBER, WINHTTP_HEADER_NAME_BY_INDEX, &dwHttpStatusCode, @@ -1873,7 +2127,7 @@ XS(w32_HttpGetFile) if (bResults) { dwQuerySize = ONE_K_BUFSIZE * 2 - 2; ZeroMemory(&msgbuf, ONE_K_BUFSIZE * 2); - bResults = WinHttpQueryHeaders(hRequest, + bResults = pfnWinHttpQueryHeaders(hRequest, WINHTTP_QUERY_STATUS_TEXT, WINHTTP_HEADER_NAME_BY_INDEX, msgbuf, @@ -1915,7 +2169,7 @@ XS(w32_HttpGetFile) /* Keep checking for data until there is nothing left. */ while (1) { - if (!WinHttpReadData(hRequest, + if (!pfnWinHttpReadData(hRequest, (LPVOID)pszOutBuffer, dwSize, &dwDownloaded)) { @@ -1956,9 +2210,9 @@ XS(w32_HttpGetFile) /* Close any open handles. */ if (hOut != INVALID_HANDLE_VALUE) CloseHandle(hOut); - if (hRequest) WinHttpCloseHandle(hRequest); - if (hConnect) WinHttpCloseHandle(hConnect); - if (hSession) WinHttpCloseHandle(hSession); + if (hRequest) pfnWinHttpCloseHandle(hRequest); + if (hConnect) pfnWinHttpCloseHandle(hConnect); + if (hSession) pfnWinHttpCloseHandle(hSession); Safefree(url); Safefree(file); @@ -2088,7 +2342,10 @@ BOOT: newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file); #endif #ifdef WINHTTPAPI - newXS("Win32::HttpGetFile", w32_HttpGetFile, file); + newXS("Win32::HttpGetFile", w32_StubLoadWinHttp, file); + newXS("Win32::CLONE", w32_CLONE, file); + newXS("Win32::END", w32_END, file); + MY_CXT_INIT; #endif XSRETURN_YES; } From ae46273042db8b0332530facb5ff6203d40a7381 Mon Sep 17 00:00:00 2001 From: bulk88 Date: Sun, 20 Oct 2024 11:04:20 -0400 Subject: [PATCH 2/3] fix ANSI->WIDE conv bugs, fix HttpGetFile heap corruption+optimize -sv_to_wstr_len(), if input is low ASCII clean, or basically UTF BMP clean just guess the initial WIDE buffer, and run through MultiByteToWideChar() only once for perfomance. Dont translate the same string twice. Non-BMP can't be guessed ahead. -sv_to_wstr_len() handle error codes from MBTWC correctly, die() if UTF-8 with UTF surrogates code points and other nasties, can't continue execution if there was no UTF16 output -add shortcuts for empty string to code page converters -dont use ST() over and over, nothing will realloc the PL stack -dont keep Newx() mem blocks on C stack for long periods incase PL die() -dont use Newx() for smallish length capped strings, C stack is better faster and leak proof -original pull req says the proxy code is untested, but Safefree() is wrong on a MS native pointer, and instant "panic: free to wrong pool" if you try it, MS API docs say GlobalFree() is correct -ProxyInfo.lpszProxy and friend, lift pointer, NULL it, then free it, incase struct ProxyInfo is used in future code refactors or its C scope lasts longer -Perl-exception-proof DESTROY all winhttp.dll handles and the CreateFile() handle and WCHAR * file, with SVMG -store LPCWSTR acceptTypes[] as const, its mis declared in MS API docs -even though HGF is sync I/O, async I/O is TODO, spin perl's event loop with HGF_ASYNC_CHECK(); either %SIG{ALRM} can fire or some perl Win32 GUI app will be more responsive than the current situation -"ZeroMemory(&msgbuf, ONE_K_BUFSIZE * 2);" totally redundant, we aren't using PP my $str = "\x00" x 1024; pack('p',$str); here, 1 WIDE null char is enough for all APIs. Win32 API never determines output buffer length, by counting null bytes. -CloseHandle() the file before DeleteFile(), perhaps lock vio was here b4. -CloseHandle() before returning, mortal SVs get freed at PP ";"s, not at every token. -wcsncpy(msgbuf", L"unable"), src is fixed length, use Move(); -GIMME_V is a getter function not a macro, don't call it multiple times -don't ret any SV *s if caller will ignore them with G_VOID -don't convert and alloc the extended WCHAR msgbuf if its empty string This was tested with "$ENV{PERL_WIN32_INTERNET_OK} = 1;" --- Win32.xs | 478 ++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 382 insertions(+), 96 deletions(-) diff --git a/Win32.xs b/Win32.xs index 910f54b..ab146cc 100644 --- a/Win32.xs +++ b/Win32.xs @@ -20,6 +20,37 @@ # define countof(array) (sizeof (array) / sizeof (*(array))) #endif +/* 128KB minus some breathing room to actually touch/alloc/vivify 128KB, only + right under that amount. We don't want byte 0x20000 to be alloced or + writeable since 4096-1 will be wasted. + + "alloca((_l)+PTRSIZE)" guards against off-by-one, and + writing a ASCII or WIDE NULL into theoretical unalloced mem. + If the croak executes, something is really wrong, since the entire Win32 + revolves around struct UNICODE_STRING and its USHORT Length field. + Depending on WinOS version, MS API bugs, legacy behaviour, and specific + API func name, 0x7FFF or 0xFFFF is max legal input. + + Lets just cap this API at 0xFFFF-PTRSIZE, unless a good reason is found + to delivery a 0xFFFF long string to the Win API. + + 128KB limit allows about 2 ASCII strings, or 1 WIDE string at almost + MAX LEN. And you can combine 2 buffers into 1 chkstk()/alloca() func call. + + 128KB limit is also to prevent too much C stack expansion/vivify + and anti-abuse, since the C stack wont shrink after expansion, and Win32 + default limit is 1 MB. + + If production code hits the croak, it needs to be refactored with a + C stack buf initial buf len MAX_PATH+1, or 4096 initial length. + If API retval failure/buf overflow error, then + do a "FetchLength(NULL, &my_strlen)", and "malloc()" something and retry, + or if string length in context is unreasonable, do a "croak()". +*/ +#define SAFE_ALLOCA(_l,_t) ((_l)*sizeof(_t) > (((0xFFFF-PTRSIZE)*2)-PTRSIZE) ? \ + (croak_sub_glr(cv, "alloca", ERROR_BUFFER_OVERFLOW),NULL) \ + : alloca(((_l)*sizeof(_t))+PTRSIZE)) + #define SE_SHUTDOWN_NAMEA "SeShutdownPrivilege" #ifndef WC_NO_BEST_FIT_CHARS @@ -50,6 +81,19 @@ typedef LONG (WINAPI *PFNRegGetValueA)(HKEY, LPCSTR, LPCSTR, DWORD, LPDWORD, PVO #ifdef WINHTTPAPI +/* Pump perl's event loop as a good citizen, Win32 GUIs or SIG ALRM + GetTickCount() is extremely fast but slow updates (15 ms or worse) since it + fetchs a value from shared RO global kernel memory, but 30 ms or 60 ms + resolution is much more than we need. If GetTickCount() overflows after + 45 days (don't ask how that happened), because unsigned comparison, + conditional still triggers, new time stored, and hgf_async_check() runs + 1x only, needlessly, at less than every 333 ms. */ +#define HGF_ASYNC_CHECK if( (cur = GetTickCount())-last > 333 \ + || PL_sig_pending) {\ + last = cur; \ + hgf_async_check(aTHX); \ +} + typedef BOOL (__stdcall * PFNWinHttpCrackUrl) ( LPCWSTR pwszUrl, DWORD dwUrlLength, @@ -153,6 +197,74 @@ PFNWinHttpReceiveResponse pfnWinHttpReceiveResponse = NULL; PFNWinHttpQueryHeaders pfnWinHttpQueryHeaders = NULL; PFNWinHttpGetProxyForUrl pfnWinHttpGetProxyForUrl = NULL; +typedef struct { + HINTERNET hSession; + HINTERNET hConnect; + HINTERNET hRequest; + WCHAR *file; + HANDLE hOut; +} HGF_DTOR_T; + +typedef struct { + WINHTTP_AUTOPROXY_OPTIONS AutoProxyOptions; + WINHTTP_PROXY_INFO ProxyInfo; +} HGF_PXYINFO_T; + +static int hgf_free(pTHX_ SV* sv, MAGIC* mg) { + HANDLE h; + WCHAR *file; + DWORD e = GetLastError(); + HGF_DTOR_T * dtor = (HGF_DTOR_T *)mg->mg_ptr; + HINTERNET hi = dtor->hRequest; + if(hi) { + dtor->hRequest = NULL; + pfnWinHttpCloseHandle(hi); + } + hi = dtor->hConnect; + if(hi) { + dtor->hConnect = NULL; + pfnWinHttpCloseHandle(hi); + } + hi = dtor->hSession; + if(hi) { + dtor->hSession = NULL; + pfnWinHttpCloseHandle(hi); + } + h = dtor->hOut; + if(h != INVALID_HANDLE_VALUE) { + dtor->hOut = INVALID_HANDLE_VALUE; + CloseHandle(h); + if(dtor->file) { + DeleteFileW(dtor->file); + } + } + file = dtor->file; + if(file) { + dtor->file = NULL; + Safefree(file); + } + SetLastError(e); + return 0; +} + +static int hgf_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) { + /* nothing can survive a ithread/psuedofork, no WinHttpDuplicateHandle() */ + HGF_DTOR_T * dtor = (HGF_DTOR_T *)mg->mg_ptr; + dtor->hRequest = NULL; + dtor->hConnect = NULL; + dtor->hSession = NULL; + dtor->file = NULL; + dtor->hOut = INVALID_HANDLE_VALUE; + return 0; +} + +const MGVTBL hgf_mg_vtbl = { 0, 0, 0, 0, hgf_free, 0, hgf_dup, 0 }; + +static void hgf_async_check(pTHX) { + DWORD e = GetLastError(); + win32_async_check(aTHX); + SetLastError(e); +} static void DecRefWinHttp() { LONG old = InterlockedDecrement(&WinHttpRefCnt); @@ -266,37 +378,119 @@ struct g_osver_t { } g_osver = {0, 0, 0, 0, 0, "", 0, 0, 0, 0, 0}; BOOL g_osver_ex = TRUE; +/* Croak with XSUB's name prefixed, taken from croak_xs_usage */ +#define croak_sub(_cv, _pv) S_croak_sub((_cv), (_pv)) +STATIC void +S_croak_sub(const CV *const cv, const char *const params) +{ +/* This executes so rarely, avoid overhead of passing my_perl in callers. */ + dTHX; + const GV *const gv = CvGV(cv); + + if (gv) { + const char *const gvname = GvNAME(gv); + const HV *const stash = GvSTASH(gv); + const char *const hvname = stash ? HvNAME(stash) : NULL; + + if (hvname) + Perl_croak_nocontext("%s::%s: %s", hvname, gvname, params); + else + Perl_croak_nocontext("%s: %s", gvname, params); + } else { + /* Pants. I don't think that it should be possible to get here. */ + Perl_croak_nocontext("CODE(0x%" UVxf "): %s", PTR2UV(cv), params); + } +} + +/* Croak with XSUB's name prefixed, taken from croak_xs_usage */ +#define croak_sub_glr(_cv, _syscallpv, _e) S_croak_sub_glr((_cv), (_syscallpv), (_e)) +STATIC void +S_croak_sub_glr(const CV *const cv, const char *const syscallpv, DWORD err) +{ + char buf [128+sizeof("%s GetLastError=%u %x ")+12+9]; + my_snprintf((char *)buf, sizeof(buf)-1, "%s GetLastError=%u %x ", + syscallpv, err, err); + croak_sub(cv, (const char *)buf); +} + #define ONE_K_BUFSIZE 1024 /* Convert SV to wide character string. The return value must be * freed using Safefree(). */ -WCHAR* -sv_to_wstr(pTHX_ SV *sv) +static WCHAR* +sv_to_wstr_len(pTHX_ const CV *const cv, SV *sv, STRLEN *plen) { DWORD wlen; WCHAR *wstr; STRLEN len; + DWORD e; char *str = SvPV(sv, len); UINT cp = SvUTF8(sv) ? CP_UTF8 : CP_ACP; + DWORD wlen_guess = len + 1; + + New(0, wstr, wlen_guess, WCHAR); + if (len == 0) { /* output WIDE string is obvious */ + *plen = 0; + wstr[0] = 0; + return wstr; + } + + wlen = MultiByteToWideChar(cp, 0, str, (int)(len+1), wstr, wlen_guess); + if(wlen == 0) { + e = GetLastError(); + if(e == ERROR_INSUFFICIENT_BUFFER) { /* not BMP ??? */ + wlen = MultiByteToWideChar(cp, 0, str, (int)(len+1), NULL, 0); + if(wlen == 0) /* probably illegal code point in some code page */ + goto croak; + wlen++; + Renew(wstr, wlen, WCHAR); + wlen = MultiByteToWideChar(cp, 0, str, (int)(len+1), wstr, wlen); + if (wlen == 0) { /* unknown err, but we have no output */ + goto croak; + } + *plen = wlen-1; + return wstr; + } + else /* probably illegal code point in some code page */ + goto croak_err; + } + *plen = wlen-1; + return wstr; - wlen = MultiByteToWideChar(cp, 0, str, (int)(len+1), NULL, 0); - New(0, wstr, wlen, WCHAR); - MultiByteToWideChar(cp, 0, str, (int)(len+1), wstr, wlen); + croak: + e = GetLastError(); - return wstr; + croak_err: + Safefree(wstr); + croak_sub_glr(cv, "MultiByteToWideChar", e); +} + +static WCHAR* +sv_to_wstr(pTHX_ const CV *const cv, SV *sv) { + STRLEN len; + return sv_to_wstr_len(aTHX_ cv, sv, &len); } /* Convert wide character string to mortal SV. Use UTF8 encoding * if the string cannot be represented in the system codepage. + * Arg len is in units of WCHAR not including WIDE null, just like MS APIs. + * Arg len IS NOT in units of bytes. If len is 0, wcslen() is called instead. */ SV * -wstr_to_sv(pTHX_ WCHAR *wstr) +wstr_to_sv(pTHX_ WCHAR *wstr, STRLEN len) { - int wlen = (int)wcslen(wstr)+1; + /* 2 GB-1 max, do len = 0 on overflow instead of croak for now, too rare */ + int wlen = len ? + ((((int)len) < 0 || len > (0x7FFFFFFF-1)) ? 1 : ((int)len)+1) + : ((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)); + SV *sv; + if(wlen == 1) { /* empty string */ + return sv_2mortal(newSVpvs("")); + } + len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, NULL, 0, NULL, NULL); + sv = sv_2mortal(newSV(len)); len = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wstr, wlen, SvPVX(sv), len, NULL, &use_default); if (use_default) { @@ -346,7 +540,7 @@ get_unicode_env(pTHX_ const WCHAR *name) equal = (towupper(entry[i]) == towupper(name[i])); if (equal) { - sv = wstr_to_sv(aTHX_ entry+name_len+1); + sv = wstr_to_sv(aTHX_ entry+name_len+1, 0); break; } entry += entry_len+1; @@ -470,9 +664,9 @@ XS(w32_ExpandEnvironmentStrings) if (items != 1) croak("usage: Win32::ExpandEnvironmentStrings($String)"); - source = sv_to_wstr(aTHX_ ST(0)); + source = sv_to_wstr(aTHX_ cv, ST(0)); ExpandEnvironmentStringsW(source, value, countof(value)-1); - ST(0) = wstr_to_sv(aTHX_ value); + ST(0) = wstr_to_sv(aTHX_ value, 0); Safefree(source); XSRETURN(1); } @@ -713,11 +907,11 @@ XS(w32_MsgBox) if (items < 1 || items > 3) croak("usage: Win32::MsgBox($message [, $flags [, $title]])"); - msg = sv_to_wstr(aTHX_ ST(0)); + msg = sv_to_wstr(aTHX_ cv, ST(0)); if (items > 1) flags = (DWORD)SvIV(ST(1)); if (items > 2) - title = sv_to_wstr(aTHX_ ST(2)); + title = sv_to_wstr(aTHX_ cv, ST(2)); result = MessageBoxW(GetActiveWindow(), msg, title ? title : L"Perl", flags); @@ -1110,7 +1304,7 @@ XS(w32_SetCwd) Perl_croak(aTHX_ "usage: Win32::SetCwd($cwd)"); if (SvUTF8(ST(0))) { - WCHAR *wide = sv_to_wstr(aTHX_ ST(0)); + WCHAR *wide = sv_to_wstr(aTHX_ cv, ST(0)); char *ansi = my_ansipath(wide); int rc = PerlDir_chdir(ansi); Safefree(wide); @@ -1175,7 +1369,7 @@ XS(w32_LoginName) EXTEND(SP,1); if (GetUserNameW(name, &size)) { - ST(0) = wstr_to_sv(aTHX_ name); + ST(0) = wstr_to_sv(aTHX_ name, 0); XSRETURN(1); } @@ -1380,12 +1574,12 @@ XS(w32_GetShortPathName) if (items != 1) Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)"); - wlong = sv_to_wstr(aTHX_ ST(0)); + wlong = sv_to_wstr(aTHX_ cv, ST(0)); len = GetShortPathNameW(wlong, wshort, countof(wshort)); Safefree(wlong); if (len && len < sizeof(wshort)) { - ST(0) = wstr_to_sv(aTHX_ wshort); + ST(0) = wstr_to_sv(aTHX_ wshort, 0); XSRETURN(1); } @@ -1413,7 +1607,7 @@ XS(w32_GetFullPathName) #if __CYGWIN__ || !defined(PERL_IMPLICIT_SYS) { - WCHAR *filename = sv_to_wstr(aTHX_ ST(0)); + WCHAR *filename = sv_to_wstr(aTHX_ cv, ST(0)); WCHAR full[2*MAX_PATH]; DWORD len = GetFullPathNameW(filename, countof(full), full, NULL); Safefree(filename); @@ -1432,7 +1626,7 @@ XS(w32_GetFullPathName) * XXX from UTF8 into the current codepage. */ if (SvUTF8(ST(0))) { - WCHAR *filename = sv_to_wstr(aTHX_ ST(0)); + WCHAR *filename = sv_to_wstr(aTHX_ cv, ST(0)); WCHAR *mappedname = PerlDir_mapW(filename); Safefree(filename); ansi = fullname = my_ansipath(mappedname); @@ -1496,14 +1690,14 @@ XS(w32_GetLongPathName) if (items != 1) Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)"); - wstr = sv_to_wstr(aTHX_ ST(0)); + wstr = sv_to_wstr(aTHX_ cv, ST(0)); 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); + ST(0) = wstr_to_sv(aTHX_ long_path, 0); XSRETURN(1); } } @@ -1519,7 +1713,7 @@ XS(w32_GetANSIPathName) if (items != 1) Perl_croak(aTHX_ "usage: Win32::GetANSIPathName($pathname)"); - wide_path = sv_to_wstr(aTHX_ ST(0)); + wide_path = sv_to_wstr(aTHX_ cv, ST(0)); ST(0) = wstr_to_ansipath(aTHX_ wide_path); Safefree(wide_path); XSRETURN(1); @@ -1561,7 +1755,7 @@ XS(w32_OutputDebugString) Perl_croak(aTHX_ "usage: Win32::OutputDebugString($string)"); if (SvUTF8(ST(0))) { - WCHAR *str = sv_to_wstr(aTHX_ ST(0)); + WCHAR *str = sv_to_wstr(aTHX_ cv, ST(0)); OutputDebugStringW(str); Safefree(str); } @@ -1598,7 +1792,7 @@ XS(w32_CreateDirectory) Perl_croak(aTHX_ "usage: Win32::CreateDirectory($dir)"); if (SvUTF8(ST(0))) { - WCHAR *dir = sv_to_wstr(aTHX_ ST(0)); + WCHAR *dir = sv_to_wstr(aTHX_ cv, ST(0)); result = CreateDirectoryW(dir, NULL); Safefree(dir); } @@ -1619,7 +1813,7 @@ XS(w32_CreateFile) Perl_croak(aTHX_ "usage: Win32::CreateFile($file)"); if (SvUTF8(ST(0))) { - WCHAR *file = sv_to_wstr(aTHX_ ST(0)); + WCHAR *file = sv_to_wstr(aTHX_ cv, ST(0)); handle = CreateFileW(file, GENERIC_WRITE, FILE_SHARE_WRITE, NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, NULL); Safefree(file); @@ -1964,7 +2158,11 @@ XS(w32_StubLoadWinHttp) { XS(w32_HttpGetFile) { dXSARGS; + U8 gimme_v; + MAGIC * mg; + HGF_DTOR_T * dtor; WCHAR *url = NULL, *file = NULL, *hostName = NULL, *urlPath = NULL; + STRLEN url_len, file_len; bool bIgnoreCertErrors = FALSE; WCHAR msgbuf[ONE_K_BUFSIZE]; BOOL bResults = FALSE; @@ -1977,18 +2175,38 @@ XS(w32_HttpGetFile) bFileError = FALSE, bHttpError = FALSE; DWORD error = 0; + DWORD cur = 0; + DWORD last = 0; URL_COMPONENTS urlComp; - LPCWSTR acceptTypes[] = { L"*/*", NULL }; + static const LPCWSTR acceptTypes[] = { L"*/*", NULL }; DWORD dwHttpStatusCode = 0, dwQuerySize = 0; + msgbuf[0] = '\0'; /* only first WCHAR, not entire buf, don't = {0} */ if (items < 2 || items > 3) - croak("usage: Win32::HttpGetFile($url, $file[, $ignore_cert_errors])"); - - url = sv_to_wstr(aTHX_ ST(0)); - file = sv_to_wstr(aTHX_ ST(1)); - - if (items == 3) - bIgnoreCertErrors = (BOOL)SvIV(ST(2)); + croak_xs_usage(cv, "url, file [, ignore_cert_errors]"); + mg = sv_magicext( sv_newmortal(), NULL, PERL_MAGIC_ext, &hgf_mg_vtbl, + NULL, 0); + New(0, dtor, 1 , HGF_DTOR_T); + mg->mg_ptr = (char *)dtor; + mg->mg_len = sizeof(HGF_DTOR_T); + mg->mg_flags |= MGf_DUP; + /* init struct with empty values */ + hgf_dup(aTHX_ mg, NULL); + + XSprePUSH; + SP++; + url = sv_to_wstr_len(aTHX_ cv, *SP, &url_len); + SAVEFREEPV(url); + SP++; + dtor->file = file = sv_to_wstr_len(aTHX_ cv, *SP, &file_len); + if (items == 3) { + SP++; + bIgnoreCertErrors = (BOOL)SvIV(*SP); + } + /* rewind SP, prep stack for retvals later, dont need incoming SV*s anymore */ + XSprePUSH; + /* paranoia, no PP callbacks or maybe PL stack realloc API calls, but w/e */ + PUTBACK; /* Initialize the URL_COMPONENTS structure, setting the required * component lengths to non-zero so that they get populated. @@ -2001,7 +2219,7 @@ XS(w32_HttpGetFile) urlComp.dwExtraInfoLength = (DWORD)-1; /* Parse the URL. */ - bParsed = pfnWinHttpCrackUrl(url, (DWORD)wcslen(url), 0, &urlComp); + bParsed = pfnWinHttpCrackUrl(url, (DWORD)url_len, 0, &urlComp); /* Only support http and htts, not ftp, gopher, etc. */ if (bParsed @@ -2012,14 +2230,24 @@ XS(w32_HttpGetFile) } if (bParsed) { - New(0, hostName, urlComp.dwHostNameLength + 1, WCHAR); - wcsncpy(hostName, urlComp.lpszHostName, urlComp.dwHostNameLength); - hostName[urlComp.dwHostNameLength] = 0; - - New(0, urlPath, urlComp.dwUrlPathLength + urlComp.dwExtraInfoLength + 1, WCHAR); - wcsncpy(urlPath, urlComp.lpszUrlPath, urlComp.dwUrlPathLength + urlComp.dwExtraInfoLength); - urlPath[urlComp.dwUrlPathLength + urlComp.dwExtraInfoLength] = 0; - + hostName = SAFE_ALLOCA(urlComp.dwHostNameLength + 1 + + urlComp.dwUrlPathLength + urlComp.dwExtraInfoLength + 1, + WCHAR); + Move( urlComp.lpszHostName, hostName, + urlComp.dwHostNameLength, WCHAR); + urlPath = hostName+urlComp.dwHostNameLength; + urlPath[0] = '\0'; + urlPath++; + + /* Note shortcut, we assume NOTHING is removed in URL + * "/Acme-Module-0.1.tar.gz?sessionid=12345" between "tar.gz" and "?". + * We don't use the urlComp.lpszExtraInfo WCHAR *, but we are using + * urlComp.dwExtraInfoLength length */ + Move( urlComp.lpszUrlPath, urlPath, + urlComp.dwUrlPathLength + urlComp.dwExtraInfoLength, WCHAR); + urlPath[urlComp.dwUrlPathLength + urlComp.dwExtraInfoLength] = '\0'; + + /* XXX Add perl version to UA or metadata is bad? */ /* Use WinHttpOpen to obtain a session handle. */ hSession = pfnWinHttpOpen(L"Perl", WINHTTP_ACCESS_TYPE_NO_PROXY, @@ -2029,23 +2257,33 @@ XS(w32_HttpGetFile) } /* Specify an HTTP server. */ - if (hSession) + if (hSession) { + dtor->hSession = hSession; hConnect = pfnWinHttpConnect(hSession, hostName, urlComp.nPort, 0); + } + HGF_ASYNC_CHECK; /* Create an HTTP request handle. */ - if (hConnect) + if (hConnect) { + dtor->hConnect = hConnect; hRequest = pfnWinHttpOpenRequest(hConnect, L"GET", urlPath, NULL, WINHTTP_NO_REFERER, - acceptTypes, + /* MS API wrong decl, this is RO input */ + (LPCWSTR *)acceptTypes, urlComp.nScheme == INTERNET_SCHEME_HTTPS ? WINHTTP_FLAG_SECURE : 0); + } + + HGF_ASYNC_CHECK; + if(hRequest) + dtor->hRequest = hRequest; /* If specified, disable certificate-related errors for https connections. */ if (hRequest @@ -2070,32 +2308,41 @@ XS(w32_HttpGetFile) * configuration, which the request handle will inherit from the session). */ if (hRequest && !bAborted) { - WINHTTP_AUTOPROXY_OPTIONS AutoProxyOptions; - WINHTTP_PROXY_INFO ProxyInfo; - DWORD cbProxyInfoSize = sizeof(ProxyInfo); - - ZeroMemory(&AutoProxyOptions, sizeof(AutoProxyOptions)); - ZeroMemory(&ProxyInfo, sizeof(ProxyInfo)); - AutoProxyOptions.dwFlags = WINHTTP_AUTOPROXY_AUTO_DETECT; - AutoProxyOptions.dwAutoDetectFlags = + HGF_PXYINFO_T pi; + + ZeroMemory(&pi, sizeof(pi)); /* null fill 2 structs, 1 func call */ + pi.AutoProxyOptions.dwFlags = WINHTTP_AUTOPROXY_AUTO_DETECT; + pi.AutoProxyOptions.dwAutoDetectFlags = WINHTTP_AUTO_DETECT_TYPE_DHCP | WINHTTP_AUTO_DETECT_TYPE_DNS_A; - AutoProxyOptions.fAutoLogonIfChallenged = TRUE; + pi.AutoProxyOptions.fAutoLogonIfChallenged = TRUE; if(pfnWinHttpGetProxyForUrl(hSession, url, - &AutoProxyOptions, - &ProxyInfo)) { + &pi.AutoProxyOptions, + &pi.ProxyInfo)) { + LPWSTR wProxyStr; if(!pfnWinHttpSetOption(hRequest, WINHTTP_OPTION_PROXY, - &ProxyInfo, - cbProxyInfoSize)) { + &pi.ProxyInfo, + sizeof(pi.ProxyInfo))) { bAborted = TRUE; Perl_warn(aTHX_ "Win32::HttpGetFile: setting proxy options failed"); } - Safefree(ProxyInfo.lpszProxy); - Safefree(ProxyInfo.lpszProxyBypass); +/* bug fixed, perl's Safefree() is not GlobalFree(), different mem pools, + different malloc-type headers before "your pointer" */ + wProxyStr = pi.ProxyInfo.lpszProxy; + if(wProxyStr) { + pi.ProxyInfo.lpszProxy = NULL; + GlobalFree(wProxyStr); + } + wProxyStr = pi.ProxyInfo.lpszProxyBypass; + if(wProxyStr) { + pi.ProxyInfo.lpszProxyBypass = NULL; + GlobalFree(wProxyStr); + } } + HGF_ASYNC_CHECK; } /* Send a request. */ @@ -2108,10 +2355,12 @@ XS(w32_HttpGetFile) 0, 0); + HGF_ASYNC_CHECK; /* End the request. */ if (bResults) bResults = pfnWinHttpReceiveResponse(hRequest, NULL); + HGF_ASYNC_CHECK; /* Retrieve HTTP status code. */ if (bResults) { dwQuerySize = sizeof(dwHttpStatusCode); @@ -2125,14 +2374,18 @@ XS(w32_HttpGetFile) /* Retrieve HTTP status text. Note this may be a success message. */ if (bResults) { - dwQuerySize = ONE_K_BUFSIZE * 2 - 2; - ZeroMemory(&msgbuf, ONE_K_BUFSIZE * 2); + dwQuerySize = (ONE_K_BUFSIZE * sizeof(WCHAR)) - sizeof(WCHAR); bResults = pfnWinHttpQueryHeaders(hRequest, WINHTTP_QUERY_STATUS_TEXT, WINHTTP_HEADER_NAME_BY_INDEX, msgbuf, &dwQuerySize, WINHTTP_NO_HEADER_INDEX); + if(bResults) { + msgbuf[dwQuerySize/sizeof(WCHAR)] = '\0'; + } else { + msgbuf[0] = '\0'; + } } /* There is no point in successfully downloading an error page from @@ -2145,6 +2398,7 @@ XS(w32_HttpGetFile) } } + HGF_ASYNC_CHECK; /* Create output file for download. */ if (bResults) { hOut = CreateFileW(file, @@ -2155,20 +2409,24 @@ XS(w32_HttpGetFile) FILE_ATTRIBUTE_NORMAL, NULL); - if (hOut == INVALID_HANDLE_VALUE) + if (hOut == INVALID_HANDLE_VALUE) { bFileError = TRUE; + } + else { + dtor->hOut = hOut; + } } if (!bFileError && bResults) { DWORD dwDownloaded = 0; DWORD dwBytesWritten = 0; - DWORD dwSize = 65536; - char *pszOutBuffer; - - New(0, pszOutBuffer, dwSize, char); + char OutBuffer [0xFFFF]; + DWORD dwSize = sizeof(OutBuffer); + char * pszOutBuffer = (char *)OutBuffer; /* Keep checking for data until there is nothing left. */ while (1) { + HGF_ASYNC_CHECK; if (!pfnWinHttpReadData(hRequest, (LPVOID)pszOutBuffer, dwSize, @@ -2192,7 +2450,6 @@ XS(w32_HttpGetFile) } - Safefree(pszOutBuffer); } else { bAborted = TRUE; @@ -2205,19 +2462,32 @@ XS(w32_HttpGetFile) /* If we successfully opened the output file but failed later, mark * the file for deletion. */ - if (bAborted && hOut != INVALID_HANDLE_VALUE) + if (bAborted && hOut != INVALID_HANDLE_VALUE) { + HANDLE h = hOut; + hOut = INVALID_HANDLE_VALUE; + dtor->hOut = INVALID_HANDLE_VALUE; + CloseHandle(h); (void) DeleteFileW(file); + } /* Close any open handles. */ - if (hOut != INVALID_HANDLE_VALUE) CloseHandle(hOut); + /* Do ASAP to flush disk file handle, and release all file locks. + FILE_SHARE_READ | FILE_SHARE_WRITE, are file locks themselves and + can block a future CreateFile/open(). When the SV mortal MG dtor + actually runs is questionable. It WILL run, but when vs open() ?*/ + if (hOut != INVALID_HANDLE_VALUE) { + HANDLE h = hOut; + hOut = INVALID_HANDLE_VALUE; + dtor->hOut = INVALID_HANDLE_VALUE; + CloseHandle(h); + } + + /* Just let the SV MG dtor do it if (hRequest) pfnWinHttpCloseHandle(hRequest); if (hConnect) pfnWinHttpCloseHandle(hConnect); if (hSession) pfnWinHttpCloseHandle(hSession); - - Safefree(url); - Safefree(file); - Safefree(hostName); - Safefree(urlPath); + if (file) Safefree(file); + */ /* Retrieve system and WinHttp error messages, or compose a user-defined * error code if we got a failed HTTP status text above. Conveniently, adding @@ -2229,39 +2499,55 @@ XS(w32_HttpGetFile) SetLastError(dwHttpStatusCode + 1000000000); } else { + DWORD msg_len; + dMY_CXT; DWORD msgFlags = bFileError ? FORMAT_MESSAGE_FROM_SYSTEM : FORMAT_MESSAGE_FROM_HMODULE; msgFlags |= FORMAT_MESSAGE_IGNORE_INSERTS; - - ZeroMemory(&msgbuf, ONE_K_BUFSIZE * 2); - if (!FormatMessageW(msgFlags, - GetModuleHandleW(L"winhttp.dll"), +/* "The WinHTTP Web Proxy Auto-Discovery Service detected a non- local RPC +request (Transport Type = %1); Access Denied. There may have been an rogue +attempt to gain access to the service through the network." at ~204 chars +is probably the longest, but i8ln. */ + msg_len = FormatMessageW(msgFlags, + MY_CXT.winhttp, /* HMODULE */ error, 0, msgbuf, ONE_K_BUFSIZE - 1, /* TCHARs, not bytes */ - NULL)) { - wcsncpy(msgbuf, L"unable to format error message", ONE_K_BUFSIZE - 1); + NULL); + if(msg_len) { + msgbuf[msg_len] = '\0'; /* paranoia */ + } + else { + DWORD msg_len = sizeof(L"unable to format error message"); + if(msg_len > sizeof(msgbuf)-1) /* assert will optimize out */ + croak_sub_glr(cv, "msgbuf", ERROR_BUFFER_OVERFLOW); + Move(L"unable to format error message", msgbuf, msg_len/2, WCHAR); } SetLastError(error); } } - if (GIMME_V == G_SCALAR) { - EXTEND(SP, 1); - ST(0) = !bAborted ? &PL_sv_yes : &PL_sv_no; - XSRETURN(1); - } - else if (GIMME_V == G_ARRAY) { - EXTEND(SP, 2); - ST(0) = !bAborted ? &PL_sv_yes : &PL_sv_no; - ST(1) = wstr_to_sv(aTHX_ msgbuf); - XSRETURN(2); - } - else { - XSRETURN_EMPTY; + gimme_v = GIMME_V; + SPAGAIN; /* paranoia */ + if(gimme_v != G_VOID) { + /* no EXTEND, 2 arg min check above */ + SV * sv = !bAborted ? &PL_sv_yes : &PL_sv_no; + PUSHs(sv); + if (gimme_v == G_ARRAY) { + if(msgbuf[0]) { + error = GetLastError(); + sv = wstr_to_sv(aTHX_ msgbuf, 0); + SetLastError(error); + } + else + sv = &PL_sv_no; + PUSHs(sv); + } } + PUTBACK; + return; } #endif From e49fe5a58d7ef7efb2ed226302dda5e71415ce38 Mon Sep 17 00:00:00 2001 From: bulk88 Date: Sun, 20 Oct 2024 20:15:28 -0400 Subject: [PATCH 3/3] restore Perl 5.6/5.8.9, MSVC 6, and Mingw GCC 3.4.5 compiling -preliminary delay loading of DLLs for ancient GCC Mingw.org, modern Mingw64 GCC, and MSVC, without using CC specific features. Notably old GCCs require a "dlltool" post 2010, to generate a .a from a .def. Strawberry 5.8.9's dlltool is too old. Plus politics by lead devs of Mingw64 and Mingw.org claiming delay loading is patented, or you can can fork ld, and ReactOS and WINE did fork ld, to add delay loaded DLLs as defined by MS ABI/PE spec. Strangely, MS API compliant __delayLoadHelper2 function, has been included for 15 years by both Mingw64 and Mingw.org in libmingwex.a or msvcrt.a, both projects won't explain why, and just reject all tickets and support requests on the topic. I have made working delay loading DLLs with GCC, but dlltool.exe distribution by 3rd party Mingw packagers is problematic. AFAIK both projects do not publish any gcc/ld Win32 binaries, so Strawberry Perl has always used unofficial 3rd party GCC binaries. The delay loading code here correctly ref counts DLLs on a psudofork/ithreads. Win32.pm static links too many DLLs most users will never call into. Infrastruture here allows more DLLs to be turned into delay loads beyond old CC old Perl requirements of delay load/runtime linking because of old CC .a/.lib files. Faster startup, less process unique memory with each DLL removed. w32ppport.h needs a code formatter run on it. Next step after this commit is winhttp.dll/HttpGetFile support, on 100% of Win32 Perls and CCs released in the last 20 years. Also keeping the fnc ptrs in MY_CXT vs true DLL/EXE global memory is for a future optimization. MY_CXT keeps some organization vs more complicated style of winhttp.dll fnc ptr storage, but a DllMain() and a CRITICAL_SECTION need to be added vs all these MY_CXT pointers and their indirection. Also certain groups of fnc ptrs must be fetch as a single unit, rather than the current 1 by 1 system. Using the offset into MY_CXT to find the initializer strings from the const struct, is highly efficient, and reduction arg counts at call sites for 1x ever executed branches. --- MANIFEST | 1 + Win32.xs | 526 +++++++++++++++++++++++++++++++++++++++------------- w32ppport.h | 289 +++++++++++++++++++++++++++++ 3 files changed, 682 insertions(+), 134 deletions(-) create mode 100644 w32ppport.h diff --git a/MANIFEST b/MANIFEST index 71e5686..fb3260d 100755 --- a/MANIFEST +++ b/MANIFEST @@ -6,6 +6,7 @@ README Win32.pm Win32.xs longpath.inc +w32ppport.h t/CodePage.t t/CreateFile.t t/ExpandEnvironmentStrings.t diff --git a/Win32.xs b/Win32.xs index ab146cc..db1bac7 100644 --- a/Win32.xs +++ b/Win32.xs @@ -5,16 +5,26 @@ #include #include #include -#include + +#if !defined(_MSC_VER) || (defined(_MSC_VER) && _MSC_VER >= 1300) +# include +#else +# define USERENV_API_DLL 1 +#endif + #include -#if !defined(__GNUC__) || (((100000 * __GNUC__) + (1000 * __GNUC_MINOR__)) >= 408000) + +#if (defined(_MSC_VER) && _MSC_VER >= 1400) || (((100000 * __GNUC__) + (1000 * __GNUC_MINOR__)) >= 408000) # include +#else +# define WINHTTP_API_DLL 1 #endif #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#include "w32ppport.h" #ifndef countof # define countof(array) (sizeof (array) / sizeof (*(array))) @@ -57,17 +67,238 @@ # define WC_NO_BEST_FIT_CHARS 0x00000400 #endif -#ifdef WINHTTPAPI + +#define croak_sub(_cv, _pv) S_croak_sub((_cv), (_pv)) +STATIC void S_croak_sub(const CV *const cv, const char *const params); + +#define dll_ref_inc(_cv, _hm) S_dll_ref_inc((_cv),(_hm)) +static void S_dll_ref_inc(CV * cv, HMODULE hmod) { + HANDLE h; + WCHAR buf [MAX_PATH*2]; /* times 2 why not? 32KB paths one day lol*/ + DWORD r = GetModuleFileNameW(hmod, (WCHAR *)buf, (sizeof(buf)/sizeof(WCHAR))-1); + if(!r) + croak_sub(cv, "dll_ref_inc"); + h = LoadLibraryW((WCHAR *)buf); + if(!h) + croak_sub(cv, "dll_ref_inc"); +} + +#define dll_ref_dec(_cv, _hm) S_dll_ref_dec((_cv),(_hm)) +static void S_dll_ref_dec(CV * cv, HMODULE * hmod) { + HMODULE h = *hmod; + if(h) { + *hmod = NULL; + if(!FreeLibrary(h)) + croak_sub(cv, "dll_ref_dec"); + } +} #define MY_CXT_KEY "Win32::Win32pm_guts" + typedef struct { + WCHAR * s32dir; +#ifdef WINHTTPAPI HMODULE winhttp; +#endif +#ifdef USERENV_API_DLL + HMODULE userenv; + PFNDestroyEnvironmentBlock pfnDestroyEnvironmentBlock; + PFNCreateEnvironmentBlock pfnCreateEnvironmentBlock; +#endif +#ifdef SHFOLDER_API_DLL + HMODULE shfolder; /* Win2k probably and up, shell32.dll will be here */ + PFNSHGetFolderPathW pfnSHGetFolderPathW; +#endif +#ifdef SHELL32_API_DLL + HMODULE shell32; + PFNSHGetSpecialFolderPathW pfnSHGetSpecialFolderPathW; +#endif +#ifdef USER32_API_DLL + HMODULE user32; + PFNMessageBoxW pfnMessageBoxW; + PFNGetSystemMetrics pfnGetSystemMetrics; + PFNGetActiveWindow pfnGetActiveWindow; +#endif +#ifdef NETAPI32_API_DLL + HMODULE netapi32; + PFNNetWkstaGetInfo pfnNetWkstaGetInfo; + PFNNetApiBufferFree pfnNetApiBufferFree; +#endif +#ifdef VERSION_API_DLL + HMODULE version; + PFNGetFileVersionInfoA pfnGetFileVersionInfoA; + PFNGetFileVersionInfoSizeA pfnGetFileVersionInfoSizeA; + PFNVerQueryValueA pfnVerQueryValueA; +#endif +#ifdef OLE32_API_DLL + HMODULE ole32; + PFNCoCreateGuid pfnCoCreateGuid; + PFNCoTaskMemFree pfnCoTaskMemFree; + PFNStringFromCLSID pfnStringFromCLSID; +#endif + USHORT s32dirlen; } my_cxt_t; -START_MY_CXT +START_MY_CXT; -XS(w32_HttpGetFile); +typedef struct { + WCHAR * s32dir; +#ifdef WINHTTPAPI + WCHAR *winhttp; +#endif +#ifdef USERENV_API_DLL + WCHAR *userenv; + char * pfnDestroyEnvironmentBlock; + char * pfnCreateEnvironmentBlock; +#endif +#ifdef SHFOLDER_API_DLL + WCHAR *shfolder; /* Win2k probably and up, shell32.dll will be here */ + char * pfnSHGetFolderPathW; +#endif +#ifdef SHELL32_API_DLL + WCHAR *shell32; + char * pfnSHGetSpecialFolderPathW; +#endif +#ifdef USER32_API_DLL + WCHAR *user32; + char * pfnMessageBoxW; + char * pfnGetSystemMetrics; + char * pfnGetActiveWindow; +#endif +#ifdef NETAPI32_API_DLL + WCHAR *netapi32; + char * pfnNetWkstaGetInfo; + char * pfnNetApiBufferFree; +#endif +#ifdef VERSION_API_DLL + WCHAR *version; + char * pfnGetFileVersionInfoA; + char * pfnGetFileVersionInfoSizeA; + char * pfnVerQueryValueA; +#endif +#ifdef OLE32_API_DLL + WCHAR *ole32; + char * pfnCoCreateGuid; + char * pfnCoTaskMemFree; + char * pfnStringFromCLSID; +#endif + USHORT s32dirlen; +} fntable_t; + +static const fntable_t fntable = { + L"", +#ifdef WINHTTPAPI + L"winhttp", +#endif +#ifdef USERENV_API_DLL + L"userenv", + "DestroyEnvironmentBlock", + "CreateEnvironmentBlock", +#endif +#ifdef SHFOLDER_API_DLL + L"shfolder", /* Win2k probably and up, shell32.dll will be here */ + "SHGetFolderPathW", +#endif +#ifdef SHELL32_API_DLL + L"shell32", + "SHGetSpecialFolderPathW", +#endif +#ifdef USER32_API_DLL + L"user32", + "MessageBoxW", + "GetSystemMetrics", + "GetActiveWindow", +#endif +#ifdef NETAPI32_API_DLL + L"netapi32", + "NetWkstaGetInfo", + "NetApiBufferFree", +#endif +#ifdef VERSION_API_DLL + L"version", + "GetFileVersionInfoA", + "GetFileVersionInfoSizeA", + "VerQueryValueA", +#endif +#ifdef OLE32_API_DLL + L"ole32", + "CoCreateGuid", + "CoTaskMemFree", + "StringFromCLSID", +#endif + 0 +}; + +#define CALLFN(_fn) (MY_CXT.pfn##_fn \ + ? MY_CXT.pfn##_fn \ + : (PFN##_fn)(get_fn(aTHX_ cv, ((void **)(&MY_CXT.pfn##_fn))))) + +static void * get_fn(pTHX_ CV * cv, void ** p_to_pfn) { + dMY_CXT; + void * fn; + DWORD idxfn = ((char**)p_to_pfn)-((char**)&MY_CXT); + char ** fnname = ((char **)&fntable)+idxfn; + char ** widedll = ((char **)&fntable)+idxfn; + while(widedll != (char **)&fntable) { + if(!(*widedll)[1]) {/* if 2nd byte this is a wide DLL name */ + DWORD idxhmod = ((char**)widedll)-((char **)&fntable); + HMODULE h = ((HMODULE *)&MY_CXT)[idxhmod]; + if(!h) { + WCHAR * trydll = (WCHAR *)*widedll; + /* Ancient redundant stub >= 2K, search the probably + already in address space shell32 first. */ + if(trydll == L"shfolder") { + trydll = L"shell32"; + h = LoadLibraryW((WCHAR *)*widedll); + if(!h) + croak_sub(cv, "LoadLibraryW"); + fn = (void *)GetProcAddress(h,*fnname); + if(!fn) { + FreeLibrary(h); + h = LoadLibraryW(L"shfolder"); + if(!h) + croak_sub(cv, "LoadLibraryW"); + else + ((HMODULE *)&MY_CXT)[idxhmod] = h; + fn = (void *)GetProcAddress(h,*fnname); + if(!fn) + croak_sub(cv, "GetProcAddress"); + else { + *p_to_pfn = fn; + return fn; + } + } + else { + ((HMODULE *)&MY_CXT)[idxhmod] = h; + *p_to_pfn = fn; + return fn; + } + } + else { + h = LoadLibraryW((WCHAR *)*widedll); + if(!h) + croak_sub(cv, "LoadLibraryW"); + else + ((HMODULE *)&MY_CXT)[idxhmod] = h; + } + } + fn = (void *)GetProcAddress(h,*fnname); + if(!fn) + croak_sub(cv, "GetProcAddress"); + else { + *p_to_pfn = fn; + return fn; + } + } + else + widedll--; + } + croak_sub(cv, "fntable"); + return NULL; +} +#ifdef WINHTTPAPI +XS(w32_HttpGetFile); #endif #define GETPROC(fn) pfn##fn = (PFN##fn)GetProcAddress(module, #fn) @@ -94,93 +325,6 @@ typedef LONG (WINAPI *PFNRegGetValueA)(HKEY, LPCSTR, LPCSTR, DWORD, LPDWORD, PVO hgf_async_check(aTHX); \ } -typedef BOOL (__stdcall * PFNWinHttpCrackUrl) ( -LPCWSTR pwszUrl, -DWORD dwUrlLength, -DWORD dwFlags, -LPURL_COMPONENTS lpUrlComponents -); - -typedef HINTERNET (__stdcall * PFNWinHttpOpen) ( -LPCWSTR pszAgentW, -DWORD dwAccessType, -LPCWSTR pszProxyW, -LPCWSTR pszProxyBypassW, -DWORD dwFlags -); - -typedef BOOL (__stdcall * PFNWinHttpCloseHandle) ( -HINTERNET hInternet -); - -typedef HINTERNET (__stdcall * PFNWinHttpConnect) ( -HINTERNET hSession, -LPCWSTR pswzServerName, -INTERNET_PORT nServerPort, -DWORD dwReserved -); - -typedef BOOL (__stdcall * PFNWinHttpReadData) ( -HINTERNET hRequest, -LPVOID lpBuffer, -DWORD dwNumberOfBytesToRead, -LPDWORD lpdwNumberOfBytesRead -); - -typedef BOOL (__stdcall * PFNWinHttpSetOption) ( -HINTERNET hInternet, -DWORD dwOption, -LPVOID lpBuffer, -DWORD dwBufferLength -); - -typedef HINTERNET (__stdcall * PFNWinHttpOpenRequest) ( -HINTERNET hConnect, -LPCWSTR pwszVerb, -LPCWSTR pwszObjectName, -LPCWSTR pwszVersion, -LPCWSTR pwszReferrer OPTIONAL, -LPCWSTR FAR * ppwszAcceptTypes, -DWORD dwFlags -); - -typedef BOOL (__stdcall * PFNWinHttpAddRequestHeaders) ( -HINTERNET hRequest, -LPCWSTR lpszHeaders, -DWORD dwHeadersLength, -DWORD dwModifiers -); - -typedef BOOL (__stdcall * PFNWinHttpSendRequest) ( -HINTERNET hRequest, -LPCWSTR lpszHeaders, -DWORD dwHeadersLength, -LPVOID lpOptional, -DWORD dwOptionalLength, -DWORD dwTotalLength, -DWORD_PTR dwContext -); - -typedef BOOL (__stdcall * PFNWinHttpReceiveResponse) ( -HINTERNET hRequest, -LPVOID lpReserved -); - -typedef BOOL (__stdcall * PFNWinHttpQueryHeaders) ( - HINTERNET hRequest, - DWORD dwInfoLevel, - LPCWSTR pwszName, - LPVOID lpBuffer, - LPDWORD lpdwBufferLength, - LPDWORD lpdwIndex -); - -typedef BOOL (__stdcall * PFNWinHttpGetProxyForUrl) ( - HINTERNET hSession, - LPCWSTR lpcwszUrl, - WINHTTP_AUTOPROXY_OPTIONS * pAutoProxyOptions, - WINHTTP_PROXY_INFO * pProxyInfo -); volatile LONG WinHttpRefCnt = 0; volatile LONG WinHttpLoaded = 0; @@ -198,6 +342,8 @@ PFNWinHttpQueryHeaders pfnWinHttpQueryHeaders = NULL; PFNWinHttpGetProxyForUrl pfnWinHttpGetProxyForUrl = NULL; typedef struct { + /* first 4 fields are NULL inited, so they are in a row for + SSE/AVX memset() instrinsic friendly */ HINTERNET hSession; HINTERNET hConnect; HINTERNET hRequest; @@ -250,6 +396,7 @@ static int hgf_free(pTHX_ SV* sv, MAGIC* mg) { static int hgf_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) { /* nothing can survive a ithread/psuedofork, no WinHttpDuplicateHandle() */ HGF_DTOR_T * dtor = (HGF_DTOR_T *)mg->mg_ptr; + /*4 NULLs in a row, SSE/AVX memset() instrinsic friendly */ dtor->hRequest = NULL; dtor->hConnect = NULL; dtor->hSession = NULL; @@ -378,8 +525,8 @@ struct g_osver_t { } g_osver = {0, 0, 0, 0, 0, "", 0, 0, 0, 0, 0}; BOOL g_osver_ex = TRUE; -/* Croak with XSUB's name prefixed, taken from croak_xs_usage */ -#define croak_sub(_cv, _pv) S_croak_sub((_cv), (_pv)) +/* Croak with XSUB's name prefixed, and any suffix string, taken from + croak_xs_usage */ STATIC void S_croak_sub(const CV *const cv, const char *const params) { @@ -443,6 +590,8 @@ sv_to_wstr_len(pTHX_ const CV *const cv, SV *sv, STRLEN *plen) wlen = MultiByteToWideChar(cp, 0, str, (int)(len+1), NULL, 0); if(wlen == 0) /* probably illegal code point in some code page */ goto croak; + /* null or paranoia, are inputs from supposed to have a + narrow nul byte that comes out as output*/ wlen++; Renew(wstr, wlen, WCHAR); wlen = MultiByteToWideChar(cp, 0, str, (int)(len+1), wstr, wlen); @@ -464,6 +613,7 @@ sv_to_wstr_len(pTHX_ const CV *const cv, SV *sv, STRLEN *plen) croak_err: Safefree(wstr); croak_sub_glr(cv, "MultiByteToWideChar", e); + return NULL; } static WCHAR* @@ -477,7 +627,7 @@ sv_to_wstr(pTHX_ const CV *const cv, SV *sv) { * Arg len is in units of WCHAR not including WIDE null, just like MS APIs. * Arg len IS NOT in units of bytes. If len is 0, wcslen() is called instead. */ -SV * +static SV * wstr_to_sv(pTHX_ WCHAR *wstr, STRLEN len) { /* 2 GB-1 max, do len = 0 on overflow instead of croak for now, too rare */ @@ -513,9 +663,12 @@ wstr_to_sv(pTHX_ WCHAR *wstr, STRLEN len) * overwrites it with the ANSI version, which contains replacement * characters for the characters not in the ANSI codepage. */ -SV* -get_unicode_env(pTHX_ const WCHAR *name) +static SV* +get_unicode_env(pTHX_ CV* cv, const WCHAR *name) { +#ifdef USERENV_API_DLL + dMY_CXT; +#endif SV *sv = NULL; void *env; HANDLE token; @@ -527,7 +680,12 @@ get_unicode_env(pTHX_ const WCHAR *name) } /* Create a Unicode environment block for this process */ + +#ifdef USERENV_API_DLL + if (CALLFN(CreateEnvironmentBlock)(&env, token, FALSE)) +#else if (CreateEnvironmentBlock(&env, token, FALSE)) +#endif { size_t name_len = wcslen(name); WCHAR *entry = (WCHAR *)env; @@ -545,7 +703,11 @@ get_unicode_env(pTHX_ const WCHAR *name) } entry += entry_len+1; } +#ifdef USERENV_API_DLL + CALLFN(DestroyEnvironmentBlock)(env); +#else DestroyEnvironmentBlock(env); +#endif } CloseHandle(token); return sv; @@ -620,7 +782,7 @@ wstr_to_ansipath(pTHX_ WCHAR *wstr) return sv; } -#ifdef __CYGWIN__ +#if defined(__CYGWIN__) || !(PERL_VERSION >= 8 || (PERL_VERSION == 7 && PERL_SUBVERSION >= 3)) char* get_childdir(void) @@ -651,7 +813,9 @@ free_childenv(void *d) PERL_UNUSED_ARG(d); } +#ifdef __CYGWIN__ # define PerlDir_mapA(dir) (dir) +#endif #endif @@ -850,9 +1014,9 @@ XS(w32_InitiateSystemShutdown) (BOOL)SvIV(ST(3)), (BOOL)SvIV(ST(4))); /* Disable shutdown privilege. */ - tkp.Privileges[0].Attributes = 0; + tkp.Privileges[0].Attributes = 0; AdjustTokenPrivileges(hToken, FALSE, &tkp, 0, - (PTOKEN_PRIVILEGES)NULL, 0); + (PTOKEN_PRIVILEGES)NULL, 0); CloseHandle(hToken); XSRETURN_IV(bRet); } @@ -1056,20 +1220,34 @@ XS(w32_GuidGen) GUID guid; char szGUID[50] = {'\0'}; HRESULT hr; +#ifdef OLE32_API_DLL + dMY_CXT; +#endif if (items) - Perl_croak(aTHX_ "usage: Win32::GuidGen()"); - + Perl_croak(aTHX_ "usage: Win32::GuidGen()"); +#ifdef OLE32_API_DLL + hr = CALLFN(CoCreateGuid)(&guid); +#else hr = CoCreateGuid(&guid); +#endif if (SUCCEEDED(hr)) { LPOLESTR pStr = NULL; +#ifdef OLE32_API_DLL + if (SUCCEEDED(CALLFN(StringFromCLSID)(&guid, &pStr))) { +#else #ifdef __cplusplus if (SUCCEEDED(StringFromCLSID(guid, &pStr))) { #else if (SUCCEEDED(StringFromCLSID(&guid, &pStr))) { +#endif #endif WideCharToMultiByte(CP_ACP, 0, pStr, (int)wcslen(pStr), szGUID, sizeof(szGUID), NULL, NULL); +#ifdef OLE32_API_DLL + CALLFN(CoTaskMemFree)(pStr); +#else CoTaskMemFree(pStr); +#endif XSRETURN_PV(szGUID); } } @@ -1078,6 +1256,9 @@ XS(w32_GuidGen) XS(w32_GetFolderPath) { +#if defined(SHFOLDER_API_DLL) || defined (SHELL32_API_DLL) + dMY_CXT; +#endif dXSARGS; WCHAR wpath[MAX_PATH+1]; int folder; @@ -1089,13 +1270,20 @@ XS(w32_GetFolderPath) folder = (int)SvIV(ST(0)); if (items == 2) create = SvTRUE(ST(1)) ? CSIDL_FLAG_CREATE : 0; - +#ifdef SHFOLDER_API_DLL + if (SUCCEEDED(CALLFN(SHGetFolderPathW)(NULL, folder|create, NULL, 0, wpath))) { +#else if (SUCCEEDED(SHGetFolderPathW(NULL, folder|create, NULL, 0, wpath))) { +#endif ST(0) = wstr_to_ansipath(aTHX_ wpath); XSRETURN(1); } +#ifdef SHELL32_API_DLL + if (CALLFN(SHGetSpecialFolderPathW)(NULL, wpath, folder, !!create)) { +#else if (SHGetSpecialFolderPathW(NULL, wpath, folder, !!create)) { +#endif ST(0) = wstr_to_ansipath(aTHX_ wpath); XSRETURN(1); } @@ -1185,11 +1373,11 @@ XS(w32_GetFolderPath) */ sv = NULL; switch (folder) { - case CSIDL_APPDATA: sv = get_unicode_env(aTHX_ L"APPDATA"); break; - case CSIDL_PROFILE: sv = get_unicode_env(aTHX_ L"USERPROFILE"); break; - case CSIDL_PROGRAM_FILES: sv = get_unicode_env(aTHX_ L"ProgramFiles"); break; - case CSIDL_PROGRAM_FILES_COMMON: sv = get_unicode_env(aTHX_ L"CommonProgramFiles"); break; - case CSIDL_WINDOWS: sv = get_unicode_env(aTHX_ L"SystemRoot"); break; + case CSIDL_APPDATA: sv = get_unicode_env(aTHX_ cv, L"APPDATA"); break; + case CSIDL_PROFILE: sv = get_unicode_env(aTHX_ cv, L"USERPROFILE"); break; + case CSIDL_PROGRAM_FILES: sv = get_unicode_env(aTHX_ cv, L"ProgramFiles"); break; + case CSIDL_PROGRAM_FILES_COMMON: sv = get_unicode_env(aTHX_ cv, L"CommonProgramFiles"); break; + case CSIDL_WINDOWS: sv = get_unicode_env(aTHX_ cv, L"SystemRoot"); break; } if (sv) { ST(0) = sv; @@ -1207,23 +1395,37 @@ XS(w32_GetFileVersion) DWORD handle; char *filename; char *data; +#ifdef VERSION_API_DLL + dMY_CXT; +#endif if (items != 1) croak("usage: Win32::GetFileVersion($filename)"); filename = SvPV_nolen(ST(0)); +#ifdef VERSION_API_DLL + size = CALLFN(GetFileVersionInfoSizeA)(filename, &handle); +#else size = GetFileVersionInfoSize(filename, &handle); +#endif if (!size) XSRETURN_UNDEF; New(0, data, size, char); if (!data) XSRETURN_UNDEF; - +#ifdef VERSION_API_DLL + if (CALLFN(GetFileVersionInfoA)(filename, handle, size, data)) { +#else if (GetFileVersionInfo(filename, handle, size, data)) { +#endif VS_FIXEDFILEINFO *info; UINT len; +#ifdef VERSION_API_DLL + if (CALLFN(VerQueryValueA)(data, "\\", (void**)&info, &len)) { +#else if (VerQueryValue(data, "\\", (void**)&info, &len)) { +#endif int dwValueMS1 = (info->dwFileVersionMS>>16); int dwValueMS2 = (info->dwFileVersionMS&0xffff); int dwValueLS1 = (info->dwFileVersionLS>>16); @@ -2046,46 +2248,101 @@ XS(w32_IsDeveloperModeEnabled) XS(w32_CLONE) { dXSARGS; -#ifdef WINHTTPAPI HMODULE h; WCHAR buf [MAX_PATH*2]; /* times 2 why not? 32KB paths one day lol*/ - - { - MY_CXT_CLONE; /* a redundant memcpy() on this line */ - h = MY_CXT.winhttp; - if(h) { /* bump ref count on dll */ - InterlockedIncrement(&WinHttpRefCnt); - if(!GetModuleFileNameW(h, (WCHAR *)buf, (sizeof(buf)/sizeof(WCHAR))-1)) { - DecRefWinHttp(); - Perl_croak_nocontext("Win32.pm WinHttp DLL load failed %u", GetLastError()); - } - h = LoadLibraryW((WCHAR *)buf); - MY_CXT.winhttp = h; - if(!h) { - DecRefWinHttp(); - Perl_croak_nocontext("Win32.pm WinHttp DLL load failed %u", GetLastError()); - } + WCHAR * wp; + WCHAR * wpnew; + DWORD len; + MY_CXT_CLONE; /* a redundant memcpy() on this line */ + wp = MY_CXT.s32dir; + if(wp) { + len = MY_CXT.s32dirlen+1; + New(0, wpnew, len, WCHAR); + MY_CXT.s32dir = wpnew; + Move(wp, wpnew, len, WCHAR); + } +#ifdef WINHTTPAPI + h = MY_CXT.winhttp; + if(h) { /* bump ref count on dll */ + InterlockedIncrement(&WinHttpRefCnt); + if(!GetModuleFileNameW(h, (WCHAR *)buf, (sizeof(buf)/sizeof(WCHAR))-1)) { + DecRefWinHttp(); + Perl_croak_nocontext("Win32.pm WinHttp DLL load failed %u", GetLastError()); + } + h = LoadLibraryW((WCHAR *)buf); + MY_CXT.winhttp = h; + if(!h) { + DecRefWinHttp(); + Perl_croak_nocontext("Win32.pm WinHttp DLL load failed %u", GetLastError()); } } #endif +#ifdef USERENV_API_DLL + dll_ref_inc(cv, MY_CXT.userenv); +#endif +#ifdef SHFOLDER_API_DLL + dll_ref_inc(cv, MY_CXT.shfolder); +#endif +#ifdef SHELL32_API_DLL + dll_ref_inc(cv, MY_CXT.shell32); +#endif +#ifdef USER32_API_DLL + dll_ref_inc(cv, MY_CXT.user32); +#endif +#ifdef NETAPI32_API_DLL + dll_ref_inc(cv, MY_CXT.netapi32); +#endif +#ifdef VERSION_API_DLL + dll_ref_inc(cv, MY_CXT.version); +#endif +#ifdef OLE32_API_DLL + dll_ref_inc(cv, MY_CXT.ole32); +#endif } XS(w32_END) { dXSARGS; - SP = MARK; - PUTBACK; -#ifdef WINHTTPAPI { dMY_CXT; - HMODULE h = MY_CXT.winhttp; + HMODULE h; + WCHAR * wp; + wp = MY_CXT.s32dir; + if(wp) { + MY_CXT.s32dir = NULL; + MY_CXT.s32dirlen = 0; + Safefree(wp); + } +#ifdef WINHTTPAPI + h = MY_CXT.winhttp; if(h) { MY_CXT.winhttp = NULL; DecRefWinHttp(); FreeLibrary(h); } - } #endif +#ifdef USERENV_API_DLL + dll_ref_dec(cv, &MY_CXT.userenv); +#endif +#ifdef SHFOLDER_API_DLL + dll_ref_dec(cv, &MY_CXT.shfolder); +#endif +#ifdef SHELL32_API_DLL + dll_ref_dec(cv, &MY_CXT.shell32); +#endif +#ifdef USER32_API_DLL + dll_ref_dec(cv, &MY_CXT.user32); +#endif +#ifdef NETAPI32_API_DLL + dll_ref_dec(cv, &MY_CXT.netapi32); +#endif +#ifdef VERSION_API_DLL + dll_ref_dec(cv, &MY_CXT.version); +#endif +#ifdef OLE32_API_DLL + dll_ref_dec(cv, &MY_CXT.ole32); +#endif + } } #ifdef WINHTTPAPI @@ -2558,8 +2815,9 @@ PROTOTYPES: DISABLE BOOT: { - const char *file = __FILE__; - + char *file = (char *)__FILE__; /* silence const warnings 5.6 */ + if(sizeof(my_cxt_t) != sizeof(fntable_t)) /* assert optize away*/ + croak_sub_glr(cv, "my_cxt_t fntable_t mismatch", ERROR_INSUFFICIENT_BUFFER); if (g_osver.dwOSVersionInfoSize == 0) { g_osver.dwOSVersionInfoSize = sizeof(g_osver); if (!GetVersionExA((OSVERSIONINFOA*)&g_osver)) { @@ -2629,9 +2887,9 @@ BOOT: #endif #ifdef WINHTTPAPI newXS("Win32::HttpGetFile", w32_StubLoadWinHttp, file); +#endif newXS("Win32::CLONE", w32_CLONE, file); newXS("Win32::END", w32_END, file); MY_CXT_INIT; -#endif XSRETURN_YES; } diff --git a/w32ppport.h b/w32ppport.h new file mode 100644 index 0000000..9fabcc6 --- /dev/null +++ b/w32ppport.h @@ -0,0 +1,289 @@ +#if !defined(my_snprintf) +# define my_snprintf S_my_snprintf +static int S_my_snprintf(char *buffer, const Size_t len, const char *format, ...) +{ + int retval; + va_list ap; + va_start(ap, format); +#ifdef HAS_VSNPRINTF + retval = vsnprintf(buffer, len, format, ap); +#else + retval = vsprintf(buffer, format, ap); +#endif + va_end(ap); + if (retval < 0 || (len > 0 && (Size_t)retval >= len)) + Perl_croak_nocontext("panic: my_snprintf buffer overflow"); + return retval; +} +#endif + +#ifndef newSVpvs +# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1) +#endif + +#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ + defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) + +#ifndef START_MY_CXT + +/* This must appear in all extensions that define a my_cxt_t structure, + * right after the definition (i.e. at file scope). The non-threads + * case below uses it to declare the data as static. */ +#define START_MY_CXT + +#if (PERL_BCDVERSION < 0x5004068) +/* Fetches the SV that keeps the per-interpreter data. */ +#define dMY_CXT_SV \ + SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE) +#else /* >= perl5.004_68 */ +#define dMY_CXT_SV \ + SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ + sizeof(MY_CXT_KEY)-1, TRUE) +#endif /* < perl5.004_68 */ + +/* This declaration should be used within all functions that use the + * interpreter-local data. */ +#define dMY_CXT \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) + +/* Creates and zeroes the per-interpreter data. + * (We allocate my_cxtp in a Perl SV so that it will be released when + * the interpreter goes away.) */ +#define MY_CXT_INIT \ + dMY_CXT_SV; \ + /* newSV() allocates one more than needed */ \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ + Zero(my_cxtp, 1, my_cxt_t); \ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) + +/* This macro must be used to access members of the my_cxt_t structure. + * e.g. MYCXT.some_data */ +#define MY_CXT (*my_cxtp) + +/* Judicious use of these macros can reduce the number of times dMY_CXT + * is used. Use is similar to pTHX, aTHX etc. */ +#define pMY_CXT my_cxt_t *my_cxtp +#define pMY_CXT_ pMY_CXT, +#define _pMY_CXT ,pMY_CXT +#define aMY_CXT my_cxtp +#define aMY_CXT_ aMY_CXT, +#define _aMY_CXT ,aMY_CXT + +#endif /* START_MY_CXT */ + +#ifndef MY_CXT_CLONE +/* Clones the per-interpreter data. */ +#define MY_CXT_CLONE \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ + Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) +#endif + +#else /* single interpreter */ + +#ifndef START_MY_CXT + +#define START_MY_CXT static my_cxt_t my_cxt; +#define dMY_CXT_SV dNOOP +#define dMY_CXT dNOOP +#define MY_CXT_INIT NOOP +#define MY_CXT my_cxt + +#define pMY_CXT void +#define pMY_CXT_ +#define _pMY_CXT +#define aMY_CXT +#define aMY_CXT_ +#define _aMY_CXT + +#endif /* START_MY_CXT */ + +#ifndef MY_CXT_CLONE +#define MY_CXT_CLONE NOOP +#endif + +#endif + +#ifndef PERL_UNUSED_ARG +# define PERL_UNUSED_ARG(x) ((void)x) +#endif + +#ifndef SE_PRIVILEGE_REMOVED +#define SE_PRIVILEGE_REMOVED 0x00000004 +#endif + +#ifndef RRF_RT_REG_DWORD +#define RRF_RT_REG_DWORD 0x00000010 +#endif + +#ifndef KEY_WOW64_64KEY +#define KEY_WOW64_64KEY 0x0100 +#endif + + +#if !defined(_MSC_VER) || !(defined(_MSC_VER) && _MSC_VER >= 1300) +# define SHFOLDER_API_DLL 1 +#endif + +#if defined(__GNUC__) && !(defined(_WIN32_IE) && _WIN32_IE >= 0x0400) +/* SHGetSpecialFolderPathW missing */ +# define SHELL32_API_DLL 1 +#endif + +#ifdef SHFOLDER_API_DLL +typedef HRESULT (__stdcall * PFNSHGetFolderPathW)(HWND, int, HANDLE, DWORD, LPWSTR); +#endif + +#ifdef USERENV_API_DLL +typedef BOOL(__stdcall * PFNDestroyEnvironmentBlock)(LPVOID lpEnvironment); +typedef BOOL(__stdcall * PFNCreateEnvironmentBlock)( + LPVOID *lpEnvironment, + HANDLE hToken, + BOOL bInherit); +#endif + +#ifdef SHELL32_API_DLL +typedef BOOL (__stdcall * PFNSHGetSpecialFolderPathW)( + HWND hwnd, + LPWSTR pszPath, + int csidl, + BOOL fCreate +); +#endif + +#ifdef USER32_API_DLL +typedef int (__stdcall * PFNMessageBoxW)( + HWND hWnd, + LPCWSTR lpText, + LPCWSTR lpCaption, + UINT uType +); +typedef int (__stdcall * PFNGetSystemMetrics)(int nIndex); +typedef HWND (__stdcall * PFNGetActiveWindow)(); +#endif + +#ifdef NETAPI32_API_DLL +typedef NET_API_STATUS (__stdcall * PFNNetWkstaGetInfo)( + LMSTR servername, + DWORD level, + LPBYTE *bufptr +); +typedef NET_API_STATUS (__stdcall * PFNNetApiBufferFree)(LPVOID Buffer); +#endif + +#ifdef VERSION_API_DLL +typedef BOOL (__stdcall * PFNGetFileVersionInfoA)( + LPCSTR lptstrFilename, + DWORD dwHandle, + DWORD dwLen, + LPVOID lpData +); +typedef DWORD (__stdcall * PFNGetFileVersionInfoSizeA)( +LPCSTR lptstrFilename, + LPDWORD lpdwHandle +); +typedef BOOL (__stdcall * PFNVerQueryValueA)( + LPCVOID pBlock, + LPCSTR lpSubBlock, + LPVOID *lplpBuffer, + PUINT puLen +); +#endif + +#ifdef OLE32_API_DLL +typedef HRESULT (__stdcall * PFNCoCreateGuid)(GUID *pguid); +typedef void (__stdcall * PFNCoTaskMemFree)(LPVOID pv); +typedef HRESULT (__stdcall * PFNStringFromCLSID)(REFCLSID rclsid,LPOLESTR *lplpsz); +#endif + +#ifdef WINHTTPAPI +typedef BOOL (__stdcall * PFNWinHttpCrackUrl) ( +LPCWSTR pwszUrl, +DWORD dwUrlLength, +DWORD dwFlags, +LPURL_COMPONENTS lpUrlComponents +); + +typedef HINTERNET (__stdcall * PFNWinHttpOpen) ( +LPCWSTR pszAgentW, +DWORD dwAccessType, +LPCWSTR pszProxyW, +LPCWSTR pszProxyBypassW, +DWORD dwFlags +); + +typedef BOOL (__stdcall * PFNWinHttpCloseHandle) ( +HINTERNET hInternet +); + +typedef HINTERNET (__stdcall * PFNWinHttpConnect) ( +HINTERNET hSession, +LPCWSTR pswzServerName, +INTERNET_PORT nServerPort, +DWORD dwReserved +); + +typedef BOOL (__stdcall * PFNWinHttpReadData) ( +HINTERNET hRequest, +LPVOID lpBuffer, +DWORD dwNumberOfBytesToRead, +LPDWORD lpdwNumberOfBytesRead +); + +typedef BOOL (__stdcall * PFNWinHttpSetOption) ( +HINTERNET hInternet, +DWORD dwOption, +LPVOID lpBuffer, +DWORD dwBufferLength +); + +typedef HINTERNET (__stdcall * PFNWinHttpOpenRequest) ( +HINTERNET hConnect, +LPCWSTR pwszVerb, +LPCWSTR pwszObjectName, +LPCWSTR pwszVersion, +LPCWSTR pwszReferrer OPTIONAL, +LPCWSTR FAR * ppwszAcceptTypes, +DWORD dwFlags +); + +typedef BOOL (__stdcall * PFNWinHttpAddRequestHeaders) ( +HINTERNET hRequest, +LPCWSTR lpszHeaders, +DWORD dwHeadersLength, +DWORD dwModifiers +); + +typedef BOOL (__stdcall * PFNWinHttpSendRequest) ( +HINTERNET hRequest, +LPCWSTR lpszHeaders, +DWORD dwHeadersLength, +LPVOID lpOptional, +DWORD dwOptionalLength, +DWORD dwTotalLength, +DWORD_PTR dwContext +); + +typedef BOOL (__stdcall * PFNWinHttpReceiveResponse) ( +HINTERNET hRequest, +LPVOID lpReserved +); + +typedef BOOL (__stdcall * PFNWinHttpQueryHeaders) ( + HINTERNET hRequest, + DWORD dwInfoLevel, + LPCWSTR pwszName, + LPVOID lpBuffer, + LPDWORD lpdwBufferLength, + LPDWORD lpdwIndex +); + +typedef BOOL (__stdcall * PFNWinHttpGetProxyForUrl) ( + HINTERNET hSession, + LPCWSTR lpcwszUrl, + WINHTTP_AUTOPROXY_OPTIONS * pAutoProxyOptions, + WINHTTP_PROXY_INFO * pProxyInfo +); +#endif