summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs18
1 files changed, 18 insertions, 0 deletions
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")