1 files changed, 73 insertions, 0 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)