module Propellor.CmdLine (
	defaultMain,
	processCmdLine,
) where

import System.Environment (getArgs)
import Data.List
import System.Exit
import System.PosixCompat
import Network.Socket

import Propellor.Base
import Propellor.Gpg
import Propellor.Git
import Propellor.Git.VerifiedBranch
import Propellor.Bootstrap
import Propellor.Spin
import Propellor.Types.CmdLine
import qualified Propellor.Property.Docker as Docker
import qualified Propellor.Property.Chroot as Chroot
import qualified Propellor.Shim as Shim
import Utility.FileSystemEncoding

usage :: Handle -> IO ()
usage :: Handle -> IO ()
usage h :: Handle
h = Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
	[ "Usage:"
	, "  with no arguments, provision the current host"
	, ""
	, "  --init"
	, "      initialize ~/.propellor"
	, "  hostname"
	, "      provision the current host as if it had the specified hostname"
	, "  --spin targethost [--via relayhost]"
	, "      provision the specified host"
	, "  --build"
	, "      recompile using your current config"
	, "  --add-key keyid"
	, "      add an additional signing key to the private data"
	, "  --rm-key keyid"
	, "      remove a signing key from the private data"
	, "  --list-fields"
	, "      list private data fields"
	, "  --set field context"
	, "      set a private data field"
	, "  --unset field context"
	, "      clear a private data field"
	, "  --unset-unused"
	, "      clear unused fields from the private data"
	, "  --dump field context"
	, "      show the content of a private data field"
	, "  --edit field context"
	, "      edit the content of a private data field"
	, "  --merge"
	, "      combine multiple spins into a single git commit"
	, "  --check"
	, "      double-check that propellor can actually run here"]

usageError :: [String] -> IO a
usageError :: [String] -> IO a
usageError ps :: [String]
ps = do
	Handle -> IO ()
usage Handle
stderr
	String -> IO a
forall a. HasCallStack => String -> a
error ("(Unexpected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
ps)

processCmdLine :: IO CmdLine
processCmdLine :: IO CmdLine
processCmdLine = [String] -> IO CmdLine
go ([String] -> IO CmdLine) -> IO [String] -> IO CmdLine
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String]
getArgs
  where
	go :: [String] -> IO CmdLine
go ("--check":_) = CmdLine -> IO CmdLine
forall (m :: * -> *) a. Monad m => a -> m a
return CmdLine
Check
	go ("--spin":ps :: [String]
ps) = case [String] -> [String]
forall a. [a] -> [a]
reverse [String]
ps of
		(r :: String
r:"--via":hs :: [String]
hs) -> [String] -> Maybe String -> CmdLine
Spin
			([String] -> Maybe String -> CmdLine)
-> IO [String] -> IO (Maybe String -> CmdLine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO String
hostname ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
hs)
			IO (Maybe String -> CmdLine) -> IO (Maybe String) -> IO CmdLine
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe String
forall a. a -> Maybe a
Just String
r)
		_ -> [String] -> Maybe String -> CmdLine
