diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,7 +2,11 @@ # What is hascar? -HASCAR is a free unzip utility for SAP's SAPCAR format. +HASCAR is a free unzip utility for SAP's SAPCAR format. You can use it to +decompress sap car files on the command line. The command line utility also +supports unwrapping of transport files that are contained inside patch files. +(Option -p, --depat) You can also use it as a library in your own haskell programs. So +far, only the latest version of sapcar files are is supported, which is 2.01. It is implemented 100% in haskell, including the lzh decompression routine. @@ -20,6 +24,7 @@ * Reading SAPCAR archives version 2.01 only * Unpacking files that are LZH compressed * Unpacking files that are not compressed +* Unpacking transport files are wrapped inside a PAT file TODO: @@ -32,31 +37,16 @@ => Some work on this has been done; more is required. * Implement CRC checking -# Performance -The lzh algorithm is implemented in pure haskell. I have spent some time -optimizing it, but more can certainly be done. Currently the performance is -probably acceptable for most cases, but it is still a factor ten compared to -the reference C implementation: - -Decompressing a 136 MB payload (34MB compressed), the performance looks like -this: - - hascar: 7.94user 0.10system 0:08.05elapsed 99%CPU (0avgtext+0avgdata 102676maxresident)k - - sapcar: 0.84user 0.07system 0:00.92elapsed 99%CPU (0avgtext+0avgdata 8244maxresident)k - -Both executed on a single CPU core. (Intel(R) Core(TM) i7-4770 CPU @ 3.40GHz) - # Installing hascar -# nixos +## nixos Users of [nixos](https://nixos.org) can simply install hascar by issuing "nix-env -iaP haskellPackages.hascar". Or if you only need it temporarily, open a nix-shell like this: "nix-shell -p haskellPackages.hascar" -# FreeBSD/GNU_Linux/OS X/Windows +## FreeBSD/GNU_Linux/OS X/Windows To compile and install, first [get stack]( http://docs.haskellstack.org/en/stable/README/), then issue: @@ -66,26 +56,9 @@ hascar will be installed to ~/.local/bin . You should set your PATH variable to point to this directory. -# Verifying signatures - -You can use hascar to decompress and subsequently inspect the contents -of a SAR file. You would normally not install the contents from -untrusted SAR files, so there is no need to verify the signature. - -If, OTOH, you do trust the original SAR file but wish to verify the -signature to ensure you are indeed dealing with the original SAR -file's contents, like when installing patches to your SAP system, then -you will need to do the following: Since hascar at this time does not -support verifying signatures, you need to use SAP's own tool for that -purpose. You can use hascar to initially decompress the archive. This -step ensures that only archives with a correct and untampered file -header and compressed contents are accepted. Then, use SAP's own -sapcar tool to create a new archive from the decompressed archive. You -will now have a trusted archive, because you created it yourself. You -can then use SAP's original tool to decompress it again, while -verifying the signature. +# Verifying signatures and encrypted archives -The only attack vector left is the signature checking algorithm. +Since both use a proprietary crypto API, this is currently not supported. # Usage @@ -94,34 +67,10 @@ command line parser is a bit more strict than what you might be used to. -# Example run: +# Extracting transport files from PAT files - hc@espererh-pc ~/I/hascar λ hascar -xtvf /home/hc/test.sar - ┌────────────────────────────────────────────────────────────────────┐ - │ hascar, Copyright (C) 2016, Virtual Forge GmbH. │ - │ │ - │ Maint.: Hans-Christian Esperer │ - │ │ - │ │ - │ hascar comes with ABSOLUTELY NO WARRANTY; │ - │ for details read the LICENSE file. │ - │ This is free software, and you are welcome to redistribute │ - │ it under certain conditions; see the LICENSE file for details. │ - └────────────────────────────────────────────────────────────────────┘ - - 5 entrie(s) in the archive. - - All entries: - -rw-r--r-- 0 root root 9302 Jun 10 00:00 sapcar-usage - -rw-r--r-- 0 root root 267468 Jun 10 00:00 pg244.txt - -rw-r--r-- 0 root root 34857 Jun 10 00:00 man.txt - -rw-r--r-- 0 root root 10485764 Jun 10 00:00 foo - -rw-r--r-- 0 root root 30 Jun 10 00:00 date - - Extracting "sapcar-usage" - Extracting "pg244.txt" - Extracting "man.txt" - Extracting "foo" - Extracting "date" - - hc@espererh-pc ~/I/hascar λ +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'. diff --git a/app/GPL.hs b/app/GPL.hs --- a/app/GPL.hs +++ b/app/GPL.hs @@ -17,7 +17,7 @@ -- | The copyright text gpl' :: [Text] gpl' = - [ "hascar, Copyright (C) 2016, Virtual Forge GmbH.", "" + [ "hascar, Copyright (C) 2016-2018, Virtual Forge GmbH.", "" , "Maint.: Hans-Christian Esperer" , "", "" , "hascar comes with ABSOLUTELY NO WARRANTY;" diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -22,8 +22,11 @@ module Main where import Control.Monad +import Control.Monad.Catch import Control.Monad.IO.Class import Data.Binary.Get +import Data.ByteString (ByteString) +import Data.Conduit import Foreign.C.Types (CTime(..)) import Path import System.Directory @@ -38,6 +41,7 @@ import Options import Codec.Archive.SAPCAR +import Codec.Archive.SAPCAR.Pat #ifndef mingw32_HOST_OS import System.Posix.Files as SPF @@ -77,9 +81,17 @@ forM_ files $ \file -> do filename <- parseRelFile $ T.unpack $ carEntryFilename file liftIO $ cdim $ fromRelFile filename - when (oVerbose options) $ - liftIO $ putStrLn $ "x " ++ fromRelFile filename - writeToFile file filename + patWritten <- if (oExtractPatFiles options) + then unpackPat (fromRelFile filename) file + else return False + if patWritten + then when (oVerbose options) $ + liftIO $ putStrLn $ "P " ++ fromRelFile filename + 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 @@ -87,6 +99,25 @@ liftIO $ SPF.setFileTimes (fromRelFile filename) amTime amTime #endif +-- | Write a transport contained inside a PAT file +-- return if any bytes were written +unpackPat :: FilePath -> CarEntry s -> SapCar s IO Bool +unpackPat path file = bracket open close w + where + open = liftIO $ openBinaryFile path WriteMode + close = liftIO . hClose + w h = sourceEntry file (patToTransport =$= writePat h) + +-- | Provide a conduit sink, write everything that arrives there to +-- the given handle. Return True if at least one chunk was written. +writePat :: Handle -> Sink S.ByteString IO Bool +writePat h = + let loop c = do + chunk <- await + case chunk of + Just chunk' -> liftIO (S.hPut h chunk') >> loop True + Nothing -> return c + in loop False cdim :: FilePath -> IO () cdim fp = do diff --git a/app/Options.hs b/app/Options.hs --- a/app/Options.hs +++ b/app/Options.hs @@ -24,6 +24,8 @@ oQuiet :: !Bool , -- | Whether to list all entries in the archive oListEntries :: !Bool + , -- | Try to extract transports from PAT files + oExtractPatFiles :: !Bool } deriving (Show) run :: (Options -> IO a) -> IO a @@ -61,5 +63,9 @@ ( long "list" <> short 't' <> help "List all entries in the archive" ) + <*> switch + ( long "depat" + <> short 'p' + <> help "Try to extract transport files from PAT files" ) diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,9 @@ +0.2.2.0 +------- + +- Add an option to extract transport files from PAT + files automatically + 0.2.1.2 ------- diff --git a/hascar.cabal b/hascar.cabal --- a/hascar.cabal +++ b/hascar.cabal @@ -1,13 +1,13 @@ name: hascar -version: 0.2.1.2 +version: 0.2.2.0 synopsis: Decompress SAPCAR archives -description: Decompress SAPCAR archives +description: Decompressor command line utility and library for SAP's SAPCAR format. homepage: https://github.com/VirtualForgeGmbH/hascar license: GPL-2 license-file: LICENSE author: Hans-Christian Esperer maintainer: Hans-Christian Esperer -copyright: 2016, Virtual Forge GmbH +copyright: 2016-2018, Virtual Forge GmbH category: Codec build-type: Simple extra-source-files: README.md changelog.md test/test6.sar @@ -17,6 +17,7 @@ hs-source-dirs: src exposed-modules: Codec.Archive.SAPCAR , Codec.Archive.SAPCAR.FlatedFile + , Codec.Archive.SAPCAR.Pat other-modules: Codec.Archive.SAPCAR.BitStream , Codec.Archive.SAPCAR.CanonicalHuffmanTree , Codec.Archive.SAPCAR.FlexibleUtils @@ -43,7 +44,9 @@ , ansi-wl-pprint , binary , bytestring + , conduit , directory + , exceptions , filepath , gitrev , hascar diff --git a/src/Codec/Archive/SAPCAR/Pat.hs b/src/Codec/Archive/SAPCAR/Pat.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Archive/SAPCAR/Pat.hs @@ -0,0 +1,128 @@ +-- | +-- Module: Pat +-- Copyright: (C) 2015-2016, 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 + ) where + +import Control.Monad +import Data.Binary.Get +import Data.Bits +import Data.Conduit +import Data.Maybe +import Data.Word +import Data.Text (Text) +import System.IO +import Text.Printf +import Text.Read + +import qualified Data.ByteString as S +import qualified Data.ByteString.Lazy as L +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Encoding.Error as TEE + +-- | The maximum size we allow per chunk. This is +-- important to help prevent memory exhaustion attacks. +maximumChunkSize :: Int +maximumChunkSize = 65536 + +-- | One chunk in a PAT file +data PatChunk = PatChunk + { -- | The version of the chunk + pcVersion :: Int + , -- | The type of the PAT chunk + pcType :: PatChunkType + , -- | The length ot the chunk + pcLength :: Int + , -- | Reserved 14 bytes + pcReserved :: S.ByteString + , -- | The raw payload of the chunk + pcPayload :: S.ByteString } + deriving (Show, Eq) + +-- | The type of a PAT chunk +data PatChunkType + = -- | A fragment of an SAP transport file + TransportPatChunk + | -- | An unknown type of chunk + UnknownPatChunk + | -- | Not a PAT fiel + NotAPatFile + deriving (Eq, Enum, Show) + +getChunkType :: Get PatChunkType +getChunkType = getChunkType' <$> getWord8 + +getChunkType' :: Word8 -> PatChunkType +getChunkType' 82 = TransportPatChunk +getChunkType' (-1) = NotAPatFile +getChunkType' _ = UnknownPatChunk + +getChunkVersion :: Get Int +getChunkVersion = fromMaybe (-1) . readMaybe . T.unpack . TE.decodeUtf8With TEE.lenientDecode <$> getByteString 2 + +getChunkLength :: Get Int +getChunkLength = do + length <- fromMaybe (0) . readMaybe . T.unpack . TE.decodeUtf8 <$> getByteString 8 :: Get Int + when (length > maximumChunkSize) $ error "Too big a chunk" + return length + +-- | Get one SAP PAT chunk +getPatChunk :: Get PatChunk +getPatChunk = do + v <- getChunkVersion + if v == (-1) + then return $ PatChunk (-1) NotAPatFile 0 S.empty S.empty + else do + t <- getChunkType + l <- getChunkLength + r <- getByteString 14 + p <- getByteString $ l - 25 + return $ PatChunk v t l r p + +-- | 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 + +patToTransport' + :: Monad m + => S.ByteString + -> Decoder PatChunk + -> Conduit S.ByteString m S.ByteString +patToTransport' s (Partial d) + | S.null s = do + chunk <- await + case chunk of + Just chunk' -> patToTransport' S.empty $ pushChunk (Partial d) chunk' + Nothing -> return () + | otherwise = patToTransport' S.empty $ pushChunk (Partial d) s +patToTransport' s (Done rest _ r) = do + when (pcType r == TransportPatChunk) $ + yield (pcPayload r) + unless (pcType r == NotAPatFile) $ + patToTransport' rest $ runGetIncremental getPatChunk +