From e02f802ac848fe9395d9a7019b4041eca814b0c9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Apr 2014 11:59:48 -0400 Subject: add PROPELLOR_DEBUG --- Propellor/CmdLine.hs | 28 +++++++++++++++++++++++++--- Propellor/Message.hs | 5 +++++ Propellor/Property/Docker.hs | 7 +++++-- README | 5 +++++ config.hs | 6 ++++-- 5 files changed, 44 insertions(+), 7 deletions(-) diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs index 62f86e63..8edfe19e 100644 --- a/Propellor/CmdLine.hs +++ b/Propellor/CmdLine.hs @@ -1,8 +1,12 @@ module Propellor.CmdLine where -import System.Environment +import System.Environment (getArgs) import Data.List 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.SimpleSh @@ -47,7 +51,9 @@ processCmdLine = go =<< getArgs Nothing -> errorMessage "--continue serialization failure" go ("--simplesh":f:[]) = return $ SimpleSh f go ("--chain":h:[]) = return $ Chain h - go (h:[]) = return $ Run h + go (h:[]) + | "--" `isPrefixOf` h = usage + | otherwise = return $ Run h go [] = do s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"] if null s @@ -56,7 +62,11 @@ processCmdLine = go =<< getArgs go _ = usage 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 go _ (Continue cmdline) = go False cmdline go _ (Set host field) = setPrivData host field @@ -301,3 +311,15 @@ getUrl = maybe nourl return =<< getM get urls return $ case v of Just url | not (null url) -> Just url _ -> 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 diff --git a/Propellor/Message.hs b/Propellor/Message.hs index 90163649..c15661a7 100644 --- a/Propellor/Message.hs +++ b/Propellor/Message.hs @@ -2,6 +2,7 @@ module Propellor.Message where import System.Console.ANSI import System.IO +import System.Log.Logger import Propellor.Types @@ -35,3 +36,7 @@ errorMessage :: String -> IO a errorMessage s = do warningMessage s error "Propellor failed!" + +-- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1 +debug :: [String] -> IO () +debug = debugM "propellor" . unwords diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs index 450f397b..cacff5ce 100644 --- a/Propellor/Property/Docker.hs +++ b/Propellor/Property/Docker.hs @@ -211,8 +211,11 @@ runProp field val = Containerized [param] (Property param (return NoChange)) param = field++"="++val -- | Lift a Property to run inside the container. -inside :: Property -> Containerized Property -inside p = Containerized [] p +inside1 :: Property -> Containerized Property +inside1 = Containerized [] + +inside :: [Property] -> Containerized Property +inside = Containerized [] . combineProperties -- | Set custom dns server for container. dns :: String -> Containerized Property diff --git a/README b/README index e4b8a9dc..3fa092fd 100644 --- a/README +++ b/README @@ -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 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/ diff --git a/config.hs b/config.hs index 88703db7..dbbf89ed 100644 --- a/config.hs +++ b/config.hs @@ -57,8 +57,10 @@ container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container) container _ "webserver" = Just $ Docker.containerFromImage "debian" [ Docker.publish "80:80" , Docker.volume "/var/www:/var/www" - , Docker.inside $ serviceRunning "apache2" - `requires` Apt.installed ["apache2"] + , Docker.inside + [ serviceRunning "apache2" + `requires` Apt.installed ["apache2"] + ] ] container _ _ = Nothing -- cgit v1.2.3