X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=ImplantFile.hs;h=fd57fadc456023ef5e78eee0b018098b12cada39;hp=22fafeaa5acd35d413c827701265aead3a0d2349;hb=0a300483f71cbbbe84b5781849f33692c2832864;hpb=4ff7f4b48f372e1cbea63873c5604ee3b4b56d09 diff --git a/ImplantFile.hs b/ImplantFile.hs index 22fafea..fd57fad 100644 --- a/ImplantFile.hs +++ b/ImplantFile.hs @@ -1,21 +1,23 @@ -import Codec.Binary.Base64 import Codec.Compression.GZip import Control.Monad import Data.Bits +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as Lazy (ByteString) -import qualified Data.ByteString.Lazy as L hiding (ByteString) +import qualified Data.ByteString.Lazy as LS hiding (ByteString) import Data.Char -import Data.Digest.SHA1 import Data.Int import Data.Maybe import Data.Time import Data.Time.Clock.POSIX -import Data.Word import Language.Haskell.Pretty import Language.Haskell.Syntax import Network.HTTP.Lucu.MIMEType import Network.HTTP.Lucu.MIMEType.DefaultExtensionMap import Network.HTTP.Lucu.MIMEType.Guess +import OpenSSL +import OpenSSL.EVP.Digest import System.Console.GetOpt import System.Environment import System.Exit @@ -75,13 +77,14 @@ printUsage = do putStrLn "" main :: IO () -main = do (opts, sources, errors) <- return . getOpt Permute options =<< getArgs +main = withOpenSSL $ + do (opts, sources, errors) <- return . getOpt Permute options =<< getArgs - when (not $ null errors) + unless (null errors) $ do mapM_ putStr errors exitWith $ ExitFailure 1 - when (any (\ x -> x == OptHelp) opts) + when (any (== OptHelp) opts) $ do printUsage exitWith ExitSuccess @@ -105,21 +108,24 @@ generateHaskellSource opts srcFile output <- openOutput opts eTag <- getETag opts input - let gzippedData = compressWith BestCompression input - originalLen = L.length input - gzippedLen = L.length gzippedData + let compParams = defaultCompressParams { compressLevel = bestCompression } + gzippedData = compressWith compParams input + originalLen = LS.length input + gzippedLen = LS.length gzippedData useGZip = originalLen > gzippedLen - rawB64 = encode $ L.unpack input - gzippedB64 = encode $ L.unpack gzippedData + rawB64 = B64.encode $ BS.concat $ LS.toChunks input + gzippedB64 = B64.encode $ BS.concat $ LS.toChunks gzippedData header <- mkHeader srcFile originalLen gzippedLen useGZip mimeType eTag lastMod let hsModule = HsModule undefined (Module modName) (Just exports) imports decls exports = [HsEVar (UnQual (HsIdent symName))] - imports = [ HsImportDecl undefined (Module "Codec.Binary.Base64") - False Nothing Nothing + imports = [ HsImportDecl undefined (Module "Data.ByteString.Base64") + True (Just (Module "B64")) Nothing + , HsImportDecl undefined (Module "Data.ByteString.Char8") + True (Just (Module "C8")) Nothing , HsImportDecl undefined (Module "Data.ByteString.Lazy") - True (Just (Module "L")) Nothing + True (Just (Module "LS")) Nothing , HsImportDecl undefined (Module "Data.Time") False Nothing Nothing , HsImportDecl undefined (Module "Network.HTTP.Lucu") @@ -291,33 +297,35 @@ generateHaskellSource opts srcFile declGZippedData = [ HsTypeSig undefined [HsIdent "gzippedData"] (HsQualType [] - (HsTyCon (Qual (Module "L") (HsIdent "ByteString")))) + (HsTyCon (Qual (Module "LS") (HsIdent "ByteString")))) , HsFunBind [HsMatch undefined (HsIdent "gzippedData") [] (HsUnGuardedRhs defGZippedData) []] ] defGZippedData :: HsExp defGZippedData - = HsApp (HsVar (Qual (Module "L") (HsIdent "pack"))) - (HsParen - (HsApp (HsVar (UnQual (HsIdent "decode"))) - (HsLit (HsString gzippedB64)))) + = HsApp (HsVar (Qual (Module "LS") (HsIdent "fromChunks"))) + (HsList [HsApp (HsVar (Qual (Module "B64") (HsIdent "decodeLenient"))) + (HsParen + (HsApp (HsVar (Qual (Module "C8") (HsIdent "pack"))) + (HsLit (HsString $ C8.unpack gzippedB64))))]) declRawData :: [HsDecl] declRawData = [ HsTypeSig undefined [HsIdent "rawData"] (HsQualType [] - (HsTyCon (Qual (Module "L") (HsIdent "ByteString")))) + (HsTyCon (Qual (Module "LS") (HsIdent "ByteString")))) , HsFunBind [HsMatch undefined (HsIdent "rawData") [] (HsUnGuardedRhs defRawData) []] ] defRawData :: HsExp defRawData - = HsApp (HsVar (Qual (Module "L") (HsIdent "pack"))) - (HsParen - (HsApp (HsVar (UnQual (HsIdent "decode"))) - (HsLit (HsString rawB64)))) + = HsApp (HsVar (Qual (Module "LS") (HsIdent "fromChunks"))) + (HsList [HsApp (HsVar (Qual (Module "B64") (HsIdent "decodeLenient"))) + (HsParen + (HsApp (HsVar (Qual (Module "C8") (HsIdent "pack"))) + (HsLit (HsString $ C8.unpack rawB64))))]) hPutStrLn output header hPutStrLn output (prettyPrint hsModule) @@ -363,12 +371,12 @@ getSymbolName opts modName _ -> False) opts -- モジュール名をピリオドで分割した時の最後の項目の先頭文字を -- 小文字にしたものを使ふ。 - defaultSymName = mkDefault modName - mkDefault = headToLower . getLastComp - headToLower = \ str -> case str of - [] -> error "module name must not be empty" - (x:xs) -> toLower x : xs - getLastComp = reverse . fst . break (== '.') . reverse + defaultSymName = mkDefault modName + mkDefault = headToLower . getLastComp + headToLower str = case str of + [] -> error "module name must not be empty" + (x:xs) -> toLower x : xs + getLastComp = reverse . fst . break (== '.') . reverse in case symNameOpts of [] -> return defaultSymName @@ -392,8 +400,8 @@ getMIMEType opts srcFile getLastModified :: FilePath -> IO UTCTime getLastModified "-" = getCurrentTime -getLastModified fpath = getFileStatus fpath - >>= return . posixSecondsToUTCTime . fromRational . toRational . modificationTime +getLastModified fpath = fmap (posixSecondsToUTCTime . fromRational . toRational . modificationTime) + $ getFileStatus fpath getETag :: [CmdOpt] -> Lazy.ByteString -> IO String @@ -403,31 +411,32 @@ getETag opts input _ -> False) opts in case eTagOpts of - [] -> return mkETagFromInput + [] -> fmap (mkETagFromInput . fromJust) (getDigestByName "SHA1") (OptETag str):[] -> return str _ -> error "too many --etag options." where - mkETagFromInput :: String - mkETagFromInput = "SHA-1:" ++ (toHex $ hash $ L.unpack input) + mkETagFromInput :: Digest -> String + mkETagFromInput sha1 = "SHA-1:" ++ toHex (digestLBS sha1 input) - toHex :: [Word8] -> String - toHex [] = "" - toHex (x:xs) = hexByte (fromIntegral x) ++ toHex xs + toHex :: String -> String + toHex = foldr ((++) . hexByte . fromEnum) "" hexByte :: Int -> String hexByte n - = hex4bit ((n `shiftR` 4) .&. 0x0F) : hex4bit (n .&. 0x0F) : [] + = [ hex4bit ((n `shiftR` 4) .&. 0x0F) + , hex4bit ( n .&. 0x0F) + ] hex4bit :: Int -> Char hex4bit n - | n < 10 = (chr $ ord '0' + n ) - | n < 16 = (chr $ ord 'a' + n - 10) + | n < 10 = chr $ ord '0' + n + | n < 16 = chr $ ord 'a' + n - 10 | otherwise = undefined openInput :: FilePath -> IO Lazy.ByteString -openInput "-" = L.getContents -openInput fpath = L.readFile fpath +openInput "-" = LS.getContents +openInput fpath = LS.readFile fpath openOutput :: [CmdOpt] -> IO Handle @@ -457,8 +466,9 @@ openOutput opts Last Modified: 2007-11-05 13:53:42.231882 JST -} module Foo.Bar.Baz (baz) where - import Codec.Binary.Base64 - import qualified Data.ByteString.Lazy as L + import qualified Data.ByteString.Base64 as B64 + import qualified Data.ByteString.Char8 as C8 + import qualified Data.ByteString.Lazy as LS import Data.Time import Network.HTTP.Lucu @@ -485,8 +495,8 @@ openOutput opts contentType :: MIMEType contentType = read "image/png" - rawData :: L.ByteString - rawData = L.pack (decode "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ...") + rawData :: LS.ByteString + rawData = LS.fromChunks [B64.decodeLenient (C8.pack "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ...")] ------------------------------------------------------------------------------ 壓縮される場合は次のやうに變はる: @@ -517,7 +527,7 @@ openOutput opts } -- rawData の代はりに gzippedData - gzippedData :: L.ByteString - gzippedData = L.pack (decode "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB...") + gzippedData :: LS.ByteString + gzippedData = LS.fromChunks [B64.decodeLenient (C8.pack "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB...")] ------------------------------------------------------------------------------ -}