hascar 0.2.0.0 → 0.2.0.1
raw patch · 8 files changed
+132/−64 lines, 8 filesbinary-addedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- README.md +50/−4
- app/Main.hs +24/−25
- hascar.cabal +2/−2
- src/Codec/Archive/SAPCAR.hs +7/−13
- src/Codec/Archive/SAPCAR/BitStream.hs +40/−12
- src/Codec/Archive/SAPCAR/FlatedFile.hs +8/−7
- test/Spec.hs +1/−1
- test/test6.sar binary
README.md view
@@ -10,8 +10,8 @@ This is not yet in a stable state. It should successfully unpack lzh compressed files and uncompressed files. -The SAPCAR container format decoder is based on research done by-Martin Gallo (https://github.com/CoreSecurity/pysap) with further+The SAPCAR container format decoder is based on [research done by+Martin Gallo](https://github.com/CoreSecurity/pysap) with further investigation by Hans-Christian Esperer <hc@hcesperer.org>, who also did the LZH decompressor reimplementation. @@ -29,15 +29,61 @@ * Make the LZH algorithm more efficient (the author just about started to learn haskell when he embarked on implementing that algorithm :-)+ => Some work on this has been done; more is required. +# 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 -To compile and install, first get stack (+# nixos++Users of [nixos](https://nixos.org) can simply install hascar by issuing "nix-env -iaP haskellPackages.hascar".+You need to be subscribed to the unstable channel at this time.++# Windows/GNU Linux/FreeBSD/OSX++To compile and install, first [get stack]( http://docs.haskellstack.org/en/stable/README/), then issue: stack build && stack install -hascar will be installed to ~/.local/bin+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.++The only attack vector left is the signature checking algorithm. # Usage
app/Main.hs view
@@ -48,37 +48,36 @@ main = runWithHeader it it :: Options -> IO ()-it options = do- withSapCarFile (oFilename options) $ do- entries <- getEntries- let files = ((== CarFile) . cfFileType) `filter` entries- let dirs = ((== CarDirectory) . cfFileType) `filter` entries- unless (oQuiet options) . liftIO . putStrLn $ show (length entries) ++ " entrie(s) in the archive."+it options = withSapCarFile (oFilename options) $ do+ entries <- getEntries+ let files = ((== CarFile) . cfFileType) `filter` entries+ let dirs = ((== CarDirectory) . cfFileType) `filter` entries+ unless (oQuiet options) . liftIO . putStrLn $ show (length entries) ++ " entrie(s) in the archive." - when (oListEntries options) $ liftIO $ do- putStrLn "\nAll entries:"- forM_ entries print- putStrLn ""+ when (oListEntries options) $ liftIO $ do+ putStrLn "\nAll entries:"+ forM_ entries print+ putStrLn "" - when (oDecompress options) $ do- forM_ dirs $ \dir -> do- dirname <- parseRelDir $ T.unpack $ carEntryFilename dir- when (oVerbose options) $- liftIO $ putStrLn $ "Creating " ++ show dirname- liftIO $ do- createDirectoryIfMissing True $ fromRelDir dirname+ when (oDecompress options) $ do+ forM_ dirs $ \dir -> do+ dirname <- parseRelDir $ T.unpack $ carEntryFilename dir+ when (oVerbose options) $+ liftIO $ putStrLn $ "Creating " ++ show dirname+ liftIO $ do+ createDirectoryIfMissing True $ fromRelDir dirname #ifndef mingw32_HOST_OS- SPF.setFileMode (fromRelDir dirname) $ CMode $ cfPermissions dir+ SPF.setFileMode (fromRelDir dirname) $ CMode $ cfPermissions dir #endif - forM_ files $ \file -> do- filename <- parseRelFile $ T.unpack $ carEntryFilename file- liftIO $ cdim $ fromRelFile filename- when (oVerbose options) $- liftIO $ putStrLn $ "Extracting " ++ show filename- writeToFile file filename+ forM_ files $ \file -> do+ filename <- parseRelFile $ T.unpack $ carEntryFilename file+ liftIO $ cdim $ fromRelFile filename+ when (oVerbose options) $+ liftIO $ putStrLn $ "Extracting " ++ show filename+ writeToFile file filename #ifndef mingw32_HOST_OS- liftIO $ SPF.setFileMode (fromRelFile filename) $ CMode $ cfPermissions file+ liftIO $ SPF.setFileMode (fromRelFile filename) $ CMode $ cfPermissions file #endif
hascar.cabal view
@@ -1,5 +1,5 @@ name: hascar-version: 0.2.0.0+version: 0.2.0.1 synopsis: Decompress SAPCAR archives description: Decompress SAPCAR archives homepage: https://github.com/VirtualForgeGmbH/hascar@@ -10,7 +10,7 @@ copyright: 2016, Virtual Forge GmbH category: Codec build-type: Simple-extra-source-files: README.md changelog.md+extra-source-files: README.md changelog.md test/test6.sar cabal-version: >=1.10 library
src/Codec/Archive/SAPCAR.hs view
@@ -270,12 +270,7 @@ writer h = do chunk <- await case chunk of- Just chunk' -> do- liftIO $ do- -- S.hPut h "================== BEGIN CHUNK =======================================\n"- S.hPut h chunk'- -- S.hPut h "\n============================ END CHUNK ===============================\n"- writer h+ Just chunk' -> liftIO (S.hPut h chunk') >> writer h Nothing -> return () -- | Parse the compression header of one SAPCAR block.@@ -321,8 +316,8 @@ ed <- getByteString 2 skipBlock case ed of- "ED" -> getWord32le >> return ()- "UE" -> getWord32le >> return ()+ "ED" -> void getWord32le+ "UE" -> void getWord32le "DA" -> skipBlocks "UD" -> skipBlocks _ -> error $ "Unknown block type " ++ show ed@@ -338,23 +333,22 @@ case ed of -- Compressed block (any algorithm; last block) "ED" -> do- (liftIO $ decompressBlock h) >>= yield+ liftIO (decompressBlock h) >>= yield void $ liftIO $ S.hGet h 4 -- TODO: This is the crc value. Use it! -- Compressed block (any algorithm; more to follow) "DA" -> do- (liftIO $ decompressBlock h) >>= yield- -- liftIO $ print blocks+ liftIO (decompressBlock h) >>= yield decompressBlocks h -- Uncompressed block (more to follow) "UD" -> do- (liftIO $ uncompressedBlock h) >>= yield+ liftIO (uncompressedBlock h) >>= yield decompressBlocks h -- Uncompressed block (last block) -- Looks like uncompressed files don't have a CRC appended- "UE" -> (liftIO $ uncompressedBlock h) >>= yield+ "UE" -> liftIO (uncompressedBlock h) >>= yield _ -> error $ "(while decompressing) unknown block type " ++ show ed
src/Codec/Archive/SAPCAR/BitStream.hs view
@@ -66,7 +66,7 @@ number <- newSTRef 0 offset <- newSTRef 0 position <- newSTRef 0- return $ BitStreamy+ return BitStreamy { bytes=array , len=S.length theBytes , number=number@@ -79,18 +79,46 @@ getBits _ 0 = return 0 getBits stream numBits = do offs <- readSTRef $ offset stream- num <- readSTRef $ number stream if numBits > offs- then do- pos <- readSTRef $ position stream- newByte <- fromIntegral <$> readArray (bytes stream) pos- writeSTRef (position stream) $ pos + 1- let num' = num .|. newByte `shiftL` offs- writeSTRef (offset stream) $ offs + 8- writeSTRef (number stream) num'- getBits stream numBits- else let bits = num .&. ((1 `shiftL` numBits) - 1)- in return bits+ then case numBits - offs of+ n | n < 9 -> refill False stream >> returnBits stream numBits+ n | n < 17 -> refill True stream >> returnBits stream numBits+ _ -> refill True stream >> getBits stream numBits+ else returnBits stream numBits++returnBits :: BitStream s -> Int -> ST s Int+returnBits stream numBits = do+ num <- readSTRef $ number stream+ return $ num .&. ((1 `shiftL` numBits) - 1)++refill :: Bool -> BitStream s-> ST s ()+{-# INLINE refill #-}+refill two stream = do+ pos <- readSTRef $ position stream+ num <- readSTRef $ number stream+ offs <- readSTRef $ offset stream+ if two+ then refillTwoBits pos num offs stream+ else refillOneBit pos num offs stream++refillOneBit :: Int -> Int -> Int -> BitStream s -> ST s ()+{-# INLINE refillOneBit #-}+refillOneBit pos num offs stream = do+ newByte <- fromIntegral <$> readArray (bytes stream) pos+ writeSTRef (position stream) $ pos + 1+ let num' = num .|. newByte `shiftL` offs+ writeSTRef (offset stream) $ offs + 8+ writeSTRef (number stream) num'++refillTwoBits :: Int -> Int -> Int -> BitStream s -> ST s ()+{-# INLINE refillTwoBits #-}+refillTwoBits pos num offs stream = do+ newByte1 <- fromIntegral <$> readArray (bytes stream) pos+ newByte2 <- fromIntegral <$> readArray (bytes stream) (pos + 1)+ writeSTRef (position stream) $ pos + 2+ let num' = num .|. newByte1 `shiftL` offs .|. newByte2 `shiftL` (offs + 8)+ writeSTRef (offset stream) $ offs + 16+ writeSTRef (number stream) num' -- |Consume the specified number of bits consume :: BitStream s -> Int -> ST s ()
src/Codec/Archive/SAPCAR/FlatedFile.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE BangPatterns #-} -- | -- Module: FlatedFile@@ -83,7 +82,7 @@ data OutStream s = OutStream { osBuf :: STUArray s Int Word8- , osPos :: STRef s Int }+ , osPos :: STUArray s Int Int } readInt32Big :: Handle -> IO Int readInt32Big h = do@@ -142,13 +141,13 @@ writeOut :: OutStream s -> Word8 -> ST s () writeOut s b = do- pos <- readSTRef $ osPos s+ pos <- readArray (osPos s) 0 writeArray (osBuf s) pos b- writeSTRef (osPos s) $ pos + 1+ writeArray (osPos s) 0 $ pos + 1 copyBytes :: OutStream s -> Int -> Int -> ST s () copyBytes buf dist len = do- minPos <- (subtract dist) <$> readSTRef (osPos buf)+ minPos <- subtract dist <$> readArray (osPos buf) 0 copyBytes' buf minPos $ minPos + len copyBytes' :: OutStream s -> Int -> Int -> ST s ()@@ -170,7 +169,7 @@ stream <- makeStream inp o <- decompressor uncompressedSize stream o' <- freeze $ osBuf o- l <- readSTRef $ osPos o+ l <- readArray (osPos o) 0 return (l, o') skipNonsenseBits :: BitStream s -> ST s ()@@ -182,7 +181,7 @@ makeOutStream :: Int -> ST s (OutStream s) makeOutStream len = OutStream <$> (newArray (0, len - 1) 0 :: ST s (STUArray s Int Word8))- <*> newSTRef 0+ <*> (newArray (0, 1) 0 :: ST s (STUArray s Int Int)) decompressor :: Int -> BitStream s -> ST s (OutStream s) decompressor uncompressedSize s = do@@ -222,12 +221,14 @@ return () decodeIt lengthTree distTree stream out +staticLengthTree :: CanonicalHuffmanTree staticLengthTree = makeHuffmanTree lengthCodes 257 cplens csExtraLenBits where -- Length and dist codes copied from vpa108csulzh.cpp under GPL by SAP AG lengthCodes = replicate 144 8 ++ replicate 112 9 ++ replicate 24 7 ++ replicate 8 8 -- End length and dist codes copied from vpa108csulzh.cpp under GPL by SAP AG +staticDistTree :: CanonicalHuffmanTree staticDistTree = makeHuffmanTree distCodes 0 cpdist csExtraDistBits where -- Length and dist codes copied from vpa108csulzh.cpp under GPL by SAP AG
test/Spec.hs view
@@ -27,7 +27,7 @@ res <- withSapCarPath path $ do entries <- getEntries unless (length entries == 1) $ error "test6.sar should contain exactly one entry!"- let entry = entries !! 0+ let entry = head entries unless (cfFileName entry == "pg244.txt") $ error "Entry in test6.sar should be called 'pg244.txt'!" unless (cfFileType entry == CarFile) $ error "Entry in test6.sar should be of type 'file'!" sourceEntry entry bufSink
+ test/test6.sar view
binary file changed (absent → 113208 bytes)