blob: b7068f48df620466224789b7204598a27f682843 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
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"
|
