hascar 0.2.2.0 → 0.2.2.1

raw patch · 12 files changed

+127/−147 lines, 12 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• README.md +1/−2
• app/GPL.hs +1/−3
• app/Main.hs +44/−25
• app/Options.hs +8/−0
• changelog.md +8/−0
• hascar.cabal +2/−2
• src/Codec/Archive/SAPCAR.hs +8/−17
• src/Codec/Archive/SAPCAR/BitStream.hs +3/−19
• src/Codec/Archive/SAPCAR/CanonicalHuffmanTree.hs +2/−18
• src/Codec/Archive/SAPCAR/FlatedFile.hs +3/−19
• src/Codec/Archive/SAPCAR/FlexibleUtils.hs +2/−18
• src/Codec/Archive/SAPCAR/Pat.hs +45/−24

@@ -72,5 +72,4 @@ SAR files can contain transport files that are wrapped inside PAT (patch) files. Since hascar 0.2.2.0 the option -p is offered, that will try to automatically detect PAT files. If such a file is detected, the contained-transport file is extracted. In verbose mode, this is denoted by a 'P' next to-the filename instead of an 'x'.+transport file is extracted.

@@ -17,9 +17,7 @@ -- | The copyright text gpl' :: [Text] gpl' =-    [ "hascar, Copyright (C) 2016-2018, Virtual Forge GmbH.", ""-    , "Maint.: Hans-Christian Esperer"-    , "<hans-christian.esperer@virtualforge.com>", ""+    [ "hascar, Copyright (C) 2015-2018, Virtual Forge GmbH.", ""     , "hascar comes with ABSOLUTELY NO WARRANTY;"     , "for details read the LICENSE file."     , "This is free software, and you are welcome to redistribute"

@@ -1,24 +1,15 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- |+-- Module: Main+-- Copyright: (C) 2015-2018, Virtual Forge GmbH+-- License: GPL2+-- Maintainer: Hans-Christian Esperer <hc@hcesperer.org>+-- Stability: experimental+-- Portability: portable+-- | -- (De-)compress SAPCAR files------ Copyright (C) 2016, Virtual Forge GmbH------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2 of the License, or (at--- your option) any later version.------ This program is distributed in the hope that it will be useful, but--- WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU--- General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307--- USA+ module Main where  import Control.Monad@@ -36,7 +27,10 @@  import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L+import qualified Data.Conduit.List as DCL import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Encoding.Error as TEE  import Options @@ -64,6 +58,13 @@         forM_ entries print         putStrLn "" +    liftIO $ case oExtractDir options of+        Just extractDir -> do+            when (oVerbose options) $+                putStrLn $ "Setting cwd to " ++ show extractDir+            setCurrentDirectory extractDir+        Nothing -> return ()+     when (oDecompress options) $ do         forM_ dirs $ \dir -> do             dirname <- parseRelDir $ T.unpack $ carEntryFilename dir@@ -82,21 +83,36 @@             filename <- parseRelFile $ T.unpack $ carEntryFilename file             liftIO $ cdim $ fromRelFile filename             patWritten <- if (oExtractPatFiles options)-            then unpackPat (fromRelFile filename) file+            then do+                patInfo <- loadPatInfo file+                case patInfo of+                    Just patInfo' -> do+                        let transportName = T.unpack . T.strip . TE.decodeUtf8With TEE.lenientDecode . phTransportName $ patInfo'+                            patFilename = "R" ++ drop 4 transportName+                            patExt = take 3 transportName+                            transportFilename = patFilename ++ "." ++ patExt+                        liftIO $ when (oVerbose options) $ do+                            putStrLn "Transport file"+                            putStrLn "==============================================================================="+                            putStrLn $ "Transport file : " ++ show (phTransportName patInfo')+                            putStrLn $ "Title          : " ++ show (phTitle patInfo')+                            putStrLn $ "Extracting to  : " ++ show transportFilename+                            putStrLn "\n"+                        parsedTransportFilename <- parseRelFile transportFilename+                        unpackPat (fromRelFile parsedTransportFilename) file+                    Nothing -> return False             else return False             if patWritten-            then when (oVerbose options) $-                liftIO $ putStrLn $ "P " ++ fromRelFile filename+            then return () -- do nothing here             else do                 when (oVerbose options) $                     liftIO $ putStrLn $ "x " ++ fromRelFile filename                 writeToFile file filename- #ifndef mingw32_HOST_OS-            liftIO $ SPF.setFileMode (fromRelFile filename) $ CMode $-                fromIntegral $ cfPermissions file-            let amTime = CTime $ fromIntegral $ cfTimestamp file-            liftIO $ SPF.setFileTimes (fromRelFile filename) amTime amTime+                liftIO $ SPF.setFileMode (fromRelFile filename) $ CMode $+                    fromIntegral $ cfPermissions file+                let amTime = CTime $ fromIntegral $ cfTimestamp file+                liftIO $ SPF.setFileTimes (fromRelFile filename) amTime amTime #endif  -- | Write a transport contained inside a PAT file@@ -107,6 +123,9 @@         open    = liftIO $ openBinaryFile path WriteMode         close   = liftIO . hClose         w h     = sourceEntry file (patToTransport =$= writePat h)++loadPatInfo :: CarEntry s -> SapCar s IO (Maybe PatHeader)+loadPatInfo file = sourceEntry file (getPatHeader =$= DCL.head)  -- | Provide a conduit sink, write everything that arrives there to -- the given handle. Return True if at least one chunk was written.

@@ -26,6 +26,8 @@       oListEntries          :: !Bool     , -- | Try to extract transports from PAT files       oExtractPatFiles      :: !Bool+    , -- | Extract directory+      oExtractDir           :: !(Maybe FilePath)     } deriving (Show)  run :: (Options -> IO a) -> IO a@@ -67,5 +69,11 @@         (  long "depat"         <> short 'p'         <> help "Try to extract transport files from PAT files" )+    <*> option (Just <$> str)+        (  metavar "DIRECTORY"+        <> long "extractdir"+        <> short 'e'+        <> value Nothing+        <> help "Set the directory where to extract the files to. Defaults to the current working directory." )  

@@ -1,3 +1,11 @@+0.2.2.1+-------++- When unwrapping transport files from PAT files,+  name the transport files properly+- Add an option to specify the extraction directory+  (default: CWD)+ 0.2.2.0 ------- 

@@ -1,5 +1,5 @@ name:                hascar-version:             0.2.2.0+version:             0.2.2.1 synopsis:            Decompress SAPCAR archives description:         Decompressor command line utility and library for SAP's SAPCAR format. homepage:            https://github.com/VirtualForgeGmbH/hascar@@ -7,7 +7,7 @@ license-file:        LICENSE author:              Hans-Christian Esperer <hc@hcesperer.org> maintainer:          Hans-Christian Esperer <hc@hcesperer.org>-copyright:           2016-2018, Virtual Forge GmbH+copyright:           2015-2018, Virtual Forge GmbH category:            Codec build-type:          Simple extra-source-files:  README.md changelog.md test/test6.sar

@@ -1,24 +1,15 @@ {-# LANGUAGE OverloadedStrings, DeriveFunctor, GeneralizedNewtypeDeriving #-} {-# LANGUAGE ExistentialQuantification, ImpredicativeTypes #-} -- |+-- Module: SAPCAR+-- Copyright: (C) 2015-2018, Virtual Forge GmbH+-- License: GPL2+-- Maintainer: Hans-Christian Esperer <hc@hcesperer.org>+-- Stability: experimental+-- Portability: portable+-- | -- (De-)compress SAPCAR files------ Copyright (C) 2016, Virtual Forge GmbH------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2 of the License, or (at--- your option) any later version.------ This program is distributed in the hope that it will be useful, but--- WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU--- General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307--- USA+ module Codec.Archive.SAPCAR     ( SapCar     , CarEntry (..)

@@ -1,30 +1,14 @@ {-# LANGUAGE RankNTypes #-} -- | -- Module: BitStream--- Copyright: (C) 2015, Virtual Forge GmbH--- License: GPL@+-- Copyright: (C) 2015-2018, Virtual Forge GmbH+-- License: GPL2 -- Maintainer: Hans-Christian Esperer <hc@hcesperer.org> -- Stability: experimental -- Portability: portable -- | -- (De-)compress SAPCAR files------ Copyright (C) 2016, Virtual Forge GmbH------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2 of the License, or (at--- your option) any later version.------ This program is distributed in the hope that it will be useful, but--- WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU--- General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307--- USA+ module Codec.Archive.SAPCAR.BitStream     ( BitStream     , makeStream

@@ -1,29 +1,13 @@ -- | -- Module: CanonicalHuffmanTree--- Copyright: (C) 2015, Virtual Forge GmbH+-- Copyright: (C) 2015-2018, Virtual Forge GmbH -- License: GPL2 -- Maintainer: Hans-Christian Esperer <hc@hcesperer.org> -- Stability: experimental -- Portability: portable -- | -- (De-)compress SAPCAR files------ Copyright (C) 2016, Virtual Forge GmbH------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2 of the License, or (at--- your option) any later version.------ This program is distributed in the hope that it will be useful, but--- WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU--- General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307--- USA+ module Codec.Archive.SAPCAR.CanonicalHuffmanTree     (CanonicalHuffmanTree, makeHuffmanTree,      getEntry, CHTEntry, readEntry,

@@ -2,30 +2,14 @@ {-# LANGUAGE BangPatterns #-} -- | -- Module: FlatedFile--- Copyright: (C) 2015-2016, Virtual Forge GmbH+-- Copyright: (C) 2015-2018, Virtual Forge GmbH -- License: GPL2 -- Maintainer: Hans-Christian Esperer <hans-christian.esperer@virtualforge.com> -- Stability: experimental -- Portability: portable -- |--- (De-)compress SAPCAR files------ Copyright (C) 2016, Virtual Forge GmbH------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2 of the License, or (at--- your option) any later version.------ This program is distributed in the hope that it will be useful, but--- WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU--- General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307--- USA+-- Deflate implementation+ module Codec.Archive.SAPCAR.FlatedFile     ( decompressBlocks     ) where

@@ -1,29 +1,13 @@ -- | -- Module: FlexibleUtils--- Copyright: (C) 2015-2016, Virtual Forge GmbH+-- Copyright: (C) 2015-2018, Virtual Forge GmbH -- License: GPL2 -- Maintainer: Hans-Christian Esperer <hc@hcesperer.org> -- Stability: experimental -- Portability: portable -- | -- (De-)compress SAPCAR files------ Copyright (C) 2016, Virtual Forge GmbH------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2 of the License, or (at--- your option) any later version.------ This program is distributed in the hope that it will be useful, but--- WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU--- General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307--- USA+ module Codec.Archive.SAPCAR.FlexibleUtils     ( makeFlexArray     , makeFlexList

@@ -1,31 +1,17 @@ -- | -- Module: Pat--- Copyright: (C) 2015-2016, Virtual Forge GmbH+-- Copyright: (C) 2015-2018, Virtual Forge GmbH -- License: GPL2 -- Maintainer: Hans-Christian Esperer <hc@hcesperer.org> -- Stability: experimental -- Portability: portable -- | -- (De-)compress SAPCAR files------ Copyright (C) 2016, Virtual Forge GmbH------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2 of the License, or (at--- your option) any later version.------ This program is distributed in the hope that it will be useful, but--- WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU--- General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307--- USA+ module Codec.Archive.SAPCAR.Pat     ( patToTransport+    , getPatHeader+    , PatHeader(..)     ) where  import Control.Monad@@ -53,20 +39,22 @@ -- | One chunk in a PAT file data PatChunk = PatChunk     { -- | The version of the chunk-      pcVersion         :: Int+      pcVersion         :: !Int     , -- | The type of the PAT chunk-      pcType            :: PatChunkType+      pcType            :: !PatChunkType     , -- | The length ot the chunk-      pcLength          :: Int+      pcLength          :: !Int     , -- | Reserved 14 bytes-      pcReserved        :: S.ByteString+      pcReserved        :: !S.ByteString     , -- | The raw payload of the chunk-      pcPayload         :: S.ByteString }+      pcPayload         :: !S.ByteString }     deriving (Show, Eq)  -- | The type of a PAT chunk data PatChunkType-    = -- | A fragment of an SAP transport file+    = -- | The primary header of the PAT file+      PatPrimaryHeader+    | -- | A fragment of an SAP transport file       TransportPatChunk     | -- | An unknown type of chunk       UnknownPatChunk@@ -74,12 +62,23 @@       NotAPatFile     deriving (Eq, Enum, Show) +data PatHeader = PatHeader+    { phMagic           :: !S.ByteString -- 3 bytes+    , phTransportName   :: !S.ByteString -- 20 bytes+    , phTitle           :: !S.ByteString -- 60 bytes+    } deriving (Eq, Show)++readPatPrimaryHeader :: Get PatHeader+readPatPrimaryHeader = PatHeader <$> getByteString 3 <*> getByteString 20 <*> getByteString 60+ getChunkType :: Get PatChunkType getChunkType = getChunkType' <$> getWord8  getChunkType' :: Word8 -> PatChunkType+getChunkType' 65   = PatPrimaryHeader getChunkType' 82   = TransportPatChunk getChunkType' (-1) = NotAPatFile+-- getChunkType' x    = show x `trace` UnknownPatChunk getChunkType' _    = UnknownPatChunk  getChunkVersion :: Get Int@@ -107,6 +106,28 @@ -- | Extract a transport file from a PAT file chunk by chunk patToTransport :: Monad m => Conduit S.ByteString m S.ByteString patToTransport = patToTransport' S.empty $ runGetIncremental getPatChunk++getPatHeader :: Monad m => Conduit S.ByteString m PatHeader+getPatHeader = getPatHeader' S.empty $ runGetIncremental getPatChunk++getPatHeader'+    :: Monad m+    => S.ByteString+    -> Decoder PatChunk+    -> Conduit S.ByteString m PatHeader+getPatHeader' s (Partial d)+    | S.null s = do+        chunk <- await+        case chunk of+            Just chunk' -> getPatHeader' S.empty $ pushChunk (Partial d) chunk'+            Nothing     -> return ()+    | otherwise = getPatHeader' S.empty $ pushChunk (Partial d) s+getPatHeader' s (Done rest _ r) = do+    when (pcType r == PatPrimaryHeader) $+        yield $ runGet readPatPrimaryHeader $ L.fromStrict $ pcPayload r+    unless (pcType r == NotAPatFile) $+        getPatHeader' rest $ runGetIncremental getPatChunk+  patToTransport'     :: Monad m