diff options
| -rw-r--r-- | .gitignore | 5 | ||||
| -rw-r--r-- | configure.ac | 9 | ||||
| -rw-r--r-- | docs/users_guide/8.6.1-notes.rst | 48 | ||||
| -rw-r--r-- | ghc.mk | 10 | ||||
| -rw-r--r-- | libraries/base/base.cabal | 2 | ||||
| -rw-r--r-- | libraries/base/include/HsBase.h | 16 | ||||
| -rw-r--r-- | rts/Hpc.c | 5 | ||||
| -rw-r--r-- | rts/Linker.c | 3 | ||||
| -rw-r--r-- | rts/PathUtils.h | 2 | ||||
| -rw-r--r-- | rts/ProfHeap.c | 3 | ||||
| -rw-r--r-- | rts/Profiling.c | 5 | ||||
| -rw-r--r-- | rts/RtsFlags.c | 6 | ||||
| -rw-r--r-- | rts/RtsSymbols.c | 1 | ||||
| -rw-r--r-- | rts/eventlog/EventLogWriter.c | 3 | ||||
| -rw-r--r-- | rts/fs_rts.h | 15 | ||||
| -rw-r--r-- | rts/ghc.mk | 2 | ||||
| -rw-r--r-- | rts/linker/LoadArchive.c | 1 | ||||
| -rw-r--r-- | rts/linker/PEi386.c | 3 | ||||
| -rw-r--r-- | rts/rts.cabal.in | 3 | ||||
| -rw-r--r-- | utils/fs/README | 4 | ||||
| -rw-r--r-- | utils/fs/fs.c | 293 | ||||
| -rw-r--r-- | utils/fs/fs.h | 36 | ||||
| -rw-r--r-- | utils/lndir/lndir.c | 17 | ||||
| -rw-r--r-- | utils/unlit/ghc.mk | 2 | ||||
| -rw-r--r-- | utils/unlit/unlit.c | 19 | ||||
| -rw-r--r-- | utils/unlit/unlit.cabal | 3 |
26 files changed, 482 insertions, 34 deletions
diff --git a/.gitignore b/.gitignore index efc7a89ea4..631d12f8fc 100644 --- a/.gitignore +++ b/.gitignore @@ -180,6 +180,11 @@ _darcs/ /utils/mkUserGuidePart/mkUserGuidePart.cabal /utils/runghc/runghc.cabal /utils/gen-dll/gen-dll.cabal +utils/lndir/fs.* +utils/unlit/fs.* +rts/fs.* +libraries/base/include/fs.h +libraries/base/cbits/fs.c /extra-gcc-opts /sdistprep diff --git a/configure.ac b/configure.ac index 111def2cda..062004d904 100644 --- a/configure.ac +++ b/configure.ac @@ -670,6 +670,15 @@ dnl -------------------------------------------------------------- dnl End of configure script option section dnl -------------------------------------------------------------- +dnl ** Copy the files from the "fs" utility into the right folders. +dnl -------------------------------------------------------------- +AC_MSG_NOTICE([Creating links for in-tree file handling routines.]) +ln -f -v utils/fs/fs.* utils/lndir/ +ln -f -v utils/fs/fs.* utils/unlit/ +ln -f -v utils/fs/fs.* rts/ +ln -f -v utils/fs/fs.h libraries/base/include/ +ln -f -v utils/fs/fs.c libraries/base/cbits/ +AC_MSG_NOTICE([Routines in place. Packages can now be build normally.]) dnl -------------------------------------------------------------- dnl ** Can the unix package be built? diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst index 548702159c..6300a3f3e4 100644 --- a/docs/users_guide/8.6.1-notes.rst +++ b/docs/users_guide/8.6.1-notes.rst @@ -82,8 +82,10 @@ Runtime system else. This fixes ``iuuc`` on Windows given the proper search directories (e.g ``-L/mingw64/lib``). - - The GHC runtime linker now uses ``LIBRARY_PATH`` and the runtime loader now also - searches ``LD_LIBRARY_PATH``. +- The GHC runtime linker now uses ``LIBRARY_PATH`` and the runtime loader now also + searches ``LD_LIBRARY_PATH``. + +- The GHC runtime on Windows is no longer constrained by MAX_PATH. Template Haskell ~~~~~~~~~~~~~~~~ @@ -107,6 +109,48 @@ Template Haskell Build system ~~~~~~~~~~~~ +Windows Paths +~~~~~~~~~~~~~ + +Windows paths are not all the same. The different kinds of paths each have +different meanings. The MAX_PATH limitation is not a limitation of the Operating +System nor the File System. It is a limitation of the default namespace enforced +by the Win32 API for backwards compatibility. + +The NT Kernel however allows you ways to opt out of this path preprocessing by +the Win32 APIs. This is done by explicitly using the desired namespace in the +PATH. + +The namespaces are: + + - file namespace: \\?\ + - device namespace: \\.\ + - nt namespace: \ + +Each of these turn off Path processing completely by the Win32 API and the paths +are passed untouched to the filesystem. + +Paths with a drive letter are `legacy` paths. The drive letters are actually +meaningless to the kernel. Just like Unix operating systems, drive letters are +just a mount point. You can view your mount points by using the `mountvol` +command. + +The Haskell I/O manager will now automatically promote paths in the legacy +format to Win32 file namespace. By default the I/O manager will do two things to +your paths: + + - replace / with \\ + - expand relative paths to absolute paths + +If you want to opt out of all preprocessing just expliticly use namespaces in +your paths. Due to this change, if you need to open raw devices (e.g. COM ports) +you need to use the device namespace explicitly. (e.g. `\\.\COM1`). GHC and +Haskell programs in general no longer support opening devices in the `legacy` +format. + +See https://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx for +more details. + Included libraries ------------------ @@ -1450,6 +1450,16 @@ distclean : clean $(call removeTrees,inplace/mingw) $(call removeTrees,inplace/perl) +# Remove the fs utilities. + $(call removeFiles,utils/lndir/fs.h) + $(call removeFiles,utils/lndir/fs.c) + $(call removeFiles,utils/unlit/fs.h) + $(call removeFiles,utils/unlit/fs.c) + $(call removeFiles,rts/fs.h) + $(call removeFiles,rts/fs.c) + $(call removeFiles,libraries/base/include/fs.h) + $(call removeFiles,libraries/base/cbits/fs.c) + maintainer-clean : distclean $(call removeFiles,configure mk/config.h.in) $(call removeTrees,autom4te.cache $(wildcard libraries/*/autom4te.cache)) diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index c7075b3280..0a91315a61 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -36,6 +36,7 @@ extra-source-files: include/HsBaseConfig.h.in include/ieee-flpt.h include/md5.h + include/fs.h install-sh source-repository head @@ -339,6 +340,7 @@ Library cbits/md5.c cbits/primFloat.c cbits/sysconf.c + cbits/fs.c cmm-sources: cbits/CastFloatWord.cmm diff --git a/libraries/base/include/HsBase.h b/libraries/base/include/HsBase.h index 13640c590e..d5884473ca 100644 --- a/libraries/base/include/HsBase.h +++ b/libraries/base/include/HsBase.h @@ -520,13 +520,25 @@ extern void* __hscore_get_saved_termios(int fd); extern void __hscore_set_saved_termios(int fd, void* ts); #if defined(_WIN32) +/* Defined in fs.c. */ +extern int __hs_swopen (const wchar_t* filename, int oflag, int shflag, + int pmode); + INLINE int __hscore_open(wchar_t *file, int how, mode_t mode) { + int result = -1; if ((how & O_WRONLY) || (how & O_RDWR) || (how & O_APPEND)) - return _wsopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode); + result = __hs_swopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode); // _O_NOINHERIT: see #2650 else - return _wsopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode); + result = __hs_swopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode); // _O_NOINHERIT: see #2650 + + /* This call is very important, otherwise the I/O system will not propagate + the correct error for why it failed. */ + if (result == -1) + maperrno (); + + return result; } #else INLINE int __hscore_open(char *file, int how, mode_t mode) { @@ -13,6 +13,7 @@ #include <ctype.h> #include <string.h> #include <assert.h> +#include <fs_rts.h> #if defined(HAVE_SYS_TYPES_H) #include <sys/types.h> @@ -233,7 +234,7 @@ startupHpc(void) sprintf(tixFilename, "%s.tix", prog_name); } - if (init_open(fopen(tixFilename,"r"))) { + if (init_open(__rts_fopen(tixFilename,"r"))) { readTix(); } } @@ -387,7 +388,7 @@ exitHpc(void) { // not clober the .tix file. if (hpc_pid == getpid()) { - FILE *f = fopen(tixFilename,"w"); + FILE *f = __rts_fopen(tixFilename,"w"); writeTix(f); } diff --git a/rts/Linker.c b/rts/Linker.c index 8f55c296a6..aa6ec7fe7a 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -48,6 +48,7 @@ #include <string.h> #include <stdio.h> #include <assert.h> +#include <fs_rts.h> #if defined(HAVE_SYS_STAT_H) #include <sys/stat.h> @@ -711,7 +712,7 @@ addDLL( pathchar *dll_name ) strncpy(line, (errmsg+(match[1].rm_so)),match_length); line[match_length] = '\0'; // make sure string is null-terminated IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line)); - if ((fp = fopen(line, "r")) == NULL) { + if ((fp = __rts_fopen(line, "r")) == NULL) { return errmsg; // return original error if open fails } // try to find a GROUP or INPUT ( ... ) command diff --git a/rts/PathUtils.h b/rts/PathUtils.h index 152606a7b0..0b35b214e0 100644 --- a/rts/PathUtils.h +++ b/rts/PathUtils.h @@ -14,7 +14,7 @@ #if defined(mingw32_HOST_OS) #define pathcmp wcscmp #define pathlen wcslen -#define pathopen _wfopen +#define pathopen __rts_fwopen #define pathstat _wstat #define struct_stat struct _stat #define open wopen diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c index cb6a13c897..4a7b6d38a8 100644 --- a/rts/ProfHeap.c +++ b/rts/ProfHeap.c @@ -23,6 +23,7 @@ #include "Trace.h" #include "sm/GCThread.h" +#include <fs_rts.h> #include <string.h> /* ----------------------------------------------------------------------------- @@ -340,7 +341,7 @@ void initProfiling (void) sprintf(hp_filename, "%s.hp", prog); /* open the log file */ - if ((hp_file = fopen(hp_filename, "w")) == NULL) { + if ((hp_file = __rts_fopen(hp_filename, "w")) == NULL) { debugBelch("Can't open profiling report file %s\n", hp_filename); RtsFlags.ProfFlags.doHeapProfile = 0; diff --git a/rts/Profiling.c b/rts/Profiling.c index 803f86befc..9f1a442951 100644 --- a/rts/Profiling.c +++ b/rts/Profiling.c @@ -22,6 +22,7 @@ #include "Printer.h" #include "Capability.h" +#include <fs_rts.h> #include <string.h> #if defined(DEBUG) @@ -264,7 +265,7 @@ initProfilingLogFile(void) sprintf(prof_filename, "%s.prof", stem); /* open the log file */ - if ((prof_file = fopen(prof_filename, "w")) == NULL) { + if ((prof_file = __rts_fopen(prof_filename, "w")) == NULL) { debugBelch("Can't open profiling report file %s\n", prof_filename); RtsFlags.CcFlags.doCostCentres = 0; // Retainer profiling (`-hr` or `-hr<cc> -h<x>`) writes to @@ -281,7 +282,7 @@ initProfilingLogFile(void) sprintf(hp_filename, "%s.hp", stem); /* open the log file */ - if ((hp_file = fopen(hp_filename, "w")) == NULL) { + if ((hp_file = __rts_fopen(hp_filename, "w")) == NULL) { debugBelch("Can't open profiling report file %s\n", hp_filename); RtsFlags.ProfFlags.doHeapProfile = 0; diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c index b674e9b685..abb980039d 100644 --- a/rts/RtsFlags.c +++ b/rts/RtsFlags.c @@ -31,6 +31,8 @@ #include <sys/types.h> #endif +#include <fs_rts.h> + // Flag Structure RTS_FLAGS RtsFlags; @@ -1697,7 +1699,7 @@ openStatsFile (char *filename, // filename, or NULL f = NULL; /* NULL means use debugBelch */ } else { if (*filename != '\0') { /* stats file specified */ - f = fopen(filename,"w"); + f = __rts_fopen (filename,"w"); } else { if (filename_fmt == NULL) { errorBelch("Invalid stats filename format (NULL)\n"); @@ -1707,7 +1709,7 @@ openStatsFile (char *filename, // filename, or NULL char stats_filename[STATS_FILENAME_MAXLEN]; snprintf(stats_filename, STATS_FILENAME_MAXLEN, filename_fmt, prog_name); - f = fopen(stats_filename,"w"); + f = __rts_fopen (stats_filename,"w"); } if (f == NULL) { errorBelch("Can't open stats file %s\n", filename); diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c index d5800fd336..aa95660945 100644 --- a/rts/RtsSymbols.c +++ b/rts/RtsSymbols.c @@ -106,6 +106,7 @@ RTS_WIN64_ONLY(SymI_HasProto(__imp__environ)) \ RTS_WIN32_ONLY(SymI_HasProto(_imp___iob)) \ RTS_WIN64_ONLY(SymI_HasProto(__iob_func)) \ + RTS_WIN64_ONLY(SymI_HasProto(__mingw_vsnwprintf)) \ /* see Note [Symbols for MinGW's printf] */ \ SymI_HasProto(_lock_file) \ SymI_HasProto(_unlock_file) diff --git a/rts/eventlog/EventLogWriter.c b/rts/eventlog/EventLogWriter.c index d8e5a44192..e6f560fc24 100644 --- a/rts/eventlog/EventLogWriter.c +++ b/rts/eventlog/EventLogWriter.c @@ -14,6 +14,7 @@ #include <string.h> #include <stdio.h> +#include <fs_rts.h> #if defined(HAVE_SYS_TYPES_H) #include <sys/types.h> #endif @@ -71,7 +72,7 @@ initEventLogFileWriter(void) stgFree(prog); /* Open event log file for writing. */ - if ((event_log_file = fopen(event_log_filename, "wb")) == NULL) { + if ((event_log_file = __rts_fopen(event_log_filename, "wb")) == NULL) { sysErrorBelch( "initEventLogFileWriter: can't open %s", event_log_filename); stg_exit(EXIT_FAILURE); diff --git a/rts/fs_rts.h b/rts/fs_rts.h new file mode 100644 index 0000000000..12c27ccc8c --- /dev/null +++ b/rts/fs_rts.h @@ -0,0 +1,15 @@ +/* ----------------------------------------------------------------------------- + * + * (c) Tamar Christina 2018 + * + * Hack to get around linkewhole issues on linux. The FS utilities need to be in + * a different namespace to allow the linking. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#undef FS_NAMESPACE +#define FS_NAMESPACE rts + +#include "fs.h" diff --git a/rts/ghc.mk b/rts/ghc.mk index 761cc43b8f..9d1c2a50f6 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -332,7 +332,7 @@ endif STANDARD_OPTS += $(addprefix -I,$(GHC_INCLUDE_DIRS)) -Irts -Irts/dist/build # COMPILING_RTS is only used when building Win32 DLL support. -STANDARD_OPTS += -DCOMPILING_RTS +STANDARD_OPTS += -DCOMPILING_RTS -DFS_NAMESPACE=rts # HC_OPTS is included in both .c and .cmm compilations, whereas CC_OPTS is # only included in .c compilations. HC_OPTS included the WAY_* opts, which diff --git a/rts/linker/LoadArchive.c b/rts/linker/LoadArchive.c index 3c4bd44a28..7f00edbed8 100644 --- a/rts/linker/LoadArchive.c +++ b/rts/linker/LoadArchive.c @@ -22,6 +22,7 @@ #include <string.h> #include <stddef.h> #include <ctype.h> +#include <fs_rts.h> #define FAIL(...) do {\ errorBelch("loadArchive: "__VA_ARGS__); \ diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c index 364f7780b2..49aa16d3e3 100644 --- a/rts/linker/PEi386.c +++ b/rts/linker/PEi386.c @@ -2025,6 +2025,9 @@ SymbolAddr *lookupSymbol_PEi386(SymbolName *lbl) zapTrailingAtSign ( (unsigned char*)lbl ); #endif sym = lookupSymbolInDLLs((unsigned char*)lbl); + /* TODO: We should really cache this symbol now that we've loaded it. + The system loader is fast, but not fast enough to keep wasting + cycles like this. */ return sym; // might be NULL if not found } else { #if defined(mingw32_HOST_OS) diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index 67fb9c5d92..0b9a8c4efd 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -129,6 +129,8 @@ library rts/Timer.h rts/Types.h rts/Utils.h + rts/fs.h + rts/fs_rts.h rts/prof/CCS.h rts/prof/LDV.h rts/storage/Block.h @@ -429,6 +431,7 @@ library sm/Storage.c sm/Sweep.c xxhash.c + fs.c -- I wish we had wildcards..., this would be: -- *.c hooks/**/*.c sm/**/*.c eventlog/**/*.c linker/**/*.c if os(windows) diff --git a/utils/fs/README b/utils/fs/README new file mode 100644 index 0000000000..5011939a38 --- /dev/null +++ b/utils/fs/README @@ -0,0 +1,4 @@ +This "fs" library, used by various ghc utilities is used to share some common +I/O filesystem functions with different packages. + +This file is copied across the build-system by configure. diff --git a/utils/fs/fs.c b/utils/fs/fs.c new file mode 100644 index 0000000000..24bf3a3632 --- /dev/null +++ b/utils/fs/fs.c @@ -0,0 +1,293 @@ +/* ----------------------------------------------------------------------------- + * + * (c) Tamar Christina 2018 + * + * Windows I/O routines for file opening. + * + * NOTE: Only modify this file in utils/fs/ and rerun configure. Do not edit + * this file in any other directory as it will be overwritten. + * + * ---------------------------------------------------------------------------*/ +#include "fs.h" +#include <stdio.h> + +#if defined(_WIN32) + +#include <stdbool.h> +#include <stdlib.h> +#include <stdint.h> + +#include <windows.h> +#include <io.h> +#include <fcntl.h> +#include <wchar.h> +#include <sys\stat.h> +#include <sys\types.h> +#include <share.h> + +/* This function converts Windows paths between namespaces. More specifically + It converts an explorer style path into a NT or Win32 namespace. + This has several caveats but they are caviats that are native to Windows and + not POSIX. See + https://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx. + Anything else such as raw device paths we leave untouched. The main benefit + of doing any of this is that we can break the MAX_PATH restriction and also + access raw handles that we couldn't before. */ +static wchar_t* __hs_create_device_name (const wchar_t* filename) { + const wchar_t* win32_dev_namespace = L"\\\\.\\"; + const wchar_t* win32_file_namespace = L"\\\\?\\"; + const wchar_t* nt_device_namespace = L"\\Device\\"; + const wchar_t* unc_prefix = L"UNC\\"; + const wchar_t* network_share = L"\\\\"; + + wchar_t* result = _wcsdup (filename); + wchar_t ns[10] = {0}; + + /* If the file is already in a native namespace don't change it. */ + if ( wcsncmp (win32_dev_namespace , filename, 4) == 0 + || wcsncmp (win32_file_namespace, filename, 4) == 0 + || wcsncmp (nt_device_namespace , filename, 8) == 0) + return result; + + /* Since we're using the lower level APIs we must normalize slashes now. The + Win32 API layer will no longer convert '/' into '\\' for us. */ + for (size_t i = 0; i < wcslen (result); i++) + { + if (result[i] == L'/') + result[i] = L'\\'; + } + + /* Now resolve any . and .. in the path or subsequent API calls may fail since + Win32 will no longer resolve them. */ + DWORD nResult = GetFullPathNameW (result, 0, NULL, NULL) + 1; + wchar_t *temp = _wcsdup (result); + result = malloc (nResult * sizeof (wchar_t)); + if (GetFullPathNameW (temp, nResult, result, NULL) == 0) + { + goto cleanup; + } + + free (temp); + + if (wcsncmp (network_share, result, 2) == 0) + { + if (swprintf (ns, 10, L"%ls%ls", win32_file_namespace, unc_prefix) <= 0) + { + goto cleanup; + } + } + else if (swprintf (ns, 10, L"%ls", win32_file_namespace) <= 0) + { + goto cleanup; + } + + /* Create new string. */ + int bLen = wcslen (result) + wcslen (ns) + 1; + temp = _wcsdup (result); + result = malloc (bLen * sizeof (wchar_t)); + if (swprintf (result, bLen, L"%ls%ls", ns, temp) <= 0) + { + goto cleanup; + } + + free (temp); + + return result; + +cleanup: + free (temp); + free (result); + return NULL; +} + +#define HAS_FLAG(a,b) ((a & b) == b) + +int FS(swopen) (const wchar_t* filename, int oflag, int shflag, int pmode) +{ + /* Construct access mode. */ + DWORD dwDesiredAccess = 0; + if (HAS_FLAG (oflag, _O_RDONLY)) + dwDesiredAccess |= GENERIC_READ | FILE_READ_DATA | FILE_READ_ATTRIBUTES | + FILE_WRITE_ATTRIBUTES;; + if (HAS_FLAG (oflag, _O_RDWR)) + dwDesiredAccess |= GENERIC_WRITE | GENERIC_READ | FILE_READ_DATA | + FILE_WRITE_DATA | FILE_READ_ATTRIBUTES | + FILE_WRITE_ATTRIBUTES; + if (HAS_FLAG (oflag, _O_WRONLY)) + dwDesiredAccess|= GENERIC_WRITE | FILE_WRITE_DATA | + FILE_READ_ATTRIBUTES | FILE_WRITE_ATTRIBUTES; + + /* Construct shared mode. */ + DWORD dwShareMode = FILE_SHARE_DELETE | FILE_SHARE_READ | FILE_SHARE_WRITE; + if (HAS_FLAG (shflag, _SH_DENYRW)) + dwShareMode &= ~(FILE_SHARE_READ | FILE_SHARE_WRITE); + if (HAS_FLAG (shflag, _SH_DENYWR)) + dwShareMode &= ~FILE_SHARE_WRITE; + if (HAS_FLAG (shflag, _SH_DENYRD)) + dwShareMode &= ~FILE_SHARE_READ; + if (HAS_FLAG (pmode, _S_IWRITE)) + dwShareMode |= FILE_SHARE_READ | FILE_SHARE_WRITE; + if (HAS_FLAG (pmode, _S_IREAD)) + dwShareMode |= FILE_SHARE_READ; + + /* Override access mode with pmode if creating file. */ + if (HAS_FLAG (oflag, _O_CREAT)) + { + if (HAS_FLAG (pmode, _S_IWRITE)) + dwDesiredAccess |= FILE_GENERIC_WRITE; + if (HAS_FLAG (pmode, _S_IREAD)) + dwDesiredAccess |= FILE_GENERIC_READ; + } + + /* Create file disposition. */ + DWORD dwCreationDisposition = OPEN_EXISTING; + if (HAS_FLAG (oflag, _O_CREAT)) + dwCreationDisposition = OPEN_ALWAYS; + if (HAS_FLAG (oflag, (_O_CREAT | _O_EXCL))) + dwCreationDisposition = CREATE_NEW; + if (HAS_FLAG (oflag, _O_TRUNC) && !HAS_FLAG (oflag, _O_CREAT)) + dwCreationDisposition = TRUNCATE_EXISTING; + + /* Set file access attributes. */ + DWORD dwFlagsAndAttributes = FILE_ATTRIBUTE_NORMAL; + if (HAS_FLAG (oflag, _O_RDONLY)) + dwFlagsAndAttributes |= 0; /* No special attribute. */ + if (HAS_FLAG (oflag, (_O_CREAT | _O_TEMPORARY))) + dwFlagsAndAttributes |= FILE_FLAG_DELETE_ON_CLOSE; + if (HAS_FLAG (oflag, (_O_CREAT | _O_SHORT_LIVED))) + dwFlagsAndAttributes |= FILE_ATTRIBUTE_TEMPORARY; + if (HAS_FLAG (oflag, _O_RANDOM)) + dwFlagsAndAttributes |= FILE_FLAG_RANDOM_ACCESS; + if (HAS_FLAG (oflag, _O_SEQUENTIAL)) + dwFlagsAndAttributes |= FILE_FLAG_SEQUENTIAL_SCAN; + /* Flag is only valid on it's own. */ + if (dwFlagsAndAttributes != FILE_ATTRIBUTE_NORMAL) + dwFlagsAndAttributes &= ~FILE_ATTRIBUTE_NORMAL; + + /* Set security attributes. */ + SECURITY_ATTRIBUTES securityAttributes; + ZeroMemory (&securityAttributes, sizeof(SECURITY_ATTRIBUTES)); + securityAttributes.bInheritHandle = !(oflag & _O_NOINHERIT); + securityAttributes.lpSecurityDescriptor = NULL; + securityAttributes.nLength = sizeof(SECURITY_ATTRIBUTES); + + wchar_t* _filename = __hs_create_device_name (filename); + if (!_filename) + return -1; + + HANDLE hResult + = CreateFileW (_filename, dwDesiredAccess, dwShareMode, &securityAttributes, + dwCreationDisposition, dwFlagsAndAttributes, NULL); + free (_filename); + if (INVALID_HANDLE_VALUE == hResult) + return -1; + + /* Now we have a Windows handle, we have to convert it to an FD and apply + the remaining flags. */ + const int flag_mask = _O_APPEND | _O_RDONLY | _O_TEXT | _O_WTEXT; + int fd = _open_osfhandle ((intptr_t)hResult, oflag & flag_mask); + if (-1 == fd) + return -1; + + /* Finally we can change the mode to the requested one. */ + const int mode_mask = _O_TEXT | _O_BINARY | _O_U16TEXT | _O_U8TEXT | _O_WTEXT; + if ((oflag & mode_mask) && (-1 == _setmode (fd, oflag & mode_mask))) + return -1; + + return fd; +} + +FILE *FS(fwopen) (const wchar_t* filename, const wchar_t* mode) +{ + int shflag = 0; + int pmode = 0; + int oflag = 0; + + int len = wcslen (mode); + int i; + #define IS_EXT(X) ((i < (len - 1)) && mode[i] == X) + + for (i = 0; i < len; i++) + { + switch (mode[i]) + { + case L'a': + if (IS_EXT (L'+')) + oflag |= _O_RDWR | _O_CREAT | _O_APPEND; + else + oflag |= _O_WRONLY | _O_CREAT | _O_APPEND; + break; + case L'r': + if (IS_EXT (L'+')) + oflag |= _O_RDWR; + else + oflag |= _O_RDONLY; + break; + case L'w': + if (IS_EXT (L'+')) + oflag |= _O_RDWR | _O_CREAT | _O_TRUNC; + else + oflag |= _O_WRONLY | _O_CREAT | _O_TRUNC; + break; + case L'b': + oflag |= _O_BINARY; + break; + case L't': + oflag |= _O_TEXT; + break; + case L'c': + case L'n': + oflag |= 0; + break; + case L'S': + oflag |= _O_SEQUENTIAL; + break; + case L'R': + oflag |= _O_RANDOM; + break; + case L'T': + oflag |= _O_SHORT_LIVED; + break; + case L'D': + oflag |= _O_TEMPORARY; + break; + default: + if (wcsncmp (mode, L"ccs=UNICODE", 11) == 0) + oflag |= _O_WTEXT; + else if (wcsncmp (mode, L"ccs=UTF-8", 9) == 0) + oflag |= _O_U8TEXT; + else if (wcsncmp (mode, L"ccs=UTF-16LE", 12) == 0) + oflag |= _O_U16TEXT; + else continue; + } + } + #undef IS_EXT + + int fd = FS(swopen) (filename, oflag, shflag, pmode); + FILE* file = _wfdopen (fd, mode); + return file; +} + +FILE *FS(fopen) (const char* filename, const char* mode) +{ + size_t len = mbstowcs (NULL, filename, 0); + wchar_t *w_filename = malloc (sizeof (wchar_t) * (len + 1)); + mbstowcs (w_filename, filename, len); + w_filename[len] = L'\0'; + + len = mbstowcs (NULL, mode, 0); + wchar_t *w_mode = malloc (sizeof (wchar_t) * (len + 1)); + mbstowcs (w_mode, mode, len); + w_mode[len] = L'\0'; + + FILE *result = FS(fwopen) (w_filename, w_mode); + free (w_filename); + free (w_mode); + return result; +} +#else +FILE *FS(fopen) (const char* filename, const char* mode) +{ + return fopen (filename, mode); +} +#endif diff --git a/utils/fs/fs.h b/utils/fs/fs.h new file mode 100644 index 0000000000..ab2eded2a1 --- /dev/null +++ b/utils/fs/fs.h @@ -0,0 +1,36 @@ +/* ----------------------------------------------------------------------------- + * + * (c) Tamar Christina 2018 + * + * Windows I/O routines for file opening. + * + * NOTE: Only modify this file in utils/fs/ and rerun configure. Do not edit + * this file in any other directory as it will be overwritten. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include <stdio.h> + +#if !defined(FS_NAMESPACE) +#define FS_NAMESPACE hs +#endif + +/* Play some dirty tricks to get CPP to expand correctly. */ +#define FS_FULL(ns, name) __##ns##_##name +#define prefix FS_NAMESPACE +#define FS_L(p, n) FS_FULL(p, n) +#define FS(name) FS_L(prefix, name) + +#if defined(_WIN32) +#include <wchar.h> + +int FS(swopen) (const wchar_t* filename, int oflag, + int shflag, int pmode); +FILE *FS(fwopen) (const wchar_t* filename, const wchar_t* mode); +FILE *FS(fopen) (const char* filename, const char* mode); +#else + +FILE *FS(fopen) (const char* filename, const char* mode); +#endif diff --git a/utils/lndir/lndir.c b/utils/lndir/lndir.c index 87f2824166..8ea5ab2ab4 100644 --- a/utils/lndir/lndir.c +++ b/utils/lndir/lndir.c @@ -2,7 +2,7 @@ /* Create shadow link tree (after X11R4 script of the same name) Mark Reinhold (mbr@lcs.mit.edu)/3 January 1990 */ -/* +/* Copyright (c) 1990, X Consortium Permission is hereby granted, free of charge, to any person obtaining a copy @@ -46,6 +46,7 @@ in this Software without prior written authorization from the X Consortium. #define NeedVarargsPrototypes 1 #include "lndir-Xos.h" +#include "fs.h" #include <stdlib.h> #include <stdio.h> #include <sys/stat.h> @@ -182,11 +183,11 @@ int copyfile(const char *oldpath, const char *newpath) { return symlink(oldpath, newpath); } else { #endif - f_old = fopen(oldpath, "rb"); + f_old = __hs_fopen(oldpath, "rb"); if (f_old == NULL) { return -1; } - f_new = fopen(newpath, "wbx"); + f_new = __hs_fopen(newpath, "wbx"); if (f_new == NULL) { e = errno; fclose(f_old); @@ -272,7 +273,7 @@ int rel; /* if true, prepend "../" to fn before using */ else buf[0] = '\0'; strcat (buf, fn); - + if (!(df = opendir (buf))) { msg ("%s: Cannot opendir", buf); return 1; @@ -305,7 +306,7 @@ int rel; /* if true, prepend "../" to fn before using */ #if defined(S_ISDIR) if(S_ISDIR(sb.st_mode)) #else - if (sb.st_mode & S_IFDIR) + if (sb.st_mode & S_IFDIR) #endif { /* directory */ @@ -397,7 +398,7 @@ int rel; /* if true, prepend "../" to fn before using */ mperror (dp->d_name); } } - + closedir (df); return 0; } @@ -410,7 +411,7 @@ char **av; char* tn; struct stat fs, ts; #if defined(__CYGWIN32__) - /* + /* The lndir code assumes unix-style paths to work. cygwin lets you get away with using dos'ish paths (e.g., "f:/oo") in most contexts. Using them with 'lndir' will seriously @@ -457,7 +458,7 @@ char **av; if (stat (tn, &ts) < 0) { if (force && (tn[0] != '.' || tn[1] != '\0') ) { mymkdir(tn, S_IRWXU | S_IRWXG | S_IROTH | S_IXOTH ); - } + } else { quiterr (1, tn); #if defined(S_ISDIR) diff --git a/utils/unlit/ghc.mk b/utils/unlit/ghc.mk index 8911f4e856..0560aa57b8 100644 --- a/utils/unlit/ghc.mk +++ b/utils/unlit/ghc.mk @@ -11,7 +11,7 @@ # ----------------------------------------------------------------------------- # built by ghc-stage0 -utils/unlit_dist_C_SRCS = unlit.c +utils/unlit_dist_C_SRCS = unlit.c fs.c utils/unlit_dist_PROGNAME = unlit utils/unlit_dist_TOPDIR = YES utils/unlit_dist_INSTALL_INPLACE = YES diff --git a/utils/unlit/unlit.c b/utils/unlit/unlit.c index 4eb91d71be..97f853b268 100644 --- a/utils/unlit/unlit.c +++ b/utils/unlit/unlit.c @@ -7,7 +7,7 @@ * column on each line. It is hoped that this style of programming will * encourage the writing of accurate and clearly documented programs * in which the writer may include motivating arguments, examples - * and explanations. + * and explanations. * * Unlit is a filter that can be used to strip all of the comment lines * out of a literate script file. The command format for unlit is: @@ -40,6 +40,7 @@ * And \begin{pseudocode} ... \end{pseudocode}. -- LA */ +#include "fs.h" #include <string.h> #include <stdio.h> #include <stdlib.h> @@ -115,7 +116,7 @@ static void myputc(char c, FILE *ostream) { if (putc(c,ostream) == EOF) { writeerror(); - } + } } #define TABPOS 8 @@ -179,7 +180,7 @@ static line readline(FILE *istream, FILE *ostream) { if (c==EOF) return ENDFILE; - + if ( c == '#' ) { if ( ignore_shebang ) { c1 = egetc(istream); @@ -335,10 +336,10 @@ int main(int argc,char **argv) else if (strcmp(*argv,"-h")==0) { if (argc > 1) { argc--; argv++; - if (prefix_str) + if (prefix_str) free(prefix_str); prefix_str = (char*)malloc(sizeof(char)*(1+strlen(*argv))); - if (prefix_str) + if (prefix_str) strcpy(prefix_str, *argv); } } else if (strcmp(*argv,"-#")==0) @@ -362,16 +363,16 @@ int main(int argc,char **argv) file = "stdin"; } else - if ((istream=fopen(argv[0], "r")) == NULL) { + if ((istream=__hs_fopen(argv[0], "r")) == NULL) { fprintf(stderr, CANNOTOPEN, argv[0]); exit(1); } ofilename=argv[1]; - if (strcmp(argv[1], "-")==0) - ostream = stdout; + if (strcmp(argv[1], "-")==0) + ostream = stdout; else - if ((ostream=fopen(argv[1], "w")) == NULL) { + if ((ostream=__hs_fopen(argv[1], "w")) == NULL) { fprintf(stderr, CANNOTOPEN, argv[1]); exit(1); } diff --git a/utils/unlit/unlit.cabal b/utils/unlit/unlit.cabal index a621f04bc7..622a55934d 100644 --- a/utils/unlit/unlit.cabal +++ b/utils/unlit/unlit.cabal @@ -13,4 +13,5 @@ build-type: Simple Executable unlit Default-Language: Haskell2010 Main-Is: unlit.c - C-Sources: unlit.c + C-Sources: unlit.c, fs.c + Includes: fs.h |