summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--kiki.cabal12
-rw-r--r--kiki.hs18
-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
7 files changed, 97 insertions, 18 deletions
diff --git a/kiki.cabal b/kiki.cabal
index 3084908..85461c7 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -35,7 +35,6 @@ Executable kiki
35 binary, 35 binary,
36 bytestring, 36 bytestring,
37 containers, 37 containers,
38 dataenc,
39 directory, 38 directory,
40 filepath, 39 filepath,
41 tar, 40 tar,
@@ -48,7 +47,7 @@ Executable kiki
48 other-modules: DNSKey 47 other-modules: DNSKey
49 if !flag(cryptonite) 48 if !flag(cryptonite)
50 Build-Depends: crypto-pubkey >=0.2.3, cryptohash -any, 49 Build-Depends: crypto-pubkey >=0.2.3, cryptohash -any,
51 crypto-pubkey-types -any 50 crypto-pubkey-types -any, dataenc
52 if flag(hourglass) 51 if flag(hourglass)
53 Build-Depends: hourglass -any, x509 >=1.5 && <1.6 52 Build-Depends: hourglass -any, x509 >=1.5 && <1.6
54 else 53 else
@@ -89,11 +88,11 @@ library
89 CommandLine, 88 CommandLine,
90 Numeric.Interval, 89 Numeric.Interval,
91 Numeric.Interval.Bounded, 90 Numeric.Interval.Bounded,
92 SuperOrd 91 SuperOrd,
92 FunctorToMaybe
93 other-modules: TimeUtil, 93 other-modules: TimeUtil,
94 ControlMaybe, 94 ControlMaybe,
95 Compat, 95 Compat
96 FunctorToMaybe
97 96
98 Build-Depends: base >=4.6.0.0, 97 Build-Depends: base >=4.6.0.0,
99 asn1-encoding, 98 asn1-encoding,
@@ -101,7 +100,6 @@ library
101 binary, 100 binary,
102 bytestring, 101 bytestring,
103 containers, 102 containers,
104 dataenc,
105 directory, 103 directory,
106 filepath, 104 filepath,
107 network, 105 network,
@@ -120,7 +118,7 @@ library
120 118
121 if !flag(cryptonite) 119 if !flag(cryptonite)
122 Build-Depends: crypto-pubkey >=0.2.3, cryptohash -any, 120 Build-Depends: crypto-pubkey >=0.2.3, cryptohash -any,
123 crypto-pubkey-types -any 121 crypto-pubkey-types -any, dataenc
124 if flag(hourglass) 122 if flag(hourglass)
125 Build-Depends: hourglass -any, x509 >=1.5 && <1.6 123 Build-Depends: hourglass -any, x509 >=1.5 && <1.6
126 else 124 else
diff --git a/kiki.hs b/kiki.hs
index 3eb1d2a..a0eff1a 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -34,7 +34,12 @@ import System.Directory
34import System.Environment 34import System.Environment
35import System.Exit 35import System.Exit
36import System.IO (hPutStrLn,stderr) 36import System.IO (hPutStrLn,stderr)
37#if defined(VERSION_memory)
38import qualified Data.ByteString.Char8 as S8
39import Data.ByteArray.Encoding
40#elif defined(VERSION_dataenc)
37import qualified Codec.Binary.Base64 as Base64 41import qualified Codec.Binary.Base64 as Base64
42#endif
38import qualified Codec.Archive.Tar as Tar 43import qualified Codec.Archive.Tar as Tar
39import qualified Codec.Archive.Tar.Entry as Tar 44import qualified Codec.Archive.Tar.Entry as Tar
40#if !defined(VERSION_cryptonite) 45#if !defined(VERSION_cryptonite)
@@ -69,6 +74,7 @@ import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
69import Kiki 74import Kiki
70import Debug.Trace 75import Debug.Trace
71import Network.Socket (SockAddr) 76import Network.Socket (SockAddr)
77import FunctorToMaybe
72 78
73-- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} 79-- {-# ANN module ("HLint: ignore Eta reduce"::String) #-}
74-- {-# ANN module ("HLint: ignore Use camelCase"::String) #-} 80-- {-# ANN module ("HLint: ignore Use camelCase"::String) #-}
@@ -316,7 +322,11 @@ dnsPresentationFromPacket k = do
316 let RSAKey (MPI n) (MPI e) = fromJust $ rsaKeyFromPacket k 322 let RSAKey (MPI n) (MPI e) = fromJust $ rsaKeyFromPacket k
317 dnskey = DNS.RSA n e 323 dnskey = DNS.RSA n e
318 bin = runPut (DNS.putRSA dnskey) 324 bin = runPut (DNS.putRSA dnskey)
325#if defined(VERSION_memory)
326 qq = S8.unpack $ convertToBase Base64 (L.toStrict bin)
327#elif defined(VERSION_dataenc)
319 qq = Base64.encode (L.unpack bin) 328 qq = Base64.encode (L.unpack bin)
329#endif
320 ttl = 24*60*60 -- 24 hours in seconds 330 ttl = 24*60*60 -- 24 hours in seconds
321 flags = 256 -- (ZONE-key = bit7) TODO: is this a zone key or a key-signing key? 331 flags = 256 -- (ZONE-key = bit7) TODO: is this a zone key or a key-signing key?
322 algo = 8 -- RSASHA256 -- TODO: support other algorithm 332 algo = 8 -- RSASHA256 -- TODO: support other algorithm
@@ -351,7 +361,11 @@ show_wip keyspec wkgrip db = do
351show_torhash pubkey _ = do 361show_torhash pubkey _ = do
352 bs <- Char8.readFile pubkey 362 bs <- Char8.readFile pubkey
353 let parsekey f dta = do 363 let parsekey f dta = do
364#if defined(VERSION_memory)
365 let mdta = fmap L.fromStrict $ functorToMaybe $ convertFromBase Base64 (Char8.toStrict dta)
366#elif defined(VERSION_dataenc)
354 let mdta = L.pack <$> Base64.decode (Char8.unpack dta) 367 let mdta = L.pack <$> Base64.decode (Char8.unpack dta)
368#endif
355 e <- decodeASN1 DER <$> mdta 369 e <- decodeASN1 DER <$> mdta
356 asn1 <- either (const Nothing) (Just) e 370 asn1 <- either (const Nothing) (Just) e
357 k <- either (const Nothing) (Just . fst) (fromASN1 asn1) 371 k <- either (const Nothing) (Just . fst) (fromASN1 asn1)
@@ -381,7 +395,11 @@ show_cert keyspec wkgrip db = do
381 -} 395 -}
382 let cs = mapMaybe x509cert $ (sigs >>= hashed_subpackets) 396 let cs = mapMaybe x509cert $ (sigs >>= hashed_subpackets)
383 ds = map decodeBlob $ map (ParsedCert k (posixSecondsToUTCTime $ fromIntegral $ timestamp k)) cs 397 ds = map decodeBlob $ map (ParsedCert k (posixSecondsToUTCTime $ fromIntegral $ timestamp k)) cs
398#if defined(VERSION_memory)
399 qqs = map (S8.unpack . convertToBase Base64 . L.toStrict) ds
400#elif defined(VERSION_dataenc)
384 qqs = map (Base64.encode . L.unpack) ds 401 qqs = map (Base64.encode . L.unpack) ds
402#endif
385 pems = map (writePEM "CERTIFICATE") qqs 403 pems = map (writePEM "CERTIFICATE") qqs
386 forM_ pems putStrLn 404 forM_ pems putStrLn
387 _ -> void $ warn (keyspec ++ ": ambiguous") 405 _ -> void $ warn (keyspec ++ ": ambiguous")
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