unix-compat-0.7/0000755000000000000000000000000007346545000012015 5ustar0000000000000000unix-compat-0.7/CHANGELOG.md0000644000000000000000000000021107346545000013620 0ustar0000000000000000## Version 0.7 (2023-03-15) - Remote `System.PosixCompat.User` module ## Version 0.6 (2022-05-22) - Better support for symbolic links unix-compat-0.7/LICENSE0000644000000000000000000000315407346545000013025 0ustar0000000000000000BSD 3-Clause License Copyright (c) 2007-2008, Björn Bringert Copyright (c) 2007-2009, Duncan Coutts Copyright (c) 2010-2011, Jacob Stanley Copyright (c) 2011, Bryan O'Sullivan All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither the names of the copyright owners nor the names of the contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. unix-compat-0.7/Setup.lhs0000644000000000000000000000010307346545000013617 0ustar0000000000000000> import Distribution.Simple > main :: IO () > main = defaultMain unix-compat-0.7/cbits/0000755000000000000000000000000007346545000013121 5ustar0000000000000000unix-compat-0.7/cbits/HsUname.c0000644000000000000000000003044007346545000014626 0ustar0000000000000000/* * For details of what's going on here, see the following URL: * * http://msdn.microsoft.com/en-us/library/ms724429(v=vs.85).aspx */ #include #include #include #ifdef _MSC_VER # include #else static void StringCchCopy(char *dest, size_t bufsize, const char *src) { strcpy(dest, src); } static void StringCchCat(char *dest, size_t bufsize, const char *src) { strcat(dest, src); } #define StringCchPrintf _snprintf #endif typedef void (WINAPI *PGNSI)(LPSYSTEM_INFO); typedef BOOL (WINAPI *PGPI)(DWORD, DWORD, DWORD, DWORD, PDWORD); #ifndef PRODUCT_ULTIMATE # define PRODUCT_ULTIMATE 0x00000001 #endif #ifndef PRODUCT_PROFESSIONAL # define PRODUCT_PROFESSIONAL 0x00000030 #endif #ifndef PRODUCT_HOME_PREMIUM # define PRODUCT_HOME_PREMIUM 0x00000003 #endif #ifndef PRODUCT_HOME_BASIC # define PRODUCT_HOME_BASIC 0x00000002 #endif #ifndef PRODUCT_BUSINESS # define PRODUCT_BUSINESS 0x00000006 #endif #ifndef PRODUCT_ENTERPRISE # define PRODUCT_ENTERPRISE 0x00000004 #endif #ifndef PRODUCT_STARTER # define PRODUCT_STARTER 0x0000000B #endif #ifndef PRODUCT_CLUSTER_SERVER # define PRODUCT_CLUSTER_SERVER 0x00000012 #endif #ifndef PRODUCT_DATACENTER_SERVER # define PRODUCT_DATACENTER_SERVER 0x00000008 #endif #ifndef PRODUCT_DATACENTER_SERVER_CORE # define PRODUCT_DATACENTER_SERVER_CORE 0x0000000C #endif #ifndef PRODUCT_ENTERPRISE_SERVER # define PRODUCT_ENTERPRISE_SERVER 0x0000000A #endif #ifndef PRODUCT_ENTERPRISE_SERVER_CORE # define PRODUCT_ENTERPRISE_SERVER_CORE 0x0000000E #endif #ifndef PRODUCT_ENTERPRISE_SERVER_IA64 # define PRODUCT_ENTERPRISE_SERVER_IA64 0x0000000F #endif #ifndef PRODUCT_SMALLBUSINESS_SERVER # define PRODUCT_SMALLBUSINESS_SERVER 0x00000009 #endif #ifndef PRODUCT_SMALLBUSINESS_SERVER_PREMIUM # define PRODUCT_SMALLBUSINESS_SERVER_PREMIUM 0x00000019 #endif #ifndef PRODUCT_STANDARD_SERVER # define PRODUCT_STANDARD_SERVER 0x00000007 #endif #ifndef PRODUCT_STANDARD_SERVER_CORE # define PRODUCT_STANDARD_SERVER_CORE 0x0000000D #endif #ifndef PRODUCT_WEB_SERVER # define PRODUCT_WEB_SERVER 0x00000011 #endif #ifndef VER_SUITE_WH_SERVER # define VER_SUITE_WH_SERVER 0x00008000 #endif int unixcompat_os_display_string(char *pszOS, size_t BUFSIZE) { OSVERSIONINFOEX osvi; SYSTEM_INFO si; PGNSI pGNSI; PGPI pGPI; BOOL bOsVersionInfoEx; DWORD dwType; ZeroMemory(&si, sizeof(SYSTEM_INFO)); ZeroMemory(&osvi, sizeof(OSVERSIONINFOEX)); osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFOEX); bOsVersionInfoEx = GetVersionEx((OSVERSIONINFO*) &osvi); if (bOsVersionInfoEx == 0) return FALSE; // Call GetNativeSystemInfo if supported or GetSystemInfo otherwise. pGNSI = (PGNSI) GetProcAddress( GetModuleHandle(TEXT("kernel32.dll")), "GetNativeSystemInfo"); if (NULL != pGNSI) pGNSI(&si); else GetSystemInfo(&si); if (VER_PLATFORM_WIN32_NT == osvi.dwPlatformId && osvi.dwMajorVersion > 4) { StringCchCopy(pszOS, BUFSIZE, TEXT("Microsoft ")); // Test for the specific product. if (osvi.dwMajorVersion == 6) { if(osvi.dwMinorVersion == 0) { if(osvi.wProductType == VER_NT_WORKSTATION) StringCchCat(pszOS, BUFSIZE, TEXT("Windows Vista ")); else StringCchCat(pszOS, BUFSIZE, TEXT("Windows Server 2008 ")); } if (osvi.dwMinorVersion == 1) { if (osvi.wProductType == VER_NT_WORKSTATION) StringCchCat(pszOS, BUFSIZE, TEXT("Windows 7 ")); else StringCchCat(pszOS, BUFSIZE, TEXT("Windows Server 2008 R2 ")); } pGPI = (PGPI) GetProcAddress( GetModuleHandle(TEXT("kernel32.dll")), "GetProductInfo"); pGPI(osvi.dwMajorVersion, osvi.dwMinorVersion, 0, 0, &dwType); switch (dwType) { case PRODUCT_ULTIMATE: StringCchCat(pszOS, BUFSIZE, TEXT("Ultimate Edition")); break; case PRODUCT_PROFESSIONAL: StringCchCat(pszOS, BUFSIZE, TEXT("Professional")); break; case PRODUCT_HOME_PREMIUM: StringCchCat(pszOS, BUFSIZE, TEXT("Home Premium Edition")); break; case PRODUCT_HOME_BASIC: StringCchCat(pszOS, BUFSIZE, TEXT("Home Basic Edition")); break; case PRODUCT_ENTERPRISE: StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition")); break; case PRODUCT_BUSINESS: StringCchCat(pszOS, BUFSIZE, TEXT("Business Edition")); break; case PRODUCT_STARTER: StringCchCat(pszOS, BUFSIZE, TEXT("Starter Edition")); break; case PRODUCT_CLUSTER_SERVER: StringCchCat(pszOS, BUFSIZE, TEXT("Cluster Server Edition")); break; case PRODUCT_DATACENTER_SERVER: StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Edition")); break; case PRODUCT_DATACENTER_SERVER_CORE: StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Edition (core installation)")); break; case PRODUCT_ENTERPRISE_SERVER: StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition")); break; case PRODUCT_ENTERPRISE_SERVER_CORE: StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition (core installation)")); break; case PRODUCT_ENTERPRISE_SERVER_IA64: StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition for Itanium-based Systems")); break; case PRODUCT_SMALLBUSINESS_SERVER: StringCchCat(pszOS, BUFSIZE, TEXT("Small Business Server")); break; case PRODUCT_SMALLBUSINESS_SERVER_PREMIUM: StringCchCat(pszOS, BUFSIZE, TEXT("Small Business Server Premium Edition")); break; case PRODUCT_STANDARD_SERVER: StringCchCat(pszOS, BUFSIZE, TEXT("Standard Edition")); break; case PRODUCT_STANDARD_SERVER_CORE: StringCchCat(pszOS, BUFSIZE, TEXT("Standard Edition (core installation)")); break; case PRODUCT_WEB_SERVER: StringCchCat(pszOS, BUFSIZE, TEXT("Web Server Edition")); break; } } if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 2) { if (GetSystemMetrics(SM_SERVERR2)) StringCchCat(pszOS, BUFSIZE, TEXT("Windows Server 2003 R2, ")); else if (osvi.wSuiteMask & VER_SUITE_STORAGE_SERVER) StringCchCat(pszOS, BUFSIZE, TEXT("Windows Storage Server 2003")); else if (osvi.wSuiteMask & VER_SUITE_WH_SERVER) StringCchCat(pszOS, BUFSIZE, TEXT("Windows Home Server")); else if (osvi.wProductType == VER_NT_WORKSTATION && si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) StringCchCat(pszOS, BUFSIZE, TEXT("Windows XP Professional x64 Edition")); else StringCchCat(pszOS, BUFSIZE, TEXT("Windows Server 2003, ")); // Test for the server type. if (osvi.wProductType != VER_NT_WORKSTATION) { if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_IA64) { if(osvi.wSuiteMask & VER_SUITE_DATACENTER) StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Edition for Itanium-based Systems")); else if(osvi.wSuiteMask & VER_SUITE_ENTERPRISE) StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition for Itanium-based Systems")); } else if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) { if(osvi.wSuiteMask & VER_SUITE_DATACENTER) StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter x64 Edition")); else if(osvi.wSuiteMask & VER_SUITE_ENTERPRISE) StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise x64 Edition")); else StringCchCat(pszOS, BUFSIZE, TEXT("Standard x64 Edition")); } else { if (osvi.wSuiteMask & VER_SUITE_COMPUTE_SERVER) StringCchCat(pszOS, BUFSIZE, TEXT("Compute Cluster Edition")); else if(osvi.wSuiteMask & VER_SUITE_DATACENTER) StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Edition")); else if(osvi.wSuiteMask & VER_SUITE_ENTERPRISE) StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition")); else if (osvi.wSuiteMask & VER_SUITE_BLADE) StringCchCat(pszOS, BUFSIZE, TEXT("Web Edition")); else StringCchCat(pszOS, BUFSIZE, TEXT("Standard Edition")); } } } if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 1) { StringCchCat(pszOS, BUFSIZE, TEXT("Windows XP ")); if (osvi.wSuiteMask & VER_SUITE_PERSONAL) StringCchCat(pszOS, BUFSIZE, TEXT("Home Edition")); else StringCchCat(pszOS, BUFSIZE, TEXT("Professional")); } if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 0) { StringCchCat(pszOS, BUFSIZE, TEXT("Windows 2000 ")); if (osvi.wProductType == VER_NT_WORKSTATION) { StringCchCat(pszOS, BUFSIZE, TEXT("Professional")); } else { if(osvi.wSuiteMask & VER_SUITE_DATACENTER) StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Server")); else if(osvi.wSuiteMask & VER_SUITE_ENTERPRISE) StringCchCat(pszOS, BUFSIZE, TEXT("Advanced Server")); else StringCchCat(pszOS, BUFSIZE, TEXT("Server")); } } // Include service pack (if any) and build number. if(_tcslen(osvi.szCSDVersion) > 0) { StringCchCat(pszOS, BUFSIZE, TEXT(" ")); StringCchCat(pszOS, BUFSIZE, osvi.szCSDVersion); } char buf[80]; StringCchPrintf(buf, 80, TEXT(" (build %d)"), osvi.dwBuildNumber); StringCchCat(pszOS, BUFSIZE, buf); if (osvi.dwMajorVersion >= 6) { if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) StringCchCat(pszOS, BUFSIZE, TEXT(", 64-bit")); else if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_INTEL) StringCchCat(pszOS, BUFSIZE, TEXT(", 32-bit")); } return TRUE; } else { // This sample does not support this version of Windows. return FALSE; } } int unixcompat_os_version_string(char *ptr, size_t bufsize) { OSVERSIONINFOEX osvi; BOOL bOsVersionInfoEx; char *szServicePack; ZeroMemory(&osvi, sizeof(OSVERSIONINFOEX)); osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFOEX); bOsVersionInfoEx = GetVersionEx((OSVERSIONINFO*) &osvi); if (bOsVersionInfoEx == 0) return FALSE; if (strncmp(osvi.szCSDVersion, "Service Pack ", 13) == 0) szServicePack = "0"; else szServicePack = osvi.szCSDVersion + 13; StringCchPrintf(ptr, bufsize, "%ld.%ld.%s.%ld", osvi.dwMajorVersion, osvi.dwMinorVersion, szServicePack, osvi.dwBuildNumber); return TRUE; } int unixcompat_os_arch_string(char *ptr, size_t bufsize) { SYSTEM_INFO sysInfo; GetSystemInfo(&sysInfo); switch (sysInfo.wProcessorArchitecture) { case PROCESSOR_ARCHITECTURE_INTEL: StringCchCopy(ptr, bufsize, "i386"); break; case PROCESSOR_ARCHITECTURE_AMD64: StringCchCopy(ptr, bufsize, "x86_64"); break; default: StringCchCopy(ptr, bufsize, "unknown"); break; } return TRUE; } int unixcompat_os_node_name(char *ptr, size_t bufsize) { DWORD sLength; sLength = bufsize - 1; GetComputerName(ptr, &sLength); return TRUE; } unix-compat-0.7/cbits/HsUnixCompat.c0000644000000000000000000000052407346545000015650 0ustar0000000000000000#include "HsUnixCompat.h" #ifdef SOLARIS #include #elif defined(__linux__) #include #endif unsigned int unix_major(dev_t dev) { return major(dev); } unsigned int unix_minor(dev_t dev) { return minor(dev); } dev_t unix_makedev(unsigned int maj, unsigned int min) { return makedev(maj, min); } unix-compat-0.7/cbits/mktemp.c0000644000000000000000000001240207346545000014561 0ustar0000000000000000/* * Modified version of 'mktemp.c' from FreeBSD * http://www.freebsd.org/cgi/cvsweb.cgi/src/lib/libc/stdio/mktemp.c * ?rev=1.29.2.2.2.1;content-type=text%2Fplain */ /* * Copyright (c) 1987, 1993 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ #include #include #include #include #include #include #include #include #include #include static int random(uint32_t *); static int _gettemp(char *, int *); static const unsigned char padchar[] = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; int unixcompat_mkstemp(char *path) { int fd; if (_gettemp(path, &fd)) return fd; return -1; } static int _gettemp(char *path, int *doopen) { char *start, *trv, *suffp, *carryp; char *pad; struct _stat sbuf; int rval; uint32_t randidx, randval; char carrybuf[MAXPATHLEN]; for (trv = path; *trv != '\0'; ++trv) ; if (trv - path >= MAXPATHLEN) { errno = ENAMETOOLONG; return (0); } suffp = trv; --trv; if (trv < path || NULL != strchr(suffp, '/')) { errno = EINVAL; return (0); } /* Fill space with random characters */ while (trv >= path && *trv == 'X') { if (!random(&randval)) { /* this should never happen */ errno = EIO; return 0; } randidx = randval % (sizeof(padchar) - 1); *trv-- = padchar[randidx]; } start = trv + 1; /* save first combination of random characters */ memcpy(carrybuf, start, suffp - start); /* * check the target directory. */ if (doopen != NULL) { for (; trv > path; --trv) { if (*trv == '/') { *trv = '\0'; rval = _stat(path, &sbuf); *trv = '/'; if (rval != 0) return (0); if (!S_ISDIR(sbuf.st_mode)) { errno = ENOTDIR; return (0); } break; } } } for (;;) { if (doopen) { if ((*doopen = _open(path, O_CREAT|O_EXCL|O_RDWR, 0600)) >= 0) return (1); if (errno != EEXIST) return (0); } else if (_stat(path, &sbuf)) return (errno == ENOENT); /* If we have a collision, cycle through the space of filenames */ for (trv = start, carryp = carrybuf;;) { /* have we tried all possible permutations? */ if (trv == suffp) return (0); /* yes - exit with EEXIST */ pad = strchr(padchar, *trv); if (pad == NULL) { /* this should never happen */ errno = EIO; return (0); } /* increment character */ *trv = (*++pad == '\0') ? padchar[0] : *pad; /* carry to next position? */ if (*trv == *carryp) { /* increment position and loop */ ++trv; ++carryp; } else { /* try with new name */ break; } } } /*NOTREACHED*/ } static int random(uint32_t *value) { /* This handle is never released. Windows will clean up when the process * exits. Python takes this approach when emulating /dev/urandom, and if * it's good enough for them, then it's good enough for us. */ static HCRYPTPROV context = 0; if (context == 0) if (!CryptAcquireContext( &context, NULL, NULL, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)) return 0; if (!CryptGenRandom(context, sizeof *value, (BYTE *)value)) return 0; return 1; } unix-compat-0.7/include/0000755000000000000000000000000007346545000013440 5ustar0000000000000000unix-compat-0.7/include/HsUnixCompat.h0000644000000000000000000000035207346545000016173 0ustar0000000000000000#include "HsUnixConfig.h" #include unsigned int unix_major(dev_t dev); unsigned int unix_minor(dev_t dev); dev_t unix_makedev(unsigned int maj, unsigned int min); #define NEED_setSymbolicLinkOwnerAndGroup !HAVE_LCHOWN unix-compat-0.7/src/System/0000755000000000000000000000000007346545000014070 5ustar0000000000000000unix-compat-0.7/src/System/PosixCompat.hs0000644000000000000000000000161707346545000016677 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| The @unix-compat@ package provides portable implementations of parts of the @unix@ package. On POSIX system it re-exports operations from the @unix@ package, on other platforms it emulates the operations as far as possible. -} module System.PosixCompat ( module System.PosixCompat.Files , module System.PosixCompat.Temp , module System.PosixCompat.Time , module System.PosixCompat.Types , module System.PosixCompat.Unistd , usingPortableImpl ) where import System.PosixCompat.Files import System.PosixCompat.Temp import System.PosixCompat.Time import System.PosixCompat.Types import System.PosixCompat.Unistd -- | 'True' if unix-compat is using its portable implementation, -- or 'False' if the unix package is simply being re-exported. usingPortableImpl :: Bool #ifdef mingw32_HOST_OS usingPortableImpl = True #else usingPortableImpl = False #endif unix-compat-0.7/src/System/PosixCompat/0000755000000000000000000000000007346545000016336 5ustar0000000000000000unix-compat-0.7/src/System/PosixCompat/Extensions.hsc0000644000000000000000000000253207346545000021176 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} -- | This module provides some functions not present in the unix package. module System.PosixCompat.Extensions ( -- * Device IDs. CMajor , CMinor , deviceMajor , deviceMinor , makeDeviceID ) where #ifndef mingw32_HOST_OS #include "HsUnixCompat.h" #endif import Foreign.C.Types import System.PosixCompat.Types type CMajor = CUInt type CMinor = CUInt -- | Gets the major number from a 'DeviceID' for a device file. -- -- The portable implementation always returns @0@. deviceMajor :: DeviceID -> CMajor #ifdef mingw32_HOST_OS deviceMajor _ = 0 #else deviceMajor dev = unix_major dev foreign import ccall unsafe "unix_major" unix_major :: CDev -> CUInt #endif -- | Gets the minor number from a 'DeviceID' for a device file. -- -- The portable implementation always returns @0@. deviceMinor :: DeviceID -> CMinor #ifdef mingw32_HOST_OS deviceMinor _ = 0 #else deviceMinor dev = unix_minor dev foreign import ccall unsafe "unix_minor" unix_minor :: CDev -> CUInt #endif -- | Creates a 'DeviceID' for a device file given a major and minor number. makeDeviceID :: CMajor -> CMinor -> DeviceID #ifdef mingw32_HOST_OS makeDeviceID _ _ = 0 #else makeDeviceID ma mi = unix_makedev ma mi foreign import ccall unsafe "unix_makedev" unix_makedev :: CUInt -> CUInt -> CDev #endif unix-compat-0.7/src/System/PosixCompat/Files.hsc0000644000000000000000000004250407346545000020104 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| This module makes the operations exported by @System.Posix.Files@ available on all platforms. On POSIX systems it re-exports operations from @System.Posix.Files@. On other platforms it emulates the operations as far as possible. /NOTE: the portable implementations are not well tested, in some cases functions are only stubs./ -} module System.PosixCompat.Files ( -- * File modes -- FileMode exported by System.Posix.Types unionFileModes , intersectFileModes , nullFileMode , ownerReadMode , ownerWriteMode , ownerExecuteMode , ownerModes , groupReadMode , groupWriteMode , groupExecuteMode , groupModes , otherReadMode , otherWriteMode , otherExecuteMode , otherModes , setUserIDMode , setGroupIDMode , stdFileMode , accessModes -- ** Setting file modes , setFileMode , setFdMode , setFileCreationMask -- ** Checking file existence and permissions , fileAccess , fileExist -- * File status , FileStatus -- ** Obtaining file status , getFileStatus , getFdStatus , getSymbolicLinkStatus -- ** Querying file status , deviceID , fileID , fileMode , linkCount , fileOwner , fileGroup , specialDeviceID , fileSize , accessTime , modificationTime , statusChangeTime , accessTimeHiRes , modificationTimeHiRes , statusChangeTimeHiRes , isBlockDevice , isCharacterDevice , isNamedPipe , isRegularFile , isDirectory , isSymbolicLink , isSocket -- * Creation , createNamedPipe , createDevice -- * Hard links , createLink , removeLink -- * Symbolic links , createSymbolicLink , readSymbolicLink -- * Renaming files , rename -- * Changing file ownership , setOwnerAndGroup , setFdOwnerAndGroup , setSymbolicLinkOwnerAndGroup -- * Changing file timestamps , setFileTimes , touchFile -- * Setting file sizes , setFileSize , setFdSize -- * Find system-specific limits for a file , PathVar(..) , getPathVar , getFdPathVar ) where #ifndef mingw32_HOST_OS #include "HsUnixCompat.h" import System.Posix.Files #if NEED_setSymbolicLinkOwnerAndGroup import System.PosixCompat.Types setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO () setSymbolicLinkOwnerAndGroup _ _ _ = return () #endif #else /* Portable implementation */ import Control.Exception (bracket) import Control.Monad (liftM, liftM2) import Data.Bits ((.|.), (.&.)) import Data.Char (toLower) import Data.Int (Int64) import Data.Time.Clock.POSIX (POSIXTime) import Foreign.C.Types (CTime(..)) import Prelude hiding (read) import System.Directory (Permissions, emptyPermissions) import System.Directory (getPermissions, setPermissions) import System.Directory (readable, setOwnerReadable) import System.Directory (writable, setOwnerWritable) import System.Directory (executable, setOwnerExecutable) import System.Directory (searchable, setOwnerSearchable) import System.Directory (doesFileExist, doesDirectoryExist) import System.Directory (getSymbolicLinkTarget) import System.FilePath (takeExtension) import System.IO (IOMode(..), openFile, hSetFileSize, hClose) import System.IO.Error import System.PosixCompat.Types import System.Win32.File import System.Win32.HardLink (createHardLink) import System.Win32.Time (FILETIME(..), getFileTime, setFileTime) import System.Win32.Types (HANDLE) import System.PosixCompat.Internal.Time ( getClockTime, clockTimeToEpochTime ) #ifdef __GLASGOW_HASKELL__ import GHC.IO.Handle.FD (fdToHandle) #endif unsupported :: String -> IO a unsupported f = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing where x = "System.PosixCompat.Files." ++ f ++ ": not supported" -- ----------------------------------------------------------------------------- -- POSIX file modes nullFileMode :: FileMode nullFileMode = 0o000000 ownerReadMode :: FileMode ownerWriteMode :: FileMode ownerExecuteMode :: FileMode groupReadMode :: FileMode groupWriteMode :: FileMode groupExecuteMode :: FileMode otherReadMode :: FileMode otherWriteMode :: FileMode otherExecuteMode :: FileMode setUserIDMode :: FileMode setGroupIDMode :: FileMode ownerReadMode = 0o000400 ownerWriteMode = 0o000200 ownerExecuteMode = 0o000100 groupReadMode = 0o000040 groupWriteMode = 0o000020 groupExecuteMode = 0o000010 otherReadMode = 0o000004 otherWriteMode = 0o000002 otherExecuteMode = 0o000001 setUserIDMode = 0o004000 setGroupIDMode = 0o002000 stdFileMode :: FileMode ownerModes :: FileMode groupModes :: FileMode otherModes :: FileMode accessModes :: FileMode stdFileMode = ownerReadMode .|. ownerWriteMode .|. groupReadMode .|. groupWriteMode .|. otherReadMode .|. otherWriteMode ownerModes = ownerReadMode .|. ownerWriteMode .|. ownerExecuteMode groupModes = groupReadMode .|. groupWriteMode .|. groupExecuteMode otherModes = otherReadMode .|. otherWriteMode .|. otherExecuteMode accessModes = ownerModes .|. groupModes .|. otherModes unionFileModes :: FileMode -> FileMode -> FileMode unionFileModes m1 m2 = m1 .|. m2 intersectFileModes :: FileMode -> FileMode -> FileMode intersectFileModes m1 m2 = m1 .&. m2 fileTypeModes :: FileMode fileTypeModes = 0o0170000 blockSpecialMode :: FileMode characterSpecialMode :: FileMode namedPipeMode :: FileMode regularFileMode :: FileMode directoryMode :: FileMode symbolicLinkMode :: FileMode socketMode :: FileMode blockSpecialMode = 0o0060000 characterSpecialMode = 0o0020000 namedPipeMode = 0o0010000 regularFileMode = 0o0100000 directoryMode = 0o0040000 symbolicLinkMode = 0o0120000 socketMode = 0o0140000 setFileMode :: FilePath -> FileMode -> IO () setFileMode name m = setPermissions name $ modeToPerms m setFdMode :: Fd -> FileMode -> IO () setFdMode _ _ = unsupported "setFdMode" -- | The portable implementation does nothing and returns 'nullFileMode'. setFileCreationMask :: FileMode -> IO FileMode setFileCreationMask _ = return nullFileMode modeToPerms :: FileMode -> Permissions #ifdef DIRECTORY_1_0 modeToPerms m = Permissions { readable = m .&. ownerReadMode /= 0 , writable = m .&. ownerWriteMode /= 0 , executable = m .&. ownerExecuteMode /= 0 , searchable = m .&. ownerExecuteMode /= 0 } #else modeToPerms m = setOwnerReadable (m .&. ownerReadMode /= 0) $ setOwnerWritable (m .&. ownerWriteMode /= 0) $ setOwnerExecutable (m .&. ownerExecuteMode /= 0) $ setOwnerSearchable (m .&. ownerExecuteMode /= 0) $ emptyPermissions #endif -- ----------------------------------------------------------------------------- -- access() fileAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool fileAccess name read write exec = do perm <- getPermissions name return $ (not read || readable perm) && (not write || writable perm) && (not exec || executable perm || searchable perm) fileExist :: FilePath -> IO Bool fileExist name = liftM2 (||) (doesFileExist name) (doesDirectoryExist name) -- ----------------------------------------------------------------------------- -- stat() support data FileStatus = FileStatus { deviceID :: DeviceID , fileID :: FileID , fileMode :: FileMode , linkCount :: LinkCount , fileOwner :: UserID , fileGroup :: GroupID , specialDeviceID :: DeviceID , fileSize :: FileOffset , accessTime :: EpochTime , modificationTime :: EpochTime , statusChangeTime :: EpochTime , accessTimeHiRes :: POSIXTime , modificationTimeHiRes :: POSIXTime , statusChangeTimeHiRes :: POSIXTime } isBlockDevice :: FileStatus -> Bool isBlockDevice stat = (fileMode stat `intersectFileModes` fileTypeModes) == blockSpecialMode isCharacterDevice :: FileStatus -> Bool isCharacterDevice stat = (fileMode stat `intersectFileModes` fileTypeModes) == characterSpecialMode isNamedPipe :: FileStatus -> Bool isNamedPipe stat = (fileMode stat `intersectFileModes` fileTypeModes) == namedPipeMode isRegularFile :: FileStatus -> Bool isRegularFile stat = (fileMode stat `intersectFileModes` fileTypeModes) == regularFileMode isDirectory :: FileStatus -> Bool isDirectory stat = (fileMode stat `intersectFileModes` fileTypeModes) == directoryMode isSymbolicLink :: FileStatus -> Bool isSymbolicLink stat = (fileMode stat `intersectFileModes` fileTypeModes) == symbolicLinkMode isSocket :: FileStatus -> Bool isSocket stat = (fileMode stat `intersectFileModes` fileTypeModes) == socketMode getStatus :: Bool -> FilePath -> IO FileStatus getStatus forLink path = do info <- bracket openPath closeHandle getFileInformationByHandle let atime = windowsToPosixTime (bhfiLastAccessTime info) mtime = windowsToPosixTime (bhfiLastWriteTime info) ctime = windowsToPosixTime (bhfiCreationTime info) attr = bhfiFileAttributes info isLink = attr .&. fILE_ATTRIBUTE_REPARSE_POINT /= 0 isDir = attr .&. fILE_ATTRIBUTE_DIRECTORY /= 0 isWritable = attr .&. fILE_ATTRIBUTE_READONLY == 0 -- Contrary to Posix systems, directory symlinks on Windows have both -- fILE_ATTRIBUTE_REPARSE_POINT and fILE_ATTRIBUTE_DIRECTORY bits set. typ | isLink = symbolicLinkMode | isDir = directoryMode | otherwise = regularFileMode -- it's a lie but what can we do? perm = permissions path isWritable isDir return $ FileStatus { deviceID = fromIntegral (bhfiVolumeSerialNumber info) , fileID = fromIntegral (bhfiFileIndex info) , fileMode = typ .|. perm , linkCount = fromIntegral (bhfiNumberOfLinks info) , fileOwner = 0 , fileGroup = 0 , specialDeviceID = 0 , fileSize = fromIntegral (bhfiSize info) , accessTime = posixTimeToEpochTime atime , modificationTime = posixTimeToEpochTime mtime , statusChangeTime = posixTimeToEpochTime mtime , accessTimeHiRes = atime , modificationTimeHiRes = mtime , statusChangeTimeHiRes = ctime } where openPath = createFile path fILE_READ_EA (fILE_SHARE_READ .|. fILE_SHARE_WRITE .|. fILE_SHARE_DELETE) Nothing oPEN_EXISTING (fILE_FLAG_BACKUP_SEMANTICS .|. openReparsePoint) Nothing openReparsePoint = if forLink then fILE_FLAG_OPEN_REPARSE_POINT else 0 -- not yet defined in Win32 package: fILE_FLAG_OPEN_REPARSE_POINT :: FileAttributeOrFlag fILE_FLAG_OPEN_REPARSE_POINT = 0x00200000 -- Fused from System.Directory.Internal.Windows.getAccessPermissions -- and the former modeToPerms function. permissions path is_writable is_dir = r .|. w .|. x where is_executable = (toLower <$> takeExtension path) `elem` [".bat", ".cmd", ".com", ".exe"] r = ownerReadMode .|. groupReadMode .|. otherReadMode w = f is_writable (ownerWriteMode .|. groupWriteMode .|. otherWriteMode) x = f (is_executable || is_dir) (ownerExecuteMode .|. groupExecuteMode .|. otherExecuteMode) f True m = m f False _ = nullFileMode getSymbolicLinkStatus :: FilePath -> IO FileStatus getSymbolicLinkStatus = getStatus True getFileStatus :: FilePath -> IO FileStatus getFileStatus = getStatus False -- | Convert a 'POSIXTime' (synomym for 'Data.Time.Clock.NominalDiffTime') -- into an 'EpochTime' (integral number of seconds since epoch). This merely -- throws away the fractional part. posixTimeToEpochTime :: POSIXTime -> EpochTime posixTimeToEpochTime = fromInteger . floor -- three function stolen from System.Directory.Internals.Windows: -- | Difference between the Windows and POSIX epochs in units of 100ns. windowsPosixEpochDifference :: Num a => a windowsPosixEpochDifference = 116444736000000000 -- | Convert from Windows time to POSIX time. windowsToPosixTime :: FILETIME -> POSIXTime windowsToPosixTime (FILETIME t) = (fromIntegral t - windowsPosixEpochDifference) / 10000000 {- will be needed to /set/ high res timestamps, not yet supported -- | Convert from POSIX time to Windows time. This is lossy as Windows time -- has a resolution of only 100ns. posixToWindowsTime :: POSIXTime -> FILETIME posixToWindowsTime t = FILETIME $ truncate (t * 10000000 + windowsPosixEpochDifference) -} getFdStatus :: Fd -> IO FileStatus getFdStatus _ = unsupported "getFdStatus" createNamedPipe :: FilePath -> FileMode -> IO () createNamedPipe _ _ = unsupported "createNamedPipe" createDevice :: FilePath -> FileMode -> DeviceID -> IO () createDevice _ _ _ = unsupported "createDevice" -- ----------------------------------------------------------------------------- -- Hard links createLink :: FilePath -> FilePath -> IO () createLink = createHardLink removeLink :: FilePath -> IO () removeLink _ = unsupported "removeLink" -- ----------------------------------------------------------------------------- -- Symbolic Links createSymbolicLink :: FilePath -> FilePath -> IO () createSymbolicLink _ _ = unsupported "createSymbolicLink" readSymbolicLink :: FilePath -> IO FilePath readSymbolicLink = getSymbolicLinkTarget -- ----------------------------------------------------------------------------- -- Renaming rename :: FilePath -> FilePath -> IO () #if MIN_VERSION_Win32(2, 6, 0) rename name1 name2 = moveFileEx name1 (Just name2) mOVEFILE_REPLACE_EXISTING #else rename name1 name2 = moveFileEx name1 name2 mOVEFILE_REPLACE_EXISTING #endif -- ----------------------------------------------------------------------------- -- chown() -- | The portable implementation does nothing. setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO () setOwnerAndGroup _ _ _ = return () -- | The portable implementation does nothing. setFdOwnerAndGroup :: Fd -> UserID -> GroupID -> IO () setFdOwnerAndGroup _ _ _ = return () -- | The portable implementation does nothing. setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO () setSymbolicLinkOwnerAndGroup _ _ _ = return () -- ----------------------------------------------------------------------------- -- utime() setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO () setFileTimes file atime mtime = bracket openFileHandle closeHandle $ \handle -> do (creationTime, _, _) <- getFileTime handle setFileTimeCompat handle creationTime (epochTimeToFileTime atime) (epochTimeToFileTime mtime) where openFileHandle = createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing -- based on https://support.microsoft.com/en-us/kb/167296 epochTimeToFileTime (CTime t) = FILETIME (fromIntegral ll) where ll :: Int64 ll = fromIntegral t * 10000000 + 116444736000000000 setFileTimeCompat :: HANDLE -> FILETIME -> FILETIME -> FILETIME -> IO () setFileTimeCompat h crt acc wrt = #if MIN_VERSION_Win32(2, 12, 0) setFileTime h (Just crt) (Just acc) (Just wrt) #else setFileTime h crt acc wrt #endif touchFile :: FilePath -> IO () touchFile name = do t <- liftM clockTimeToEpochTime getClockTime setFileTimes name t t -- ----------------------------------------------------------------------------- -- Setting file sizes setFileSize :: FilePath -> FileOffset -> IO () setFileSize file off = bracket (openFile file WriteMode) (hClose) (\h -> hSetFileSize h (fromIntegral off)) setFdSize :: Fd -> FileOffset -> IO () #ifdef __GLASGOW_HASKELL__ setFdSize (Fd fd) off = do h <- fdToHandle (fromIntegral fd) hSetFileSize h (fromIntegral off) #else setFdSize fd off = unsupported "setFdSize" #endif -- ----------------------------------------------------------------------------- -- pathconf()/fpathconf() support data PathVar = FileSizeBits -- _PC_FILESIZEBITS | LinkLimit -- _PC_LINK_MAX | InputLineLimit -- _PC_MAX_CANON | InputQueueLimit -- _PC_MAX_INPUT | FileNameLimit -- _PC_NAME_MAX | PathNameLimit -- _PC_PATH_MAX | PipeBufferLimit -- _PC_PIPE_BUF -- These are described as optional in POSIX: -- _PC_ALLOC_SIZE_MIN -- _PC_REC_INCR_XFER_SIZE -- _PC_REC_MAX_XFER_SIZE -- _PC_REC_MIN_XFER_SIZE -- _PC_REC_XFER_ALIGN | SymbolicLinkLimit -- _PC_SYMLINK_MAX | SetOwnerAndGroupIsRestricted -- _PC_CHOWN_RESTRICTED | FileNamesAreNotTruncated -- _PC_NO_TRUNC | VDisableChar -- _PC_VDISABLE | AsyncIOAvailable -- _PC_ASYNC_IO | PrioIOAvailable -- _PC_PRIO_IO | SyncIOAvailable -- _PC_SYNC_IO getPathVar :: FilePath -> PathVar -> IO Limit getPathVar _ _ = unsupported "getPathVar" getFdPathVar :: Fd -> PathVar -> IO Limit getFdPathVar _ _ = unsupported "getFdPathVar" #endif unix-compat-0.7/src/System/PosixCompat/Internal/0000755000000000000000000000000007346545000020112 5ustar0000000000000000unix-compat-0.7/src/System/PosixCompat/Internal/Time.hs0000644000000000000000000000130007346545000021336 0ustar0000000000000000{-# LANGUAGE CPP #-} {- Compatibility wrapper to help manage the transition from old-time to time packages. Only used at all on win32. -} module System.PosixCompat.Internal.Time ( ClockTime , getClockTime , clockTimeToEpochTime ) where import System.Posix.Types (EpochTime) #ifdef OLD_TIME import System.Time (ClockTime(TOD), getClockTime) clockTimeToEpochTime :: ClockTime -> EpochTime clockTimeToEpochTime (TOD s _) = fromInteger s #else import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) type ClockTime = POSIXTime getClockTime :: IO ClockTime getClockTime = getPOSIXTime clockTimeToEpochTime :: ClockTime -> EpochTime clockTimeToEpochTime = fromInteger . floor #endif unix-compat-0.7/src/System/PosixCompat/Temp.hs0000644000000000000000000000305107346545000017576 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-| This module makes the operations exported by @System.Posix.Temp@ available on all platforms. On POSIX systems it re-exports operations from @System.Posix.Temp@, on other platforms it emulates the operations as far as possible. -} module System.PosixCompat.Temp ( mkstemp ) where #ifndef mingw32_HOST_OS -- Re-export unix package import System.Posix.Temp #elif defined(__GLASGOW_HASKELL__) -- Windows w/ GHC, we have fdToHandle so we -- can use our own implementation of mkstemp. import System.IO (Handle) import Foreign.C (CInt(..), CString, withCString, peekCString, throwErrnoIfMinus1) import GHC.IO.Handle.FD (fdToHandle) -- | 'mkstemp' - make a unique filename and open it for -- reading\/writing. -- The returned 'FilePath' is the (possibly relative) path of -- the created file, which is padded with 6 random characters. mkstemp :: String -> IO (FilePath, Handle) mkstemp template = do withCString template $ \ ptr -> do fd <- throwErrnoIfMinus1 "mkstemp" (c_mkstemp ptr) name <- peekCString ptr h <- fdToHandle (fromIntegral fd) return (name, h) foreign import ccall unsafe "unixcompat_mkstemp" c_mkstemp :: CString -> IO CInt #else -- Windows w/o GHC, we don't have fdToHandle :( import System.IO (Handle) import System.IO.Error (mkIOError, illegalOperationErrorType) mkstemp :: String -> IO (FilePath, Handle) mkstemp _ = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing where x = "System.PosixCompat.Temp.mkstemp: not supported" #endif unix-compat-0.7/src/System/PosixCompat/Time.hs0000644000000000000000000000142307346545000017570 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| This module makes the operations exported by @System.Posix.Time@ available on all platforms. On POSIX systems it re-exports operations from @System.Posix.Time@, on other platforms it emulates the operations as far as possible. -} module System.PosixCompat.Time ( epochTime ) where #ifndef mingw32_HOST_OS import System.Posix.Time #else import Control.Monad (liftM) import System.Posix.Types (EpochTime) import System.PosixCompat.Internal.Time ( getClockTime, clockTimeToEpochTime ) -- | The portable version of @epochTime@ calls 'getClockTime' to obtain the -- number of seconds that have elapsed since the epoch (Jan 01 00:00:00 GMT -- 1970). epochTime :: IO EpochTime epochTime = liftM clockTimeToEpochTime getClockTime #endif unix-compat-0.7/src/System/PosixCompat/Types.hs0000644000000000000000000000301207346545000017772 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-| This module re-exports the types from @System.Posix.Types@ on all platforms. On Windows 'UserID', 'GroupID' and 'LinkCount' are missing, so they are redefined by this module. -} module System.PosixCompat.Types ( module System.Posix.Types #ifdef mingw32_HOST_OS , UserID , GroupID , LinkCount #endif ) where #ifdef mingw32_HOST_OS -- Since CIno (FileID's underlying type) reflects ino_t, -- which mingw defines as short int (int16), it must be overriden to -- match the size of windows fileIndex (word64). import System.Posix.Types import Data.Word (Word32) newtype UserID = UserID Word32 deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real) instance Show UserID where show (UserID x) = show x instance Read UserID where readsPrec i s = [ (UserID x, s') | (x,s') <- readsPrec i s] newtype GroupID = GroupID Word32 deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real) instance Show GroupID where show (GroupID x) = show x instance Read GroupID where readsPrec i s = [ (GroupID x, s') | (x,s') <- readsPrec i s] newtype LinkCount = LinkCount Word32 deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real) instance Show LinkCount where show (LinkCount x) = show x instance Read LinkCount where readsPrec i s = [ (LinkCount x, s') | (x,s') <- readsPrec i s] #else import System.Posix.Types #endif unix-compat-0.7/src/System/PosixCompat/Unistd.hs0000644000000000000000000000565707346545000020155 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-| This module makes the operations exported by @System.Posix.Unistd@ available on all platforms. On POSIX systems it re-exports operations from @System.Posix.Unistd@, on other platforms it emulates the operations as far as possible. -} module System.PosixCompat.Unistd ( -- * System environment SystemID(..) , getSystemID -- * Sleeping , sleep , usleep , nanosleep ) where #ifndef mingw32_HOST_OS import System.Posix.Unistd #else import Control.Concurrent (threadDelay) import Foreign.C.String (CString, peekCString) import Foreign.C.Types (CInt(..), CSize(..)) import Foreign.Marshal.Array (allocaArray) data SystemID = SystemID { systemName :: String , nodeName :: String , release :: String , version :: String , machine :: String } deriving (Eq, Read, Show) getSystemID :: IO SystemID getSystemID = do let bufSize = 256 let call f = allocaArray bufSize $ \buf -> do ok <- f buf (fromIntegral bufSize) if ok == 1 then peekCString buf else return "" display <- call c_os_display_string vers <- call c_os_version_string arch <- call c_os_arch_string node <- call c_os_node_name return SystemID { systemName = "Windows" , nodeName = node , release = display , version = vers , machine = arch } -- | Sleep for the specified duration (in seconds). Returns the time -- remaining (if the sleep was interrupted by a signal, for example). -- -- On non-Unix systems, this is implemented in terms of -- 'Control.Concurrent.threadDelay'. -- -- GHC Note: the comment for 'usleep' also applies here. sleep :: Int -> IO Int sleep secs = threadDelay (secs * 1000000) >> return 0 -- | Sleep for the specified duration (in microseconds). -- -- On non-Unix systems, this is implemented in terms of -- 'Control.Concurrent.threadDelay'. -- -- GHC Note: 'Control.Concurrent.threadDelay' is a better -- choice. Without the @-threaded@ option, 'usleep' will block all other -- user threads. Even with the @-threaded@ option, 'usleep' requires a -- full OS thread to itself. 'Control.Concurrent.threadDelay' has -- neither of these shortcomings. usleep :: Int -> IO () usleep = threadDelay -- | Sleep for the specified duration (in nanoseconds). -- -- On non-Unix systems, this is implemented in terms of -- 'Control.Concurrent.threadDelay'. nanosleep :: Integer -> IO () nanosleep nsecs = threadDelay (round (fromIntegral nsecs / 1000 :: Double)) foreign import ccall "unixcompat_os_display_string" c_os_display_string :: CString -> CSize -> IO CInt foreign import ccall "unixcompat_os_version_string" c_os_version_string :: CString -> CSize -> IO CInt foreign import ccall "unixcompat_os_arch_string" c_os_arch_string :: CString -> CSize -> IO CInt foreign import ccall "unixcompat_os_node_name" c_os_node_name :: CString -> CSize -> IO CInt #endif unix-compat-0.7/tests/0000755000000000000000000000000007346545000013157 5ustar0000000000000000unix-compat-0.7/tests/LinksSpec.hs0000644000000000000000000001072407346545000015412 0ustar0000000000000000module LinksSpec(linksSpec) where import Control.Concurrent ( threadDelay ) import Control.Exception ( finally ) import qualified System.Directory as D import System.Info ( os ) import System.IO.Error ( tryIOError ) import System.IO.Temp import System.PosixCompat import Test.Hspec import Test.HUnit isWindows :: Bool isWindows = os == "mingw32" linksSpec :: Spec linksSpec = do describe "createSymbolicLink" $ do it "should error on Windows and succeed on other OSes" $ do runInTempDir $ do writeFile "file" "" result <- tryIOError $ createSymbolicLink "file" "file_link" case result of Left _ | isWindows -> return () Right _ | isWindows -> do assertFailure "Succeeded while expected to fail on Windows" Left e -> assertFailure $ "Expected to succeed, but failed with " ++ show e Right _ -> return () describe "getSymbolicLinkStatus" $ do it "should detect symbolic link to a file" $ do runFileLinkTest $ do stat <- getSymbolicLinkStatus "file_link" assert $ isSymbolicLink stat it "should detect symbolic link to a directory" $ do runDirLinkTest $ do stat <- getSymbolicLinkStatus "dir_link" assert $ isSymbolicLink stat it "should give later time stamp than getFileStatus for link to file" $ do runFileLinkTest $ do lstat_mtime <- modificationTimeHiRes <$> getSymbolicLinkStatus "file_link" stat_mtime <- modificationTimeHiRes <$> getFileStatus "file_link" assert $ lstat_mtime > stat_mtime it "should give later time stamp than getFileStatus for link to dir" $ do runDirLinkTest $ do lstat_mtime <- modificationTimeHiRes <$> getSymbolicLinkStatus "dir_link" stat_mtime <- modificationTimeHiRes <$> getFileStatus "dir_link" assert $ lstat_mtime > stat_mtime it "should give a different fileID than getFileStatus for link to file" $ do runFileLinkTest $ do lstat_id <- fileID <$> getSymbolicLinkStatus "file_link" fstat_id <- fileID <$> getFileStatus "file_link" assert $ lstat_id /= fstat_id it "should give a different fileID than getFileStatus for link to dir" $ do runDirLinkTest $ do lstat_id <- fileID <$> getSymbolicLinkStatus "dir_link" fstat_id <- fileID <$> getFileStatus "dir_link" assert $ lstat_id /= fstat_id describe "getFileStatus" $ do it "should detect that symbolic link target is a file" $ do runFileLinkTest $ do stat <- getFileStatus "file_link" assert $ isRegularFile stat it "should detect that symbolic link target is a directory" $ do runDirLinkTest $ do stat <- getFileStatus "dir_link" assert $ isDirectory stat it "should be equal for link and link target (except access time)" $ do runFileLinkTest $ do fstat <- getFileStatus "file" flstat <- getFileStatus "file_link" assert $ fstat `mostlyEq` flstat runDirLinkTest $ do fstat <- getFileStatus "dir" flstat <- getFileStatus "dir_link" assert $ fstat `mostlyEq` flstat where runFileLinkTest action = runInTempDir $ do writeFile "file" "" threadDelay delay D.createFileLink "file" "file_link" action runDirLinkTest action = runInTempDir $ do D.createDirectory "dir" threadDelay delay D.createDirectoryLink "dir" "dir_link" action runInTempDir action = do orig <- D.getCurrentDirectory withTempDirectory orig "xxxxxxx" $ \tmp -> do D.setCurrentDirectory tmp action `finally` D.setCurrentDirectory orig -- We need to set the delay this high because otherwise the timestamp test -- above fails on Linux and Windows, though not on MacOS. This seems to be -- an artefact of the GHC runtime system which gives two subsequently -- created files the same timestamp unless the delay is large enough. delay = 10000 -- Test equality for all parts except accessTime mostlyEq :: FileStatus -> FileStatus -> Bool mostlyEq x y = tuple x == tuple y where tuple s = ( deviceID s , fileID s , fileMode s , linkCount s , fileOwner s , fileGroup s , specialDeviceID s , fileSize s , modificationTime s , statusChangeTime s , modificationTimeHiRes s , statusChangeTimeHiRes s ) unix-compat-0.7/tests/MkstempSpec.hs0000644000000000000000000000137307346545000015752 0ustar0000000000000000module MkstempSpec(mkstempSpec) where import Control.Monad.Parallel import System.Directory import System.IO import System.PosixCompat ( mkstemp ) import Test.Hspec mkstempSpec :: Spec mkstempSpec = describe "mkstemp" $ do it "TODO" $ do let n = 10000 hSetBuffering stdout NoBuffering putStr $ "Creating " ++ show n ++ " temp files..." xs <- replicateM n createTempFile if length xs == n then putStrLn "ok" else putStrLn "FAIL" putStr "Deleting temp files..." Control.Monad.Parallel.mapM_ removeFile xs putStrLn "ok" createTempFile :: IO FilePath createTempFile = do (p,h) <- mkstemp "tempfileXXXXXXX" hPutStrLn h "this is a temporary file" hClose h return p unix-compat-0.7/tests/main.hs0000644000000000000000000000021107346545000014431 0ustar0000000000000000module Main where import MkstempSpec import LinksSpec import Test.Hspec main :: IO () main = hspec $ do mkstempSpec linksSpec unix-compat-0.7/unix-compat.cabal0000644000000000000000000000675607346545000015263 0ustar0000000000000000name: unix-compat version: 0.7 synopsis: Portable POSIX-compatibility layer. description: This package provides portable implementations of parts of the unix package. This package re-exports the unix package when available. When it isn't available, portable implementations are used. homepage: http://github.com/haskell-pkg-janitors/unix-compat license: BSD3 license-file: LICENSE author: Björn Bringert, Duncan Coutts, Jacob Stanley, Bryan O'Sullivan maintainer: Mitchell Rosen category: System build-type: Simple cabal-version: >= 1.10 extra-source-files: CHANGELOG.md source-repository head type: git location: git@github.com:haskell-pkg-janitors/unix-compat.git flag old-time description: build against old-time package default: False Library default-language: Haskell2010 hs-source-dirs: src ghc-options: -Wall build-depends: base == 4.* exposed-modules: System.PosixCompat System.PosixCompat.Extensions System.PosixCompat.Files System.PosixCompat.Temp System.PosixCompat.Time System.PosixCompat.Types System.PosixCompat.Unistd if os(windows) c-sources: cbits/HsUname.c cbits/mktemp.c extra-libraries: msvcrt build-depends: Win32 >= 2.5.0.0 build-depends: filepath >= 1.0 && < 1.5 if flag(old-time) build-depends: old-time >= 1.0.0.0 && < 1.2.0.0 cpp-options: -DOLD_TIME if impl(ghc < 7) build-depends: directory == 1.0.* cpp-options: -DDIRECTORY_1_0 else build-depends: directory == 1.1.* else build-depends: time >= 1.0 && < 1.13 build-depends: directory >= 1.3.1 && < 1.4 other-modules: System.PosixCompat.Internal.Time else build-depends: unix >= 2.6 && < 2.9 include-dirs: include includes: HsUnixCompat.h install-includes: HsUnixCompat.h c-sources: cbits/HsUnixCompat.c if os(solaris) cc-options: -DSOLARIS Test-Suite unix-compat-testsuite default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: tests ghc-options: -Wall main-is: main.hs other-modules: MkstempSpec LinksSpec -- ghc-options: -- -Wall -- -fwarn-tabs -- -funbox-strict-fields -- -threaded -- -fno-warn-unused-do-bind -- -fno-warn-type-defaults -- extensions: -- OverloadedStrings -- ExtendedDefaultRules -- if flag(lifted) -- cpp-options: -DLIFTED build-depends: unix-compat , base == 4.* , monad-parallel , hspec , HUnit , directory , extra , temporary if os(windows) -- c-sources: -- cbits/HsUname.c -- cbits/mktemp.c -- extra-libraries: msvcrt -- build-depends: Win32 >= 2.5.0.0 if flag(old-time) build-depends: old-time >= 1.0.0.0 && < 1.2.0.0 cpp-options: -DOLD_TIME if impl(ghc < 7) build-depends: directory == 1.0.* cpp-options: -DDIRECTORY_1_0 else build-depends: directory == 1.1.* else build-depends: time >= 1.0 && < 1.13 build-depends: directory >= 1.3.1 && < 1.4 -- other-modules: -- System.PosixCompat.Internal.Time else -- build-depends: unix >= 2.4 && < 2.9 -- include-dirs: include -- includes: HsUnixCompat.h -- install-includes: HsUnixCompat.h -- c-sources: cbits/HsUnixCompat.c if os(solaris) cc-options: -DSOLARIS build-depends: directory >= 1.3.1 && < 1.4