summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2015-01-01 13:28:17 -0400
committerJoey Hess2015-01-01 13:28:17 -0400
commit0b4a95f6c212e7d103cec5737f1917a413b0b1c2 (patch)
tree257f9431fe0498ed99574c7129ed3a74c415b3bb /src/Propellor
parentdb882415021508ced8b0b8e1ce78f03cc5cf724a (diff)
--spin checks if the DNS matches any configured IP address property of the host, and if not, sshes to the host by IP address.
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/Spin.hs36
1 files changed, 32 insertions, 4 deletions
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 3bafd165..a9a61c16 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -14,6 +14,9 @@ import System.Posix.Directory
import Control.Concurrent.Async
import Control.Exception (bracket)
import qualified Data.ByteString as B
+import qualified Data.Set as S
+import qualified Network.BSD as BSD
+import Network.Socket (inet_ntoa)
import Propellor
import Propellor.Protocol
@@ -44,17 +47,20 @@ spin target relay hst = do
when viarelay $
void $ boolSystem "ssh-add" []
+ sshtarget <- ("root@" ++) <$> case relay of
+ Just r -> pure r
+ Nothing -> getSshTarget target hst
+
-- Install, or update the remote propellor.
updateServer target relay hst
- (proc "ssh" $ cacheparams ++ [user, shellWrap probecmd])
- (proc "ssh" $ cacheparams ++ [user, shellWrap updatecmd])
+ (proc "ssh" $ cacheparams ++ [sshtarget, shellWrap probecmd])
+ (proc "ssh" $ cacheparams ++ [sshtarget, shellWrap updatecmd])
-- And now we can run it.
- unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, shellWrap runcmd])) $
+ unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $
error $ "remote propellor failed"
where
hn = fromMaybe target relay
- user = "root@"++hn
relaying = relay == Just target
viarelay = isJust relay && not relaying
@@ -84,6 +90,28 @@ spin target relay hst = do
then "--serialized " ++ shellEscape (show (Spin [target] (Just target)))
else "--continue " ++ shellEscape (show (SimpleRun target))
+-- Check if the Host contains an IP address that matches one of the IPs
+-- in the DNS for the HostName. If so, the HostName is used as-is,
+-- but if the DNS is out of sync with the Host config, or doesn't have
+-- the host in it at all, use one of the Host's IPs instead.
+getSshTarget :: HostName -> Host -> IO String
+getSshTarget target hst
+ | isJust configip = go =<< catchMaybeIO (BSD.getHostByName target)
+ | otherwise = return target
+ where
+ go Nothing = useip
+ go (Just hostentry) = maybe useip (const $ return target)
+ =<< firstM matchingtarget (BSD.hostAddresses hostentry)
+
+ matchingtarget a = (==) target <$> inet_ntoa a
+
+ useip = return $ fromMaybe target configip
+
+ configip = case mapMaybe getIPAddr (S.toList (_dns (hostInfo hst))) of
+ [] -> Nothing
+ (IPv4 a:_) -> Just a
+ (IPv6 a:_) -> Just a
+
-- Update the privdata, repo url, and git repo over the ssh
-- connection, talking to the user's local propellor instance which is
-- running the updateServer