138 lines
2.7 KiB
Haskell
138 lines
2.7 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Parser
|
|
( parseKeychain
|
|
, parseKeychainList
|
|
, runParser
|
|
) where
|
|
|
|
import Types
|
|
import Control.Applicative
|
|
import Data.Attoparsec.ByteString.Char8
|
|
import Data.ByteString.Char8 (pack, unpack)
|
|
import Data.Hex (unhex)
|
|
import Data.Time
|
|
|
|
|
|
runParser :: Monoid a => Parser a -> String -> a
|
|
runParser parser = handle . parseOnly parser . pack
|
|
where
|
|
handle (Left _) = mempty
|
|
handle (Right x) = x
|
|
|
|
|
|
-- Parsers --
|
|
|
|
parseKeychain :: Parser Keychain
|
|
parseKeychain = many item
|
|
|
|
parseKeychainList :: Parser [FilePath]
|
|
parseKeychainList = many $
|
|
between (many space >> quote) quote anyChar
|
|
|
|
item :: Parser Item
|
|
item = do
|
|
string "keychain: "
|
|
path <- quoted
|
|
endOfLine
|
|
string "class: "
|
|
class_ <- iclass <|> sclass
|
|
endOfLine
|
|
string "attributes:"
|
|
endOfLine
|
|
attrs <- many entry
|
|
endOfLine
|
|
string "data:"
|
|
endOfLine
|
|
raw <- raw <|> hex' <|>
|
|
raw' <|> pure "" <* endOfLine
|
|
return Item { keychain = path
|
|
, itemClass = class_
|
|
, attrs = attrs
|
|
, content = raw }
|
|
|
|
entry :: Parser Attrib
|
|
entry = do
|
|
many space
|
|
name <- eitherP quoted hex
|
|
between (char '<') (char '>') anyChar
|
|
char '='
|
|
val <- value
|
|
return (name, val)
|
|
|
|
value :: Parser Value
|
|
value =
|
|
pure Null <$> string "<NULL>" <|>
|
|
Date <$> date <|>
|
|
Str <$> quoted <|>
|
|
Str <$> quoted' <|>
|
|
Num <$> hex
|
|
|
|
|
|
sclass :: Parser ItemClass
|
|
sclass = do
|
|
quote
|
|
name <- str
|
|
quote
|
|
return name
|
|
where
|
|
str = pure Inet <* string "inet" <|>
|
|
pure Genp <* string "genp"
|
|
|
|
iclass :: Parser ItemClass
|
|
iclass = Id <$> hex
|
|
|
|
|
|
-- Parser helpers --
|
|
|
|
between :: Parser a -> Parser b -> Parser c -> Parser [c]
|
|
between p q x = p >> manyTill x q
|
|
|
|
hex :: Parser Integer
|
|
hex = do
|
|
string "0x"
|
|
num <- hexadecimal
|
|
space
|
|
return num
|
|
|
|
-- decoded hex string
|
|
hex' :: Parser String
|
|
hex' =
|
|
between (string "0x") (space >> endOfLine) anyChar >>= unhex
|
|
|
|
quote :: Parser Char
|
|
quote = char '"'
|
|
|
|
-- literal string
|
|
quoted :: Parser String
|
|
quoted = between quote quote anyChar
|
|
|
|
-- hex followed by string version
|
|
quoted' :: Parser String
|
|
quoted' = hex >> space >> quoted
|
|
|
|
-- unescaped string
|
|
raw :: Parser String
|
|
raw = between quote (quote >> endOfLine) anyChar
|
|
|
|
-- hex followed by unescaped string
|
|
raw' :: Parser String
|
|
raw' = hex >> space >> raw
|
|
|
|
digits :: Read a => Int -> Parser a
|
|
digits n = read <$> count n digit
|
|
|
|
date :: Parser LocalTime
|
|
date = do
|
|
hex >> space >> quote
|
|
year <- digits 4
|
|
month <- digits 2
|
|
day <- digits 2
|
|
hour <- digits 2
|
|
min <- digits 2
|
|
sec <- digits 2
|
|
string "Z\\" >> decimal >> quote
|
|
return LocalTime { localDay = fromGregorian year month day
|
|
, localTimeOfDay = TimeOfDay hour min sec }
|
|
|