diff --git a/ImplantFile.hs b/ImplantFile.hs --- a/ImplantFile.hs +++ b/ImplantFile.hs @@ -1,9 +1,11 @@ -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.Int import Data.Maybe @@ -108,22 +110,22 @@ let compParams = defaultCompressParams { compressLevel = bestCompression } gzippedData = compressWith compParams input - originalLen = L.length input - gzippedLen = L.length gzippedData + 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 - , HsImportDecl undefined (Module "Data.Maybe") - False Nothing Nothing + True (Just (Module "LS")) Nothing , HsImportDecl undefined (Module "Data.Time") False Nothing Nothing , HsImportDecl undefined (Module "Network.HTTP.Lucu") @@ -295,37 +297,35 @@ 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 "fromJust"))) - (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 "fromJust"))) - (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) @@ -435,8 +435,8 @@ 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 @@ -466,9 +466,9 @@ 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 Data.Maybe + 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 @@ -495,8 +495,8 @@ contentType :: MIMEType contentType = read "image/png" - rawData :: L.ByteString - rawData = L.pack (fromJust (decode "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ...")) + rawData :: LS.ByteString + rawData = LS.fromChunks [B64.decodeLenient (C8.pack "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ...")] ------------------------------------------------------------------------------ 壓縮される場合は次のやうに變はる: @@ -527,7 +527,7 @@ } -- rawData の代はりに gzippedData - gzippedData :: L.ByteString - gzippedData = L.pack (fromJust (decode "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB...")) + gzippedData :: LS.ByteString + gzippedData = LS.fromChunks [B64.decodeLenient (C8.pack "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB...")] ------------------------------------------------------------------------------ -} diff --git a/Lucu.cabal b/Lucu.cabal --- a/Lucu.cabal +++ b/Lucu.cabal @@ -8,13 +8,14 @@ without messing around FastCGI. It is also intended to be run behind a reverse-proxy so it doesn't have some facilities like logging, client filtering or such like. -Version: 0.7.0.1 +Version: 0.7.0.2 License: PublicDomain License-File: COPYING Author: PHO Maintainer: PHO Stability: experimental Homepage: http://cielonegro.org/Lucu.html +Bug-Reports: http://static.cielonegro.org/ditz/Lucu/ Category: Network Tested-With: GHC == 7.0.3 Cabal-Version: >= 1.6 @@ -34,8 +35,8 @@ examples/small-file.txt Source-Repository head - Type: darcs - Location: http://darcs.cielonegro.org/Lucu/ + Type: git + Location: git://git.cielonegro.org/Lucu.git Flag build-lucu-implant-file Description: Build the lucu-implant-file program. @@ -43,22 +44,23 @@ Library Build-Depends: - HsOpenSSL == 0.10.*, - base == 4.3.*, - bytestring == 0.9.*, - containers == 0.4.*, - dataenc == 0.14.*, - filepath == 1.2.*, - directory == 1.1.*, - haskell-src == 1.0.*, - hxt == 9.1.*, - mtl == 2.0.*, - network == 2.3.*, - stm == 2.2.*, - time == 1.2.*, - time-http == 0.1.*, - unix == 2.4.*, - zlib == 0.5.* + HsOpenSSL == 0.10.*, + base == 4.3.*, + base-unicode-symbols == 0.2.*, + base64-bytestring == 0.1.*, + bytestring == 0.9.*, + containers == 0.4.*, + filepath == 1.2.*, + directory == 1.1.*, + haskell-src == 1.0.*, + hxt == 9.1.*, + mtl == 2.0.*, + network == 2.3.*, + stm == 2.2.*, + time == 1.2.*, + time-http == 0.1.*, + unix == 2.4.*, + zlib == 0.5.* Exposed-Modules: Network.HTTP.Lucu @@ -95,15 +97,6 @@ Network.HTTP.Lucu.ResponseWriter Network.HTTP.Lucu.SocketLike - Extensions: - BangPatterns - DeriveDataTypeable - FlexibleContexts - FlexibleInstances - ScopedTypeVariables - TypeFamilies - UnboxedTuples - ghc-options: -Wall -funbox-strict-fields @@ -115,11 +108,6 @@ Buildable: False Main-Is: ImplantFile.hs - - Extensions: - BangPatterns - ScopedTypeVariables - UnboxedTuples ghc-options: -Wall diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,3 +1,8 @@ +Changes from 0.7.0.1 to 0.7.0.2 +------------------------------- +* Lucu now uses base64-bytestring instead of dataenc. + + Changes from 0.7 to 0.7.0.1 --------------------------- * Fixed build failure on recent GHC and other libraries. diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs --- a/Network/HTTP/Lucu/Abortion.hs +++ b/Network/HTTP/Lucu/Abortion.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + DeriveDataTypeable + , UnicodeSyntax + #-} {-# OPTIONS_HADDOCK prune #-} -- |Aborting the computation of 'Network.HTTP.Lucu.Resource.Resource' @@ -18,7 +22,7 @@ import Control.Exception import Control.Monad.Trans import qualified Data.ByteString.Char8 as C8 -import Data.Dynamic +import Data.Typeable import GHC.Conc (unsafeIOToSTM) import Network.HTTP.Lucu.Config import Network.HTTP.Lucu.DefaultPage diff --git a/Network/HTTP/Lucu/Authorization.hs b/Network/HTTP/Lucu/Authorization.hs --- a/Network/HTTP/Lucu/Authorization.hs +++ b/Network/HTTP/Lucu/Authorization.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE + UnicodeSyntax + #-} {-# OPTIONS_HADDOCK prune #-} -- |Manipulation of WWW authorization. @@ -11,12 +14,12 @@ , authCredentialP -- private ) where - -import qualified Codec.Binary.Base64 as B64 -import Data.Maybe -import Network.HTTP.Lucu.Parser -import Network.HTTP.Lucu.Parser.Http -import Network.HTTP.Lucu.Utils +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Char8 as C8 +import Network.HTTP.Lucu.Parser +import Network.HTTP.Lucu.Parser.Http +import Network.HTTP.Lucu.Utils +import Prelude.Unicode -- |Authorization challenge to be sent to client with -- \"WWW-Authenticate\" header. See @@ -26,7 +29,7 @@ deriving (Eq) -- |'Realm' is just a string which must not contain any non-ASCII letters. -type Realm = String +type Realm = String -- |Authorization credential to be sent by client with -- \"Authorization\" header. See @@ -43,25 +46,26 @@ -- letters. type Password = String - instance Show AuthChallenge where show (BasicAuthChallenge realm) - = "Basic realm=" ++ quoteStr realm - + = "Basic realm=" ⧺ quoteStr realm -authCredentialP :: Parser AuthCredential -authCredentialP = allowEOF $! - do _ <- string "Basic" - _ <- many1 lws - b64 <- many1 - $ satisfy (\ c -> (c >= 'a' && c <= 'z') || - (c >= 'A' && c <= 'Z') || - (c >= '0' && c <= '9') || - c == '+' || - c == '/' || - c == '=') - let decoded = map (toEnum . fromEnum) (fromJust $ B64.decode b64) - case break (== ':') decoded of - (uid, ':' : password) - -> return (BasicAuthCredential uid password) - _ -> failP +authCredentialP ∷ Parser AuthCredential +authCredentialP + = allowEOF $! + do _ ← string "Basic" + _ ← many1 lws + b64 ← many1 + $ satisfy (\c → (c ≥ 'a' ∧ c ≤ 'z') ∨ + (c ≥ 'A' ∧ c ≤ 'Z') ∨ + (c ≥ '0' ∧ c ≤ '9') ∨ + c ≡ '+' ∨ + c ≡ '/' ∨ + c ≡ '=') + case break (≡ ':') (decode b64) of + (uid, ':' : password) + → return (BasicAuthCredential uid password) + _ → failP + where + decode ∷ String → String + decode = C8.unpack ∘ B64.decodeLenient ∘ C8.pack diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs --- a/Network/HTTP/Lucu/DefaultPage.hs +++ b/Network/HTTP/Lucu/DefaultPage.hs @@ -1,3 +1,8 @@ +{-# LANGUAGE + BangPatterns + , UnboxedTuples + , UnicodeSyntax + #-} module Network.HTTP.Lucu.DefaultPage ( getDefaultPage , writeDefaultPage diff --git a/Network/HTTP/Lucu/HttpVersion.hs b/Network/HTTP/Lucu/HttpVersion.hs --- a/Network/HTTP/Lucu/HttpVersion.hs +++ b/Network/HTTP/Lucu/HttpVersion.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + BangPatterns + , UnicodeSyntax + #-} {-# OPTIONS_HADDOCK prune #-} -- |Manipulation of HTTP version string. diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs --- a/Network/HTTP/Lucu/Interaction.hs +++ b/Network/HTTP/Lucu/Interaction.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + BangPatterns + , UnicodeSyntax + #-} module Network.HTTP.Lucu.Interaction ( Interaction(..) , InteractionState(..) diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs --- a/Network/HTTP/Lucu/MIMEType.hs +++ b/Network/HTTP/Lucu/MIMEType.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + UnboxedTuples + , UnicodeSyntax + #-} {-# OPTIONS_HADDOCK prune #-} -- |Manipulation of MIME Types. diff --git a/Network/HTTP/Lucu/MIMEType/Guess.hs b/Network/HTTP/Lucu/MIMEType/Guess.hs --- a/Network/HTTP/Lucu/MIMEType/Guess.hs +++ b/Network/HTTP/Lucu/MIMEType/Guess.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + UnboxedTuples + , UnicodeSyntax + #-} -- |MIME Type guessing by a file extension. This is a poor man's way -- of guessing MIME Types. It is simple and fast. -- diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs --- a/Network/HTTP/Lucu/MultipartForm.hs +++ b/Network/HTTP/Lucu/MultipartForm.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + UnboxedTuples + , UnicodeSyntax + #-} module Network.HTTP.Lucu.MultipartForm ( FormData(..) , multipartFormP diff --git a/Network/HTTP/Lucu/Parser.hs b/Network/HTTP/Lucu/Parser.hs --- a/Network/HTTP/Lucu/Parser.hs +++ b/Network/HTTP/Lucu/Parser.hs @@ -1,3 +1,9 @@ +{-# LANGUAGE + BangPatterns + , ScopedTypeVariables + , UnboxedTuples + , UnicodeSyntax + #-} -- |Yet another parser combinator. This is mostly a subset of -- "Text.ParserCombinators.Parsec" but there are some differences: -- diff --git a/Network/HTTP/Lucu/Parser/Http.hs b/Network/HTTP/Lucu/Parser/Http.hs --- a/Network/HTTP/Lucu/Parser/Http.hs +++ b/Network/HTTP/Lucu/Parser/Http.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + BangPatterns + , UnicodeSyntax + #-} -- |This is an auxiliary parser utilities for parsing things related -- on HTTP protocol. -- diff --git a/Network/HTTP/Lucu/Postprocess.hs b/Network/HTTP/Lucu/Postprocess.hs --- a/Network/HTTP/Lucu/Postprocess.hs +++ b/Network/HTTP/Lucu/Postprocess.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + BangPatterns + , UnicodeSyntax + #-} module Network.HTTP.Lucu.Postprocess ( postprocess , completeUnconditionalHeaders diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs --- a/Network/HTTP/Lucu/RequestReader.hs +++ b/Network/HTTP/Lucu/RequestReader.hs @@ -1,3 +1,8 @@ +{-# LANGUAGE + BangPatterns + , UnboxedTuples + , UnicodeSyntax + #-} module Network.HTTP.Lucu.RequestReader ( requestReader ) @@ -26,7 +31,6 @@ import Network.HTTP.Lucu.Resource.Tree import Prelude hiding (catch) import System.IO (stderr) - requestReader :: HandleLike h => Config -> ResTree -> [FallbackHandler] -> h -> PortNumber -> SockAddr -> InteractionQueue -> IO () requestReader !cnf !tree !fbs !h !port !addr !tQueue diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + UnboxedTuples + , UnicodeSyntax + #-} {-# OPTIONS_HADDOCK prune #-} -- |This is the Resource Monad; monadic actions to define the behavior diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs --- a/Network/HTTP/Lucu/Response.hs +++ b/Network/HTTP/Lucu/Response.hs @@ -1,3 +1,8 @@ +{-# LANGUAGE + DeriveDataTypeable + , UnboxedTuples + , UnicodeSyntax + #-} {-# OPTIONS_HADDOCK prune #-} -- |Definition of things related on HTTP response. @@ -17,7 +22,7 @@ import qualified Data.ByteString as Strict (ByteString) import qualified Data.ByteString.Char8 as C8 hiding (ByteString) -import Data.Dynamic +import Data.Typeable import Network.HTTP.Lucu.Format import Network.HTTP.Lucu.HandleLike import Network.HTTP.Lucu.Headers diff --git a/Network/HTTP/Lucu/ResponseWriter.hs b/Network/HTTP/Lucu/ResponseWriter.hs --- a/Network/HTTP/Lucu/ResponseWriter.hs +++ b/Network/HTTP/Lucu/ResponseWriter.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + BangPatterns + , UnicodeSyntax + #-} module Network.HTTP.Lucu.ResponseWriter ( responseWriter ) diff --git a/Network/HTTP/Lucu/SocketLike.hs b/Network/HTTP/Lucu/SocketLike.hs --- a/Network/HTTP/Lucu/SocketLike.hs +++ b/Network/HTTP/Lucu/SocketLike.hs @@ -1,3 +1,9 @@ +{-# LANGUAGE + FlexibleContexts + , FlexibleInstances + , TypeFamilies + , UnicodeSyntax + #-} module Network.HTTP.Lucu.SocketLike ( SocketLike(..) ) diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs --- a/Network/HTTP/Lucu/StaticFile.hs +++ b/Network/HTTP/Lucu/StaticFile.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + BangPatterns + , UnicodeSyntax + #-} -- | Handling static files on the filesystem. module Network.HTTP.Lucu.StaticFile ( staticFile diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs --- a/Network/HTTP/Lucu/Utils.hs +++ b/Network/HTTP/Lucu/Utils.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + BangPatterns + , UnicodeSyntax + #-} -- |Utility functions used internally in the Lucu httpd. These -- functions may be useful too for something else. module Network.HTTP.Lucu.Utils diff --git a/examples/Makefile b/examples/Makefile --- a/examples/Makefile +++ b/examples/Makefile @@ -16,7 +16,7 @@ ./HelloWorld clean: - rm -f $(TARGETS) *.hi *.o + rm -f $(TARGETS) *.hi *.o MiseRafturai.hs SmallFile.hs MiseRafturai.hs: mise-rafturai.html lucu-implant-file -m MiseRafturai -o $@ $<