diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Base58.hs | 17 | ||||
-rw-r--r-- | lib/Compat.hs | 5 | ||||
-rw-r--r-- | lib/GnuPGAgent.hs | 24 | ||||
-rw-r--r-- | lib/KeyRing/BuildKeyDB.hs | 52 | ||||
-rw-r--r-- | lib/PEM.hs | 9 | ||||
-rw-r--r-- | lib/SSHKey.hs | 13 | ||||
-rw-r--r-- | lib/Transforms.hs | 19 |
7 files changed, 4 insertions, 135 deletions
diff --git a/lib/Base58.hs b/lib/Base58.hs index 2de841d..9af3eb5 100644 --- a/lib/Base58.hs +++ b/lib/Base58.hs | |||
@@ -1,12 +1,7 @@ | |||
1 | {-# LANGUAGE CPP #-} | ||
2 | module Base58 where | 1 | module Base58 where |
3 | 2 | ||
4 | #if !defined(VERSION_cryptonite) | ||
5 | import qualified Crypto.Hash.SHA256 as SHA256 | ||
6 | #else | ||
7 | import Crypto.Hash | 3 | import Crypto.Hash |
8 | import Data.ByteArray (convert) | 4 | import Data.ByteArray (convert) |
9 | #endif | ||
10 | import qualified Data.ByteString as S | 5 | import qualified Data.ByteString as S |
11 | import Data.Maybe | 6 | import Data.Maybe |
12 | import Data.List | 7 | import Data.List |
@@ -20,7 +15,7 @@ base58digits :: [Char] -> Maybe [Int] | |||
20 | base58digits str = sequence mbs | 15 | base58digits str = sequence mbs |
21 | where | 16 | where |
22 | mbs = map (flip elemIndex base58chars) str | 17 | mbs = map (flip elemIndex base58chars) str |
23 | 18 | ||
24 | -- 5HueCGU8rMjxEXxiPuD5BDku4MkFqeZyd4dZ1jvhTVqvbTLvyTJ | 19 | -- 5HueCGU8rMjxEXxiPuD5BDku4MkFqeZyd4dZ1jvhTVqvbTLvyTJ |
25 | base58_decode :: [Char] -> Maybe (Word8,[Word8]) | 20 | base58_decode :: [Char] -> Maybe (Word8,[Word8]) |
26 | base58_decode str = do | 21 | base58_decode str = do |
@@ -31,16 +26,12 @@ base58_decode str = do | |||
31 | guard (d/=0) | 26 | guard (d/=0) |
32 | let (q,b) = d `divMod` 256 | 27 | let (q,b) = d `divMod` 256 |
33 | return (fromIntegral b,q) | 28 | return (fromIntegral b,q) |
34 | 29 | ||
35 | let (rcksum,rpayload) = splitAt 4 $ rbytes | 30 | let (rcksum,rpayload) = splitAt 4 $ rbytes |
36 | a_payload = reverse rpayload | 31 | a_payload = reverse rpayload |
37 | #if !defined(VERSION_cryptonite) | ||
38 | hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload | ||
39 | #else | ||
40 | hash_result = S.take 4 . convert $ digest | 32 | hash_result = S.take 4 . convert $ digest |
41 | where digest = hash diges1 :: Digest SHA256 | 33 | where digest = hash diges1 :: Digest SHA256 |
42 | diges1 = hash (S.pack a_payload) :: Digest SHA256 | 34 | diges1 = hash (S.pack a_payload) :: Digest SHA256 |
43 | #endif | ||
44 | expected_hash = S.pack $ reverse rcksum | 35 | expected_hash = S.pack $ reverse rcksum |
45 | (network_id,payload) = splitAt 1 a_payload | 36 | (network_id,payload) = splitAt 1 a_payload |
46 | network_id <- listToMaybe network_id | 37 | network_id <- listToMaybe network_id |
@@ -51,13 +42,9 @@ base58_encode :: S.ByteString -> String | |||
51 | base58_encode hsh = replicate zcount '1' ++ map (base58chars !!) (reverse rdigits) | 42 | base58_encode hsh = replicate zcount '1' ++ map (base58chars !!) (reverse rdigits) |
52 | where | 43 | where |
53 | zcount = S.length . S.takeWhile (==0) $ hsh | 44 | zcount = S.length . S.takeWhile (==0) $ hsh |
54 | #if !defined(VERSION_cryptonite) | ||
55 | cksum = S.take 4 . SHA256.hash . SHA256.hash $ hsh | ||
56 | #else | ||
57 | cksum = S.take 4 (convert digest2 :: S.ByteString) | 45 | cksum = S.take 4 (convert digest2 :: S.ByteString) |
58 | where digest2 = hash ( convert digest1 :: S.ByteString) :: Digest SHA256 | 46 | where digest2 = hash ( convert digest1 :: S.ByteString) :: Digest SHA256 |
59 | digest1 = hash hsh :: Digest SHA256 | 47 | digest1 = hash hsh :: Digest SHA256 |
60 | #endif | ||
61 | n = foldl' (\a b->a*256+b) 0 . map asInteger $ concatMap S.unpack [hsh, cksum] | 48 | n = foldl' (\a b->a*256+b) 0 . map asInteger $ concatMap S.unpack [hsh, cksum] |
62 | asInteger x = fromIntegral x :: Integer | 49 | asInteger x = fromIntegral x :: Integer |
63 | rdigits = unfoldr getdigit n | 50 | rdigits = unfoldr getdigit n |
diff --git a/lib/Compat.hs b/lib/Compat.hs index 3b77851..9c46cb9 100644 --- a/lib/Compat.hs +++ b/lib/Compat.hs | |||
@@ -1,4 +1,3 @@ | |||
1 | {-# LANGUAGE CPP #-} | ||
2 | module Compat where | 1 | module Compat where |
3 | 2 | ||
4 | import Data.Bits | 3 | import Data.Bits |
@@ -8,8 +7,6 @@ import Data.ASN1.Encoding | |||
8 | import Data.ASN1.BinaryEncoding | 7 | import Data.ASN1.BinaryEncoding |
9 | import Crypto.PubKey.RSA as RSA | 8 | import Crypto.PubKey.RSA as RSA |
10 | 9 | ||
11 | #if defined(VERSION_cryptonite) | ||
12 | |||
13 | instance ASN1Object PublicKey where | 10 | instance ASN1Object PublicKey where |
14 | toASN1 pubKey = \xs -> Start Sequence | 11 | toASN1 pubKey = \xs -> Start Sequence |
15 | : IntVal (public_n pubKey) | 12 | : IntVal (public_n pubKey) |
@@ -41,8 +38,6 @@ instance ASN1Object PublicKey where | |||
41 | fromASN1 _ = | 38 | fromASN1 _ = |
42 | Left "fromASN1: RSA.PublicKey: unexpected format" | 39 | Left "fromASN1: RSA.PublicKey: unexpected format" |
43 | 40 | ||
44 | #endif | ||
45 | |||
46 | toPositive :: Integer -> Integer | 41 | toPositive :: Integer -> Integer |
47 | toPositive int | 42 | toPositive int |
48 | | int < 0 = uintOfBytes $ bytesOfInt int | 43 | | int < 0 = uintOfBytes $ bytesOfInt int |
diff --git a/lib/GnuPGAgent.hs b/lib/GnuPGAgent.hs index 1e40269..d73ceed 100644 --- a/lib/GnuPGAgent.hs +++ b/lib/GnuPGAgent.hs | |||
@@ -1,6 +1,6 @@ | |||
1 | {-# LANGUAGE LambdaCase #-} | 1 | {-# LANGUAGE LambdaCase #-} |
2 | {-# LANGUAGE CPP #-} | 2 | {-# LANGUAGE PatternGuards #-} |
3 | {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TupleSections #-} | 3 | {-# LANGUAGE TupleSections #-} |
4 | module GnuPGAgent | 4 | module GnuPGAgent |
5 | ( session | 5 | ( session |
6 | , GnuPGAgent | 6 | , GnuPGAgent |
@@ -26,21 +26,11 @@ import System.Posix.User | |||
26 | import System.Environment | 26 | import System.Environment |
27 | import System.IO | 27 | import System.IO |
28 | import Text.Printf | 28 | import Text.Printf |
29 | #if defined(VERSION_memory) | ||
30 | import qualified Data.ByteString.Char8 as S8 | 29 | import qualified Data.ByteString.Char8 as S8 |
31 | import Data.ByteArray.Encoding | 30 | import Data.ByteArray.Encoding |
32 | #elif defined(VERSION_dataenc) | ||
33 | import qualified Codec.Binary.Base16 as Base16 | ||
34 | #endif | ||
35 | import LengthPrefixedBE | 31 | import LengthPrefixedBE |
36 | import qualified Data.ByteString.Lazy as L | 32 | import qualified Data.ByteString.Lazy as L |
37 | #if defined(VERSION_hourglass) | ||
38 | import Data.Hourglass | 33 | import Data.Hourglass |
39 | #else | ||
40 | import Data.Time.Calendar | ||
41 | import Data.Time.Clock | ||
42 | import Data.Time.Clock.POSIX | ||
43 | #endif | ||
44 | import ProcessUtils | 34 | import ProcessUtils |
45 | import Control.Monad.Fix | 35 | import Control.Monad.Fix |
46 | import Control.Concurrent (threadDelay) | 36 | import Control.Concurrent (threadDelay) |
@@ -166,18 +156,12 @@ getPassphrase agent ask (Query key uid masterkey) = do | |||
166 | "OK" | not (null $ drop 3 r0) -> return r0 >>= unhex . drop 3 -- . (\x -> trace (show x) x) | 156 | "OK" | not (null $ drop 3 r0) -> return r0 >>= unhex . drop 3 -- . (\x -> trace (show x) x) |
167 | | otherwise -> hGetLine (agentHandle agent) >>= unhex . drop 3 -- . (\x -> trace (show x) x) | 157 | | otherwise -> hGetLine (agentHandle agent) >>= unhex . drop 3 -- . (\x -> trace (show x) x) |
168 | where | 158 | where |
169 | #if defined(VERSION_memory) | ||
170 | unhex hx = case convertFromBase Base16 (S8.pack hx) of | 159 | unhex hx = case convertFromBase Base16 (S8.pack hx) of |
171 | Left e -> do | 160 | Left e -> do |
172 | -- Useful for debugging but insecure generally ;) | 161 | -- Useful for debugging but insecure generally ;) |
173 | -- putStrLn $ "convertFromBase error for input "++show hx++": "++show e | 162 | -- putStrLn $ "convertFromBase error for input "++show hx++": "++show e |
174 | return Nothing | 163 | return Nothing |
175 | Right bs -> return $ Just $ S8.unpack bs | 164 | Right bs -> return $ Just $ S8.unpack bs |
176 | #elif defined(VERSION_dataenc) | ||
177 | unhex hx = maybe (return () {- putStrLn $ "dataenc error for input "++show hx -}) | ||
178 | return | ||
179 | $ fmap (map $ chr . fromIntegral) $ Base16.decode hx | ||
180 | #endif | ||
181 | "ERR" -> return Nothing | 165 | "ERR" -> return Nothing |
182 | 166 | ||
183 | quit :: GnuPGAgent -> IO () | 167 | quit :: GnuPGAgent -> IO () |
@@ -232,12 +216,8 @@ envhomedir opt home = do | |||
232 | timeString :: Word32 -> String | 216 | timeString :: Word32 -> String |
233 | timeString t = printf "%d-%d-%d" year month day | 217 | timeString t = printf "%d-%d-%d" year month day |
234 | where | 218 | where |
235 | #if defined(VERSION_hourglass) | ||
236 | Date year m day = timeFromElapsed (Elapsed (Seconds $ fromIntegral t)) | 219 | Date year m day = timeFromElapsed (Elapsed (Seconds $ fromIntegral t)) |
237 | month = fromEnum m + 1 | 220 | month = fromEnum m + 1 |
238 | #else | ||
239 | (year,month,day) = toGregorian . utctDay $ posixSecondsToUTCTime (realToFrac t) | ||
240 | #endif | ||
241 | 221 | ||
242 | key_nbits :: Packet -> Int | 222 | key_nbits :: Packet -> Int |
243 | key_nbits p@(SecretKeyPacket {}) = _key_nbits (key_algorithm p) (key p) | 223 | key_nbits p@(SecretKeyPacket {}) = _key_nbits (key_algorithm p) (key p) |
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 |
@@ -1,5 +1,4 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | 1 | {-# LANGUAGE OverloadedStrings #-} |
2 | {-# LANGUAGE CPP #-} | ||
3 | module PEM where | 2 | module PEM where |
4 | 3 | ||
5 | import Data.Monoid | 4 | import Data.Monoid |
@@ -7,12 +6,8 @@ import qualified Data.ByteString.Lazy as LW | |||
7 | import qualified Data.ByteString.Lazy.Char8 as L | 6 | import qualified Data.ByteString.Lazy.Char8 as L |
8 | import Control.Monad | 7 | import Control.Monad |
9 | import Control.Applicative | 8 | import Control.Applicative |
10 | #if defined(VERSION_memory) | ||
11 | import qualified Data.ByteString.Char8 as S8 | 9 | import qualified Data.ByteString.Char8 as S8 |
12 | import Data.ByteArray.Encoding | 10 | import Data.ByteArray.Encoding |
13 | #elif defined(VERSION_dataenc) | ||
14 | import qualified Codec.Binary.Base64 as Base64 | ||
15 | #endif | ||
16 | import ScanningParser | 11 | import ScanningParser |
17 | import FunctorToMaybe | 12 | import FunctorToMaybe |
18 | data PEMBlob = PEMBlob { pemType :: L.ByteString | 13 | data PEMBlob = PEMBlob { pemType :: L.ByteString |
@@ -36,11 +31,7 @@ pemParser mtyp = ScanningParser (maybe fndany fndtyp mtyp) pbdy | |||
36 | pbdy typ xs = (mblob, drop 1 rs) | 31 | pbdy typ xs = (mblob, drop 1 rs) |
37 | where | 32 | where |
38 | (ys,rs) = span (/="-----END " <> typ <> "-----") xs | 33 | (ys,rs) = span (/="-----END " <> typ <> "-----") xs |
39 | #if defined(VERSION_memory) | ||
40 | mblob = PEMBlob typ <$> LW.fromStrict <$> (functorToMaybe $ convertFromBase Base64 $ L.toStrict dta) | 34 | mblob = PEMBlob typ <$> LW.fromStrict <$> (functorToMaybe $ convertFromBase Base64 $ L.toStrict dta) |
41 | #elif defined(VERSION_dataenc) | ||
42 | mblob = PEMBlob typ <$> LW.pack <$> Base64.decode (L.unpack dta) | ||
43 | #endif | ||
44 | dta = case ys of | 35 | dta = case ys of |
45 | [] -> "" | 36 | [] -> "" |
46 | dta_lines -> L.concat dta_lines | 37 | dta_lines -> L.concat dta_lines |
diff --git a/lib/SSHKey.hs b/lib/SSHKey.hs index 0ded986..81df18c 100644 --- a/lib/SSHKey.hs +++ b/lib/SSHKey.hs | |||
@@ -1,16 +1,11 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | 1 | {-# LANGUAGE OverloadedStrings #-} |
2 | {-# LANGUAGE CPP #-} | ||
3 | module SSHKey where | 2 | module SSHKey where |
4 | 3 | ||
5 | import qualified Data.ByteString.Lazy.Char8 as L8 | 4 | import qualified Data.ByteString.Lazy.Char8 as L8 |
6 | import qualified Data.ByteString.Lazy as L | 5 | import qualified Data.ByteString.Lazy as L |
7 | #if defined(VERSION_memory) | ||
8 | import qualified Data.ByteString.Char8 as S8 | 6 | import qualified Data.ByteString.Char8 as S8 |
9 | import Data.ByteArray.Encoding | 7 | import Data.ByteArray.Encoding |
10 | import FunctorToMaybe | 8 | import FunctorToMaybe |
11 | #elif defined(VERSION_dataenc) | ||
12 | import qualified Codec.Binary.Base64 as Base64 | ||
13 | #endif | ||
14 | import Data.Binary.Get ( runGet ) | 9 | import Data.Binary.Get ( runGet ) |
15 | import Data.Binary.Put ( putWord32be, runPut, putByteString ) | 10 | import Data.Binary.Put ( putWord32be, runPut, putByteString ) |
16 | import Data.Binary ( get, put ) | 11 | import Data.Binary ( get, put ) |
@@ -34,11 +29,7 @@ keyblob :: Key -> L.ByteString | |||
34 | keyblob (n,e) = "ssh-rsa " <> blob | 29 | keyblob (n,e) = "ssh-rsa " <> blob |
35 | where | 30 | where |
36 | bs = sshrsa e n | 31 | bs = sshrsa e n |
37 | #if defined(VERSION_memory) | ||
38 | blob = L.fromStrict $ convertToBase Base64 (L.toStrict bs) | 32 | blob = L.fromStrict $ convertToBase Base64 (L.toStrict bs) |
39 | #elif defined(VERSION_dataenc) | ||
40 | blob = L8.pack $ Base64.encode (L.unpack bs) | ||
41 | #endif | ||
42 | 33 | ||
43 | blobkey :: L8.ByteString -> Maybe Key | 34 | blobkey :: L8.ByteString -> Maybe Key |
44 | blobkey bs = do | 35 | blobkey bs = do |
@@ -47,11 +38,7 @@ blobkey bs = do | |||
47 | let (sp,bs2) = L8.span isSpace bs1 | 38 | let (sp,bs2) = L8.span isSpace bs1 |
48 | guard $ not (L8.null sp) | 39 | guard $ not (L8.null sp) |
49 | bs3 <- listToMaybe $ L8.words bs2 | 40 | bs3 <- listToMaybe $ L8.words bs2 |
50 | #if defined(VERSION_memory) | ||
51 | qq <- fmap L.fromStrict $ functorToMaybe $ convertFromBase Base64 $ L.toStrict bs3 | 41 | qq <- fmap L.fromStrict $ functorToMaybe $ convertFromBase Base64 $ L.toStrict bs3 |
52 | #elif defined(VERSION_dataenc) | ||
53 | qq <- L.pack `fmap` Base64.decode (L8.unpack bs3) | ||
54 | #endif | ||
55 | decode_sshrsa qq | 42 | decode_sshrsa qq |
56 | where | 43 | where |
57 | decode_sshrsa :: L8.ByteString -> Maybe Key | 44 | decode_sshrsa :: L8.ByteString -> Maybe Key |
diff --git a/lib/Transforms.hs b/lib/Transforms.hs index 7a676b0..3e13b1a 100644 --- a/lib/Transforms.hs +++ b/lib/Transforms.hs | |||
@@ -1,4 +1,3 @@ | |||
1 | {-# LANGUAGE CPP #-} | ||
2 | {-# LANGUAGE DoAndIfThenElse #-} | 1 | {-# LANGUAGE DoAndIfThenElse #-} |
3 | {-# LANGUAGE OverloadedStrings #-} | 2 | {-# LANGUAGE OverloadedStrings #-} |
4 | {-# LANGUAGE PatternGuards #-} | 3 | {-# LANGUAGE PatternGuards #-} |
@@ -26,20 +25,10 @@ import qualified Data.ByteString as S | |||
26 | import qualified Data.ByteString.Lazy as L | 25 | import qualified Data.ByteString.Lazy as L |
27 | import qualified Data.ByteString.Lazy.Char8 as Char8 | 26 | import qualified Data.ByteString.Lazy.Char8 as Char8 |
28 | import qualified Data.Map.Strict as Map | 27 | import qualified Data.Map.Strict as Map |
29 | #if defined(VERSION_memory) | ||
30 | import qualified Data.ByteString.Char8 as S8 | 28 | import qualified Data.ByteString.Char8 as S8 |
31 | import Data.ByteArray.Encoding | 29 | import Data.ByteArray.Encoding |
32 | #elif defined(VERSION_dataenc) | ||
33 | import qualified Codec.Binary.Base32 as Base32 | ||
34 | import qualified Codec.Binary.Base64 as Base64 | ||
35 | #endif | ||
36 | #if !defined(VERSION_cryptonite) | ||
37 | import qualified Crypto.Hash.SHA1 as SHA1 | ||
38 | import qualified Crypto.Types.PubKey.ECC as ECC | ||
39 | #else | ||
40 | import qualified Crypto.Hash as Vincent | 30 | import qualified Crypto.Hash as Vincent |
41 | import Data.ByteArray (convert) | 31 | import Data.ByteArray (convert) |
42 | #endif | ||
43 | import Data.ASN1.BinaryEncoding ( DER(..) ) | 32 | import Data.ASN1.BinaryEncoding ( DER(..) ) |
44 | import Data.ASN1.Types (toASN1, ASN1Object, fromASN1, ASN1(Start, End, IntVal), ASN1ConstructionType(Sequence) ) | 33 | import Data.ASN1.Types (toASN1, ASN1Object, fromASN1, ASN1(Start, End, IntVal), ASN1ConstructionType(Sequence) ) |
45 | 34 | ||
@@ -665,16 +654,8 @@ derToBase32 :: L.ByteString -> String | |||
665 | derToBase32 = map toLower . base32 . sha1 | 654 | derToBase32 = map toLower . base32 . sha1 |
666 | where | 655 | where |
667 | sha1 :: L.ByteString -> S.ByteString | 656 | sha1 :: L.ByteString -> S.ByteString |
668 | #if !defined(VERSION_cryptonite) | ||
669 | sha1 = SHA1.hashlazy | ||
670 | #else | ||
671 | sha1 x = convert (Vincent.hashlazy x :: Vincent.Digest Vincent.SHA1) | 657 | sha1 x = convert (Vincent.hashlazy x :: Vincent.Digest Vincent.SHA1) |
672 | #endif | ||
673 | #if defined(VERSION_memory) | ||
674 | base32 = S8.unpack . convertToBase Base32 | 658 | base32 = S8.unpack . convertToBase Base32 |
675 | #elif defined(VERSION_dataenc) | ||
676 | base32 = Base32.encode . S.unpack | ||
677 | #endif | ||
678 | 659 | ||
679 | derRSA :: Packet -> Maybe L.ByteString | 660 | derRSA :: Packet -> Maybe L.ByteString |
680 | derRSA rsa = do | 661 | derRSA rsa = do |