Lucu 0.7.0.1 → 0.7.0.2
raw patch · 22 files changed
+168/−97 lines, 22 filesdep +base-unicode-symbolsdep +base64-bytestringdep −dataencPVP ok
version bump matches the API change (PVP)
Dependencies added: base-unicode-symbols, base64-bytestring
Dependencies removed: dataenc
API changes (from Hackage documentation)
Files
- ImplantFile.hs +34/−34
- Lucu.cabal +21/−33
- NEWS +5/−0
- Network/HTTP/Lucu/Abortion.hs +5/−1
- Network/HTTP/Lucu/Authorization.hs +30/−26
- Network/HTTP/Lucu/DefaultPage.hs +5/−0
- Network/HTTP/Lucu/HttpVersion.hs +4/−0
- Network/HTTP/Lucu/Interaction.hs +4/−0
- Network/HTTP/Lucu/MIMEType.hs +4/−0
- Network/HTTP/Lucu/MIMEType/Guess.hs +4/−0
- Network/HTTP/Lucu/MultipartForm.hs +4/−0
- Network/HTTP/Lucu/Parser.hs +6/−0
- Network/HTTP/Lucu/Parser/Http.hs +4/−0
- Network/HTTP/Lucu/Postprocess.hs +4/−0
- Network/HTTP/Lucu/RequestReader.hs +5/−1
- Network/HTTP/Lucu/Resource.hs +4/−0
- Network/HTTP/Lucu/Response.hs +6/−1
- Network/HTTP/Lucu/ResponseWriter.hs +4/−0
- Network/HTTP/Lucu/SocketLike.hs +6/−0
- Network/HTTP/Lucu/StaticFile.hs +4/−0
- Network/HTTP/Lucu/Utils.hs +4/−0
- examples/Makefile +1/−1
ImplantFile.hs view
@@ -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...")] ------------------------------------------------------------------------------ -}
Lucu.cabal view
@@ -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 <pho at cielonegro dot org> Maintainer: PHO <pho at cielonegro dot org> 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
NEWS view
@@ -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.
Network/HTTP/Lucu/Abortion.hs view
@@ -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
Network/HTTP/Lucu/Authorization.hs view
@@ -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
Network/HTTP/Lucu/DefaultPage.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE+ BangPatterns+ , UnboxedTuples+ , UnicodeSyntax+ #-} module Network.HTTP.Lucu.DefaultPage ( getDefaultPage , writeDefaultPage
Network/HTTP/Lucu/HttpVersion.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE+ BangPatterns+ , UnicodeSyntax+ #-} {-# OPTIONS_HADDOCK prune #-} -- |Manipulation of HTTP version string.
Network/HTTP/Lucu/Interaction.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE+ BangPatterns+ , UnicodeSyntax+ #-} module Network.HTTP.Lucu.Interaction ( Interaction(..) , InteractionState(..)
Network/HTTP/Lucu/MIMEType.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE+ UnboxedTuples+ , UnicodeSyntax+ #-} {-# OPTIONS_HADDOCK prune #-} -- |Manipulation of MIME Types.
Network/HTTP/Lucu/MIMEType/Guess.hs view
@@ -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. --
Network/HTTP/Lucu/MultipartForm.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE+ UnboxedTuples+ , UnicodeSyntax+ #-} module Network.HTTP.Lucu.MultipartForm ( FormData(..) , multipartFormP
Network/HTTP/Lucu/Parser.hs view
@@ -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: --
Network/HTTP/Lucu/Parser/Http.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE+ BangPatterns+ , UnicodeSyntax+ #-} -- |This is an auxiliary parser utilities for parsing things related -- on HTTP protocol. --
Network/HTTP/Lucu/Postprocess.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE+ BangPatterns+ , UnicodeSyntax+ #-} module Network.HTTP.Lucu.Postprocess ( postprocess , completeUnconditionalHeaders
Network/HTTP/Lucu/RequestReader.hs view
@@ -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
Network/HTTP/Lucu/Resource.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE+ UnboxedTuples+ , UnicodeSyntax+ #-} {-# OPTIONS_HADDOCK prune #-} -- |This is the Resource Monad; monadic actions to define the behavior
Network/HTTP/Lucu/Response.hs view
@@ -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
Network/HTTP/Lucu/ResponseWriter.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE+ BangPatterns+ , UnicodeSyntax+ #-} module Network.HTTP.Lucu.ResponseWriter ( responseWriter )
Network/HTTP/Lucu/SocketLike.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE+ FlexibleContexts+ , FlexibleInstances+ , TypeFamilies+ , UnicodeSyntax+ #-} module Network.HTTP.Lucu.SocketLike ( SocketLike(..) )
Network/HTTP/Lucu/StaticFile.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE+ BangPatterns+ , UnicodeSyntax+ #-} -- | Handling static files on the filesystem. module Network.HTTP.Lucu.StaticFile ( staticFile
Network/HTTP/Lucu/Utils.hs view
@@ -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
examples/Makefile view
@@ -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 $@ $<