summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs41
1 files changed, 34 insertions, 7 deletions
diff --git a/kiki.hs b/kiki.hs
index d58ef2a..087e24f 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -10,6 +10,7 @@ module Main ( main ) where
10 10
11import Control.Applicative 11import Control.Applicative
12import Control.Monad 12import Control.Monad
13import Control.Monad.Fix
13import Data.ASN1.BinaryEncoding 14import Data.ASN1.BinaryEncoding
14import Data.ASN1.Encoding 15import Data.ASN1.Encoding
15import Data.ASN1.Types 16import Data.ASN1.Types
@@ -268,6 +269,9 @@ partitionStaticArguments specs args = psa args
268 psa [] = ([],[]) 269 psa [] = ([],[])
269 psa (a:as) = 270 psa (a:as) =
270 case Map.lookup a smap of 271 case Map.lookup a smap of
272 Nothing | (k,'=':v) <- break (=='=') a
273 , Just 1 <- Map.lookup k smap
274 -> first ([k,v]:) $ psa as
271 Nothing -> second (a:) $ psa as 275 Nothing -> second (a:) $ psa as
272 Just n -> first ((a:take n as):) $ psa (drop n as) 276 Just n -> first ((a:take n as):) $ psa (drop n as)
273 277
@@ -1729,25 +1733,48 @@ tarC (sargs,margs) = do
1729 KikiSuccess rt -> do 1733 KikiSuccess rt -> do
1730 CTime pubtime <- modificationTime <$> getFileStatus (rtPubring rt) 1734 CTime pubtime <- modificationTime <$> getFileStatus (rtPubring rt)
1731 let keyspec = concat . take 1 <$> Map.lookup "--secrets" margs 1735 let keyspec = concat . take 1 <$> Map.lookup "--secrets" margs
1732 fs = tarContent rt keyspec build_ipsec (build_ssh rt pubtime) (error "todo") 1736 fs = tarContent rt keyspec build_ipsec (build_ssh rt pubtime) (build_secret rt)
1733 es = do 1737 es = do
1734 (n,(epoch_time_int64,bs)) <- fs 1738 (n,(epoch_time_int64,ebs)) <- fs
1735 entry <- either (const []) (return . flip Tar.fileEntry bs) $ Tar.toTarPath False n 1739 let mktar' = mktar n epoch_time_int64
1736 return $ entry { Tar.entryTime = epoch_time_int64 } 1740 return $ case ebs of
1737 tarbs = Tar.write es 1741 Right bs -> return $ either (const Nothing) Just $ mktar' bs
1742 Left iombs -> do
1743 mbs <- iombs
1744 case mbs of
1745 Nothing -> return Nothing
1746 Just bs -> return $ either (const Nothing) Just $ mktar' bs
1747 tarbs <- Tar.write . mapMaybe id <$> sequence es
1738 L.putStr tarbs 1748 L.putStr tarbs
1739 err -> putStrLn $ errorString err 1749 err -> putStrLn $ errorString err
1740 where 1750 where
1741 build_ipsec ns addr ipsec sigs 1751 build_ipsec ns addr ipsec sigs
1742 = ( fromIntegral $ timestamp ipsec 1752 = ( fromIntegral $ timestamp ipsec
1743 , Char8.pack $ fromJust $ pemFromPacket ipsec) 1753 , Right $ Char8.pack $ fromJust $ pemFromPacket ipsec)
1744 build_ssh rt timestamp sshs = (timestamp, Char8.unlines $ map knownhost sshs) 1754 build_ssh rt timestamp sshs = (timestamp, Right $ Char8.unlines $ map knownhost sshs)
1745 where 1755 where
1746 knownhost (kk,hostkey,sigs) = Char8.intercalate "," ns <> " " <> Char8.pack (sshblobFromPacket hostkey) 1756 knownhost (kk,hostkey,sigs) = Char8.intercalate "," ns <> " " <> Char8.pack (sshblobFromPacket hostkey)
1747 where 1757 where
1748 ns = onames ++ others 1758 ns = onames ++ others
1749 (_,(onames,others)) = getHostnames $ rtKeyDB rt Map.! kk 1759 (_,(onames,others)) = getHostnames $ rtKeyDB rt Map.! kk
1750 1760
1761 build_secret rt k = ( fromIntegral $ timestamp k
1762 , Left $ fmap Char8.pack . (>>= secretPemFromPacket) <$> decrypt rt k )
1763
1764 mktar n epoch_time_int64 bs = do
1765 torpath <- Tar.toTarPath False n
1766 Right $ (Tar.fileEntry torpath bs) { Tar.entryTime = epoch_time_int64 }
1767
1768 decrypt :: KeyRingRuntime -> Packet -> IO (Maybe Packet)
1769 decrypt rt k@SecretKeyPacket { symmetric_algorithm = Unencrypted } = return $ Just k
1770 decrypt rt k = do
1771 r <- rtPassphrases rt (MappedPacket k Map.empty)
1772 case r of
1773 KikiSuccess p -> return $ Just p
1774 _ -> do
1775 hPutStrLn stderr $ "Failed to decrypt "++fingerprint k++"."
1776 return Nothing
1777
1751minimalOp :: CommonArgsParsed -> KeyRingOperation 1778minimalOp :: CommonArgsParsed -> KeyRingOperation
1752minimalOp cap = op 1779minimalOp cap = op
1753 where 1780 where