hasufell/hsfm
1
1
Fork 0
Code Issues 33 Pull Requests Releases Wiki Activity

LIB: add throwCantOpenDirectory calls to file operations

Browse Source
This commit is contained in:
Julian Ospald 2016-04-03 14:36:56 +02:00
parent 8c95aa312a
commit 9b03b36f2f
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
1 changed files with 9 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/HSFM/FileSystem/FileOperations.hs
View File

@ -175,6 +175,8 @@ copyDir cm from@(_ :/ Dir fromn FileInfo{ fileMode = fmode })
destdirp = top P.</> fromn destdirp = top P.</> fromn
throwDestinationInSource fromp destdirp throwDestinationInSource fromp destdirp
throwSameFile fromp destdirp throwSameFile fromp destdirp
throwCantOpenDirectory fromp
throwCantOpenDirectory top
createDestdir destdirp fmode createDestdir destdirp fmode
destdir <- HSFM.FileSystem.FileType.readFileWithFileInfo destdirp destdir <- HSFM.FileSystem.FileType.readFileWithFileInfo destdirp
@ -216,6 +218,7 @@ recreateSymlink _ _ AFileInvFN = throw InvalidFileName
recreateSymlink cm symf@(_ :/ SymLink {}) recreateSymlink cm symf@(_ :/ SymLink {})
symdest@(_ :/ Dir {}) symdest@(_ :/ Dir {})
= do = do
throwCantOpenDirectory $ fullPath symdest
sympoint <- readSymbolicLink (fullPathS $ symf) sympoint <- readSymbolicLink (fullPathS $ symf)
let symname = fullPath symdest P.</> (name . file $ symf) let symname = fullPath symdest P.</> (name . file $ symf)
case cm of case cm of
@ -238,6 +241,8 @@ copyFile' :: Path Abs -> Path Abs -> IO ()
copyFile' from to = do copyFile' from to = do
let from' = P.fromAbs from let from' = P.fromAbs from
to' = P.fromAbs to to' = P.fromAbs to
throwCantOpenDirectory $ P.dirname from
throwCantOpenDirectory $ P.dirname to
fromFstatus <- getSymbolicLinkStatus from' fromFstatus <- getSymbolicLinkStatus from'
fromContent <- BS.readFile from' fromContent <- BS.readFile from'
fd <- System.Posix.IO.createFile to' fd <- System.Posix.IO.createFile to'
@ -258,6 +263,8 @@ overwriteFile from@(_ :/ RegFile {})
= do = do
let from' = fullPath from let from' = fullPath from
to' = fullPath to to' = fullPath to
throwCantOpenDirectory $ P.dirname from'
throwCantOpenDirectory $ P.dirname to'
throwSameFile from' to' throwSameFile from' to'
copyFile' from' to' copyFile' from' to'
overwriteFile _ _ = throw $ InvalidOperation "wrong input type" overwriteFile _ _ = throw $ InvalidOperation "wrong input type"
@ -276,6 +283,7 @@ copyFileToDir cm from@(_ :/ RegFile fn _)
= do = do
let from' = fullPath from let from' = fullPath from
to' = fullPath to P.</> fn to' = fullPath to P.</> fn
throwCantOpenDirectory $ fullPath to
case cm of case cm of
Strict -> throwFileDoesExist to' Strict -> throwFileDoesExist to'
_ -> return () _ -> return ()
@ -333,13 +341,12 @@ deleteDir f@(_ :/ Dir {})
deleteDir _ = throw $ InvalidOperation "wrong input type" deleteDir _ = throw $ InvalidOperation "wrong input type"
-- TODO: check if we have permissions at all to remove the directory,
-- before we go recursively messing with it
-- |Deletes the given directory recursively. -- |Deletes the given directory recursively.
deleteDirRecursive :: AnchoredFile FileInfo -> IO () deleteDirRecursive :: AnchoredFile FileInfo -> IO ()
deleteDirRecursive AFileInvFN = throw InvalidFileName deleteDirRecursive AFileInvFN = throw InvalidFileName
deleteDirRecursive f@(_ :/ Dir {}) = do deleteDirRecursive f@(_ :/ Dir {}) = do
let fp = fullPath f let fp = fullPath f
throwCantOpenDirectory fp
files <- readDirectoryContents' fp files <- readDirectoryContents' fp
for_ files $ \file -> for_ files $ \file ->
case file of case file of