module Propellor.Property.Reboot (
now,
atEnd,
toDistroKernel,
toKernelNewerThan,
KernelVersion,
) where
import Propellor.Base
import Data.List
import Data.Version
import Text.ParserCombinators.ReadP
type KernelVersion = String
now :: Property Linux
now :: Property Linux
now = Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"reboot" []
UncheckedProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> String
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> String -> p
`describe` String
"reboot now"
type Force = Bool
atEnd :: Force -> (Result -> Bool) -> Property Linux
atEnd :: Force -> (Result -> Force) -> Property Linux
atEnd Force
force Result -> Force
resultok = String -> Propellor Result -> Property Linux
forall k (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property String
"scheduled reboot at end of propellor run" (Propellor Result -> Property Linux)
-> Propellor Result -> Property Linux
forall a b. (a -> b) -> a -> b
$ do
String -> (Result -> Propellor Result) -> Propellor ()
endAction String
"rebooting" Result -> Propellor Result
forall (m :: * -> *). MonadIO m => Result -> m Result
atend
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
where
atend :: Result -> m Result
atend Result
r
| Result -> Force
resultok Result
r = IO Result -> m Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> m Result) -> IO Result -> m Result
forall a b. (a -> b) -> a -> b
$ Force -> Result
forall t. ToResult t => t -> Result
toResult
(Force -> Result) -> IO Force -> IO Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [CommandParam] -> IO Force
boolSystem String
"reboot" [CommandParam]
rebootparams
| Force
otherwise = do
String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
warningMessage String
"Not rebooting, due to status of propellor run."
Result -> m Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
rebootparams :: [CommandParam]
rebootparams
| Force
force = [String -> CommandParam
Param String
"--force"]
| Force
otherwise = []
toDistroKernel :: Property DebianLike
toDistroKernel :: Property DebianLike
toDistroKernel = Property Linux -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property Linux -> Property DebianLike)
-> Property Linux -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ IO Force -> Property Linux -> Property Linux
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Force -> p i -> Property i
check (Force -> Force
not (Force -> Force) -> IO Force -> IO Force
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Force
runningInstalledKernel) Property Linux
now
Property Linux -> String -> Property Linux
forall p. IsProp p => p -> String -> p
`describe` String
"running installed kernel"
toKernelNewerThan :: KernelVersion -> Property DebianLike
toKernelNewerThan :: String -> Property DebianLike
toKernelNewerThan String
ver =
String
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (String
"reboot to kernel newer than " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ver) ((OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property DebianLike)
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
Version
wantV <- String -> Propellor Version
tryReadVersion String
ver
Version
runningV <- String -> Propellor Version
tryReadVersion (String -> Propellor Version)
-> Propellor String -> Propellor Version
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String -> Propellor String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
runningKernelVersion
if Version
runningV Version -> Version -> Force
forall a. Ord a => a -> a -> Force
>= Version
wantV then Propellor Result
noChange
else [Version] -> Version
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Version] -> Version) -> Propellor [Version] -> Propellor Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Propellor [Version]
installedVs Propellor Version
-> (Version -> Propellor Result) -> Propellor Result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Version
installedV ->
if Version
installedV Version -> Version -> Force
forall a. Ord a => a -> a -> Force
>= Version
wantV
then OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property Linux -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w Property Linux
now
else String -> Propellor Result
forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage (String -> Propellor Result) -> String -> Propellor Result
forall a b. (a -> b) -> a -> b
$
String
"kernel newer than "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ver
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not installed"
where
installedVs :: Propellor [Version]
installedVs = (String -> Propellor Version) -> [String] -> Propellor [Version]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> Propellor Version
tryReadVersion ([String] -> Propellor [Version])
-> Propellor [String] -> Propellor [Version]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String] -> Propellor [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
installedKernelVersions
runningInstalledKernel :: IO Bool
runningInstalledKernel :: IO Force
runningInstalledKernel = do
String
kernelver <- IO String
runningKernelVersion
Force -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Force -> f () -> f ()
when (String -> Force
forall (t :: * -> *) a. Foldable t => t a -> Force
null String
kernelver) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall a. HasCallStack => String -> a
error String
"failed to read uname -r"
[String]
kernelimages <- IO [String]
installedKernelImages
Force -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Force -> f () -> f ()
when ([String] -> Force
forall (t :: * -> *) a. Foldable t => t a -> Force
null [String]
kernelimages) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall a. HasCallStack => String -> a
error String
"failed to find any installed kernel images"
String -> String -> Force
findVersion String
kernelver (String -> Force) -> IO String -> IO Force
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
String -> [String] -> IO String
readProcess String
"file" (String
"-L" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
kernelimages)
runningKernelVersion :: IO KernelVersion
runningKernelVersion :: IO String
runningKernelVersion = (Char -> Force) -> String -> String
forall a. (a -> Force) -> [a] -> [a]
takeWhile (Char -> Char -> Force
forall a. Eq a => a -> a -> Force
/= Char
'\n') (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO String
readProcess String
"uname" [String
"-r"]
installedKernelImages :: IO [String]
installedKernelImages :: IO [String]
installedKernelImages = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO [String]
kernelsIn [String
"/", String
"/boot/"]
findVersion :: KernelVersion -> String -> Bool
findVersion :: String -> String -> Force
findVersion String
ver String
s = (String
" version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ver String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") String -> String -> Force
forall a. Eq a => [a] -> [a] -> Force
`isInfixOf` String
s
installedKernelVersions :: IO [KernelVersion]
installedKernelVersions :: IO [String]
installedKernelVersions = do
[String]
kernelimages <- IO [String]
installedKernelImages
Force -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Force -> f () -> f ()
when ([String] -> Force
forall (t :: * -> *) a. Foldable t => t a -> Force
null [String]
kernelimages) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall a. HasCallStack => String -> a
error String
"failed to find any installed kernel images"
[String]
imageLines <- String -> [String]
lines (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO String
readProcess String
"file" (String
"-L" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
kernelimages)
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> String
extractKernelVersion (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
imageLines
kernelsIn :: FilePath -> IO [FilePath]
kernelsIn :: String -> IO [String]
kernelsIn String
d = (String -> Force) -> [String] -> [String]
forall a. (a -> Force) -> [a] -> [a]
filter (String
"vmlinu" String -> String -> Force
forall a. Eq a => [a] -> [a] -> Force
`isInfixOf`) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
dirContents String
d
extractKernelVersion :: String -> KernelVersion
=
[String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Force) -> [String] -> [String]
forall a. (a -> Force) -> [a] -> [a]
dropWhile (String -> String -> Force
forall a. Eq a => a -> a -> Force
/= String
"version") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
readVersionMaybe :: KernelVersion -> Maybe Version
readVersionMaybe :: String -> Maybe Version
readVersionMaybe String
ver = case ((Version, String) -> Version) -> [(Version, String)] -> [Version]
forall a b. (a -> b) -> [a] -> [b]
map (Version, String) -> Version
forall a b. (a, b) -> a
fst ([(Version, String)] -> [Version])
-> [(Version, String)] -> [Version]
forall a b. (a -> b) -> a -> b
$ ReadP Version -> ReadS Version
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion String
ver of
[] -> Maybe Version
forall a. Maybe a
Nothing
[Version]
l -> Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version] -> Version
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Version]
l
tryReadVersion :: KernelVersion -> Propellor Version
tryReadVersion :: String -> Propellor Version
tryReadVersion String
ver = case String -> Maybe Version
readVersionMaybe String
ver of
Just Version
x -> Version -> Propellor Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
x
Maybe Version
Nothing -> String -> Propellor Version
forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage (String
"couldn't parse version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ver)