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