Network/HTTP/Lucu/StaticFile.hs

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