Network/HTTP/Lucu/StaticFile.hs

   1 -- | Handling static files on the filesystem.
   2 module Network.HTTP.Lucu.StaticFile
   3     ( staticFile
   4     , handleStaticFile
   5
   6     , staticDir
   7     , handleStaticDir
   8
   9     , generateETagFromFile
  10     )
  11     where
  12
  13 import           Control.Monad
  14 import           Control.Monad.Trans
  15 import qualified Data.ByteString.Lazy.Char8 as B
  16 import           Data.ByteString.Lazy.Char8 (ByteString)
  17 import           Network.HTTP.Lucu.Abortion
  18 import           Network.HTTP.Lucu.Config
  19 import           Network.HTTP.Lucu.ETag
  20 import           Network.HTTP.Lucu.MIMEType.Guess
  21 import           Network.HTTP.Lucu.Resource
  22 import           Network.HTTP.Lucu.Resource.Tree
  23 import           Network.HTTP.Lucu.Response
  24 import           Network.HTTP.Lucu.Utils
  25 import           System.Directory
  26 import           System.Posix.Files
  27 import           Text.Printf
  28
  29
  30 -- | @'staticFile' fpath@ is a
  31 -- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' which serves the file
  32 -- at @fpath@ on the filesystem.
  33 staticFile :: FilePath -> ResourceDef
  34 staticFile path
  35     = ResourceDef {
  36         resUsesNativeThread = False
  37       , resIsGreedy         = False
  38       , resGet              = Just $ handleStaticFile path
  39       , resHead             = Nothing
  40       , resPost             = Nothing
  41       , resPut              = Nothing
  42       , resDelete           = Nothing
  43       }
  44
  45 -- | Computation of @'handleStaticFile' fpath@ serves the file at
  46 -- @fpath@ on the filesystem. The
  47 -- 'Network.HTTP.Lucu.Resource.Resource' must be in the /Examining
  48 -- Request/ state before the computation. It will be in the /Done/
  49 -- state after the computation.
  50 --
  51 -- If you just want to place a static file on the
  52 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree', you had better use
  53 -- 'staticFile' instead of this.
  54 handleStaticFile :: FilePath -> Resource ()
  55 handleStaticFile path
  56     = do isFile <- liftIO $ doesFileExist path
  57          if isFile then
  58              -- 存在はした。讀めるかどうかは知らない。
  59              do readable <- liftIO $ fileAccess path True False False
  60                 unless readable
  61                            -- 讀めない
  62                            $ abort Forbidden [] Nothing
  63
  64                 -- 讀める
  65                 tag      <- liftIO $ generateETagFromFile path
  66                 lastMod  <- liftIO $ getModificationTime path
  67                 foundEntity tag lastMod
  68
  69                 -- MIME Type を推定
  70                 conf <- getConfig
  71                 case guessTypeByFileName (cnfExtToMIMEType conf) path of
  72                   Nothing   -> return ()
  73                   Just mime -> setContentType mime
  74
  75                 -- 實際にファイルを讀んで送る
  76                 (liftIO $ B.readFile path) >>= outputBS
  77            else
  78              do isDir <- liftIO $ doesDirectoryExist path
  79                 if isDir then
  80                     abort Forbidden [] Nothing
  81                   else
  82                     foundNoEntity Nothing
  83
  84 -- |Computation of @'generateETagFromFile' fpath@ generates a strong
  85 -- entity tag from a file. The file doesn't necessarily have to be a
  86 -- regular file; it may be a FIFO or a device file. The tag is made of
  87 -- inode ID, size and modification time.
  88 --
  89 -- Note that the tag is not strictly strong because the file could be
  90 -- modified twice at a second without changing inode ID or size, but
  91 -- it's not really possible to generate a strict strong ETag from a
  92 -- file since we don't want to simply grab the entire file and use it
  93 -- as an ETag. It is indeed possible to hash it with SHA-1 or MD5 to
  94 -- increase strictness, but it's too inefficient if the file is really
  95 -- large (say, 1 TiB).
  96 generateETagFromFile :: FilePath -> IO ETag
  97 generateETagFromFile path
  98     = do stat <- getFileStatus path
  99          let inode   = fromEnum $ fileID   stat
 100              size    = fromEnum $ fileSize stat
 101              lastmod = fromEnum $ modificationTime stat
 102          return $ strongETag $ printf "%x-%x-%x" inode size lastmod
 103
 104 -- | @'staticDir' dir@ is a
 105 -- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' which maps all files
 106 -- in @dir@ and its subdirectories on the filesystem to the
 107 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
 108 staticDir :: FilePath -> ResourceDef
 109 staticDir path
 110     = ResourceDef {
 111         resUsesNativeThread = False
 112       , resIsGreedy         = True
 113       , resGet              = Just $ handleStaticDir path
 114       , resHead             = Nothing
 115       , resPost             = Nothing
 116       , resPut              = Nothing
 117       , resDelete           = Nothing
 118       }
 119
 120 -- | Computation of @'handleStaticDir' dir@ maps all files in @dir@
 121 -- and its subdirectories on the filesystem to the
 122 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'. The
 123 -- 'Network.HTTP.Lucu.Resource.Resource' must be in the /Examining
 124 -- Request/ state before the computation. It will be in the /Done/
 125 -- state after the computation.
 126 --
 127 -- If you just want to place a static directory tree on the
 128 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree', you had better use
 129 -- 'staticDir' instead of this.
 130 handleStaticDir :: FilePath -> Resource ()
 131 handleStaticDir basePath
 132     = do extraPath <- getPathInfo
 133          securityCheck extraPath
 134          let path = basePath ++ "/" ++ joinWith "/" extraPath
 135
 136          handleStaticFile path
 137     where
 138       securityCheck :: Monad m => [String] -> m ()
 139       securityCheck pathElems
 140           = when (any (== "..") pathElems) $ fail ("security error: "
 141                                                    ++ joinWith "/" pathElems)