| Age | Commit message (Collapse) | Author |
|---|
|
(cherry picked from commit 3590a1241580ddcdd153e2619a3c02ce18a8db8c
but without the changes to src/Propellor/Precompiled.hs)
|
|
TODO: remove ANDROID (used in GitAnnexBuilder)
TODO: add other architectures
TODO: rename ARMHF
TODO: rename ARMEL
(cherry picked from commit 6f36f6cade4e1d8b15c714565e223562c6573099)
|
|
|
|
fixed up chroot to take Props
|
|
Unfortunately, DiskImage needs to add properties to the Chroot it's
presented with, and the metatypes are not included in the Chroot, so it
can't guarantee that the properties it's adding match the OS in the Chroot.
I partially worked around this by making the properties that DiskImage adds
check the OS, so they don't assume Debian.
It would be nicer to parameterize the Chroot type with the metatypes of the
inner OS. I worked for several hours on a patch along those lines, but it
doesn't quite compile. Failed at the final hurdle :/ The patch is below
for later..
--- src/Propellor/Property/Chroot.hs 2016-03-27 16:06:44.285464820 -0400
+++ /home/joey/Chroot.hs 2016-03-27 15:32:29.073416143 -0400
@@ -1,9 +1,9 @@
-{-# LANGUAGE FlexibleContexts, GADTs, DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts, GADTs, DeriveDataTypeable, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, DataKinds #-}
module Propellor.Property.Chroot (
debootstrapped,
bootstrapped,
- provisioned,
+ --provisioned,
Chroot(..),
ChrootBootstrapper(..),
Debootstrapped(..),
@@ -11,7 +11,7 @@
noServices,
inChroot,
-- * Internal use
- provisioned',
+ --provisioned',
propagateChrootInfo,
propellChroot,
chain,
@@ -20,6 +20,7 @@
import Propellor.Base
import Propellor.Container
+import Propellor.Types.MetaTypes
import Propellor.Types.CmdLine
import Propellor.Types.Chroot
import Propellor.Types.Info
@@ -38,27 +39,29 @@
-- | Specification of a chroot. Normally you'll use `debootstrapped` or
-- `bootstrapped` to construct a Chroot value.
-data Chroot where
- Chroot :: ChrootBootstrapper b => FilePath -> b -> Host -> Chroot
-
-instance IsContainer Chroot where
- containerProperties (Chroot _ _ h) = containerProperties h
- containerInfo (Chroot _ _ h) = containerInfo h
- setContainerProperties (Chroot loc b h) ps = Chroot loc b (setContainerProperties h ps)
+--
+-- The inner and outer type variables are the metatypes of the inside of
+-- the chroot and the system it runs in.
+data Chroot inner outer where
+ Chroot :: ChrootBootstrapper b inner outer => FilePath -> b -> Host -> (inner, outer) -> Chroot inner outer
+
+instance IsContainer (Chroot inner outer) where
+ containerProperties (Chroot _ _ h _) = containerProperties h
+ containerInfo (Chroot _ _ h _) = containerInfo h
-chrootSystem :: Chroot -> Maybe System
+chrootSystem :: Chroot inner outer -> Maybe System
chrootSystem = fromInfoVal . fromInfo . containerInfo
-instance Show Chroot where
- show c@(Chroot loc _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
+instance Show (Chroot inner outer) where
+ show c@(Chroot loc _ _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
-- | Class of things that can do initial bootstrapping of an operating
-- System in a chroot.
-class ChrootBootstrapper b where
+class ChrootBootstrapper b inner outer where
-- | Do initial bootstrapping of an operating system in a chroot.
-- If the operating System is not supported, return
-- Left error message.
- buildchroot :: b -> Maybe System -> FilePath -> Either String (Property Linux)
+ buildchroot :: b -> Maybe System -> FilePath -> Either String (Property outer)
-- | Use this to bootstrap a chroot by extracting a tarball.
--
@@ -68,9 +71,8 @@
-- detect automatically.
data ChrootTarball = ChrootTarball FilePath
-instance ChrootBootstrapper ChrootTarball where
- buildchroot (ChrootTarball tb) _ loc = Right $
- tightenTargets $ extractTarball loc tb
+instance ChrootBootstrapper ChrootTarball UnixLike UnixLike where
+ buildchroot (ChrootTarball tb) _ loc = Right $ extractTarball loc tb
extractTarball :: FilePath -> FilePath -> Property UnixLike
extractTarball target src = check (unpopulated target) $
@@ -88,7 +90,7 @@
-- | Use this to bootstrap a chroot with debootstrap.
data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig
-instance ChrootBootstrapper Debootstrapped where
+instance ChrootBootstrapper Debootstrapped DebianLike Linux where
buildchroot (Debootstrapped cf) system loc = case system of
(Just s@(System (Debian _) _)) -> Right $ debootstrap s
(Just s@(System (Buntish _) _)) -> Right $ debootstrap s
@@ -107,13 +109,22 @@
-- > & osDebian Unstable "amd64"
-- > & Apt.installed ["ghc", "haskell-platform"]
-- > & ...
-debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Chroot
+-- debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Chroot DebianLike
+debootstrapped
+ :: (SingI inner, SingI outer, ChrootBootstrapper Debootstrapped (MetaTypes inner) (MetaTypes outer))
+ => Debootstrap.DebootstrapConfig
+ -> FilePath
+ -> Chroot (MetaTypes inner) (MetaTypes outer)
debootstrapped conf = bootstrapped (Debootstrapped conf)
-- | Defines a Chroot at the given location, bootstrapped with the
-- specified ChrootBootstrapper.
-bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Chroot
-bootstrapped bootstrapper location = Chroot location bootstrapper h
+bootstrapped
+ :: (SingI inner, SingI outer, ChrootBootstrapper b (MetaTypes inner) (MetaTypes outer))
+ => b
+ -> FilePath
+ -> Chroot (MetaTypes inner) (MetaTypes outer)
+bootstrapped bootstrapper location = Chroot location bootstrapper h (sing, sing)
where
h = Host location [] mempty
@@ -123,45 +134,79 @@
-- Reverting this property removes the chroot. Anything mounted inside it
-- is first unmounted. Note that it does not ensure that any processes
-- that might be running inside the chroot are stopped.
-provisioned :: Chroot -> RevertableProperty (HasInfo + Linux) Linux
+-- provisioned :: SingI outer => Chroot inner outer -> RevertableProperty (HasInfo + MetaTypes outer) Linux
+provisioned
+ ::
+ ( SingI outer
+ , SingI metatypes
+ , Combines (Property (MetaTypes outer)) (Property (MetaTypes outer))
+ , (HasInfo + outer) ~ MetaTypes metatypes
+ , CombinedType (Property (MetaTypes outer)) (Property (MetaTypes outer)) ~ Property outer
+ , IncludesInfo (MetaTypes metatypes) ~ 'True)
+ => Chroot inner outer -> RevertableProperty (HasInfo + outer) Linux
provisioned c = provisioned' (propagateChrootInfo c) c False
provisioned'
- :: (Property Linux -> Property (HasInfo + Linux))
- -> Chroot
+ ::
+ ( Combines (Property (MetaTypes outer)) (Property (MetaTypes outer))
+ , CombinedType (Property (MetaTypes outer)) (Property (MetaTypes outer)) ~ Property outer
+ , SingI outer
+ )
+ => (Property outer -> Property (HasInfo + outer))
+ -> Chroot inner outer
-> Bool
- -> RevertableProperty (HasInfo + Linux) Linux
-provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
- (propigator $ setup `describe` chrootDesc c "exists")
+ -> RevertableProperty (HasInfo + outer) Linux
+provisioned' propigator c systemdonly =
+ (propigator $ setup c systemdonly `describe` chrootDesc c "exists")
<!>
- (teardown `describe` chrootDesc c "removed")
- where
- setup :: Property Linux
- setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
- `requires` built
-
- built = case buildchroot bootstrapper (chrootSystem c) loc of
- Right p -> p
- Left e -> cantbuild e
-
- cantbuild e = property (chrootDesc c "built") (error e)
-
- teardown :: Property Linux
- teardown = check (not <$> unpopulated loc) $
- property ("removed " ++ loc) $
- makeChange (removeChroot loc)
-
-propagateChrootInfo :: Chroot -> Property Linux -> Property (HasInfo + Linux)
-propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c $
- p `addInfoProperty` chrootInfo c
+ (teardown c `describe` chrootDesc c "removed")
-chrootInfo :: Chroot -> Info
-chrootInfo (Chroot loc _ h) = mempty `addInfo`
+-- chroot removal code is currently linux specific..
+teardown :: Chroot inner outer -> Property Linux
+teardown (Chroot loc _ _ _) = check (not <$> unpopulated loc) $
+ property ("removed " ++ loc) $
+ makeChange (removeChroot loc)
+
+setup
+ ::
+ ( SingI outer
+ , Combines (Property (MetaTypes outer)) (Property (MetaTypes outer))
+ )
+ => Chroot inner outer
+ -> Bool
+ -> CombinedType (Property (MetaTypes outer)) (Property (MetaTypes outer))
+setup c systemdonly = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
+ `requires` built c
+
+built :: (SingI outer, ChrootBootstrapper b inner outer) => Chroot inner outer -> Property (MetaTypes outer)
+built c@(Chroot loc bootstrapper _ _) =
+ case buildchroot bootstrapper (chrootSystem c) loc of
+ Right p -> error "FOO" -- p
+ Left e -> error "FOO" -- cantbuild c e
+
+cantbuild :: Chroot inner outer -> String -> Property UnixLike
+cantbuild c e = property (chrootDesc c "built") (error e)
+
+propagateChrootInfo
+ ::
+ ( SingI metatypes
+ , (HasInfo + outer) ~ MetaTypes metatypes
+ , IncludesInfo (MetaTypes metatypes) ~ 'True
+ )
+ => Chroot inner outer
+ -> Property outer
+ -> Property (MetaTypes metatypes)
+propagateChrootInfo c@(Chroot location _ _ _) p =
+ propagateContainer location c $
+ p `addInfoProperty` chrootInfo c
+
+chrootInfo :: Chroot inner outer -> Info
+chrootInfo (Chroot loc _ h _) = mempty `addInfo`
mempty { _chroots = M.singleton loc h }
-- | Propellor is run inside the chroot to provision it.
-propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property UnixLike
-propellChroot c@(Chroot loc _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
+propellChroot :: SingI outer => Chroot inner outer -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property (MetaTypes outer)
+propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
let d = localdir </> shimdir c
let me = localdir </> "propellor"
shim <- liftIO $ ifM (doesDirectoryExist d)
@@ -199,8 +244,8 @@
liftIO cleanup
return r
-toChain :: HostName -> Chroot -> Bool -> IO CmdLine
-toChain parenthost (Chroot loc _ _) systemdonly = do
+toChain :: HostName -> Chroot inner outer -> Bool -> IO CmdLine
+toChain parenthost (Chroot loc _ _ _) systemdonly = do
onconsole <- isConsole <$> getMessageHandle
return $ ChrootChain parenthost loc systemdonly onconsole
@@ -224,8 +269,8 @@
putStrLn $ "\n" ++ show r
chain _ _ = errorMessage "bad chain command"
-inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ())
-inChrootProcess keepprocmounted (Chroot loc _ _) cmd = do
+inChrootProcess :: Bool -> Chroot inner outer -> [String] -> IO (CreateProcess, IO ())
+inChrootProcess keepprocmounted (Chroot loc _ _ _) cmd = do
mountproc
return (proc "chroot" (loc:cmd), cleanup)
where
@@ -244,26 +289,24 @@
provisioningLock :: FilePath -> FilePath
provisioningLock containerloc = "chroot" </> mungeloc containerloc ++ ".lock"
-shimdir :: Chroot -> FilePath
-shimdir (Chroot loc _ _) = "chroot" </> mungeloc loc ++ ".shim"
+shimdir :: Chroot inner outer -> FilePath
+shimdir (Chroot loc _ _ _) = "chroot" </> mungeloc loc ++ ".shim"
mungeloc :: FilePath -> String
mungeloc = replace "/" "_"
-chrootDesc :: Chroot -> String -> String
-chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc
+chrootDesc :: Chroot inner outer -> String -> String
+chrootDesc (Chroot loc _ _ _) desc = "chroot " ++ loc ++ " " ++ desc
|
|
Also, implemented modifyHostProps to add properties to an existing host.
Using it bypasses some type safety. Its use in docker is safe though.
But, in Conductor, the use of it was not really safe, because it was used
with a DebianLike property. Fixed that by making Ssh.installed
target all unix's, although it will fail on non-DebianLike ones.
|
|
It ended up specialized to Linux for a few reasons, including
inChrootProcess's use of umountLazy which is linux specific.
The ChrootBootstrapper type class is specialized to Linux for no good
reason. Future work: Support other unix's.
|
|
Renamed several utility functions along the way.
|
|
The new properties let the type checker know what the target OS is.
|
|
and note that it's not meant to be used by regular users
|
|
I wanted to keep propertyList [foo, bar] working, but had some difficulty
making the type class approach work. Anyway, that's unlikely to be useful,
since foo and bar probably have different types, or could easiy have their
types updated breaking it.
|
|
|
|
|
|
Seems that Canonical have trademarked numerous words ending in "buntu",
and would like to trademark anything ending in that to the extent their
lawyers can make that happen.
|
|
Removed references to *buntu from code and documentation because of
an unfortunate trademark use policy.
http://joeyh.name/blog/entry/trademark_nonsense/
That included changing a data constructor to "FooBuntu", an API change.
|
|
* Properties that run an arbitrary command, such as cmdProperty
and scriptProperty are converted to use UncheckedProperty, since
they cannot tell on their own if the command truely made a change or not.
(API Change)
Transition guide:
- When GHC complains about an UncheckedProperty, add:
`assume` MadeChange
- Since these properties used to always return MadeChange, that
change is always safe to make.
- Or, if you know that the command should modifiy a file, use:
`changesFile` filename
* A few properties have had their Result improved, for example
Apt.buldDep and Apt.autoRemove now check if a change was made or not.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
RevertableProperty used to be assumed to contain info, but this is now made
explicit, with RevertableProperty HasInfo or RevertableProperty NoInfo.
Transition guide:
- If you define a RevertableProperty, expect some type check
failures like: "Expecting one more argument to ‘RevertableProperty’".
- Change it to "RevertableProperty NoInfo"
- The compiler will then tell you if it needs "HasInfo" instead.
- If you have code that uses the RevertableProperty constructor
that fails to type check, use the more powerful <!> operator
|
|
chroot, and won't affect the hostname of the host system.
|
|
|
|
* Where before debootstrapped and bootstrapped took a System parameter,
the os property should now be added to the Chroot.
* Follow-on change to Systemd.container, which now takes a System parameter.
Two motivations for this change:
1. When using ChrootTarball, there may be no particular System that
makes sense for the contents of the tarball, so don't force the user to
specify one.
2. When creating a chroot for a disk image with the same properties
as an existing Host, using hostProperties host to get them, this
allows inheriting the os property from the host, and doesn't require
it to be redundantly passed to Chroot.debootstrapped.
|
|
|
|
|
|
This extracts a minimal tarball into a target directory.
(cherry picked from commit 33ac6c1c4bb2581d6f5a27254e52956e5a257326)
|
|
|
|
So other ways to bootstrap chroots can easily be added in separate modules.
(API change)
|
|
|
|
|
|
This involved some code changes, including some renaming of instance
methods. (ABI change)
|
|
Privdata that uses HostContext inside a container will now have the name of
the container as its context, rather than the name of the host(s) where the
container is used. This allows eg, having different passwords for a user in
different containers.
Note that previously, propellor would prompt using
the container name as the context, but not actually use privdata using that
context; so this is a bug fix.
I don't entirely like the implementation; I had to put the code to change
the context in PropAccum, and it's not generalized past PrivInfo.
|
|
Convert Info to use Data.Dynamic, so properties can export and consume
info of any type that is Typeable and a Monoid, including data types
private to a module. (API change)
Thanks to Joachim Breitner for the idea.
|
|
|
|
While needed for chroot provisioning, it confuses system when
systemd-nspawn runs it inside the container.
|
|
|
|
Propellor.Property.Cmd, so they are available for use in constricting your own Properties when using propellor as a library.
Several imports of Utility.SafeCommand now redundant.
|
|
* Property has been converted to a GADT, and will be Property NoInfo
or Property HasInfo.
This was done to make sure that ensureProperty is only used on
properties that do not have Info.
Transition guide:
- Change all "Property" to "Property NoInfo" or "Property WithInfo"
(The compiler can tell you if you got it wrong!)
- To construct a RevertableProperty, it is useful to use the new
(<!>) operator
- Constructing a list of properties can be problimatic, since
Property NoInto and Property WithInfo are different types and cannot
appear in the same list. To deal with this, "props" has been added,
and can built up a list of properties of different types,
using the same (&) and (!) operators that are used to build
up a host's properties.
|
|
Not yet used
|
|
|
|
|
|
This is more general; it doesn't need to contain a Host.
It would, for example, be possible to make Property itself be an instance
of PropAccum.
|
|
Properties now form a tree, instead of the flat list used before.
This simplifies propigation of Info from the Properties used inside a
container to the outer host; the Property that docks the container on the
host can just have as child properties all the inner Properties, and their
Info can then be gathered recursively. (Although in practice it still needs
to be filtered, since not all Info should propigate out of a container.)
Note that there is no change to how Properties are actually satisfied.
Just because a Property lists some child properties, this does not mean
they always have their propertySatisfy actions run. It's still up to the
parent property to run those actions.
That's necessary so that a container's properties can be satisfied inside
it, not outside. It also allows property combinators to
add the combined Properties to their childProperties list, even if,
like onChange, they don't always run the child properties at all.
Testing: I tested that the exact same Info is calculated before and after
this change, for every Host in my config file.
|
|
where Info is correctly propigated. Better approach needed.
|
|
|
|
|
|
|
