fdo-trash (empty) → 0.0.0.0
raw patch · 8 files changed
+512/−0 lines, 8 filesdep +Diffdep +basedep +directorysetup-changed
Dependencies added: Diff, base, directory, fdo-trash, filepath, old-locale, parsec, time, unix, url
Files
- Freedesktop/Trash.hs +175/−0
- Setup.hs +2/−0
- fdo-trash.cabal +41/−0
- fdo-trash.hs +251/−0
- man/fdo-purge.txt +10/−0
- man/fdo-rm.txt +9/−0
- man/fdo-unrm.txt +9/−0
- man/genManPages +15/−0
+ Freedesktop/Trash.hs view
@@ -0,0 +1,175 @@+module Freedesktop.Trash (+ TrashFile(..),+ trashGetOrphans,+ trashGetFiles,+ trashSortFiles,+ trashRestore,+ genTrashFile,+ moveToTrash,+ getPathSize,+ formatTrashDate,+ encodeTrashPath,+ expungeTrash,+ getTrashPaths+) where+++import Network.URL(encString,decString, ok_url)+import System.Posix.Env(getEnv,getEnvDefault)+import System.FilePath.Posix((</>),(<.>),dropExtension,splitExtension)+import System.Directory(getDirectoryContents,removeDirectoryRecursive)+import Data.Maybe(fromJust,catMaybes)+import System.Locale(iso8601DateFormat,defaultTimeLocale)+import Text.ParserCombinators.Parsec(parse,many,try,(<|>),string,noneOf,oneOf,many)+import Data.Time(getCurrentTimeZone,parseTime,localTimeToUTC,UTCTime,formatTime,utcToLocalTime,FormatTime)+import Data.Either(partitionEithers)+import Control.Monad(when)+import Data.Algorithm.Diff(getDiff,DI(..))+import Data.List(sort)+import System.Posix.Files(fileSize,getSymbolicLinkStatus,isRegularFile,isDirectory,rename,removeLink,fileExist)+import qualified System.IO.Error as E++data TrashFile = TrashFile {+ infoPath :: FilePath,+ dataPath :: FilePath,+ origPath :: FilePath,+ deleteTime :: UTCTime,+ totalSize :: Integer+ } deriving (Show)++trashHeaderString = "[Trash Info]\n"++headerLine = string trashHeaderString++dateLine = do+ _ <- string "DeletionDate="+ dateString <- many $ oneOf "0123456789-T:"+ _ <- many $ noneOf "\n"+ _ <- string "\n"+ return (parseTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S") dateString) >>=+ maybe (fail "Invalid date format") (return.Left)++nameLine = do+ _ <- string "Path="+ n <- many $ noneOf " \n\t"+ _ <- many $ noneOf "\n"+ _ <- string "\n"+ return (decString False n) >>=+ maybe (fail "Invalid url-encoded filename") (return.Right)++searchHeader = (try headerLine) <|>+ (ignoreLine >> searchHeader)++line = (try nameLine) <|>+ (try dateLine) <|>+ (ignoreLine >> line)++ignoreLine = many (noneOf "\n") >> string "\n"++infoFile timeZone = do+ _ <- searchHeader+ (dates,names) <- fmap partitionEithers $ many line+ when (length dates /= 1 || length names /= 1) $ fail "Exactly one name and date not found."+ return (localTimeToUTC timeZone (head dates), head names)++genTrashFile riPath rdPath timeZone name = do+ let iPath = riPath </> name <.> "trashinfo"+ let dPath = rdPath </> name+ size <- getPathSize dPath+ parsed <- readFile iPath >>=+ (\x -> return (parse (infoFile timeZone) "" x))+ either (\x -> print iPath >> print x >> return Nothing)+ (\(x,y) -> return.Just $ TrashFile iPath dPath y x size)+ parsed++trashSortFiles iPath fPath= do+ timeZone <- getCurrentTimeZone+ iFiles <- fmap (sort.filter (\x -> x /= ".." && x /= ".")) $ getDirectoryContents iPath+ dataFiles <- fmap (sort.filter (\x -> x /= ".." && x /= ".")) $ getDirectoryContents fPath+ let dFiles = sort $ map (<.>"trashinfo") dataFiles+ diff = getDiff iFiles dFiles+ files <- fmap catMaybes $ mapM (genTrashFile iPath fPath timeZone) (diffBth diff)+ return (files, (diffFst diff, map dropExtension $ diffSnd diff))+ where diffFst ((F,l):xs) = l : diffFst xs+ diffFst [] = []+ diffFst (_:xs) = diffFst xs+ diffSnd ((S,l):xs) = dropExtension l : diffSnd xs+ diffSnd [] = []+ diffSnd (_:xs) = diffSnd xs+ diffBth ((B,l):xs) = dropExtension l : diffBth xs+ diffBth [] = []+ diffBth (_:xs) = diffBth xs++trashGetOrphans iPath fPath = fmap snd $ trashSortFiles iPath fPath++trashGetFiles iPath fPath = fmap fst $ trashSortFiles iPath fPath++formatTrashDate :: FormatTime a => a -> String+formatTrashDate = formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S")++encodeTrashPath = encString False ok_url++doRemoveFile file = E.catch (removeDirectoryRecursive file)+ (\_ -> E.try (removeLink file) >> return ())+ >> return ()++expungeTrash file = do+ doRemoveFile (dataPath file)+ doRemoveFile (infoPath file)++trashRestore file condName = do+ rename (dataPath file) $ maybe (origPath file) id condName+ expungeTrash file++getPathSize path = do+ stat <- getSymbolicLinkStatus path+ if (isDirectory stat)+ then do+ files <- fmap (map (path</>) . filter (\x -> x /= ".." && x /= ".")) $ getDirectoryContents path+ fmap sum (mapM getPathSize files)+ else do+ if (isRegularFile stat)+ then return (fromIntegral $ fileSize stat)+ else return 0++getTrashPaths = do+ defaultRoot <- fmap ((</> ".local/share/").fromJust) $ getEnv "HOME"+ rootPath <- fmap (</> "Trash") $ getEnvDefault "XDG_DATA_HOME" defaultRoot+ let iPath = rootPath </> "info"+ let fPath = rootPath </> "files"+ return (iPath,fPath)++getFreeTrashSlot :: TrashFile -> Maybe Int -> IO TrashFile+getFreeTrashSlot trashFile Nothing = do+ iExists <- fileExist $ infoPath trashFile+ dExists <- fileExist $ dataPath trashFile+ if (iExists || dExists)+ then getFreeTrashSlot trashFile (Just 0)+ else return trashFile+getFreeTrashSlot trashFile (Just index) = do+ let (iPath',iExt2) = splitExtension $ infoPath trashFile+ (iPath,iExt1) = splitExtension $ iPath'+ (dPath,dExt) = splitExtension $ dataPath trashFile+ iTry = iPath <.> show index <.> iExt1 <.> iExt2+ dTry = dPath <.> show index <.> dExt++ iExists <- fileExist iTry+ dExists <- fileExist dTry+ if (iExists || dExists)+ then getFreeTrashSlot trashFile (Just $ index + 1)+ else return trashFile{infoPath=iTry, dataPath=dTry}++doMoveToTrash trashFile = do+ timeZone <- getCurrentTimeZone+ writeFile (infoPath trashFile)+ ( trashHeaderString+ ++ "Path=" ++ (encodeTrashPath $ origPath trashFile) ++ "\n"+ ++ "DeletionDate=" ++ formatTrashDate (utcToLocalTime timeZone $ deleteTime trashFile) ++ "\n"+ )+ rename (origPath trashFile) (dataPath trashFile)++moveToTrash trashFile = do+ yes <- fileExist $ origPath trashFile+ target <- getFreeTrashSlot trashFile Nothing+ when yes $ doMoveToTrash target+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fdo-trash.cabal view
@@ -0,0 +1,41 @@+name: fdo-trash+version: 0.0.0.0+copyright: (c) 2012 Emil Karlson+license: BSD3+author: Emil Karlson <jekarlson@gmail.com>+maintainer: Emil Karlson <jekarlson@gmail.com>+category: Desktop+synopsis: Utilities related to freedesktop Trash standard.+description: Contains utilities to unrm from trash, purge old files from trash and move files to trash.+stability: provisional+build-type: Simple+cabal-version: >= 1.8++library+ exposed-modules: Freedesktop.Trash+ other-modules: Paths_fdo_trash+ build-depends: base < 5,+ unix < 3,+ Diff,+ parsec,+ old-locale,+ directory,+ filepath,+ url,+ time+ ghc-options: -Wall -fno-warn-missing-signatures++executable fdo-trash+ Main-is: fdo-trash.hs+ Build-Depends: base >= 3 && < 5,+ fdo-trash,+ Diff,+ parsec,+ old-locale,+ directory,+ filepath,+ url,+ time,+ unix+ ghc-options: -Wall -fno-warn-missing-signatures+
+ fdo-trash.hs view
@@ -0,0 +1,251 @@+import System.Environment(getArgs,getProgName)+import System.Console.GetOpt(getOpt,ArgOrder(..),OptDescr(..),ArgDescr(..),usageInfo)+import System.FilePath.Posix((</>),(<.>),isAbsolute,takeFileName,dropTrailingPathSeparator)+import Data.Time(getCurrentTime,diffUTCTime,addUTCTime)+import Data.List(intercalate)+import Freedesktop.Trash(TrashFile(..),trashGetOrphans,getTrashPaths,trashGetFiles,trashRestore,expungeTrash,moveToTrash)+import Control.Monad(when)+import System.Exit(exitSuccess)+import Paths_fdo_trash(version)+import Data.Version(showVersion)+import System.Directory(createDirectoryIfMissing,canonicalizePath)+import Text.Parsec(parse,many1,(<|>),char,oneOf,eof,option,digit,ParseError)++minSecs = 60+hourSecs = 60 *minSecs+daySecs = 24 *hourSecs+monthSecs = 30 *daySecs+yearSecs = 365*daySecs++timeOffsetString = do+ sign <- (char '-' >> return (-1))+ <|> (option 1 (char '+' >> return 1))+ num <- option 1 (fmap read $ many1 digit)+ mult <- option 'd' (oneOf "SMHdmy")+ let multNum = case mult of+ 'S' -> 1+ 'M' -> minSecs+ 'H' -> hourSecs+ 'd' -> daySecs+ 'm' -> monthSecs+ 'y' -> yearSecs+ _ -> undefined+ eof+ return $ sign*num*multNum++printVersion = fmap (++ '-' : showVersion version) getProgName >>= putStrLn >> exitSuccess++castFloat :: (Real a, Fractional b) => a -> b+castFloat = fromRational.toRational++actions =+ [ ("purge", fdoPurge)+ , ("rm", fdoRm)+ , ("unrm", fdoUnRm)+ ]++--compilerOpts :: [String] -> IO (Options, [String])+parseOpts defaultOptions options exe argv =+ case getOpt Permute options argv of+ (o,n,[] ) -> return (foldl (flip id) defaultOptions o, n)+ (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))+ where header = "Usage: " ++ exe ++ " [OPTION...] parameters..."++--Rm+data RmOptions = RmOptions+ { rmTimeOffset :: Either ParseError Double+ , rmVersion :: Bool+ , rmHelp :: Bool+ , rmTrash :: Maybe String+ } deriving(Show)++rmDefaults = RmOptions+ { rmTimeOffset = Right 0+ , rmVersion = False+ , rmHelp = False+ , rmTrash = Nothing+ }++rmOptions =+ [ Option ['V'] ["version"] (NoArg (\opts -> opts{rmVersion=True})) "Show version number"+ , Option ['h'] ["help"] (NoArg (\opts -> opts{rmHelp=True})) "Print help"+ , Option ['t'] ["time-offset"] (ReqArg (\offset opts ->+ opts{rmTimeOffset=parse timeOffsetString "" offset}) "offset")+ "Specify time offset suffixes ymdHMS supported, default: 0d"+ , Option ['T'] ["trash-path"] (ReqArg (\path opts -> opts{rmTrash=Just path}) "path")+ "Override Trash path autodetection."+ ]++doRm time iPath fPath fileName = do+ absFile <- canonicalizePath fileName+ moveToTrash $ TrashFile+ (iPath </> takeFileName fileName <.> "trashinfo")+ (fPath </> takeFileName fileName)+ absFile+ time+ 0++fdoRm args = do+ (myOpts, realArgs) <- parseOpts rmDefaults rmOptions "fdo-rm" args+ when (rmVersion myOpts) printVersion+ when (rmHelp myOpts) $ putStrLn+ (usageInfo "Usage: fdo-rm [OPTION...] parameters..." rmOptions)+ >> exitSuccess+ (iPath,fPath) <- maybe+ getTrashPaths+ (\p -> return (p </> "info", p </> "files"))+ (rmTrash myOpts)+ createDirectoryIfMissing True iPath+ createDirectoryIfMissing True fPath+ timeOffset <- either+ (\x -> ioError (userError $ "Invalid time format" ++ show x))+ (\x -> return x)+ (rmTimeOffset myOpts)+ time <- fmap (addUTCTime $ castFloat timeOffset) getCurrentTime+ mapM_ (doRm time iPath fPath) (map dropTrailingPathSeparator realArgs)++--Purge+data PurgeOptions = PurgeOptions+ { purgeThreshold :: Double+ , purgeAgePow :: Double+ , purgeSizePow :: Double+ , purgeVersion :: Bool+ , purgeHelp :: Bool+ , purgeTrash :: Maybe String+ } deriving(Show)++purgeDefaults = PurgeOptions+ { purgeThreshold = 10**6+ , purgeAgePow = 1+ , purgeSizePow = 0.1+ , purgeHelp = False+ , purgeVersion = False+ , purgeTrash = Nothing+ }++purgeOptions =+ [ Option ['V'] ["version"] (NoArg (\opts -> opts{purgeVersion=True})) "Show version number"+ , Option ['h'] ["help"] (NoArg (\opts -> opts{purgeHelp=True})) "Print help"+ , Option ['a'] ["age"] (ReqArg (\secs opts -> opts{purgeThreshold=read secs}) "secs")+ ("Specify maximium file age default: " ++ (show $ purgeThreshold purgeDefaults))+ , Option ['A'] ["age-power"] (ReqArg (\pow opts -> opts{purgeAgePow=read pow}) "pow")+ ("Specify age power for threshold formula size^sizepow*age^agepow, default: " +++ (show $ purgeAgePow purgeDefaults))+ , Option ['S'] ["size-power"] (ReqArg (\pow opts -> opts{purgeSizePow=read pow}) "pow")+ ("Specify size power for threshold formula size^sizepow*age^agepow, default: "+ ++ (show $ purgeSizePow purgeDefaults))+ , Option ['T'] ["trash-path"] (ReqArg (\path opts -> opts{purgeTrash=Just path}) "path")+ "Override Trash path autodetection."+ ]++fdoPurge args = do+ (myOpts, _) <- parseOpts purgeDefaults purgeOptions "fdo-purge" args+ when (purgeVersion myOpts) printVersion+ when (purgeHelp myOpts) $ putStrLn+ (usageInfo "Usage: fdo-purge [OPTION...] parameters..." purgeOptions)+ >> exitSuccess+ (iPath,fPath) <- maybe+ getTrashPaths+ (\p -> return (p </> "info", p </> "files"))+ (purgeTrash myOpts)+ createDirectoryIfMissing True iPath+ createDirectoryIfMissing True fPath+ now <- getCurrentTime+ (iExtra,dExtra) <- trashGetOrphans iPath fPath+ ayx <- fmap+ (filter (\x -> (max 0 $ castFloat $ diffUTCTime now $ deleteTime x)**(purgeAgePow myOpts) *+ (max 1 $ fromIntegral $ totalSize x)**(purgeSizePow myOpts) > purgeThreshold myOpts))+ $ trashGetFiles iPath fPath+ when (not$null iExtra) $ putStrLn "Orphan files detected:\n" >> print iExtra+ when (not$null dExtra) $ putStrLn "Orphan files detected:\n" >> print dExtra+ mapM_ expungeTrash ayx++--Unrm+data UnRmOptions = UnRmOptions+ { unRmOrigDir :: Bool+ , unRmVersion :: Bool+ , unRmHelp :: Bool+ , unRmOutFile :: Maybe String+ , unRmSelect :: Maybe Int+ , unRmTrash :: Maybe String+ } deriving(Show)++unRmDefaults = UnRmOptions+ { unRmOrigDir = False+ , unRmHelp = False+ , unRmVersion = False+ , unRmOutFile = Nothing+ , unRmSelect = Nothing+ , unRmTrash = Nothing+ }++unRmOptions =+ [ Option ['V'] ["version"] (NoArg (\opts -> opts{unRmVersion=True})) "Show version number"+ , Option ['h'] ["help"] (NoArg (\opts -> opts{unRmHelp=True})) "Print help"+ , Option ['O'] ["original-name"] (NoArg (\opts -> opts{unRmOrigDir=True}))+ "output file to original path, default: ., conflicts with -o"+ , Option ['o'] ["output-file"] (ReqArg (\out opts -> opts{unRmOutFile=Just out}) "filepath")+ "Specify output file, conflicts with -O"+ , Option ['s'] ["select"] (ReqArg (\index opts -> opts{unRmSelect=Just $ read index}) "index")+ "Select file with index if multiple files match"+ , Option ['T'] ["trash-path"] (ReqArg (\path opts -> opts{unRmTrash=Just path}) "path")+ "Override Trash path autodetection."+ ]++doRestore file opts saveFile = maybe+ (if (unRmOrigDir opts)+ then trashRestore file Nothing+ else trashRestore file (Just saveFile))+ (\out -> trashRestore file (Just out))+ (unRmOutFile opts)++doUnRm files opts saveFile = do+ case (length files') of+ 0 -> putStrLn $ "No such file: " ++ saveFile+ 1 -> doRestore (head files') opts saveFile+ _ -> maybe+ (putStrLn $ "Multiple matches:\n" ++ unlines (zipWith (++) (map (\x -> show x ++ ": ") [(0::Int)..]) (map origPath files') ))+ (\index -> if (index < length files' && index >= 0)+ then doRestore (files' !! index) opts saveFile+ else putStrLn $ "Index " ++ show index ++ " out of bounds!")+ (unRmSelect opts)+ where files' = if (isAbsolute saveFile)+ then filter (\x -> origPath x == saveFile) files+ else filter (\x -> takeFileName (origPath x) == takeFileName saveFile) files++fdoUnRm args = do+ (myOpts, realArgs) <- parseOpts unRmDefaults unRmOptions "fdo-unrm" args+ when (unRmVersion myOpts) printVersion+ when (unRmHelp myOpts) $ putStrLn+ (usageInfo "Usage: fdo-unrm [OPTION...] parameters..." unRmOptions)+ >> exitSuccess+ (iPath,fPath) <- maybe+ getTrashPaths+ (\p -> return (p </> "info", p </> "files"))+ (unRmTrash myOpts)+ createDirectoryIfMissing True iPath+ createDirectoryIfMissing True fPath+ files <- trashGetFiles iPath fPath+ mapM_ (doUnRm files myOpts) realArgs++--Main+main :: IO ()+main = do+ args <- getArgs+ exe <- getProgName+ let actionsStr = intercalate "|" $ map fst actions+ thisAction = maybe+ ( if (null args)+ then Nothing+ else maybe+ (Nothing)+ (\x -> Just (tail args, x))+ (lookup (args !! 0) actions) )+ (\x -> Just (args,x))+ (lookup (drop 4 exe) actions)++ maybe+ (putStrLn $ "No action specified\nUsage: " ++ exe ++ " <" ++ actionsStr ++ "> params")+ (\(a,f) -> f a)+ thisAction+
+ man/fdo-purge.txt view
@@ -0,0 +1,10 @@+[Description]+Purge old files from Freedesktop Trash. A path is purged from Trash if formula+expression size^sizepow*age^agepow evaluates to value larger than maximum age.+Ages are expressed in seconds. With default values the comparison expression+evaluates typically in between 1 and 10 times the real age. If you want to purge+just by the age use --size-power=0.++[Conforming to]+http://freedesktop.org/wiki/Specifications/trash-spec+
+ man/fdo-rm.txt view
@@ -0,0 +1,9 @@+[Description]+Moves files listed in parameters to Freedesktop Trashdir with properly formatted metadata.+Time offset allows you to offset time into future '+' or past '-' in the+deletion timestamp from current time. Time offset supports suffixes y, m, d, H,+M and S for years, months, days, hours, minutes and seconds.++[Conforming to]+http://freedesktop.org/wiki/Specifications/trash-spec+
+ man/fdo-unrm.txt view
@@ -0,0 +1,9 @@+[Description]+Undeletes files listed in parameters, parameter path can be with relative or+absolute path. If relative path is used the path is ignored beyond the+pathname. If multiple targets in Trash match all mathing files are listed to+stdout with indices.++[Conforming to]+http://freedesktop.org/wiki/Specifications/trash-spec+
+ man/genManPages view
@@ -0,0 +1,15 @@+#!/bin/bash++commands=(fdo-rm fdo-unrm fdo-purge)++if ! [[ -x dist/build/fdo-trash/fdo-trash ]]; then+ runhaskell Setup.hs configure+ runhaskell Setup.hs build+fi++for i in ${commands[*]}; do+ ln -sf dist/build/fdo-trash/fdo-trash "$i"+ help2man -N -I man/$i.txt ./$i > $i.1+ rm $i+done+