diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 18 |
1 files changed, 18 insertions, 0 deletions
@@ -34,7 +34,12 @@ import System.Directory | |||
34 | import System.Environment | 34 | import System.Environment |
35 | import System.Exit | 35 | import System.Exit |
36 | import System.IO (hPutStrLn,stderr) | 36 | import System.IO (hPutStrLn,stderr) |
37 | #if defined(VERSION_memory) | ||
38 | import qualified Data.ByteString.Char8 as S8 | ||
39 | import Data.ByteArray.Encoding | ||
40 | #elif defined(VERSION_dataenc) | ||
37 | import qualified Codec.Binary.Base64 as Base64 | 41 | import qualified Codec.Binary.Base64 as Base64 |
42 | #endif | ||
38 | import qualified Codec.Archive.Tar as Tar | 43 | import qualified Codec.Archive.Tar as Tar |
39 | import qualified Codec.Archive.Tar.Entry as Tar | 44 | import 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 ) | |||
69 | import Kiki | 74 | import Kiki |
70 | import Debug.Trace | 75 | import Debug.Trace |
71 | import Network.Socket (SockAddr) | 76 | import Network.Socket (SockAddr) |
77 | import 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 | |||
351 | show_torhash pubkey _ = do | 361 | show_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") |