From a15059b0452ba9d730404ce5c5a6b91a3828fdbc Mon Sep 17 00:00:00 2001 From: joe Date: Sat, 27 Aug 2016 04:29:39 -0400 Subject: Replaced dataenc with memory. --- lib/KeyRing.hs | 45 ++++++++++++++++++++++++++++++++++++--------- lib/Kiki.hs | 11 ++++++++++- lib/PEM.hs | 12 +++++++++++- lib/SSHKey.hs | 15 +++++++++++++++ lib/TimeUtil.hs | 2 ++ 5 files changed, 74 insertions(+), 11 deletions(-) (limited to 'lib') diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index bc881f2..ae2d14d 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs @@ -145,12 +145,15 @@ import Data.Time.Clock ( UTCTime ) import Data.Bits ( Bits, shiftR ) import Data.Text.Encoding ( encodeUtf8 ) import qualified Data.Map as Map -import qualified Data.ByteString.Lazy as L ( unpack, null, readFile, writeFile - , ByteString, toChunks, hGetContents, hPut, concat, fromChunks, splitAt - , index, break, pack, empty ) -import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile, breakSubstring, drop, length, null, hPutStr, singleton, unfoldr, reverse ) +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString as S +#if defined(VERSION_memory) +import qualified Data.ByteString.Char8 as S8 +import Data.ByteArray.Encoding +#elif defined(VERSION_dataenc) import qualified Codec.Binary.Base32 as Base32 import qualified Codec.Binary.Base64 as Base64 +#endif #if !defined(VERSION_cryptonite) import qualified Crypto.Hash.SHA1 as SHA1 import qualified Crypto.Types.PubKey.ECC as ECC @@ -1795,14 +1798,19 @@ torhash :: Packet -> String torhash key = fromMaybe "" $ derToBase32 <$> derRSA key derToBase32 :: ByteString -> String -#if !defined(VERSION_cryptonite) -derToBase32 = map toLower . Base32.encode . S.unpack . SHA1.hashlazy -#else -derToBase32 = map toLower . Base32.encode . S.unpack . sha1 +derToBase32 = map toLower . base32 . sha1 where sha1 :: L.ByteString -> S.ByteString +#if !defined(VERSION_cryptonite) + sha1 = SHA1.hashlazy +#else sha1 x = convert (Vincent.hashlazy x :: Vincent.Digest Vincent.SHA1) #endif +#if defined(VERSION_memory) + base32 = S8.unpack . convertToBase Base32 +#elif defined(VERSION_dataenc) + base32 = Base32.encode . S.unpack +#endif derRSA :: Packet -> Maybe ByteString derRSA rsa = do @@ -1930,11 +1938,18 @@ extractRSAKeyFields kvs = do , rsaCoefficient = u } where parseField blob = MPI <$> m +#if defined(VERSION_memory) + where m = bigendian <$> functorToMaybe (convertFromBase Base64 $ Char8.toStrict blob) + bigendian bs = snd $ S.foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) bs + where + nlen = S.length bs +#elif defined(VERSION_dataenc) where m = bigendian <$> Base64.decode (Char8.unpack blob) - bigendian bs = snd $ foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) bs where nlen = length bs +#endif + rsaToPGP stamp rsa = SecretKeyPacket { version = 4 @@ -2422,7 +2437,11 @@ pemFromPacket Sec packet = rsa <- rsaPrivateKeyFromPacket packet -- RSAPrivateKey let asn1 = toASN1 rsa [] bs = encodeASN1 DER asn1 +#if defined(VERSION_memory) + dta = S8.unpack $ convertToBase Base64 (L.toStrict bs) +#elif defined(VERSION_dataenc) dta = Base64.encode (L.unpack bs) +#endif output = writePEM "RSA PRIVATE KEY" dta Just output algo -> Nothing @@ -2432,7 +2451,11 @@ pemFromPacket Pub packet = rsa <- rsaKeyFromPacket packet let asn1 = toASN1 (pkcs8 rsa) [] bs = encodeASN1 DER asn1 +#if defined(VERSION_memory) + dta = S8.unpack $ convertToBase Base64 (L.toStrict bs) +#elif defined(VERSION_dataenc) dta = Base64.encode (L.unpack bs) +#endif output = writePEM "PUBLIC KEY" dta Just output algo -> Nothing @@ -2464,7 +2487,11 @@ writeKeyToFile StreamInfo { typ = DNSPresentation } fname packet = do let -- asn1 = toASN1 rsa [] -- bs = encodeASN1 DER asn1 -- dta = Base64.encode (L.unpack bs) +#if defined(VERSION_memory) + b64 ac rsa = S8.unpack $ convertToBase Base64 $ i2bs_unsized i +#elif defined(VERSION_dataenc) b64 ac rsa = Base64.encode (S.unpack $ i2bs_unsized i) +#endif where MPI i = ac rsa i2bs_unsized :: Integer -> S.ByteString diff --git a/lib/Kiki.hs b/lib/Kiki.hs index ef7b913..a134680 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs @@ -26,7 +26,12 @@ import System.Posix.User import System.Process import System.Posix.Files import qualified Data.Traversable as T (mapM) +#if defined(VERSION_memory) +import qualified Data.ByteString.Char8 as S8 +import Data.ByteArray.Encoding +#elif defined(VERSION_dataenc) import qualified Codec.Binary.Base64 as Base64 +#endif import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as Char8 import qualified Data.Map.Strict as Map @@ -146,7 +151,7 @@ importAndRefresh root cmn = do ( encode $ Message [mk { is_subkey = False }] ) -} master_un <- (\k -> k { is_subkey = False }) <$> generateKey (GenRSA $ 4096 `div` 8 ) - let default_cipher = (CAST5, IteratedSaltedS2K SHA1 4073382889203176146 7864320) + let default_cipher = (CAST5 {- AES128 -}, IteratedSaltedS2K SHA1 4073382889203176146 7864320) ctx = InputFileContext secring pubring passwordop = KeyRingOperation { opFiles = Map.empty @@ -452,7 +457,11 @@ sortOn f = pemFromPacket k = do let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k der = encodeASN1 DER (toASN1 rsa []) +#if defined(VERSION_memory) + qq = S8.unpack $ convertToBase Base64 (L.toStrict der) +#elif defined(VERSION_dataenc) qq = Base64.encode (L.unpack der) +#endif return $ writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec) diff --git a/lib/PEM.hs b/lib/PEM.hs index e07b3d4..fd2fe98 100644 --- a/lib/PEM.hs +++ b/lib/PEM.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} module PEM where import Data.Monoid @@ -6,9 +7,14 @@ import qualified Data.ByteString.Lazy as LW import qualified Data.ByteString.Lazy.Char8 as L import Control.Monad import Control.Applicative +#if defined(VERSION_memory) +import qualified Data.ByteString.Char8 as S8 +import Data.ByteArray.Encoding +#elif defined(VERSION_dataenc) import qualified Codec.Binary.Base64 as Base64 +#endif import ScanningParser - +import FunctorToMaybe data PEMBlob = PEMBlob { pemType :: L.ByteString , pemBlob :: L.ByteString } @@ -28,7 +34,11 @@ pemParser mtyp = ScanningParser (maybe fndany fndtyp mtyp) pbdy pbdy typ xs = (mblob, drop 1 rs) where (ys,rs) = span (/="-----END " <> typ <> "-----") xs +#if defined(VERSION_memory) + mblob = PEMBlob typ <$> LW.fromStrict <$> (functorToMaybe $ convertFromBase Base64 $ L.toStrict dta) +#elif defined(VERSION_dataenc) mblob = PEMBlob typ <$> LW.pack <$> Base64.decode (L.unpack dta) +#endif dta = case ys of [] -> "" dta_lines -> L.concat dta_lines diff --git a/lib/SSHKey.hs b/lib/SSHKey.hs index 488f55f..bd47169 100644 --- a/lib/SSHKey.hs +++ b/lib/SSHKey.hs @@ -1,9 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} module SSHKey where import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.Lazy as L +#if defined(VERSION_memory) +import qualified Data.ByteString.Char8 as S8 +import Data.ByteArray.Encoding +import FunctorToMaybe +#elif defined(VERSION_dataenc) import qualified Codec.Binary.Base64 as Base64 +#endif import Data.Binary.Get ( runGet ) import Data.Binary.Put ( putWord32be, runPut, putByteString ) import Data.Binary ( get, put ) @@ -19,7 +26,11 @@ keyblob :: Key -> L.ByteString keyblob (n,e) = "ssh-rsa " <> blob where bs = sshrsa e n +#if defined(VERSION_memory) + blob = L.fromStrict $ convertToBase Base64 (L.toStrict bs) +#elif defined(VERSION_dataenc) blob = L8.pack $ Base64.encode (L.unpack bs) +#endif sshrsa :: Integer -> Integer -> L.ByteString sshrsa e n = runPut $ do @@ -35,7 +46,11 @@ blobkey bs = do let (sp,bs2) = L8.span isSpace bs1 guard $ not (L8.null sp) bs3 <- listToMaybe $ L8.words bs2 +#if defined(VERSION_memory) + qq <- fmap L.fromStrict $ functorToMaybe $ convertFromBase Base64 $ L.toStrict bs3 +#elif defined(VERSION_dataenc) qq <- L.pack `fmap` Base64.decode (L8.unpack bs3) +#endif decode_sshrsa qq where decode_sshrsa :: L8.ByteString -> Maybe Key diff --git a/lib/TimeUtil.hs b/lib/TimeUtil.hs index 879bc32..b678d5f 100644 --- a/lib/TimeUtil.hs +++ b/lib/TimeUtil.hs @@ -11,6 +11,8 @@ module TimeUtil , dateParser ) where +-- TODO: switch to hourglass package + import Data.Time.LocalTime import Data.Time.Format import Data.Time.Clock -- cgit v1.2.3