| Age | Commit message (Collapse) | Author |
|---|
|
Turns out that with ghc 8.2.2, the instructions given on the page don't
work. And the cppless variant that I had compiles, but into effectively
mappend = mappend so it loops.
The only way I can see to make it work without cpp is to use
mappend = (Sem.<>)
which is ugly and a land mine waiting to explode if someone changes it
to a nicer mappend = (<>) with a newer version of ghc which will compile
it and work ok, while breaking it with 8.2.2. Sigh.
I posted to haskell-cafe about this.
|
|
Fix build with ghc 8.4, which broke due to the Semigroup Monoid change.
See https://prime.haskell.org/wiki/Libraries/Proposals/SemigroupMonoid
Dropped support for building propellor with ghc 7 (as in debian
oldstable), to avoid needing to depend on the semigroups transitional
package, but also because it's just too old to be worth supporting.
If we indeed drop ghc 7 support entirely, some code to support "jessie"
can be removed; concurrent-output can be de-embedded, and the Singletons
code can be simplified.
This commit was sponsored by Jack Hill on Patreon.
|
|
* DiskImage building properties used to propagate DNS info out from
the chroot used to build the disk image to the Host. That is no longer
done, since that chroot only exists as a side effect of the disk image
creation and servers will not be running in it.
* The IsInfo types class's propagateInfo function changed to use a
PropagateInfo data type. (API change)
This is particularly important when using hostChroot, since the host could
well have DNS settings then.
This commit was sponsored by Ole-Morten Duesund on Patreon.
|
|
* Removed fromPort (use val instead). (API change)
* Removed several Show instances that were only used for generating
configuration, replacing with ConfigurableValue instances. (API change)
It's somewhat annoying that IsInfo requires a Show instance.
That's needed to be able to display Info in ghci, but some non-derived Show
instances had to be kept to support that.
|
|
* Added ConfigurableValue type class, for values that can be used in a
config file, or to otherwise configure a program.
* The val function converts such values to String.
This was motivated by the bug caused by type Port = Int changing to
newtype Port = Port Int deriving Show
After that change, some things that used show port to generate config
files were broken. By using the ConfigurableValue type class instead,
such breakage can be prevented.
|
|
|
|
|
|
it exists.
|
|
|
|
|
|
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.
|
|
|
|
Ssh is WIP and failing to compile quite badly
|
|
(cherry picked from commit 0207c5ab585f41877c1b9f9674a25941cffd2ac7)
|
|
|
|
authorized_keys file does not yet exist.
|
|
* 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
|
|
|
|
And use when reverting conductor property.
Note that I didn't convert existing ssh properties to RevertablePropery
because the API change was too annoying to work through.
|
|
This makes Show Info work, and simplifies the implementation.
|
|
|
|
|
|
|
|
|
|
* Ssh.keyImported is replaced with Ssh.userKeys. (API change)
The new property only gets the private key from the privdata; the
public key is provided as a parameter, and so is available as
Info that other properties can use.
* Ssh.keyImported' is renamed to Ssh.userKeyAt, and also changed
to only import the private key from the privdata. (API change)
* While Ssh.keyImported and Ssh.keyImported' avoided updating existing
keys, the new Ssh.userKeys and Ssh.userKeyAt properties will
always update out of date key files.
* Ssh.pubKey renamed to Ssh.hostPubKey. (API change)
This makes eg, setting up ssh for spin controllers work better.
|
|
|
|
* PrivData converted to newtype (API change).
* Stopped stripping trailing newlines when setting PrivData;
this was previously done to avoid mistakes when pasting eg passwords
with an unwanted newline. Instead, PrivData consumers should use either
privDataLines or privDataVal, to extract respectively lines or a
value (without internal newlines) from PrivData.
|
|
|
|
|
|
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.
|
|
ForcedCommandsOnly (API change)
* Ssh.permitRootLogin type changed to allow configuring WithoutPassword
and ForcedCommandsOnly (API change)
* setSshdConfig type changed, and setSshdConfigBool added with old type.
|
|
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.
|
|
|
|
the type UserName = String were changed to use them.
Note that UserName is kept and PrivData still uses it in its sum type.
This is to avoid breaking PrivData serialization.
|
|
|
|
|
|
* Ssh.authorizedKey: Make the authorized_keys file and .ssh directory
be owned by the user, not root.
* Ssh.knownHost: Make the .ssh directory be owned by the user, not root.
|
|
|
|
|
|
|
|
* 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.
|
|
|
|
SSHFP records.
|
|
didn't already exist.
This is not a new bug.
|
|
|
|
|
|
|
|
|
