X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=ImplantFile.hs;h=1d7d43d8ce21f51666bb53b3b4652d94f37de063;hb=73ddbe92c23aec1d4e06cb9dce1b2b088643f5c2;hp=7410b5f4cde3803c44a652a179763ee749298660;hpb=2321c55149b4fd126835b1d2f708007ca1ffcb85;p=Lucu.git

diff --git a/ImplantFile.hs b/ImplantFile.hs
index 7410b5f..1d7d43d 100644
--- a/ImplantFile.hs
+++ b/ImplantFile.hs
@@ -5,17 +5,17 @@ import           Data.Bits
 import qualified Data.ByteString.Lazy as Lazy (ByteString)
 import qualified Data.ByteString.Lazy as L hiding (ByteString)
 import           Data.Char
-import           Data.Digest.SHA2
 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 +75,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,7 +106,8 @@ generateHaskellSource opts srcFile
          output   <- openOutput opts
          eTag     <- getETag opts input
 
-         let gzippedData = compressWith BestCompression input
+         let compParams  = defaultCompressParams { compressLevel = bestCompression }
+             gzippedData = compressWith compParams input
              originalLen = L.length input
              gzippedLen  = L.length gzippedData
              useGZip     = originalLen > gzippedLen
@@ -120,6 +122,8 @@ generateHaskellSource opts srcFile
                                        False Nothing Nothing
                         , HsImportDecl undefined (Module "Data.ByteString.Lazy")
                                        True (Just (Module "L")) Nothing
+                        , HsImportDecl undefined (Module "Data.Maybe")
+                                       False Nothing Nothing
                         , HsImportDecl undefined (Module "Data.Time")
                                        False Nothing Nothing
                         , HsImportDecl undefined (Module "Network.HTTP.Lucu")
@@ -300,8 +304,10 @@ generateHaskellSource opts srcFile
              defGZippedData 
                  = HsApp (HsVar (Qual (Module "L") (HsIdent "pack")))
                    (HsParen
-                    (HsApp (HsVar (UnQual (HsIdent "decode")))
-                     (HsLit (HsString gzippedB64))))
+                    (HsApp (HsVar (UnQual (HsIdent "fromJust")))
+                     (HsParen
+                      (HsApp (HsVar (UnQual (HsIdent "decode")))
+                       (HsLit (HsString gzippedB64))))))
 
              declRawData :: [HsDecl]
              declRawData 
@@ -316,8 +322,10 @@ generateHaskellSource opts srcFile
              defRawData
                  = HsApp (HsVar (Qual (Module "L") (HsIdent "pack")))
                    (HsParen
-                    (HsApp (HsVar (UnQual (HsIdent "decode")))
-                     (HsLit (HsString rawB64))))
+                    (HsApp (HsVar (UnQual (HsIdent "fromJust")))
+                     (HsParen
+                      (HsApp (HsVar (UnQual (HsIdent "decode")))
+                       (HsLit (HsString 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,25 +411,26 @@ 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 $ toOctets $ sha256 $ 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
 
 
@@ -459,6 +468,7 @@ openOutput opts
   module Foo.Bar.Baz (baz) where
   import Codec.Binary.Base64
   import qualified Data.ByteString.Lazy as L
+  import Data.Maybe
   import Data.Time
   import Network.HTTP.Lucu
 
@@ -486,7 +496,7 @@ openOutput opts
   contentType = read "image/png"
 
   rawData :: L.ByteString
-  rawData = L.pack (decode "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ...")
+  rawData = L.pack (fromJust (decode "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ..."))
   ------------------------------------------------------------------------------
 
   壓縮される場合は次のやうに變はる:
@@ -518,6 +528,6 @@ openOutput opts
   
   -- rawData の代はりに gzippedData
   gzippedData :: L.ByteString
-  gzippedData = L.pack (decode "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB...")
+  gzippedData = L.pack (fromJust (decode "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB..."))
   ------------------------------------------------------------------------------
  -}