diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/app/GPL.hs b/app/GPL.hs --- a/app/GPL.hs +++ b/app/GPL.hs @@ -17,9 +17,7 @@ -- | The copyright text gpl' :: [Text] gpl' = - [ "hascar, Copyright (C) 2016-2018, Virtual Forge GmbH.", "" - , "Maint.: Hans-Christian Esperer" - , "", "" + [ "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" diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,24 +1,15 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | +-- Module: Main +-- Copyright: (C) 2015-2018, Virtual Forge GmbH +-- License: GPL2 +-- Maintainer: Hans-Christian Esperer +-- 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. diff --git a/app/Options.hs b/app/Options.hs --- a/app/Options.hs +++ b/app/Options.hs @@ -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." ) diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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 ------- diff --git a/hascar.cabal b/hascar.cabal --- a/hascar.cabal +++ b/hascar.cabal @@ -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 maintainer: Hans-Christian Esperer -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 diff --git a/src/Codec/Archive/SAPCAR.hs b/src/Codec/Archive/SAPCAR.hs --- a/src/Codec/Archive/SAPCAR.hs +++ b/src/Codec/Archive/SAPCAR.hs @@ -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 +-- 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 (..) diff --git a/src/Codec/Archive/SAPCAR/BitStream.hs b/src/Codec/Archive/SAPCAR/BitStream.hs --- a/src/Codec/Archive/SAPCAR/BitStream.hs +++ b/src/Codec/Archive/SAPCAR/BitStream.hs @@ -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 -- 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 diff --git a/src/Codec/Archive/SAPCAR/CanonicalHuffmanTree.hs b/src/Codec/Archive/SAPCAR/CanonicalHuffmanTree.hs --- a/src/Codec/Archive/SAPCAR/CanonicalHuffmanTree.hs +++ b/src/Codec/Archive/SAPCAR/CanonicalHuffmanTree.hs @@ -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 -- 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, diff --git a/src/Codec/Archive/SAPCAR/FlatedFile.hs b/src/Codec/Archive/SAPCAR/FlatedFile.hs --- a/src/Codec/Archive/SAPCAR/FlatedFile.hs +++ b/src/Codec/Archive/SAPCAR/FlatedFile.hs @@ -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 -- 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 diff --git a/src/Codec/Archive/SAPCAR/FlexibleUtils.hs b/src/Codec/Archive/SAPCAR/FlexibleUtils.hs --- a/src/Codec/Archive/SAPCAR/FlexibleUtils.hs +++ b/src/Codec/Archive/SAPCAR/FlexibleUtils.hs @@ -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 -- 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 diff --git a/src/Codec/Archive/SAPCAR/Pat.hs b/src/Codec/Archive/SAPCAR/Pat.hs --- a/src/Codec/Archive/SAPCAR/Pat.hs +++ b/src/Codec/Archive/SAPCAR/Pat.hs @@ -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 -- 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