├── .github └── workflows │ └── ci.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.lhs ├── cbits ├── HsUname.c ├── HsUnixCompat.c └── mktemp.c ├── include └── HsUnixCompat.h ├── src └── System │ ├── PosixCompat.hs │ └── PosixCompat │ ├── Extensions.hsc │ ├── Files.hsc │ ├── Internal │ └── Time.hs │ ├── Temp.hs │ ├── Time.hs │ ├── Types.hs │ ├── Unistd.hs │ └── User.hsc ├── stack.yaml ├── stack.yaml.lock ├── tests ├── LinksSpec.hs ├── MkstempSpec.hs └── main.hs └── unix-compat.cabal /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: 3 | - push 4 | - pull_request 5 | jobs: 6 | 7 | cabal: 8 | name: ${{ matrix.os }} - GHC ${{ matrix.ghc }} 9 | runs-on: ${{ matrix.os }} 10 | strategy: 11 | matrix: 12 | os: [ubuntu-latest, macOS-latest, windows-latest] 13 | ghc: 14 | - 8.8.4 15 | - 8.10.7 16 | - 9.0.1 17 | - 9.2.1 18 | fail-fast: false 19 | continue-on-error: ${{ startsWith(matrix.os, 'windows') && startsWith(matrix.ghc, '9.2') }} 20 | 21 | steps: 22 | - uses: actions/checkout@v2 23 | 24 | - uses: haskell/actions/setup@v1 25 | id: setup-haskell-cabal 26 | name: Setup Haskell 27 | with: 28 | ghc-version: ${{ matrix.ghc }} 29 | 30 | - name: Freeze 31 | run: | 32 | cabal freeze 33 | 34 | - uses: actions/cache@v2 35 | name: Cache ~/.cabal/store 36 | with: 37 | path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }} 38 | key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }} 39 | 40 | - name: Build 41 | run: | 42 | cabal configure --enable-tests --enable-benchmarks --test-show-details=direct 43 | cabal build all 44 | 45 | - name: Test 46 | run: | 47 | cabal test all 48 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /dist/ 2 | /dist-newstyle/ 3 | /test/dist/ 4 | *.swp 5 | .ghc.* 6 | .stack-work 7 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | ## Version 0.6 (2022-05-22) 2 | 3 | - Better support for symbolic links 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2007-2008, Björn Bringert 4 | Copyright (c) 2007-2009, Duncan Coutts 5 | Copyright (c) 2010-2011, Jacob Stanley 6 | Copyright (c) 2011, Bryan O'Sullivan 7 | All rights reserved. 8 | 9 | Redistribution and use in source and binary forms, with or without 10 | modification, are permitted provided that the following conditions are met: 11 | 12 | - Redistributions of source code must retain the above copyright notice, 13 | this list of conditions and the following disclaimer. 14 | - Redistributions in binary form must reproduce the above copyright 15 | notice, this list of conditions and the following disclaimer in the 16 | documentation and/or other materials provided with the distribution. 17 | - Neither the names of the copyright owners nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # unix-compat: Portable POSIX-compatibility layer. 2 | 3 | This package provides portable implementations of parts of the unix 4 | package. This package re-exports the unix package when available. When 5 | it isn't available, portable implementations are used. 6 | -------------------------------------------------------------------------------- /Setup.lhs: -------------------------------------------------------------------------------- 1 | > import Distribution.Simple 2 | 3 | > main :: IO () 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /cbits/HsUname.c: -------------------------------------------------------------------------------- 1 | /* 2 | * For details of what's going on here, see the following URL: 3 | * 4 | * http://msdn.microsoft.com/en-us/library/ms724429(v=vs.85).aspx 5 | */ 6 | 7 | #include 8 | #include 9 | #include 10 | 11 | #ifdef _MSC_VER 12 | # include 13 | #else 14 | 15 | static void StringCchCopy(char *dest, size_t bufsize, const char *src) 16 | { 17 | strcpy(dest, src); 18 | } 19 | 20 | static void StringCchCat(char *dest, size_t bufsize, const char *src) 21 | { 22 | strcat(dest, src); 23 | } 24 | 25 | #define StringCchPrintf _snprintf 26 | 27 | #endif 28 | 29 | typedef void (WINAPI *PGNSI)(LPSYSTEM_INFO); 30 | typedef BOOL (WINAPI *PGPI)(DWORD, DWORD, DWORD, DWORD, PDWORD); 31 | 32 | #ifndef PRODUCT_ULTIMATE 33 | # define PRODUCT_ULTIMATE 0x00000001 34 | #endif 35 | 36 | #ifndef PRODUCT_PROFESSIONAL 37 | # define PRODUCT_PROFESSIONAL 0x00000030 38 | #endif 39 | 40 | #ifndef PRODUCT_HOME_PREMIUM 41 | # define PRODUCT_HOME_PREMIUM 0x00000003 42 | #endif 43 | 44 | #ifndef PRODUCT_HOME_BASIC 45 | # define PRODUCT_HOME_BASIC 0x00000002 46 | #endif 47 | 48 | #ifndef PRODUCT_BUSINESS 49 | # define PRODUCT_BUSINESS 0x00000006 50 | #endif 51 | 52 | #ifndef PRODUCT_ENTERPRISE 53 | # define PRODUCT_ENTERPRISE 0x00000004 54 | #endif 55 | 56 | #ifndef PRODUCT_STARTER 57 | # define PRODUCT_STARTER 0x0000000B 58 | #endif 59 | 60 | #ifndef PRODUCT_CLUSTER_SERVER 61 | # define PRODUCT_CLUSTER_SERVER 0x00000012 62 | #endif 63 | 64 | #ifndef PRODUCT_DATACENTER_SERVER 65 | # define PRODUCT_DATACENTER_SERVER 0x00000008 66 | #endif 67 | 68 | #ifndef PRODUCT_DATACENTER_SERVER_CORE 69 | # define PRODUCT_DATACENTER_SERVER_CORE 0x0000000C 70 | #endif 71 | 72 | #ifndef PRODUCT_ENTERPRISE_SERVER 73 | # define PRODUCT_ENTERPRISE_SERVER 0x0000000A 74 | #endif 75 | 76 | #ifndef PRODUCT_ENTERPRISE_SERVER_CORE 77 | # define PRODUCT_ENTERPRISE_SERVER_CORE 0x0000000E 78 | #endif 79 | 80 | #ifndef PRODUCT_ENTERPRISE_SERVER_IA64 81 | # define PRODUCT_ENTERPRISE_SERVER_IA64 0x0000000F 82 | #endif 83 | 84 | #ifndef PRODUCT_SMALLBUSINESS_SERVER 85 | # define PRODUCT_SMALLBUSINESS_SERVER 0x00000009 86 | #endif 87 | 88 | #ifndef PRODUCT_SMALLBUSINESS_SERVER_PREMIUM 89 | # define PRODUCT_SMALLBUSINESS_SERVER_PREMIUM 0x00000019 90 | #endif 91 | 92 | #ifndef PRODUCT_STANDARD_SERVER 93 | # define PRODUCT_STANDARD_SERVER 0x00000007 94 | #endif 95 | 96 | #ifndef PRODUCT_STANDARD_SERVER_CORE 97 | # define PRODUCT_STANDARD_SERVER_CORE 0x0000000D 98 | #endif 99 | 100 | #ifndef PRODUCT_WEB_SERVER 101 | # define PRODUCT_WEB_SERVER 0x00000011 102 | #endif 103 | 104 | #ifndef VER_SUITE_WH_SERVER 105 | # define VER_SUITE_WH_SERVER 0x00008000 106 | #endif 107 | 108 | int unixcompat_os_display_string(char *pszOS, size_t BUFSIZE) 109 | { 110 | OSVERSIONINFOEX osvi; 111 | SYSTEM_INFO si; 112 | PGNSI pGNSI; 113 | PGPI pGPI; 114 | BOOL bOsVersionInfoEx; 115 | DWORD dwType; 116 | 117 | ZeroMemory(&si, sizeof(SYSTEM_INFO)); 118 | ZeroMemory(&osvi, sizeof(OSVERSIONINFOEX)); 119 | 120 | osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFOEX); 121 | bOsVersionInfoEx = GetVersionEx((OSVERSIONINFO*) &osvi); 122 | 123 | if (bOsVersionInfoEx == 0) 124 | return FALSE; 125 | 126 | // Call GetNativeSystemInfo if supported or GetSystemInfo otherwise. 127 | 128 | pGNSI = (PGNSI) GetProcAddress( 129 | GetModuleHandle(TEXT("kernel32.dll")), 130 | "GetNativeSystemInfo"); 131 | if (NULL != pGNSI) 132 | pGNSI(&si); 133 | else 134 | GetSystemInfo(&si); 135 | 136 | if (VER_PLATFORM_WIN32_NT == osvi.dwPlatformId && osvi.dwMajorVersion > 4) { 137 | StringCchCopy(pszOS, BUFSIZE, TEXT("Microsoft ")); 138 | 139 | // Test for the specific product. 140 | if (osvi.dwMajorVersion == 6) { 141 | if(osvi.dwMinorVersion == 0) { 142 | if(osvi.wProductType == VER_NT_WORKSTATION) 143 | StringCchCat(pszOS, BUFSIZE, TEXT("Windows Vista ")); 144 | else 145 | StringCchCat(pszOS, BUFSIZE, TEXT("Windows Server 2008 ")); 146 | } 147 | 148 | if (osvi.dwMinorVersion == 1) { 149 | if (osvi.wProductType == VER_NT_WORKSTATION) 150 | StringCchCat(pszOS, BUFSIZE, TEXT("Windows 7 ")); 151 | else 152 | StringCchCat(pszOS, BUFSIZE, TEXT("Windows Server 2008 R2 ")); 153 | } 154 | 155 | pGPI = (PGPI) GetProcAddress( 156 | GetModuleHandle(TEXT("kernel32.dll")), 157 | "GetProductInfo"); 158 | 159 | pGPI(osvi.dwMajorVersion, osvi.dwMinorVersion, 0, 0, &dwType); 160 | 161 | switch (dwType) { 162 | case PRODUCT_ULTIMATE: 163 | StringCchCat(pszOS, BUFSIZE, TEXT("Ultimate Edition")); 164 | break; 165 | case PRODUCT_PROFESSIONAL: 166 | StringCchCat(pszOS, BUFSIZE, TEXT("Professional")); 167 | break; 168 | case PRODUCT_HOME_PREMIUM: 169 | StringCchCat(pszOS, BUFSIZE, TEXT("Home Premium Edition")); 170 | break; 171 | case PRODUCT_HOME_BASIC: 172 | StringCchCat(pszOS, BUFSIZE, TEXT("Home Basic Edition")); 173 | break; 174 | case PRODUCT_ENTERPRISE: 175 | StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition")); 176 | break; 177 | case PRODUCT_BUSINESS: 178 | StringCchCat(pszOS, BUFSIZE, TEXT("Business Edition")); 179 | break; 180 | case PRODUCT_STARTER: 181 | StringCchCat(pszOS, BUFSIZE, TEXT("Starter Edition")); 182 | break; 183 | case PRODUCT_CLUSTER_SERVER: 184 | StringCchCat(pszOS, BUFSIZE, TEXT("Cluster Server Edition")); 185 | break; 186 | case PRODUCT_DATACENTER_SERVER: 187 | StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Edition")); 188 | break; 189 | case PRODUCT_DATACENTER_SERVER_CORE: 190 | StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Edition (core installation)")); 191 | break; 192 | case PRODUCT_ENTERPRISE_SERVER: 193 | StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition")); 194 | break; 195 | case PRODUCT_ENTERPRISE_SERVER_CORE: 196 | StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition (core installation)")); 197 | break; 198 | case PRODUCT_ENTERPRISE_SERVER_IA64: 199 | StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition for Itanium-based Systems")); 200 | break; 201 | case PRODUCT_SMALLBUSINESS_SERVER: 202 | StringCchCat(pszOS, BUFSIZE, TEXT("Small Business Server")); 203 | break; 204 | case PRODUCT_SMALLBUSINESS_SERVER_PREMIUM: 205 | StringCchCat(pszOS, BUFSIZE, TEXT("Small Business Server Premium Edition")); 206 | break; 207 | case PRODUCT_STANDARD_SERVER: 208 | StringCchCat(pszOS, BUFSIZE, TEXT("Standard Edition")); 209 | break; 210 | case PRODUCT_STANDARD_SERVER_CORE: 211 | StringCchCat(pszOS, BUFSIZE, TEXT("Standard Edition (core installation)")); 212 | break; 213 | case PRODUCT_WEB_SERVER: 214 | StringCchCat(pszOS, BUFSIZE, TEXT("Web Server Edition")); 215 | break; 216 | } 217 | } 218 | 219 | if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 2) { 220 | if (GetSystemMetrics(SM_SERVERR2)) 221 | StringCchCat(pszOS, BUFSIZE, TEXT("Windows Server 2003 R2, ")); 222 | else if (osvi.wSuiteMask & VER_SUITE_STORAGE_SERVER) 223 | StringCchCat(pszOS, BUFSIZE, TEXT("Windows Storage Server 2003")); 224 | else if (osvi.wSuiteMask & VER_SUITE_WH_SERVER) 225 | StringCchCat(pszOS, BUFSIZE, TEXT("Windows Home Server")); 226 | else if (osvi.wProductType == VER_NT_WORKSTATION && 227 | si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) 228 | StringCchCat(pszOS, BUFSIZE, TEXT("Windows XP Professional x64 Edition")); 229 | else 230 | StringCchCat(pszOS, BUFSIZE, TEXT("Windows Server 2003, ")); 231 | 232 | // Test for the server type. 233 | 234 | if (osvi.wProductType != VER_NT_WORKSTATION) { 235 | if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_IA64) { 236 | if(osvi.wSuiteMask & VER_SUITE_DATACENTER) 237 | StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Edition for Itanium-based Systems")); 238 | else if(osvi.wSuiteMask & VER_SUITE_ENTERPRISE) 239 | StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition for Itanium-based Systems")); 240 | } else if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) { 241 | if(osvi.wSuiteMask & VER_SUITE_DATACENTER) 242 | StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter x64 Edition")); 243 | else if(osvi.wSuiteMask & VER_SUITE_ENTERPRISE) 244 | StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise x64 Edition")); 245 | else StringCchCat(pszOS, BUFSIZE, TEXT("Standard x64 Edition")); 246 | } else { 247 | if (osvi.wSuiteMask & VER_SUITE_COMPUTE_SERVER) 248 | StringCchCat(pszOS, BUFSIZE, TEXT("Compute Cluster Edition")); 249 | else if(osvi.wSuiteMask & VER_SUITE_DATACENTER) 250 | StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Edition")); 251 | else if(osvi.wSuiteMask & VER_SUITE_ENTERPRISE) 252 | StringCchCat(pszOS, BUFSIZE, TEXT("Enterprise Edition")); 253 | else if (osvi.wSuiteMask & VER_SUITE_BLADE) 254 | StringCchCat(pszOS, BUFSIZE, TEXT("Web Edition")); 255 | else StringCchCat(pszOS, BUFSIZE, TEXT("Standard Edition")); 256 | } 257 | } 258 | } 259 | 260 | if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 1) { 261 | StringCchCat(pszOS, BUFSIZE, TEXT("Windows XP ")); 262 | 263 | if (osvi.wSuiteMask & VER_SUITE_PERSONAL) 264 | StringCchCat(pszOS, BUFSIZE, TEXT("Home Edition")); 265 | else 266 | StringCchCat(pszOS, BUFSIZE, TEXT("Professional")); 267 | } 268 | 269 | if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 0) { 270 | StringCchCat(pszOS, BUFSIZE, TEXT("Windows 2000 ")); 271 | 272 | if (osvi.wProductType == VER_NT_WORKSTATION) { 273 | StringCchCat(pszOS, BUFSIZE, TEXT("Professional")); 274 | } else { 275 | if(osvi.wSuiteMask & VER_SUITE_DATACENTER) 276 | StringCchCat(pszOS, BUFSIZE, TEXT("Datacenter Server")); 277 | else if(osvi.wSuiteMask & VER_SUITE_ENTERPRISE) 278 | StringCchCat(pszOS, BUFSIZE, TEXT("Advanced Server")); 279 | else 280 | StringCchCat(pszOS, BUFSIZE, TEXT("Server")); 281 | } 282 | } 283 | 284 | // Include service pack (if any) and build number. 285 | 286 | if(_tcslen(osvi.szCSDVersion) > 0) { 287 | StringCchCat(pszOS, BUFSIZE, TEXT(" ")); 288 | StringCchCat(pszOS, BUFSIZE, osvi.szCSDVersion); 289 | } 290 | 291 | char buf[80]; 292 | StringCchPrintf(buf, 80, TEXT(" (build %d)"), osvi.dwBuildNumber); 293 | StringCchCat(pszOS, BUFSIZE, buf); 294 | 295 | if (osvi.dwMajorVersion >= 6) { 296 | if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) 297 | StringCchCat(pszOS, BUFSIZE, TEXT(", 64-bit")); 298 | else if (si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_INTEL) 299 | StringCchCat(pszOS, BUFSIZE, TEXT(", 32-bit")); 300 | } 301 | 302 | return TRUE; 303 | } else { 304 | // This sample does not support this version of Windows. 305 | return FALSE; 306 | } 307 | } 308 | 309 | int unixcompat_os_version_string(char *ptr, size_t bufsize) 310 | { 311 | OSVERSIONINFOEX osvi; 312 | BOOL bOsVersionInfoEx; 313 | char *szServicePack; 314 | 315 | ZeroMemory(&osvi, sizeof(OSVERSIONINFOEX)); 316 | osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFOEX); 317 | bOsVersionInfoEx = GetVersionEx((OSVERSIONINFO*) &osvi); 318 | 319 | if (bOsVersionInfoEx == 0) 320 | return FALSE; 321 | 322 | if (strncmp(osvi.szCSDVersion, "Service Pack ", 13) == 0) 323 | szServicePack = "0"; 324 | else 325 | szServicePack = osvi.szCSDVersion + 13; 326 | 327 | StringCchPrintf(ptr, bufsize, "%ld.%ld.%s.%ld", 328 | osvi.dwMajorVersion, osvi.dwMinorVersion, szServicePack, 329 | osvi.dwBuildNumber); 330 | 331 | return TRUE; 332 | } 333 | 334 | int unixcompat_os_arch_string(char *ptr, size_t bufsize) 335 | { 336 | SYSTEM_INFO sysInfo; 337 | 338 | GetSystemInfo(&sysInfo); 339 | 340 | switch (sysInfo.wProcessorArchitecture) { 341 | case PROCESSOR_ARCHITECTURE_INTEL: 342 | StringCchCopy(ptr, bufsize, "i386"); 343 | break; 344 | case PROCESSOR_ARCHITECTURE_AMD64: 345 | StringCchCopy(ptr, bufsize, "x86_64"); 346 | break; 347 | default: 348 | StringCchCopy(ptr, bufsize, "unknown"); 349 | break; 350 | } 351 | 352 | return TRUE; 353 | } 354 | 355 | int unixcompat_os_node_name(char *ptr, size_t bufsize) 356 | { 357 | DWORD sLength; 358 | 359 | sLength = bufsize - 1; 360 | GetComputerName(ptr, &sLength); 361 | 362 | return TRUE; 363 | } 364 | -------------------------------------------------------------------------------- /cbits/HsUnixCompat.c: -------------------------------------------------------------------------------- 1 | #include "HsUnixCompat.h" 2 | 3 | #ifdef SOLARIS 4 | #include 5 | #elif defined(__linux__) 6 | #include 7 | #endif 8 | 9 | unsigned int unix_major(dev_t dev) 10 | { 11 | return major(dev); 12 | } 13 | 14 | unsigned int unix_minor(dev_t dev) 15 | { 16 | return minor(dev); 17 | } 18 | 19 | dev_t unix_makedev(unsigned int maj, unsigned int min) 20 | { 21 | return makedev(maj, min); 22 | } 23 | -------------------------------------------------------------------------------- /cbits/mktemp.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Modified version of 'mktemp.c' from FreeBSD 3 | * http://www.freebsd.org/cgi/cvsweb.cgi/src/lib/libc/stdio/mktemp.c 4 | * ?rev=1.29.2.2.2.1;content-type=text%2Fplain 5 | */ 6 | 7 | /* 8 | * Copyright (c) 1987, 1993 9 | * The Regents of the University of California. All rights reserved. 10 | * 11 | * Redistribution and use in source and binary forms, with or without 12 | * modification, are permitted provided that the following conditions 13 | * are met: 14 | * 1. Redistributions of source code must retain the above copyright 15 | * notice, this list of conditions and the following disclaimer. 16 | * 2. Redistributions in binary form must reproduce the above copyright 17 | * notice, this list of conditions and the following disclaimer in the 18 | * documentation and/or other materials provided with the distribution. 19 | * 4. Neither the name of the University nor the names of its contributors 20 | * may be used to endorse or promote products derived from this software 21 | * without specific prior written permission. 22 | * 23 | * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 24 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 25 | * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 26 | * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE 27 | * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 28 | * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 29 | * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 30 | * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 | * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 32 | * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 33 | * SUCH DAMAGE. 34 | */ 35 | 36 | #include 37 | #include 38 | #include 39 | #include 40 | #include 41 | #include 42 | #include 43 | #include 44 | #include 45 | #include 46 | 47 | static int random(uint32_t *); 48 | static int _gettemp(char *, int *); 49 | 50 | static const unsigned char padchar[] = 51 | "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; 52 | 53 | int unixcompat_mkstemp(char *path) 54 | { 55 | int fd; 56 | 57 | if (_gettemp(path, &fd)) 58 | return fd; 59 | 60 | return -1; 61 | } 62 | 63 | static int _gettemp(char *path, int *doopen) 64 | { 65 | char *start, *trv, *suffp, *carryp; 66 | char *pad; 67 | struct _stat sbuf; 68 | int rval; 69 | uint32_t randidx, randval; 70 | char carrybuf[MAXPATHLEN]; 71 | 72 | for (trv = path; *trv != '\0'; ++trv) 73 | ; 74 | if (trv - path >= MAXPATHLEN) { 75 | errno = ENAMETOOLONG; 76 | return (0); 77 | } 78 | suffp = trv; 79 | --trv; 80 | if (trv < path || NULL != strchr(suffp, '/')) { 81 | errno = EINVAL; 82 | return (0); 83 | } 84 | 85 | /* Fill space with random characters */ 86 | while (trv >= path && *trv == 'X') { 87 | if (!random(&randval)) { 88 | /* this should never happen */ 89 | errno = EIO; 90 | return 0; 91 | } 92 | randidx = randval % (sizeof(padchar) - 1); 93 | *trv-- = padchar[randidx]; 94 | } 95 | start = trv + 1; 96 | 97 | /* save first combination of random characters */ 98 | memcpy(carrybuf, start, suffp - start); 99 | 100 | /* 101 | * check the target directory. 102 | */ 103 | if (doopen != NULL) { 104 | for (; trv > path; --trv) { 105 | if (*trv == '/') { 106 | *trv = '\0'; 107 | rval = _stat(path, &sbuf); 108 | *trv = '/'; 109 | if (rval != 0) 110 | return (0); 111 | if (!S_ISDIR(sbuf.st_mode)) { 112 | errno = ENOTDIR; 113 | return (0); 114 | } 115 | break; 116 | } 117 | } 118 | } 119 | 120 | for (;;) { 121 | if (doopen) { 122 | if ((*doopen = 123 | _open(path, O_CREAT|O_EXCL|O_RDWR, 0600)) >= 0) 124 | return (1); 125 | if (errno != EEXIST) 126 | return (0); 127 | } else if (_stat(path, &sbuf)) 128 | return (errno == ENOENT); 129 | 130 | /* If we have a collision, cycle through the space of filenames */ 131 | for (trv = start, carryp = carrybuf;;) { 132 | /* have we tried all possible permutations? */ 133 | if (trv == suffp) 134 | return (0); /* yes - exit with EEXIST */ 135 | pad = strchr(padchar, *trv); 136 | if (pad == NULL) { 137 | /* this should never happen */ 138 | errno = EIO; 139 | return (0); 140 | } 141 | /* increment character */ 142 | *trv = (*++pad == '\0') ? padchar[0] : *pad; 143 | /* carry to next position? */ 144 | if (*trv == *carryp) { 145 | /* increment position and loop */ 146 | ++trv; 147 | ++carryp; 148 | } else { 149 | /* try with new name */ 150 | break; 151 | } 152 | } 153 | } 154 | /*NOTREACHED*/ 155 | } 156 | 157 | static int random(uint32_t *value) 158 | { 159 | /* This handle is never released. Windows will clean up when the process 160 | * exits. Python takes this approach when emulating /dev/urandom, and if 161 | * it's good enough for them, then it's good enough for us. */ 162 | static HCRYPTPROV context = 0; 163 | 164 | if (context == 0) 165 | if (!CryptAcquireContext( 166 | &context, NULL, NULL, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)) 167 | return 0; 168 | 169 | if (!CryptGenRandom(context, sizeof *value, (BYTE *)value)) 170 | return 0; 171 | 172 | return 1; 173 | } 174 | -------------------------------------------------------------------------------- /include/HsUnixCompat.h: -------------------------------------------------------------------------------- 1 | #include "HsUnixConfig.h" 2 | #include 3 | 4 | unsigned int unix_major(dev_t dev); 5 | unsigned int unix_minor(dev_t dev); 6 | dev_t unix_makedev(unsigned int maj, unsigned int min); 7 | 8 | #define NEED_setSymbolicLinkOwnerAndGroup !HAVE_LCHOWN 9 | -------------------------------------------------------------------------------- /src/System/PosixCompat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | {-| 4 | The @unix-compat@ package provides portable implementations of parts of the 5 | @unix@ package. On POSIX system it re-exports operations from the @unix@ 6 | package, on other platforms it emulates the operations as far as possible. 7 | -} 8 | module System.PosixCompat ( 9 | module System.PosixCompat.Files 10 | , module System.PosixCompat.Temp 11 | , module System.PosixCompat.Time 12 | , module System.PosixCompat.Types 13 | , module System.PosixCompat.Unistd 14 | , module System.PosixCompat.User 15 | , usingPortableImpl 16 | ) where 17 | 18 | import System.PosixCompat.Files 19 | import System.PosixCompat.Temp 20 | import System.PosixCompat.Time 21 | import System.PosixCompat.Types 22 | import System.PosixCompat.Unistd 23 | import System.PosixCompat.User 24 | 25 | -- | 'True' if unix-compat is using its portable implementation, 26 | -- or 'False' if the unix package is simply being re-exported. 27 | usingPortableImpl :: Bool 28 | #ifdef mingw32_HOST_OS 29 | usingPortableImpl = True 30 | #else 31 | usingPortableImpl = False 32 | #endif 33 | 34 | -------------------------------------------------------------------------------- /src/System/PosixCompat/Extensions.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | -- | This module provides some functions not present in the unix package. 5 | module System.PosixCompat.Extensions ( 6 | -- * Device IDs. 7 | CMajor 8 | , CMinor 9 | , deviceMajor 10 | , deviceMinor 11 | , makeDeviceID 12 | ) where 13 | 14 | 15 | #ifndef mingw32_HOST_OS 16 | #include "HsUnixCompat.h" 17 | #endif 18 | 19 | import Foreign.C.Types 20 | import System.PosixCompat.Types 21 | 22 | 23 | type CMajor = CUInt 24 | type CMinor = CUInt 25 | 26 | -- | Gets the major number from a 'DeviceID' for a device file. 27 | -- 28 | -- The portable implementation always returns @0@. 29 | deviceMajor :: DeviceID -> CMajor 30 | #ifdef mingw32_HOST_OS 31 | deviceMajor _ = 0 32 | #else 33 | deviceMajor dev = unix_major dev 34 | 35 | foreign import ccall unsafe "unix_major" unix_major :: CDev -> CUInt 36 | #endif 37 | 38 | -- | Gets the minor number from a 'DeviceID' for a device file. 39 | -- 40 | -- The portable implementation always returns @0@. 41 | deviceMinor :: DeviceID -> CMinor 42 | #ifdef mingw32_HOST_OS 43 | deviceMinor _ = 0 44 | #else 45 | deviceMinor dev = unix_minor dev 46 | 47 | foreign import ccall unsafe "unix_minor" unix_minor :: CDev -> CUInt 48 | #endif 49 | 50 | -- | Creates a 'DeviceID' for a device file given a major and minor number. 51 | makeDeviceID :: CMajor -> CMinor -> DeviceID 52 | #ifdef mingw32_HOST_OS 53 | makeDeviceID _ _ = 0 54 | #else 55 | makeDeviceID ma mi = unix_makedev ma mi 56 | 57 | foreign import ccall unsafe "unix_makedev" unix_makedev :: CUInt -> CUInt -> CDev 58 | #endif 59 | -------------------------------------------------------------------------------- /src/System/PosixCompat/Files.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | {-| 4 | This module makes the operations exported by @System.Posix.Files@ 5 | available on all platforms. On POSIX systems it re-exports operations from 6 | @System.Posix.Files@. On other platforms it emulates the operations as far 7 | as possible. 8 | 9 | /NOTE: the portable implementations are not well tested, in some cases 10 | functions are only stubs./ 11 | -} 12 | module System.PosixCompat.Files ( 13 | -- * File modes 14 | -- FileMode exported by System.Posix.Types 15 | unionFileModes 16 | , intersectFileModes 17 | , nullFileMode 18 | , ownerReadMode 19 | , ownerWriteMode 20 | , ownerExecuteMode 21 | , ownerModes 22 | , groupReadMode 23 | , groupWriteMode 24 | , groupExecuteMode 25 | , groupModes 26 | , otherReadMode 27 | , otherWriteMode 28 | , otherExecuteMode 29 | , otherModes 30 | , setUserIDMode 31 | , setGroupIDMode 32 | , stdFileMode 33 | , accessModes 34 | 35 | -- ** Setting file modes 36 | , setFileMode 37 | , setFdMode 38 | , setFileCreationMask 39 | 40 | -- ** Checking file existence and permissions 41 | , fileAccess 42 | , fileExist 43 | 44 | -- * File status 45 | , FileStatus 46 | -- ** Obtaining file status 47 | , getFileStatus 48 | , getFdStatus 49 | , getSymbolicLinkStatus 50 | -- ** Querying file status 51 | , deviceID 52 | , fileID 53 | , fileMode 54 | , linkCount 55 | , fileOwner 56 | , fileGroup 57 | , specialDeviceID 58 | , fileSize 59 | , accessTime 60 | , modificationTime 61 | , statusChangeTime 62 | , accessTimeHiRes 63 | , modificationTimeHiRes 64 | , statusChangeTimeHiRes 65 | , isBlockDevice 66 | , isCharacterDevice 67 | , isNamedPipe 68 | , isRegularFile 69 | , isDirectory 70 | , isSymbolicLink 71 | , isSocket 72 | 73 | -- * Creation 74 | , createNamedPipe 75 | , createDevice 76 | 77 | -- * Hard links 78 | , createLink 79 | , removeLink 80 | 81 | -- * Symbolic links 82 | , createSymbolicLink 83 | , readSymbolicLink 84 | 85 | -- * Renaming files 86 | , rename 87 | 88 | -- * Changing file ownership 89 | , setOwnerAndGroup 90 | , setFdOwnerAndGroup 91 | , setSymbolicLinkOwnerAndGroup 92 | 93 | -- * Changing file timestamps 94 | , setFileTimes 95 | , touchFile 96 | 97 | -- * Setting file sizes 98 | , setFileSize 99 | , setFdSize 100 | 101 | -- * Find system-specific limits for a file 102 | , PathVar(..) 103 | , getPathVar 104 | , getFdPathVar 105 | ) where 106 | 107 | #ifndef mingw32_HOST_OS 108 | 109 | #include "HsUnixCompat.h" 110 | 111 | import System.Posix.Files 112 | 113 | #if NEED_setSymbolicLinkOwnerAndGroup 114 | import System.PosixCompat.Types 115 | 116 | setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO () 117 | setSymbolicLinkOwnerAndGroup _ _ _ = return () 118 | #endif 119 | 120 | #else /* Portable implementation */ 121 | 122 | import Control.Exception (bracket) 123 | import Control.Monad (liftM, liftM2) 124 | import Data.Bits ((.|.), (.&.)) 125 | import Data.Char (toLower) 126 | import Data.Int (Int64) 127 | import Data.Time.Clock.POSIX (POSIXTime) 128 | import Foreign.C.Types (CTime(..)) 129 | import Prelude hiding (read) 130 | import System.Directory (Permissions, emptyPermissions) 131 | import System.Directory (getPermissions, setPermissions) 132 | import System.Directory (readable, setOwnerReadable) 133 | import System.Directory (writable, setOwnerWritable) 134 | import System.Directory (executable, setOwnerExecutable) 135 | import System.Directory (searchable, setOwnerSearchable) 136 | import System.Directory (doesFileExist, doesDirectoryExist) 137 | import System.Directory (getSymbolicLinkTarget) 138 | import System.FilePath (takeExtension) 139 | import System.IO (IOMode(..), openFile, hSetFileSize, hClose) 140 | import System.IO.Error 141 | import System.PosixCompat.Types 142 | import System.Win32.File 143 | import System.Win32.HardLink (createHardLink) 144 | import System.Win32.Time (FILETIME(..), getFileTime, setFileTime) 145 | import System.Win32.Types (HANDLE) 146 | 147 | import System.PosixCompat.Internal.Time ( 148 | getClockTime, clockTimeToEpochTime 149 | ) 150 | 151 | #ifdef __GLASGOW_HASKELL__ 152 | import GHC.IO.Handle.FD (fdToHandle) 153 | #endif 154 | 155 | 156 | unsupported :: String -> IO a 157 | unsupported f = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing 158 | where 159 | x = "System.PosixCompat.Files." ++ f ++ ": not supported" 160 | 161 | -- ----------------------------------------------------------------------------- 162 | -- POSIX file modes 163 | 164 | nullFileMode :: FileMode 165 | nullFileMode = 0o000000 166 | 167 | ownerReadMode :: FileMode 168 | ownerWriteMode :: FileMode 169 | ownerExecuteMode :: FileMode 170 | groupReadMode :: FileMode 171 | groupWriteMode :: FileMode 172 | groupExecuteMode :: FileMode 173 | otherReadMode :: FileMode 174 | otherWriteMode :: FileMode 175 | otherExecuteMode :: FileMode 176 | setUserIDMode :: FileMode 177 | setGroupIDMode :: FileMode 178 | 179 | ownerReadMode = 0o000400 180 | ownerWriteMode = 0o000200 181 | ownerExecuteMode = 0o000100 182 | groupReadMode = 0o000040 183 | groupWriteMode = 0o000020 184 | groupExecuteMode = 0o000010 185 | otherReadMode = 0o000004 186 | otherWriteMode = 0o000002 187 | otherExecuteMode = 0o000001 188 | setUserIDMode = 0o004000 189 | setGroupIDMode = 0o002000 190 | 191 | stdFileMode :: FileMode 192 | ownerModes :: FileMode 193 | groupModes :: FileMode 194 | otherModes :: FileMode 195 | accessModes :: FileMode 196 | 197 | stdFileMode = ownerReadMode .|. ownerWriteMode .|. 198 | groupReadMode .|. groupWriteMode .|. 199 | otherReadMode .|. otherWriteMode 200 | ownerModes = ownerReadMode .|. ownerWriteMode .|. ownerExecuteMode 201 | groupModes = groupReadMode .|. groupWriteMode .|. groupExecuteMode 202 | otherModes = otherReadMode .|. otherWriteMode .|. otherExecuteMode 203 | accessModes = ownerModes .|. groupModes .|. otherModes 204 | 205 | unionFileModes :: FileMode -> FileMode -> FileMode 206 | unionFileModes m1 m2 = m1 .|. m2 207 | 208 | intersectFileModes :: FileMode -> FileMode -> FileMode 209 | intersectFileModes m1 m2 = m1 .&. m2 210 | 211 | fileTypeModes :: FileMode 212 | fileTypeModes = 0o0170000 213 | 214 | blockSpecialMode :: FileMode 215 | characterSpecialMode :: FileMode 216 | namedPipeMode :: FileMode 217 | regularFileMode :: FileMode 218 | directoryMode :: FileMode 219 | symbolicLinkMode :: FileMode 220 | socketMode :: FileMode 221 | 222 | blockSpecialMode = 0o0060000 223 | characterSpecialMode = 0o0020000 224 | namedPipeMode = 0o0010000 225 | regularFileMode = 0o0100000 226 | directoryMode = 0o0040000 227 | symbolicLinkMode = 0o0120000 228 | socketMode = 0o0140000 229 | 230 | 231 | setFileMode :: FilePath -> FileMode -> IO () 232 | setFileMode name m = setPermissions name $ modeToPerms m 233 | 234 | 235 | setFdMode :: Fd -> FileMode -> IO () 236 | setFdMode _ _ = unsupported "setFdMode" 237 | 238 | -- | The portable implementation does nothing and returns 'nullFileMode'. 239 | setFileCreationMask :: FileMode -> IO FileMode 240 | setFileCreationMask _ = return nullFileMode 241 | 242 | modeToPerms :: FileMode -> Permissions 243 | 244 | #ifdef DIRECTORY_1_0 245 | modeToPerms m = Permissions 246 | { readable = m .&. ownerReadMode /= 0 247 | , writable = m .&. ownerWriteMode /= 0 248 | , executable = m .&. ownerExecuteMode /= 0 249 | , searchable = m .&. ownerExecuteMode /= 0 } 250 | #else 251 | modeToPerms m = 252 | setOwnerReadable (m .&. ownerReadMode /= 0) $ 253 | setOwnerWritable (m .&. ownerWriteMode /= 0) $ 254 | setOwnerExecutable (m .&. ownerExecuteMode /= 0) $ 255 | setOwnerSearchable (m .&. ownerExecuteMode /= 0) $ 256 | emptyPermissions 257 | #endif 258 | 259 | -- ----------------------------------------------------------------------------- 260 | -- access() 261 | 262 | fileAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool 263 | fileAccess name read write exec = 264 | do perm <- getPermissions name 265 | return $ (not read || readable perm) 266 | && (not write || writable perm) 267 | && (not exec || executable perm || searchable perm) 268 | 269 | fileExist :: FilePath -> IO Bool 270 | fileExist name = liftM2 (||) (doesFileExist name) (doesDirectoryExist name) 271 | 272 | -- ----------------------------------------------------------------------------- 273 | -- stat() support 274 | 275 | data FileStatus = FileStatus 276 | { deviceID :: DeviceID 277 | , fileID :: FileID 278 | , fileMode :: FileMode 279 | , linkCount :: LinkCount 280 | , fileOwner :: UserID 281 | , fileGroup :: GroupID 282 | , specialDeviceID :: DeviceID 283 | , fileSize :: FileOffset 284 | , accessTime :: EpochTime 285 | , modificationTime :: EpochTime 286 | , statusChangeTime :: EpochTime 287 | , accessTimeHiRes :: POSIXTime 288 | , modificationTimeHiRes :: POSIXTime 289 | , statusChangeTimeHiRes :: POSIXTime 290 | } 291 | 292 | isBlockDevice :: FileStatus -> Bool 293 | isBlockDevice stat = 294 | (fileMode stat `intersectFileModes` fileTypeModes) == blockSpecialMode 295 | 296 | isCharacterDevice :: FileStatus -> Bool 297 | isCharacterDevice stat = 298 | (fileMode stat `intersectFileModes` fileTypeModes) == characterSpecialMode 299 | 300 | isNamedPipe :: FileStatus -> Bool 301 | isNamedPipe stat = 302 | (fileMode stat `intersectFileModes` fileTypeModes) == namedPipeMode 303 | 304 | isRegularFile :: FileStatus -> Bool 305 | isRegularFile stat = 306 | (fileMode stat `intersectFileModes` fileTypeModes) == regularFileMode 307 | 308 | isDirectory :: FileStatus -> Bool 309 | isDirectory stat = 310 | (fileMode stat `intersectFileModes` fileTypeModes) == directoryMode 311 | 312 | isSymbolicLink :: FileStatus -> Bool 313 | isSymbolicLink stat = 314 | (fileMode stat `intersectFileModes` fileTypeModes) == symbolicLinkMode 315 | 316 | isSocket :: FileStatus -> Bool 317 | isSocket stat = 318 | (fileMode stat `intersectFileModes` fileTypeModes) == socketMode 319 | 320 | getStatus :: Bool -> FilePath -> IO FileStatus 321 | getStatus forLink path = do 322 | info <- bracket openPath closeHandle getFileInformationByHandle 323 | let atime = windowsToPosixTime (bhfiLastAccessTime info) 324 | mtime = windowsToPosixTime (bhfiLastWriteTime info) 325 | ctime = windowsToPosixTime (bhfiCreationTime info) 326 | attr = bhfiFileAttributes info 327 | isLink = attr .&. fILE_ATTRIBUTE_REPARSE_POINT /= 0 328 | isDir = attr .&. fILE_ATTRIBUTE_DIRECTORY /= 0 329 | isWritable = attr .&. fILE_ATTRIBUTE_READONLY == 0 330 | -- Contrary to Posix systems, directory symlinks on Windows have both 331 | -- fILE_ATTRIBUTE_REPARSE_POINT and fILE_ATTRIBUTE_DIRECTORY bits set. 332 | typ 333 | | isLink = symbolicLinkMode 334 | | isDir = directoryMode 335 | | otherwise = regularFileMode -- it's a lie but what can we do? 336 | perm = permissions path isWritable isDir 337 | return $ FileStatus 338 | { deviceID = fromIntegral (bhfiVolumeSerialNumber info) 339 | , fileID = fromIntegral (bhfiFileIndex info) 340 | , fileMode = typ .|. perm 341 | , linkCount = fromIntegral (bhfiNumberOfLinks info) 342 | , fileOwner = 0 343 | , fileGroup = 0 344 | , specialDeviceID = 0 345 | , fileSize = fromIntegral (bhfiSize info) 346 | , accessTime = posixTimeToEpochTime atime 347 | , modificationTime = posixTimeToEpochTime mtime 348 | , statusChangeTime = posixTimeToEpochTime mtime 349 | , accessTimeHiRes = atime 350 | , modificationTimeHiRes = mtime 351 | , statusChangeTimeHiRes = ctime 352 | } 353 | where 354 | openPath = createFile path 355 | fILE_READ_EA 356 | (fILE_SHARE_READ .|. fILE_SHARE_WRITE .|. fILE_SHARE_DELETE) 357 | Nothing 358 | oPEN_EXISTING 359 | (fILE_FLAG_BACKUP_SEMANTICS .|. openReparsePoint) 360 | Nothing 361 | 362 | openReparsePoint = if forLink then fILE_FLAG_OPEN_REPARSE_POINT else 0 363 | 364 | -- not yet defined in Win32 package: 365 | fILE_FLAG_OPEN_REPARSE_POINT :: FileAttributeOrFlag 366 | fILE_FLAG_OPEN_REPARSE_POINT = 0x00200000 367 | 368 | -- Fused from System.Directory.Internal.Windows.getAccessPermissions 369 | -- and the former modeToPerms function. 370 | permissions path is_writable is_dir = r .|. w .|. x 371 | where 372 | is_executable = 373 | (toLower <$> takeExtension path) `elem` [".bat", ".cmd", ".com", ".exe"] 374 | r = ownerReadMode .|. groupReadMode .|. otherReadMode 375 | w = f is_writable (ownerWriteMode .|. groupWriteMode .|. otherWriteMode) 376 | x = f (is_executable || is_dir) 377 | (ownerExecuteMode .|. groupExecuteMode .|. otherExecuteMode) 378 | f True m = m 379 | f False _ = nullFileMode 380 | 381 | getSymbolicLinkStatus :: FilePath -> IO FileStatus 382 | getSymbolicLinkStatus = getStatus True 383 | 384 | getFileStatus :: FilePath -> IO FileStatus 385 | getFileStatus = getStatus False 386 | 387 | -- | Convert a 'POSIXTime' (synomym for 'Data.Time.Clock.NominalDiffTime') 388 | -- into an 'EpochTime' (integral number of seconds since epoch). This merely 389 | -- throws away the fractional part. 390 | posixTimeToEpochTime :: POSIXTime -> EpochTime 391 | posixTimeToEpochTime = fromInteger . floor 392 | 393 | -- three function stolen from System.Directory.Internals.Windows: 394 | 395 | -- | Difference between the Windows and POSIX epochs in units of 100ns. 396 | windowsPosixEpochDifference :: Num a => a 397 | windowsPosixEpochDifference = 116444736000000000 398 | 399 | -- | Convert from Windows time to POSIX time. 400 | windowsToPosixTime :: FILETIME -> POSIXTime 401 | windowsToPosixTime (FILETIME t) = 402 | (fromIntegral t - windowsPosixEpochDifference) / 10000000 403 | 404 | {- will be needed to /set/ high res timestamps, not yet supported 405 | 406 | -- | Convert from POSIX time to Windows time. This is lossy as Windows time 407 | -- has a resolution of only 100ns. 408 | posixToWindowsTime :: POSIXTime -> FILETIME 409 | posixToWindowsTime t = FILETIME $ 410 | truncate (t * 10000000 + windowsPosixEpochDifference) 411 | -} 412 | 413 | getFdStatus :: Fd -> IO FileStatus 414 | getFdStatus _ = unsupported "getFdStatus" 415 | 416 | createNamedPipe :: FilePath -> FileMode -> IO () 417 | createNamedPipe _ _ = unsupported "createNamedPipe" 418 | 419 | createDevice :: FilePath -> FileMode -> DeviceID -> IO () 420 | createDevice _ _ _ = unsupported "createDevice" 421 | 422 | -- ----------------------------------------------------------------------------- 423 | -- Hard links 424 | 425 | createLink :: FilePath -> FilePath -> IO () 426 | createLink = createHardLink 427 | 428 | removeLink :: FilePath -> IO () 429 | removeLink _ = unsupported "removeLink" 430 | 431 | -- ----------------------------------------------------------------------------- 432 | -- Symbolic Links 433 | 434 | createSymbolicLink :: FilePath -> FilePath -> IO () 435 | createSymbolicLink _ _ = unsupported "createSymbolicLink" 436 | 437 | readSymbolicLink :: FilePath -> IO FilePath 438 | readSymbolicLink = getSymbolicLinkTarget 439 | 440 | -- ----------------------------------------------------------------------------- 441 | -- Renaming 442 | 443 | rename :: FilePath -> FilePath -> IO () 444 | #if MIN_VERSION_Win32(2, 6, 0) 445 | rename name1 name2 = moveFileEx name1 (Just name2) mOVEFILE_REPLACE_EXISTING 446 | #else 447 | rename name1 name2 = moveFileEx name1 name2 mOVEFILE_REPLACE_EXISTING 448 | #endif 449 | 450 | -- ----------------------------------------------------------------------------- 451 | -- chown() 452 | 453 | -- | The portable implementation does nothing. 454 | setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO () 455 | setOwnerAndGroup _ _ _ = return () 456 | 457 | -- | The portable implementation does nothing. 458 | setFdOwnerAndGroup :: Fd -> UserID -> GroupID -> IO () 459 | setFdOwnerAndGroup _ _ _ = return () 460 | 461 | -- | The portable implementation does nothing. 462 | setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO () 463 | setSymbolicLinkOwnerAndGroup _ _ _ = return () 464 | 465 | -- ----------------------------------------------------------------------------- 466 | -- utime() 467 | 468 | setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO () 469 | setFileTimes file atime mtime = 470 | bracket openFileHandle closeHandle $ \handle -> do 471 | (creationTime, _, _) <- getFileTime handle 472 | setFileTimeCompat 473 | handle 474 | creationTime 475 | (epochTimeToFileTime atime) 476 | (epochTimeToFileTime mtime) 477 | where 478 | openFileHandle = createFile file 479 | gENERIC_WRITE 480 | fILE_SHARE_NONE 481 | Nothing 482 | oPEN_EXISTING 483 | fILE_ATTRIBUTE_NORMAL 484 | Nothing 485 | 486 | -- based on https://support.microsoft.com/en-us/kb/167296 487 | epochTimeToFileTime (CTime t) = FILETIME (fromIntegral ll) 488 | where 489 | ll :: Int64 490 | ll = fromIntegral t * 10000000 + 116444736000000000 491 | 492 | setFileTimeCompat :: HANDLE -> FILETIME -> FILETIME -> FILETIME -> IO () 493 | setFileTimeCompat h crt acc wrt = 494 | #if MIN_VERSION_Win32(2, 12, 0) 495 | setFileTime h (Just crt) (Just acc) (Just wrt) 496 | #else 497 | setFileTime h crt acc wrt 498 | #endif 499 | 500 | touchFile :: FilePath -> IO () 501 | touchFile name = 502 | do t <- liftM clockTimeToEpochTime getClockTime 503 | setFileTimes name t t 504 | 505 | -- ----------------------------------------------------------------------------- 506 | -- Setting file sizes 507 | 508 | setFileSize :: FilePath -> FileOffset -> IO () 509 | setFileSize file off = 510 | bracket (openFile file WriteMode) (hClose) 511 | (\h -> hSetFileSize h (fromIntegral off)) 512 | 513 | setFdSize :: Fd -> FileOffset -> IO () 514 | #ifdef __GLASGOW_HASKELL__ 515 | setFdSize (Fd fd) off = 516 | do h <- fdToHandle (fromIntegral fd) 517 | hSetFileSize h (fromIntegral off) 518 | #else 519 | setFdSize fd off = unsupported "setFdSize" 520 | #endif 521 | 522 | -- ----------------------------------------------------------------------------- 523 | -- pathconf()/fpathconf() support 524 | 525 | data PathVar 526 | = FileSizeBits -- _PC_FILESIZEBITS 527 | | LinkLimit -- _PC_LINK_MAX 528 | | InputLineLimit -- _PC_MAX_CANON 529 | | InputQueueLimit -- _PC_MAX_INPUT 530 | | FileNameLimit -- _PC_NAME_MAX 531 | | PathNameLimit -- _PC_PATH_MAX 532 | | PipeBufferLimit -- _PC_PIPE_BUF 533 | 534 | -- These are described as optional in POSIX: 535 | -- _PC_ALLOC_SIZE_MIN 536 | -- _PC_REC_INCR_XFER_SIZE 537 | -- _PC_REC_MAX_XFER_SIZE 538 | -- _PC_REC_MIN_XFER_SIZE 539 | -- _PC_REC_XFER_ALIGN 540 | | SymbolicLinkLimit -- _PC_SYMLINK_MAX 541 | | SetOwnerAndGroupIsRestricted -- _PC_CHOWN_RESTRICTED 542 | | FileNamesAreNotTruncated -- _PC_NO_TRUNC 543 | | VDisableChar -- _PC_VDISABLE 544 | | AsyncIOAvailable -- _PC_ASYNC_IO 545 | | PrioIOAvailable -- _PC_PRIO_IO 546 | | SyncIOAvailable -- _PC_SYNC_IO 547 | 548 | getPathVar :: FilePath -> PathVar -> IO Limit 549 | getPathVar _ _ = unsupported "getPathVar" 550 | 551 | getFdPathVar :: Fd -> PathVar -> IO Limit 552 | getFdPathVar _ _ = unsupported "getFdPathVar" 553 | 554 | #endif 555 | -------------------------------------------------------------------------------- /src/System/PosixCompat/Internal/Time.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {- 3 | Compatibility wrapper to help manage the transition from 4 | old-time to time packages. Only used at all on win32. 5 | -} 6 | module System.PosixCompat.Internal.Time ( 7 | ClockTime 8 | , getClockTime 9 | , clockTimeToEpochTime 10 | ) where 11 | 12 | import System.Posix.Types (EpochTime) 13 | 14 | #ifdef OLD_TIME 15 | 16 | import System.Time (ClockTime(TOD), getClockTime) 17 | 18 | clockTimeToEpochTime :: ClockTime -> EpochTime 19 | clockTimeToEpochTime (TOD s _) = fromInteger s 20 | 21 | #else 22 | 23 | import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) 24 | 25 | type ClockTime = POSIXTime 26 | 27 | getClockTime :: IO ClockTime 28 | getClockTime = getPOSIXTime 29 | 30 | clockTimeToEpochTime :: ClockTime -> EpochTime 31 | clockTimeToEpochTime = fromInteger . floor 32 | 33 | #endif 34 | -------------------------------------------------------------------------------- /src/System/PosixCompat/Temp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | {-| 5 | This module makes the operations exported by @System.Posix.Temp@ 6 | available on all platforms. On POSIX systems it re-exports operations from 7 | @System.Posix.Temp@, on other platforms it emulates the operations as far 8 | as possible. 9 | -} 10 | module System.PosixCompat.Temp ( 11 | mkstemp 12 | ) where 13 | 14 | #ifndef mingw32_HOST_OS 15 | -- Re-export unix package 16 | 17 | import System.Posix.Temp 18 | 19 | #elif defined(__GLASGOW_HASKELL__) 20 | -- Windows w/ GHC, we have fdToHandle so we 21 | -- can use our own implementation of mkstemp. 22 | 23 | import System.IO (Handle) 24 | import Foreign.C (CInt(..), CString, withCString, peekCString, throwErrnoIfMinus1) 25 | import GHC.IO.Handle.FD (fdToHandle) 26 | 27 | -- | 'mkstemp' - make a unique filename and open it for 28 | -- reading\/writing. 29 | -- The returned 'FilePath' is the (possibly relative) path of 30 | -- the created file, which is padded with 6 random characters. 31 | mkstemp :: String -> IO (FilePath, Handle) 32 | mkstemp template = do 33 | withCString template $ \ ptr -> do 34 | fd <- throwErrnoIfMinus1 "mkstemp" (c_mkstemp ptr) 35 | name <- peekCString ptr 36 | h <- fdToHandle (fromIntegral fd) 37 | return (name, h) 38 | 39 | foreign import ccall unsafe "unixcompat_mkstemp" 40 | c_mkstemp :: CString -> IO CInt 41 | 42 | #else 43 | -- Windows w/o GHC, we don't have fdToHandle :( 44 | 45 | import System.IO (Handle) 46 | import System.IO.Error (mkIOError, illegalOperationErrorType) 47 | 48 | mkstemp :: String -> IO (FilePath, Handle) 49 | mkstemp _ = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing 50 | where 51 | x = "System.PosixCompat.Temp.mkstemp: not supported" 52 | 53 | #endif 54 | -------------------------------------------------------------------------------- /src/System/PosixCompat/Time.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | {-| 4 | This module makes the operations exported by @System.Posix.Time@ 5 | available on all platforms. On POSIX systems it re-exports operations from 6 | @System.Posix.Time@, on other platforms it emulates the operations as far 7 | as possible. 8 | -} 9 | module System.PosixCompat.Time ( 10 | epochTime 11 | ) where 12 | 13 | #ifndef mingw32_HOST_OS 14 | 15 | import System.Posix.Time 16 | 17 | #else 18 | 19 | import Control.Monad (liftM) 20 | import System.Posix.Types (EpochTime) 21 | 22 | import System.PosixCompat.Internal.Time ( 23 | getClockTime, clockTimeToEpochTime 24 | ) 25 | 26 | -- | The portable version of @epochTime@ calls 'getClockTime' to obtain the 27 | -- number of seconds that have elapsed since the epoch (Jan 01 00:00:00 GMT 28 | -- 1970). 29 | epochTime :: IO EpochTime 30 | epochTime = liftM clockTimeToEpochTime getClockTime 31 | 32 | #endif 33 | 34 | -------------------------------------------------------------------------------- /src/System/PosixCompat/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | 4 | {-| 5 | This module re-exports the types from @System.Posix.Types@ on all platforms. 6 | 7 | On Windows 'UserID', 'GroupID' and 'LinkCount' are missing, so they are 8 | redefined by this module. 9 | -} 10 | module System.PosixCompat.Types ( 11 | module System.Posix.Types 12 | #ifdef mingw32_HOST_OS 13 | , UserID 14 | , GroupID 15 | , LinkCount 16 | #endif 17 | ) where 18 | 19 | #ifdef mingw32_HOST_OS 20 | -- Since CIno (FileID's underlying type) reflects ino_t, 21 | -- which mingw defines as short int (int16), it must be overriden to 22 | -- match the size of windows fileIndex (word64). 23 | import System.Posix.Types 24 | 25 | import Data.Word (Word32) 26 | 27 | newtype UserID = UserID Word32 28 | deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real) 29 | instance Show UserID where show (UserID x) = show x 30 | instance Read UserID where readsPrec i s = [ (UserID x, s') 31 | | (x,s') <- readsPrec i s] 32 | 33 | newtype GroupID = GroupID Word32 34 | deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real) 35 | instance Show GroupID where show (GroupID x) = show x 36 | instance Read GroupID where readsPrec i s = [ (GroupID x, s') 37 | | (x,s') <- readsPrec i s] 38 | 39 | newtype LinkCount = LinkCount Word32 40 | deriving (Eq, Ord, Enum, Bounded, Integral, Num, Real) 41 | instance Show LinkCount where show (LinkCount x) = show x 42 | instance Read LinkCount where readsPrec i s = [ (LinkCount x, s') 43 | | (x,s') <- readsPrec i s] 44 | 45 | #else 46 | import System.Posix.Types 47 | #endif 48 | -------------------------------------------------------------------------------- /src/System/PosixCompat/Unistd.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | 4 | {-| 5 | This module makes the operations exported by @System.Posix.Unistd@ 6 | available on all platforms. On POSIX systems it re-exports operations from 7 | @System.Posix.Unistd@, on other platforms it emulates the operations as far 8 | as possible. 9 | -} 10 | module System.PosixCompat.Unistd ( 11 | -- * System environment 12 | SystemID(..) 13 | , getSystemID 14 | -- * Sleeping 15 | , sleep 16 | , usleep 17 | , nanosleep 18 | ) where 19 | 20 | #ifndef mingw32_HOST_OS 21 | 22 | import System.Posix.Unistd 23 | 24 | #else 25 | 26 | import Control.Concurrent (threadDelay) 27 | import Foreign.C.String (CString, peekCString) 28 | import Foreign.C.Types (CInt(..), CSize(..)) 29 | import Foreign.Marshal.Array (allocaArray) 30 | 31 | data SystemID = SystemID { 32 | systemName :: String 33 | , nodeName :: String 34 | , release :: String 35 | , version :: String 36 | , machine :: String 37 | } deriving (Eq, Read, Show) 38 | 39 | getSystemID :: IO SystemID 40 | getSystemID = do 41 | let bufSize = 256 42 | let call f = allocaArray bufSize $ \buf -> do 43 | ok <- f buf (fromIntegral bufSize) 44 | if ok == 1 45 | then peekCString buf 46 | else return "" 47 | display <- call c_os_display_string 48 | vers <- call c_os_version_string 49 | arch <- call c_os_arch_string 50 | node <- call c_os_node_name 51 | return SystemID { 52 | systemName = "Windows" 53 | , nodeName = node 54 | , release = display 55 | , version = vers 56 | , machine = arch 57 | } 58 | 59 | -- | Sleep for the specified duration (in seconds). Returns the time 60 | -- remaining (if the sleep was interrupted by a signal, for example). 61 | -- 62 | -- On non-Unix systems, this is implemented in terms of 63 | -- 'Control.Concurrent.threadDelay'. 64 | -- 65 | -- GHC Note: the comment for 'usleep' also applies here. 66 | sleep :: Int -> IO Int 67 | sleep secs = threadDelay (secs * 1000000) >> return 0 68 | 69 | -- | Sleep for the specified duration (in microseconds). 70 | -- 71 | -- On non-Unix systems, this is implemented in terms of 72 | -- 'Control.Concurrent.threadDelay'. 73 | -- 74 | -- GHC Note: 'Control.Concurrent.threadDelay' is a better 75 | -- choice. Without the @-threaded@ option, 'usleep' will block all other 76 | -- user threads. Even with the @-threaded@ option, 'usleep' requires a 77 | -- full OS thread to itself. 'Control.Concurrent.threadDelay' has 78 | -- neither of these shortcomings. 79 | usleep :: Int -> IO () 80 | usleep = threadDelay 81 | 82 | -- | Sleep for the specified duration (in nanoseconds). 83 | -- 84 | -- On non-Unix systems, this is implemented in terms of 85 | -- 'Control.Concurrent.threadDelay'. 86 | nanosleep :: Integer -> IO () 87 | nanosleep nsecs = threadDelay (round (fromIntegral nsecs / 1000 :: Double)) 88 | 89 | foreign import ccall "unixcompat_os_display_string" 90 | c_os_display_string :: CString -> CSize -> IO CInt 91 | 92 | foreign import ccall "unixcompat_os_version_string" 93 | c_os_version_string :: CString -> CSize -> IO CInt 94 | 95 | foreign import ccall "unixcompat_os_arch_string" 96 | c_os_arch_string :: CString -> CSize -> IO CInt 97 | 98 | foreign import ccall "unixcompat_os_node_name" 99 | c_os_node_name :: CString -> CSize -> IO CInt 100 | 101 | #endif 102 | -------------------------------------------------------------------------------- /src/System/PosixCompat/User.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | {-| 4 | This module makes the operations exported by @System.Posix.User@ 5 | available on all platforms. On POSIX systems it re-exports operations from 6 | @System.Posix.User@. On other platforms it provides dummy implementations. 7 | -} 8 | module System.PosixCompat.User ( 9 | -- * User environment 10 | -- ** Querying the user environment 11 | getRealUserID 12 | , getRealGroupID 13 | , getEffectiveUserID 14 | , getEffectiveGroupID 15 | , getGroups 16 | , getLoginName 17 | , getEffectiveUserName 18 | 19 | -- *** The group database 20 | , GroupEntry(..) 21 | , getGroupEntryForID 22 | , getGroupEntryForName 23 | , getAllGroupEntries 24 | 25 | -- *** The user database 26 | , UserEntry(..) 27 | , getUserEntryForID 28 | , getUserEntryForName 29 | , getAllUserEntries 30 | 31 | -- ** Modifying the user environment 32 | , setUserID 33 | , setGroupID 34 | ) where 35 | 36 | #ifndef mingw32_HOST_OS 37 | 38 | #include "HsUnixCompat.h" 39 | 40 | import System.Posix.User 41 | 42 | #if __GLASGOW_HASKELL__<605 43 | getAllGroupEntries :: IO [GroupEntry] 44 | getAllGroupEntries = return [] 45 | 46 | getAllUserEntries :: IO [UserEntry] 47 | getAllUserEntries = return [] 48 | #endif 49 | 50 | #else /* Portable implementation */ 51 | 52 | import System.IO.Error 53 | import System.PosixCompat.Types 54 | 55 | unsupported :: String -> IO a 56 | unsupported f = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing 57 | where x = "System.PosixCompat.User." ++ f ++ ": not supported" 58 | 59 | -- ----------------------------------------------------------------------------- 60 | -- User environment 61 | 62 | getRealUserID :: IO UserID 63 | getRealUserID = unsupported "getRealUserID" 64 | 65 | getRealGroupID :: IO GroupID 66 | getRealGroupID = unsupported "getRealGroupID" 67 | 68 | getEffectiveUserID :: IO UserID 69 | getEffectiveUserID = unsupported "getEffectiveUserID" 70 | 71 | getEffectiveGroupID :: IO GroupID 72 | getEffectiveGroupID = unsupported "getEffectiveGroupID" 73 | 74 | getGroups :: IO [GroupID] 75 | getGroups = return [] 76 | 77 | getLoginName :: IO String 78 | getLoginName = unsupported "getLoginName" 79 | 80 | setUserID :: UserID -> IO () 81 | setUserID _ = return () 82 | 83 | setGroupID :: GroupID -> IO () 84 | setGroupID _ = return () 85 | 86 | -- ----------------------------------------------------------------------------- 87 | -- User names 88 | 89 | getEffectiveUserName :: IO String 90 | getEffectiveUserName = unsupported "getEffectiveUserName" 91 | 92 | -- ----------------------------------------------------------------------------- 93 | -- The group database 94 | 95 | data GroupEntry = GroupEntry 96 | { groupName :: String 97 | , groupPassword :: String 98 | , groupID :: GroupID 99 | , groupMembers :: [String] 100 | } deriving (Show, Read, Eq) 101 | 102 | getGroupEntryForID :: GroupID -> IO GroupEntry 103 | getGroupEntryForID _ = unsupported "getGroupEntryForID" 104 | 105 | getGroupEntryForName :: String -> IO GroupEntry 106 | getGroupEntryForName _ = unsupported "getGroupEntryForName" 107 | 108 | getAllGroupEntries :: IO [GroupEntry] 109 | getAllGroupEntries = return [] 110 | 111 | -- ----------------------------------------------------------------------------- 112 | -- The user database (pwd.h) 113 | 114 | data UserEntry = UserEntry 115 | { userName :: String 116 | , userPassword :: String 117 | , userID :: UserID 118 | , userGroupID :: GroupID 119 | , userGecos :: String 120 | , homeDirectory :: String 121 | , userShell :: String 122 | } deriving (Show, Read, Eq) 123 | 124 | getUserEntryForID :: UserID -> IO UserEntry 125 | getUserEntryForID _ = unsupported "getUserEntryForID" 126 | 127 | getUserEntryForName :: String -> IO UserEntry 128 | getUserEntryForName _ = unsupported "getUserEntryForName" 129 | 130 | getAllUserEntries :: IO [UserEntry] 131 | getAllUserEntries = return [] 132 | 133 | #endif 134 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: lts-18.16 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # subdirs: 29 | # - auto-update 30 | # - wai 31 | packages: 32 | - . 33 | # Dependency packages to be pulled from upstream that are not in the resolver. 34 | # These entries can reference officially published versions as well as 35 | # forks / in-progress versions pinned to a git hash. For example: 36 | # 37 | # extra-deps: 38 | # - acme-missiles-0.3 39 | # - git: https://github.com/commercialhaskell/stack.git 40 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 41 | # 42 | # extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | # flags: {} 46 | 47 | # Extra package databases containing global packages 48 | # extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=2.7" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor 67 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 586286 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/16.yaml 11 | sha256: cdead65fca0323144b346c94286186f4969bf85594d649c49c7557295675d8a5 12 | original: lts-18.16 13 | -------------------------------------------------------------------------------- /tests/LinksSpec.hs: -------------------------------------------------------------------------------- 1 | module LinksSpec(linksSpec) where 2 | 3 | import Control.Concurrent ( threadDelay ) 4 | import Control.Exception ( finally ) 5 | import qualified System.Directory as D 6 | import System.Info ( os ) 7 | import System.IO.Error ( tryIOError ) 8 | import System.IO.Temp 9 | import System.PosixCompat 10 | import Test.Hspec 11 | import Test.HUnit 12 | 13 | isWindows :: Bool 14 | isWindows = os == "mingw32" 15 | 16 | linksSpec :: Spec 17 | linksSpec = do 18 | describe "createSymbolicLink" $ do 19 | it "should error on Windows and succeed on other OSes" $ do 20 | runInTempDir $ do 21 | writeFile "file" "" 22 | result <- tryIOError $ createSymbolicLink "file" "file_link" 23 | case result of 24 | Left _ | isWindows -> return () 25 | Right _ | isWindows -> do 26 | assertFailure "Succeeded while expected to fail on Windows" 27 | Left e -> assertFailure $ "Expected to succeed, but failed with " ++ show e 28 | Right _ -> return () 29 | describe "getSymbolicLinkStatus" $ do 30 | it "should detect symbolic link to a file" $ do 31 | runFileLinkTest $ do 32 | stat <- getSymbolicLinkStatus "file_link" 33 | assert $ isSymbolicLink stat 34 | it "should detect symbolic link to a directory" $ do 35 | runDirLinkTest $ do 36 | stat <- getSymbolicLinkStatus "dir_link" 37 | assert $ isSymbolicLink stat 38 | it "should give later time stamp than getFileStatus for link to file" $ do 39 | runFileLinkTest $ do 40 | lstat_mtime <- modificationTimeHiRes <$> getSymbolicLinkStatus "file_link" 41 | stat_mtime <- modificationTimeHiRes <$> getFileStatus "file_link" 42 | assert $ lstat_mtime > stat_mtime 43 | it "should give later time stamp than getFileStatus for link to dir" $ do 44 | runDirLinkTest $ do 45 | lstat_mtime <- modificationTimeHiRes <$> getSymbolicLinkStatus "dir_link" 46 | stat_mtime <- modificationTimeHiRes <$> getFileStatus "dir_link" 47 | assert $ lstat_mtime > stat_mtime 48 | it "should give a different fileID than getFileStatus for link to file" $ do 49 | runFileLinkTest $ do 50 | lstat_id <- fileID <$> getSymbolicLinkStatus "file_link" 51 | fstat_id <- fileID <$> getFileStatus "file_link" 52 | assert $ lstat_id /= fstat_id 53 | it "should give a different fileID than getFileStatus for link to dir" $ do 54 | runDirLinkTest $ do 55 | lstat_id <- fileID <$> getSymbolicLinkStatus "dir_link" 56 | fstat_id <- fileID <$> getFileStatus "dir_link" 57 | assert $ lstat_id /= fstat_id 58 | describe "getFileStatus" $ do 59 | it "should detect that symbolic link target is a file" $ do 60 | runFileLinkTest $ do 61 | stat <- getFileStatus "file_link" 62 | assert $ isRegularFile stat 63 | it "should detect that symbolic link target is a directory" $ do 64 | runDirLinkTest $ do 65 | stat <- getFileStatus "dir_link" 66 | assert $ isDirectory stat 67 | it "should be equal for link and link target (except access time)" $ do 68 | runFileLinkTest $ do 69 | fstat <- getFileStatus "file" 70 | flstat <- getFileStatus "file_link" 71 | assert $ fstat `mostlyEq` flstat 72 | runDirLinkTest $ do 73 | fstat <- getFileStatus "dir" 74 | flstat <- getFileStatus "dir_link" 75 | assert $ fstat `mostlyEq` flstat 76 | 77 | where 78 | 79 | runFileLinkTest action = 80 | runInTempDir $ do 81 | writeFile "file" "" 82 | threadDelay delay 83 | D.createFileLink "file" "file_link" 84 | action 85 | 86 | runDirLinkTest action = 87 | runInTempDir $ do 88 | D.createDirectory "dir" 89 | threadDelay delay 90 | D.createDirectoryLink "dir" "dir_link" 91 | action 92 | 93 | runInTempDir action = do 94 | orig <- D.getCurrentDirectory 95 | withTempDirectory orig "xxxxxxx" $ \tmp -> do 96 | D.setCurrentDirectory tmp 97 | action `finally` D.setCurrentDirectory orig 98 | 99 | -- We need to set the delay this high because otherwise the timestamp test 100 | -- above fails on Linux and Windows, though not on MacOS. This seems to be 101 | -- an artefact of the GHC runtime system which gives two subsequently 102 | -- created files the same timestamp unless the delay is large enough. 103 | delay = 10000 104 | 105 | -- Test equality for all parts except accessTime 106 | mostlyEq :: FileStatus -> FileStatus -> Bool 107 | mostlyEq x y = tuple x == tuple y 108 | where 109 | tuple s = 110 | ( deviceID s 111 | , fileID s 112 | , fileMode s 113 | , linkCount s 114 | , fileOwner s 115 | , fileGroup s 116 | , specialDeviceID s 117 | , fileSize s 118 | , modificationTime s 119 | , statusChangeTime s 120 | , modificationTimeHiRes s 121 | , statusChangeTimeHiRes s 122 | ) 123 | -------------------------------------------------------------------------------- /tests/MkstempSpec.hs: -------------------------------------------------------------------------------- 1 | module MkstempSpec(mkstempSpec) where 2 | import Control.Monad.Parallel 3 | import System.Directory 4 | import System.IO 5 | import System.PosixCompat ( mkstemp ) 6 | import Test.Hspec 7 | 8 | mkstempSpec :: Spec 9 | mkstempSpec = describe "mkstemp" $ do 10 | it "TODO" $ do 11 | let n = 10000 12 | hSetBuffering stdout NoBuffering 13 | 14 | putStr $ "Creating " ++ show n ++ " temp files..." 15 | xs <- replicateM n createTempFile 16 | if length xs == n 17 | then putStrLn "ok" 18 | else putStrLn "FAIL" 19 | 20 | putStr "Deleting temp files..." 21 | Control.Monad.Parallel.mapM_ removeFile xs 22 | putStrLn "ok" 23 | 24 | createTempFile :: IO FilePath 25 | createTempFile = do 26 | (p,h) <- mkstemp "tempfileXXXXXXX" 27 | hPutStrLn h "this is a temporary file" 28 | hClose h 29 | return p 30 | -------------------------------------------------------------------------------- /tests/main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import MkstempSpec 4 | import LinksSpec 5 | 6 | import Test.Hspec 7 | 8 | main :: IO () 9 | main = hspec $ do 10 | mkstempSpec 11 | linksSpec 12 | -------------------------------------------------------------------------------- /unix-compat.cabal: -------------------------------------------------------------------------------- 1 | name: unix-compat 2 | version: 0.6 3 | synopsis: Portable POSIX-compatibility layer. 4 | description: This package provides portable implementations of parts 5 | of the unix package. This package re-exports the unix 6 | package when available. When it isn't available, 7 | portable implementations are used. 8 | 9 | homepage: http://github.com/jacobstanley/unix-compat 10 | license: BSD3 11 | license-file: LICENSE 12 | author: Björn Bringert, Duncan Coutts, Jacob Stanley, Bryan O'Sullivan 13 | maintainer: Jacob Stanley 14 | category: System 15 | build-type: Simple 16 | cabal-version: >= 1.10 17 | 18 | extra-source-files: 19 | CHANGELOG.md 20 | 21 | source-repository head 22 | type: git 23 | location: git@github.com:jacobstanley/unix-compat.git 24 | 25 | flag old-time 26 | description: build against old-time package 27 | default: False 28 | 29 | Library 30 | default-language: Haskell2010 31 | hs-source-dirs: src 32 | ghc-options: -Wall 33 | build-depends: base == 4.* 34 | 35 | exposed-modules: 36 | System.PosixCompat 37 | System.PosixCompat.Extensions 38 | System.PosixCompat.Files 39 | System.PosixCompat.Temp 40 | System.PosixCompat.Time 41 | System.PosixCompat.Types 42 | System.PosixCompat.Unistd 43 | System.PosixCompat.User 44 | 45 | if os(windows) 46 | c-sources: 47 | cbits/HsUname.c 48 | cbits/mktemp.c 49 | 50 | extra-libraries: msvcrt 51 | build-depends: Win32 >= 2.5.0.0 52 | build-depends: filepath >= 1.0 && < 1.5 53 | 54 | if flag(old-time) 55 | build-depends: old-time >= 1.0.0.0 && < 1.2.0.0 56 | cpp-options: -DOLD_TIME 57 | 58 | if impl(ghc < 7) 59 | build-depends: directory == 1.0.* 60 | cpp-options: -DDIRECTORY_1_0 61 | else 62 | build-depends: directory == 1.1.* 63 | else 64 | build-depends: time >= 1.0 && < 1.13 65 | build-depends: directory >= 1.3.1 && < 1.4 66 | 67 | other-modules: 68 | System.PosixCompat.Internal.Time 69 | 70 | else 71 | build-depends: unix >= 2.6 && < 2.9 72 | include-dirs: include 73 | includes: HsUnixCompat.h 74 | install-includes: HsUnixCompat.h 75 | c-sources: cbits/HsUnixCompat.c 76 | if os(solaris) 77 | cc-options: -DSOLARIS 78 | 79 | Test-Suite unix-compat-testsuite 80 | default-language: Haskell2010 81 | type: exitcode-stdio-1.0 82 | hs-source-dirs: tests 83 | ghc-options: -Wall 84 | main-is: main.hs 85 | 86 | other-modules: 87 | MkstempSpec 88 | LinksSpec 89 | 90 | -- ghc-options: 91 | -- -Wall 92 | -- -fwarn-tabs 93 | -- -funbox-strict-fields 94 | -- -threaded 95 | -- -fno-warn-unused-do-bind 96 | -- -fno-warn-type-defaults 97 | 98 | -- extensions: 99 | -- OverloadedStrings 100 | -- ExtendedDefaultRules 101 | 102 | -- if flag(lifted) 103 | -- cpp-options: -DLIFTED 104 | 105 | build-depends: 106 | unix-compat 107 | , base == 4.* 108 | , monad-parallel 109 | , hspec 110 | , HUnit 111 | , directory 112 | , extra 113 | , temporary 114 | 115 | if os(windows) 116 | -- c-sources: 117 | -- cbits/HsUname.c 118 | -- cbits/mktemp.c 119 | 120 | -- extra-libraries: msvcrt 121 | -- build-depends: Win32 >= 2.5.0.0 122 | 123 | if flag(old-time) 124 | build-depends: old-time >= 1.0.0.0 && < 1.2.0.0 125 | cpp-options: -DOLD_TIME 126 | 127 | if impl(ghc < 7) 128 | build-depends: directory == 1.0.* 129 | cpp-options: -DDIRECTORY_1_0 130 | else 131 | build-depends: directory == 1.1.* 132 | else 133 | build-depends: time >= 1.0 && < 1.13 134 | build-depends: directory >= 1.3.1 && < 1.4 135 | 136 | -- other-modules: 137 | -- System.PosixCompat.Internal.Time 138 | 139 | else 140 | -- build-depends: unix >= 2.4 && < 2.9 141 | -- include-dirs: include 142 | -- includes: HsUnixCompat.h 143 | -- install-includes: HsUnixCompat.h 144 | -- c-sources: cbits/HsUnixCompat.c 145 | if os(solaris) 146 | cc-options: -DSOLARIS 147 | 148 | build-depends: directory >= 1.3.1 && < 1.4 149 | --------------------------------------------------------------------------------