summaryrefslogtreecommitdiff
path: root/Utility/SshConfig.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Utility/SshConfig.hs')
-rw-r--r--Utility/SshConfig.hs125
1 files changed, 125 insertions, 0 deletions
diff --git a/Utility/SshConfig.hs b/Utility/SshConfig.hs
new file mode 100644
index 000000000..b7068f48d
--- /dev/null
+++ b/Utility/SshConfig.hs
@@ -0,0 +1,125 @@
+{- ssh config file parsing and modification
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.SshConfig where
+
+import Common
+import Utility.UserInfo
+import Utility.Tmp
+
+import Data.Char
+import Data.Ord
+import Data.Either
+
+data SshConfig
+ = GlobalConfig SshSetting
+ | HostConfig Host [Either Comment SshSetting]
+ | CommentLine Comment
+ deriving (Show)
+
+data Comment = Comment Indent String
+ deriving (Show)
+
+data SshSetting = SshSetting Indent Key Value
+ deriving (Show)
+
+type Indent = String
+type Host = String
+type Key = String
+type Value = String
+
+{- Parses ~/.ssh/config. Comments and indentation are preserved.
+ -
+ - Note that there is no parse failure. If a line cannot be parsed, it will
+ - be taken to be a SshSetting that contains the whole line as the key,
+ - and has no value. -}
+parseSshConfig :: String -> [SshConfig]
+parseSshConfig = go [] . lines
+ where
+ go c [] = reverse c
+ go c (l:ls)
+ | iscomment l = collect $ CommentLine $ mkcomment l
+ | otherwise = case splitline l of
+ (indent, k, v)
+ | isHost k -> hoststanza v c [] ls
+ | otherwise -> collect $ GlobalConfig $ SshSetting indent k v
+ where
+ collect v = go (v:c) ls
+
+ hoststanza host c hc [] = go (HostConfig host (reverse hc):c) []
+ hoststanza host c hc (l:ls)
+ | iscomment l = hoststanza host c ((Left $ mkcomment l):hc) ls
+ | otherwise = case splitline l of
+ (indent, k, v)
+ | isHost k -> hoststanza v
+ (HostConfig host (reverse hc):c) [] ls
+ | otherwise -> hoststanza host c
+ ((Right $ SshSetting indent k v):hc) ls
+
+ iscomment l = all isSpace l || "#" `isPrefixOf` (dropWhile isSpace l)
+
+ splitline l = (indent, k, v)
+ where
+ (indent, rest) = span isSpace l
+ (k, v) = separate isSpace rest
+
+ mkcomment l = Comment indent c
+ where
+ (indent, c) = span isSpace l
+
+ isHost v = map toLower v == "host"
+
+genSshConfig :: [SshConfig] -> String
+genSshConfig = unlines . concatMap gen
+ where
+ gen (CommentLine c) = [comment c]
+ gen (GlobalConfig s) = [setting s]
+ gen (HostConfig h cs) = ("Host " ++ h) : map (either comment setting) cs
+
+ setting (SshSetting indent k v) = indent ++ k ++ " " ++ v
+ comment (Comment indent c) = indent ++ c
+
+findHostConfigKey :: SshConfig -> Key -> Maybe Value
+findHostConfigKey (HostConfig _ cs) wantk = go (rights cs) (map toLower wantk)
+ where
+ go [] _ = Nothing
+ go ((SshSetting _ k v):rest) wantk'
+ | map toLower k == wantk' = Just v
+ | otherwise = go rest wantk'
+findHostConfigKey _ _ = Nothing
+
+{- Adds a particular Key and Value to a HostConfig. -}
+addToHostConfig :: SshConfig -> Key -> Value -> SshConfig
+addToHostConfig (HostConfig host cs) k v =
+ HostConfig host $ Right (SshSetting indent k v) : cs
+ where
+ {- The indent is taken from any existing SshSetting
+ - in the HostConfig (largest indent wins). -}
+ indent = fromMaybe "\t" $ headMaybe $ reverse $
+ sortBy (comparing length) $ map getindent cs
+ getindent (Right (SshSetting i _ _)) = i
+ getindent (Left (Comment i _)) = i
+addToHostConfig other _ _ = other
+
+modifyUserSshConfig :: ([SshConfig] -> [SshConfig]) -> IO ()
+modifyUserSshConfig modifier = changeUserSshConfig $
+ genSshConfig . modifier . parseSshConfig
+
+changeUserSshConfig :: (String -> String) -> IO ()
+changeUserSshConfig modifier = do
+ sshdir <- sshDir
+ let configfile = sshdir </> "config"
+ whenM (doesFileExist configfile) $ do
+ c <- readFileStrict configfile
+ let c' = modifier c
+ when (c /= c') $
+ viaTmp writeFile configfile c'
+
+sshDir :: IO FilePath
+sshDir = do
+ home <- myHomeDir
+ return $ home </> ".ssh"