diff options
-rw-r--r-- | kiki.cabal | 1 | ||||
-rw-r--r-- | kiki.hs | 12 | ||||
-rw-r--r-- | lib/KeyRing.hs | 1 |
3 files changed, 13 insertions, 1 deletions
@@ -43,6 +43,7 @@ Executable kiki | |||
43 | time, | 43 | time, |
44 | unix, | 44 | unix, |
45 | openpgp-util, | 45 | openpgp-util, |
46 | network, | ||
46 | kiki | 47 | kiki |
47 | other-modules: DNSKey | 48 | other-modules: DNSKey |
48 | if !flag(cryptonite) | 49 | if !flag(cryptonite) |
@@ -68,6 +68,7 @@ import qualified DNSKey as DNS | |||
68 | import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) | 68 | import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) |
69 | import Kiki | 69 | import Kiki |
70 | import Debug.Trace | 70 | import Debug.Trace |
71 | import Network.Socket (SockAddr) | ||
71 | 72 | ||
72 | -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} | 73 | -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} |
73 | -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-} | 74 | -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-} |
@@ -1503,6 +1504,13 @@ kiki "tar" args = do | |||
1503 | ["-A":_] -> putStrLn "unimplemented." -- import tar file? | 1504 | ["-A":_] -> putStrLn "unimplemented." -- import tar file? |
1504 | _ -> kiki "tar" ["--help"] | 1505 | _ -> kiki "tar" ["--help"] |
1505 | 1506 | ||
1507 | |||
1508 | tarContent :: KeyRingRuntime | ||
1509 | -> Maybe String | ||
1510 | -> ([Char8.ByteString] -> SockAddr -> Packet -> [Packet] -> t ) | ||
1511 | -> ([(KeyRing.KeyKey, Packet, [Packet])] -> t) | ||
1512 | -> (Packet -> t) | ||
1513 | -> [(String, t)] | ||
1506 | tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" | 1514 | tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" |
1507 | where | 1515 | where |
1508 | ipsecs = do | 1516 | ipsecs = do |
@@ -1580,6 +1588,7 @@ tarC (sargs,margs) = do | |||
1580 | L.putStr tarbs | 1588 | L.putStr tarbs |
1581 | err -> putStrLn $ errorString err | 1589 | err -> putStrLn $ errorString err |
1582 | where | 1590 | where |
1591 | build_ipsec :: Num n => b -> c -> Packet -> d -> (n, Either a Char8.ByteString) | ||
1583 | build_ipsec ns addr ipsec sigs | 1592 | build_ipsec ns addr ipsec sigs |
1584 | = ( fromIntegral $ timestamp ipsec | 1593 | = ( fromIntegral $ timestamp ipsec |
1585 | , Right $ Char8.pack $ fromJust $ pemFromPacket ipsec) | 1594 | , Right $ Char8.pack $ fromJust $ pemFromPacket ipsec) |
@@ -1590,9 +1599,11 @@ tarC (sargs,margs) = do | |||
1590 | ns = onames ++ others | 1599 | ns = onames ++ others |
1591 | (_,(onames,others)) = getHostnames $ rtKeyDB rt Map.! kk | 1600 | (_,(onames,others)) = getHostnames $ rtKeyDB rt Map.! kk |
1592 | 1601 | ||
1602 | build_secret :: Num t => KeyRingRuntime -> Packet -> (t, Either (IO (Maybe Char8.ByteString)) b) | ||
1593 | build_secret rt k = ( fromIntegral $ timestamp k | 1603 | build_secret rt k = ( fromIntegral $ timestamp k |
1594 | , Left $ fmap Char8.pack . (>>= secretPemFromPacket) <$> decrypt rt k ) | 1604 | , Left $ fmap Char8.pack . (>>= secretPemFromPacket) <$> decrypt rt k ) |
1595 | 1605 | ||
1606 | mktar :: FilePath -> Tar.EpochTime -> L.ByteString -> Either String Tar.Entry | ||
1596 | mktar n epoch_time_int64 bs = do | 1607 | mktar n epoch_time_int64 bs = do |
1597 | torpath <- Tar.toTarPath False n | 1608 | torpath <- Tar.toTarPath False n |
1598 | Right $ (Tar.fileEntry torpath bs) { Tar.entryTime = epoch_time_int64 } | 1609 | Right $ (Tar.fileEntry torpath bs) { Tar.entryTime = epoch_time_int64 } |
@@ -1606,7 +1617,6 @@ tarC (sargs,margs) = do | |||
1606 | _ -> do | 1617 | _ -> do |
1607 | hPutStrLn stderr $ "Failed to decrypt "++fingerprint k++"." | 1618 | hPutStrLn stderr $ "Failed to decrypt "++fingerprint k++"." |
1608 | return Nothing | 1619 | return Nothing |
1609 | |||
1610 | -- | | 1620 | -- | |
1611 | -- | 1621 | -- |
1612 | -- no leading hyphen, returns Right (input string). | 1622 | -- no leading hyphen, returns Right (input string). |
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index 21d7c3e..fbd23fe 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs | |||
@@ -102,6 +102,7 @@ module KeyRing | |||
102 | , getSubkeys | 102 | , getSubkeys |
103 | , writeKeyToFile | 103 | , writeKeyToFile |
104 | , resolveForReport | 104 | , resolveForReport |
105 | , KeyKey -- needed for Type sigs | ||
105 | ) where | 106 | ) where |
106 | 107 | ||
107 | import System.Environment | 108 | import System.Environment |