module BDCS.API.Customization(RecipeCustomization(..),
RecipeSshKey(..),
emptyCustomization,
processCustomization)
where
import BDCS.DB
import BDCS.Export.Customize(Customization(..))
import Control.Monad.IO.Class(MonadIO, liftIO)
import Data.Aeson
import Data.Bits((.|.))
import qualified Data.ByteString.Char8 as C8
import Data.Maybe(catMaybes)
import qualified Data.Text as T
import Data.Time.Clock(getCurrentTime)
import Data.Time.Clock.POSIX(POSIXTime, utcTimeToPOSIXSeconds)
import System.FilePath.Posix((</>))
import System.Posix.Files(directoryMode, regularFileMode)
data RecipeCustomization =
RecipeCustomization { rcHostName :: Maybe String
, rcSshKeys :: [RecipeSshKey]
} deriving (Eq, Show)
instance FromJSON RecipeCustomization where
parseJSON = withObject "recipe customization" $ \o -> do
rcHostName <- o .:? "hostname"
rcSshKeys <- o .:? "sshkey".!= []
return RecipeCustomization{..}
instance ToJSON RecipeCustomization where
toJSON RecipeCustomization{..} = let
maybeHostname = ("hostname" .=) <$> rcHostName
maybeSshKeys = if null rcSshKeys then Nothing
else Just ("sshkey" .= toJSONList rcSshKeys)
in object $ catMaybes [maybeHostname, maybeSshKeys]
emptyCustomization :: RecipeCustomization
emptyCustomization = RecipeCustomization Nothing []
data RecipeSshKey =
RecipeSshKey { rcSshUser :: String
, rcSshKey :: String
} deriving (Eq, Show)
instance FromJSON RecipeSshKey where
parseJSON = withObject "ssh key" $ \o -> do
rcSshUser <- o .: "user"
rcSshKey <- o .: "key"
return RecipeSshKey{..}
instance ToJSON RecipeSshKey where
toJSON RecipeSshKey{..} = object [
"user" .= rcSshUser
, "key" .= rcSshKey ]
processCustomization :: MonadIO m => RecipeCustomization -> m [Customization]
processCustomization RecipeCustomization{..} = do
currentTime <- utcTimeToPOSIXSeconds <$> liftIO getCurrentTime
let hostnameCustomization = maybe [] (\h -> [processHostname currentTime h]) rcHostName
sshKeyCustomizations = concatMap (processSshKey currentTime) rcSshKeys
return $ hostnameCustomization ++ sshKeyCustomizations
where
processHostname :: POSIXTime -> String -> Customization
processHostname currentTime hostname =
let hostnameData = C8.pack $ hostname ++ "\n"
hostnameFile = Files "/etc/hostname"
"root"
"root"
(floor currentTime)
Nothing
(fromIntegral $ regularFileMode .|. 0o0644)
(C8.length hostnameData)
Nothing
in WriteFile hostnameFile (Just hostnameData)
processSshKey :: POSIXTime -> RecipeSshKey -> [Customization]
processSshKey currentTime RecipeSshKey{..} =
let keyData = C8.pack $ rcSshKey ++ "\n"
keyDir = Files (T.pack $ "/home" </> rcSshUser </> ".ssh")
(T.pack rcSshUser)
(T.pack rcSshUser)
(floor currentTime)
Nothing
(fromIntegral $ directoryMode .|. 0o0700)
0
Nothing
keyFile = Files (T.pack $ "/home" </> rcSshUser </> ".ssh" </> "authorized_keys")
(T.pack rcSshUser)
(T.pack rcSshUser)
(floor currentTime)
Nothing
(fromIntegral $ regularFileMode .|. 0o0644)
(C8.length keyData)
Nothing
in [WriteFile keyDir Nothing, WriteFile keyFile (Just keyData)]