{-# LANGUAGE TypeFamilies #-}
module Propellor.Property.Debootstrap (
Url,
DebootstrapConfig(..),
built,
built',
extractSuite,
installed,
sourceInstall,
) where
import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.Chroot.Util
import Propellor.Property.Qemu
import Utility.Path
import Data.List
import Data.Char
import qualified Data.Semigroup as Sem
import System.Posix.Directory
import System.Posix.Files
type Url = String
data DebootstrapConfig
= DefaultConfig
| MinBase
| BuilddD
| DebootstrapParam String
| UseEmulation
| DebootstrapProxy Url
| DebootstrapMirror Url
| DebootstrapConfig :+ DebootstrapConfig
deriving (Int -> DebootstrapConfig -> ShowS
[DebootstrapConfig] -> ShowS
DebootstrapConfig -> [Char]
(Int -> DebootstrapConfig -> ShowS)
-> (DebootstrapConfig -> [Char])
-> ([DebootstrapConfig] -> ShowS)
-> Show DebootstrapConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DebootstrapConfig] -> ShowS
$cshowList :: [DebootstrapConfig] -> ShowS
show :: DebootstrapConfig -> [Char]
$cshow :: DebootstrapConfig -> [Char]
showsPrec :: Int -> DebootstrapConfig -> ShowS
$cshowsPrec :: Int -> DebootstrapConfig -> ShowS
Show)
instance Sem.Semigroup DebootstrapConfig where
<> :: DebootstrapConfig -> DebootstrapConfig -> DebootstrapConfig
(<>) = DebootstrapConfig -> DebootstrapConfig -> DebootstrapConfig
(:+)
instance Monoid DebootstrapConfig where
mempty :: DebootstrapConfig
mempty = DebootstrapConfig
DefaultConfig
mappend :: DebootstrapConfig -> DebootstrapConfig -> DebootstrapConfig
mappend = DebootstrapConfig -> DebootstrapConfig -> DebootstrapConfig
forall a. Semigroup a => a -> a -> a
(Sem.<>)
toParams :: DebootstrapConfig -> [CommandParam]
toParams :: DebootstrapConfig -> [CommandParam]
toParams DebootstrapConfig
DefaultConfig = []
toParams DebootstrapConfig
MinBase = [[Char] -> CommandParam
Param [Char]
"--variant=minbase"]
toParams DebootstrapConfig
BuilddD = [[Char] -> CommandParam
Param [Char]
"--variant=buildd"]
toParams (DebootstrapParam [Char]
p) = [[Char] -> CommandParam
Param [Char]
p]
toParams DebootstrapConfig
UseEmulation = []
toParams (DebootstrapProxy [Char]
_) = []
toParams (DebootstrapMirror [Char]
_) = []
toParams (DebootstrapConfig
c1 :+ DebootstrapConfig
c2) = DebootstrapConfig -> [CommandParam]
toParams DebootstrapConfig
c1 [CommandParam] -> [CommandParam] -> [CommandParam]
forall a. Semigroup a => a -> a -> a
<> DebootstrapConfig -> [CommandParam]
toParams DebootstrapConfig
c2
useEmulation :: DebootstrapConfig -> Bool
useEmulation :: DebootstrapConfig -> Bool
useEmulation DebootstrapConfig
UseEmulation = Bool
True
useEmulation (DebootstrapConfig
a :+ DebootstrapConfig
b) = DebootstrapConfig -> Bool
useEmulation DebootstrapConfig
a Bool -> Bool -> Bool
|| DebootstrapConfig -> Bool
useEmulation DebootstrapConfig
b
useEmulation DebootstrapConfig
_ = Bool
False
debootstrapProxy :: DebootstrapConfig -> Maybe Url
debootstrapProxy :: DebootstrapConfig -> Maybe [Char]
debootstrapProxy (DebootstrapProxy [Char]
u) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
u
debootstrapProxy (DebootstrapConfig
a :+ DebootstrapConfig
b) = DebootstrapConfig -> Maybe [Char]
debootstrapProxy DebootstrapConfig
a Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DebootstrapConfig -> Maybe [Char]
debootstrapProxy DebootstrapConfig
b
debootstrapProxy DebootstrapConfig
_ = Maybe [Char]
forall a. Maybe a
Nothing
debootstrapMirror :: DebootstrapConfig -> Maybe Url
debootstrapMirror :: DebootstrapConfig -> Maybe [Char]
debootstrapMirror (DebootstrapMirror [Char]
u) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
u
debootstrapMirror (DebootstrapConfig
a :+ DebootstrapConfig
b) = DebootstrapConfig -> Maybe [Char]
debootstrapMirror DebootstrapConfig
a Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DebootstrapConfig -> Maybe [Char]
debootstrapMirror DebootstrapConfig
b
debootstrapMirror DebootstrapConfig
_ = Maybe [Char]
forall a. Maybe a
Nothing
built :: FilePath -> System -> DebootstrapConfig -> Property Linux
built :: [Char]
-> System
-> DebootstrapConfig
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
built [Char]
target system :: System
system@(System Distribution
_ Architecture
targetarch) DebootstrapConfig
config =
[Char]
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Maybe System -> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> (OuterMetaTypesWitness metatypes
-> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS ([Char]
"debootstrapped " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
target) OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Maybe System -> Propellor Result
go
where
go :: OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Maybe System -> Propellor Result
go OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
w (Just System
hostos)
| System -> Architecture -> Bool
supportsArch System
hostos Architecture
targetarch Bool -> Bool -> Bool
&& Bool -> Bool
not (DebootstrapConfig -> Bool
useEmulation DebootstrapConfig
config) =
OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
w (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result
forall a b. (a -> b) -> a -> b
$
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> [Char]
-> System
-> DebootstrapConfig
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
built' (RevertableProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property setupmetatypes
setupRevertableProperty RevertableProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
installed)
[Char]
target System
system DebootstrapConfig
config
go OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
w Maybe System
_ = OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
w (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Propellor Result
forall a b. (a -> b) -> a -> b
$ do
let p :: CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
p = RevertableProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property setupmetatypes
setupRevertableProperty RevertableProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
foreignBinariesEmulated
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
forall x y. Combines x y => x -> y -> CombinedType x y
`before` RevertableProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property setupmetatypes
setupRevertableProperty RevertableProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
installed
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> [Char]
-> System
-> DebootstrapConfig
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
built' Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
p [Char]
target System
system (DebootstrapConfig
config DebootstrapConfig -> DebootstrapConfig -> DebootstrapConfig
:+ DebootstrapConfig
UseEmulation)
built' :: Property Linux -> FilePath -> System -> DebootstrapConfig -> Property Linux
built' :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> [Char]
-> System
-> DebootstrapConfig
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
built' Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
installprop [Char]
target system :: System
system@(System Distribution
_ Architecture
arch) DebootstrapConfig
config =
CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
go Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
oldpermfix
where
go :: CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
go = IO Bool
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check ([Char] -> IO Bool
isUnpopulated [Char]
target IO Bool -> IO Bool -> IO Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> IO Bool
ispartial) Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
setupprop
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
installprop
setupprop :: Property Linux
setupprop :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
setupprop = [Char]
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall {k} (metatypes :: k).
SingI metatypes =>
[Char] -> Propellor Result -> Property (MetaTypes metatypes)
property ([Char]
"debootstrapped " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
target) (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ IO Result -> Propellor Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
forall a b. (a -> b) -> a -> b
$ do
Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
target
[Char]
suite <- case System -> Maybe [Char]
extractSuite System
system of
Maybe [Char]
Nothing -> [Char] -> IO [Char]
forall (m :: * -> *) a. MonadIO m => [Char] -> m a
errorMessage ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"don't know how to debootstrap " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ System -> [Char]
forall a. Show a => a -> [Char]
show System
system
Just [Char]
s -> [Char] -> IO [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
s
let params :: [CommandParam]
params = DebootstrapConfig -> [CommandParam]
toParams DebootstrapConfig
config [CommandParam] -> [CommandParam] -> [CommandParam]
forall a. [a] -> [a] -> [a]
++
[ [Char] -> CommandParam
Param ([Char] -> CommandParam) -> [Char] -> CommandParam
forall a b. (a -> b) -> a -> b
$ [Char]
"--arch=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Architecture -> [Char]
architectureToDebianArchString Architecture
arch
, [Char] -> CommandParam
Param [Char]
suite
, [Char] -> CommandParam
Param [Char]
target
] [CommandParam] -> [CommandParam] -> [CommandParam]
forall a. [a] -> [a] -> [a]
++ case DebootstrapConfig -> Maybe [Char]
debootstrapMirror DebootstrapConfig
config of
Just [Char]
u -> [[Char] -> CommandParam
Param [Char]
u]
Maybe [Char]
Nothing -> []
[Char]
cmd <- if DebootstrapConfig -> Bool
useEmulation DebootstrapConfig
config
then [Char] -> IO [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"qemu-debootstrap"
else [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"debootstrap" (Maybe [Char] -> [Char]) -> IO (Maybe [Char]) -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe [Char])
programPath
[([Char], [Char])]
de <- case DebootstrapConfig -> Maybe [Char]
debootstrapProxy DebootstrapConfig
config of
Just [Char]
u -> [Char] -> [Char] -> [([Char], [Char])] -> [([Char], [Char])]
forall k v. Eq k => k -> v -> [(k, v)] -> [(k, v)]
addEntry [Char]
"http_proxy" [Char]
u ([([Char], [Char])] -> [([Char], [Char])])
-> IO [([Char], [Char])] -> IO [([Char], [Char])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [([Char], [Char])]
standardPathEnv
Maybe [Char]
Nothing -> IO [([Char], [Char])]
standardPathEnv
IO Bool -> (IO Result, IO Result) -> IO Result
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM ([Char] -> [CommandParam] -> Maybe [([Char], [Char])] -> IO Bool
boolSystemEnv [Char]
cmd [CommandParam]
params ([([Char], [Char])] -> Maybe [([Char], [Char])]
forall a. a -> Maybe a
Just [([Char], [Char])]
de))
( Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
, Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
)
ispartial :: IO Bool
ispartial = IO Bool -> (IO Bool, IO Bool) -> IO Bool
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM ([Char] -> IO Bool
doesDirectoryExist ([Char]
target [Char] -> ShowS
</> [Char]
"debootstrap"))
( do
[Char] -> IO ()
removeChroot [Char]
target
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
, Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
)
oldpermfix :: Property Linux
oldpermfix :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
oldpermfix = [Char]
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall {k} (metatypes :: k).
SingI metatypes =>
[Char] -> Propellor Result -> Property (MetaTypes metatypes)
property ([Char]
"fixed old chroot file mode") (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ do
IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ [Char] -> (FileMode -> FileMode) -> IO ()
modifyFileMode [Char]
target ((FileMode -> FileMode) -> IO ())
-> (FileMode -> FileMode) -> IO ()
forall a b. (a -> b) -> a -> b
$
[FileMode] -> FileMode -> FileMode
addModes [FileMode
otherReadMode, FileMode
otherExecuteMode]
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
extractSuite :: System -> Maybe String
(System (Debian DebianKernel
_ DebianSuite
s) Architecture
_) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ DebianSuite -> [Char]
Apt.showSuite DebianSuite
s
extractSuite (System (Buntish [Char]
r) Architecture
_) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
r
extractSuite (System (Distribution
ArchLinux) Architecture
_) = Maybe [Char]
forall a. Maybe a
Nothing
extractSuite (System (FreeBSD FreeBSDRelease
_) Architecture
_) = Maybe [Char]
forall a. Maybe a
Nothing
installed :: RevertableProperty Linux Linux
installed :: RevertableProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
installed = Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
install Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> RevertableProperty
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
remove
where
install :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
install = IO Bool
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe [Char] -> Bool) -> IO (Maybe [Char]) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe [Char])
programPath) (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
(Property DebianLike
aptinstall Property DebianLike
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall {k} ka kb (c :: k) (a :: ka) (b :: kb).
(HasCallStack, SingKind 'KProxy, SingKind 'KProxy,
DemoteRep 'KProxy ~ [MetaType], DemoteRep 'KProxy ~ [MetaType],
SingI c) =>
Property (MetaTypes a)
-> Property (MetaTypes b) -> Property (MetaTypes c)
`pickOS` Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
sourceInstall)
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> [Char]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"debootstrap installed"
remove :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
remove = (Property DebianLike
aptremove Property DebianLike
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall {k} ka kb (c :: k) (a :: ka) (b :: kb).
(HasCallStack, SingKind 'KProxy, SingKind 'KProxy,
DemoteRep 'KProxy ~ [MetaType], DemoteRep 'KProxy ~ [MetaType],
SingI c) =>
Property (MetaTypes a)
-> Property (MetaTypes b) -> Property (MetaTypes c)
`pickOS` Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
sourceRemove)
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> [Char]
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall p. IsProp p => p -> [Char] -> p
`describe` [Char]
"debootstrap removed"
aptinstall :: Property DebianLike
aptinstall = [[Char]] -> Property DebianLike
Apt.installed [[Char]
"debootstrap"]
aptremove :: Property DebianLike
aptremove = [[Char]] -> Property DebianLike
Apt.removed [[Char]
"debootstrap"]
sourceInstall :: Property Linux
sourceInstall :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
sourceInstall = Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
go
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
perlInstalled
Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> CombinedType
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
(Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
arInstalled
where
go :: Property Linux
go :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
go = [Char]
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall {k} (metatypes :: k).
SingI metatypes =>
[Char] -> Propellor Result -> Property (MetaTypes metatypes)
property [Char]
"debootstrap installed from source" (IO Result -> Propellor Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Result
sourceInstall')
perlInstalled :: Property Linux
perlInstalled :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
perlInstalled = IO Bool
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Bool
inPath [Char]
"perl") (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ [Char]
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall {k} (metatypes :: k).
SingI metatypes =>
[Char] -> Propellor Result -> Property (MetaTypes metatypes)
property [Char]
"perl installed" (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
IO Result -> Propellor Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
forall a b. (a -> b) -> a -> b
$ Bool -> Result
forall t. ToResult t => t -> Result
toResult (Bool -> Result)
-> (Maybe (IO Bool) -> Bool) -> Maybe (IO Bool) -> Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (IO Bool) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (IO Bool) -> Result) -> IO (Maybe (IO Bool)) -> IO Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO Bool -> IO Bool) -> [IO Bool] -> IO (Maybe (IO Bool))
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
firstM IO Bool -> IO Bool
forall a. a -> a
id
[ [Char] -> IO Bool
yumInstall [Char]
"perl"
]
arInstalled :: Property Linux
arInstalled :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
arInstalled = IO Bool
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Bool
inPath [Char]
"ar") (Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ [Char]
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall {k} (metatypes :: k).
SingI metatypes =>
[Char] -> Propellor Result -> Property (MetaTypes metatypes)
property [Char]
"ar installed" (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
IO Result -> Propellor Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
forall a b. (a -> b) -> a -> b
$ Bool -> Result
forall t. ToResult t => t -> Result
toResult (Bool -> Result)
-> (Maybe (IO Bool) -> Bool) -> Maybe (IO Bool) -> Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (IO Bool) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (IO Bool) -> Result) -> IO (Maybe (IO Bool)) -> IO Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO Bool -> IO Bool) -> [IO Bool] -> IO (Maybe (IO Bool))
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
firstM IO Bool -> IO Bool
forall a. a -> a
id
[ [Char] -> IO Bool
yumInstall [Char]
"binutils"
]
yumInstall :: String -> IO Bool
yumInstall :: [Char] -> IO Bool
yumInstall [Char]
p = [Char] -> [CommandParam] -> IO Bool
boolSystem [Char]
"yum" [[Char] -> CommandParam
Param [Char]
"-y", [Char] -> CommandParam
Param [Char]
"install", [Char] -> CommandParam
Param [Char]
p]
sourceInstall' :: IO Result
sourceInstall' :: IO Result
sourceInstall' = [Char] -> ([Char] -> IO Result) -> IO Result
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
[Char] -> ([Char] -> m a) -> m a
withTmpDir [Char]
"debootstrap" (([Char] -> IO Result) -> IO Result)
-> ([Char] -> IO Result) -> IO Result
forall a b. (a -> b) -> a -> b
$ \[Char]
tmpd -> do
let indexfile :: [Char]
indexfile = [Char]
tmpd [Char] -> ShowS
</> [Char]
"index.html"
IO Bool -> IO () -> IO ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM ([Char] -> [Char] -> IO Bool
download [Char]
baseurl [Char]
indexfile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> IO ()
forall (m :: * -> *) a. MonadIO m => [Char] -> m a
errorMessage ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to download " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
baseurl
[[Char]]
urls <- ([Char] -> [Char] -> Ordering) -> [[Char]] -> [[Char]]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (([Char] -> [Char] -> Ordering) -> [Char] -> [Char] -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare)
([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
"debootstrap_" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`)
([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
".tar." [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`)
([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[Char]]
extractUrls [Char]
baseurl ([Char] -> [[Char]]) -> IO [Char] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[Char] -> IO [Char]
readFileStrict [Char]
indexfile
[Char] -> IO ()
nukeFile [Char]
indexfile
[Char]
tarfile <- case [[Char]]
urls of
([Char]
tarurl:[[Char]]
_) -> do
let f :: [Char]
f = [Char]
tmpd [Char] -> ShowS
</> ShowS
takeFileName [Char]
tarurl
IO Bool -> IO () -> IO ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM ([Char] -> [Char] -> IO Bool
download [Char]
tarurl [Char]
f) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> IO ()
forall (m :: * -> *) a. MonadIO m => [Char] -> m a
errorMessage ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to download " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
tarurl
[Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
f
[[Char]]
_ -> [Char] -> IO [Char]
forall (m :: * -> *) a. MonadIO m => [Char] -> m a
errorMessage ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to find any debootstrap tarballs listed on " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
baseurl
Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
localInstallDir
IO [Char]
-> ([Char] -> IO ()) -> ([Char] -> IO Result) -> IO Result
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket IO [Char]
getWorkingDirectory [Char] -> IO ()
changeWorkingDirectory (([Char] -> IO Result) -> IO Result)
-> ([Char] -> IO Result) -> IO Result
forall a b. (a -> b) -> a -> b
$ \[Char]
_ -> do
[Char] -> IO ()
changeWorkingDirectory [Char]
localInstallDir
IO Bool -> IO () -> IO ()
forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM ([Char] -> [CommandParam] -> IO Bool
boolSystem [Char]
"tar" [[Char] -> CommandParam
Param [Char]
"xf", [Char] -> CommandParam
File [Char]
tarfile]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> IO ()
forall (m :: * -> *) a. MonadIO m => [Char] -> m a
errorMessage [Char]
"Failed to extract debootstrap tar file"
[Char] -> IO ()
nukeFile [Char]
tarfile
[[Char]]
l <- [Char] -> IO [[Char]]
dirContents [Char]
"."
case [[Char]]
l of
([Char]
subdir:[]) -> do
[Char] -> IO ()
changeWorkingDirectory [Char]
subdir
[Char] -> IO ()
makeWrapperScript ([Char]
localInstallDir [Char] -> ShowS
</> [Char]
subdir)
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
[[Char]]
_ -> [Char] -> IO Result
forall (m :: * -> *) a. MonadIO m => [Char] -> m a
errorMessage [Char]
"debootstrap tar file did not contain exactly one directory"
sourceRemove :: Property Linux
sourceRemove :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
sourceRemove = [Char]
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall {k} (metatypes :: k).
SingI metatypes =>
[Char] -> Propellor Result -> Property (MetaTypes metatypes)
property [Char]
"debootstrap not installed from source" (Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
-> Propellor Result
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$ IO Result -> Propellor Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
forall a b. (a -> b) -> a -> b
$
IO Bool -> (IO Result, IO Result) -> IO Result
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM ([Char] -> IO Bool
doesDirectoryExist [Char]
sourceInstallDir)
( do
[Char] -> IO ()
removeDirectoryRecursive [Char]
sourceInstallDir
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
, Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
)
sourceInstallDir :: FilePath
sourceInstallDir :: [Char]
sourceInstallDir = [Char]
"/usr/local/propellor/debootstrap"
wrapperScript :: FilePath
wrapperScript :: [Char]
wrapperScript = [Char]
sourceInstallDir [Char] -> ShowS
</> [Char]
"debootstrap.wrapper"
programPath :: IO (Maybe FilePath)
programPath :: IO (Maybe [Char])
programPath = ([Char] -> IO (Maybe [Char])) -> [[Char]] -> IO (Maybe [Char])
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
getM [Char] -> IO (Maybe [Char])
searchPath
[ [Char]
"debootstrap"
, [Char]
wrapperScript
]
makeWrapperScript :: FilePath -> IO ()
makeWrapperScript :: [Char] -> IO ()
makeWrapperScript [Char]
dir = do
Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True (ShowS
takeDirectory [Char]
wrapperScript)
[Char] -> [Char] -> IO ()
writeFile [Char]
wrapperScript ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
[ [Char]
"#!/bin/sh"
, [Char]
"set -e"
, [Char]
"DEBOOTSTRAP_DIR=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
dir
, [Char]
"export DEBOOTSTRAP_DIR"
, [Char]
dir [Char] -> ShowS
</> [Char]
"debootstrap" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" \"$@\""
]
[Char] -> (FileMode -> FileMode) -> IO ()
modifyFileMode [Char]
wrapperScript ([FileMode] -> FileMode -> FileMode
addModes ([FileMode] -> FileMode -> FileMode)
-> [FileMode] -> FileMode -> FileMode
forall a b. (a -> b) -> a -> b
$ [FileMode]
readModes [FileMode] -> [FileMode] -> [FileMode]
forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes)
localInstallDir :: FilePath
localInstallDir :: [Char]
localInstallDir = [Char]
"/usr/local/debootstrap"
baseurl :: Url
baseurl :: [Char]
baseurl = [Char]
"http://ftp.debian.org/debian/pool/main/d/debootstrap/"
download :: Url -> FilePath -> IO Bool
download :: [Char] -> [Char] -> IO Bool
download [Char]
url [Char]
dest = (IO Bool -> IO Bool) -> [IO Bool] -> IO Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM IO Bool -> IO Bool
forall a. a -> a
id
[ [Char] -> [CommandParam] -> IO Bool
boolSystem [Char]
"curl" [[Char] -> CommandParam
Param [Char]
"-o", [Char] -> CommandParam
File [Char]
dest, [Char] -> CommandParam
Param [Char]
url]
, [Char] -> [CommandParam] -> IO Bool
boolSystem [Char]
"wget" [[Char] -> CommandParam
Param [Char]
"-O", [Char] -> CommandParam
File [Char]
dest, [Char] -> CommandParam
Param [Char]
url]
]
extractUrls :: Url -> String -> [Url]
[Char]
base = [[Char]] -> [Char] -> [[Char]]
collect [] ([Char] -> [[Char]]) -> ShowS -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
where
collect :: [[Char]] -> [Char] -> [[Char]]
collect [[Char]]
l [] = [[Char]]
l
collect [[Char]]
l (Char
'h':Char
'r':Char
'e':Char
'f':Char
'=':[Char]
r) = case [Char]
r of
(Char
'"':[Char]
r') -> [[Char]] -> [Char] -> [[Char]]
findend [[Char]]
l [Char]
r'
[Char]
_ -> [[Char]] -> [Char] -> [[Char]]
findend [[Char]]
l [Char]
r
collect [[Char]]
l (Char
_:[Char]
cs) = [[Char]] -> [Char] -> [[Char]]
collect [[Char]]
l [Char]
cs
findend :: [[Char]] -> [Char] -> [[Char]]
findend [[Char]]
l [Char]
s =
let ([Char]
u, [Char]
r) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"') [Char]
s
u' :: [Char]
u' = if [Char]
"http" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
u
then [Char]
u
else [Char]
base [Char] -> ShowS
</> [Char]
u
in [[Char]] -> [Char] -> [[Char]]
collect ([Char]
u'[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
l) [Char]
r