base-unicode-symbols == 0.2.*,
base64-bytestring == 0.1.*,
blaze-builder == 0.3.*,
- blaze-textual == 0.2.*,
bytestring == 0.9.*,
containers == 0.4.*,
containers-unicode-symbols == 0.3.*,
+ directory == 1.1.*,
filepath == 1.2.*,
hxt == 9.1.*,
mtl == 2.0.*,
network == 2.3.*,
+ old-time == 1.0.*,
stm == 2.2.*,
stringsearch == 0.3.*,
template-haskell == 2.5.*,
text == 0.11.*,
time == 1.2.*,
time-http == 0.2.*,
- transformers == 0.2.*,
- unix == 2.4.*
+ transformers == 0.2.*
Exposed-Modules:
Network.HTTP.Lucu
import Network.HTTP.Lucu.Resource.Tree
import Network.HTTP.Lucu.ResponseWriter
import Network.HTTP.Lucu.SocketLike as SL
-import System.Posix.Signals
-- |This is the entry point of Lucu httpd. It listens to a socket and
-- waits for clients. 'runHttpd' never stops by itself so the only way
-- to stop it is to raise an exception in the thread running it.
--
--- Note that 'runHttpd' automatically makes SIGPIPE be ignored by
--- calling @'installHandler' 'sigPIPE' 'Ignore' 'Nothing'@. This can
--- hardly cause a problem though.
---
-- Example:
--
-- > {-# LANGUAGE OverloadedStrings #-}
runHttpd ∷ Config → ResTree → [FallbackHandler] → IO ()
runHttpd cnf tree fbs
= withSocketsDo $
- do void $ installHandler sigPIPE Ignore Nothing
- let launchers
+ do let launchers
= catMaybes
[ do scnf ← cnfSSLConfig cnf
addr ← cnfServerV4Addr cnf
import Data.Digest.Pure.SHA
import Data.Maybe
import Data.Time
-import Data.Time.Clock.POSIX
import Network.HTTP.Lucu.ETag
import Network.HTTP.Lucu.MIMEType hiding (mimeType)
import Network.HTTP.Lucu.MIMEType.DefaultExtensionMap
import Network.HTTP.Lucu.MIMEType.Guess
import Network.HTTP.Lucu.MIMEType.TH
+import Network.HTTP.Lucu.Utils
import Prelude.Unicode
-import System.Posix.Files
data Input
= Input {
lastModified ∷ FilePath → IO UTCTime
lastModified "-" = getCurrentTime
-lastModified fpath = ( posixSecondsToUTCTime
- ∘ fromRational
- ∘ toRational
- ∘ modificationTime
- )
- <$>
- getFileStatus fpath
+lastModified fpath = getLastModified fpath
openInputFile ∷ FilePath → IO L.ByteString
openInputFile "-" = L.getContents
when (method ≡ POST)
$ abort
$ mkAbortion' InternalServerError
- "Illegal computation of foundTimeStamp for POST request."
+ "Illegal call of foundTimeStamp for POST request."
let statusForIfModSince
= if method ≡ GET ∨ method ≡ HEAD then
else
fromStatusCode PreconditionFailed
- -- If-Modified-Since があればそれを見る。
ifModSince ← getHeader "If-Modified-Since"
case ifModSince of
Just str → case HTTP.fromAscii str of
$ abort
$ mkAbortion' statusForIfModSince
$ "The entity has not been modified since " ⊕ A.toText str
- Left _
- → return () -- 不正な時刻は無視
+ Left e
+ → abort $ mkAbortion' BadRequest
+ $ "Malformed If-Modified-Since: " ⊕ T.pack e
Nothing → return ()
- -- If-Unmodified-Since があればそれを見る。
ifUnmodSince ← getHeader "If-Unmodified-Since"
case ifUnmodSince of
Just str → case HTTP.fromAscii str of
$ abort
$ mkAbortion' PreconditionFailed
$ "The entity has not been modified since " ⊕ A.toText str
- Left _
- → return () -- 不正な時刻は無視
+ Left e
+ → abort $ mkAbortion' BadRequest
+ $ "Malformed If-Unmodified-Since: " ⊕ T.pack e
Nothing → return ()
driftTo ReceivingBody
module Network.HTTP.Lucu.StaticFile
( staticFile
, staticDir
-
- , generateETagFromFile
)
where
-import qualified Blaze.ByteString.Builder.ByteString as BB
-import qualified Blaze.Text.Int as BT
import Control.Monad
import Control.Monad.Unicode
import Control.Monad.Trans
-import qualified Data.Ascii as A
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy.Char8 as LBS
-import Data.Monoid.Unicode
import Data.String
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
-import Data.Time.Clock.POSIX
import Network.HTTP.Lucu.Abortion
import Network.HTTP.Lucu.Config
-import Network.HTTP.Lucu.ETag
import Network.HTTP.Lucu.MIMEType hiding (mimeType)
import Network.HTTP.Lucu.MIMEType.Guess
import Network.HTTP.Lucu.MIMEType.TH
import Network.HTTP.Lucu.Resource
import Network.HTTP.Lucu.Resource.Internal
import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Utils
import Prelude.Unicode
+import System.Directory
import System.FilePath
-import System.Posix.Files
-- | @'staticFile' fpath@ is a 'ResourceDef' which serves the file at
-- @fpath@ on the filesystem.
handleStaticFile ∷ Bool → FilePath → Resource ()
handleStaticFile sendContent path
- = do exists ← liftIO $ fileExist path
+ = do exists ← liftIO $ doesFileExist path
unless exists
foundNoEntity'
- readable ← liftIO $ fileAccess path True False False
- unless readable
- $ abort
- $ mkAbortion Forbidden [] Nothing
-
- stat ← liftIO $ getFileStatus path
- when (isDirectory stat)
+ perms ← liftIO $ getPermissions path
+ unless (readable perms)
$ abort
$ mkAbortion Forbidden [] Nothing
- -- FIXME: Forget about ETags of a static file.
- tag ← liftIO $ generateETagFromFile path
- let lastMod = posixSecondsToUTCTime
- $ fromRational
- $ toRational
- $ modificationTime stat
- foundEntity tag lastMod
+ lastMod ← liftIO $ getLastModified path
+ foundTimeStamp lastMod
conf ← getConfig
case guessTypeByFileName (cnfExtToMIMEType conf) path of
when sendContent
$ liftIO (LBS.readFile path) ≫= putChunks
--- |@'generateETagFromFile' fpath@ generates a strong entity tag from
--- a file. The file doesn't necessarily have to be a regular file; it
--- may be a FIFO or a device file. The tag is made of inode ID, size
--- and modification time.
---
--- Note that the tag is not strictly strong because the file could be
--- modified twice at a second without changing inode ID or size, but
--- it's not really possible to generate a strictly strong ETag from a
--- file as we don't want to simply grab the entire file and use it as
--- an ETag. It is indeed possible to hash it with SHA-1 or MD5 to
--- increase strictness, but it's too inefficient if the file is really
--- large (say, 1 TiB).
-generateETagFromFile ∷ FilePath → IO ETag
-generateETagFromFile path
- = do stat ← getFileStatus path
- let inode = fileID stat
- size = fileSize stat
- lastMod = fromEnum $ modificationTime stat
- tag = A.fromAsciiBuilder
- $ A.unsafeFromBuilder
- $ BT.integral inode
- ⊕ BB.fromByteString "-"
- ⊕ BT.integral size
- ⊕ BB.fromByteString "-"
- ⊕ BT.integral lastMod
- return $ strongETag tag
-
-- | @'staticDir' dir@ is a 'ResourceDef' which maps all files in
-- @dir@ and its subdirectories on the filesystem to the
-- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
, parseWWWFormURLEncoded
, splitPathInfo
, trim
+
+ , getLastModified
+
, liftByteString
, liftLazyByteString
, liftAscii
, liftUTCTime
)
where
+import Control.Applicative
import Control.Monad
import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
import qualified Data.Ascii as A
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time
+import Data.Time.Clock.POSIX
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Syntax
import Network.URI
import Prelude hiding (last)
import Prelude.Unicode
+import System.Directory
+import System.Time (ClockTime(..))
-- |>>> splitBy (== ':') "ab:c:def"
-- ["ab", "c", "def"]
where
f = dropWhile isSpace
+-- |Get the modification time of a given file.
+getLastModified ∷ FilePath → IO UTCTime
+getLastModified = (clockTimeToUTC <$>) ∘ getModificationTime
+ where
+ clockTimeToUTC ∷ ClockTime → UTCTime
+ clockTimeToUTC (TOD sec picoSec)
+ = posixSecondsToUTCTime
+ $ fromRational
+ $ sec % 1 + picoSec % (1000 ⋅ 1000 ⋅ 1000 ⋅ 1000)
+
-- |Convert a 'ByteString' to an 'Exp' representing it as a literal.
liftByteString ∷ ByteString → Q Exp
liftByteString bs
component: Lucu
release: Lucu-1.0
reporter: PHO <pho@cielonegro.org>
-status: :unstarted
-disposition:
+status: :closed
+disposition: :fixed
creation_time: 2011-10-26 23:18:42.168974 Z
references: []
- PHO <pho@cielonegro.org>
- edited title, description
- ""
+- - 2011-11-12 08:01:44.320957 Z
+ - PHO <pho@cielonegro.org>
+ - changed status from unstarted to in_progress
+ - ""
+- - 2011-11-12 09:10:32.315822 Z
+ - PHO <pho@cielonegro.org>
+ - closed with disposition fixed
+ - Done.
git_branch:
projects / Lucu.git / commitdiff