1{-# LANGUAGE CPP #-} 2{-# LANGUAGE ForeignFunctionInterface #-} 3{-# LANGUAGE OverloadedStrings #-} 4{-# LANGUAGE TemplateHaskell #-} 5 6-- Copyright (C) 2011 John Millikin <jmillikin@gmail.com> 7-- 8-- See license.txt for details 9module FilesystemTests.Posix 10 ( suite_Posix 11 ) where 12 13import Prelude hiding (FilePath) 14import Control.Exception (bracket) 15import Control.Monad 16import Control.Monad.IO.Class (liftIO) 17import qualified Data.ByteString 18import Data.ByteString (ByteString) 19import qualified Data.ByteString.Char8 as Char8 20import qualified Data.Text 21import Data.Text (Text) 22import qualified Data.Text.IO 23import Data.Time.Clock (diffUTCTime, getCurrentTime) 24import Foreign 25import Foreign.C 26import Test.Chell 27 28#if MIN_VERSION_base(4,2,0) 29import qualified GHC.IO.Exception as GHC 30#else 31import qualified GHC.IOBase as GHC 32#endif 33 34import qualified System.Posix.IO as PosixIO 35 36import Filesystem 37import Filesystem.Path 38import qualified Filesystem.Path.Rules as Rules 39import qualified Filesystem.Path.CurrentOS as CurrentOS 40 41import FilesystemTests.Util (assertionsWithTemp, todo) 42 43suite_Posix :: Suite 44suite_Posix = suite "posix" $ 45 (concatMap suiteTests 46 [ suite_IsFile 47 , suite_IsDirectory 48 , suite_Rename 49 , suite_CanonicalizePath 50 , suite_CreateDirectory 51 , suite_CreateTree 52 , suite_RemoveFile 53 , suite_RemoveDirectory 54 , suite_RemoveTree 55 , suite_GetWorkingDirectory 56 , suite_SetWorkingDirectory 57 , suite_GetHomeDirectory 58 , suite_GetDesktopDirectory 59 , suite_GetModified 60 , suite_GetSize 61 , suite_CopyFile 62 , suite_WithFile 63 , suite_WithTextFile 64 , suite_RegressionTests 65 ]) ++ 66 [ test_ListDirectory 67 , todo "getDocumentsDirectory" 68 , todo "getAppDataDirectory" 69 , todo "getAppCacheDirectory" 70 , todo "getAppConfigDirectory" 71 , todo "openFile" 72 , todo "readFile" 73 , todo "writeFile" 74 , todo "appendFile" 75 , todo "openTextFile" 76 , todo "readTextFile" 77 , todo "writeTextFile" 78 , todo "appendTextFile" 79 ] 80 81suite_IsFile :: Suite 82suite_IsFile = suite "isFile" 83 [ test_IsFile "ascii" (decode "test.txt") 84 , test_IsFile "utf8" (fromText "\xA1\xA2.txt") 85 , test_IsFile "iso8859" (decode "\xA1\xA2\xA3.txt") 86 , test_PipeIsFile "pipe.ascii" (decode "test.txt") 87 , test_PipeIsFile "pipe.utf8" (fromText "\xA1\xA2.txt") 88 , test_PipeIsFile "pipe.iso8859" (decode "\xA1\xA2\xA3.txt") 89 ] 90 91suite_IsDirectory :: Suite 92suite_IsDirectory = suite "isDirectory" 93 [ test_IsDirectory "ascii" (decode "test.d") 94 , test_IsDirectory "utf8" (fromText "\xA1\xA2.d") 95 , test_IsDirectory "iso8859" (decode "\xA1\xA2\xA3.d") 96 ] 97 98suite_Rename :: Suite 99suite_Rename = suite "rename" 100 [ test_Rename "ascii" 101 (decode "old_test.txt") 102 (decode "new_test.txt") 103 , test_Rename "utf8" 104 (fromText "old_\xA1\xA2.txt") 105 (fromText "new_\xA1\xA2.txt") 106 , test_Rename "iso8859" 107 (decode "old_\xA1\xA2\xA3.txt") 108 (decode "new_\xA1\xA2\xA3.txt") 109 ] 110 111suite_CanonicalizePath :: Suite 112suite_CanonicalizePath = suite "canonicalizePath" 113 [ test_CanonicalizePath "ascii" 114 (decode "test-a.txt") 115 (decode "test-b.txt") 116 , test_CanonicalizePath "utf8" 117 (fromText "\xA1\xA2-a.txt") 118 (fromText "\xA1\xA2-b.txt") 119 , test_CanonicalizePath "iso8859" 120 (decode "\xA1\xA2\xA3-a.txt") 121#ifdef CABAL_OS_DARWIN 122 (decode "%A1%A2%A3-b.txt") 123#else 124 (decode "\xA1\xA2\xA3-b.txt") 125#endif 126 , test_CanonicalizePath_TrailingSlash 127 ] 128 129suite_CreateDirectory :: Suite 130suite_CreateDirectory = suite "createDirectory" 131 [ test_CreateDirectory "ascii" 132 (decode "test.d") 133 , test_CreateDirectory "utf8" 134 (fromText "\xA1\xA2.d") 135 , test_CreateDirectory "iso8859" 136 (decode "\xA1\xA2\xA3.d") 137 , test_CreateDirectory_FailExists 138 , test_CreateDirectory_SucceedExists 139 , test_CreateDirectory_FailFileExists 140 ] 141 142suite_CreateTree :: Suite 143suite_CreateTree = suite "createTree" 144 [ test_CreateTree "ascii" 145 (decode "test.d") 146 , test_CreateTree "ascii-slash" 147 (decode "test.d/") 148 , test_CreateTree "utf8" 149 (fromText "\xA1\xA2.d") 150 , test_CreateTree "utf8-slash" 151 (fromText "\xA1\xA2.d/") 152 , test_CreateTree "iso8859" 153 (decode "\xA1\xA2\xA3.d") 154 , test_CreateTree "iso8859-slash" 155 (decode "\xA1\xA2\xA3.d/") 156 ] 157 158suite_RemoveFile :: Suite 159suite_RemoveFile = suite "removeFile" 160 [ test_RemoveFile "ascii" 161 (decode "test.txt") 162 , test_RemoveFile "utf8" 163 (fromText "\xA1\xA2.txt") 164 , test_RemoveFile "iso8859" 165 (decode "\xA1\xA2\xA3.txt") 166 ] 167 168suite_RemoveDirectory :: Suite 169suite_RemoveDirectory = suite "removeDirectory" 170 [ test_RemoveDirectory "ascii" 171 (decode "test.d") 172 , test_RemoveDirectory "utf8" 173 (fromText "\xA1\xA2.d") 174 , test_RemoveDirectory "iso8859" 175 (decode "\xA1\xA2\xA3.d") 176 ] 177 178suite_RemoveTree :: Suite 179suite_RemoveTree = suite "removeTree" 180 [ test_RemoveTree "ascii" 181 (decode "test.d") 182 , test_RemoveTree "utf8" 183 (fromText "\xA1\xA2.d") 184 , test_RemoveTree "iso8859" 185 (decode "\xA1\xA2\xA3.d") 186 ] 187 188suite_GetWorkingDirectory :: Suite 189suite_GetWorkingDirectory = suite "getWorkingDirectory" 190 [ test_GetWorkingDirectory "ascii" 191 (decode "test.d") 192 , test_GetWorkingDirectory "utf8" 193 (fromText "\xA1\xA2.d") 194 , test_GetWorkingDirectory "iso8859" 195 (decode "\xA1\xA2\xA3.d") 196 ] 197 198suite_SetWorkingDirectory :: Suite 199suite_SetWorkingDirectory = suite "setWorkingDirectory" 200 [ test_SetWorkingDirectory "ascii" 201 (decode "test.d") 202 , test_SetWorkingDirectory "utf8" 203 (fromText "\xA1\xA2.d") 204 , test_SetWorkingDirectory "iso8859" 205 (decode "\xA1\xA2\xA3.d") 206 ] 207 208suite_GetHomeDirectory :: Suite 209suite_GetHomeDirectory = suite "getHomeDirectory" 210 [ test_GetHomeDirectory "ascii" 211 (decode "/home/test.d") 212 , test_GetHomeDirectory "utf8" 213 (decode "/home/\xA1\xA2.d") 214 , test_GetHomeDirectory "iso8859" 215 (decode "/home/\xA1\xA2\xA3.d") 216 ] 217 218suite_GetDesktopDirectory :: Suite 219suite_GetDesktopDirectory = suite "getDesktopDirectory" 220 [ test_GetDesktopDirectory "ascii" 221 (decode "/desktop/test.d") 222 , test_GetDesktopDirectory "utf8" 223 (decode "/desktop/\xA1\xA2.d") 224 , test_GetDesktopDirectory "iso8859" 225 (decode "/desktop/\xA1\xA2\xA3.d") 226 ] 227 228suite_GetModified :: Suite 229suite_GetModified = suite "getModified" 230 [ test_GetModified "ascii" 231 (decode "test.txt") 232 , test_GetModified "utf8" 233 (fromText "\xA1\xA2.txt") 234 , test_GetModified "iso8859" 235 (decode "\xA1\xA2\xA3.txt") 236 ] 237 238suite_GetSize :: Suite 239suite_GetSize = suite "getSize" 240 [ test_GetSize "ascii" 241 (decode "test.txt") 242 , test_GetSize "utf8" 243 (fromText "\xA1\xA2.txt") 244 , test_GetSize "iso8859" 245 (decode "\xA1\xA2\xA3.txt") 246 ] 247 248suite_CopyFile :: Suite 249suite_CopyFile = suite "copyFile" 250 [ test_CopyFile "ascii" 251 (decode "old_test.txt") 252 (decode "new_test.txt") 253 , test_CopyFile "utf8" 254 (fromText "old_\xA1\xA2.txt") 255 (fromText "new_\xA1\xA2.txt") 256 , test_CopyFile "iso8859" 257#ifdef CABAL_OS_DARWIN 258 (decode "old_%A1%A2%A3.txt") 259#else 260 (decode "old_\xA1\xA2\xA3.txt") 261#endif 262#ifdef CABAL_OS_DARWIN 263 (decode "new_%A1%A2%A3.txt") 264#else 265 (decode "new_\xA1\xA2\xA3.txt") 266#endif 267 ] 268 269suite_WithFile :: Suite 270suite_WithFile = suite "withFile" 271 [ test_WithFile_Read "read.ascii" 272 (decode "test.txt") 273 , test_WithFile_Read "read.utf8" 274 (fromText "\xA1\xA2.txt") 275 , test_WithFile_Read "read.iso8859" 276#ifdef CABAL_OS_DARWIN 277 (decode "%A1%A2%A3.txt") 278#else 279 (decode "\xA1\xA2\xA3.txt") 280#endif 281 , test_WithFile_Write "write.ascii" 282 (decode "test.txt") 283 , test_WithFile_Write "write.utf8" 284 (fromText "\xA1\xA2.txt") 285 , test_WithFile_Write "write.iso8859" 286 (decode "\xA1\xA2\xA3.txt") 287 ] 288 289suite_WithTextFile :: Suite 290suite_WithTextFile = suite "withTextFile" 291 [ test_WithTextFile "ascii" 292 (decode "test.txt") 293 , test_WithTextFile "utf8" 294 (fromText "\xA1\xA2.txt") 295 , test_WithTextFile "iso8859" 296#ifdef CABAL_OS_DARWIN 297 (decode "%A1%A2%A3.txt") 298#else 299 (decode "\xA1\xA2\xA3.txt") 300#endif 301 ] 302 303suite_RegressionTests :: Suite 304suite_RegressionTests = suite "regression-tests" 305 [ test_ListDirectoryLeaksFds 306 ] 307 308test_IsFile :: String -> FilePath -> Test 309test_IsFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do 310 let path = tmp </> file_name 311 312 before <- liftIO $ Filesystem.isFile path 313 $expect (not before) 314 315 touch_ffi path "contents\n" 316 317 after <- liftIO $ Filesystem.isFile path 318 $expect after 319 320test_PipeIsFile :: String -> FilePath -> Test 321test_PipeIsFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do 322 let path = tmp </> file_name 323 324 before <- liftIO $ Filesystem.isFile path 325 $expect (not before) 326 327 mkfifo_ffi path 328 329 after <- liftIO $ Filesystem.isFile path 330 $expect after 331 332test_IsDirectory :: String -> FilePath -> Test 333test_IsDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do 334 let path = tmp </> dir_name 335 336 before <- liftIO $ Filesystem.isDirectory path 337 $expect (not before) 338 339 mkdir_ffi path 340 341 after <- liftIO $ Filesystem.isDirectory path 342 $expect after 343 344test_Rename :: String -> FilePath -> FilePath -> Test 345test_Rename test_name old_name new_name = assertionsWithTemp test_name $ \tmp -> do 346 let old_path = tmp </> old_name 347 let new_path = tmp </> new_name 348 349 touch_ffi old_path "" 350 351 old_before <- liftIO $ Filesystem.isFile old_path 352 new_before <- liftIO $ Filesystem.isFile new_path 353 $expect old_before 354 $expect (not new_before) 355 356 liftIO $ Filesystem.rename old_path new_path 357 358 old_after <- liftIO $ Filesystem.isFile old_path 359 new_after <- liftIO $ Filesystem.isFile new_path 360 $expect (not old_after) 361 $expect new_after 362 363test_CopyFile :: String -> FilePath -> FilePath -> Test 364test_CopyFile test_name old_name new_name = assertionsWithTemp test_name $ \tmp -> do 365 let old_path = tmp </> old_name 366 let new_path = tmp </> new_name 367 368 touch_ffi old_path "" 369 370 old_before <- liftIO $ Filesystem.isFile old_path 371 new_before <- liftIO $ Filesystem.isFile new_path 372 $expect old_before 373 $expect (not new_before) 374 375 liftIO $ Filesystem.copyFile old_path new_path 376 377 old_after <- liftIO $ Filesystem.isFile old_path 378 new_after <- liftIO $ Filesystem.isFile new_path 379 $expect old_after 380 $expect new_after 381 old_contents <- liftIO $ 382 Filesystem.withTextFile old_path ReadMode $ 383 Data.Text.IO.hGetContents 384 new_contents <- liftIO $ 385 Filesystem.withTextFile new_path ReadMode $ 386 Data.Text.IO.hGetContents 387 $expect (equalLines old_contents new_contents) 388 389test_CanonicalizePath :: String -> FilePath -> FilePath -> Test 390test_CanonicalizePath test_name src_name dst_name = assertionsWithTemp test_name $ \tmp -> do 391 let src_path = tmp </> src_name 392 let subdir = tmp </> "subdir" 393 394 -- canonicalize the directory first, to avoid false negatives if 395 -- it gets placed in a symlinked location. 396 mkdir_ffi subdir 397 canon_subdir <- liftIO (Filesystem.canonicalizePath subdir) 398 399 let dst_path = canon_subdir </> dst_name 400 401 touch_ffi dst_path "" 402 symlink_ffi dst_path src_path 403 404 canonicalized <- liftIO $ Filesystem.canonicalizePath src_path 405 $expect $ equal canonicalized dst_path 406 407test_CanonicalizePath_TrailingSlash :: Test 408test_CanonicalizePath_TrailingSlash = assertionsWithTemp "trailing-slash" $ \tmp -> do 409 let src_path = tmp </> "src" 410 let subdir = tmp </> "subdir" 411 412 -- canonicalize the directory first, to avoid false negatives if 413 -- it gets placed in a symlinked location. 414 mkdir_ffi subdir 415 canon_subdir <- liftIO (Filesystem.canonicalizePath (tmp </> "subdir")) 416 417 let dst_path = canon_subdir </> "dst" 418 419 mkdir_ffi dst_path 420 symlink_ffi dst_path src_path 421 422 canonicalized <- liftIO (Filesystem.canonicalizePath (src_path </> empty)) 423 $expect (equal canonicalized (dst_path </> empty)) 424 425test_CreateDirectory :: String -> FilePath -> Test 426test_CreateDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do 427 let dir_path = tmp </> dir_name 428 429 exists_before <- liftIO $ Filesystem.isDirectory dir_path 430 $assert (not exists_before) 431 432 liftIO $ Filesystem.createDirectory False dir_path 433 exists_after <- liftIO $ Filesystem.isDirectory dir_path 434 435 $expect exists_after 436 437test_CreateDirectory_FailExists :: Test 438test_CreateDirectory_FailExists = assertionsWithTemp "fail-if-exists" $ \tmp -> do 439 let dir_path = tmp </> "subdir" 440 mkdir_ffi dir_path 441 442 $expect $ throwsEq 443 (mkAlreadyExists "createDirectory" dir_path) 444 (Filesystem.createDirectory False dir_path) 445 446test_CreateDirectory_SucceedExists :: Test 447test_CreateDirectory_SucceedExists = assertionsWithTemp "succeed-if-exists" $ \tmp -> do 448 let dir_path = tmp </> "subdir" 449 mkdir_ffi dir_path 450 451 liftIO $ Filesystem.createDirectory True dir_path 452 453test_CreateDirectory_FailFileExists :: Test 454test_CreateDirectory_FailFileExists = assertionsWithTemp "fail-if-file-exists" $ \tmp -> do 455 let dir_path = tmp </> "subdir" 456 touch_ffi dir_path "" 457 458 $expect $ throwsEq 459 (mkAlreadyExists "createDirectory" dir_path) 460 (Filesystem.createDirectory False dir_path) 461 $expect $ throwsEq 462 (mkAlreadyExists "createDirectory" dir_path) 463 (Filesystem.createDirectory True dir_path) 464 465mkAlreadyExists :: String -> FilePath -> GHC.IOError 466mkAlreadyExists loc path = GHC.IOError Nothing GHC.AlreadyExists loc "File exists" 467#if MIN_VERSION_base(4,2,0) 468 (Just (errnoCInt eEXIST)) 469#endif 470 (Just (CurrentOS.encodeString path)) 471 472test_CreateTree :: String -> FilePath -> Test 473test_CreateTree test_name dir_name = assertionsWithTemp test_name $ \tmp -> do 474 let dir_path = tmp </> dir_name 475 let subdir = dir_path </> "subdir" 476 477 dir_exists_before <- liftIO $ Filesystem.isDirectory dir_path 478 subdir_exists_before <- liftIO $ Filesystem.isDirectory subdir 479 $assert (not dir_exists_before) 480 $assert (not subdir_exists_before) 481 482 liftIO $ Filesystem.createTree subdir 483 dir_exists_after <- liftIO $ Filesystem.isDirectory dir_path 484 subdir_exists_after <- liftIO $ Filesystem.isDirectory subdir 485 486 $expect dir_exists_after 487 $expect subdir_exists_after 488 489test_ListDirectory :: Test 490test_ListDirectory = assertionsWithTemp "listDirectory" $ \tmp -> do 491 -- OSX replaces non-UTF8 filenames with http-style %XX escapes 492 let paths = 493#ifdef CABAL_OS_DARWIN 494 [ tmp </> decode "%A1%A2%A3.txt" 495 , tmp </> decode "test.txt" 496 , tmp </> fromText "\xA1\xA2.txt" 497 ] 498#else 499 [ tmp </> decode "test.txt" 500 , tmp </> fromText "\xA1\xA2.txt" 501 , tmp </> decode "\xA1\xA2\xA3.txt" 502 ] 503#endif 504 forM_ paths (\path -> touch_ffi path "") 505 506 names <- liftIO $ Filesystem.listDirectory tmp 507 $expect $ sameItems paths names 508 509test_RemoveFile :: String -> FilePath -> Test 510test_RemoveFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do 511 let file_path = tmp </> file_name 512 513 touch_ffi file_path "contents\n" 514 515 before <- liftIO $ Filesystem.isFile file_path 516 $assert before 517 518 liftIO $ Filesystem.removeFile file_path 519 520 after <- liftIO $ Filesystem.isFile file_path 521 $expect (not after) 522 523test_RemoveDirectory :: String -> FilePath -> Test 524test_RemoveDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do 525 let dir_path = tmp </> dir_name 526 527 mkdir_ffi dir_path 528 529 before <- liftIO $ Filesystem.isDirectory dir_path 530 $assert before 531 532 liftIO $ Filesystem.removeDirectory dir_path 533 534 after <- liftIO $ Filesystem.isDirectory dir_path 535 $expect (not after) 536 537test_RemoveTree :: String -> FilePath -> Test 538test_RemoveTree test_name dir_name = assertionsWithTemp test_name $ \tmp -> do 539 let dir_path = tmp </> dir_name 540 let subdir = dir_path </> "subdir" 541 542 mkdir_ffi dir_path 543 mkdir_ffi subdir 544 545 dir_before <- liftIO $ Filesystem.isDirectory dir_path 546 subdir_before <- liftIO $ Filesystem.isDirectory subdir 547 $assert dir_before 548 $assert subdir_before 549 550 liftIO $ Filesystem.removeTree dir_path 551 552 dir_after <- liftIO $ Filesystem.isDirectory dir_path 553 subdir_after <- liftIO $ Filesystem.isDirectory subdir 554 $expect (not dir_after) 555 $expect (not subdir_after) 556 557test_GetWorkingDirectory :: String -> FilePath -> Test 558test_GetWorkingDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do 559 -- canonicalize to avoid issues with symlinked temp dirs 560 canon_tmp <- liftIO (Filesystem.canonicalizePath tmp) 561 let dir_path = canon_tmp </> dir_name 562 563 mkdir_ffi dir_path 564 chdir_ffi dir_path 565 566 cwd <- liftIO $ Filesystem.getWorkingDirectory 567 $expect (equal cwd dir_path) 568 569test_SetWorkingDirectory :: String -> FilePath -> Test 570test_SetWorkingDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do 571 -- canonicalize to avoid issues with symlinked temp dirs 572 canon_tmp <- liftIO (Filesystem.canonicalizePath tmp) 573 let dir_path = canon_tmp </> dir_name 574 575 mkdir_ffi dir_path 576 liftIO $ Filesystem.setWorkingDirectory dir_path 577 578 cwd <- getcwd_ffi 579 $expect (equal cwd dir_path) 580 581test_GetHomeDirectory :: String -> FilePath -> Test 582test_GetHomeDirectory test_name dir_name = assertions test_name $ do 583 path <- liftIO $ withEnv "HOME" (Just dir_name) Filesystem.getHomeDirectory 584 $expect (equal path dir_name) 585 586test_GetDesktopDirectory :: String -> FilePath -> Test 587test_GetDesktopDirectory test_name dir_name = assertions test_name $ do 588 path <- liftIO $ 589 withEnv "XDG_DESKTOP_DIR" (Just dir_name) $ 590 Filesystem.getDesktopDirectory 591 $expect (equal path dir_name) 592 593 fallback <- liftIO $ 594 withEnv "XDG_DESKTOP_DIR" Nothing $ 595 withEnv "HOME" (Just dir_name) $ 596 Filesystem.getDesktopDirectory 597 $expect (equal fallback (dir_name </> "Desktop")) 598 599test_GetModified :: String -> FilePath -> Test 600test_GetModified test_name file_name = assertionsWithTemp test_name $ \tmp -> do 601 let file_path = tmp </> file_name 602 603 touch_ffi file_path "" 604 now <- liftIO getCurrentTime 605 606 mtime <- liftIO $ Filesystem.getModified file_path 607 $expect (equalWithin (diffUTCTime mtime now) 0 2) 608 609test_GetSize :: String -> FilePath -> Test 610test_GetSize test_name file_name = assertionsWithTemp test_name $ \tmp -> do 611 let file_path = tmp </> file_name 612 let contents = "contents\n" 613 614 touch_ffi file_path contents 615 616 size <- liftIO $ Filesystem.getSize file_path 617 $expect (equal size (toInteger (Data.ByteString.length contents))) 618 619test_WithFile_Read :: String -> FilePath -> Test 620test_WithFile_Read test_name file_name = assertionsWithTemp test_name $ \tmp -> do 621 let file_path = tmp </> file_name 622 let contents = "contents\n" 623 624 touch_ffi file_path contents 625 626 read_contents <- liftIO $ 627 Filesystem.withFile file_path ReadMode $ 628 Data.ByteString.hGetContents 629 $expect (equalLines contents read_contents) 630 631test_WithFile_Write :: String -> FilePath -> Test 632test_WithFile_Write test_name file_name = assertionsWithTemp test_name $ \tmp -> do 633 let file_path = tmp </> file_name 634 let contents = "contents\n" 635 636 liftIO $ 637 Filesystem.withFile file_path WriteMode $ 638 (\h -> Data.ByteString.hPut h contents) 639 640 read_contents <- liftIO $ 641 Filesystem.withFile file_path ReadMode $ 642 Data.ByteString.hGetContents 643 $expect (equalLines contents read_contents) 644 645test_WithTextFile :: String -> FilePath -> Test 646test_WithTextFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do 647 let file_path = tmp </> file_name 648 let contents = "contents\n" 649 650 touch_ffi file_path (Char8.pack contents) 651 652 read_contents <- liftIO $ 653 Filesystem.withTextFile file_path ReadMode $ 654 Data.Text.IO.hGetContents 655 $expect (equalLines (Data.Text.pack contents) read_contents) 656 657test_ListDirectoryLeaksFds :: Test 658test_ListDirectoryLeaksFds = assertionsWithTemp "listDirectory-leaks-fds" $ \tmp -> do 659 -- Test that listDirectory doesn't leak file descriptors. 660 let dir_path = tmp </> "subdir" 661 mkdir_ffi dir_path 662 663 nullfd1 <- liftIO $ PosixIO.openFd "/dev/null" PosixIO.ReadOnly Nothing PosixIO.defaultFileFlags 664 liftIO $ PosixIO.closeFd nullfd1 665 666 subdirContents <- liftIO $ listDirectory dir_path 667 668 nullfd2 <- liftIO $ PosixIO.openFd "/dev/null" PosixIO.ReadOnly Nothing PosixIO.defaultFileFlags 669 liftIO $ PosixIO.closeFd nullfd2 670 671 $assert (equal nullfd1 nullfd2) 672 673withPathCString :: FilePath -> (CString -> IO a) -> IO a 674withPathCString p = Data.ByteString.useAsCString (encode p) 675 676decode :: ByteString -> FilePath 677decode = Rules.decode Rules.posix 678 679encode :: FilePath -> ByteString 680encode = Rules.encode Rules.posix 681 682fromText :: Text -> FilePath 683fromText = Rules.fromText Rules.posix 684 685-- | Create a file using the raw POSIX API, via FFI 686touch_ffi :: FilePath -> Data.ByteString.ByteString -> Assertions () 687touch_ffi path contents = do 688 fp <- liftIO $ withPathCString path $ \path_cstr -> 689 Foreign.C.withCString "wb" $ \mode_cstr -> 690 c_fopen path_cstr mode_cstr 691 692 $assert (fp /= nullPtr) 693 694 _ <- liftIO $ Data.ByteString.useAsCStringLen contents $ \(buf, len) -> 695 c_fwrite buf 1 (fromIntegral len) fp 696 697 _ <- liftIO $ c_fclose fp 698 return () 699 700-- | Create a directory using the raw POSIX API, via FFI 701mkdir_ffi :: FilePath -> Assertions () 702mkdir_ffi path = do 703 ret <- liftIO $ withPathCString path $ \path_cstr -> 704 c_mkdir path_cstr 0o700 705 706 $assert (ret == 0) 707 708-- | Create a symlink using the raw POSIX API, via FFI 709symlink_ffi :: FilePath -> FilePath -> Assertions () 710symlink_ffi dst src = do 711 ret <- liftIO $ 712 withPathCString dst $ \dst_p -> 713 withPathCString src $ \src_p -> 714 c_symlink dst_p src_p 715 716 $assert (ret == 0) 717 718-- | Create a FIFO using the raw POSIX API, via FFI 719mkfifo_ffi :: FilePath -> Assertions () 720mkfifo_ffi path = do 721 ret <- liftIO $ withPathCString path $ \path_cstr -> 722 c_mkfifo path_cstr 0o700 723 724 $assert (ret == 0) 725 726getcwd_ffi :: Assertions FilePath 727getcwd_ffi = do 728 buf <- liftIO $ c_getcwd nullPtr 0 729 $assert (buf /= nullPtr) 730 bytes <- liftIO $ Data.ByteString.packCString buf 731 liftIO $ c_free buf 732 return (decode bytes) 733 734chdir_ffi :: FilePath -> Assertions () 735chdir_ffi path = do 736 ret <- liftIO $ 737 withPathCString path $ \path_p -> 738 c_chdir path_p 739 $assert (ret == 0) 740 741errnoCInt :: Errno -> CInt 742errnoCInt (Errno x) = x 743 744withEnv :: ByteString -> Maybe FilePath -> IO a -> IO a 745withEnv name val io = bracket set unset (\_ -> io) where 746 set = do 747 old <- getEnv name 748 setEnv name (fmap encode val) 749 return old 750 unset = setEnv name 751 752getEnv :: ByteString -> IO (Maybe ByteString) 753getEnv name = Data.ByteString.useAsCString name $ \cName -> do 754 ret <- liftIO (c_getenv cName) 755 if ret == nullPtr 756 then return Nothing 757 else fmap Just (Data.ByteString.packCString ret) 758 759setEnv :: ByteString -> Maybe ByteString -> IO () 760setEnv name Nothing = throwErrnoIfMinus1_ "setEnv" $ 761 Data.ByteString.useAsCString name c_unsetenv 762setEnv name (Just val) = throwErrnoIfMinus1_ "setEnv" $ 763 Data.ByteString.useAsCString name $ \cName -> 764 Data.ByteString.useAsCString val $ \cVal -> 765 c_setenv cName cVal 1 766 767foreign import ccall unsafe "fopen" 768 c_fopen :: CString -> CString -> IO (Ptr ()) 769 770foreign import ccall unsafe "fclose" 771 c_fclose :: Ptr () -> IO CInt 772 773foreign import ccall unsafe "fwrite" 774 c_fwrite :: CString -> CSize -> CSize -> Ptr () -> IO CSize 775 776foreign import ccall unsafe "mkdir" 777 c_mkdir :: CString -> CInt -> IO CInt 778 779foreign import ccall unsafe "symlink" 780 c_symlink :: CString -> CString -> IO CInt 781 782foreign import ccall unsafe "mkfifo" 783 c_mkfifo :: CString -> CInt -> IO CInt 784 785foreign import ccall unsafe "getcwd" 786 c_getcwd :: CString -> CSize -> IO CString 787 788foreign import ccall unsafe "chdir" 789 c_chdir :: CString -> IO CInt 790 791foreign import ccall unsafe "free" 792 c_free :: Ptr a -> IO () 793 794foreign import ccall unsafe "getenv" 795 c_getenv :: CString -> IO CString 796 797foreign import ccall unsafe "setenv" 798 c_setenv :: CString -> CString -> CInt -> IO CInt 799 800foreign import ccall unsafe "unsetenv" 801 c_unsetenv :: CString -> IO CInt 802