diff options
author | Andrew Cady <d@jerkface.net> | 2019-07-13 15:22:45 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2019-07-13 15:41:12 -0400 |
commit | 006d1f0b7f36c25a91006fce24cbe76416fcee86 (patch) | |
tree | bf3e95582edf806677c6aaf56c825ba33c2c2974 /lib/KeyRing | |
parent | 495d9fbac3d633b768d910fced5cf00d00118fa0 (diff) |
no cpp needed, since my love is unconditional
Diffstat (limited to 'lib/KeyRing')
-rw-r--r-- | lib/KeyRing/BuildKeyDB.hs | 52 |
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 #-} |
10 | module KeyRing.BuildKeyDB where | 9 | module KeyRing.BuildKeyDB where |
11 | 10 | ||
12 | #if defined(VERSION_memory) | ||
13 | import Data.ByteArray.Encoding | 11 | import Data.ByteArray.Encoding |
14 | import qualified Data.ByteString as S | 12 | import qualified Data.ByteString as S |
15 | #elif defined(VERSION_dataenc) | ||
16 | import qualified Codec.Binary.Base32 as Base32 | ||
17 | import qualified Codec.Binary.Base64 as Base64 | ||
18 | #endif | ||
19 | import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor | 13 | import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor |
20 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types | 14 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types |
21 | import Control.Arrow (first, second) | 15 | import Control.Arrow (first, second) |
@@ -49,12 +43,7 @@ import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) | |||
49 | import System.Directory (doesFileExist) | 43 | import System.Directory (doesFileExist) |
50 | 44 | ||
51 | import System.IO.Error (isDoesNotExistError) | 45 | import System.IO.Error (isDoesNotExistError) |
52 | #if !defined(VERSION_cryptonite) | ||
53 | import qualified Crypto.Hash.SHA1 as SHA1 | ||
54 | import qualified Crypto.Types.PubKey.ECC as ECC | ||
55 | #else | ||
56 | import qualified Crypto.PubKey.ECC.Types as ECC | 46 | import qualified Crypto.PubKey.ECC.Types as ECC |
57 | #endif | ||
58 | import qualified Codec.Compression.GZip as GZip | 47 | import qualified Codec.Compression.GZip as GZip |
59 | import qualified Crypto.PubKey.RSA as RSA | 48 | import qualified Crypto.PubKey.RSA as RSA |
60 | import qualified Data.X509 as X509 | 49 | import qualified Data.X509 as X509 |
@@ -63,28 +52,13 @@ import System.Posix.Files (getFdStatus, getFileStatus, | |||
63 | 52 | ||
64 | 53 | ||
65 | import qualified System.Posix.Types as Posix | 54 | import qualified System.Posix.Types as Posix |
66 | #if MIN_VERSION_x509(1,5,0) | ||
67 | import Data.Hourglass | 55 | import Data.Hourglass |
68 | #endif | ||
69 | #if MIN_VERSION_unix(2,7,0) | ||
70 | import Foreign.C.Types (CTime (..)) | 56 | import Foreign.C.Types (CTime (..)) |
71 | #else | ||
72 | import Foreign.C.Error (throwErrnoIfMinus1_) | ||
73 | import Foreign.C.Types (CInt (..), CLong, CTime (..)) | ||
74 | import Foreign.Marshal.Array (withArray) | ||
75 | import Foreign.Ptr | ||
76 | import Foreign.Storable | ||
77 | #endif | ||
78 | import Data.Traversable (sequenceA) | 57 | import Data.Traversable (sequenceA) |
79 | import qualified Data.Traversable as Traversable | 58 | import qualified Data.Traversable as Traversable |
80 | import System.IO (openFile, IOMode(ReadMode)) | 59 | import System.IO (openFile, IOMode(ReadMode)) |
81 | 60 | ||
82 | import System.Posix.IO (fdToHandle) | 61 | import System.Posix.IO (fdToHandle) |
83 | #if ! MIN_VERSION_base(4,6,0) | ||
84 | import GHC.Exts (Down (..)) | ||
85 | #endif | ||
86 | #if MIN_VERSION_binary(0,7,0) | ||
87 | #endif | ||
88 | import Compat () | 62 | import Compat () |
89 | import qualified Data.ByteString.Lazy.Char8 as Char8 | 63 | import qualified Data.ByteString.Lazy.Char8 as Char8 |
90 | import Network.Socket | 64 | import 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 | ||
291 | decodePacketList :: L.ByteString -> [Packet] | 257 | decodePacketList :: L.ByteString -> [Packet] |
292 | decodePacketList some = | 258 | decodePacketList 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 | |||
300 | decodeOrFail bs = Right (L.empty,1,decode bs) | ||
301 | #endif | ||
302 | |||
303 | 262 | ||
304 | readPacketsFromFile :: InputFileContext -> InputFile -> IO (PacketsCodec, Message) | 263 | readPacketsFromFile :: InputFileContext -> InputFile -> IO (PacketsCodec, Message) |
305 | readPacketsFromFile ctx fname = do | 264 | readPacketsFromFile 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 | ||
1405 | selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet | 1353 | selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet |