diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +# 0.1.0.5 + + * Allow compression level to be set on the command-line + * Add lrzip decompression support + * Add `repack` subcommand + * Support CPIO, 7zip, zip formats + # 0.1.0.4 * Add support for lzo (`.lzo`, `.tzo`) compression diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,13 +1,12 @@ # hstar `hstar` is a command-line tool like [tar](https://www.gnu.org/software/tar/), -but written in Haskell and taking advantage of -[backpack](http://blog.ezyang.com/category/haskell/backpack/). +with several more features. -It can be built with -a [libarchive](http://hackage.haskell.org/package/libarchive) backend wrapping -the C library, or the [tar](http://hackage.haskell.org/package/tar) library -written in Haskell. +- [Use](#use) +- [Features](#features) + - [Compression](#compression) +- [Performance](#performance) ## Use @@ -17,35 +16,69 @@ hstar --bash-completion-script hstar ``` -## Performance +## Features -Benchmarks run on Linux. +Unlike other tar implementations, hstar has the `sanitize` subcommand which +converts a file into a pax-compatible archive and the `lint` subcommand which +points out suspicious archives. -`hstar` built with the `libarchive` backend. +`hstar` can change the compression based on command-line flags, like `bsdtar` +and `arc` (this feature is missing from GNU tar, busybox tar, and seemingly Schily tar). +### Compression + +hstar has near-parity with other command-line tar implementations with respect +to compression support. + +| Program | lzop | lzip | lzma | gzip | bzip2 | zstd | lz4 | brotli | snappy | lrzip | grzip | +| ------- | ---- | ---- | ---- | ---- | ----- | ---- | --- | ------ | ------ | ----- | ----- | +| [bsdtar](http://libarchive.org/) | x | x | x | x | x | x | x | | | x | x | +| hstar | x | x | x | x | x | x | x | x | x | ½ | | +| [arc](https://github.com/mholt/archiver) | | | x | x | x | x | ½ | | x | | | +| [Schily tar](http://cdrtools.sourceforge.net/private/star.html) | x | x | x | x | x | x | | | | | | +| [busybox tar](https://www.busybox.net/) | | | x | x | x | | | | | | | +| [python3 tar module](https://docs.python.org/3/library/tarfile.html#command-line-interface) | | | x | x | x | | | | | | | +| [GNU tar](https://www.gnu.org/software/tar/) | x | x | x | x | x | x | | | | | | + +## Performance + +Benchmarks run on Linux. Performance should be near GNU tar, bsdtar, or Schily tar. + | Program | Compression | Command | Time | | ------- | ----------- | ------- | ---: | -| bsdtar | lz4 | `bsdtar -xf ghc-8.8.2-x86_64-deb9-linux.tar.lz4` | 2.411 s | -| hstar | lz4 | `hstar unpack ghc-8.8.2-x86_64-deb9-linux.tar.lz4` | 2.529 s | -| GNU tar | lz4 | `lz4 -cd ghc-8.8.2-x86_64-deb9-linux.tar.lz4 \| tar -xf -` | 2.539 s | -| Schily tar | lz4 | `lz4 -cd ghc-8.8.2-x86_64-deb9-linux.tar.lz4 \| star -xf -` | 1.572 s | -| bsdtar | gzip | `bsdtar -xf ghc-8.8.2-x86_64-deb9-linux.tar.gz` | 4.625 s | -| hstar | gzip | `hstar unpack ghc-8.8.2-x86_64-deb9-linux.tar.gz` | 6.378 s | -| GNU tar | gzip | `tar xf ghc-8.8.2-x86_64-deb9-linux.tar.gz` | 8.335 s | -| Schily tar | gzip | `star xf ghc-8.8.2-x86_64-deb9-linux.tar.gz` | 8.379 s | -| bsdtar | lzip | `bsdtar -xf ghc-8.8.2-x86_64-deb9-linux.tar.lz` | 12.49 s | -| hstar | lzip | `hstar unpack ghc-8.8.2-x86_64-deb9-linux.tar.lz` | 16.12 s | -| GNU tar | lzip | `tar xf ghc-8.8.2-x86_64-deb9-linux.tar.lz` | 16.71 s | -| Schily tar | lzip | `star xf ghc-8.8.2-x86_64-deb9-linux.tar.lz` | 15.81 s | -| bsdtar | lzma | `bsdtar -xf ghc-8.8.2-x86_64-deb9-linux.tar.xz` | 14.95 s | -| hstar | lzma | `hstar unpack ghc-8.8.2-x86_64-deb9-linux.tar.xz` | 15.37 s | -| GNU tar | lzma | `tar xf ghc-8.8.2-x86_64-deb9-linux.tar.xz` | 14.32 s | -| Schily tar | lzma | `star xf ghc-8.8.2-x86_64-deb9-linux.tar.xz` | 14.37 s | -| bsdtar | bzip2 | `bsdtar -xf ghc-8.8.2-x86_64-deb9-linux.tar.bz2` | 37.85 s | -| hstar | bzip2 | `hstar unpack ghc-8.8.2-x86_64-deb9-linux.tar.bz2` | 38.99 s | -| GNU tar | bzip2 | `tar xf ghc-8.8.2-x86_64-deb9-linux.tar.bz2` | 37.90 s | -| Schily tar | bzip2 | `star xf ghc-8.8.2-x86_64-deb9-linux.tar.bz2` | 38.27 s | -| bsdtar | zstd | `bsdtar -xf ghc-8.8.2-x86_64-deb9-linux.tar.zst` | 2.232 s | -| hstar | zstd | `hstar unpack ghc-8.8.2-x86_64-deb9-linux.tar.zst` | 3.053 s | -| GNU tar | zstd | `tar xf ghc-8.8.2-x86_64-deb9-linux.tar.zst` | 2.644 s | -| Schily tar | zstd | `star xf ghc-8.8.2-x86_64-deb9-linux.tar.zst` | 2.237 s | +| bsdtar | zstd | `bsdtar -xf sparc64-linux-dist.tar.zst` | 61.28 ms | +| hstar | zstd | `hstar unpack sparc64-linux-dist.tar.zst` | 69.63 ms | +| GNU tar | zstd | `tar xf sparc64-linux-dist.tar.zst` | 303.8 ms | +| Schily tar | zstd | `star xf sparc64-linux-dist.tar.zst` | 291.0 ms | +| bsdtar | lzip | `bsdtar -xf sparc64-linux-dist.tar.lz` | 345.3 ms | +| hstar | lzip | `hstar unpack sparc64-linux-dist.tar.lz` | 433.2 ms | +| GNU tar | lzip | `tar xf sparc64-linux-dist.tar.lz` | 456.8 ms | +| Schily tar | lzip | `star xf sparc64-linux-dist.tar.lz` | 440.0 ms | +| busybox tar | lzip | `lzip -cd sparc64-linux-dist.tar.lz \| busybox tar xf -` | 481.0 ms | +| busybox tar | zstd | `zstd -cd sparc64-linux-dist.tar.zst \| busybox tar xf -` | 319.0 ms | +| python3 tar | gzip | `python3 -m tarfile -e sparc64-linux-dist.tar.gz` | 245.3 ms | +| bsdtar | gzip | `bsdtar -xf sparc64-linux-dist.tar.gz` | 122.8 ms | +| hstar | gzip | `hstar unpack sparc64-linux-dist.tar.gz` | 172.4 ms | +| GNU tar | gzip | `tar xf sparc64-linux-dist.tar.gz` | 233.9 ms | +| Schily tar | gzip | `star xf sparc64-linux-dist.tar.gz` | 234.8 ms | +| arc | gzip | `arc -overwrite unarchive sparc64-linux-dist.tar.gz` | 362.0 ms | +| python3 tar | lzma | `python3 -m tarfile -e sparc64-linux-dist.tar.xz` | 414.9 ms | +| bsdtar | lzma | `bsdtar -xf sparc64-linux-dist.tar.xz` | 349.4 ms | +| hstar | lzma | `hstar unpack sparc64-linux-dist.tar.xz` | 360.6 ms | +| GNU tar | lzma | `tar xf sparc64-linux-dist.tar.xz` | 364.3 ms | +| Schily tar | lzma | `star xf sparc64-linux-dist.tar.xz` | 353.6 ms | +| arc | lzma | `arc -overwrite unarchive sparc64-linux-dist.tar.xz` | 1.191 s | +| python3 tar | bzip2 | `python3 -m tarfile -e sparc64-linux-dist.tar.bz2` | 1.242 s | +| bsdtar | bzip2 | `bsdtar -xf sparc64-linux-dist.tar.bz2` | 1.149 s | +| hstar | bzip2 | `hstar unpack sparc64-linux-dist.tar.bz2` | 1.136 s | +| GNU tar | bzip2 | `tar xf sparc64-linux-dist.tar.bz2` | 1.092 s | +| Schily tar | bzip2 | `star xf sparc64-linux-dist.tar.bz2` | 1.103 s | +| arc | bzip2 | `arc -overwrite unarchive sparc64-linux-dist.tar.bz2` | 2.544 s | +| busybox tar | gzip | `busybox tar xzf sparc64-linux-dist.tar.gz` | 307.5 ms | +| busybox tar | bzip2 | `busybox tar xjf sparc64-linux-dist.tar.bz2` | 1.018 s | +| busybox tar | lzma | `busybox tar xJf sparc64-linux-dist.tar.xz` | 385.6 ms | +| bsdtar | lz4 | `bsdtar -xf sparc64-linux-dist.tar.lz4` | 40.69 ms | +| hstar | lz4 | `hstar unpack sparc64-linux-dist.tar.lz4` | 49.87 ms | +| busybox tar | lz4 | `lz4 -cd sparc64-linux-dist.tar.lz4 \| busybox tar xf -` | 56.00 ms | +| GNU tar | lz4 | `lz4 -cd sparc64-linux-dist.tar.lz4 \| tar xf -` | 39.19 ms | +| Schily tar | lz4 | `lz4 -cd sparc64-linux-dist.tar.lz4 \| star xf -` | 30.88 ms | diff --git a/hstar.cabal b/hstar.cabal --- a/hstar.cabal +++ b/hstar.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: hstar -version: 0.1.0.4 +version: 0.1.0.5 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2019-2020 Vanessa McHale @@ -9,7 +9,7 @@ bug-reports: https://github.com/vmchale/archive-backpack/issues synopsis: Haskell version of tar CLI utility description: - Haskell implementation of the tar utility, demonstrating backpack + Haskell implementation of the tar utility, backed by [libarchive](http://libarchive.org/). category: Codec, Tar, Archive build-type: Simple @@ -23,19 +23,6 @@ location: https://github.com/vmchale/archive-backpack subdir: hstar -flag development - description: Enable `-Werror` - default: False - manual: True - -flag pure - description: Use Haskell backend instead of libarchive - default: False - -flag tar-bytestring - description: Use tar-bytestring - default: False - flag with-brotli description: Enable brotli compression support @@ -49,8 +36,13 @@ hs-source-dirs: src other-modules: Compression + Compression.Type + Compression.Level + Compression.Lrzip + Tar Paths_hstar Version + Version.Foreign autogen-modules: Paths_hstar default-language: Haskell2010 @@ -60,8 +52,9 @@ build-depends: base >=4.11 && <5, - archive-sig >=0.2.1.2, + libarchive >=3.0.0.0, optparse-applicative -any, + composition-prelude -any, bytestring -any, lzma -any, bz2 >=1.0.0.0, @@ -69,7 +62,9 @@ zstd -any, lz4-hs >=0.1.1.0, lzlib >=1.0.1.0, - lzo >=0.1.1.0 + lzo >=0.1.1.0, + process >=1.4.3.0, + dir-traverse >=0.2.2.0 if flag(with-snappy) build-depends: snappy-lazy -any @@ -85,24 +80,3 @@ if impl(ghc >=8.10) ghc-options: -Wunused-packages - - if flag(pure) - build-depends: archive-tar -any - - if flag(tar-bytestring) - build-depends: archive-tar-bytestring -any - - if (!flag(pure) && !flag(tar-bytestring)) - build-depends: archive-libarchive -any - - if flag(pure) - mixins: archive-tar (Archive.Tar as Archive) - - if flag(tar-bytestring) - mixins: archive-tar-bytestring (Archive.Tar as Archive) - - if (!flag(pure) && !flag(tar-bytestring)) - mixins: archive-libarchive (Archive.FFI as Archive) - - if flag(development) - ghc-options: -Werror diff --git a/man/hstar.1 b/man/hstar.1 --- a/man/hstar.1 +++ b/man/hstar.1 @@ -1,4 +1,4 @@ -.\" Automatically generated by Pandoc 2.9.2.1 +.\" Automatically generated by Pandoc 2.11 .\" .TH "hstar (1)" "" "" "" "" .hy @@ -26,6 +26,9 @@ .PP \f[B]sanitize\f[R] - Convert a tarball to a pax-compatible archive. This reads the whole file into memory. +.PP +\f[B]repack\f[R] - Convert from one archive format to another. +This reads the whole file into memory. .SH OPTIONS .TP \f[B]-h\f[R] \f[B]--help\f[R] @@ -33,6 +36,9 @@ .TP \f[B]-V\f[R] \f[B]--version\f[R] Display version information +.TP +\f[B]-l\f[R] \f[B]--compression-level\f[R] +Set compression level .SH SUPPORTED FORMATS .SS COMPRESSION .IP \[bu] 2 @@ -55,6 +61,17 @@ brotli (optional) .IP \[bu] 2 snappy (optional) +.IP \[bu] 2 +lrzip (decompression only; requires command-line executable at runtime) +.SS Archive +.IP \[bu] 2 +tar +.IP \[bu] 2 +cpio +.IP \[bu] 2 +zip +.IP \[bu] 2 +7zip .SH SHELL COMPLETIONS .PP To get shell completions in your current session: diff --git a/src/Compression.cpphs b/src/Compression.cpphs --- a/src/Compression.cpphs +++ b/src/Compression.cpphs @@ -17,50 +17,43 @@ import qualified Codec.Compression.Zstd.Lazy as Zstd import qualified Codec.Lz4 as Lz4 import Codec.Lzip as Lzip +import Compression.Level +import qualified Compression.Lrzip as Lrzip +import Compression.Type import qualified Data.ByteString.Lazy as BSL import Data.List (isSuffixOf) -data Compressor = Lzma - | Lz - | Bz2 - | GZip - | Zstd - | Deflate - | Lz4 - | Lzo -#ifdef BROTLI - | Brotli -#endif -#ifdef SNAPPY - | Snappy -#endif - | None - -compressionByFileExt :: FilePath -> Compressor -compressionByFileExt fp | ".tgz" `isSuffixOf` fp = GZip - | ".tar.bz2" `isSuffixOf` fp = Bz2 - | ".tar.bz" `isSuffixOf` fp = Bz2 - | ".tbz2" `isSuffixOf` fp = Bz2 - | ".tbz" `isSuffixOf` fp = Bz2 - | ".tar.gz" `isSuffixOf` fp = GZip - | ".tar.xz" `isSuffixOf` fp = Lzma - | ".txz" `isSuffixOf` fp = Lzma - | ".tar.lz" `isSuffixOf` fp = Lz - | ".tlz" `isSuffixOf` fp = Lz - | ".tar.zst" `isSuffixOf` fp = Zstd - | ".tar.Z" `isSuffixOf` fp = Deflate - | ".tar.lz4" `isSuffixOf` fp = Lz4 - | ".tar.lzo" `isSuffixOf` fp = Lzo - | ".tzo" `isSuffixOf` fp = Lzo +-- shar? .vba.gz? +compressionByFileExt :: FilePath -> Archive +compressionByFileExt fp | ".tgz" `isSuffixOf` fp = Tar GZip + | ".cpio.gz" `isSuffixOf` fp = Cpio GZip + | ".tar.bz2" `isSuffixOf` fp = Tar Bz2 + | ".tar.bz" `isSuffixOf` fp = Tar Bz2 + | ".tbz2" `isSuffixOf` fp = Tar Bz2 + | ".tbz" `isSuffixOf` fp = Tar Bz2 + | ".tar.gz" `isSuffixOf` fp = Tar GZip + | ".tar.xz" `isSuffixOf` fp = Tar Lzma + | ".txz" `isSuffixOf` fp = Tar Lzma + | ".tar.lzma" `isSuffixOf` fp = Tar Lzma + | ".tar.lz" `isSuffixOf` fp = Tar Lz + | ".tlz" `isSuffixOf` fp = Tar Lz + | ".tar.zst" `isSuffixOf` fp = Tar Zstd + | ".tar.Z" `isSuffixOf` fp = Tar Deflate + | ".tar.lz4" `isSuffixOf` fp = Tar Lz4 + | ".tar.lzo" `isSuffixOf` fp = Tar Lzo + | ".tzo" `isSuffixOf` fp = Tar Lzo + | ".tar.lrz" `isSuffixOf` fp = Tar Lrzip #ifdef BROTLI - | ".tbr" `isSuffixOf` fp = Brotli - | ".tar.br" `isSuffixOf` fp = Brotli + | ".tbr" `isSuffixOf` fp = Tar Brotli + | ".tar.br" `isSuffixOf` fp = Tar Brotli #endif #ifdef SNAPPY - | ".tar.sz" `isSuffixOf` fp = Snappy + | ".tar.sz" `isSuffixOf` fp = Tar Snappy + | ".tsz" `isSuffixOf` fp = Tar Snappy #endif - | ".tar" `isSuffixOf` fp = None - | otherwise = error "Suffix not supported or invalid." + | ".tar" `isSuffixOf` fp = Tar None + | ".7z" `isSuffixOf` fp = SevenZip + | otherwise = error "Suffix not supported or invalid." decompressor :: Compressor -> (BSL.ByteString -> BSL.ByteString) decompressor Lzma = Lzma.decompress @@ -71,6 +64,7 @@ decompressor Deflate = Zlib.decompress decompressor Lz4 = Lz4.decompress decompressor Lzo = Lzo.decompressFile +decompressor Lrzip = Lrzip.decompress . BSL.toStrict #ifdef BROTLI decompressor Brotli = Brotli.decompress #endif @@ -78,20 +72,3 @@ decompressor Snappy = Snappy.decompress #endif decompressor None = id - -compressor :: Compressor -> (BSL.ByteString -> BSL.ByteString) -compressor Lzma = Lzma.compress -compressor Lzo = Lzo.compressFile -compressor Bz2 = BZip.compress -compressor GZip = GZip.compress -compressor Lz = Lzip.compress -compressor Zstd = Zstd.compress 3 -compressor Deflate = Zlib.compress -compressor Lz4 = Lz4.compress -#ifdef BROTLI -compressor Brotli = Brotli.compress -#endif -#ifdef SNAPPY -compressor Snappy = Snappy.compress -#endif -compressor None = id diff --git a/src/Compression/Level.cpphs b/src/Compression/Level.cpphs new file mode 100644 --- /dev/null +++ b/src/Compression/Level.cpphs @@ -0,0 +1,106 @@ +module Compression.Level ( CompressionLevel (..) + , compressor + ) where + +#ifdef BROTLI +import qualified Codec.Compression.Brotli as Br +#endif +import qualified Codec.Compression.BZip as BZip +import qualified Codec.Compression.GZip as GZip +import qualified Codec.Compression.Lzma as Lzma +import qualified Codec.Compression.Lzo as Lzo +#ifdef SNAPPY +import qualified Codec.Compression.Snappy.BSL as Snappy +#endif +import qualified Codec.Compression.Zlib as Zlib +import qualified Codec.Compression.Zstd.Lazy as Zstd +import qualified Codec.Lz4 as Lz4 +import qualified Codec.Lzip as Lzip +import Compression.Type +import qualified Data.ByteString.Lazy as BSL + +data CompressionLevel = Best + | Fastest + | Default + | Custom !Int + +levelGuard :: (Int, Int) -> Int -> Int +levelGuard (min', max') lvl | lvl < min' || lvl > max' = + error ("Invalid compression level. Compression must be between " ++ show min' ++ " and " ++ show max') + | otherwise = lvl + +gzipCompression :: Int -> GZip.CompressParams +gzipCompression lvl = GZip.defaultCompressParams { GZip.compressLevel = GZip.compressionLevel lvl } + +zlibCompression :: Int -> Zlib.CompressParams +zlibCompression lvl = Zlib.defaultCompressParams { Zlib.compressLevel = Zlib.compressionLevel lvl } + +lzmaCompression :: Int -> Lzma.CompressParams +lzmaCompression lvl = Lzma.defaultCompressParams { Lzma.compressLevel = toEnum lvl } + +#ifdef BROTLI +brotliCompression :: Int -> Br.CompressParams +brotliCompression lvl = Br.defaultCompressParams { Br.compressLevel = toEnum lvl } +#endif + +toInt :: Compressor -> CompressionLevel -> Int +#ifdef SNAPPY +toInt Snappy _ = undefined +#endif +toInt Lzo _ = undefined +#ifdef BROTLI +toInt Brotli Fastest = fromEnum (minBound :: Br.CompressionLevel) +toInt Brotli (Custom i) = levelGuard (0,11) i +toInt Brotli _ = fromEnum (maxBound :: Br.CompressionLevel) +#endif +toInt Zstd Best = Zstd.maxCLevel +toInt Zstd Fastest = 1 +toInt Zstd (Custom i) = levelGuard (1, Zstd.maxCLevel) i +toInt Zstd Default = 3 +toInt Lz Best = fromEnum (maxBound :: Lzip.CompressionLevel) +toInt Lz Fastest = fromEnum (minBound :: Lzip.CompressionLevel) +toInt Lz (Custom i) = levelGuard (0, 9) i +toInt Lz Default = 6 +toInt Lzma Best = 9 +toInt Lzma Fastest = 0 +toInt Lzma (Custom i) = levelGuard (0, 9) i +toInt Lzma Default = 6 +toInt Bz2 Best = 9 +toInt Bz2 Fastest = 1 +toInt Bz2 (Custom i) = i +toInt Bz2 Default = 7 +toInt GZip Best = 9 +toInt GZip Fastest = 0 +toInt GZip (Custom i) = i +toInt GZip Default = 6 +toInt Deflate Best = 9 +toInt Deflate Fastest = 0 +toInt Deflate (Custom i) = i +toInt Deflate Default = 6 +toInt Lz4 Best = Lz4.lZ4HCClevelMax +toInt Lz4 Fastest = 0 +toInt Lz4 (Custom i) = levelGuard (0, Lz4.lZ4HCClevelMax) i +toInt Lz4 Default = 0 -- 1? +toInt Lrzip Best = 9 +toInt Lrzip Fastest = 1 +toInt Lrzip (Custom i) = levelGuard (1, 9) i +toInt Lrzip Default = 7 +toInt None _ = error "Internal error." + +compressor :: Compressor -> CompressionLevel -> BSL.ByteString -> BSL.ByteString +compressor Lzma lvl = Lzma.compressWith (lzmaCompression $ toInt Lzma lvl) +compressor Lz lvl = Lzip.compressWith(toEnum $ toInt Lz lvl) +compressor Bz2 lvl = BZip.compressWith (fromIntegral $ toInt Bz2 lvl) 30 +compressor GZip lvl = GZip.compressWith (gzipCompression $ toInt GZip lvl) +compressor Deflate lvl = Zlib.compressWith (zlibCompression $ toInt Deflate lvl) +compressor Zstd lvl = Zstd.compress (toInt Zstd lvl) +compressor Lz4 lvl = Lz4.compressSz (toInt Lz4 lvl) +#ifdef BROTLI +compressor Brotli lvl = Br.compressWith (brotliCompression $ toInt Brotli lvl) +#endif +#ifdef SNAPPY +compressor Snappy _ = Snappy.compress +#endif +compressor Lzo _ = Lzo.compressFile +compressor Lrzip _ = error "Lrzip compression unsupported." +compressor None _ = id diff --git a/src/Compression/Lrzip.hs b/src/Compression/Lrzip.hs new file mode 100644 --- /dev/null +++ b/src/Compression/Lrzip.hs @@ -0,0 +1,21 @@ +module Compression.Lrzip ( decompress + ) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL +import System.IO (hSetBinaryMode) +import System.IO.Unsafe (unsafePerformIO) +import System.Process (CreateProcess, StdStream (CreatePipe, Inherit), createProcess, proc, std_err, std_in, std_out) + +decompress :: BS.ByteString -> BSL.ByteString +decompress = unsafePerformIO . decompressIO + +bsProc :: CreateProcess -> BS.ByteString -> IO BSL.ByteString +bsProc p bs = do + (Just stdin, Just stdout, _, _) <- createProcess p { std_in = CreatePipe, std_out = CreatePipe } + BS.hPut stdin bs + hSetBinaryMode stdout True + BSL.hGetContents stdout + +decompressIO :: BS.ByteString -> IO BSL.ByteString +decompressIO = bsProc ((proc "lrzip" ["-d", "-q"]) { std_err = Inherit }) diff --git a/src/Compression/Type.cpphs b/src/Compression/Type.cpphs new file mode 100644 --- /dev/null +++ b/src/Compression/Type.cpphs @@ -0,0 +1,25 @@ +module Compression.Type ( Compressor (..) + , Archive (..) + ) where + +data Archive = Tar !Compressor + | SevenZip + | Cpio !Compressor + | Zip + +data Compressor = Lzma + | Lz + | Bz2 + | GZip + | Zstd + | Deflate + | Lz4 + | Lzo + | Lrzip +#ifdef BROTLI + | Brotli +#endif +#ifdef SNAPPY + | Snappy +#endif + | None diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,47 +1,82 @@ module Main ( main ) where -import Archive -import Archive.Compression +import Codec.Archive (Entry (Entry), EntryContent (Hardlink), entriesToBSL, entriesToBSL7zip, entriesToBSLCpio, entriesToBSLzip, + readArchiveBSL) import Compression +import Compression.Level +import Compression.Type import Control.Exception (throw) import qualified Data.ByteString.Lazy as BSL import Data.Maybe (fromMaybe) import Options.Applicative +import Tar import Version -- pack a directory/list of files? -data Command = PackDir !FilePath !FilePath - | Pack ![FilePath] !FilePath +-- repack .tar.gz to .cpio.gz or whatnot? +data Command = PackDir !FilePath !FilePath !CompressionLevel + | Pack ![FilePath] !FilePath !CompressionLevel | Unpack !FilePath !(Maybe FilePath) - | PackSrc !FilePath !FilePath - | Sanitize !FilePath + | PackSrc !FilePath !FilePath !CompressionLevel + | Sanitize !FilePath !CompressionLevel + | Repack !FilePath !FilePath !CompressionLevel +forceLast :: [a] -> IO () +forceLast = (`seq` mempty) . last + forceBSL :: BSL.ByteString -> IO () -forceBSL = (`seq` mempty) . last . BSL.toChunks +forceBSL = forceLast . BSL.toChunks -sanitize :: FilePath -> IO () -sanitize fp = do - let enc = compressionByFileExt fp +sanitize :: FilePath -> CompressionLevel -> IO () +sanitize fp lvl = do + let enc = fromArchive $ compressionByFileExt fp contents <- BSL.readFile fp decoded <- decompressor enc contents <$ forceBSL contents - let es = either throw id $ readArchiveBytes decoded - paxContents = writeArchiveBytes es - BSL.writeFile fp (compressor enc paxContents) + let es = either throw id $ readArchiveBSL decoded + -- also removes hardlinks pointing to themselves + paxContents = entriesToBSL (filter (not.selfLink) es) + BSL.writeFile fp (compressor enc lvl paxContents) +repack :: FilePath + -> FilePath + -> CompressionLevel + -> IO () +repack inp out lvl = do + let enc = fromArchive $ compressionByFileExt inp + contents <- BSL.readFile inp + let decoded = decompressor enc contents + es = either throw id $ readArchiveBSL decoded + outArchive = compressionByFileExt out + archiveContentsNew = + case outArchive of + Tar{} -> entriesToBSL es + Cpio{} -> entriesToBSLCpio es + SevenZip -> entriesToBSL7zip es + Zip -> entriesToBSLzip es + BSL.writeFile out (compressor (fromArchive outArchive) lvl archiveContentsNew) + +selfLink :: Eq fp => Entry fp e -> Bool +selfLink (Entry fp (Hardlink fp') _ _ _) = fp == fp' +selfLink _ = False + +fromArchive :: Archive -> Compressor +fromArchive (Tar c) = c +fromArchive (Cpio c) = c +fromArchive _ = None + run :: Command -> IO () -run (Sanitize src) = sanitize src +run (Sanitize src lvl) = sanitize src lvl run (Unpack src dest) = - let dec = decompressor (compressionByFileExt src) + let dec = decompressor (fromArchive $ compressionByFileExt src) in unpackFileToDirAndDecompress dec src (fromMaybe "." dest) -run (PackDir dir' tar) = - let comp = compressor (compressionByFileExt tar) - in packFromDirAndCompress comp dir' tar -run (Pack fs tar) = - let comp = compressor (compressionByFileExt tar) - in packFromFilesAndCompress comp tar fs -run (PackSrc dir' tar) = - let comp = compressor (compressionByFileExt tar) - in packSrcDirAndCompress comp dir' tar +run (PackDir dir' tar lvl) = + packFromDirAndCompress (compressionByFileExt tar) lvl dir' tar +run (Pack fs tar lvl) = + packFromFilesAndCompress (compressionByFileExt tar) lvl tar fs +run (PackSrc dir' tar lvl) = + packSrcDirAndCompress (compressionByFileExt tar) lvl dir' tar +run (Repack inp out lvl) = + repack inp out lvl sanitizeP :: Parser Command sanitizeP = Sanitize @@ -49,6 +84,7 @@ (metavar "SRC" <> fileCompletions <> help "Archive to pax-ify") + <*> compressionLevel unpack :: Parser Command unpack = Unpack @@ -65,11 +101,20 @@ packDir = PackDir <$> dir <*> archive + <*> compressionLevel + +repackP :: Parser Command +repackP = Repack + <$> archive + <*> archive + <*> compressionLevel + packSrc :: Parser Command packSrc = PackSrc <$> dir <*> archive + <*> compressionLevel dir :: Parser FilePath dir = argument str @@ -92,7 +137,34 @@ <> fileCompletions <> help "File to add to archive")) <*> archive + <*> compressionLevel +compressionLevel :: Parser CompressionLevel +compressionLevel = + compressCustom + <|> compressBest + <|> compressFast + <|> flag Default Default mempty + +compressCustom :: Parser CompressionLevel +compressCustom = + Custom <$> + option auto + (long "compression-level" + <> short 'l' + <> metavar "LVL" + <> help "Compression level (usually 0-9)" + <> completer (listCompleter (show <$> [(0::Int)..22])) + ) + +compressBest :: Parser CompressionLevel +compressBest = + flag' Best (long "best") + +compressFast :: Parser CompressionLevel +compressFast = + flag' Fastest (long "fastest") + fileCompletions :: HasCompleter f => Mod f a fileCompletions = completer (bashCompleter "file -o plusdirs") @@ -106,6 +178,7 @@ <> command "pack" (info pack (progDesc "Pack an archive from a list of files")) <> command "pack-src" (info packSrc (progDesc "Pack up a source directory as a bundle, ignoring version control and artifact directories")) <> command "sanitize" (info sanitizeP (progDesc "Sanitize a tar archive so it is pax-compatible")) + <> command "repack" (info repackP (progDesc "Convert from one archive format to another")) ) versionMod :: Parser (a -> a) diff --git a/src/Tar.hs b/src/Tar.hs new file mode 100644 --- /dev/null +++ b/src/Tar.hs @@ -0,0 +1,69 @@ +module Tar ( unpackToDir + , packFromDirAndCompress + , packFromFilesAndCompress + , unpackFileToDirAndDecompress + , packSrcDirAndCompress + ) where + +import Codec.Archive (packFiles, packFiles7zip, packFilesCpio, packFilesZip, throwArchiveM, unpackToDirLazy) +import Compression.Level (CompressionLevel, compressor) +import Compression.Type (Archive (..)) +import Control.Composition ((.*)) +import qualified Data.ByteString.Lazy as BSL +import Data.List (isSuffixOf) +import System.Directory.Recursive (getDirFiltered, getDirRecursive) + +type Decompressor = BSL.ByteString -> BSL.ByteString + +unpackToDir :: FilePath -> BSL.ByteString -> IO () +unpackToDir = throwArchiveM .* unpackToDirLazy + +packFromDirAndCompress :: Archive + -> CompressionLevel + -> FilePath -- ^ Directory to pack up + -> FilePath -- ^ Destination tarball + -> IO () +packFromDirAndCompress a lvl dir tar = packFromFilesAndCompress a lvl tar =<< getDirRecursive dir + +packFromFilesAndCompress :: Archive -> CompressionLevel -> FilePath -> [FilePath] -> IO () +packFromFilesAndCompress (Tar c) lvl tar fps = BSL.writeFile tar =<< (compressor c lvl <$> packFiles fps) +packFromFilesAndCompress SevenZip _ tar fps = BSL.writeFile tar =<< packFiles7zip fps +packFromFilesAndCompress (Cpio c) lvl tar fps = BSL.writeFile tar =<< (compressor c lvl <$> packFilesCpio fps) +packFromFilesAndCompress Zip _ tar fps = BSL.writeFile tar =<< packFilesZip fps + +unpackFileToDirAndDecompress :: Decompressor -- ^ Decompression to use + -> FilePath -- ^ Filepath pointing to archive + -> FilePath -- ^ Directory + -> IO () +unpackFileToDirAndDecompress f tar dir = unpackToDir dir =<< (f <$> BSL.readFile tar) + +packSrcDirAndCompress :: Archive -> CompressionLevel -> FilePath -> FilePath -> IO () +packSrcDirAndCompress a lvl dir tar = packFromFilesAndCompress a lvl tar =<< getDirFiltered (pure.srcFilter) dir + +srcFilter :: FilePath -> Bool +srcFilter fp | ".git" `isSuffixOf` fp = False + | "_darcs" `isSuffixOf` fp = False + | ".hg" `isSuffixOf` fp = False + | ".pijul" `isSuffixOf` fp = False + | "dist" `isSuffixOf` fp = False + | "dist-newstyle" `isSuffixOf` fp = False + | ".stack-work" `isSuffixOf` fp = False + | "target" `isSuffixOf` fp = False + | ".atspkg" `isSuffixOf` fp = False + | ".shake" `isSuffixOf` fp = False + | ".vagrant" `isSuffixOf` fp = False + | "tags" `isSuffixOf` fp = False + | "hspec-failures" `isSuffixOf` fp = False + | ".github" `isSuffixOf` fp = False + | ".travis.yml" `isSuffixOf` fp = False + | "TODO.md" `isSuffixOf` fp = False + | ".yamllint" `isSuffixOf` fp = False + | ".ctags" `isSuffixOf` fp = False + | ".atsfmt.toml" `isSuffixOf` fp = False + | ".gitignore" `isSuffixOf` fp = False + | ".clang-format" `isSuffixOf` fp = False + | "stack.yaml.lock" `isSuffixOf` fp = False + | "appveyor.yml" `isSuffixOf` fp = False + | ".terraform" `isSuffixOf` fp = False + | otherwise = True + diff --git a/src/Version.cpphs b/src/Version.cpphs --- a/src/Version.cpphs +++ b/src/Version.cpphs @@ -1,26 +1,29 @@ module Version ( allVersionsString ) where -import Archive -import Archive.Generic +import Codec.Archive.Foreign.Archive (archiveVersionString) import Codec.Compression.BZip -import Codec.Compression.Lzo (lzoVersionString) -import Codec.Lz4 (lZ4VersionString) +import Codec.Compression.Lzo (lzoVersionString) +import Codec.Lz4 (lZ4VersionString) import Codec.Lzip -import qualified Data.Version as V -import qualified Paths_hstar as P +import qualified Data.Version as V +import qualified Paths_hstar as P +import Version.Foreign allVersionsString :: String allVersionsString = "hstar version: " ++ V.showVersion P.version ++ "\n" - ++ "archive-sig version: " ++ V.showVersion archiveSigVersion ++ "\n" - ++ versionInfo ++ "\n" + ++ "libarchive-hs: " ++ VERSION_libarchive ++ "\n" + ++ archiveVersionString ++ "\n" ++ "lzlib-hs: " ++ VERSION_lzlib ++ "\n" ++ "lzlib: " ++ lZVersion ++ "\n" ++ "lzlib API: " ++ show (lZApiVersion :: Int) ++ "\n" ++ "zlib-hs: " ++ VERSION_zlib ++ "\n" + ++ "zlib: " ++ zlib ++ "\n" ++ "lzma-hs: " ++ VERSION_lzma ++ "\n" + ++ "lzma: " ++ lzma ++ "\n" ++ "lz4-hs: " ++ VERSION_lz4_hs ++ "\n" ++ "lz4: " ++ lZ4VersionString ++ "\n" + ++ "zstd: " ++ zstd ++ "\n" ++ "zstd-hs: " ++ VERSION_zstd ++ "\n" ++ "lzo: " ++ lzoVersionString ++ "\n" ++ "lzo-hs: " ++ VERSION_lzo ++ "\n" diff --git a/src/Version/Foreign.hs b/src/Version/Foreign.hs new file mode 100644 --- /dev/null +++ b/src/Version/Foreign.hs @@ -0,0 +1,20 @@ +module Version.Foreign ( zstd + , zlib + , lzma + ) where + +import Foreign.C.String (CString, peekCString) +import System.IO.Unsafe (unsafeDupablePerformIO) + +foreign import ccall unsafe "ZSTD_versionString" zstdVersionString :: CString +foreign import ccall unsafe zlibVersion :: CString +foreign import ccall unsafe lzma_version_string :: CString + +zstd :: String +zstd = unsafeDupablePerformIO (peekCString zstdVersionString) + +zlib :: String +zlib = unsafeDupablePerformIO (peekCString zlibVersion) + +lzma :: String +lzma = unsafeDupablePerformIO (peekCString lzma_version_string)