Permalink
Browse files

Injection

  • Loading branch information...
1 parent 307738a commit 33188f2b138e0d013f96143704c8b64322b488a7 @snoyberg committed May 27, 2011
Showing with 71 additions and 3 deletions.
  1. +61 −2 Data/FileEmbed.hs
  2. +1 −1 file-embed.cabal
  3. +4 −0 inject.hs
  4. +4 −0 template.hs
  5. +1 −0 test-inject.sh
View
@@ -1,13 +1,18 @@
{-# LANGUAGE TemplateHaskell #-}
module Data.FileEmbed
- ( embedFile
+ ( -- * Embed at compile time
+ embedFile
, embedDir
, getDir
+ -- * Inject into an executable
+ , dummySpace
+ , inject
+ , injectFile
) where
import Language.Haskell.TH (runQ,
Exp (AppE, ListE, LitE, TupE),
- Lit (StringL),
+ Lit (StringL, StringPrimL, IntegerL),
Q,
runIO)
import System.Directory (doesDirectoryExist, doesFileExist,
@@ -18,6 +23,8 @@ import qualified Data.ByteString.Char8 as B8
import Control.Arrow ((&&&), second, first)
import Control.Applicative ((<$>))
import Data.Monoid (mappend)
+import Data.ByteString.Unsafe (unsafePackAddressLen)
+import System.IO.Unsafe (unsafePerformIO)
-- | Embed a single file in your source code.
--
@@ -78,3 +85,55 @@ fileList' realTop top = do
liftPair2 :: Monad m => (a, m b) -> m (a, b)
liftPair2 (a, b) = b >>= \b' -> return (a, b')
+
+magic = concat ["fe", "MS"]
+sizeLen = 20
+
+getInner :: B.ByteString -> B.ByteString
+getInner b =
+ let (sizeBS, rest) = B.splitAt sizeLen $ B.drop (length magic) b
+ in case reads $ B8.unpack sizeBS of
+ (i, _):_ -> B.take i rest
+ [] -> error "Data.FileEmbed (getInner): Your dummy space has been corrupted."
+
+padSize :: Int -> String
+padSize i =
+ let s = show i
+ in replicate (sizeLen - length s) '0' ++ s
+
+dummySpace :: Int -> Q Exp
+dummySpace space = do
+ let size = padSize space
+ let start = magic ++ size
+ let chars = LitE $ StringPrimL $ start ++ replicate space '0'
+ let len = LitE $ IntegerL $ fromIntegral $ length start + space
+ upi <- [|unsafePerformIO|]
+ pack <- [|unsafePackAddressLen|]
+ getInner' <- [|getInner|]
+ return $ getInner' `AppE` (upi `AppE` (pack `AppE` len `AppE` chars))
+
+inject :: B.ByteString -- ^ bs to inject
+ -> B.ByteString -- ^ original BS containing dummy
+ -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space
+inject toInj orig =
+ if toInjL > size
+ then Nothing
+ else Just $ B.concat [before, B8.pack magic, B8.pack $ padSize toInjL, toInj, B8.pack $ replicate (size - toInjL) '0', after]
+ where
+ toInjL = B.length toInj
+ (before, rest) = B.breakSubstring (B8.pack magic) orig
+ (sizeBS, rest') = B.splitAt sizeLen $ B.drop (length magic) rest
+ size = case reads $ B8.unpack sizeBS of
+ (i, _):_ -> i
+ [] -> error $ "Data.FileEmbed (inject): Your dummy space has been corrupted. Size is: " ++ show sizeBS
+ (dummy, after) = B.splitAt size rest'
+
+injectFile :: B.ByteString
+ -> FilePath -- ^ template file
+ -> FilePath -- ^ output file
+ -> IO ()
+injectFile inj srcFP dstFP = do
+ src <- B.readFile srcFP
+ case inject inj src of
+ Nothing -> error "Insufficient dummy space"
+ Just dst -> B.writeFile dstFP dst
View
@@ -1,5 +1,5 @@
name: file-embed
-version: 0.0.3.1
+version: 0.0.4
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
View
@@ -0,0 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Data.FileEmbed
+
+main = injectFile "Hello World" "template" "injected"
View
@@ -0,0 +1,4 @@
+{-# LANGUAGE TemplateHaskell #-}
+import Data.FileEmbed
+
+main = print $(dummySpace 100)
View
@@ -0,0 +1 @@
+ghc --make -fforce-recomp template.hs && runghc inject.hs && chmod +x injected && ./injected

0 comments on commit 33188f2

Please sign in to comment.