-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathSSHKeys.hs
121 lines (94 loc) · 3.08 KB
/
SSHKeys.hs
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
{-# LANGUAGE CPP #-}
module SSHKeys where
import QuietTesting
import Data.Char
import Test.HUnit
import Text.Parsec hiding (Line)
#if !MIN_VERSION_parsec(3,1,9)
instance Eq ParseError where
l == r = errorPos l == errorPos r && errorMessages l == errorMessages r
#endif
type Parser = Parsec String ()
file :: Parser [Line]
file = line `sepEndBy` newline <* eof
type Option = (String, Maybe String)
data Line
= Entry ([Option], String, String, String)
| Comment String
| EmptyLine
deriving (Eq, Show)
line :: Parser Line
line = commentLine <|> emptyLine <|> entry
commentLine :: Parser Line
commentLine = Comment <$> try (spaces' *> char '#' *> comment)
emptyLine :: Parser Line
emptyLine = EmptyLine <$ try (spaces' *> lookAhead newline)
entry :: Parser Line
entry = do
o <- options
_ <- spaces'
k <- kind
_ <- spaces'
h <- hash
_ <- spaces'
c <- comment
return $ Entry (o, k, h, c)
options :: Parser [(String, Maybe String)]
options = setting `sepBy` comma
setting :: Parser (String, Maybe String)
setting = do
notFollowedBy kind
key <- many1 (alphaNum <|> char '-') <?> "option name"
value <- optionMaybe $ do
_ <- char '='
between (char '"') (char '"') (anyChar `manyTill` lookAhead (char '"'))
<|> anyChar `manyTill` lookAhead (space <|> comma)
return (key, value)
kind :: Parser String
kind = do
base <- string "ssh" <|> string "ecdsa"
_ <- char '-'
rest <- many1 nonSpace
return $ base ++ "-" ++ rest
<?> "key kind"
hash :: Parser String
hash = many1 base64 <?> "base64 hash"
comment :: Parser String
comment = many nonNewline <?> "comment"
base64 :: Parser Char
base64 = satisfy (\c -> isAsciiUpper c || isAsciiLower c || isDigit c || c `elem` "+/=") <?> "base64 character"
nonNewline :: Parser Char
nonNewline = noneOf "\r\n" <?> "character"
nonSpace :: Parser Char
nonSpace = satisfy (not . isSpace) <?> "non-space"
space' :: Parser Char
space' = oneOf " \t" <?> "space"
spaces' :: Parser String
spaces' = many space' <?> "spaces"
comma :: Parser Char
comma = char ','
manyTill1 :: Parser a -> Parser end -> Parser [a]
manyTill1 p end = (:) <$> p <*> manyTill p end
parseFile :: SourceName -> String -> Either ParseError [Line]
parseFile = runP file ()
testData :: String
testData = concat
[ "ssh-dsa AAAAAAAA me@somewhere OK?\n"
, " \n"
, "opt-1 ssh-dsa AAAAAAAA me@somewhere OK?\n"
, " # A comment line\n"
, "opt-1,opt2 ssh-dsa AAAAAAAA me@somewhere OK?\n"
, "opt-1=\"a value\",opt2 ssh-dsa AAAAAAAA me@somewhere OK?" ]
testResult :: Either a [Line]
testResult = Right
[ Entry ([], "ssh-dsa","AAAAAAAA","me@somewhere OK?")
, EmptyLine
, Entry ([("opt-1",Nothing)], "ssh-dsa","AAAAAAAA","me@somewhere OK?")
, Comment " A comment line"
, Entry ([("opt-1",Nothing),("opt2",Nothing)], "ssh-dsa","AAAAAAAA","me@somewhere OK?")
, Entry ([("opt-1",Just "a value"),("opt2",Nothing)], "ssh-dsa","AAAAAAAA","me@somewhere OK?") ]
tests :: Test
tests = test
[ parseFile "testData" testData ~?= testResult ]
runTests :: IO ()
runTests = runTestTTquiet tests