add PROPELLOR_DEBUG

This commit is contained in:
Joey Hess 2014-04-01 11:59:48 -04:00
parent bf4ba05528
commit e02f802ac8
5 changed files with 44 additions and 7 deletions

View File

@ -1,8 +1,12 @@
module Propellor.CmdLine where module Propellor.CmdLine where
import System.Environment import System.Environment (getArgs)
import Data.List import Data.List
import System.Exit import System.Exit
import System.Log.Logger
import System.Log.Formatter
import System.Log.Handler (setFormatter, LogHandler)
import System.Log.Handler.Simple
import Propellor import Propellor
import Propellor.SimpleSh import Propellor.SimpleSh
@ -47,7 +51,9 @@ processCmdLine = go =<< getArgs
Nothing -> errorMessage "--continue serialization failure" Nothing -> errorMessage "--continue serialization failure"
go ("--simplesh":f:[]) = return $ SimpleSh f go ("--simplesh":f:[]) = return $ SimpleSh f
go ("--chain":h:[]) = return $ Chain h go ("--chain":h:[]) = return $ Chain h
go (h:[]) = return $ Run h go (h:[])
| "--" `isPrefixOf` h = usage
| otherwise = return $ Run h
go [] = do go [] = do
s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"] s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"]
if null s if null s
@ -56,7 +62,11 @@ processCmdLine = go =<< getArgs
go _ = usage go _ = usage
defaultMain :: [HostName -> Maybe [Property]] -> IO () defaultMain :: [HostName -> Maybe [Property]] -> IO ()
defaultMain getprops = go True =<< processCmdLine defaultMain getprops = do
checkDebugMode
cmdline <- processCmdLine
debug ["command line: ", show cmdline]
go True cmdline
where where
go _ (Continue cmdline) = go False cmdline go _ (Continue cmdline) = go False cmdline
go _ (Set host field) = setPrivData host field go _ (Set host field) = setPrivData host field
@ -301,3 +311,15 @@ getUrl = maybe nourl return =<< getM get urls
return $ case v of return $ case v of
Just url | not (null url) -> Just url Just url | not (null url) -> Just url
_ -> Nothing _ -> Nothing
checkDebugMode :: IO ()
checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
where
go (Just s)
| s == "1" = do
f <- setFormatter
<$> streamHandler stderr DEBUG
<*> pure (simpleLogFormatter "[$time] $msg")
updateGlobalLogger rootLoggerName $
setLevel DEBUG . setHandlers [f]
go _ = noop

View File

@ -2,6 +2,7 @@ module Propellor.Message where
import System.Console.ANSI import System.Console.ANSI
import System.IO import System.IO
import System.Log.Logger
import Propellor.Types import Propellor.Types
@ -35,3 +36,7 @@ errorMessage :: String -> IO a
errorMessage s = do errorMessage s = do
warningMessage s warningMessage s
error "Propellor failed!" error "Propellor failed!"
-- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1
debug :: [String] -> IO ()
debug = debugM "propellor" . unwords

View File

@ -211,8 +211,11 @@ runProp field val = Containerized [param] (Property param (return NoChange))
param = field++"="++val param = field++"="++val
-- | Lift a Property to run inside the container. -- | Lift a Property to run inside the container.
inside :: Property -> Containerized Property inside1 :: Property -> Containerized Property
inside p = Containerized [] p inside1 = Containerized []
inside :: [Property] -> Containerized Property
inside = Containerized [] . combineProperties
-- | Set custom dns server for container. -- | Set custom dns server for container.
dns :: String -> Containerized Property dns :: String -> Containerized Property

5
README
View File

@ -87,4 +87,9 @@ To securely store private data, use: propellor --set $host $field
The field name will be something like 'Password "root"'; see PrivData.hs The field name will be something like 'Password "root"'; see PrivData.hs
for available fields. for available fields.
## debugging
Set PROPELLOR_DEBUG=1 to make propellor print out all the commands it runs
and anything other debug messages Properties choose to.
[1] http://reclass.pantsfullofunix.net/ [1] http://reclass.pantsfullofunix.net/

View File

@ -57,8 +57,10 @@ container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container)
container _ "webserver" = Just $ Docker.containerFromImage "debian" container _ "webserver" = Just $ Docker.containerFromImage "debian"
[ Docker.publish "80:80" [ Docker.publish "80:80"
, Docker.volume "/var/www:/var/www" , Docker.volume "/var/www:/var/www"
, Docker.inside $ serviceRunning "apache2" , Docker.inside
`requires` Apt.installed ["apache2"] [ serviceRunning "apache2"
`requires` Apt.installed ["apache2"]
]
] ]
container _ _ = Nothing container _ _ = Nothing