diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-04-26 17:31:30 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-04-26 18:13:40 -0400 |
commit | 3c7d3b3a2088cfe3698c3b055822c2b9fa67468a (patch) | |
tree | ea059c1d13981e12d461bb7485406aaea0d2ba1c /Crypto.hs | |
parent | 8f2d5a67911ae22ff5bf0a191aa63cbb61da32ac (diff) | |
download | debug-me-3c7d3b3a2088cfe3698c3b055822c2b9fa67468a.tar.gz |
gpg sign developer session key
And part of what we need to have users verify them.
This commit was sponsored by andrea rota.
Diffstat (limited to 'Crypto.hs')
-rw-r--r-- | Crypto.hs | 85 |
1 files changed, 73 insertions, 12 deletions
@@ -1,16 +1,22 @@ -{-# LANGUAGE OverloadedStrings, RankNTypes #-} +{-# LANGUAGE OverloadedStrings, RankNTypes, DeriveGeneric #-} module Crypto where import Val import Hash import Types +import Serialization import qualified Crypto.PubKey.Ed25519 as Ed25519 import Crypto.Error import Crypto.Random.Entropy import Data.ByteArray (convert) -import Data.ByteString +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import System.IO +import System.Process +import System.Exit +import Data.List dummySignature :: Signature dummySignature = OtherSignature (Val mempty) @@ -43,7 +49,7 @@ sign :: Signed v => MySessionKey -> v -> Signature sign (MySessionKey sk pk) v = Ed25519Signature $ Val $ convert $ Ed25519.sign sk pk (toSign v) -toSign :: Signed v => v -> ByteString +toSign :: Signed v => v -> B.ByteString toSign = val . hashValue . hashExceptSignature -- | Verifiy the signature of a Signed value. @@ -56,10 +62,10 @@ verifySigned (SigVerifier verifier) v = CryptoFailed _ -> False OtherSignature _ -> False -data SigVerifier = SigVerifier (ByteString -> Ed25519.Signature -> Bool) +data SigVerifier = SigVerifier (B.ByteString -> Ed25519.Signature -> Bool) mkSigVerifier :: PublicKey -> SigVerifier -mkSigVerifier (PublicKey (Val pk) _) = +mkSigVerifier (PublicKey (Val pk)) = case Ed25519.publicKey pk of CryptoPassed pk' -> SigVerifier (Ed25519.verify pk') CryptoFailed _ -> mempty @@ -71,18 +77,73 @@ instance Monoid SigVerifier where data MySessionKey = MySessionKey Ed25519.SecretKey Ed25519.PublicKey --- TODO add gpg signature when available -myPublicKey :: MySessionKey -> IO PublicKey -myPublicKey (MySessionKey _ pk) = do - let gpgsig = Nothing - return $ PublicKey (Val (convert pk)) gpgsig - genMySessionKey :: IO MySessionKey genMySessionKey = do -- Crypto.Random.Entropy may use rdrand, or /dev/random. -- Even if you don't trust rdrand to be free of backdoors, -- it seems safe enough to use it for a session key that -- is only used for signing, not encryption. - rand32 <- getEntropy 32 :: IO ByteString + rand32 <- getEntropy 32 :: IO B.ByteString sk <- throwCryptoErrorIO $ Ed25519.secretKey rand32 return $ MySessionKey sk (Ed25519.toPublic sk) + +newtype GpgSign = GpgSign Bool + +myPublicKey :: MySessionKey -> GpgSign -> IO (PerhapsSigned PublicKey) +myPublicKey (MySessionKey _ epk) (GpgSign gpgsign) = do + let pk = PublicKey (Val $ convert epk) + if gpgsign + then gpgSign pk + else return (UnSigned pk) + +gpgSign :: PublicKey -> IO (PerhapsSigned PublicKey) +gpgSign pk = do + putStrLn "Using gpg to sign the debug-me session key." + (Just hin, Just hout, _, pid) <- createProcess $ + (proc "gpg" ["--clearsign", "-a"]) + { std_in = CreatePipe + , std_out = CreatePipe + } + L.hPut hin $ encode pk + hClose hin + hSetBinaryMode hout True + sig <- GpgSig . Val <$> B.hGetContents hout + st <- waitForProcess pid + case st of + ExitSuccess -> return $ GpgSigned pk sig + ExitFailure _ -> error "gpg failed" + +-- | Verify the gpg signature. The key will be retrieved from a keyserver +-- if possible. 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. +gpgVerify :: [String] -> PerhapsSigned PublicKey -> IO Bool +gpgVerify _ (UnSigned _) = return False +gpgVerify gpgopts (GpgSigned pk (GpgSig (Val sig))) = do + -- 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", "-"])) + { std_in = CreatePipe + , std_out = CreatePipe + } + B.hPut hin sig + hClose hin + hSetBinaryMode hout True + out <- L.hGetContents hout + st <- waitForProcess pid + return $ case st of + ExitFailure _ -> False + ExitSuccess -> Just pk == decode out + where + extraopts = if any ("--keyserver" `isPrefixOf`) gpgopts + then gpgopts + else map ("--keyserver=" ++) defaultKeyServers ++ gpgopts + +-- | Default keyservers to use. +defaultKeyServers :: [String] +defaultKeyServers = + [ "pool.sks-keyservers.net" + , "pgpkeys.mit.edu" + ] |