ファイルの種別判定にはlibmagic使おう

ファイルの種類を判定する

ファイルの種類を判定するのに拡張子から判定するやり方だと、ちょっと乱暴な感じがしたので調べてみた。
思い浮かぶのがmagicぐらいしかないので、素直にやってみた。

fileコマンドが使っているライブラリ

多分fileコマンドのパッケージと一緒に入るライブラリにlibmagicっていうのがあって、これがmagicデータベースからファイル種別を判定してくれる。

gentooだとここにあるよ

cuomo@ugui7 ~ $ file /usr/share/misc/magic.mgc
/usr/share/misc/magic.mgc: magic binary file for file(1) cmd (version 14) (little endian)

haskellで書いてみた

haskell-magicをいれる

ugui7 ~ # emerge dev-haskell/magic

コードから使ってみる

import Magic
import Control.Monad (forM_)

main :: IO ()
main = do
  magic <- magicOpen []
  magicLoadDefault magic
  forM_ fileList $ \path -> do
    magicFile magic path >>= putStrLn

fileList :: [String]
fileList = [
      "mishimahs2_original.jpg"
    , "ero_dehanai.wmv"
    , "jp106.map.gz" ]

cuomo@ugui7 ~/Code/haskell/magic $ runhaskell FileMagic.hs
JPEG image data, JFIF standard 1.01, resolution (DPI), density 100x100, segment length 16, baseline, precision 8, 624x468, frames 3
Microsoft ASF
gzip compressed data, max compression, from Unix
cuomo@ugui7 ~/Code/haskell/magic $

fileコマンドと同じ出力をとれる
ちなみに、magicOpen関数の引数にMagicMimeTypeを設定すると

image/jpeg
video/x-ms-asf
application/x-gzip

ちゃんとmimeがとれる、その他指定できるフラグは

data MagicFlag
  = MagicNone
  | MagicDebug
  | MagicSymlink
  | MagicCompress
  | MagicDevices
  | MagicMimeType
  | MagicMimeEncoding
  | MagicMime
  | MagicContinue
  | MagicCheck
  | MagicPreserveAtime
  | MagicRaw
  | MagicError
  | UnknownMagicFlag Int

があるます、おおむねfileコマンドのオプションに指定可能なものがフラグになっているぽい

ファイル種別でした...

Yesodでファイルアップロードサイズを調整する方法

Content Lengthで調整

Yesodで、デカいファイルをアップロードすると、エラーが発生する

POST /list/0
  Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
  Status: 413 Too Large 0.000029971s

ファイルのアップロードサイズというか、ContentLengthの調整で対応

設定ファイルからサイズを取れるようにする

* config/settings.ymlに追加

# Content Length Max MB
max-byte: 50

* src/Settings.hs

data AppSettings = AppSettings
...
    , appMaxByte                :: Word64
    -- ^ Content Length Max MB
...

FromJSONのインスタンス設定も修正

instance FromJSON AppSettings where
    parseJSON = withObject "AppSettings" $ \o -> do
        let defaultDev =
...
...
  appMaxByte <- o .:  "max-byte"
..

maximumContentLength関数を実装する

設定を取得してその値を元に、ContentLengthの上限を設定する

instance Yesod App where
...
...
    -- Content Length Max
    maximumContentLength app _ = do
        let size = appMaxByte $ appSettings app
        return $ size * 1024 * 1024 -- MB
...

これでデカいのがあがるようになる

YesodのURLパラメータ

URLのパラメータ変換

URLのパラメータの扱いについて調べてみた

config/routes

/list/#Int ListR GET POST

こう書くと、URLのパラメータに数字が使える、それ以外は「404エラー」、ちょっと注意が必要で、「0087」みたいなパラメータも受け付けるので、これはプログラム側のバリデーション等で対応が必要

基本的な型は、PathPieceクラスのインスタンスなっているので、そのままURLに使えて変換してくれる

それ以外の型をURLパラメータに利用する

適当な場所に、型を定義してPathPieceのインスタンスにする

import qualified Text.Read as R

newtype DirId = DirId Int deriving(Show, Read, Eq)

instance PathPiece DirId where
  toPathPiece (DirId n) = pack $ show n
  fromPathPiece n = case R.reads $ unpack n of
    (p, ""):_
      | p < 1 -> Nothing
      | otherwise -> Just $ DirId p
    _ -> Nothing

toPathPiece関数は特定の型をTextへ変換してURLで利用できるようにし、fromPathPiece関数はその逆。

そしてhandlerで

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Handler.DirList where

import Import

getDirListR :: DirId -> Handler Html
getDirListR (DirId n) = defaultLayout $ do
    setTitle "Routing test"
    $(widgetFile "did")

テンプレート

<div .container>
    <div .bs-docs-section>
        <div .row>
            <div .col-lg-12>
                <div .page-header>
                    <h1 #start>DirID Test
                    <p>n = #{show n}

こんな感じで、できまする、昨晩の宴で呼吸が苦しい...

最近、うまいと思ったビール

