| /* |
| * R : A Computer Language for Statistical Data Analysis |
| * file extra.c |
| * Copyright (C) 1998--2003 Guido Masarotto and Brian Ripley |
| * Copyright (C) 2004 The R Foundation |
| * Copyright (C) 2005--2021 The R Core Team |
| * |
| * This program is free software; you can redistribute it and/or modify |
| * it under the terms of the GNU General Public License as published by |
| * the Free Software Foundation; either version 2 of the License, or |
| * (at your option) any later version. |
| * |
| * This program is distributed in the hope that it will be useful, |
| * but WITHOUT ANY WARRANTY; without even the implied warranty of |
| * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| * GNU General Public License for more details. |
| * |
| * You should have received a copy of the GNU General Public License |
| * along with this program; if not, a copy is available at |
| * https://www.R-project.org/Licenses/ |
| */ |
| |
| |
| /* extra commands for R */ |
| |
| #ifdef HAVE_CONFIG_H |
| #include <config.h> |
| #endif |
| |
| #include "win-nls.h" |
| |
| |
| #include <stdio.h> |
| #include <string.h> |
| #include <time.h> |
| #include "Defn.h" |
| #include <Internal.h> |
| #include "Fileio.h" |
| #include <direct.h> |
| #include "graphapp/ga.h" |
| #include "rlocale.h" |
| /* Mingw-w64 defines this to be 0x0502 */ |
| #ifndef _WIN32_WINNT |
| # define _WIN32_WINNT 0x0502 /* for GetLongPathName, KEY_WOW64_64KEY */ |
| #endif |
| #include <windows.h> |
| #include "rui.h" |
| #undef ERROR |
| #include <R_ext/RS.h> /* formerly for Calloc */ |
| |
| #include <winbase.h> |
| |
| |
| /* used in rui.c */ |
| void internal_shellexec(const char * file) |
| { |
| const char *home; |
| char home2[10000], *p; |
| uintptr_t ret; |
| |
| home = getenv("R_HOME"); |
| if (home == NULL) |
| error(_("R_HOME not set")); |
| strncpy(home2, home, 10000 - 1); |
| home2[10000 - 1] = '\0'; |
| for(p = home2; *p; p++) if(*p == '/') *p = '\\'; |
| ret = (uintptr_t) ShellExecute(NULL, "open", file, NULL, home2, SW_SHOW); |
| if(ret <= 32) { /* an error condition */ |
| if(ret == ERROR_FILE_NOT_FOUND || ret == ERROR_PATH_NOT_FOUND |
| || ret == SE_ERR_FNF || ret == SE_ERR_PNF) |
| error(_("'%s' not found"), file); |
| if(ret == SE_ERR_ASSOCINCOMPLETE || ret == SE_ERR_NOASSOC) |
| error(_("file association for '%s' not available or invalid"), |
| file); |
| if(ret == SE_ERR_ACCESSDENIED || ret == SE_ERR_SHARE) |
| error(_("access to '%s' denied"), file); |
| error(_("problem in displaying '%s'"), file); |
| } |
| } |
| |
| /* used by shell.exec() with rhome=FALSE. 2.13.0 and earlier were |
| like rhome=TRUE, but without fixing the path */ |
| static void internal_shellexecW(const wchar_t * file, Rboolean rhome) |
| { |
| const wchar_t *home; |
| wchar_t home2[10000], *p; |
| uintptr_t ret; |
| |
| if (rhome) { |
| home = _wgetenv(L"R_HOME"); |
| if (home == NULL) |
| error(_("R_HOME not set")); |
| wcsncpy(home2, home, 10000); |
| for(p = home2; *p; p++) if(*p == L'/') *p = L'\\'; |
| home = home2; |
| } else home = NULL; |
| |
| ret = (uintptr_t) ShellExecuteW(NULL, L"open", file, NULL, home, SW_SHOW); |
| if(ret <= 32) { /* an error condition */ |
| if(ret == ERROR_FILE_NOT_FOUND || ret == ERROR_PATH_NOT_FOUND |
| || ret == SE_ERR_FNF || ret == SE_ERR_PNF) |
| error(_("'%ls' not found"), file); |
| if(ret == SE_ERR_ASSOCINCOMPLETE || ret == SE_ERR_NOASSOC) |
| error(_("file association for '%ls' not available or invalid"), |
| file); |
| if(ret == SE_ERR_ACCESSDENIED || ret == SE_ERR_SHARE) |
| error(_("access to '%ls' denied"), file); |
| error(_("problem in displaying '%ls'"), file); |
| } |
| } |
| |
| SEXP do_shellexec(SEXP call, SEXP op, SEXP args, SEXP env) |
| { |
| SEXP file; |
| |
| checkArity(op, args); |
| file = CAR(args); |
| if (!isString(file) || length(file) != 1) |
| errorcall(call, _("invalid '%s' argument"), "file"); |
| internal_shellexecW(filenameToWchar(STRING_ELT(file, 0), FALSE), FALSE); |
| return R_NilValue; |
| } |
| |
| int check_doc_file(const char * file) |
| { |
| const char *home; |
| char path[MAX_PATH]; |
| |
| home = getenv("R_HOME"); |
| if (home == NULL) |
| error(_("R_HOME not set")); |
| if(strlen(home) + strlen(file) + 1 >= MAX_PATH) return(1); /* cannot exist */ |
| strcpy(path, home); |
| strcat(path, "/"); |
| strcat(path, file); |
| return access(path, 4) == 0; /* read access */ |
| } |
| |
| #include "Startup.h" |
| |
| void Rwin_fpset(void) |
| { |
| /* Under recent MinGW this is what fpreset does. It sets the |
| control word to 0x37f which corresponds to 0x8001F as used by |
| _controlfp. That is all errors are masked, 64-bit mantissa and |
| rounding are selected. */ |
| |
| __asm__ ( "fninit" ) ; |
| } |
| |
| |
| #include <preferences.h> |
| |
| /* utils::loadRconsole */ |
| SEXP in_loadRconsole(SEXP sfile) |
| { |
| struct structGUI gui; |
| const void *vmax = vmaxget(); |
| |
| if (!isString(sfile) || LENGTH(sfile) < 1) |
| error(_("invalid '%s' argument"), "file"); |
| getActive(&gui); /* Will get defaults if there's no active console */ |
| if (loadRconsole(&gui, translateChar(STRING_ELT(sfile, 0)))) applyGUI(&gui); |
| if (strlen(gui.warning)) warning(gui.warning); |
| vmaxset(vmax); |
| return R_NilValue; |
| } |
| |
| #include <lmcons.h> |
| typedef void (WINAPI *PGNSI)(LPSYSTEM_INFO); |
| |
| /* base::Sys.info */ |
| // keep in step with src/library/utils/src/windows/util.c |
| SEXP do_sysinfo(SEXP call, SEXP op, SEXP args, SEXP rho) |
| { |
| SEXP ans, ansnames; |
| OSVERSIONINFOEX osvi; |
| char ver[256], buf[1000]; |
| wchar_t name[MAX_COMPUTERNAME_LENGTH + 1], user[UNLEN+1]; |
| DWORD namelen = MAX_COMPUTERNAME_LENGTH + 1, userlen = UNLEN+1; |
| |
| checkArity(op, args); |
| PROTECT(ans = allocVector(STRSXP, 8)); |
| osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFOEX); |
| if(!GetVersionEx((OSVERSIONINFO *)&osvi)) |
| error(_("unsupported version of Windows")); |
| |
| SET_STRING_ELT(ans, 0, mkChar("Windows")); |
| |
| /* Here for unknown future versions */ |
| snprintf(ver, 256, "%d.%d", |
| (int)osvi.dwMajorVersion, (int)osvi.dwMinorVersion); |
| |
| if((int)osvi.dwMajorVersion >= 5) { |
| PGNSI pGNSI; |
| SYSTEM_INFO si; |
| if(osvi.dwMajorVersion == 10 && osvi.dwMinorVersion == 0) { |
| if(osvi.wProductType == VER_NT_WORKSTATION) strcpy(ver, "10"); |
| else strcpy(ver, "Server"); |
| } |
| if(osvi.dwMajorVersion == 6) { |
| char *desc = ""; |
| if(osvi.wProductType == VER_NT_WORKSTATION) { |
| if(osvi.dwMinorVersion == 0) desc = "Vista"; |
| else if(osvi.dwMinorVersion == 1) desc = "7"; |
| else if(osvi.dwMinorVersion == 2) desc = ">= 8"; |
| else if(osvi.dwMinorVersion == 3) desc = "8.1"; |
| else desc = "> 8.1"; |
| } else { |
| if(osvi.dwMinorVersion == 0) desc = "Server 2008"; |
| else if(osvi.dwMinorVersion == 1) desc = "Server 2008 R2"; |
| else if(osvi.dwMinorVersion == 2) desc = "Server >= 2012"; |
| else if(osvi.dwMinorVersion == 3) desc = "Server 2012 R2"; |
| else desc = "Server > 2012"; |
| } |
| strcpy(ver, desc); |
| } |
| if(osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 0) |
| strcpy(ver, "2000"); |
| if(osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 1) |
| strcpy(ver, "XP"); |
| if(osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 2) { |
| if(osvi.wProductType == VER_NT_WORKSTATION) |
| strcpy(ver, "XP Professional"); |
| else strcpy(ver, "Server 2003"); |
| } |
| /* GetNativeSystemInfo is XP or later */ |
| pGNSI = (PGNSI) |
| GetProcAddress(GetModuleHandle(TEXT("kernel32.dll")), |
| "GetNativeSystemInfo"); |
| if(NULL != pGNSI) pGNSI(&si); else GetSystemInfo(&si); |
| if(si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) |
| strcat(ver, " x64"); |
| } |
| SET_STRING_ELT(ans, 1, mkChar(ver)); |
| |
| if((int)osvi.dwMajorVersion >= 5) { |
| if(osvi.wServicePackMajor > 0) |
| snprintf(ver, 256, "build %d, Service Pack %d", |
| LOWORD(osvi.dwBuildNumber), |
| (int) osvi.wServicePackMajor); |
| else snprintf(ver, 256, "build %d", LOWORD(osvi.dwBuildNumber)); |
| } else |
| snprintf(ver, 256, "build %d, %s", |
| LOWORD(osvi.dwBuildNumber), osvi.szCSDVersion); |
| SET_STRING_ELT(ans, 2, mkChar(ver)); |
| GetComputerNameW(name, &namelen); |
| wcstoutf8(buf, name, sizeof(buf)); |
| SET_STRING_ELT(ans, 3, mkCharCE(buf, CE_UTF8)); |
| #ifdef _WIN64 |
| SET_STRING_ELT(ans, 4, mkChar("x86-64")); |
| #else |
| SET_STRING_ELT(ans, 4, mkChar("x86")); |
| #endif |
| GetUserNameW(user, &userlen); |
| wcstoutf8(buf, user, sizeof(buf)); |
| SET_STRING_ELT(ans, 5, mkCharCE(buf, CE_UTF8)); |
| SET_STRING_ELT(ans, 6, STRING_ELT(ans, 5)); |
| SET_STRING_ELT(ans, 7, STRING_ELT(ans, 5)); |
| PROTECT(ansnames = allocVector(STRSXP, 8)); |
| SET_STRING_ELT(ansnames, 0, mkChar("sysname")); |
| SET_STRING_ELT(ansnames, 1, mkChar("release")); |
| SET_STRING_ELT(ansnames, 2, mkChar("version")); |
| SET_STRING_ELT(ansnames, 3, mkChar("nodename")); |
| SET_STRING_ELT(ansnames, 4, mkChar("machine")); |
| SET_STRING_ELT(ansnames, 5, mkChar("login")); |
| SET_STRING_ELT(ansnames, 6, mkChar("user")); |
| SET_STRING_ELT(ansnames, 7, mkChar("effective_user")); |
| setAttrib(ans, R_NamesSymbol, ansnames); |
| UNPROTECT(2); |
| return ans; |
| } |
| |
| void Rsleep(double timeint) |
| { |
| int ntime = 1000*timeint + 0.5; |
| DWORD mtime; |
| while (ntime > 0) { |
| mtime = min(500, ntime); |
| ntime -= mtime; |
| Sleep(mtime); |
| R_ProcessEvents(); |
| } |
| |
| } |
| |
| SEXP do_dllversion(SEXP call, SEXP op, SEXP args, SEXP rho) |
| { |
| SEXP path = R_NilValue, ans; |
| const wchar_t *dll; |
| DWORD dwVerInfoSize; |
| DWORD dwVerHnd; |
| |
| checkArity(op, args); |
| path = CAR(args); |
| if(!isString(path) || LENGTH(path) != 1) |
| errorcall(call, _("invalid '%s' argument"), "path"); |
| dll = filenameToWchar(STRING_ELT(path, 0), FALSE); |
| dwVerInfoSize = GetFileVersionInfoSizeW(dll, &dwVerHnd); |
| PROTECT(ans = allocVector(STRSXP, 2)); |
| SET_STRING_ELT(ans, 0, mkChar("")); |
| SET_STRING_ELT(ans, 1, mkChar("")); |
| if (dwVerInfoSize) { |
| BOOL fRet; |
| LPSTR lpstrVffInfo; |
| LPSTR lszVer = NULL; |
| UINT cchVer = 0; |
| |
| lpstrVffInfo = (LPSTR) malloc(dwVerInfoSize); |
| if (GetFileVersionInfoW(dll, 0L, dwVerInfoSize, lpstrVffInfo)) { |
| |
| fRet = VerQueryValue(lpstrVffInfo, |
| TEXT("\\StringFileInfo\\040904E4\\FileVersion"), |
| (LPVOID)&lszVer, &cchVer); |
| if(fRet) SET_STRING_ELT(ans, 0, mkChar(lszVer)); |
| |
| fRet = VerQueryValue(lpstrVffInfo, |
| TEXT("\\StringFileInfo\\040904E4\\R Version"), |
| (LPVOID)&lszVer, &cchVer); |
| if(fRet) SET_STRING_ELT(ans, 1, mkChar(lszVer)); |
| else { |
| fRet = VerQueryValue(lpstrVffInfo, |
| TEXT("\\StringFileInfo\\040904E4\\Compiled under R Version"), |
| (LPVOID)&lszVer, &cchVer); |
| if(fRet) SET_STRING_ELT(ans, 1, mkChar(lszVer)); |
| } |
| |
| } else ans = R_NilValue; |
| free(lpstrVffInfo); |
| } else ans = R_NilValue; |
| UNPROTECT(1); |
| return ans; |
| } |
| |
| /* Retry renaming a few times to recover from possible anti-virus interference, |
| which has been reported e.g. during installation of packages. */ |
| |
| int Rwin_rename(const char *from, const char *to) |
| { |
| for(int retries = 0; retries < 10; retries++) { |
| /* coreutils first call MoveFileEx without flags; only if it fails |
| with ERROR_FILE_EXISTS or ERROR_ALREADY_EXISTING, they call again |
| with MOVEFILE_REPLACE_EXISTING */ |
| if (MoveFileEx(from, to, MOVEFILE_REPLACE_EXISTING | MOVEFILE_COPY_ALLOWED | MOVEFILE_WRITE_THROUGH)) |
| return 0; |
| DWORD err = GetLastError(); |
| if (err != ERROR_SHARING_VIOLATION && err != ERROR_ACCESS_DENIED) |
| return 1; |
| Sleep(500); |
| R_ProcessEvents(); |
| } |
| return 1; |
| } |
| |
| int Rwin_wrename(const wchar_t *from, const wchar_t *to) |
| { |
| for(int retries = 0; retries < 10; retries++) { |
| if (MoveFileExW(from, to, MOVEFILE_REPLACE_EXISTING | MOVEFILE_COPY_ALLOWED | MOVEFILE_WRITE_THROUGH)) |
| return 0; |
| DWORD err = GetLastError(); |
| if (err != ERROR_SHARING_VIOLATION && err != ERROR_ACCESS_DENIED) |
| return 1; |
| Sleep(500); |
| R_ProcessEvents(); |
| } |
| return 1; |
| } |
| |
| |
| const char *formatError(DWORD res) |
| { |
| static char buf[1000], *p; |
| FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, |
| NULL, res, |
| MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), |
| buf, 1000, NULL); |
| p = buf+strlen(buf) -1; |
| if(*p == '\n') *p = '\0'; |
| p = buf+strlen(buf) -1; |
| if(*p == '\r') *p = '\0'; |
| p = buf+strlen(buf) -1; |
| if(*p == '.') *p = '\0'; |
| return buf; |
| } |
| |
| #if _WIN32_WINNT < 0x0600 |
| /* FIXME: also used in sysutils.c */ |
| /* available from Windows Vista */ |
| typedef enum _FILE_INFO_BY_HANDLE_CLASS { |
| FileBasicInfo, |
| FileStandardInfo, |
| FileNameInfo, |
| FileRenameInfo, |
| FileDispositionInfo, |
| FileAllocationInfo, |
| FileEndOfFileInfo, |
| FileStreamInfo, |
| FileCompressionInfo, |
| FileAttributeTagInfo, |
| FileIdBothDirectoryInfo, |
| FileIdBothDirectoryRestartInfo, |
| FileIoPriorityHintInfo, |
| FileRemoteProtocolInfo, |
| FileFullDirectoryInfo, |
| FileFullDirectoryRestartInfo, |
| FileStorageInfo, |
| FileAlignmentInfo, |
| FileIdInfo, |
| FileIdExtdDirectoryInfo, |
| FileIdExtdDirectoryRestartInfo, |
| FileDispositionInfoEx, |
| FileRenameInfoEx, |
| MaximumFileInfoByHandleClass, |
| FileCaseSensitiveInfo, |
| FileNormalizedNameInfo |
| } FILE_INFO_BY_HANDLE_CLASS, *PFILE_INFO_BY_HANDLE_CLASS; |
| |
| /* MinGW defines this structure even for Vista. Older versions of MinGW |
| define it differently from Windows (two ULONGLONG fields). Newer |
| versions and Windows use |
| |
| typedef struct _FILE_ID_128 { |
| BYTE Identifier[16]; |
| } FILE_ID_128, *PFILE_ID_128; |
| */ |
| #elif _WIN32_WINNT < 0x0602 |
| /* These constants were added to FILE_INFO_BY_HANDLE_CLASS in Windows 8 */ |
| enum { |
| FileStorageInfo = FileFullDirectoryRestartInfo + 1, |
| FileAlignmentInfo, |
| FileIdInfo, |
| FileIdExtdDirectoryInfo, |
| FileIdExtdDirectoryRestartInfo |
| }; |
| #endif |
| |
| #if _WIN32_WINNT < 0x602 || !defined(__MINGW32__) |
| /* Available in Windows Server 2012, but also in MinGW from Windows 8. */ |
| typedef struct _FILE_ID_INFO { |
| ULONGLONG VolumeSerialNumber; |
| FILE_ID_128 FileId; |
| } FILE_ID_INFO, *PFILE_ID_INFO; |
| #endif |
| |
| typedef BOOL (WINAPI *LPFN_GFIBH_EX) (HANDLE, FILE_INFO_BY_HANDLE_CLASS, |
| LPVOID, DWORD); |
| |
| static int isSameFile(HANDLE a, HANDLE b) |
| { |
| static LPFN_GFIBH_EX gfibh = NULL; |
| static Rboolean initialized = FALSE; |
| FILE_ID_INFO aid, bid; |
| |
| if (!initialized) { |
| initialized = TRUE; |
| gfibh = (LPFN_GFIBH_EX) GetProcAddress( |
| GetModuleHandle(TEXT("kernel32")), |
| "GetFileInformationByHandleEx"); |
| } |
| if (gfibh == NULL) |
| return -1; |
| |
| memset(&aid, 0, sizeof(FILE_ID_INFO)); |
| memset(&bid, 0, sizeof(FILE_ID_INFO)); |
| if (!gfibh(a, FileIdInfo, &aid, sizeof(FILE_ID_INFO)) || |
| !gfibh(b, FileIdInfo, &bid, sizeof(FILE_ID_INFO))) |
| /* on Vista and Win7 it is expected to fail because FileIdInfo |
| is not supported */ |
| return -1; |
| |
| if (aid.VolumeSerialNumber == bid.VolumeSerialNumber && |
| !memcmp(&aid.FileId, &bid.FileId, sizeof(FILE_ID_128))) |
| |
| return 1; |
| else |
| return 0; |
| } |
| |
| #if _WIN32_WINNT < 0x0600 |
| /* available from Windows Vista */ |
| typedef DWORD (WINAPI *LPFN_GFPNBH) (HANDLE, LPSTR, DWORD, DWORD); |
| typedef DWORD (WINAPI *LPFN_GFPNBHW) (HANDLE, LPWSTR, DWORD, DWORD); |
| /* |
| DWORD GetFinalPathNameByHandle( |
| HANDLE hFile, |
| LPSTR lpszFilePath, |
| DWORD cchFilePath, |
| DWORD dwFlags); |
| |
| DWORD GetFinalPathNameByHandleW( |
| HANDLE hFile, |
| LPWSTR lpszFilePath, |
| DWORD cchFilePath, |
| DWORD dwFlags |
| ); |
| */ |
| #endif |
| |
| /* |
| Returns TRUE on success. On failure, "res" may be modified but not useful. |
| */ |
| static Rboolean getFinalPathName(const char *orig, char *res) |
| { |
| HANDLE horig, hres; |
| int ret; |
| #if _WIN32_WINNT < 0x0600 |
| static LPFN_GFPNBH gfpnbh = NULL; |
| static Rboolean initialized = FALSE; |
| |
| if (!initialized) { |
| initialized = TRUE; |
| gfpnbh = (LPFN_GFPNBH) GetProcAddress( |
| GetModuleHandle(TEXT("kernel32")), |
| "GetFinalPathNameByHandleA"); |
| } |
| if (gfpnbh == NULL) |
| return FALSE; |
| #endif |
| |
| /* FILE_FLAG_BACKUP_SEMANTICS needed to open a directory */ |
| horig = CreateFile(orig, 0, |
| FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, |
| NULL, OPEN_EXISTING, |
| FILE_ATTRIBUTE_HIDDEN | FILE_FLAG_BACKUP_SEMANTICS, |
| NULL); |
| if (horig == INVALID_HANDLE_VALUE) |
| return FALSE; |
| #if _WIN32_WINNT < 0x0600 |
| ret = gfpnbh(horig, res, MAX_PATH, VOLUME_NAME_DOS); |
| #else |
| ret = GetFinalPathNameByHandle(horig, res, MAX_PATH, VOLUME_NAME_DOS); |
| #endif |
| |
| if (!ret || ret > MAX_PATH) { |
| CloseHandle(horig); |
| return FALSE; |
| } |
| |
| /* get rid of the \\?\ prefix */ |
| int len = strlen(res); |
| int strip = 0; |
| if (len < 4 || strncmp("\\\\?\\", res, 4)) { |
| /* res should start with \\?\ */ |
| CloseHandle(horig); |
| return FALSE; |
| } |
| |
| if (len > 8 && !strncmp("UNC\\", res+4, 4)) { |
| /* UNC path \\?\UNC */ |
| res[6] = '\\'; /* replace the "C" in "UNC" to get "\\" prefix */ |
| strip = 6; |
| } else if (len >= 6 && isalpha(res[4]) && res[5] == ':' && res[6] == '\\') |
| /* \\?\D: */ |
| strip = 4; |
| else { |
| CloseHandle(horig); |
| return FALSE; |
| } |
| memmove(res, res+strip, len-strip+1); |
| |
| /* sanity check if the file exists using the normalized path, a normalized |
| path to an existing file should still be working */ |
| /* FILE_FLAG_BACKUP_SEMANTICS needed to open a directory */ |
| hres = CreateFile(res, 0, |
| FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, |
| NULL, OPEN_EXISTING, |
| FILE_ATTRIBUTE_HIDDEN | FILE_FLAG_BACKUP_SEMANTICS, |
| NULL); |
| if (hres == INVALID_HANDLE_VALUE) { |
| CloseHandle(horig); |
| return FALSE; |
| } |
| |
| /* check that the handles point to the same file, which may not be |
| always the case because of silent best-fit encoding conversion |
| done by Windows */ |
| ret = isSameFile(horig, hres); |
| CloseHandle(horig); |
| CloseHandle(hres); |
| |
| return (ret == 1) ? TRUE : FALSE; |
| } |
| |
| /* |
| Returns TRUE on success. On failure, "res" may be modified but not useful. |
| */ |
| static Rboolean getFinalPathNameW(const wchar_t *orig, wchar_t *res) |
| { |
| HANDLE horig, hres; |
| int ret; |
| #if _WIN32_WINNT < 0x0600 |
| static LPFN_GFPNBHW gfpnbhw = NULL; |
| static Rboolean initialized = FALSE; |
| |
| if (!initialized) { |
| initialized = TRUE; |
| gfpnbhw = (LPFN_GFPNBHW) GetProcAddress( |
| GetModuleHandle(TEXT("kernel32")), |
| "GetFinalPathNameByHandleW"); |
| } |
| if (gfpnbhw == NULL) |
| return FALSE; |
| #endif |
| |
| /* FILE_FLAG_BACKUP_SEMANTICS needed to open a directory */ |
| horig = CreateFileW(orig, 0, |
| FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, |
| NULL, OPEN_EXISTING, |
| FILE_ATTRIBUTE_HIDDEN | FILE_FLAG_BACKUP_SEMANTICS, |
| NULL); |
| if (horig == INVALID_HANDLE_VALUE) |
| return FALSE; |
| |
| #if _WIN32_WINNT < 0x0600 |
| ret = gfpnbhw(horig, res, 32767, VOLUME_NAME_DOS); |
| #else |
| ret = GetFinalPathNameByHandleW(horig, res, 32767, VOLUME_NAME_DOS); |
| #endif |
| |
| if (!ret || ret > 32768) { |
| CloseHandle(horig); |
| return FALSE; |
| } |
| |
| /* get rid of the \\?\ prefix */ |
| size_t len = wcslen(res); |
| int strip = 0; |
| if (len < 4 || wcsncmp(L"\\\\?\\", res, 4)) { |
| /* res should start with \\?\ */ |
| CloseHandle(horig); |
| return FALSE; |
| } |
| |
| if (len > 8 && !wcsncmp(L"UNC\\", res+4, 4)) { |
| /* UNC path \\?\UNC */ |
| res[6] = L'\\'; |
| strip = 6; |
| } else if (len >= 6 && Ri18n_iswctype(res[4], Ri18n_wctype("alpha")) |
| && res[5] == L':' && res[6] == L'\\') |
| /* \\?\D: */ |
| strip = 4; |
| else { |
| CloseHandle(horig); |
| return FALSE; |
| } |
| wmemmove(res, res+strip, len-strip+1); |
| |
| /* sanity check if the file exists using the normalized path, a normalized |
| path to an existing file should still be working */ |
| /* FILE_FLAG_BACKUP_SEMANTICS needed to open a directory */ |
| hres = CreateFileW(res, 0, |
| FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, |
| NULL, OPEN_EXISTING, |
| FILE_ATTRIBUTE_HIDDEN | FILE_FLAG_BACKUP_SEMANTICS, |
| NULL); |
| if (hres == INVALID_HANDLE_VALUE) { |
| CloseHandle(horig); |
| return FALSE; |
| } |
| |
| /* sanity check that the handles point to the same file; they should, but |
| better be safe wrt to undocumented features/changes of gfpnbhw */ |
| ret = isSameFile(horig, hres); |
| CloseHandle(horig); |
| CloseHandle(hres); |
| |
| return ret ? TRUE : FALSE; /* return TRUE when isSameFile fails with -1 */ |
| } |
| |
| void R_UTF8fixslash(char *s); /* from main/util.c */ |
| SEXP do_normalizepath(SEXP call, SEXP op, SEXP args, SEXP rho) |
| { |
| SEXP ans, paths = CAR(args), el, slash; |
| int i, n = LENGTH(paths), res; |
| char tmp[4*MAX_PATH+1], longpath[4*MAX_PATH+1], *tmp2; |
| wchar_t wtmp[32768], wlongpath[32768], *wtmp2; |
| int mustWork, fslash = 0; |
| |
| checkArity(op, args); |
| if(!isString(paths)) |
| errorcall(call, _("'path' must be a character vector")); |
| |
| slash = CADR(args); |
| if(!isString(slash) || LENGTH(slash) != 1) |
| errorcall(call, "'winslash' must be a character string"); |
| const char *sl = CHAR(STRING_ELT(slash, 0)); |
| if (strcmp(sl, "/") && strcmp(sl, "\\")) |
| errorcall(call, "'winslash' must be '/' or '\\\\'"); |
| if (strcmp(sl, "/") == 0) fslash = 1; |
| |
| mustWork = asLogical(CADDR(args)); |
| |
| PROTECT(ans = allocVector(STRSXP, n)); |
| for (i = 0; i < n; i++) { |
| SEXP result; |
| Rboolean ok = FALSE; |
| el = STRING_ELT(paths, i); |
| result = el; |
| if (el == NA_STRING) { |
| result = NA_STRING; |
| if(mustWork == 1) |
| errorcall(call, "path[%d]=NA", i+1); |
| else if(mustWork == NA_LOGICAL) |
| warningcall(call, "path[%d]=NA", i+1); |
| } else if(getCharCE(el) == CE_UTF8) { |
| wchar_t *norm = NULL; |
| const wchar_t* wel = filenameToWchar(el, FALSE); |
| |
| if (getFinalPathNameW(wel, wtmp)) { |
| norm = wtmp; |
| ok = TRUE; |
| /* if normalized to UNC path but full path is D:..., fall back |
| to GetLongPathName */ |
| if (norm[0] == L'\\' && norm[1] == L'\\') { |
| res = GetFullPathNameW(wel, 32768, wlongpath, &wtmp2); |
| if (res && res <= 32768 && |
| Ri18n_iswctype(wlongpath[0], Ri18n_wctype("alpha")) && |
| wlongpath[1] == L':') { |
| |
| ok = FALSE; |
| norm = NULL; |
| /* NOTE: GetFullPathName is called twice */ |
| } |
| } |
| } |
| |
| if (!ok) { |
| /* silently fall back to GetFullPathNameW/GetLongPathNameW */ |
| res = GetFullPathNameW(wel, 32768, wtmp, &wtmp2); |
| if (res && res <= 32768) { |
| norm = wtmp; |
| res = GetLongPathNameW(wtmp, wlongpath, 32768); |
| if (res && res <= 32768) { |
| norm = wlongpath; |
| ok = TRUE; |
| } |
| } |
| } |
| if (!ok) { |
| if (mustWork == 1) { |
| errorcall(call, "path[%d]=\"%ls\": %s", i+1, |
| wel, formatError(GetLastError())); |
| } else if (mustWork == NA_LOGICAL) { |
| warningcall(call, "path[%d]=\"%ls\": %s", i+1, |
| wel, formatError(GetLastError())); |
| } |
| } |
| |
| char *normutf8 = tmp; |
| if (norm) |
| wcstoutf8(tmp, norm, sizeof(tmp)); |
| else if (fslash) |
| strcpy(tmp, translateCharUTF8(el)); |
| else |
| normutf8 = (char *)translateCharUTF8(el); |
| |
| if (fslash) R_UTF8fixslash(normutf8); |
| result = mkCharCE(normutf8, CE_UTF8); |
| } else { |
| char *norm = NULL; |
| const char *tel = translateChar(el); |
| if (getFinalPathName(tel, tmp)) { |
| norm = tmp; |
| ok = TRUE; |
| /* if normalized to UNC path but full path is D:..., fall back |
| to GetLongPathName */ |
| if (norm[0] == '\\' && norm[1] == '\\') { |
| res = GetFullPathName(tel, MAX_PATH, longpath, &tmp2); |
| if (res && res <= MAX_PATH && |
| isalpha(longpath[0]) && longpath[1] == ':') { |
| |
| ok = FALSE; |
| norm = NULL; |
| /* NOTE: GetFullPathName is called twice */ |
| } |
| } |
| } |
| if (!ok) { |
| /* silently fall back to GetFullPathName/GetLongPathName */ |
| res = GetFullPathName(tel, MAX_PATH, tmp, &tmp2); |
| if (res && res <= MAX_PATH) { |
| norm = tmp; |
| res = GetLongPathName(tmp, longpath, MAX_PATH); |
| if (res && res <= MAX_PATH) { |
| norm = longpath; |
| ok = TRUE; |
| } |
| } |
| } |
| if (!ok) { |
| if (mustWork == 1) { |
| errorcall(call, "path[%d]=\"%s\": %s", i+1, |
| tel, formatError(GetLastError())); |
| } else if (mustWork == NA_LOGICAL) { |
| warningcall(call, "path[%d]=\"%s\": %s", i+1, |
| tel, formatError(GetLastError())); |
| } |
| if (!norm) { |
| if (fslash) { |
| strcpy(tmp, tel); |
| norm = tmp; |
| } else |
| norm = (char *)tel; |
| } |
| } |
| if (fslash) R_fixslash(norm); |
| result = mkChar(norm); |
| } |
| SET_STRING_ELT(ans, i, result); |
| } |
| UNPROTECT(1); |
| return ans; |
| } |
| |
| /* utils::shortPathName */ |
| SEXP in_shortpath(SEXP paths) |
| { |
| SEXP ans, el; |
| int i, n = LENGTH(paths); |
| char tmp[4*MAX_PATH+1]; |
| wchar_t wtmp[32768]; |
| DWORD res; |
| const void *vmax = vmaxget(); |
| |
| if(!isString(paths)) error(_("'path' must be a character vector")); |
| |
| PROTECT(ans = allocVector(STRSXP, n)); |
| for (i = 0; i < n; i++) { |
| el = STRING_ELT(paths, i); |
| if(getCharCE(el) == CE_UTF8) { |
| res = GetShortPathNameW(filenameToWchar(el, FALSE), wtmp, 32768); |
| if (res && res <= 32768) |
| wcstoutf8(tmp, wtmp, sizeof(tmp)); |
| else |
| strcpy(tmp, translateChar(el)); |
| /* documented to return paths using \, which the API call does |
| not necessarily do */ |
| R_fixbackslash(tmp); |
| SET_STRING_ELT(ans, i, mkCharCE(tmp, CE_UTF8)); |
| } else { |
| res = GetShortPathName(translateChar(el), tmp, MAX_PATH); |
| if (res == 0 || res > MAX_PATH) strcpy(tmp, translateChar(el)); |
| /* documented to return paths using \, which the API call does |
| not necessarily do */ |
| R_fixbackslash(tmp); |
| SET_STRING_ELT(ans, i, mkChar(tmp)); |
| } |
| } |
| UNPROTECT(1); |
| vmaxset(vmax); |
| return ans; |
| } |
| |
| #include "devWindows.h" |
| #include <R_ext/GraphicsEngine.h> /* GEgetDevice */ |
| |
| /* grDevices::bringToTop */ |
| SEXP bringtotop(SEXP sdev, SEXP sstay) |
| { |
| int dev, stay; |
| pGEDevDesc gdd; |
| gadesc *xd; |
| |
| dev = asInteger(sdev); |
| stay = asInteger(sstay); |
| |
| if(dev == -1) { /* console */ |
| if(CharacterMode == RGui) BringToTop(RConsole, stay); |
| } else { |
| if(dev < 1 || dev > R_MaxDevices || dev == NA_INTEGER) |
| error(_("invalid '%s' argument"), "which"); |
| gdd = GEgetDevice(dev - 1); |
| if(!gdd) error(_("invalid device")); |
| xd = (gadesc *) gdd->dev->deviceSpecific; |
| if(!xd) error(_("invalid device")); |
| if(stay && ismdi()) error(_("requires SDI mode")); |
| BringToTop(xd->gawin, stay); |
| } |
| return R_NilValue; |
| } |
| |
| /* grDevices::msgWindow */ |
| SEXP msgwindow(SEXP sdev, SEXP stype) |
| { |
| int dev, type; |
| pGEDevDesc gdd; |
| gadesc *xd; |
| |
| dev = asInteger(sdev); |
| type = asInteger(stype); |
| |
| if(dev == -1) { /* console */ |
| if(CharacterMode == RGui) GA_msgWindow(RConsole, type); |
| } else { |
| if(dev < 1 || dev > R_MaxDevices || dev == NA_INTEGER) |
| error(_("invalid '%s' argument"), "which"); |
| gdd = GEgetDevice(dev - 1); |
| if(!gdd) error(_("invalid device")); |
| xd = (gadesc *) gdd->dev->deviceSpecific; |
| if(!xd) error(_("invalid device")); |
| if(type == 5) { |
| xd->recording = TRUE; |
| check(xd->mrec); |
| } else if(type == 6) { |
| xd-> recording = FALSE; |
| uncheck(xd->mrec); |
| } else |
| GA_msgWindow(xd->gawin, type); |
| } |
| return R_NilValue; |
| } |
| |
| |
| /* This assumes a menuname of the form |
| $Graph<nn>Main, $Graph<nn>Popup, $Graph<nn>LocMain, |
| or $Graph<nn>LocPopup where <nn> is the |
| device number. We've already checked the $Graph prefix. */ |
| |
| /* called from rui.c, only */ |
| menu getGraphMenu(const char* menuname) |
| { |
| int devnum; |
| pGEDevDesc gdd; |
| gadesc *xd; |
| |
| menuname = menuname + 6; |
| devnum = atoi(menuname); |
| if(devnum < 1 || devnum > R_MaxDevices) |
| error(_("invalid graphical device number")); |
| |
| while (('0' <= *menuname) && (*menuname <= '9')) menuname++; |
| |
| gdd = GEgetDevice(devnum - 1); |
| |
| if(!gdd) error(_("invalid device")); |
| |
| xd = (gadesc *) gdd->dev->deviceSpecific; |
| |
| if(!xd || xd->kind != SCREEN) error(_("bad device")); |
| |
| if (strcmp(menuname, "Main") == 0) return(xd->mbar); |
| else if (strcmp(menuname, "Popup") == 0) return(xd->grpopup); |
| else return(NULL); |
| } |
| |
| /* |
| Replacement for MSVCRT's access. |
| Coded looking at tcl's tclWinFile.c |
| */ |
| |
| int winAccessW(const wchar_t *path, int mode) |
| { |
| DWORD attr = GetFileAttributesW(path); |
| |
| if(attr == INVALID_FILE_ATTRIBUTES) |
| /* file does not exist or may be locked */ |
| return -1; |
| |
| if(mode == F_OK) return 0; |
| |
| if ((mode & W_OK) |
| && !(attr & FILE_ATTRIBUTE_DIRECTORY) |
| && (attr & FILE_ATTRIBUTE_READONLY)) return -1; |
| |
| if(mode & X_OK) |
| if(!(attr & FILE_ATTRIBUTE_DIRECTORY)) { /* Directory, so OK */ |
| /* Look at extension for executables */ |
| wchar_t *p = wcsrchr(path, '.'); |
| if(p == NULL || |
| !((wcsicmp(p, L".exe") == 0) || (wcsicmp(p, L".com") == 0) || |
| (wcsicmp(p, L".bat") == 0) || (wcsicmp(p, L".cmd") == 0)) ) |
| return -1; |
| } |
| { |
| /* Now look for file security info */ |
| SECURITY_DESCRIPTOR *sdPtr = NULL; |
| DWORD size = 0; |
| PSID sid = 0; |
| BOOL sidDefaulted; |
| SID_IDENTIFIER_AUTHORITY samba_unmapped = {{0, 0, 0, 0, 0, 22}}; |
| GENERIC_MAPPING genMap; |
| HANDLE hToken = NULL; |
| DWORD desiredAccess = 0; |
| DWORD grantedAccess = 0; |
| BOOL accessYesNo = FALSE; |
| PRIVILEGE_SET privSet; |
| DWORD privSetSize = sizeof(PRIVILEGE_SET); |
| int error; |
| |
| /* get size */ |
| GetFileSecurityW(path, |
| OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION |
| | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, |
| 0, 0, &size); |
| error = GetLastError(); |
| if (error == ERROR_NOT_SUPPORTED) |
| /* happens for some remote shares */ |
| return _waccess(path, mode); |
| if (error != ERROR_INSUFFICIENT_BUFFER) |
| return -1; |
| sdPtr = (SECURITY_DESCRIPTOR *) alloca(size); |
| if(!GetFileSecurityW(path, |
| OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION |
| | DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION, sdPtr, size, &size)) |
| return -1; |
| /* rely on attrib checks for unmapped samba owners and groups */ |
| if (!GetSecurityDescriptorOwner(sdPtr, &sid, &sidDefaulted)) |
| return 0; |
| if (IsValidSid(sid) && |
| !memcmp(GetSidIdentifierAuthority(sid), &samba_unmapped, sizeof(SID_IDENTIFIER_AUTHORITY))) |
| return 0; |
| /* |
| * Perform security impersonation of the user and open the |
| * resulting thread token. |
| */ |
| if(!ImpersonateSelf(SecurityImpersonation)) return -1; |
| if(!OpenThreadToken(GetCurrentThread (), |
| TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, |
| &hToken)) return -1; |
| if (mode & R_OK) desiredAccess |= FILE_GENERIC_READ; |
| if (mode & W_OK) desiredAccess |= FILE_GENERIC_WRITE; |
| if (mode & X_OK) desiredAccess |= FILE_GENERIC_EXECUTE; |
| |
| memset(&genMap, 0x0, sizeof (GENERIC_MAPPING)); |
| genMap.GenericRead = FILE_GENERIC_READ; |
| genMap.GenericWrite = FILE_GENERIC_WRITE; |
| genMap.GenericExecute = FILE_GENERIC_EXECUTE; |
| genMap.GenericAll = FILE_ALL_ACCESS; |
| if(!AccessCheck(sdPtr, hToken, desiredAccess, &genMap, &privSet, |
| &privSetSize, &grantedAccess, &accessYesNo)) { |
| CloseHandle(hToken); |
| return -1; |
| } |
| CloseHandle(hToken); |
| if (!accessYesNo) return -1; |
| |
| } |
| return 0; |
| } |
| |
| #include <Rversion.h> |
| char *getDLLVersion(void) |
| { |
| static char DLLversion[25]; |
| OSVERSIONINFO osvi; |
| osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); |
| GetVersionEx(&osvi); |
| /* 95, 98, ME are 4.x */ |
| if(osvi.dwMajorVersion < 5) |
| R_Suicide("Windows 2000 or later is required"); |
| snprintf(DLLversion, 25, "%s.%s", R_MAJOR, R_MINOR); |
| return (DLLversion); |
| } |
| |
| /* base::file.choose */ |
| SEXP attribute_hidden do_filechoose(SEXP call, SEXP op, SEXP args, SEXP rho) |
| { |
| SEXP ans; |
| wchar_t *fn; |
| char str[4*MAX_PATH+1]; |
| |
| checkArity(op, args); |
| setuserfilterW(L"All files (*.*)\0*.*\0\0"); |
| fn = askfilenameW(G_("Select file"), ""); |
| if (!fn) |
| error(_("file choice cancelled")); |
| wcstoutf8(str, fn, sizeof(str)); |
| PROTECT(ans = allocVector(STRSXP, 1)); |
| SET_STRING_ELT(ans, 0, mkCharCE(str, CE_UTF8)); |
| UNPROTECT(1); |
| return ans; |
| } |
| |
| const char *getTZinfo(void); // src/extra/tzone/registryTZ.c |
| |
| SEXP attribute_hidden do_tzone_name(SEXP call, SEXP op, SEXP args, SEXP rho) |
| { |
| return mkString(getTZinfo()); |
| } |
| |