diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 41 |
1 files changed, 34 insertions, 7 deletions
@@ -10,6 +10,7 @@ module Main ( main ) where | |||
10 | 10 | ||
11 | import Control.Applicative | 11 | import Control.Applicative |
12 | import Control.Monad | 12 | import Control.Monad |
13 | import Control.Monad.Fix | ||
13 | import Data.ASN1.BinaryEncoding | 14 | import Data.ASN1.BinaryEncoding |
14 | import Data.ASN1.Encoding | 15 | import Data.ASN1.Encoding |
15 | import Data.ASN1.Types | 16 | import 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 | |||
1751 | minimalOp :: CommonArgsParsed -> KeyRingOperation | 1778 | minimalOp :: CommonArgsParsed -> KeyRingOperation |
1752 | minimalOp cap = op | 1779 | minimalOp cap = op |
1753 | where | 1780 | where |