diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/KeyRing.hs | 45 | ||||
-rw-r--r-- | lib/Kiki.hs | 11 | ||||
-rw-r--r-- | lib/PEM.hs | 12 | ||||
-rw-r--r-- | lib/SSHKey.hs | 15 | ||||
-rw-r--r-- | lib/TimeUtil.hs | 2 |
5 files changed, 74 insertions, 11 deletions
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 ) | |||
145 | import Data.Bits ( Bits, shiftR ) | 145 | import Data.Bits ( Bits, shiftR ) |
146 | import Data.Text.Encoding ( encodeUtf8 ) | 146 | import Data.Text.Encoding ( encodeUtf8 ) |
147 | import qualified Data.Map as Map | 147 | import qualified Data.Map as Map |
148 | import qualified Data.ByteString.Lazy as L ( unpack, null, readFile, writeFile | 148 | import qualified Data.ByteString.Lazy as L |
149 | , ByteString, toChunks, hGetContents, hPut, concat, fromChunks, splitAt | 149 | import qualified Data.ByteString as S |
150 | , index, break, pack, empty ) | 150 | #if defined(VERSION_memory) |
151 | import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile, breakSubstring, drop, length, null, hPutStr, singleton, unfoldr, reverse ) | 151 | import qualified Data.ByteString.Char8 as S8 |
152 | import Data.ByteArray.Encoding | ||
153 | #elif defined(VERSION_dataenc) | ||
152 | import qualified Codec.Binary.Base32 as Base32 | 154 | import qualified Codec.Binary.Base32 as Base32 |
153 | import qualified Codec.Binary.Base64 as Base64 | 155 | import qualified Codec.Binary.Base64 as Base64 |
156 | #endif | ||
154 | #if !defined(VERSION_cryptonite) | 157 | #if !defined(VERSION_cryptonite) |
155 | import qualified Crypto.Hash.SHA1 as SHA1 | 158 | import qualified Crypto.Hash.SHA1 as SHA1 |
156 | import qualified Crypto.Types.PubKey.ECC as ECC | 159 | import qualified Crypto.Types.PubKey.ECC as ECC |
@@ -1795,14 +1798,19 @@ torhash :: Packet -> String | |||
1795 | torhash key = fromMaybe "" $ derToBase32 <$> derRSA key | 1798 | torhash key = fromMaybe "" $ derToBase32 <$> derRSA key |
1796 | 1799 | ||
1797 | derToBase32 :: ByteString -> String | 1800 | derToBase32 :: ByteString -> String |
1798 | #if !defined(VERSION_cryptonite) | 1801 | derToBase32 = map toLower . base32 . sha1 |
1799 | derToBase32 = map toLower . Base32.encode . S.unpack . SHA1.hashlazy | ||
1800 | #else | ||
1801 | derToBase32 = map toLower . Base32.encode . S.unpack . sha1 | ||
1802 | where | 1802 | where |
1803 | sha1 :: L.ByteString -> S.ByteString | 1803 | sha1 :: L.ByteString -> S.ByteString |
1804 | #if !defined(VERSION_cryptonite) | ||
1805 | sha1 = SHA1.hashlazy | ||
1806 | #else | ||
1804 | sha1 x = convert (Vincent.hashlazy x :: Vincent.Digest Vincent.SHA1) | 1807 | sha1 x = convert (Vincent.hashlazy x :: Vincent.Digest Vincent.SHA1) |
1805 | #endif | 1808 | #endif |
1809 | #if defined(VERSION_memory) | ||
1810 | base32 = S8.unpack . convertToBase Base32 | ||
1811 | #elif defined(VERSION_dataenc) | ||
1812 | base32 = Base32.encode . S.unpack | ||
1813 | #endif | ||
1806 | 1814 | ||
1807 | derRSA :: Packet -> Maybe ByteString | 1815 | derRSA :: Packet -> Maybe ByteString |
1808 | derRSA rsa = do | 1816 | derRSA rsa = do |
@@ -1930,11 +1938,18 @@ extractRSAKeyFields kvs = do | |||
1930 | , rsaCoefficient = u } | 1938 | , rsaCoefficient = u } |
1931 | where | 1939 | where |
1932 | parseField blob = MPI <$> m | 1940 | parseField blob = MPI <$> m |
1941 | #if defined(VERSION_memory) | ||
1942 | where m = bigendian <$> functorToMaybe (convertFromBase Base64 $ Char8.toStrict blob) | ||
1943 | bigendian bs = snd $ S.foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) bs | ||
1944 | where | ||
1945 | nlen = S.length bs | ||
1946 | #elif defined(VERSION_dataenc) | ||
1933 | where m = bigendian <$> Base64.decode (Char8.unpack blob) | 1947 | where m = bigendian <$> Base64.decode (Char8.unpack blob) |
1934 | |||
1935 | bigendian bs = snd $ foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) bs | 1948 | bigendian bs = snd $ foldl' (\(c,a) w8 -> (c-1, a + 256^c * fromIntegral w8)) (nlen-1,0) bs |
1936 | where | 1949 | where |
1937 | nlen = length bs | 1950 | nlen = length bs |
1951 | #endif | ||
1952 | |||
1938 | 1953 | ||
1939 | rsaToPGP stamp rsa = SecretKeyPacket | 1954 | rsaToPGP stamp rsa = SecretKeyPacket |
1940 | { version = 4 | 1955 | { version = 4 |
@@ -2422,7 +2437,11 @@ pemFromPacket Sec packet = | |||
2422 | rsa <- rsaPrivateKeyFromPacket packet -- RSAPrivateKey | 2437 | rsa <- rsaPrivateKeyFromPacket packet -- RSAPrivateKey |
2423 | let asn1 = toASN1 rsa [] | 2438 | let asn1 = toASN1 rsa [] |
2424 | bs = encodeASN1 DER asn1 | 2439 | bs = encodeASN1 DER asn1 |
2440 | #if defined(VERSION_memory) | ||
2441 | dta = S8.unpack $ convertToBase Base64 (L.toStrict bs) | ||
2442 | #elif defined(VERSION_dataenc) | ||
2425 | dta = Base64.encode (L.unpack bs) | 2443 | dta = Base64.encode (L.unpack bs) |
2444 | #endif | ||
2426 | output = writePEM "RSA PRIVATE KEY" dta | 2445 | output = writePEM "RSA PRIVATE KEY" dta |
2427 | Just output | 2446 | Just output |
2428 | algo -> Nothing | 2447 | algo -> Nothing |
@@ -2432,7 +2451,11 @@ pemFromPacket Pub packet = | |||
2432 | rsa <- rsaKeyFromPacket packet | 2451 | rsa <- rsaKeyFromPacket packet |
2433 | let asn1 = toASN1 (pkcs8 rsa) [] | 2452 | let asn1 = toASN1 (pkcs8 rsa) [] |
2434 | bs = encodeASN1 DER asn1 | 2453 | bs = encodeASN1 DER asn1 |
2454 | #if defined(VERSION_memory) | ||
2455 | dta = S8.unpack $ convertToBase Base64 (L.toStrict bs) | ||
2456 | #elif defined(VERSION_dataenc) | ||
2435 | dta = Base64.encode (L.unpack bs) | 2457 | dta = Base64.encode (L.unpack bs) |
2458 | #endif | ||
2436 | output = writePEM "PUBLIC KEY" dta | 2459 | output = writePEM "PUBLIC KEY" dta |
2437 | Just output | 2460 | Just output |
2438 | algo -> Nothing | 2461 | algo -> Nothing |
@@ -2464,7 +2487,11 @@ writeKeyToFile StreamInfo { typ = DNSPresentation } fname packet = do | |||
2464 | let -- asn1 = toASN1 rsa [] | 2487 | let -- asn1 = toASN1 rsa [] |
2465 | -- bs = encodeASN1 DER asn1 | 2488 | -- bs = encodeASN1 DER asn1 |
2466 | -- dta = Base64.encode (L.unpack bs) | 2489 | -- dta = Base64.encode (L.unpack bs) |
2490 | #if defined(VERSION_memory) | ||
2491 | b64 ac rsa = S8.unpack $ convertToBase Base64 $ i2bs_unsized i | ||
2492 | #elif defined(VERSION_dataenc) | ||
2467 | b64 ac rsa = Base64.encode (S.unpack $ i2bs_unsized i) | 2493 | b64 ac rsa = Base64.encode (S.unpack $ i2bs_unsized i) |
2494 | #endif | ||
2468 | where | 2495 | where |
2469 | MPI i = ac rsa | 2496 | MPI i = ac rsa |
2470 | i2bs_unsized :: Integer -> S.ByteString | 2497 | 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 | |||
26 | import System.Process | 26 | import System.Process |
27 | import System.Posix.Files | 27 | import System.Posix.Files |
28 | import qualified Data.Traversable as T (mapM) | 28 | import qualified Data.Traversable as T (mapM) |
29 | #if defined(VERSION_memory) | ||
30 | import qualified Data.ByteString.Char8 as S8 | ||
31 | import Data.ByteArray.Encoding | ||
32 | #elif defined(VERSION_dataenc) | ||
29 | import qualified Codec.Binary.Base64 as Base64 | 33 | import qualified Codec.Binary.Base64 as Base64 |
34 | #endif | ||
30 | import qualified Data.ByteString.Lazy as L | 35 | import qualified Data.ByteString.Lazy as L |
31 | import qualified Data.ByteString.Lazy.Char8 as Char8 | 36 | import qualified Data.ByteString.Lazy.Char8 as Char8 |
32 | import qualified Data.Map.Strict as Map | 37 | import qualified Data.Map.Strict as Map |
@@ -146,7 +151,7 @@ importAndRefresh root cmn = do | |||
146 | ( encode $ Message [mk { is_subkey = False }] ) | 151 | ( encode $ Message [mk { is_subkey = False }] ) |
147 | -} | 152 | -} |
148 | master_un <- (\k -> k { is_subkey = False }) <$> generateKey (GenRSA $ 4096 `div` 8 ) | 153 | master_un <- (\k -> k { is_subkey = False }) <$> generateKey (GenRSA $ 4096 `div` 8 ) |
149 | let default_cipher = (CAST5, IteratedSaltedS2K SHA1 4073382889203176146 7864320) | 154 | let default_cipher = (CAST5 {- AES128 -}, IteratedSaltedS2K SHA1 4073382889203176146 7864320) |
150 | ctx = InputFileContext secring pubring | 155 | ctx = InputFileContext secring pubring |
151 | passwordop = KeyRingOperation | 156 | passwordop = KeyRingOperation |
152 | { opFiles = Map.empty | 157 | { opFiles = Map.empty |
@@ -452,7 +457,11 @@ sortOn f = | |||
452 | pemFromPacket k = do | 457 | pemFromPacket k = do |
453 | let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k | 458 | let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k |
454 | der = encodeASN1 DER (toASN1 rsa []) | 459 | der = encodeASN1 DER (toASN1 rsa []) |
460 | #if defined(VERSION_memory) | ||
461 | qq = S8.unpack $ convertToBase Base64 (L.toStrict der) | ||
462 | #elif defined(VERSION_dataenc) | ||
455 | qq = Base64.encode (L.unpack der) | 463 | qq = Base64.encode (L.unpack der) |
464 | #endif | ||
456 | return $ | 465 | return $ |
457 | writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec) | 466 | writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec) |
458 | 467 | ||
@@ -1,4 +1,5 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | 1 | {-# LANGUAGE OverloadedStrings #-} |
2 | {-# LANGUAGE CPP #-} | ||
2 | module PEM where | 3 | module PEM where |
3 | 4 | ||
4 | import Data.Monoid | 5 | import Data.Monoid |
@@ -6,9 +7,14 @@ import qualified Data.ByteString.Lazy as LW | |||
6 | import qualified Data.ByteString.Lazy.Char8 as L | 7 | import qualified Data.ByteString.Lazy.Char8 as L |
7 | import Control.Monad | 8 | import Control.Monad |
8 | import Control.Applicative | 9 | import Control.Applicative |
10 | #if defined(VERSION_memory) | ||
11 | import qualified Data.ByteString.Char8 as S8 | ||
12 | import Data.ByteArray.Encoding | ||
13 | #elif defined(VERSION_dataenc) | ||
9 | import qualified Codec.Binary.Base64 as Base64 | 14 | import qualified Codec.Binary.Base64 as Base64 |
15 | #endif | ||
10 | import ScanningParser | 16 | import ScanningParser |
11 | 17 | import FunctorToMaybe | |
12 | data PEMBlob = PEMBlob { pemType :: L.ByteString | 18 | data PEMBlob = PEMBlob { pemType :: L.ByteString |
13 | , pemBlob :: L.ByteString | 19 | , pemBlob :: L.ByteString |
14 | } | 20 | } |
@@ -28,7 +34,11 @@ pemParser mtyp = ScanningParser (maybe fndany fndtyp mtyp) pbdy | |||
28 | pbdy typ xs = (mblob, drop 1 rs) | 34 | pbdy typ xs = (mblob, drop 1 rs) |
29 | where | 35 | where |
30 | (ys,rs) = span (/="-----END " <> typ <> "-----") xs | 36 | (ys,rs) = span (/="-----END " <> typ <> "-----") xs |
37 | #if defined(VERSION_memory) | ||
38 | mblob = PEMBlob typ <$> LW.fromStrict <$> (functorToMaybe $ convertFromBase Base64 $ L.toStrict dta) | ||
39 | #elif defined(VERSION_dataenc) | ||
31 | mblob = PEMBlob typ <$> LW.pack <$> Base64.decode (L.unpack dta) | 40 | mblob = PEMBlob typ <$> LW.pack <$> Base64.decode (L.unpack dta) |
41 | #endif | ||
32 | dta = case ys of | 42 | dta = case ys of |
33 | [] -> "" | 43 | [] -> "" |
34 | dta_lines -> L.concat dta_lines | 44 | 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 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | 1 | {-# LANGUAGE OverloadedStrings #-} |
2 | {-# LANGUAGE CPP #-} | ||
2 | module SSHKey where | 3 | module SSHKey where |
3 | 4 | ||
4 | import qualified Data.ByteString.Lazy.Char8 as L8 | 5 | import qualified Data.ByteString.Lazy.Char8 as L8 |
5 | import qualified Data.ByteString.Lazy as L | 6 | import qualified Data.ByteString.Lazy as L |
7 | #if defined(VERSION_memory) | ||
8 | import qualified Data.ByteString.Char8 as S8 | ||
9 | import Data.ByteArray.Encoding | ||
10 | import FunctorToMaybe | ||
11 | #elif defined(VERSION_dataenc) | ||
6 | import qualified Codec.Binary.Base64 as Base64 | 12 | import qualified Codec.Binary.Base64 as Base64 |
13 | #endif | ||
7 | import Data.Binary.Get ( runGet ) | 14 | import Data.Binary.Get ( runGet ) |
8 | import Data.Binary.Put ( putWord32be, runPut, putByteString ) | 15 | import Data.Binary.Put ( putWord32be, runPut, putByteString ) |
9 | import Data.Binary ( get, put ) | 16 | import Data.Binary ( get, put ) |
@@ -19,7 +26,11 @@ keyblob :: Key -> L.ByteString | |||
19 | keyblob (n,e) = "ssh-rsa " <> blob | 26 | keyblob (n,e) = "ssh-rsa " <> blob |
20 | where | 27 | where |
21 | bs = sshrsa e n | 28 | bs = sshrsa e n |
29 | #if defined(VERSION_memory) | ||
30 | blob = L.fromStrict $ convertToBase Base64 (L.toStrict bs) | ||
31 | #elif defined(VERSION_dataenc) | ||
22 | blob = L8.pack $ Base64.encode (L.unpack bs) | 32 | blob = L8.pack $ Base64.encode (L.unpack bs) |
33 | #endif | ||
23 | 34 | ||
24 | sshrsa :: Integer -> Integer -> L.ByteString | 35 | sshrsa :: Integer -> Integer -> L.ByteString |
25 | sshrsa e n = runPut $ do | 36 | sshrsa e n = runPut $ do |
@@ -35,7 +46,11 @@ blobkey bs = do | |||
35 | let (sp,bs2) = L8.span isSpace bs1 | 46 | let (sp,bs2) = L8.span isSpace bs1 |
36 | guard $ not (L8.null sp) | 47 | guard $ not (L8.null sp) |
37 | bs3 <- listToMaybe $ L8.words bs2 | 48 | bs3 <- listToMaybe $ L8.words bs2 |
49 | #if defined(VERSION_memory) | ||
50 | qq <- fmap L.fromStrict $ functorToMaybe $ convertFromBase Base64 $ L.toStrict bs3 | ||
51 | #elif defined(VERSION_dataenc) | ||
38 | qq <- L.pack `fmap` Base64.decode (L8.unpack bs3) | 52 | qq <- L.pack `fmap` Base64.decode (L8.unpack bs3) |
53 | #endif | ||
39 | decode_sshrsa qq | 54 | decode_sshrsa qq |
40 | where | 55 | where |
41 | decode_sshrsa :: L8.ByteString -> Maybe Key | 56 | 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 | |||
11 | , dateParser | 11 | , dateParser |
12 | ) where | 12 | ) where |
13 | 13 | ||
14 | -- TODO: switch to hourglass package | ||
15 | |||
14 | import Data.Time.LocalTime | 16 | import Data.Time.LocalTime |
15 | import Data.Time.Format | 17 | import Data.Time.Format |
16 | import Data.Time.Clock | 18 | import Data.Time.Clock |