commit
8bb175d107
|
@ -6,3 +6,4 @@ privdata/keyring.gpg~
|
|||
Setup
|
||||
Setup.hi
|
||||
Setup.o
|
||||
docker
|
||||
|
|
|
@ -10,13 +10,15 @@ import qualified Propellor.Property.Cron as Cron
|
|||
import qualified Propellor.Property.Sudo as Sudo
|
||||
import qualified Propellor.Property.User as User
|
||||
import qualified Propellor.Property.Hostname as Hostname
|
||||
import qualified Propellor.Property.Reboot as Reboot
|
||||
--import qualified Propellor.Property.Reboot as Reboot
|
||||
import qualified Propellor.Property.Tor as Tor
|
||||
import qualified Propellor.Property.Docker as Docker
|
||||
import qualified Propellor.Property.SiteSpecific.GitHome as GitHome
|
||||
import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder
|
||||
import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites
|
||||
import Data.List
|
||||
-- Only imported to make sure it continues to build.
|
||||
import qualified ConfigSimple as Simple
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain [host, Docker.containerProperties container]
|
||||
|
@ -45,7 +47,7 @@ host hostname@"orca.kitenet.net" = standardSystem Unstable $ props
|
|||
& Docker.configured
|
||||
& Apt.buildDep ["git-annex"]
|
||||
& Docker.docked container hostname "amd64-git-annex-builder"
|
||||
! Docker.docked container hostname "i386-git-annex-builder"
|
||||
& Docker.docked container hostname "i386-git-annex-builder"
|
||||
& Docker.garbageCollected
|
||||
-- My laptop
|
||||
host _hostname@"darkstar.kitenet.net" = Just $ props
|
||||
|
@ -75,17 +77,14 @@ container _host name
|
|||
| otherwise = Nothing
|
||||
|
||||
-- | Docker images I prefer to use.
|
||||
-- Edit as suites you, or delete this function and just put the image names
|
||||
-- above.
|
||||
image :: System -> Docker.Image
|
||||
image (System (Debian Unstable) "amd64") = "joeyh/debian-unstable"
|
||||
image (System (Debian Unstable) "i386") = "joeyh/debian-unstable-i386"
|
||||
image _ = "debian"
|
||||
image (System (Debian Unstable) arch) = "joeyh/debian-unstable-" ++ arch
|
||||
image _ = "debian-stable-official" -- does not currently exist!
|
||||
|
||||
-- This is my standard system setup
|
||||
standardSystem :: DebianSuite -> [Property] -> Maybe [Property]
|
||||
standardSystem suite customprops = Just $
|
||||
standardprops : customprops ++ [endprops]
|
||||
standardprops : customprops ++ endprops
|
||||
where
|
||||
standardprops = propertyList "standard system" $ props
|
||||
& Apt.stdSourcesList suite `onChange` Apt.upgrade
|
||||
|
@ -104,9 +103,11 @@ standardSystem suite customprops = Just $
|
|||
& Apt.installed ["vim", "screen", "less"]
|
||||
& Cron.runPropellor "30 * * * *"
|
||||
-- I use postfix, or no MTA.
|
||||
& Apt.removed ["exim4"] `onChange` Apt.autoRemove
|
||||
-- May reboot, so comes last.
|
||||
endprops = Apt.installed ["systemd-sysv"] `onChange` Reboot.now
|
||||
& Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"]
|
||||
`onChange` Apt.autoRemove
|
||||
-- May reboot, so comes last
|
||||
-- Currently not enable due to #726375
|
||||
endprops = [] -- [Apt.installed ["systemd-sysv"] `onChange` Reboot.now]
|
||||
|
||||
-- Clean up a system as installed by cloudatcost.com
|
||||
cleanCloudAtCost :: HostName -> Property
|
|
@ -15,21 +15,25 @@ actionMessage desc a = do
|
|||
|
||||
r <- a
|
||||
|
||||
setTitle "propellor: running"
|
||||
let (msg, intensity, color) = getActionResult r
|
||||
putStr $ desc ++ " ... "
|
||||
setSGR [SetColor Foreground intensity color]
|
||||
putStrLn msg
|
||||
setSGR []
|
||||
setTitle "propellor: running"
|
||||
colorLine intensity color msg
|
||||
hFlush stdout
|
||||
|
||||
return r
|
||||
|
||||
warningMessage :: String -> IO ()
|
||||
warningMessage s = do
|
||||
setSGR [SetColor Foreground Vivid Red]
|
||||
putStrLn $ "** warning: " ++ s
|
||||
warningMessage s = colorLine Vivid Red $ "** warning: " ++ s
|
||||
|
||||
colorLine :: ColorIntensity -> Color -> String -> IO ()
|
||||
colorLine intensity color msg = do
|
||||
setSGR [SetColor Foreground intensity color]
|
||||
putStr msg
|
||||
setSGR []
|
||||
-- Note this comes after the color is reset, so that
|
||||
-- the color set and reset happen in the same line.
|
||||
putStrLn ""
|
||||
hFlush stdout
|
||||
|
||||
errorMessage :: String -> IO a
|
||||
|
|
|
@ -4,13 +4,6 @@
|
|||
--
|
||||
-- The existance of a docker container is just another Property of a system,
|
||||
-- which propellor can set up. See config.hs for an example.
|
||||
--
|
||||
-- Note that propellor provisions a container by running itself, inside the
|
||||
-- container. Currently, to avoid the overhead of building propellor
|
||||
-- inside the container, the binary from outside is reused inside.
|
||||
-- So, the libraries that propellor is linked against need to be available
|
||||
-- in the container with compatable versions. This can cause a problem
|
||||
-- if eg, mixing Debian stable and unstable.
|
||||
|
||||
module Propellor.Property.Docker where
|
||||
|
||||
|
@ -18,6 +11,7 @@ import Propellor
|
|||
import Propellor.SimpleSh
|
||||
import qualified Propellor.Property.File as File
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import qualified Propellor.Property.Docker.Shim as Shim
|
||||
import Utility.SafeCommand
|
||||
import Utility.Path
|
||||
|
||||
|
@ -256,15 +250,14 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
|
|||
, name (fromContainerId cid)
|
||||
]
|
||||
|
||||
chaincmd = [localdir </> "propellor", "--docker", fromContainerId cid]
|
||||
|
||||
go img = do
|
||||
clearProvisionedFlag cid
|
||||
createDirectoryIfMissing True (takeDirectory $ identFile cid)
|
||||
shim <- Shim.setup (localdir </> "propellor") (localdir </> shimdir cid)
|
||||
writeFile (identFile cid) (show ident)
|
||||
ensureProperty $ boolProperty "run" $ runContainer img
|
||||
(runps ++ ["-i", "-d", "-t"])
|
||||
chaincmd
|
||||
[shim, "--docker", fromContainerId cid]
|
||||
|
||||
-- | Called when propellor is running inside a docker container.
|
||||
-- The string should be the container's ContainerId.
|
||||
|
@ -290,8 +283,9 @@ chain s = case toContainerId s of
|
|||
writeFile propellorIdent . show =<< readIdentFile cid
|
||||
-- Run boot provisioning before starting simpleSh,
|
||||
-- to avoid ever provisioning twice at the same time.
|
||||
whenM (checkProvisionedFlag cid) $
|
||||
unlessM (boolSystem "./propellor" [Param "--continue", Param $ show $ Chain $ fromContainerId cid]) $
|
||||
whenM (checkProvisionedFlag cid) $ do
|
||||
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
|
||||
unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain $ fromContainerId cid]) $
|
||||
warningMessage "Boot provision failed!"
|
||||
void $ async $ simpleSh $ namedPipe cid
|
||||
forever $ do
|
||||
|
@ -310,7 +304,8 @@ chain s = case toContainerId s of
|
|||
-- 1 minute.
|
||||
provisionContainer :: ContainerId -> Property
|
||||
provisionContainer cid = containerDesc cid $ Property "provision" $ do
|
||||
r <- simpleShClientRetry 60 (namedPipe cid) "./propellor" params (go Nothing)
|
||||
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
|
||||
r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing)
|
||||
when (r /= FailedChange) $
|
||||
setProvisionedFlag cid
|
||||
return r
|
||||
|
@ -342,11 +337,17 @@ stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId
|
|||
stoppedContainer :: ContainerId -> Property
|
||||
stoppedContainer cid = containerDesc cid $ Property desc $
|
||||
ifM (elem cid <$> listContainers RunningContainers)
|
||||
( ensureProperty $ boolProperty desc $ stopContainer cid
|
||||
( cleanup `after` ensureProperty
|
||||
(boolProperty desc $ stopContainer cid)
|
||||
, return NoChange
|
||||
)
|
||||
where
|
||||
desc = "stopped"
|
||||
cleanup = do
|
||||
nukeFile $ namedPipe cid
|
||||
nukeFile $ identFile cid
|
||||
removeDirectoryRecursive $ shimdir cid
|
||||
clearProvisionedFlag cid
|
||||
|
||||
removeContainer :: ContainerId -> IO Bool
|
||||
removeContainer cid = catchBoolIO $
|
||||
|
@ -396,10 +397,10 @@ propellorIdent = "/.propellor-ident"
|
|||
|
||||
-- | Named pipe used for communication with the container.
|
||||
namedPipe :: ContainerId -> FilePath
|
||||
namedPipe cid = "docker/" ++ fromContainerId cid
|
||||
namedPipe cid = "docker" </> fromContainerId cid
|
||||
|
||||
provisionedFlag :: ContainerId -> FilePath
|
||||
provisionedFlag cid = "docker/" ++ fromContainerId cid ++ ".provisioned"
|
||||
provisionedFlag cid = "docker" </> fromContainerId cid ++ ".provisioned"
|
||||
|
||||
clearProvisionedFlag :: ContainerId -> IO ()
|
||||
clearProvisionedFlag = nukeFile . provisionedFlag
|
||||
|
@ -412,8 +413,11 @@ setProvisionedFlag cid = do
|
|||
checkProvisionedFlag :: ContainerId -> IO Bool
|
||||
checkProvisionedFlag = doesFileExist . provisionedFlag
|
||||
|
||||
shimdir :: ContainerId -> FilePath
|
||||
shimdir cid = "docker" </> fromContainerId cid ++ ".shim"
|
||||
|
||||
identFile :: ContainerId -> FilePath
|
||||
identFile cid = "docker/" ++ fromContainerId cid ++ ".ident"
|
||||
identFile cid = "docker" </> fromContainerId cid ++ ".ident"
|
||||
|
||||
readIdentFile :: ContainerId -> IO ContainerIdent
|
||||
readIdentFile cid = fromMaybe (error "bad ident in identFile")
|
||||
|
|
|
@ -0,0 +1,58 @@
|
|||
-- | Support for running propellor, as built outside a docker container,
|
||||
-- inside the container.
|
||||
--
|
||||
-- Note: This is currently Debian specific, due to glibcLibs.
|
||||
|
||||
module Propellor.Property.Docker.Shim (setup, file) where
|
||||
|
||||
import Propellor
|
||||
import Utility.LinuxMkLibs
|
||||
import Utility.SafeCommand
|
||||
import Utility.Path
|
||||
import Utility.FileMode
|
||||
|
||||
import Data.List
|
||||
import System.Posix.Files
|
||||
|
||||
-- | Sets up a shimmed version of the program, in a directory, and
|
||||
-- returns its path.
|
||||
setup :: FilePath -> FilePath -> IO FilePath
|
||||
setup propellorbin dest = do
|
||||
createDirectoryIfMissing True dest
|
||||
|
||||
libs <- parseLdd <$> readProcess "ldd" [propellorbin]
|
||||
glibclibs <- glibcLibs
|
||||
let libs' = nub $ libs ++ glibclibs
|
||||
libdirs <- map (dest ++) . nub . catMaybes
|
||||
<$> mapM (installLib installFile dest) libs'
|
||||
|
||||
let linker = (dest ++) $
|
||||
fromMaybe (error "cannot find ld-linux linker") $
|
||||
headMaybe $ filter ("ld-linux" `isInfixOf`) libs'
|
||||
let gconvdir = (dest ++) $ parentDir $
|
||||
fromMaybe (error "cannot find gconv directory") $
|
||||
headMaybe $ filter ("/gconv/" `isInfixOf`) glibclibs
|
||||
let linkerparams = ["--library-path", intercalate ":" libdirs ]
|
||||
let shim = file propellorbin dest
|
||||
writeFile shim $ unlines
|
||||
[ "#!/bin/sh"
|
||||
, "GCONV_PATH=" ++ shellEscape gconvdir
|
||||
, "export GCONV_PATH"
|
||||
, "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++
|
||||
" " ++ shellEscape propellorbin ++ " \"$@\""
|
||||
]
|
||||
modifyFileMode shim (addModes executeModes)
|
||||
return shim
|
||||
|
||||
file :: FilePath -> FilePath -> FilePath
|
||||
file propellorbin dest = dest </> takeFileName propellorbin
|
||||
|
||||
installFile :: FilePath -> FilePath -> IO ()
|
||||
installFile top f = do
|
||||
createDirectoryIfMissing True destdir
|
||||
nukeFile dest
|
||||
createLink f dest `catchIO` (const copy)
|
||||
where
|
||||
copy = void $ boolSystem "cp" [Param "-a", Param f, Param dest]
|
||||
destdir = inTop top $ parentDir f
|
||||
dest = inTop top f
|
|
@ -2,6 +2,8 @@ module Propellor.Property.File where
|
|||
|
||||
import Propellor
|
||||
|
||||
import System.Posix.Files
|
||||
|
||||
type Line = String
|
||||
|
||||
-- | Replaces all the content of a file.
|
||||
|
@ -32,13 +34,19 @@ fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
|
|||
fileProperty desc a f = Property desc $ go =<< doesFileExist f
|
||||
where
|
||||
go True = do
|
||||
ls <- lines <$> catchDefaultIO [] (readFile f)
|
||||
ls <- lines <$> readFile f
|
||||
let ls' = a ls
|
||||
if ls' == ls
|
||||
then noChange
|
||||
else makeChange $ viaTmp writeFile f (unlines ls')
|
||||
else makeChange $ viaTmp updatefile f (unlines ls')
|
||||
go False = makeChange $ writeFile f (unlines $ a [])
|
||||
|
||||
-- viaTmp makes the temp file mode 600.
|
||||
-- Replicate the original file mode before moving it into place.
|
||||
updatefile f' content = do
|
||||
writeFile f' content
|
||||
getFileStatus f >>= setFileMode f' . fileMode
|
||||
|
||||
-- | Ensures a directory exists.
|
||||
dirExists :: FilePath -> Property
|
||||
dirExists d = check (not <$> doesDirectoryExist d) $ Property (d ++ " exists") $
|
||||
|
|
|
@ -3,7 +3,29 @@ module Propellor.Property.Hostname where
|
|||
import Propellor
|
||||
import qualified Propellor.Property.File as File
|
||||
|
||||
-- | Sets the hostname. Configures both /etc/hostname and the current
|
||||
-- hostname.
|
||||
--
|
||||
-- When provided with a FQDN, also configures /etc/hosts,
|
||||
-- with an entry for 127.0.1.1, which is standard at least on Debian
|
||||
-- to set the FDQN (127.0.0.1 is localhost).
|
||||
set :: HostName -> Property
|
||||
set hostname = "/etc/hostname" `File.hasContent` [hostname]
|
||||
`onChange` cmdProperty "hostname" [hostname]
|
||||
`describe` ("hostname " ++ hostname)
|
||||
set hostname = combineProperties desc go
|
||||
`onChange` cmdProperty "hostname" [host]
|
||||
where
|
||||
desc = "hostname " ++ hostname
|
||||
(host, domain) = separate (== '.') hostname
|
||||
|
||||
go = catMaybes
|
||||
[ Just $ "/etc/hostname" `File.hasContent` [host]
|
||||
, if null domain
|
||||
then Nothing
|
||||
else Just $ File.fileProperty desc
|
||||
addhostline "/etc/hosts"
|
||||
]
|
||||
|
||||
hostip = "127.0.1.1"
|
||||
hostline = hostip ++ "\t" ++ hostname ++ " " ++ host
|
||||
|
||||
addhostline ls = hostline : filter (not . hashostip) ls
|
||||
hashostip l = headMaybe (words l) == Just hostip
|
||||
|
|
2
TODO
2
TODO
|
@ -12,3 +12,5 @@
|
|||
says they are unchanged even when they changed and triggered a
|
||||
reprovision.
|
||||
* Should properties be a tree rather than a list?
|
||||
* Only make docker garbage collection run once a day or something
|
||||
to avoid GC after a temp fail.
|
||||
|
|
|
@ -0,0 +1,61 @@
|
|||
{- Linux library copier and binary shimmer
|
||||
-
|
||||
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Utility.LinuxMkLibs where
|
||||
|
||||
import Control.Applicative
|
||||
import Data.Maybe
|
||||
import System.Directory
|
||||
import Data.List.Utils
|
||||
import System.Posix.Files
|
||||
import Data.Char
|
||||
import Control.Monad.IfElse
|
||||
|
||||
import Utility.PartialPrelude
|
||||
import Utility.Directory
|
||||
import Utility.Process
|
||||
import Utility.Monad
|
||||
import Utility.Path
|
||||
|
||||
{- Installs a library. If the library is a symlink to another file,
|
||||
- install the file it links to, and update the symlink to be relative. -}
|
||||
installLib :: (FilePath -> FilePath -> IO ()) -> FilePath -> FilePath -> IO (Maybe FilePath)
|
||||
installLib installfile top lib = ifM (doesFileExist lib)
|
||||
( do
|
||||
installfile top lib
|
||||
checksymlink lib
|
||||
return $ Just $ parentDir lib
|
||||
, return Nothing
|
||||
)
|
||||
where
|
||||
checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do
|
||||
l <- readSymbolicLink (inTop top f)
|
||||
let absl = absPathFrom (parentDir f) l
|
||||
let target = relPathDirToFile (parentDir f) absl
|
||||
installfile top absl
|
||||
nukeFile (top ++ f)
|
||||
createSymbolicLink target (inTop top f)
|
||||
checksymlink absl
|
||||
|
||||
-- Note that f is not relative, so cannot use </>
|
||||
inTop :: FilePath -> FilePath -> FilePath
|
||||
inTop top f = top ++ f
|
||||
|
||||
{- Parse ldd output, getting all the libraries that the input files
|
||||
- link to. Note that some of the libraries may not exist
|
||||
- (eg, linux-vdso.so) -}
|
||||
parseLdd :: String -> [FilePath]
|
||||
parseLdd = catMaybes . map (getlib . dropWhile isSpace) . lines
|
||||
where
|
||||
getlib l = headMaybe . words =<< lastMaybe (split " => " l)
|
||||
|
||||
{- Get all glibc libs and other support files, including gconv files
|
||||
-
|
||||
- XXX Debian specific. -}
|
||||
glibcLibs :: IO [FilePath]
|
||||
glibcLibs = lines <$> readProcess "sh"
|
||||
["-c", "dpkg -L libc6:$(dpkg --print-architecture) libgcc1:$(dpkg --print-architecture) | egrep '\\.so|gconv'"]
|
|
@ -1,3 +1,12 @@
|
|||
propellor (0.2.2) unstable; urgency=medium
|
||||
|
||||
* Now supports provisioning docker containers with architecture/libraries
|
||||
that do not match the host.
|
||||
* Fixed a bug that caused file modes to be set to 600 when propellor
|
||||
modified the file (did not affect newly created files).
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Fri, 04 Apr 2014 01:07:32 -0400
|
||||
|
||||
propellor (0.2.1) unstable; urgency=medium
|
||||
|
||||
* First release with Debian package.
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
Name: propellor
|
||||
Version: 0.2.1
|
||||
Version: 0.2.2
|
||||
Cabal-Version: >= 1.6
|
||||
License: GPL
|
||||
Maintainer: Joey Hess <joey@kitenet.net>
|
||||
|
@ -14,8 +14,6 @@ Extra-Source-Files:
|
|||
README.md
|
||||
TODO
|
||||
CHANGELOG
|
||||
config-simple.hs
|
||||
config-joeyh.hs
|
||||
Makefile
|
||||
debian/changelog
|
||||
debian/README.Debian
|
||||
|
@ -64,6 +62,8 @@ Library
|
|||
|
||||
Exposed-Modules:
|
||||
Propellor
|
||||
Propellor.Config.Simple
|
||||
Propellor.Config.Joey
|
||||
Propellor.Property
|
||||
Propellor.Property.Apt
|
||||
Propellor.Property.Cmd
|
||||
|
@ -87,6 +87,7 @@ Library
|
|||
Other-Modules:
|
||||
Propellor.CmdLine
|
||||
Propellor.SimpleSh
|
||||
Propellor.Property.Docker.Shim
|
||||
Utility.Applicative
|
||||
Utility.Data
|
||||
Utility.Directory
|
||||
|
@ -94,6 +95,7 @@ Library
|
|||
Utility.Exception
|
||||
Utility.FileMode
|
||||
Utility.FileSystemEncoding
|
||||
Utility.LinuxMkLibs
|
||||
Utility.Misc
|
||||
Utility.Monad
|
||||
Utility.Path
|
||||
|
|
Loading…
Reference in New Issue