diff options
Diffstat (limited to 'Gpg')
| -rw-r--r-- | Gpg/Keyring.hs | 73 | ||||
| -rw-r--r-- | Gpg/Wot.hs | 5 |
2 files changed, 77 insertions, 1 deletions
diff --git a/Gpg/Keyring.hs b/Gpg/Keyring.hs new file mode 100644 index 0000000..a0fa242 --- /dev/null +++ b/Gpg/Keyring.hs @@ -0,0 +1,73 @@ +{- Copyright 2017 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +-- | Gpg keyrings for debug-me + +module Gpg.Keyring where + +import Gpg +import qualified Gpg.Wot + +import System.FilePath +import Data.Char +import System.Directory +import Data.Time.Clock +import Data.Time.Format +import System.Process +import System.Exit + +keyringDir :: FilePath +keyringDir = "/usr/share/debug-me/keyring" + +data Keyring = Keyring FilePath UTCTime + +keyringToDeveloperDesc :: Maybe (Gpg.Wot.WotStats) -> Keyring -> String +keyringToDeveloperDesc mws (Keyring f mtime) = + name ++ " is " ++ desc ++ " \t(as of " ++ showtime mtime ++ ")" + where + name = maybe "This person" Gpg.Wot.wotStatName mws + desc = map sanitize $ dropExtension $ takeFileName f + sanitize '_' = ' ' + sanitize c + | isAlphaNum c || c `elem` "-+" = c + | otherwise = '?' + showtime = formatTime defaultTimeLocale "%c" + +findKeyringsContaining :: GpgKeyId -> IO [Keyring] +findKeyringsContaining k = + go [] . map (keyringDir </>) =<< getDirectoryContents keyringDir + where + go c [] = return c + go c (f:fs) = do + isfile <- doesFileExist f + if isfile && takeExtension f == ".gpg" + then do + inkeyring <- isInKeyring k f + if inkeyring + then do + mtime <- getModificationTime f + let keyring = Keyring f mtime + go (keyring : c) fs + else go c fs + else go c fs + +-- | Check if the gpg key is included in the keyring file. +-- +-- Similar to gpgv, this does not check if the key is revoked or expired, +-- only if it's included in the keyring. +isInKeyring :: GpgKeyId -> FilePath -> IO Bool +isInKeyring (GpgKeyId k) f = do + -- gpg assumes non-absolute keyring files are relative to ~/.gnupg/ + absf <- makeAbsolute f + let p = proc "gpg" + -- Avoid reading any keyrings except the specified one. + [ "--no-options" + , "--no-default-keyring" + , "--no-auto-check-trustdb" + , "--keyring", absf + , "--list-key", k + ] + (exitcode, _, _) <- readCreateProcessWithExitCode p "" + return (exitcode == ExitSuccess) @@ -107,7 +107,7 @@ describeWot (Just ws) (StrongSetAnalysis ss) , theirname ++ " is probably a real person." ] where - theirname = stripEmail (uid (key ws)) + theirname = wotStatName ws sigs = cross_sigs ws ++ other_sigs ws bestconnectedsigs = sortOn rank sigs describeWot Nothing _ = @@ -115,5 +115,8 @@ describeWot Nothing _ = , "Their identity cannot be verified!" ] +wotStatName :: WotStats -> String +wotStatName ws = stripEmail (uid (key ws)) + stripEmail :: String -> String stripEmail = unwords . takeWhile (not . ("<" `isPrefixOf`)) . words |