Spin ([String] -> Maybe String -> CmdLine)
-> IO [String] -> IO (Maybe String -> CmdLine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO String
hostname [String]
ps IO (Maybe String -> CmdLine) -> IO (Maybe String) -> IO CmdLine
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
	go ("--build":[]) = CmdLine -> IO CmdLine
forall (m :: * -> *) a. Monad m => a -> m a
return CmdLine
Build
	go ("--add-key":k :: String
k:[]) = CmdLine -> IO CmdLine
forall (m :: * -> *) a. Monad m => a -> m a
return (CmdLine -> IO CmdLine) -> CmdLine -> IO CmdLine
forall a b. (a -> b) -> a -> b
$ String -> CmdLine
AddKey String
k
	go ("--rm-key":k :: String
k:[]) = CmdLine -> IO CmdLine
forall (m :: * -> *) a. Monad m => a -> m a
return (CmdLine -> IO CmdLine) -> CmdLine -> IO CmdLine
forall a b. (a -> b) -> a -> b
$ String -> CmdLine
RmKey String
k
	go ("--set":f :: String
f:c :: String
c:[]) = String
-> String -> (PrivDataField -> Context -> CmdLine) -> IO CmdLine
forall t (m :: * -> *) a.
(Read t, MonadIO m) =>
String -> String -> (t -> Context -> a) -> m a
withprivfield String
f String
c PrivDataField -> Context -> CmdLine
Set
	go ("--unset":f :: String
f:c :: String
c:[]) = String
-> String -> (PrivDataField -> Context -> CmdLine) -> IO CmdLine
forall t (m :: * -> *) a.
(Read t, MonadIO m) =>
String -> String -> (t -> Context -> a) -> m a
withprivfield String
f String
c PrivDataField -> Context -> CmdLine
Unset
	go ("--unset-unused":[]) = CmdLine -> IO CmdLine
forall (m :: * -> *) a. Monad m => a -> m a
return CmdLine
UnsetUnused
	go ("--dump":f :: String
f:c :: String
c:[]) = String
-> String -> (PrivDataField -> Context -> CmdLine) -> IO CmdLine
forall t (m :: * -> *) a.
(Read t, MonadIO m) =>
String -> String -> (t -> Context -> a) -> m a
withprivfield String
f String
c PrivDataField -> Context -> CmdLine
Dump
	go ("--edit":f :: String
f:c :: String
c:[]) = String
-> String -> (PrivDataField -> Context -> CmdLine) -> IO CmdLine
forall t (m :: * -> *) a.
(Read t, MonadIO m) =>
String -> String -> (t -> Context -> a) -> m a
withprivfield String
f String
c PrivDataField -> Context -> CmdLine
Edit
	go ("--list-fields":[]) = CmdLine -> IO CmdLine
forall (m :: * -> *) a. Monad m => a -> m a
return CmdLine
ListFields
	go ("--merge":[]) = CmdLine -> IO CmdLine
forall (m :: * -> *) a. Monad m => a -> m a
return CmdLine
Merge
	go ("--help":_) = do
		Handle -> IO ()
usage Handle
stdout
		IO CmdLine
forall a. IO a
exitFailure
	go ("--boot":_:[]) = CmdLine -> IO CmdLine
forall (m :: * -> *) a. Monad m => a -> m a
return (CmdLine -> IO CmdLine) -> CmdLine -> IO CmdLine
forall a b. (a -> b) -> a -> b
$ Maybe String -> CmdLine
Update Maybe String
forall a. Maybe a
Nothing -- for back-compat
	go ("--serialized":s :: String
s:[]) = (CmdLine -> CmdLine) -> String -> IO CmdLine
forall t (m :: * -> *) a.
(Read t, MonadIO m) =>
(t -> a) -> String -> m a
serialized CmdLine -> CmdLine
Serialized String
s
	go ("--continue":s :: String
s:[]) = (CmdLine -> CmdLine) -> String -> IO CmdLine
forall t (m :: * -> *) a.
(Read t, MonadIO m) =>
(t -> a) -> String -> m a
serialized CmdLine -> CmdLine
Continue String
s
	go ("--gitpush":fin :: String
fin:fout :: String
fout:_) = CmdLine -> IO CmdLine
forall (m :: * -> *) a. Monad m => a -> m a
return (CmdLine -> IO CmdLine) -> CmdLine -> IO CmdLine
forall a b. (a -> b) -> a -> b
$ Fd -> Fd -> CmdLine
GitPush (String -> Fd
forall a. Read a => String -> a
Prelude.read String
fin) (String -> Fd
forall a. Read a => String -> a
Prelude.read String
fout)
	go ("--run":h :: String
h:[]) = [String] -> IO CmdLine
go [String
h]
	go (h :: String
h:[])
		| "--" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
h = [String] -> IO CmdLine
forall a. [String] -> IO a
usageError [String
h]
		| Bool
otherwise = String -> CmdLine
Run (String -> CmdLine) -> IO String -> IO CmdLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
hostname String
h
	go [] = do
		String
s <- (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n') (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO String
readProcess "hostname" ["-f"]
		if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s
			then String -> IO CmdLine
forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage "Cannot determine hostname! Pass it on the command line."
			else CmdLine -> IO CmdLine
forall (m :: * -> *) a. Monad m => a -> m a
return (CmdLine -> IO CmdLine) -> CmdLine -> IO CmdLine
forall a b. (a -> b) -> a -> b
$ String -> CmdLine
Run String
s
	go v :: [String]
v = [String] -> IO CmdLine
forall a. [String] -> IO a
usageError [String]
v

	withprivfield :: String -> String -> (t -> Context -> a) -> m a
withprivfield s :: String
s c :: String
c f :: t -> Context -> a
f = case String -> Maybe t
forall a. Read a => String -> Maybe a
readish String
s of
		Just pf :: t
pf -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ t -> Context -> a
f t
pf (String -> Context
Context String
c)
		Nothing -> String -> m a
forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ "Unknown privdata field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

	serialized :: (t -> a) -> String -> m a
serialized mk :: t -> a
mk s :: String
s = case String -> Maybe t
forall a. Read a => String -> Maybe a
readish String
s of
		Just cmdline :: t
cmdline -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ t -> a
mk t
cmdline
		Nothing -> String -> m a
forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ "serialization failure (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"

data CanRebuild = CanRebuild | NoRebuild

-- | Runs propellor on hosts, as controlled by command-line options.
defaultMain :: [Host] -> IO ()
defaultMain :: [Host] -> IO ()
defaultMain hostlist :: [Host]
hostlist = IO () -> IO ()
forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
withConcurrentOutput (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
	IO ()
useFileSystemEncoding
	IO ()
setupGpgEnv
	IO ()
Shim.cleanEnv
	IO ()
checkDebugMode
	CmdLine
cmdline <- IO CmdLine
processCmdLine
	[String] -> IO ()
debug ["command line: ", CmdLine -> String
forall a. Show a => a -> String
show CmdLine
cmdline]
	CanRebuild -> CmdLine -> IO ()
go CanRebuild
CanRebuild CmdLine
cmdline
  where
	go :: CanRebuild -> CmdLine -> IO ()
go cr :: CanRebuild
cr (Serialized cmdline :: CmdLine
cmdline) = CanRebuild -> CmdLine -> IO ()
go CanRebuild
cr CmdLine
cmdline
	go _ Check = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
	go cr :: CanRebuild
cr Build = Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
buildFirst Maybe Host
forall a. Maybe a
Nothing CanRebuild
cr CmdLine
Build (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
	go _ (Set field :: PrivDataField
field context :: Context
context) = PrivDataField -> Context -> IO ()
setPrivData PrivDataField
field Context
context
	go _ (Unset field :: PrivDataField
field context :: Context
context) = PrivDataField -> Context -> IO ()
unsetPrivData PrivDataField
field Context
context
	go _ (CmdLine
UnsetUnused) = [Host] -> IO ()
unsetPrivDataUnused [Host]
hostlist
	go _ (Dump field :: PrivDataField
field context :: Context
context) = PrivDataField -> Context -> IO ()
dumpPrivData PrivDataField
field Context
context
	go _ (Edit field :: PrivDataField
field context :: Context
context) = PrivDataField -> Context -> IO ()
editPrivData PrivDataField
field Context
context
	go _ ListFields = [Host] -> IO ()
listPrivDataFields [Host]
hostlist
	go _ (AddKey keyid :: String
keyid) = String -> IO ()
addKey String
keyid
	go _ (RmKey keyid :: String
keyid) = String -> IO ()
rmKey String
keyid
	go _ c :: CmdLine
c@(ChrootChain _ _ _ _ _) = [Host] -> CmdLine -> IO ()
Chroot.chain [Host]
hostlist CmdLine
c
	go _ (DockerChain hn :: String
hn cid :: String
cid) = [Host] -> String -> String -> IO ()
Docker.chain [Host]
hostlist String
hn String
cid
	go _ (DockerInit hn :: String
hn) = String -> IO ()
Docker.init String
hn
	go _ (GitPush fin :: Fd
fin fout :: Fd
fout) = Fd -> Fd -> IO ()
gitPushHelper Fd
fin Fd
fout
	go cr :: CanRebuild
cr (Relay h :: String
h) = IO ()
forceConsole IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
		Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
updateFirst Maybe Host
forall a. Maybe a
Nothing CanRebuild
cr (Maybe String -> CmdLine
Update (String -> Maybe String
forall a. a -> Maybe a
Just String
h)) (Maybe String -> IO ()
update (String -> Maybe String
forall a. a -> Maybe a
Just String
h))
	go _ (Update Nothing) = IO ()
forceConsole IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
		IO () -> IO ()
fetchFirst (IO () -> IO ()
forall a. IO a -> IO a
onlyprocess (Maybe String -> IO ()
update Maybe String
forall a. Maybe a
Nothing))
	go _ (Update (Just h :: String
h)) = Maybe String -> IO ()
update (String -> Maybe String
forall a. a -> Maybe a
Just String
h)
	go _ Merge = IO ()
mergeSpin
	go cr :: CanRebuild
cr cmdline :: CmdLine
cmdline@(Spin hs :: [String]
hs mrelay :: Maybe String
mrelay) = Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
buildFirst Maybe Host
forall a. Maybe a
Nothing CanRebuild
cr CmdLine
cmdline (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
mrelay) IO ()
commitSpin
		[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
hs ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \hn :: String
hn -> String -> (Host -> IO ()) -> IO ()
withhost String
hn ((Host -> IO ()) -> IO ()) -> (Host -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> Host -> IO ()
spin Maybe String
mrelay String
hn
	go cr :: CanRebuild
cr cmdline :: CmdLine
cmdline@(Run hn :: String
hn) = IO Bool -> (IO (), IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
(==) 0 (UserID -> Bool) -> IO UserID -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UserID
getRealUserID)
		( Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
updateFirst ([Host] -> String -> Maybe Host
findHost [Host]
hostlist String
hn) CanRebuild
cr CmdLine
cmdline (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
runhost String
hn
		, IO () -> IO ()
fetchFirst (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ CanRebuild -> CmdLine -> IO ()
go CanRebuild
cr ([String] -> Maybe String -> CmdLine
Spin [String
hn] Maybe String
forall a. Maybe a
Nothing)
		)
	go cr :: CanRebuild
cr cmdline :: CmdLine
cmdline@(SimpleRun hn :: String
hn) = IO ()
forceConsole IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
		IO () -> IO ()
fetchFirst (Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
buildFirst ([Host] -> String -> Maybe Host
findHost [Host]
hostlist String
hn) CanRebuild
cr CmdLine
cmdline (String -> IO ()
runhost String
hn))
	-- When continuing after a rebuild, don't want to rebuild again.
	go _ (Continue cmdline :: CmdLine
cmdline) = CanRebuild -> CmdLine -> IO ()
go CanRebuild
NoRebuild CmdLine
cmdline

	withhost :: HostName -> (Host -> IO ()) -> IO ()
	withhost :: String -> (Host -> IO ()) -> IO ()
withhost hn :: String
hn a :: Host -> IO ()
a = IO () -> (Host -> IO ()) -> Maybe Host -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> [Host] -> IO ()
forall a. String -> [Host] -> IO a
unknownhost String
hn [Host]
hostlist) Host -> IO ()
a ([Host] -> String -> Maybe Host
findHost [Host]
hostlist String
hn)

	runhost :: String -> IO ()
runhost hn :: String
hn = IO () -> IO ()
forall a. IO a -> IO a
onlyprocess (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (Host -> IO ()) -> IO ()
withhost String
hn Host -> IO ()
mainProperties

	onlyprocess :: IO a -> IO a
onlyprocess = String -> IO a -> IO a
forall a. String -> IO a -> IO a
onlyProcess (String
localdir String -> String -> String
</> ".lock")

unknownhost :: HostName -> [Host] -> IO a
unknownhost :: String -> [Host] -> IO a
unknownhost h :: String
h hosts :: [Host]
hosts = String -> IO a
forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
	[ "Propellor does not know about host: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h
	, "(Perhaps you should specify the real hostname on the command line?)"
	, "(Or, edit propellor's config.hs to configure this host)"
	, "Known hosts: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((Host -> String) -> [Host] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Host -> String
hostName [Host]
hosts)
	]

-- Builds propellor (when allowed) and if it looks like a new binary,
-- re-execs it to continue.
-- Otherwise, runs the IO action to continue.
--
-- The Host should only be provided when dependencies should be installed
-- as needed to build propellor.
buildFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
buildFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
buildFirst h :: Maybe Host
h CanRebuild cmdline :: CmdLine
cmdline next :: IO ()
next = do
	Maybe UTCTime
oldtime <- IO (Maybe UTCTime)
getmtime
	Maybe Host -> IO ()
buildPropellor Maybe Host
h
	Maybe UTCTime
newtime <- IO (Maybe UTCTime)
getmtime
	if Maybe UTCTime
newtime Maybe UTCTime -> Maybe UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe UTCTime
oldtime
		then IO ()
next
		else CmdLine -> IO ()
forall a. CmdLine -> IO a
continueAfterBuild CmdLine
cmdline
  where
	getmtime :: IO (Maybe UTCTime)
getmtime = IO UTCTime -> IO (Maybe UTCTime)
forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (IO UTCTime -> IO (Maybe UTCTime))
-> IO UTCTime -> IO (Maybe UTCTime)
forall a b. (a -> b) -> a -> b
$ String -> IO UTCTime
getModificationTime "propellor"
buildFirst _ NoRebuild _ next :: IO ()
next = IO ()
next

continueAfterBuild :: CmdLine -> IO a
continueAfterBuild :: CmdLine -> IO a
continueAfterBuild cmdline :: CmdLine
cmdline = Bool -> IO a
forall a. Bool -> IO a
go (Bool -> IO a) -> IO Bool -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [CommandParam] -> IO Bool
boolSystem "./propellor"
	[ String -> CommandParam
Param "--continue"
	, String -> CommandParam
Param (CmdLine -> String
forall a. Show a => a -> String
show CmdLine
cmdline)
	]
  where
	go :: Bool -> IO a
go True = IO a
forall a. IO a
exitSuccess
	go False = ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)

fetchFirst :: IO () -> IO ()
fetchFirst :: IO () -> IO ()
fetchFirst next :: IO ()
next = do
	IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM IO Bool
hasOrigin (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
		IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO Bool
fetchOrigin
	IO ()
next

updateFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
updateFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
updateFirst h :: Maybe Host
h canrebuild :: CanRebuild
canrebuild cmdline :: CmdLine
cmdline next :: IO ()
next = IO Bool -> (IO (), IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM IO Bool
hasOrigin
	( Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
updateFirst' Maybe Host
h CanRebuild
canrebuild CmdLine
cmdline IO ()
next
	, IO ()
next
	)

-- If changes can be fetched from origin, builds propellor (when allowed)
-- and re-execs the updated propellor binary to continue.
-- Otherwise, runs the IO action to continue.
updateFirst' :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
updateFirst' :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
updateFirst' h :: Maybe Host
h CanRebuild cmdline :: CmdLine
cmdline next :: IO ()
next = IO Bool -> (IO (), IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM IO Bool
fetchOrigin
	( do
		Maybe Host -> IO ()
buildPropellor Maybe Host
h
		CmdLine -> IO ()
forall a. CmdLine -> IO a
continueAfterBuild CmdLine
cmdline
	, IO ()
next
	)
updateFirst' _ NoRebuild _ next :: IO ()
next = IO ()
next

-- Gets the fully qualified domain name, given a string that might be
-- a short name to look up in the DNS.
hostname :: String -> IO HostName
hostname :: String -> IO String
hostname s :: String
s = [AddrInfo] -> IO String
forall (f :: * -> *). Applicative f => [AddrInfo] -> f String
go ([AddrInfo] -> IO String) -> IO [AddrInfo] -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [AddrInfo] -> IO [AddrInfo] -> IO [AddrInfo]
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO [] IO [AddrInfo]
dnslookup
  where
	dnslookup :: IO [AddrInfo]
dnslookup = Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
canonname) (String -> Maybe String
forall a. a -> Maybe a
Just String
s) Maybe String
forall a. Maybe a
Nothing
	canonname :: AddrInfo
canonname = AddrInfo
defaultHints { addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_CANONNAME] }
	go :: [AddrInfo] -> f String
go (AddrInfo { addrCanonName :: AddrInfo -> Maybe String
addrCanonName = Just v :: String
v } : _) = String -> f String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
v
	go _
		| "." String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s = String -> f String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s -- assume it's a fqdn
		| Bool
otherwise =
			String -> f String
forall a. HasCallStack => String -> a
error (String -> f String) -> String -> f String
forall a b. (a -> b) -> a -> b
$ "cannot find host " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ " in the DNS"