1{-# LANGUAGE Trustworthy #-} 2 3{- arch-tag: HVFS utilities main file 4Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org> 5 6All rights reserved. 7 8For license and copyright information, see the file LICENSE 9-} 10 11{- | 12 Module : System.IO.HVFS.Utils 13 Copyright : Copyright (C) 2004-2011 John Goerzen 14 SPDX-License-Identifier: BSD-3-Clause 15 16 Stability : provisional 17 Portability: portable 18 19This module provides various helpful utilities for dealing 20filesystems. 21 22Written by John Goerzen, jgoerzen\@complete.org 23 24To operate on your system's main filesystem, just pass SystemFS as the 25first parameter to these functions. 26-} 27 28module System.IO.HVFS.Utils (recurseDir, 29 recurseDirStat, 30 recursiveRemove, 31 lsl, 32 SystemFS(..) 33 ) 34where 35 36import System.FilePath (pathSeparator, (</>)) 37import System.IO.HVFS 38import System.IO.PlafCompat 39import System.IO.Unsafe (unsafeInterleaveIO) 40import System.Locale 41import System.Time 42import System.Time.Utils 43import Text.Printf 44 45{- | Obtain a recursive listing of all files\/directories beneath 46the specified directory. The traversal is depth-first 47and the original 48item is always present in the returned list. 49 50If the passed value is not a directory, the return value 51be only that value. 52 53The \".\" and \"..\" entries are removed from the data returned. 54-} 55recurseDir :: HVFS a => a -> FilePath -> IO [FilePath] 56recurseDir fs x = recurseDirStat fs x >>= return . map fst 57 58{- | Like 'recurseDir', but return the stat() (System.Posix.Files.FileStatus) 59information with them. This is an optimization if you will be statting files 60yourself later. 61 62The items are returned lazily. 63 64WARNING: do not change your current working directory until you have consumed 65all the items. Doing so could cause strange effects. 66 67Alternatively, you may wish to pass an absolute path to this function. 68-} 69 70recurseDirStat :: HVFS a => a -> FilePath -> IO [(FilePath, HVFSStatEncap)] 71recurseDirStat h fn = 72 do fs <- vGetSymbolicLinkStatus h fn 73 if withStat fs vIsDirectory 74 then do 75 dirc <- vGetDirectoryContents h fn 76 let contents = map ((++) (fn ++ [pathSeparator])) $ 77 filter (\x -> x /= "." && x /= "..") dirc 78 subdirs <- unsafeInterleaveIO $ mapM (recurseDirStat h) contents 79 return $ (concat subdirs) ++ [(fn, fs)] 80 else return [(fn, fs)] 81 82{- | Removes a file or a directory. If a directory, also removes all its 83child files\/directories. 84-} 85recursiveRemove :: HVFS a => a -> FilePath -> IO () 86recursiveRemove h fn = 87 recurseDirStat h fn >>= (mapM_ $ 88 \(fn, fs) -> if withStat fs vIsDirectory 89 then vRemoveDirectory h fn 90 else vRemoveFile h fn 91 ) 92 93{- | Provide a result similar to the command ls -l over a directory. 94 95Known bug: setuid bit semantics are inexact compared with standard ls. 96-} 97lsl :: HVFS a => a -> FilePath -> IO String 98lsl fs fp = 99 let showmodes mode = 100 let i m = (intersectFileModes mode m /= 0) 101 in 102 (if i ownerReadMode then 'r' else '-') : 103 (if i ownerWriteMode then 'w' else '-') : 104 (if i setUserIDMode then 's' else 105 if i ownerExecuteMode then 'x' else '-') : 106 (if i groupReadMode then 'r' else '-') : 107 (if i groupWriteMode then 'w' else '-') : 108 (if i setGroupIDMode then 's' else 109 if i groupExecuteMode then 'x' else '-') : 110 (if i otherReadMode then 'r' else '-') : 111 (if i otherWriteMode then 'w' else '-') : 112 (if i otherExecuteMode then 'x' else '-') : [] 113 showentry origdir fh (state, fp) = 114 case state of 115 HVFSStatEncap se -> 116 let typechar = 117 if vIsDirectory se then 'd' 118 else if vIsSymbolicLink se then 'l' 119 else if vIsBlockDevice se then 'b' 120 else if vIsCharacterDevice se then 'c' 121 else if vIsSocket se then 's' 122 else if vIsNamedPipe se then 's' 123 else '-' 124 clocktime = epochToClockTime (vModificationTime se) 125 datestr c= formatCalendarTime defaultTimeLocale "%b %e %Y" 126 c 127 in do c <- toCalendarTime clocktime 128 linkstr <- case vIsSymbolicLink se of 129 False -> return "" 130 True -> do sl <- vReadSymbolicLink fh 131 (origdir </> fp) 132 return $ " -> " ++ sl 133 return $ printf "%c%s 1 %-8d %-8d %-9d %s %s%s" 134 typechar 135 (showmodes (vFileMode se)) 136 (toInteger $ vFileOwner se) 137 (toInteger $ vFileGroup se) 138 (toInteger $ vFileSize se) 139 (datestr c) 140 fp 141 linkstr 142 in do c <- vGetDirectoryContents fs fp 143 pairs <- mapM (\x -> do ss <- vGetSymbolicLinkStatus fs (fp </> x) 144 return (ss, x) 145 ) c 146 linedata <- mapM (showentry fp fs) pairs 147 return $ unlines $ ["total 1"] ++ linedata 148 149 150