summaryrefslogtreecommitdiff
path: root/lib/KeyRing
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2019-07-13 15:22:45 -0400
committerAndrew Cady <d@jerkface.net>2019-07-13 15:41:12 -0400
commit006d1f0b7f36c25a91006fce24cbe76416fcee86 (patch)
treebf3e95582edf806677c6aaf56c825ba33c2c2974 /lib/KeyRing
parent495d9fbac3d633b768d910fced5cf00d00118fa0 (diff)
no cpp needed, since my love is unconditional
Diffstat (limited to 'lib/KeyRing')
-rw-r--r--lib/KeyRing/BuildKeyDB.hs52
1 files changed, 0 insertions, 52 deletions
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index 0a90cbc..943578f 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -1,4 +1,3 @@
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveFunctor #-} 1{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE DoAndIfThenElse #-} 2{-# LANGUAGE DoAndIfThenElse #-}
4{-# LANGUAGE ForeignFunctionInterface #-} 3{-# LANGUAGE ForeignFunctionInterface #-}
@@ -9,13 +8,8 @@
9{-# LANGUAGE ViewPatterns #-} 8{-# LANGUAGE ViewPatterns #-}
10module KeyRing.BuildKeyDB where 9module KeyRing.BuildKeyDB where
11 10
12#if defined(VERSION_memory)
13import Data.ByteArray.Encoding 11import Data.ByteArray.Encoding
14import qualified Data.ByteString as S 12import qualified Data.ByteString as S
15#elif defined(VERSION_dataenc)
16import qualified Codec.Binary.Base32 as Base32
17import qualified Codec.Binary.Base64 as Base64
18#endif
19import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor 13import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor
20import Codec.Encryption.OpenPGP.ASCIIArmor.Types 14import Codec.Encryption.OpenPGP.ASCIIArmor.Types
21import Control.Arrow (first, second) 15import Control.Arrow (first, second)
@@ -49,12 +43,7 @@ import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
49import System.Directory (doesFileExist) 43import System.Directory (doesFileExist)
50 44
51import System.IO.Error (isDoesNotExistError) 45import System.IO.Error (isDoesNotExistError)
52#if !defined(VERSION_cryptonite)
53import qualified Crypto.Hash.SHA1 as SHA1
54import qualified Crypto.Types.PubKey.ECC as ECC
55#else
56import qualified Crypto.PubKey.ECC.Types as ECC 46import qualified Crypto.PubKey.ECC.Types as ECC
57#endif
58import qualified Codec.Compression.GZip as GZip 47import qualified Codec.Compression.GZip as GZip
59import qualified Crypto.PubKey.RSA as RSA 48import qualified Crypto.PubKey.RSA as RSA
60import qualified Data.X509 as X509 49import qualified Data.X509 as X509
@@ -63,28 +52,13 @@ import System.Posix.Files (getFdStatus, getFileStatus,
63 52
64 53
65import qualified System.Posix.Types as Posix 54import qualified System.Posix.Types as Posix
66#if MIN_VERSION_x509(1,5,0)
67import Data.Hourglass 55import Data.Hourglass
68#endif
69#if MIN_VERSION_unix(2,7,0)
70import Foreign.C.Types (CTime (..)) 56import Foreign.C.Types (CTime (..))
71#else
72import Foreign.C.Error (throwErrnoIfMinus1_)
73import Foreign.C.Types (CInt (..), CLong, CTime (..))
74import Foreign.Marshal.Array (withArray)
75import Foreign.Ptr
76import Foreign.Storable
77#endif
78import Data.Traversable (sequenceA) 57import Data.Traversable (sequenceA)
79import qualified Data.Traversable as Traversable 58import qualified Data.Traversable as Traversable
80import System.IO (openFile, IOMode(ReadMode)) 59import System.IO (openFile, IOMode(ReadMode))
81 60
82import System.Posix.IO (fdToHandle) 61import System.Posix.IO (fdToHandle)
83#if ! MIN_VERSION_base(4,6,0)
84import GHC.Exts (Down (..))
85#endif
86#if MIN_VERSION_binary(0,7,0)
87#endif
88import Compat () 62import Compat ()
89import qualified Data.ByteString.Lazy.Char8 as Char8 63import qualified Data.ByteString.Lazy.Char8 as Char8
90import Network.Socket 64import Network.Socket
@@ -151,11 +125,7 @@ buildKeyDB ctx grip0 keyring = do
151 125
152 -- KeyRings (todo: KikiCondition reporting?) 126 -- KeyRings (todo: KikiCondition reporting?)
153 (spilled,mwk,grip,accs,keyqs,unspilled) <- do 127 (spilled,mwk,grip,accs,keyqs,unspilled) <- do
154#if MIN_VERSION_containers(0,5,0)
155 ringPackets <- Map.traverseWithKey readp ringMap 128 ringPackets <- Map.traverseWithKey readp ringMap
156#else
157 ringPackets <- Traversable.traverse (uncurry readp) $ Map.mapWithKey (,) ringMap
158#endif
159 let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message) 129 let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message)
160 130
161 let grip = grip0 `mplus` (fingerprint <$> fstkey) 131 let grip = grip0 `mplus` (fingerprint <$> fstkey)
@@ -208,11 +178,7 @@ buildKeyDB ctx grip0 keyring = do
208 -- XXX: Unspilled keys are not obtainable from rtKeyDB. 178 -- XXX: Unspilled keys are not obtainable from rtKeyDB.
209 -- If the working key is marked non spillable, then how 179 -- If the working key is marked non spillable, then how
210 -- would we look up it's UID and such? 180 -- would we look up it's UID and such?
211#if MIN_VERSION_containers(0,5,0)
212 in fmap sequenceA $ Map.traverseWithKey trans spilled 181 in fmap sequenceA $ Map.traverseWithKey trans spilled
213#else
214 in fmap sequenceA $ Traversable.traverse (uncurry trans) $ Map.mapWithKey (,) spilled
215#endif
216 try transformed0 $ \transformed -> do 182 try transformed0 $ \transformed -> do
217 let -- | db_rings - all keyrings combined into one 183 let -- | db_rings - all keyrings combined into one
218 db_rings = Map.foldlWithKey' mergeIt emptyKeyDB transformed 184 db_rings = Map.foldlWithKey' mergeIt emptyKeyDB transformed
@@ -290,16 +256,9 @@ isring _ = False
290 256
291decodePacketList :: L.ByteString -> [Packet] 257decodePacketList :: L.ByteString -> [Packet]
292decodePacketList some = 258decodePacketList some =
293#if MIN_VERSION_binary(0,7,0)
294 case decodeOrFail some of 259 case decodeOrFail some of
295 Right (more,_,msg ) -> msg : decodePacketList more 260 Right (more,_,msg ) -> msg : decodePacketList more
296 Left (_,_,_) -> [] 261 Left (_,_,_) -> []
297#else
298 either (const []) (\(Message xs) -> xs) $ decode input
299
300decodeOrFail bs = Right (L.empty,1,decode bs)
301#endif
302
303 262
304readPacketsFromFile :: InputFileContext -> InputFile -> IO (PacketsCodec, Message) 263readPacketsFromFile :: InputFileContext -> InputFile -> IO (PacketsCodec, Message)
305readPacketsFromFile ctx fname = do 264readPacketsFromFile ctx fname = do
@@ -1309,12 +1268,8 @@ parseCertBlob comp bs = do
1309 cert <- either (const Nothing) (Just . fst) (fromASN1 asn1') 1268 cert <- either (const Nothing) (Just . fst) (fromASN1 asn1')
1310 let _ = cert :: X509.Certificate 1269 let _ = cert :: X509.Certificate
1311 notBefore :: UTCTime 1270 notBefore :: UTCTime
1312#if MIN_VERSION_x509(1,5,0)
1313 notBefore = toUTC ( timeFromElapsedP (timeGetElapsedP vincentTime) :: CTime) -- nanoToUTCTime nano 1271 notBefore = toUTC ( timeFromElapsedP (timeGetElapsedP vincentTime) :: CTime) -- nanoToUTCTime nano
1314 where (vincentTime,_) = X509.certValidity cert 1272 where (vincentTime,_) = X509.certValidity cert
1315#else
1316 (notBefore,_) = X509.certValidity cert
1317#endif
1318 case X509.certPubKey cert of 1273 case X509.certPubKey cert of
1319 X509.PubKeyRSA key -> do 1274 X509.PubKeyRSA key -> do
1320 let withoutkey = 1275 let withoutkey =
@@ -1389,17 +1344,10 @@ extractRSAKeyFields kvs = do
1389 , rsaCoefficient = u } 1344 , rsaCoefficient = u }
1390 where 1345 where
1391 parseField blob = MPI <$> m 1346 parseField blob = MPI <$> m
1392#if defined(VERSION_memory)
1393 where m = bigendian <$> functorToMaybe (convertFromBase Base64 $ Char8.toStrict blob) 1347 where m = bigendian <$> functorToMaybe (convertFromBase Base64 $ Char8.toStrict blob)
1394 bigendian bs = snd $ S.foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) bs 1348 bigendian bs = snd $ S.foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) bs
1395 where 1349 where
1396 nlen = S.length bs 1350 nlen = S.length bs
1397#elif defined(VERSION_dataenc)
1398 where m = bigendian <$> Base64.decode (Char8.unpack blob)
1399 bigendian bs = snd $ foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) bs
1400 where
1401 nlen = length bs
1402#endif
1403 1351
1404 1352
1405selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet 1353selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet