summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/KeyRing.hs45
-rw-r--r--lib/Kiki.hs11
-rw-r--r--lib/PEM.hs12
-rw-r--r--lib/SSHKey.hs15
-rw-r--r--lib/TimeUtil.hs2
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 )
145import Data.Bits ( Bits, shiftR ) 145import Data.Bits ( Bits, shiftR )
146import Data.Text.Encoding ( encodeUtf8 ) 146import Data.Text.Encoding ( encodeUtf8 )
147import qualified Data.Map as Map 147import qualified Data.Map as Map
148import qualified Data.ByteString.Lazy as L ( unpack, null, readFile, writeFile 148import qualified Data.ByteString.Lazy as L
149 , ByteString, toChunks, hGetContents, hPut, concat, fromChunks, splitAt 149import qualified Data.ByteString as S
150 , index, break, pack, empty ) 150#if defined(VERSION_memory)
151import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile, breakSubstring, drop, length, null, hPutStr, singleton, unfoldr, reverse ) 151import qualified Data.ByteString.Char8 as S8
152import Data.ByteArray.Encoding
153#elif defined(VERSION_dataenc)
152import qualified Codec.Binary.Base32 as Base32 154import qualified Codec.Binary.Base32 as Base32
153import qualified Codec.Binary.Base64 as Base64 155import qualified Codec.Binary.Base64 as Base64
156#endif
154#if !defined(VERSION_cryptonite) 157#if !defined(VERSION_cryptonite)
155import qualified Crypto.Hash.SHA1 as SHA1 158import qualified Crypto.Hash.SHA1 as SHA1
156import qualified Crypto.Types.PubKey.ECC as ECC 159import qualified Crypto.Types.PubKey.ECC as ECC
@@ -1795,14 +1798,19 @@ torhash :: Packet -> String
1795torhash key = fromMaybe "" $ derToBase32 <$> derRSA key 1798torhash key = fromMaybe "" $ derToBase32 <$> derRSA key
1796 1799
1797derToBase32 :: ByteString -> String 1800derToBase32 :: ByteString -> String
1798#if !defined(VERSION_cryptonite) 1801derToBase32 = map toLower . base32 . sha1
1799derToBase32 = map toLower . Base32.encode . S.unpack . SHA1.hashlazy
1800#else
1801derToBase32 = 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
1807derRSA :: Packet -> Maybe ByteString 1815derRSA :: Packet -> Maybe ByteString
1808derRSA rsa = do 1816derRSA 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
1939rsaToPGP stamp rsa = SecretKeyPacket 1954rsaToPGP 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
26import System.Process 26import System.Process
27import System.Posix.Files 27import System.Posix.Files
28import qualified Data.Traversable as T (mapM) 28import qualified Data.Traversable as T (mapM)
29#if defined(VERSION_memory)
30import qualified Data.ByteString.Char8 as S8
31import Data.ByteArray.Encoding
32#elif defined(VERSION_dataenc)
29import qualified Codec.Binary.Base64 as Base64 33import qualified Codec.Binary.Base64 as Base64
34#endif
30import qualified Data.ByteString.Lazy as L 35import qualified Data.ByteString.Lazy as L
31import qualified Data.ByteString.Lazy.Char8 as Char8 36import qualified Data.ByteString.Lazy.Char8 as Char8
32import qualified Data.Map.Strict as Map 37import 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 =
452pemFromPacket k = do 457pemFromPacket 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
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 @@
1{-# LANGUAGE OverloadedStrings #-} 1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE CPP #-}
2module PEM where 3module PEM where
3 4
4import Data.Monoid 5import Data.Monoid
@@ -6,9 +7,14 @@ import qualified Data.ByteString.Lazy as LW
6import qualified Data.ByteString.Lazy.Char8 as L 7import qualified Data.ByteString.Lazy.Char8 as L
7import Control.Monad 8import Control.Monad
8import Control.Applicative 9import Control.Applicative
10#if defined(VERSION_memory)
11import qualified Data.ByteString.Char8 as S8
12import Data.ByteArray.Encoding
13#elif defined(VERSION_dataenc)
9import qualified Codec.Binary.Base64 as Base64 14import qualified Codec.Binary.Base64 as Base64
15#endif
10import ScanningParser 16import ScanningParser
11 17import FunctorToMaybe
12data PEMBlob = PEMBlob { pemType :: L.ByteString 18data 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 #-}
2module SSHKey where 3module SSHKey where
3 4
4import qualified Data.ByteString.Lazy.Char8 as L8 5import qualified Data.ByteString.Lazy.Char8 as L8
5import qualified Data.ByteString.Lazy as L 6import qualified Data.ByteString.Lazy as L
7#if defined(VERSION_memory)
8import qualified Data.ByteString.Char8 as S8
9import Data.ByteArray.Encoding
10import FunctorToMaybe
11#elif defined(VERSION_dataenc)
6import qualified Codec.Binary.Base64 as Base64 12import qualified Codec.Binary.Base64 as Base64
13#endif
7import Data.Binary.Get ( runGet ) 14import Data.Binary.Get ( runGet )
8import Data.Binary.Put ( putWord32be, runPut, putByteString ) 15import Data.Binary.Put ( putWord32be, runPut, putByteString )
9import Data.Binary ( get, put ) 16import Data.Binary ( get, put )
@@ -19,7 +26,11 @@ keyblob :: Key -> L.ByteString
19keyblob (n,e) = "ssh-rsa " <> blob 26keyblob (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
14import Data.Time.LocalTime 16import Data.Time.LocalTime
15import Data.Time.Format 17import Data.Time.Format
16import Data.Time.Clock 18import Data.Time.Clock