unix-compat-0.4.3.1/0000755000000000000000000000000013021544610012303 5ustar0000000000000000unix-compat-0.4.3.1/LICENSE0000644000000000000000000000312613021544610013312 0ustar0000000000000000Copyright (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.4.3.1/Setup.lhs0000644000000000000000000000010313021544610014105 0ustar0000000000000000> import Distribution.Simple > main :: IO () > main = defaultMain unix-compat-0.4.3.1/unix-compat.cabal0000644000000000000000000000362713021544610015543 0ustar0000000000000000name: unix-compat version: 0.4.3.1 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/jystic/unix-compat license: BSD3 license-file: LICENSE author: Björn Bringert, Duncan Coutts, Jacob Stanley, Bryan O'Sullivan maintainer: Jacob Stanley category: System build-type: Simple cabal-version: >= 1.6 source-repository head type: git location: git://github.com/jystic/unix-compat.git flag old-time description: build against old-time package default: False Library 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 System.PosixCompat.User if os(windows) c-sources: cbits/HsUname.c cbits/mktemp.c extra-libraries: msvcrt build-depends: Win32 >= 2.3.0.2 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.7 build-depends: directory >= 1.2 && < 1.3 other-modules: System.PosixCompat.Internal.Time else build-depends: unix >= 2.4 && < 2.8 include-dirs: include includes: HsUnixCompat.h install-includes: HsUnixCompat.h c-sources: cbits/HsUnixCompat.c if os(solaris) cc-options: -DSOLARIS unix-compat-0.4.3.1/cbits/0000755000000000000000000000000013021544610013407 5ustar0000000000000000unix-compat-0.4.3.1/cbits/HsUname.c0000644000000000000000000003044013021544610015114 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.4.3.1/cbits/HsUnixCompat.c0000644000000000000000000000044013021544610016133 0ustar0000000000000000#include "HsUnixCompat.h" #ifdef SOLARIS #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.4.3.1/cbits/mktemp.c0000644000000000000000000001240213021544610015047 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.4.3.1/include/0000755000000000000000000000000013021544610013726 5ustar0000000000000000unix-compat-0.4.3.1/include/HsUnixCompat.h0000644000000000000000000000035213021544610016461 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.4.3.1/src/0000755000000000000000000000000013021544610013072 5ustar0000000000000000unix-compat-0.4.3.1/src/System/0000755000000000000000000000000013021544610014356 5ustar0000000000000000unix-compat-0.4.3.1/src/System/PosixCompat.hs0000644000000000000000000000172313021544610017163 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 , module System.PosixCompat.User , usingPortableImpl ) where import System.PosixCompat.Files import System.PosixCompat.Temp import System.PosixCompat.Time import System.PosixCompat.Types import System.PosixCompat.Unistd import System.PosixCompat.User -- | '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.4.3.1/src/System/PosixCompat/0000755000000000000000000000000013021544610016624 5ustar0000000000000000unix-compat-0.4.3.1/src/System/PosixCompat/Extensions.hsc0000644000000000000000000000253213021544610021464 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.4.3.1/src/System/PosixCompat/Files.hsc0000644000000000000000000003551013021544610020371 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 , 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.Int (Int64) 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 (getModificationTime, renameFile) import System.IO (IOMode(..), openFile, hFileSize, hSetFileSize, hClose) import System.IO.Error import System.PosixCompat.Types import System.Win32.File hiding (getFileType) import System.Win32.Time (FILETIME(..), getFileTime, setFileTime) import System.PosixCompat.Internal.Time ( getClockTime, clockTimeToEpochTime , modificationTimeToEpochTime ) #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 } 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 getFileStatus :: FilePath -> IO FileStatus getFileStatus path = do perm <- liftM permsToMode (getPermissions path) typ <- getFileType path size <- if typ == regularFileMode then getFileSize path else return 0 mtime <- liftM modificationTimeToEpochTime (getModificationTime path) info <- bracket openPath closeHandle getFileInformationByHandle return $ FileStatus { deviceID = fromIntegral (bhfiVolumeSerialNumber info) , fileID = fromIntegral (bhfiFileIndex info) , fileMode = typ .|. perm , linkCount = fromIntegral (bhfiNumberOfLinks info) , fileOwner = 0 , fileGroup = 0 , specialDeviceID = 0 , fileSize = size , accessTime = mtime , modificationTime = mtime , statusChangeTime = mtime } where openPath = createFile path gENERIC_READ (fILE_SHARE_READ .|. fILE_SHARE_WRITE .|. fILE_SHARE_DELETE) Nothing oPEN_EXISTING (sECURITY_ANONYMOUS .|. fILE_FLAG_BACKUP_SEMANTICS) Nothing permsToMode :: Permissions -> FileMode permsToMode perms = r .|. w .|. x where r = f (readable perms) (ownerReadMode .|. groupReadMode .|. otherReadMode) w = f (writable perms) (ownerWriteMode .|. groupWriteMode .|. otherWriteMode) x = f (executable perms || searchable perms) (ownerExecuteMode .|. groupExecuteMode .|. otherExecuteMode) f True m = m f False _ = nullFileMode getFileType :: FilePath -> IO FileMode getFileType path = do f <- doesFileExist path if f then return regularFileMode else do d <- doesDirectoryExist path if d then return directoryMode else unsupported "Unknown file type." getFileSize :: FilePath -> IO FileOffset getFileSize path = bracket (openFile path ReadMode) hClose (liftM fromIntegral . hFileSize) getFdStatus :: Fd -> IO FileStatus getFdStatus _ = unsupported "getFdStatus" getSymbolicLinkStatus :: FilePath -> IO FileStatus getSymbolicLinkStatus path = getFileStatus path createNamedPipe :: FilePath -> FileMode -> IO () createNamedPipe _ _ = unsupported "createNamedPipe" createDevice :: FilePath -> FileMode -> DeviceID -> IO () createDevice _ _ _ = unsupported "createDevice" -- ----------------------------------------------------------------------------- -- Hard links createLink :: FilePath -> FilePath -> IO () createLink _ _ = unsupported "createLink" removeLink :: FilePath -> IO () removeLink _ = unsupported "removeLink" -- ----------------------------------------------------------------------------- -- Symbolic Links createSymbolicLink :: FilePath -> FilePath -> IO () createSymbolicLink _ _ = unsupported "createSymbolicLink" readSymbolicLink :: FilePath -> IO FilePath readSymbolicLink _ = unsupported "readSymbolicLink" -- ----------------------------------------------------------------------------- -- Renaming files rename :: FilePath -> FilePath -> IO () rename name1 name2 = renameFile name1 name2 -- ----------------------------------------------------------------------------- -- 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 setFileTime 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 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.4.3.1/src/System/PosixCompat/Temp.hs0000644000000000000000000000305113021544610020064 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.4.3.1/src/System/PosixCompat/Time.hs0000644000000000000000000000142313021544610020056 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.4.3.1/src/System/PosixCompat/Types.hs0000644000000000000000000000360013021544610020263 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 ( #ifdef mingw32_HOST_OS module AllPosixTypesButFileID , FileID , UserID , GroupID , LinkCount #else module System.Posix.Types #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 as AllPosixTypesButFileID hiding (FileID) import Data.Word (Word32, Word64) newtype FileID = FileID Word64 deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real) instance Show FileID where show (FileID x) = show x instance Read FileID where readsPrec i s = [ (FileID x, s') | (x,s') <- readsPrec i s] 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.4.3.1/src/System/PosixCompat/Unistd.hs0000644000000000000000000000565713021544610020443 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.4.3.1/src/System/PosixCompat/User.hsc0000644000000000000000000000655513021544610020254 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| This module makes the operations exported by @System.Posix.User@ available on all platforms. On POSIX systems it re-exports operations from @System.Posix.User@. On other platforms it provides dummy implementations. -} module System.PosixCompat.User ( -- * User environment -- ** Querying the user environment getRealUserID , getRealGroupID , getEffectiveUserID , getEffectiveGroupID , getGroups , getLoginName , getEffectiveUserName -- *** The group database , GroupEntry(..) , getGroupEntryForID , getGroupEntryForName , getAllGroupEntries -- *** The user database , UserEntry(..) , getUserEntryForID , getUserEntryForName , getAllUserEntries -- ** Modifying the user environment , setUserID , setGroupID ) where #ifndef mingw32_HOST_OS #include "HsUnixCompat.h" import System.Posix.User #if __GLASGOW_HASKELL__<605 getAllGroupEntries :: IO [GroupEntry] getAllGroupEntries = return [] getAllUserEntries :: IO [UserEntry] getAllUserEntries = return [] #endif #else /* Portable implementation */ import System.IO.Error import System.PosixCompat.Types unsupported :: String -> IO a unsupported f = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing where x = "System.PosixCompat.User." ++ f ++ ": not supported" -- ----------------------------------------------------------------------------- -- User environment getRealUserID :: IO UserID getRealUserID = unsupported "getRealUserID" getRealGroupID :: IO GroupID getRealGroupID = unsupported "getRealGroupID" getEffectiveUserID :: IO UserID getEffectiveUserID = unsupported "getEffectiveUserID" getEffectiveGroupID :: IO GroupID getEffectiveGroupID = unsupported "getEffectiveGroupID" getGroups :: IO [GroupID] getGroups = return [] getLoginName :: IO String getLoginName = unsupported "getLoginName" setUserID :: UserID -> IO () setUserID _ = return () setGroupID :: GroupID -> IO () setGroupID _ = return () -- ----------------------------------------------------------------------------- -- User names getEffectiveUserName :: IO String getEffectiveUserName = unsupported "getEffectiveUserName" -- ----------------------------------------------------------------------------- -- The group database data GroupEntry = GroupEntry { groupName :: String , groupPassword :: String , groupID :: GroupID , groupMembers :: [String] } deriving (Show, Read, Eq) getGroupEntryForID :: GroupID -> IO GroupEntry getGroupEntryForID _ = unsupported "getGroupEntryForID" getGroupEntryForName :: String -> IO GroupEntry getGroupEntryForName _ = unsupported "getGroupEntryForName" getAllGroupEntries :: IO [GroupEntry] getAllGroupEntries = return [] -- ----------------------------------------------------------------------------- -- The user database (pwd.h) data UserEntry = UserEntry { userName :: String , userPassword :: String , userID :: UserID , userGroupID :: GroupID , userGecos :: String , homeDirectory :: String , userShell :: String } deriving (Show, Read, Eq) getUserEntryForID :: UserID -> IO UserEntry getUserEntryForID _ = unsupported "getUserEntryForID" getUserEntryForName :: String -> IO UserEntry getUserEntryForName _ = unsupported "getUserEntryForName" getAllUserEntries :: IO [UserEntry] getAllUserEntries = return [] #endif unix-compat-0.4.3.1/src/System/PosixCompat/Internal/0000755000000000000000000000000013021544610020400 5ustar0000000000000000unix-compat-0.4.3.1/src/System/PosixCompat/Internal/Time.hs0000644000000000000000000000214613021544610021635 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 , ModificationTime , modificationTimeToEpochTime ) where import System.Posix.Types (EpochTime) #ifdef OLD_TIME import System.Time (ClockTime(TOD), getClockTime) clockTimeToEpochTime :: ClockTime -> EpochTime clockTimeToEpochTime (TOD s _) = fromInteger s type ModificationTime = ClockTime modificationTimeToEpochTime :: ModificationTime -> EpochTime modificationTimeToEpochTime = clockTimeToEpochTime #else import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime, utcTimeToPOSIXSeconds) type ClockTime = POSIXTime getClockTime :: IO ClockTime getClockTime = getPOSIXTime clockTimeToEpochTime :: ClockTime -> EpochTime clockTimeToEpochTime = fromInteger . floor type ModificationTime = UTCTime modificationTimeToEpochTime :: UTCTime -> EpochTime modificationTimeToEpochTime = clockTimeToEpochTime . utcTimeToPOSIXSeconds #endif