97 lines
2.8 KiB
Haskell
97 lines
2.8 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
import Skeleton.Types
|
|
import Skeleton.Pretty
|
|
import Skeleton.Parser
|
|
|
|
import Control.Monad (when)
|
|
import Data.List (isInfixOf)
|
|
import System.FilePath (takeBaseName)
|
|
import System.Process (readProcess, callCommand)
|
|
import System.Posix.Escape (escape)
|
|
import System.Console.ArgParser
|
|
|
|
|
|
-- Search functions --
|
|
|
|
byAttrib :: Attrib -> Keychain -> [Item]
|
|
byAttrib a = filter (elem a . attrs)
|
|
|
|
fuzzy :: String -> Keychain -> [Item]
|
|
fuzzy x = filter (any (isInfixOf x) . strings)
|
|
where
|
|
strings = map unvalue . attrs
|
|
unvalue (_, Str s) = s
|
|
unvalue _ = ""
|
|
|
|
|
|
-- Keychain access --
|
|
|
|
keychainList :: IO [FilePath]
|
|
keychainList = do
|
|
raw <- readProcess "security" ["list-keychains"] ""
|
|
case runParser parseKeychainList raw of
|
|
Just list -> return $ filter ((/="System") . takeBaseName) list
|
|
Nothing -> error "failed to parse active keychains list"
|
|
|
|
getKeychain :: [FilePath] -> IO Keychain
|
|
getKeychain paths = do
|
|
raw <- readProcess "security" ("dump-keychain" : "-d" : paths) ""
|
|
case runParser parseKeychain raw of
|
|
Just items -> return items
|
|
Nothing -> error "failed to parse keychain"
|
|
|
|
sendClipboard :: String -> IO ()
|
|
sendClipboard text =
|
|
callCommand $ "echo " ++ (escape text) ++ " | pbcopy"
|
|
|
|
|
|
-- CLI arguments --
|
|
|
|
data ProgArgs = ProgArgs
|
|
{ searchTerm :: String
|
|
, keychain :: FilePath
|
|
, exactMatches :: String
|
|
, resultsLimit :: Int
|
|
, contentOnly :: Bool
|
|
, noClipboard :: Bool
|
|
} deriving (Show)
|
|
|
|
parser :: ParserSpec ProgArgs
|
|
parser = ProgArgs
|
|
`parsedBy` reqPos "term" `Descr` "Keychain search term"
|
|
`andBy` optFlag "" "keychain" `Descr` "Use a specific keychain (default: all except System)"
|
|
`andBy` optFlag "" "exact" `Descr` "Return exact matches with the given class"
|
|
`andBy` optFlag 10 "limit" `Descr` "Set upper results limit (default: 10, 0: unlimited)"
|
|
`andBy` boolFlag "content" `Descr` "Print only the items content"
|
|
`andBy` boolFlag "clipboard" `Descr` "Disable paste to clipboard"
|
|
|
|
interface :: IO (CmdLnInterface ProgArgs)
|
|
interface =
|
|
(`setAppDescr` "Quickly access the OSX keychain") <$>
|
|
(`setAppEpilog` "The skeleton key") <$>
|
|
mkApp parser
|
|
|
|
main :: IO ()
|
|
main = interface >>= (`runApp` search)
|
|
|
|
|
|
-- Program --
|
|
|
|
search :: ProgArgs -> IO ()
|
|
search ProgArgs {..} = do
|
|
paths <- if null keychain
|
|
then keychainList
|
|
else return [keychain]
|
|
items <- getKeychain paths
|
|
let select = if resultsLimit == 0
|
|
then id
|
|
else take resultsLimit
|
|
let res = if null exactMatches
|
|
then select (fuzzy searchTerm items)
|
|
else select (byAttrib (Left exactMatches, Str searchTerm) items)
|
|
if contentOnly
|
|
then mapM_ print (map content res)
|
|
else pprint res
|
|
when (not noClipboard) (sendClipboard (content $ head res))
|