色々飲むけどやっぱり一番搾りがうまい

ふつうにうまい、ふるーてぃー、魚で言う、アジの刺身てきな存在。

今日もやるか...

YesodのセッションストレージをRedisにする

SessionのBackendをRedisにする

Yesodでディフォルトのセッションストレージはファイルになっているので、そのBackendをRedisにする。

今回使用したライブラリは

• lts-9.10をベースに作成
• serversession-frontend-yesod
• serversession-backend-redis
• hedis
• hedis-config

セイッ

サンプルコード

さんぷるはここへおいときます

https://github.com/calimakvo/sessredis.git

Redisへの接続設定を作成

かいつまんで...

* config/settings.yml

当な場所へ追加、環境変数も利用可能

redis:
  host:      "_env:REDIS_HOST:localhost"          # host name or address
  port:      "_env:REDIS_PORT:6379"               # you can specify either port
  # socket: /run/redis.socket                     # or unix socket path
  # service: redis                                # or service name
  password:   "_env:REDIS_PASSWORD:"              # if not specified then no password used
  database:   "_env:REDIS_DATABASE:0"             # database number to connect to
  max-connections: "_env:REDIS_MAX_CONNECTIONS:5" # max 5 connections in pool
  max-idle-time:   "_env:REDIS_MAX_IDLE_TIME:30"  # max 30 idle time in pool

* package.yaml dependenciesへ追加

dependencies:
..
..
- hedis
- hedis-config
- serversession-backend-redis
- serversession-frontend-yesod

* stack.yaml extra-depsへ追加

lts-9.10に入っていないパッケージをextra-depsへ追加

extra-deps:
  - hedis-config-0.0.3
  - serversession-backend-redis-1.0.2
...

ソースをイジる

* src/Settings.hs

import宣言と、RedisConfigの1行を追加、AppSettingsのFromJSONインスタンス宣言にfromYamlAppRedisConfを追加

..
import Database.Redis.Config (RedisConfig (..))
..
..
data AppSettings = AppSettings
    { appStaticDir              :: String
    -- ^ Directory from which to serve static files.
    , appDatabaseConf           :: MySQLConf
    -- ^ Configuration settings for accessing the database.
    , appRedisConf              :: RedisConfig
    -- ^ Configuration settings for accessing the redis.
    , appRoot                   :: Maybe Text
...
...
instance FromJSON AppSettings where
    parseJSON = withObject "AppSettings" $ \o -> do
        let defaultDev =
#ifdef DEVELOPMENT
                True
#else
                False
#endif
        appStaticDir              <- o .: "static-dir"
        fromYamlAppDatabaseConf   <- o .: "database"
        fromYamlAppRedisConf      <- o .: "redis"
        appRoot                   <- o .:? "approot"
        appHost                   <- fromString <$> o .: "host"
        appPort                   <- o .: "port"
...
...
        let appRedisConf = fromYamlAppRedisConf {                       
              getConnectInfo = getConnectInfo fromYamlAppRedisConf
            }                       

        appAuthDummyLogin         <- o .:? "auth-dummy-login"      .!= defaultDev

        return AppSettings {..}
...

* src/Foundation.hs
 
import宣言と、関数の宣言、makeSessionBackendの切り替え

...
import qualified Database.Redis as R
import Database.Redis.Config (RedisConfig (..))
import Web.ServerSession.Backend.Redis (RedisStorage(..))
import Web.ServerSession.Frontend.Yesod (setCookieName,
                                         setAbsoluteTimeout,
                                         setIdleTimeout,
                                         simpleBackend)
...
sessionCookieName :: Text
sessionCookieName = "SESSION"

redisStorage :: RedisConfig -> IO (RedisStorage sess)
redisStorage rc = do
  conn <- R.connect $ getConnectInfo rc
  return $ RedisStorage conn Nothing Nothing
..
..
instance Yesod App where
...
    makeSessionBackend app = do
        let redisConf = appRedisConf $ appSettings app
        simpleBackend opts =<< redisStorage redisConf    
            where opts = setIdleTimeout     (Just $  30 * 60)          -- 30  minutes
                       . setAbsoluteTimeout (Just $  2 * 60 * 60 * 24) -- 2 days minutes
                       . setCookieName      sessionCookieName
..

buildと実行

redisサーバーを起動しておいてね

sessredis $ sudo systemctl start redis

sessredis $ stack build && stack exec -- yesod devel

確認

ブラウザからログインして、redisの中をみてみる

karky7 ~ # redis-cli
127.0.0.1:6379> KEYS *
(empty list or set)
127.0.0.1:6379> KEYS *
1) "ssr:session:XSkbZBiMlMsw-yqCGJXNSIxF"
2) "ssr:authid:1"
127.0.0.1:6379>

はいってる

調査不足なところが、RedisStorageのidleTimeoutとabsoluteTimeoutが、simpleBackendのoptsで設定する、timeoutとabsoluteの設定にどう効いてくるのか調べてないとこ、今度しらべる...だれか教えて。

haskellはとにかくたのしい