module Ganeti.DataCollectors.Diagnose
( dcName
, dcCategory
, dcKind
, dcReport
) where
import Control.Monad.Trans.Class (lift)
import System.Directory (doesFileExist)
import System.FilePath.Posix (isValid, takeFileName, (</>))
import System.Posix.Files ( getFileStatus
, fileOwner
, fileGroup
, fileMode
, ownerModes
, groupReadMode
, groupExecuteMode
, otherReadMode
, otherExecuteMode
, intersectFileModes
, unionFileModes
, ownerExecuteMode
, isRegularFile
, regularFileMode
)
import System.Process (readProcess)
import Text.JSON (JSValue(..), toJSObject, toJSString, decode, Result(..))
import Ganeti.BasicTypes (runResultT, ResultT(..), genericResult)
import Ganeti.Confd.ClientFunctions (getDiagnoseCollectorFilename)
import Ganeti.Constants (dataCollectorDiagnose, dataCollectorDiagnoseDirectory)
import Ganeti.DataCollectors.Types ( DCCategory(..)
, DCKind(..)
, DCVersion(..)
, DCReport(..)
, buildReport
)
dcName :: String
dcName = dataCollectorDiagnose
dcCategory :: Maybe DCCategory
dcCategory = Just DCNode
dcKind :: DCKind
dcKind = DCKStatus
dcVersion :: DCVersion
dcVersion = DCVerBuiltin
dcFormatVersion :: Int
dcFormatVersion = 1
okWithDetails :: String -> JSValue
okWithDetails details = JSObject $ toJSObject
[ ("status", JSString $ toJSString "Ok")
, ("details", JSString $ toJSString details)
]
fnToVal :: String -> IO JSValue
fnToVal fn
| null fn = return $ okWithDetails
"No file specified for diagnose data collector"
| not $ isValid fn = return $ okWithDetails
"Invalid filename specified for diagnose data collector"
| takeFileName fn /= fn = return $ okWithDetails
"Filepaths cannot be specified for diagnose data collector"
| otherwise = do
let fp = dataCollectorDiagnoseDirectory </> fn
exists <- doesFileExist fp
if exists
then do
fs <- getFileStatus fp
let maxFileMode = foldl1 unionFileModes [ ownerModes
, groupReadMode
, groupExecuteMode
, otherReadMode
, otherExecuteMode
, regularFileMode
]
isSubSetOf m1 m2 = m1 `intersectFileModes` m2 == m1
case () of _
| fileOwner fs /= 0 -> return . okWithDetails $
"File for diagnose data collector " ++
"must be owned by root"
| fileGroup fs /= 0 -> return . okWithDetails $
"File for diagnose data collector " ++
"must have group root"
| not $ isRegularFile fs -> return . okWithDetails $
"File for diagnose data collector " ++
"must be a regular file"
| not $ isSubSetOf (fileMode fs) maxFileMode ->
return . okWithDetails $
"File for diagnose data collector " ++
"must have permissions 755 or stricter"
| not $ isSubSetOf ownerExecuteMode (fileMode fs) ->
return . okWithDetails $
"File for diagnose data collector " ++
"must be executable by owner"
| otherwise -> do
r <- fmap decode (readProcess fp [] "")
case r of
Ok val -> return val
Error str -> return . okWithDetails $
"Could not parse result: " ++ str
else return $ okWithDetails
"File specified for diagnose data collector does not exist"
buildJsonReport :: IO JSValue
buildJsonReport = fmap (genericResult okWithDetails id) . runResultT $ do
statusFnName <- getDiagnoseCollectorFilename Nothing Nothing
lift $ fnToVal statusFnName
dcReport :: IO DCReport
dcReport = buildJsonReport >>=
buildReport dcName dcVersion dcFormatVersion dcCategory dcKind