htar 0.1 → 0.3
raw patch · 5 files changed
+238/−177 lines, 5 filesdep +bytestringdep +bzlibdep +directorydep −compressiondep ~basedep ~tarsetup-changednew-uploader
Dependencies added: bytestring, bzlib, directory, filepath, old-locale, old-time, zlib
Dependencies removed: compression
Dependency ranges changed: base, tar
Files
- LICENSE +27/−0
- Setup.hs +2/−0
- Setup.lhs +0/−3
- htar.cabal +38/−15
- htar.hs +171/−159
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2007, Björn Bringert+ 2008-2009 Duncan Coutts+All rights reserved.++Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer.+- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution.+- Neither the names of the copyright owners nor the names of the + contributors may be used to endorse or promote products derived + from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− Setup.lhs
@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain
htar.cabal view
@@ -1,16 +1,39 @@-Name: htar-Version: 0.1-License: BSD4-License-File: ../LICENSE-Author: Bjorn Bringert <bjorn@bringert.net>-Maintainer: Bjorn Bringert <bjorn@bringert.net>-Copyright: 2007 Bjorn Bringert <bjorn@bringert.net>-Stability: Experimental-Build-depends: base >= 2.0, tar == 0.1, compression >= 0.1-Synopsis: Command-line TAR utility.-Description:- Command-line TAR utility which uses the tar package.+name: htar+version: 0.3+license: BSD3+license-File: LICENSE+author: Bjorn Bringert <bjorn@bringert.net>+ Duncan Coutts <duncan@haskell.org>+maintainer: Duncan Coutts <duncan@haskell.org>+copyright: 2007 Bjorn Bringert <bjorn@bringert.net>+ 2008-2009 Duncan Coutts <duncan@haskell.org>+category: Codec+synopsis: Command-line tar archive utility.+description: A Command-line utility to create, extract and list the+ contents of tar archives. It can work with compressed+ archives using gzip or bzip2 compression.+build-type: Simple+cabal-version: >= 1.2 -Executable: htar-Main-Is: htar.hs-GHC-options: -O -Wall+flag base3++executable htar+ main-is: htar.hs+ ghc-options: -Wall+ build-depends:+ base >= 2,+ tar >= 0.3 && < 0.4,+ zlib >= 0.4 && < 0.6,+ bzlib >= 0.4 && < 0.6,+ filepath >= 1++ if flag(base3)+ build-depends:+ base >= 3,+ old-time >= 1.0,+ old-locale >= 1.0,+ directory >= 1.0,+ bytestring >= 0.9+ else+ build-depends:+ base < 3
htar.hs view
@@ -1,188 +1,200 @@ module Main where -import Codec.Archive.Tar+import qualified Codec.Archive.Tar as Tar+import qualified Codec.Archive.Tar.Entry as Tar -import Codec.Compression.GZip.GUnZip (gunzip)+import qualified Codec.Compression.GZip as GZip (compress, decompress)+import qualified Codec.Compression.BZip as BZip (compress, decompress) import qualified Data.ByteString.Lazy as BS-import Data.ByteString.Lazy (ByteString)-import Control.Monad-import Data.Bits-import Data.Char (toUpper)-import qualified Data.Set as Set-import System.Console.GetOpt-import System.Environment-import System.Exit-import System.Locale (defaultTimeLocale)-import System.IO-import System.Posix.Types (EpochTime)-import System.Time (ClockTime(..), toUTCTime, formatCalendarTime)+import Data.ByteString.Lazy (ByteString)+import Data.Bits (testBit)+import Data.Char (toUpper)+import System.Console.GetOpt (OptDescr(..), ArgDescr(..), ArgOrder(..),+ getOpt', usageInfo)+import System.Environment (getArgs)+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)+import System.Locale (defaultTimeLocale)+import System.Time (ClockTime(..), toUTCTime, formatCalendarTime) main :: IO ()-main = do args <- getArgs- (opts, files) <- parseOptions args- mainOpts opts files+main = do+ (opts, files) <- parseOptions =<< getArgs+ main' opts files -parseOptions :: [String] -> IO (Options, [FilePath])-parseOptions args = - do let (fs, files, nonopts, errs) = getOpt' RequireOrder optDescr args- when (not (null errs)) $ die errs- case nonopts of- [] -> return $ (foldl (flip ($)) defaultOptions fs, files)- ["--help"] -> usage- _ -> die (map (("unrecognized option "++).show) nonopts)+main' :: Options -> [FilePath] -> IO ()+main' (Options { optFile = file,+ optAction = action,+ optCompression = compression,+ optVerbosity = verbosity }) files =+ case action of+ NoAction -> die ["No action given. Specify one of -c, -t or -x."]+ Help -> printUsage+ Create -> output . compress compression+ . Tar.write =<< Tar.pack "" files+ Extract -> Tar.unpack "." . Tar.read . decompress compression =<< input+ List -> printEntries . Tar.read . decompress compression =<< input+ where+ input = if file == "-" then BS.getContents else BS.readFile file+ output = if file == "-" then BS.putStr else BS.writeFile file -mainOpts :: Options -> [FilePath] -> IO ()-mainOpts (Options { optAction = Nothing }) _ - = die ["No action given. Specify one of -c, -t or -x."]-mainOpts (Options { optFile = file, - optAction = Just action,- optCompression = compression, - optVerbose = verbose }) files = - -- FIXME: catch errors and print out nicely- case action of - Create -> recurseDirectories files - >>= mapM (createEntry verbose) - >>= output . compress compression - . writeTarArchive . TarArchive- Extract -> inputEntries >>= mapM_ (extractEntry verbose)- List -> inputEntries >>= mapM_ (putStrLn . entryInfo verbose)- where input = if file == "-" then BS.getContents else BS.readFile file- output = if file == "-" then BS.putStr else BS.writeFile file- inputEntries = input >>= return . readEntries files . decompress compression+ printEntries = Tar.foldEntries (\entry rest -> printEntry entry >> rest)+ (return ()) fail+ printEntry = putStrLn . entryInfo verbosity -compress :: Maybe Compression -> ByteString -> ByteString-compress Nothing = id-compress (Just GZip) = error "gzip compression is not supported yet"-compress (Just BZip2) = error "bzip2 compression is not supported yet"+data Compression = None | GZip | BZip+ deriving Show -decompress :: Maybe Compression -> ByteString -> ByteString-decompress Nothing = id-decompress (Just GZip) = gunzip-decompress (Just BZip2) = error "bzip2 decompression is not supported yet"+compress :: Compression -> ByteString -> ByteString+compress None = id+compress GZip = GZip.compress+compress BZip = BZip.compress -readEntries :: [FilePath] -> ByteString -> [TarEntry]-readEntries files = (if null files then id else keepFiles files) - . archiveEntries . readTarArchive+decompress :: Compression -> ByteString -> ByteString+decompress None = id+decompress GZip = GZip.decompress+decompress BZip = BZip.decompress --- FIXME: allow files names to differ in trailing slashes-keepFiles :: [FilePath] -> [TarEntry] -> [TarEntry]-keepFiles files = filter (p . entryHeader)- where p = ((`Set.member` Set.fromList files) . tarFileName)+data Verbosity = Verbose | Concise -createEntry :: Bool -> FilePath -> IO TarEntry-createEntry verbose file =- do when verbose $ putStrLn file- createTarEntry file+------------------------+-- List archive contents -extractEntry :: Bool -> TarEntry -> IO ()-extractEntry verbose e =- do when verbose $ putStrLn $ tarFileName $ entryHeader e- extractTarEntry e+entryInfo :: Verbosity -> Tar.Entry -> String+entryInfo Verbose = detailedInfo+entryInfo Concise = Tar.entryPath -die :: [String] -> IO a-die errs = do mapM_ (\e -> hPutStrLn stderr $ "htar: " ++ e) $ errs- hPutStrLn stderr "Try `htar --help' for more information."- exitFailure+detailedInfo :: Tar.Entry -> String+detailedInfo entry =+ unwords [ typeCode : permissions+ , justify 19 (owner ++ '/' : group) size+ , time+ , name ++ link ]+ where+ typeCode = case Tar.entryContent entry of+ Tar.HardLink _ -> 'h'+ Tar.SymbolicLink _ -> 'l'+ Tar.CharacterDevice _ _ -> 'c'+ Tar.BlockDevice _ _ -> 'b'+ Tar.Directory -> 'd'+ Tar.NamedPipe -> 'p'+ _ -> '-'+ permissions = concat [userPerms, groupPerms, otherPerms]+ where+ userPerms = formatPerms 8 7 6 11 's'+ groupPerms = formatPerms 5 4 3 10 's'+ otherPerms = formatPerms 2 1 0 9 't'+ formatPerms r w x s c =+ [if testBit m r then 'r' else '-'+ ,if testBit m w then 'w' else '-'+ ,if testBit m s+ then if testBit m x then c else toUpper c+ else if testBit m x then 'x' else '-']+ m = Tar.entryPermissions entry+ owner = nameOrID ownerName ownerId+ group = nameOrID groupName groupId+ (Tar.Ownership ownerName groupName ownerId groupId) =+ Tar.entryOwnership entry+ nameOrID n i = if null n then show i else n+ size = case Tar.entryContent entry of+ Tar.NormalFile _ fileSize -> show fileSize+ _ -> "0" -usage :: IO a-usage = do putStrLn (usageInfo hdr optDescr)- exitWith ExitSuccess- where hdr = unlines ["htar creates and extracts TAR archives.",- "",- "Usage: htar [OPTION ...] [FILE ...]"]+ time = formatEpochTime "%Y-%m-%d %H:%M" (Tar.entryTime entry)+ name = Tar.entryPath entry+ link = case Tar.entryContent entry of+ Tar.HardLink l -> " link to " ++ Tar.fromLinkTarget l+ Tar.SymbolicLink l -> " -> " ++ Tar.fromLinkTarget l+ _ -> "" --- * Options+justify :: Int -> String -> String -> String+justify width left right = left ++ padding ++ right+ where+ padding = replicate padWidth ' '+ padWidth = max 1 (width - length left - length right) -data Options = Options - {- optFile :: FilePath, -- "-" means stdin/stdout- optAction :: Maybe Action,- optCompression :: Maybe Compression,- optVerbose :: Bool- }- deriving Show+formatEpochTime :: String -> Tar.EpochTime -> String+formatEpochTime f =+ formatCalendarTime defaultTimeLocale f . toUTCTime . epochTimeToClockTime -data Action = Create- | Extract- | List- deriving Show+epochTimeToClockTime :: Tar.EpochTime -> ClockTime+epochTimeToClockTime e = TOD s (truncate (1000000000 * f))+ where (s,f) = properFraction (toRational e) -data Compression = GZip | BZip2- deriving Show+------------------------+-- Command line handling +data Options = Options {+ optFile :: FilePath, -- "-" means stdin/stdout+ optAction :: Action,+ optCompression :: Compression,+ optVerbosity :: Verbosity+ }+ defaultOptions :: Options defaultOptions = Options {- optFile = "-",- optAction = Nothing,- optCompression = Nothing,- optVerbose = False- }--optDescr :: [OptDescr (Options -> Options)]-optDescr = - [- Option ['c'] ["create"] (action Create) "Create a new archive.",- Option ['x'] ["extract","get"] (action Extract) "Extract files.",- Option ['t'] ["list"] (action List) "List archive contents.",- Option ['z'] ["gzip","ungzip"] (compression GZip) "Use gzip compression.",- Option ['j'] ["bzip2"] (compression BZip2) "Use bzip2 compression.",- Option ['f'] ["file"] (ReqArg (\f o -> o { optFile = f}) "ARCHIVE")- "Use archive file ARCHIVE.",- Option ['v'] ["verbose"] (NoArg (\o -> o { optVerbose = True }))- "Increase output verbosity."- ]- where action a = NoArg (\o -> o { optAction = Just a })- compression c = NoArg (\o -> o { optCompression = Just c })---- * Formatted information about archives--entryInfo :: Bool -- ^ Verbosity- -> TarEntry -> String-entryInfo True = detailedInfo . entryHeader-entryInfo False = tarFileName . entryHeader+ optFile = "-",+ optAction = NoAction,+ optCompression = None,+ optVerbosity = Concise+ } -detailedInfo :: TarHeader -> String-detailedInfo hdr = unwords [typ:mode, owner, group, size, time, name++link]- where typ = case tarFileType hdr of- TarHardLink -> 'h'- TarSymbolicLink -> 'l'- TarCharacterDevice -> 'c'- TarBlockDevice -> 'b'- TarDirectory -> 'd'- TarFIFO -> 'p'- _ -> '-'- mode = concat [u,g,o]- where m = tarFileMode hdr - f r w x s c = [if testBit m r then 'r' else '-',- if testBit m w then 'w' else '-',- if testBit m s - then if testBit m x then c else toUpper c- else if testBit m x then 'x' else '-']- u = f 8 7 6 11 's'- g = f 5 4 3 10 's'- o = f 2 1 0 9 't'- owner = rpad 7 ' ' $ nameOrID (tarOwnerName hdr) (tarOwnerID hdr)- group = rpad 7 ' ' $ nameOrID (tarGroupName hdr) (tarGroupID hdr)- nameOrID n i = if null n then show i else n- size = lpad 11 ' ' $ show (tarFileSize hdr)- time = formatEpochTime "%Y-%m-%d %H:%M:%S" (tarModTime hdr)- name = tarFileName hdr- link = case tarFileType hdr of- TarHardLink -> " link to " ++ tarLinkTarget hdr- TarSymbolicLink -> " -> " ++ tarLinkTarget hdr- _ -> ""+data Action = NoAction+ | Help+ | Create+ | Extract+ | List+ deriving Show -lpad :: Int -> a -> [a] -> [a]-lpad n x xs = replicate (n - length xs) x ++ xs+optDescr :: [OptDescr (Options -> Options)]+optDescr =+ [ Option ['c'] ["create"]+ (action Create)+ "Create a new archive."+ , Option ['x'] ["extract", "get"]+ (action Extract)+ "Extract files from an archive."+ , Option ['t'] ["list"]+ (action List)+ "List the contents of an archive."+ , Option ['f'] ["file"]+ (ReqArg (\f o -> o { optFile = f}) "ARCHIVE")+ "Use archive file ARCHIVE."+ , Option ['z'] ["gzip", "gunzip", "ungzip"]+ (compression GZip)+ "Use gzip compression."+ , Option ['j'] ["bzip2"]+ (compression BZip)+ "Use bzip2 compression."+ , Option ['v'] ["verbose"]+ (NoArg (\o -> o { optVerbosity = Verbose }))+ "Verbosely list files processed."+ , Option ['h', '?'] ["help"]+ (action Help)+ "Print this help output."+ ]+ where+ action a = NoArg (\o -> o { optAction = a })+ compression c = NoArg (\o -> o { optCompression = c }) -rpad :: Int -> a -> [a] -> [a]-rpad n x xs = xs ++ replicate (n - length xs) x+printUsage :: IO ()+printUsage = putStrLn (usageInfo headder optDescr)+ where+ headder = unlines ["htar creates and extracts TAR archives.",+ "",+ "Usage: htar [OPTION ...] [FILE ...]"] -formatEpochTime :: String -> EpochTime -> String-formatEpochTime f = - formatCalendarTime defaultTimeLocale f . toUTCTime . epochTimeToClockTime+parseOptions :: [String] -> IO (Options, [FilePath])+parseOptions args =+ let (fs, files, nonopts, errors) = getOpt' Permute optDescr args+ in case (nonopts, errors) of+ ([], []) -> return $ (foldl (flip ($)) defaultOptions fs, files)+ (_ , (_:_)) -> die errors+ (_ , _) -> die (map (("unrecognized option "++).show) nonopts) -epochTimeToClockTime :: EpochTime -> ClockTime-epochTimeToClockTime e = TOD s (truncate (1000000000 * f))- where (s,f) = properFraction (toRational e)+die :: [String] -> IO a+die errs = do+ mapM_ (\e -> hPutStrLn stderr $ "htar: " ++ e) $ errs+ hPutStrLn stderr "Try `htar --help' for more information."+ exitFailure