diff options
Diffstat (limited to 'Gpg.hs')
-rw-r--r-- | Gpg.hs | 30 |
1 files changed, 20 insertions, 10 deletions
@@ -7,6 +7,7 @@ import Crypto import Data.ByteArray (convert) import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as B8 import System.IO import System.Posix.IO hiding (createPipe) import System.Process @@ -17,6 +18,7 @@ import System.Directory import Control.Concurrent.Async newtype GpgKeyId = GpgKeyId String + deriving (Show) newtype GpgSign = GpgSign Bool @@ -58,16 +60,17 @@ gpgSign pk = do -- Gpg outputs to stderr information about who signed the -- data, so that will be visible to the user when eg, prompting -- them if they want to accept a connection from that person. +-- +-- This relies on gpgSign using --clearsign, so on successful +-- verification, the JSON encoded PublicKey is output to gpg's +-- stdout. gpgVerify :: [String] -> PerhapsSigned PublicKey -> IO (Maybe GpgKeyId) gpgVerify _ (UnSigned _) = return Nothing gpgVerify gpgopts (GpgSigned pk (GpgSig (Val sig))) = do (statusreadh, statuswriteh) <- createPipe statuswritefd <- handleToFd statuswriteh - -- This relies on gpgSign using --clearsign, so on successful - -- verification, the JSON encoded PublicKey is output to gpg's - -- stdout. (Just hin, Just hout, _, pid) <- createProcess $ - (proc "gpg" (extraopts ++ ["--verify", "--output", "-"])) + (proc "gpg" (verifyopts statuswritefd)) { std_in = CreatePipe , std_out = CreatePipe } @@ -78,14 +81,21 @@ gpgVerify gpgopts (GpgSigned pk (GpgSig (Val sig))) = do (signeddata, gpgkeyid) <- B.hGetContents hout `concurrently` (parseStatusFd <$> hGetContents statusreadh) st <- waitForProcess pid - return $ case st of - ExitSuccess - | val (hashValue (hash pk)) == signeddata -> gpgkeyid - _ -> Nothing + let norm = filter (not . B.null) . B8.lines + let pkissigned = norm (val (hashValue (hash pk))) == norm signeddata + return $ if st == ExitSuccess && pkissigned + then gpgkeyid + else Nothing where extraopts = if any ("--keyserver" `isPrefixOf`) gpgopts then gpgopts - else map ("--keyserver=" ++) defaultKeyServers ++ gpgopts + else concatMap (\s -> ["--keyserver", s]) defaultKeyServers + ++ gpgopts + verifyopts statuswritefd = extraopts ++ + [ "--status-fd", show statuswritefd + , "--verify" + , "--output", "-" + ] -- | Default keyservers to use. defaultKeyServers :: [String] @@ -98,5 +108,5 @@ parseStatusFd :: String -> Maybe GpgKeyId parseStatusFd = go . map words . lines where go [] = Nothing - go ((_:"VALIDSIG":keyid:_):_) = Just (GpgKeyId keyid) + go ((_:"VALIDSIG":_:_:_:_:_:_:_:_:_:keyid:_):_) = Just (GpgKeyId keyid) go (_:rest) = go rest |