summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs12
1 files changed, 11 insertions, 1 deletions
diff --git a/kiki.hs b/kiki.hs
index 8ca6e5d..2a4dde2 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -68,6 +68,7 @@ import qualified DNSKey as DNS
68import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) 68import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
69import Kiki 69import Kiki
70import Debug.Trace 70import Debug.Trace
71import 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
1508tarContent :: KeyRingRuntime
1509 -> Maybe String
1510 -> ([Char8.ByteString] -> SockAddr -> Packet -> [Packet] -> t )
1511 -> ([(KeyRing.KeyKey, Packet, [Packet])] -> t)
1512 -> (Packet -> t)
1513 -> [(String, t)]
1506tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" 1514tarContent 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).