Commit fca8a0e1 authored by Kristof Korwisi's avatar Kristof Korwisi
Browse files

Merge branch '102-fix-zip' into 'master'

Resolve "Use Haskell zip to extract the resource files from the executable"

Closes #102

See merge request decker/decker!56
parents 768927f7 834cd279
{-# LANGUAGE CPP #-}
import Codec.Archive.Zip
import Conduit
import Control.Monad.Extra
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString.Lazy as B
import Data.Maybe
import Distribution.PackageDescription
......@@ -22,7 +26,7 @@ appendResourceArchive ::
Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ()
appendResourceArchive args flags descr info = do
let binDir = fromPathTemplate $ bindir $ installDirTemplates info
executable <- makeAbsolute $ binDir </> "decker"
executable <- makeAbsolute $ binDir </> executableName
withCurrentDirectory resourceDir $ do
files <-
glob "**/*" >>= filterM doesFileExist >>=
......@@ -33,9 +37,77 @@ appendResourceArchive args flags descr info = do
putStrLn $
"Appending resource archive (" ++
show (length files) ++ " files) to " ++ executable
exeSize <- withBinaryFile executable ReadMode $ \h -> hFileSize h
fixZip archive exeSize
runConduitRes $
sourceFileBS archive .| sinkIOHandle (openFile executable AppendMode))
where
addFile path = do
selector <- mkEntrySelector path
loadEntry Deflate selector path
\ No newline at end of file
loadEntry Deflate selector path
fixZip :: FilePath -> Integer -> IO ()
fixZip zipPath adjustmentSize = do
withBinaryFile zipPath ReadWriteMode $ \h -> do
fsize <- hFileSize h
--- TODO if fsize is too small, don't do anything or report error
hSeek h SeekFromEnd (-22)
findEOCD h
hSeek h RelativeSeek 10
numberOfFiles <- readLen h
hSeek h RelativeSeek 4
currentOffset <- readNum h
hSeek h RelativeSeek (-4) -- undo change of last read
let cdPos = currentOffset + fromIntegral adjustmentSize
-- update central directory offset in eocd
writeNum h (fromIntegral cdPos)
-- update central directory file offsets
hSeek h AbsoluteSeek (fromIntegral currentOffset)
fixCDEntryRec h (fromIntegral numberOfFiles)
return ()
where
findEOCD h = do
sig <- readNum h
hSeek h RelativeSeek (-4) -- undo read increment
if sig == 0x06054b50
then do
return ()
else do
hSeek h RelativeSeek (-1) -- search backwards
findEOCD h
return ()
readNum h = runGet getWord32le <$> B.hGet h 4
readLen h = runGet getWord16le <$> B.hGet h 2
writeNum h val = B.hPut h (runPut $ putWord32le val)
fixCDEntry h = do
hSeek h RelativeSeek 28
fileLength <- readLen h
extraLength <- readLen h
commentLength <- readLen h
hSeek h RelativeSeek 8
currentRelativeOffset <- readNum h
hSeek h RelativeSeek (-4) -- undo change of last read
writeNum
h
(fromIntegral (currentRelativeOffset + fromIntegral adjustmentSize))
hSeek
h
RelativeSeek
(fromIntegral $ fileLength + extraLength + commentLength)
return ()
fixCDEntryRec :: Handle -> Int -> IO ()
fixCDEntryRec h iterations =
if iterations > 0
then do
fixCDEntry h
fixCDEntryRec h (iterations - 1)
return ()
else do
return ()
executableName :: String
#ifdef mingw32_HOST_OS
executableName = "decker.exe"
#else
executableName = "decker"
#endif
\ No newline at end of file
......@@ -10,6 +10,7 @@ build-type: Custom
custom-setup:
dependencies:
- base >= 4.7 && < 5
- binary
- bytestring
- Cabal
- conduit
......
......@@ -8,11 +8,13 @@ module Resources
, copyDir
) where
import Codec.Archive.Zip
import Common
import Control.Exception
import Control.Monad
import Control.Monad.Extra
import Data.List.Split (splitOn)
import Data.Map.Strict (size)
import Exception
import Flags
import System.Decker.OS
......@@ -61,12 +63,11 @@ extractResources = do
dataDir <- deckerResourceDir
exists <- doesDirectoryExist dataDir
unless exists $ do
unlessM (Resources.unzip ["-l", deckerExecutable]) $
numFiles <- withArchive deckerExecutable getEntries
unless ((size numFiles) > 0) $
throw $ ResourceException "No resource zip found in decker executable."
createDirectoryIfMissing True dataDir
unlessM (Resources.unzip ["-qq", "-o", "-d", dataDir, deckerExecutable]) $
throw $
ResourceException "Unable to extract resources from decker executable"
withArchive deckerExecutable (unpackInto dataDir)
putStrLn $ "# resources extracted to " ++ dataDir
unzip :: [String] -> IO Bool
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment