htar (empty) → 0.1

raw patch · 3 files changed

+207/−0 lines, 3 filesdep +basedep +compressiondep +tarbuild-type:Customsetup-changed

Dependencies added: base, compression, tar

Files

Setup.lhs +3/−0
htar.cabal +16/−0
htar.hs +188/−0

+ Setup.lhs view

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

+ htar.cabal view

@@ -0,0 +1,16 @@+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.++Executable: htar+Main-Is: htar.hs+GHC-options: -O -Wall

+ htar.hs view

@@ -0,0 +1,188 @@+module Main where++import Codec.Archive.Tar++import Codec.Compression.GZip.GUnZip (gunzip)++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)++main :: IO ()+main = do args <- getArgs+          (opts, files) <- parseOptions args+          mainOpts 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)++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++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"++decompress :: Maybe Compression -> ByteString -> ByteString+decompress Nothing      = id+decompress (Just GZip)  = gunzip+decompress (Just BZip2) = error "bzip2 decompression is not supported yet"++readEntries :: [FilePath] -> ByteString -> [TarEntry]+readEntries files = (if null files then id else keepFiles files) +                    . archiveEntries . readTarArchive++-- 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)++createEntry :: Bool -> FilePath -> IO TarEntry+createEntry verbose file =+    do when verbose $ putStrLn file+       createTarEntry file++extractEntry :: Bool -> TarEntry -> IO ()+extractEntry verbose e =+    do when verbose $ putStrLn $ tarFileName $ entryHeader e+       extractTarEntry e++die :: [String] -> IO a+die errs = do mapM_ (\e -> hPutStrLn stderr $ "htar: " ++ e) $ errs+              hPutStrLn stderr "Try `htar --help' for more information."+              exitFailure++usage :: IO a+usage = do putStrLn (usageInfo hdr optDescr)+           exitWith ExitSuccess+  where hdr = unlines ["htar creates and extracts TAR archives.",+                       "",+                       "Usage: htar [OPTION ...] [FILE ...]"]++-- * Options++data Options = Options +    {+     optFile :: FilePath, -- "-" means stdin/stdout+     optAction :: Maybe Action,+     optCompression :: Maybe Compression,+     optVerbose :: Bool+    }+ deriving Show++data Action = Create+            | Extract+            | List+  deriving Show++data Compression = GZip | BZip2+  deriving Show++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++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+                   _               -> ""++lpad :: Int -> a -> [a] -> [a]+lpad n x xs = replicate (n - length xs) x ++ xs++rpad :: Int -> a -> [a] -> [a]+rpad n x xs = xs ++ replicate (n - length xs) x++formatEpochTime :: String -> EpochTime -> String+formatEpochTime f = +    formatCalendarTime defaultTimeLocale f . toUTCTime . epochTimeToClockTime++epochTimeToClockTime :: EpochTime -> ClockTime+epochTimeToClockTime e = TOD s (truncate (1000000000 * f))+    where (s,f) = properFraction (toRational e)