You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 

899 lines
27 KiB

  1. -- |
  2. -- Module : HPath.IO
  3. -- Copyright : © 2016 Julian Ospald
  4. -- License : BSD3
  5. --
  6. -- Maintainer : Julian Ospald <hasufell@posteo.de>
  7. -- Stability : experimental
  8. -- Portability : portable
  9. --
  10. -- This module provides high-level IO related file operations like
  11. -- copy, delete, move and so on. It only operates on /Path Abs/ which
  12. -- guarantees us well-typed paths which are absolute.
  13. --
  14. -- Some functions are just path-safe wrappers around
  15. -- unix functions, others have stricter exception handling
  16. -- and some implement functionality that doesn't have a unix
  17. -- counterpart (like `copyDirRecursive`).
  18. --
  19. -- Some of these operations are due to their nature __not atomic__, which
  20. -- means they may do multiple syscalls which form one context. Some
  21. -- of them also have to examine the filetypes explicitly before the
  22. -- syscalls, so a reasonable decision can be made. That means
  23. -- the result is undefined if another process changes that context
  24. -- while the non-atomic operation is still happening. However, where
  25. -- possible, as few syscalls as possible are used and the underlying
  26. -- exception handling is kept.
  27. --
  28. -- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket`
  29. -- are ignored by some of the more high-level functions (like `easyCopy`).
  30. -- For other functions (like `copyFile`), the behavior on these file types is
  31. -- unreliable/unsafe. Check the documentation of those functions for details.
  32. {-# LANGUAGE PackageImports #-}
  33. {-# LANGUAGE OverloadedStrings #-}
  34. module HPath.IO
  35. (
  36. -- * Types
  37. FileType(..)
  38. -- * File copying
  39. , copyDirRecursive
  40. , copyDirRecursiveOverwrite
  41. , recreateSymlink
  42. , copyFile
  43. , copyFileOverwrite
  44. , easyCopy
  45. , easyCopyOverwrite
  46. -- * File deletion
  47. , deleteFile
  48. , deleteDir
  49. , deleteDirRecursive
  50. , easyDelete
  51. -- * File opening
  52. , openFile
  53. , executeFile
  54. -- * File creation
  55. , createRegularFile
  56. , createDir
  57. , createSymlink
  58. -- * File renaming/moving
  59. , renameFile
  60. , moveFile
  61. , moveFileOverwrite
  62. -- * File permissions
  63. , newFilePerms
  64. , newDirPerms
  65. -- * Directory reading
  66. , getDirsFiles
  67. -- * Filetype operations
  68. , getFileType
  69. -- * Others
  70. , canonicalizePath
  71. )
  72. where
  73. import Control.Applicative
  74. (
  75. (<$>)
  76. )
  77. import Control.Exception
  78. (
  79. bracket
  80. , throwIO
  81. )
  82. import Control.Monad
  83. (
  84. void
  85. , when
  86. )
  87. import Data.ByteString
  88. (
  89. ByteString
  90. )
  91. import Data.Foldable
  92. (
  93. for_
  94. )
  95. import Data.Maybe
  96. (
  97. catMaybes
  98. )
  99. import Data.Word
  100. (
  101. Word8
  102. )
  103. import Foreign.C.Error
  104. (
  105. eEXIST
  106. , eINVAL
  107. , eNOSYS
  108. , eNOTEMPTY
  109. , eXDEV
  110. )
  111. import Foreign.C.Types
  112. (
  113. CSize
  114. )
  115. import Foreign.Marshal.Alloc
  116. (
  117. allocaBytes
  118. )
  119. import Foreign.Ptr
  120. (
  121. Ptr
  122. )
  123. import GHC.IO.Exception
  124. (
  125. IOErrorType(..)
  126. )
  127. import HPath
  128. import HPath.Internal
  129. import HPath.IO.Errors
  130. import HPath.IO.Utils
  131. import Prelude hiding (readFile)
  132. import System.IO.Error
  133. (
  134. catchIOError
  135. , ioeGetErrorType
  136. )
  137. import System.Linux.Sendfile
  138. (
  139. sendfileFd
  140. , FileRange(..)
  141. )
  142. import System.Posix.ByteString
  143. (
  144. exclusive
  145. )
  146. import System.Posix.Directory.ByteString
  147. (
  148. createDirectory
  149. , removeDirectory
  150. )
  151. import System.Posix.Directory.Traversals
  152. (
  153. getDirectoryContents'
  154. )
  155. import System.Posix.Files.ByteString
  156. (
  157. createSymbolicLink
  158. , fileMode
  159. , getFdStatus
  160. , groupExecuteMode
  161. , groupReadMode
  162. , groupWriteMode
  163. , otherExecuteMode
  164. , otherReadMode
  165. , otherWriteMode
  166. , ownerModes
  167. , ownerReadMode
  168. , ownerWriteMode
  169. , readSymbolicLink
  170. , removeLink
  171. , rename
  172. , setFileMode
  173. , unionFileModes
  174. )
  175. import qualified System.Posix.Files.ByteString as PF
  176. import qualified "unix" System.Posix.IO.ByteString as SPI
  177. import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
  178. import System.Posix.FD
  179. (
  180. openFd
  181. )
  182. import qualified System.Posix.Directory.Traversals as SPDT
  183. import qualified System.Posix.Directory.Foreign as SPDF
  184. import qualified System.Posix.Process.ByteString as SPP
  185. import System.Posix.Types
  186. (
  187. FileMode
  188. , ProcessID
  189. , Fd
  190. )
  191. -------------
  192. --[ Types ]--
  193. -------------
  194. data FileType = Directory
  195. | RegularFile
  196. | SymbolicLink
  197. | BlockDevice
  198. | CharacterDevice
  199. | NamedPipe
  200. | Socket
  201. deriving (Eq, Show)
  202. --------------------
  203. --[ File Copying ]--
  204. --------------------
  205. -- |Copies a directory recursively to the given destination.
  206. -- Does not follow symbolic links.
  207. --
  208. -- For directory contents, this has the same behavior as `easyCopy`
  209. -- and thus will ignore any file type that is not `RegularFile`,
  210. -- `SymbolicLink` or `Directory`.
  211. --
  212. -- Safety/reliability concerns:
  213. --
  214. -- * not atomic
  215. -- * examines filetypes explicitly
  216. -- * an explicit check `throwDestinationInSource` is carried out for the
  217. -- top directory for basic sanity, because otherwise we might end up
  218. -- with an infinite copy loop... however, this operation is not
  219. -- carried out recursively (because it's slow)
  220. --
  221. -- Throws:
  222. --
  223. -- - `NoSuchThing` if source directory does not exist
  224. -- - `PermissionDenied` if output directory is not writable
  225. -- - `PermissionDenied` if source directory can't be opened
  226. -- - `InvalidArgument` if source directory is wrong type (symlink)
  227. -- - `InvalidArgument` if source directory is wrong type (regular file)
  228. -- - `AlreadyExists` if destination already exists
  229. -- - `SameFile` if source and destination are the same file (`HPathIOException`)
  230. -- - `DestinationInSource` if destination is contained in source (`HPathIOException`)
  231. copyDirRecursive :: Path Abs -- ^ source dir
  232. -> Path Abs -- ^ full destination
  233. -> IO ()
  234. copyDirRecursive fromp destdirp
  235. = do
  236. -- for performance, sanity checks are only done for the top dir
  237. throwSameFile fromp destdirp
  238. throwDestinationInSource fromp destdirp
  239. go fromp destdirp
  240. where
  241. go :: Path Abs -> Path Abs -> IO ()
  242. go fromp' destdirp' = do
  243. -- order is important here, so we don't get empty directories
  244. -- on failure
  245. contents <- getDirsFiles fromp'
  246. fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')
  247. createDirectory (fromAbs destdirp') fmode'
  248. -- we can't use `easyCopy` here, because we want to call `go`
  249. -- recursively to skip the top-level sanity checks
  250. for_ contents $ \f -> do
  251. ftype <- getFileType f
  252. newdest <- (destdirp' </>) <$> basename f
  253. case ftype of
  254. SymbolicLink -> recreateSymlink f newdest
  255. Directory -> go f newdest
  256. RegularFile -> copyFile f newdest
  257. _ -> return ()
  258. -- |Like `copyDirRecursive` except it overwrites contents of directories
  259. -- if any.
  260. --
  261. -- For directory contents, this has the same behavior as `easyCopyOverwrite`
  262. -- and thus will ignore any file type that is not `RegularFile`,
  263. -- `SymbolicLink` or `Directory`.
  264. --
  265. -- Throws:
  266. --
  267. -- - `NoSuchThing` if source directory does not exist
  268. -- - `PermissionDenied` if output directory is not writable
  269. -- - `PermissionDenied` if source directory can't be opened
  270. -- - `InvalidArgument` if source directory is wrong type (symlink)
  271. -- - `InvalidArgument` if source directory is wrong type (regular file)
  272. -- - `SameFile` if source and destination are the same file (`HPathIOException`)
  273. -- - `DestinationInSource` if destination is contained in source (`HPathIOException`)
  274. copyDirRecursiveOverwrite :: Path Abs -- ^ source dir
  275. -> Path Abs -- ^ full destination
  276. -> IO ()
  277. copyDirRecursiveOverwrite fromp destdirp
  278. = do
  279. -- for performance, sanity checks are only done for the top dir
  280. throwSameFile fromp destdirp
  281. throwDestinationInSource fromp destdirp
  282. go fromp destdirp
  283. where
  284. go :: Path Abs -> Path Abs -> IO ()
  285. go fromp' destdirp' = do
  286. -- order is important here, so we don't get empty directories
  287. -- on failure
  288. contents <- getDirsFiles fromp'
  289. fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')
  290. catchIOError (createDirectory (fromAbs destdirp') fmode') $ \e ->
  291. case ioeGetErrorType e of
  292. AlreadyExists -> setFileMode (fromAbs destdirp') fmode'
  293. _ -> ioError e
  294. -- we can't use `easyCopyOverwrite` here, because we want to call `go`
  295. -- recursively to skip the top-level sanity checks
  296. for_ contents $ \f -> do
  297. ftype <- getFileType f
  298. newdest <- (destdirp' </>) <$> basename f
  299. case ftype of
  300. SymbolicLink -> whenM (doesFileExist newdest) (deleteFile newdest)
  301. >> recreateSymlink f newdest
  302. Directory -> go f newdest
  303. RegularFile -> copyFileOverwrite f newdest
  304. _ -> return ()
  305. -- |Recreate a symlink.
  306. --
  307. -- Throws:
  308. --
  309. -- - `InvalidArgument` if source file is wrong type (not a symlink)
  310. -- - `PermissionDenied` if output directory cannot be written to
  311. -- - `PermissionDenied` if source directory cannot be opened
  312. -- - `AlreadyExists` if destination file already exists
  313. -- - `SameFile` if source and destination are the same file (`HPathIOException`)
  314. --
  315. -- Note: calls `symlink`
  316. recreateSymlink :: Path Abs -- ^ the old symlink file
  317. -> Path Abs -- ^ destination file
  318. -> IO ()
  319. recreateSymlink symsource newsym
  320. = do
  321. throwSameFile symsource newsym
  322. sympoint <- readSymbolicLink (fromAbs symsource)
  323. createSymbolicLink sympoint (fromAbs newsym)
  324. -- |Copies the given regular file to the given destination.
  325. -- Neither follows symbolic links, nor accepts them.
  326. -- For "copying" symbolic links, use `recreateSymlink` instead.
  327. --
  328. -- Note that this is still sort of a low-level function and doesn't
  329. -- examine file types. For a more high-level version, use `easyCopy`
  330. -- instead.
  331. --
  332. -- Safety/reliability concerns:
  333. --
  334. -- * when used on `CharacterDevice`, reads the "contents" and copies
  335. -- them to a regular file, which might take indefinitely
  336. -- * when used on `BlockDevice`, may either read the "contents"
  337. -- and copy them to a regular file (potentially hanging indefinitely)
  338. -- or may create a regular empty destination file
  339. -- * when used on `NamedPipe`, will hang indefinitely
  340. --
  341. -- Throws:
  342. --
  343. -- - `NoSuchThing` if source file does not exist
  344. -- - `NoSuchThing` if source file is a a `Socket`
  345. -- - `PermissionDenied` if output directory is not writable
  346. -- - `PermissionDenied` if source directory can't be opened
  347. -- - `InvalidArgument` if source file is wrong type (symlink or directory)
  348. -- - `AlreadyExists` if destination already exists
  349. -- - `SameFile` if source and destination are the same file (`HPathIOException`)
  350. --
  351. -- Note: calls `sendfile` and possibly `read`/`write` as fallback
  352. copyFile :: Path Abs -- ^ source file
  353. -> Path Abs -- ^ destination file
  354. -> IO ()
  355. copyFile from to = do
  356. throwSameFile from to
  357. _copyFile [SPDF.oNofollow]
  358. [SPDF.oNofollow, SPDF.oExcl]
  359. from to
  360. -- |Like `copyFile` except it overwrites the destination if it already
  361. -- exists.
  362. --
  363. -- Safety/reliability concerns:
  364. --
  365. -- * when used on `CharacterDevice`, reads the "contents" and copies
  366. -- them to a regular file, which might take indefinitely
  367. -- * when used on `BlockDevice`, may either read the "contents"
  368. -- and copy them to a regular file (potentially hanging indefinitely)
  369. -- or may create a regular empty destination file
  370. -- * when used on `NamedPipe`, will hang indefinitely
  371. -- * not atomic, since it uses read/write
  372. --
  373. -- Throws:
  374. --
  375. -- - `NoSuchThing` if source file does not exist
  376. -- - `NoSuchThing` if source file is a `Socket`
  377. -- - `PermissionDenied` if output directory is not writable
  378. -- - `PermissionDenied` if source directory can't be opened
  379. -- - `InvalidArgument` if source file is wrong type (symlink or directory)
  380. -- - `SameFile` if source and destination are the same file (`HPathIOException`)
  381. --
  382. -- Note: calls `sendfile` and possibly `read`/`write` as fallback
  383. copyFileOverwrite :: Path Abs -- ^ source file
  384. -> Path Abs -- ^ destination file
  385. -> IO ()
  386. copyFileOverwrite from to = do
  387. throwSameFile from to
  388. catchIOError (_copyFile [SPDF.oNofollow]
  389. [SPDF.oNofollow, SPDF.oTrunc]
  390. from to) $ \e ->
  391. case ioeGetErrorType e of
  392. -- if the destination file is not writable, we need to
  393. -- figure out if we can still copy by deleting it first
  394. PermissionDenied -> do
  395. exists <- doesFileExist to
  396. writable <- isWritable (dirname to)
  397. if exists && writable
  398. then deleteFile to >> copyFile from to
  399. else ioError e
  400. _ -> ioError e
  401. _copyFile :: [SPDF.Flags]
  402. -> [SPDF.Flags]
  403. -> Path Abs -- ^ source file
  404. -> Path Abs -- ^ destination file
  405. -> IO ()
  406. _copyFile sflags dflags from to
  407. =
  408. -- from sendfile(2) manpage:
  409. -- Applications may wish to fall back to read(2)/write(2) in the case
  410. -- where sendfile() fails with EINVAL or ENOSYS.
  411. withAbsPath to $ \to' -> withAbsPath from $ \from' ->
  412. catchErrno [eINVAL, eNOSYS]
  413. (sendFileCopy from' to')
  414. (void $ readWriteCopy from' to')
  415. where
  416. copyWith copyAction source dest =
  417. bracket (openFd source SPI.ReadOnly sflags Nothing)
  418. SPI.closeFd
  419. $ \sfd -> do
  420. fileM <- System.Posix.Files.ByteString.fileMode
  421. <$> getFdStatus sfd
  422. bracketeer (openFd dest SPI.WriteOnly
  423. dflags $ Just fileM)
  424. SPI.closeFd
  425. (\fd -> SPI.closeFd fd >> deleteFile to)
  426. $ \dfd -> copyAction sfd dfd
  427. -- this is low-level stuff utilizing sendfile(2) for speed
  428. sendFileCopy :: ByteString -> ByteString -> IO ()
  429. sendFileCopy = copyWith
  430. (\sfd dfd -> sendfileFd dfd sfd EntireFile $ return ())
  431. -- low-level copy operation utilizing read(2)/write(2)
  432. -- in case `sendFileCopy` fails/is unsupported
  433. readWriteCopy :: ByteString -> ByteString -> IO Int
  434. readWriteCopy = copyWith
  435. (\sfd dfd -> allocaBytes (fromIntegral bufSize)
  436. $ \buf -> write' sfd dfd buf 0)
  437. where
  438. bufSize :: CSize
  439. bufSize = 8192
  440. write' :: Fd -> Fd -> Ptr Word8 -> Int -> IO Int
  441. write' sfd dfd buf totalsize = do
  442. size <- SPB.fdReadBuf sfd buf bufSize
  443. if size == 0
  444. then return $ fromIntegral totalsize
  445. else do rsize <- SPB.fdWriteBuf dfd buf size
  446. when (rsize /= size) (throwIO . CopyFailed $ "wrong size!")
  447. write' sfd dfd buf (totalsize + fromIntegral size)
  448. -- |Copies a regular file, directory or symbolic link. In case of a
  449. -- symbolic link it is just recreated, even if it points to a directory.
  450. -- Any other file type is ignored.
  451. --
  452. -- Safety/reliability concerns:
  453. --
  454. -- * examines filetypes explicitly
  455. -- * calls `copyDirRecursive` for directories
  456. easyCopy :: Path Abs
  457. -> Path Abs
  458. -> IO ()
  459. easyCopy from to = do
  460. ftype <- getFileType from
  461. case ftype of
  462. SymbolicLink -> recreateSymlink from to
  463. RegularFile -> copyFile from to
  464. Directory -> copyDirRecursive from to
  465. _ -> return ()
  466. -- |Like `easyCopy` except it overwrites the destination if it already exists.
  467. -- For directories, this overwrites contents without pruning them, so the resulting
  468. -- directory may have more files than have been copied.
  469. --
  470. -- Safety/reliability concerns:
  471. --
  472. -- * examines filetypes explicitly
  473. -- * calls `copyDirRecursive` for directories
  474. easyCopyOverwrite :: Path Abs
  475. -> Path Abs
  476. -> IO ()
  477. easyCopyOverwrite from to = do
  478. ftype <- getFileType from
  479. case ftype of
  480. SymbolicLink -> whenM (doesFileExist to) (deleteFile to)
  481. >> recreateSymlink from to
  482. RegularFile -> copyFileOverwrite from to
  483. Directory -> copyDirRecursiveOverwrite from to
  484. _ -> return ()
  485. ---------------------
  486. --[ File Deletion ]--
  487. ---------------------
  488. -- |Deletes the given file. Raises `eISDIR`
  489. -- if run on a directory. Does not follow symbolic links.
  490. --
  491. -- Throws:
  492. --
  493. -- - `InappropriateType` for wrong file type (directory)
  494. -- - `NoSuchThing` if the file does not exist
  495. -- - `PermissionDenied` if the directory cannot be read
  496. deleteFile :: Path Abs -> IO ()
  497. deleteFile p = withAbsPath p removeLink
  498. -- |Deletes the given directory, which must be empty, never symlinks.
  499. --
  500. -- Throws:
  501. --
  502. -- - `InappropriateType` for wrong file type (symlink to directory)
  503. -- - `InappropriateType` for wrong file type (regular file)
  504. -- - `NoSuchThing` if directory does not exist
  505. -- - `UnsatisfiedConstraints` if directory is not empty
  506. -- - `PermissionDenied` if we can't open or write to parent directory
  507. --
  508. -- Notes: calls `rmdir`
  509. deleteDir :: Path Abs -> IO ()
  510. deleteDir p = withAbsPath p removeDirectory
  511. -- |Deletes the given directory recursively. Does not follow symbolic
  512. -- links. Tries `deleteDir` first before attemtping a recursive
  513. -- deletion.
  514. --
  515. -- On directory contents this behaves like `easyDelete`
  516. -- and thus will ignore any file type that is not `RegularFile`,
  517. -- `SymbolicLink` or `Directory`.
  518. --
  519. -- Safety/reliability concerns:
  520. --
  521. -- * not atomic
  522. -- * examines filetypes explicitly
  523. --
  524. -- Throws:
  525. --
  526. -- - `InappropriateType` for wrong file type (symlink to directory)
  527. -- - `InappropriateType` for wrong file type (regular file)
  528. -- - `NoSuchThing` if directory does not exist
  529. -- - `PermissionDenied` if we can't open or write to parent directory
  530. deleteDirRecursive :: Path Abs -> IO ()
  531. deleteDirRecursive p =
  532. catchErrno [eNOTEMPTY, eEXIST]
  533. (deleteDir p)
  534. $ do
  535. files <- getDirsFiles p
  536. for_ files $ \file -> do
  537. ftype <- getFileType file
  538. case ftype of
  539. SymbolicLink -> deleteFile file
  540. Directory -> deleteDirRecursive file
  541. RegularFile -> deleteFile file
  542. _ -> return ()
  543. removeDirectory . toFilePath $ p
  544. -- |Deletes a file, directory or symlink.
  545. -- In case of directory, performs recursive deletion. In case of
  546. -- a symlink, the symlink file is deleted.
  547. -- Any other file type is ignored.
  548. --
  549. -- Safety/reliability concerns:
  550. --
  551. -- * examines filetypes explicitly
  552. -- * calls `deleteDirRecursive` for directories
  553. easyDelete :: Path Abs -> IO ()
  554. easyDelete p = do
  555. ftype <- getFileType p
  556. case ftype of
  557. SymbolicLink -> deleteFile p
  558. Directory -> deleteDirRecursive p
  559. RegularFile -> deleteFile p
  560. _ -> return ()
  561. --------------------
  562. --[ File Opening ]--
  563. --------------------
  564. -- |Opens a file appropriately by invoking xdg-open. The file type
  565. -- is not checked. This forks a process.
  566. openFile :: Path Abs
  567. -> IO ProcessID
  568. openFile p =
  569. withAbsPath p $ \fp ->
  570. SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing
  571. -- |Executes a program with the given arguments. This forks a process.
  572. executeFile :: Path Abs -- ^ program
  573. -> [ByteString] -- ^ arguments
  574. -> IO ProcessID
  575. executeFile fp args
  576. = withAbsPath fp $ \fpb ->
  577. SPP.forkProcess
  578. $ SPP.executeFile fpb True args Nothing
  579. ---------------------
  580. --[ File Creation ]--
  581. ---------------------
  582. -- |Create an empty regular file at the given directory with the given filename.
  583. --
  584. -- Throws:
  585. --
  586. -- - `PermissionDenied` if output directory cannot be written to
  587. -- - `AlreadyExists` if destination file already exists
  588. createRegularFile :: Path Abs -> IO ()
  589. createRegularFile dest =
  590. bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just newFilePerms)
  591. (SPI.defaultFileFlags { exclusive = True }))
  592. SPI.closeFd
  593. (\_ -> return ())
  594. -- |Create an empty directory at the given directory with the given filename.
  595. --
  596. -- Throws:
  597. --
  598. -- - `PermissionDenied` if output directory cannot be written to
  599. -- - `AlreadyExists` if destination directory already exists
  600. createDir :: Path Abs -> IO ()
  601. createDir dest = createDirectory (fromAbs dest) newDirPerms
  602. -- |Create a symlink.
  603. --
  604. -- Throws:
  605. --
  606. -- - `PermissionDenied` if output directory cannot be written to
  607. -- - `AlreadyExists` if destination file already exists
  608. --
  609. -- Note: calls `symlink`
  610. createSymlink :: Path Abs -- ^ destination file
  611. -> ByteString -- ^ path the symlink points to
  612. -> IO ()
  613. createSymlink dest sympoint
  614. = createSymbolicLink sympoint (fromAbs dest)
  615. ----------------------------
  616. --[ File Renaming/Moving ]--
  617. ----------------------------
  618. -- |Rename a given file with the provided filename. Destination and source
  619. -- must be on the same device, otherwise `eXDEV` will be raised.
  620. --
  621. -- Does not follow symbolic links, but renames the symbolic link file.
  622. --
  623. -- Safety/reliability concerns:
  624. --
  625. -- * has a separate set of exception handling, apart from the syscall
  626. --
  627. -- Throws:
  628. --
  629. -- - `NoSuchThing` if source file does not exist
  630. -- - `PermissionDenied` if output directory cannot be written to
  631. -- - `PermissionDenied` if source directory cannot be opened
  632. -- - `UnsupportedOperation` if source and destination are on different devices
  633. -- - `FileDoesExist` if destination file already exists (`HPathIOException`)
  634. -- - `DirDoesExist` if destination directory already exists (`HPathIOException`)
  635. -- - `SameFile` if destination and source are the same file (`HPathIOException`)
  636. --
  637. -- Note: calls `rename` (but does not allow to rename over existing files)
  638. renameFile :: Path Abs -> Path Abs -> IO ()
  639. renameFile fromf tof = do
  640. throwSameFile fromf tof
  641. throwFileDoesExist tof
  642. throwDirDoesExist tof
  643. rename (fromAbs fromf) (fromAbs tof)
  644. -- |Move a file. This also works across devices by copy-delete fallback.
  645. -- And also works on directories.
  646. --
  647. -- Does not follow symbolic links, but renames the symbolic link file.
  648. --
  649. --
  650. -- Safety/reliability concerns:
  651. --
  652. -- * copy-delete fallback is inherently non-atomic
  653. -- * since this function calls `easyCopy` and `easyDelete` as a fallback
  654. -- to `renameFile`, file types that are not `RegularFile`, `SymbolicLink`
  655. -- or `Directory` may be ignored
  656. --
  657. -- Throws:
  658. --
  659. -- - `NoSuchThing` if source file does not exist
  660. -- - `PermissionDenied` if output directory cannot be written to
  661. -- - `PermissionDenied` if source directory cannot be opened
  662. -- - `FileDoesExist` if destination file already exists (`HPathIOException`)
  663. -- - `DirDoesExist` if destination directory already exists (`HPathIOException`)
  664. -- - `SameFile` if destination and source are the same file (`HPathIOException`)
  665. --
  666. -- Note: calls `rename` (but does not allow to rename over existing files)
  667. moveFile :: Path Abs -- ^ file to move
  668. -> Path Abs -- ^ destination
  669. -> IO ()
  670. moveFile from to = do
  671. throwSameFile from to
  672. catchErrno [eXDEV] (renameFile from to) $ do
  673. easyCopy from to
  674. easyDelete from
  675. -- |Like `moveFile`, but overwrites the destination if it exists.
  676. --
  677. -- Does not follow symbolic links, but renames the symbolic link file.
  678. --
  679. -- Ignores any file type that is not `RegularFile`, `SymbolicLink` or
  680. -- `Directory`.
  681. --
  682. -- Safety/reliability concerns:
  683. --
  684. -- * copy-delete fallback is inherently non-atomic
  685. -- * checks for file types and destination file existence explicitly
  686. --
  687. -- Throws:
  688. --
  689. -- - `NoSuchThing` if source file does not exist
  690. -- - `PermissionDenied` if output directory cannot be written to
  691. -- - `PermissionDenied` if source directory cannot be opened
  692. -- - `SameFile` if destination and source are the same file (`HPathIOException`)
  693. --
  694. -- Note: calls `rename` (but does not allow to rename over existing files)
  695. moveFileOverwrite :: Path Abs -- ^ file to move
  696. -> Path Abs -- ^ destination
  697. -> IO ()
  698. moveFileOverwrite from to = do
  699. throwSameFile from to
  700. ft <- getFileType from
  701. writable <- isWritable $ dirname to
  702. case ft of
  703. RegularFile -> do
  704. exists <- doesFileExist to
  705. when (exists && writable) (deleteFile to)
  706. SymbolicLink -> do
  707. exists <- doesFileExist to
  708. when (exists && writable) (deleteFile to)
  709. Directory -> do
  710. exists <- doesDirectoryExist to
  711. when (exists && writable) (deleteDir to)
  712. _ -> return ()
  713. moveFile from to
  714. -----------------------
  715. --[ File Permissions]--
  716. -----------------------
  717. -- |Default permissions for a new file.
  718. newFilePerms :: FileMode
  719. newFilePerms
  720. = ownerWriteMode
  721. `unionFileModes` ownerReadMode
  722. `unionFileModes` groupWriteMode
  723. `unionFileModes` groupReadMode
  724. `unionFileModes` otherWriteMode
  725. `unionFileModes` otherReadMode
  726. -- |Default permissions for a new directory.
  727. newDirPerms :: FileMode
  728. newDirPerms
  729. = ownerModes
  730. `unionFileModes` groupExecuteMode
  731. `unionFileModes` groupReadMode
  732. `unionFileModes` otherExecuteMode
  733. `unionFileModes` otherReadMode
  734. -------------------------
  735. --[ Directory reading ]--
  736. -------------------------
  737. -- |Gets all filenames of the given directory. This excludes "." and "..".
  738. -- This version does not follow symbolic links.
  739. --
  740. -- Throws:
  741. --
  742. -- - `NoSuchThing` if directory does not exist
  743. -- - `InappropriateType` if file type is wrong (file)
  744. -- - `InappropriateType` if file type is wrong (symlink to file)
  745. -- - `InappropriateType` if file type is wrong (symlink to dir)
  746. -- - `PermissionDenied` if directory cannot be opened
  747. getDirsFiles :: Path Abs -- ^ dir to read
  748. -> IO [Path Abs]
  749. getDirsFiles p =
  750. withAbsPath p $ \fp -> do
  751. fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing
  752. return
  753. . catMaybes
  754. . fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))
  755. =<< getDirectoryContents' fd
  756. where
  757. parseMaybe :: ByteString -> Maybe (Path Fn)
  758. parseMaybe = parseFn
  759. ---------------------------
  760. --[ FileType operations ]--
  761. ---------------------------
  762. -- |Get the file type of the file located at the given path. Does
  763. -- not follow symbolic links.
  764. --
  765. -- Throws:
  766. --
  767. -- - `NoSuchThing` if the file does not exist
  768. -- - `PermissionDenied` if any part of the path is not accessible
  769. getFileType :: Path Abs -> IO FileType
  770. getFileType p = do
  771. fs <- PF.getSymbolicLinkStatus (fromAbs p)
  772. decide fs
  773. where
  774. decide fs
  775. | PF.isDirectory fs = return Directory
  776. | PF.isRegularFile fs = return RegularFile
  777. | PF.isSymbolicLink fs = return SymbolicLink
  778. | PF.isBlockDevice fs = return BlockDevice
  779. | PF.isCharacterDevice fs = return CharacterDevice
  780. | PF.isNamedPipe fs = return NamedPipe
  781. | PF.isSocket fs = return Socket
  782. | otherwise = ioError $ userError "No filetype?!"
  783. --------------
  784. --[ Others ]--
  785. --------------
  786. -- |Applies `realpath` on the given absolute path.
  787. --
  788. -- Throws:
  789. --
  790. -- - `NoSuchThing` if the file at the given path does not exist
  791. -- - `NoSuchThing` if the symlink is broken
  792. canonicalizePath :: Path Abs -> IO (Path Abs)
  793. canonicalizePath (MkPath l) = do
  794. nl <- SPDT.realpath l
  795. return $ MkPath nl