summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2019-07-16 16:27:43 -0400
committerAndrew Cady <d@jerkface.net>2019-07-16 17:52:10 -0400
commit0110bd961c87e1ca47e649519933b490ec38fd2d (patch)
treeb347565a4a9a7e16d565ccfe4c0ee71f09611bb5
parent27f408f64ce250938f236bc624fb4d4624fc1c62 (diff)
Remove unused "tar" command
This code duplicated the same functionality as when writing /var/cache/kiki, and the "tar" functionality was only there to serve that same purpose anyway. If it were to be readded, duplication could be avoided by implementing a FileWriter that creates a tar file instead of writing to disk.
-rw-r--r--kiki.hs132
1 files changed, 0 insertions, 132 deletions
diff --git a/kiki.hs b/kiki.hs
index 0b884ae..6b3d36e 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1612,18 +1612,6 @@ kiki "tar" args | "--help" `elem` args = do
1612 ," (sub-string of a user id without 'u:' prefix)" 1612 ," (sub-string of a user id without 'u:' prefix)"
1613 ] 1613 ]
1614 1614
1615kiki "tar" args = do
1616 let parsed_args = processArgs sargspec [] "" args
1617 sargspec = [("-t",0),("-c",0),("--secrets",1)]
1618 ismode ("-t":_) = True
1619 ismode ("-c":_) = True
1620 ismode _ = False
1621 case filter ismode (fst parsed_args) of
1622 ["-t":_] -> tarT parsed_args
1623 ["-c":_] -> tarC parsed_args
1624 ["-A":_] -> putStrLn "unimplemented." -- import tar file?
1625 _ -> kiki "tar" ["--help"]
1626
1627kiki "verify" args | "--help" `elem` args = do 1615kiki "verify" args | "--help" `elem` args = do
1628 putStr . unlines $ 1616 putStr . unlines $
1629 [ "kiki verify [--homedir HOMEDIR | --homeless] [[--keyring FILE] ...] FILE" 1617 [ "kiki verify [--homedir HOMEDIR | --homeless] [[--keyring FILE] ...] FILE"
@@ -1644,126 +1632,6 @@ sshkeyname :: Packet -> [FilePath]
1644sshkeyname SecretKeyPacket { key_algorithm = RSA } = ["id_rsa"] 1632sshkeyname SecretKeyPacket { key_algorithm = RSA } = ["id_rsa"]
1645sshkeyname _ = [] 1633sshkeyname _ = []
1646 1634
1647
1648tarContent :: KeyRingRuntime
1649 -> Maybe String
1650 -> ([Char8.ByteString] -> SockAddr -> Packet -> [Packet] -> t )
1651 -> ([(KeyRing.KeyKey, Packet, [Packet])] -> t)
1652 -> (Packet -> t)
1653 -> [(String, t)]
1654tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root"
1655 where
1656 ipsecs = do
1657 (kk,ipsec,sigs) <- selectPublicKeyAndSigs (KeyUidMatch "",Just "ipsec") (rtKeyDB rt)
1658 let kd = fromJust $ lookupKeyData kk (rtKeyDB rt)
1659 Hostnames addr onames ns _ = getHostnames kd
1660 oname <- onames
1661 return ("etc/ipsec.d/certs/" ++ Char8.unpack oname ++ ".pem", pubpem ns addr ipsec sigs)
1662
1663 sshs = case selectPublicKeyAndSigs (KeyUidMatch "",Just "ssh-host") (rtKeyDB rt) of
1664 [] -> []
1665 ssh_sel -> [("etc/ssh/ssh_known_hosts", knownhosts ssh_sel)]
1666
1667 secrets_kd = case fst . parseSpec "" <$> (++"/") <$> spec of
1668 _ | spec == Just "-" || spec == Just ""
1669 -> maybeToList (rtWorkingKey rt)
1670 >>= return . fromJust . (`lookupKeyData` rtKeyDB rt) . keykey
1671 Just topspec
1672 -> map snd $ filterMatches topspec $ kkData $ rtKeyDB rt
1673 w -> []
1674
1675 lookupSecret tag kd = take 1 $ snd $ (\(y:ys) -> seek_key (KeyTag y tag) ys)
1676 $ snd $ seek_key (KeyGrip "")
1677 $ map packet $ flattenTop "" False kd
1678
1679 dir :: FilePath -> FilePath
1680 dir d = d -- TODO: prepend prefix path?
1681
1682 spem d k = (d, secpem k)
1683
1684 secrets homedir = do
1685 kd <- secrets_kd
1686 let torkey = spem (dir "var/lib/tor/samizdat/private_key") <$> lookupSecret "tor" kd
1687 sshcli = do k <- lookupSecret "ssh-client" kd
1688 keyname <- sshkeyname k
1689 return $ spem (dir $ homedir ++ "/.ssh/" ++ keyname) k
1690 sshsvr = spem (dir "etc/ssh/ssh_host_rsa_key") <$> lookupSecret "ssh-host" kd
1691 ipseckey = do
1692 k <- lookupSecret "ipsec" kd
1693 keyName <- ipsecKeyNames (getHostnames kd)
1694 return $ spem (dir $ keyName) k
1695 torkey ++ sshcli ++ sshsvr ++ ipseckey
1696
1697ipsecKeyNames :: Hostnames -> [String]
1698ipsecKeyNames (Hostnames _ onames _ _) = do
1699 oname <- Char8.unpack <$> onames
1700 return $ "etc/ipsec.d/private/"++oname++".pem"
1701
1702tarT :: ([[String]],Map.Map String [String]) -> IO ()
1703tarT (sargs,margs) = do
1704 KikiResult rt report <- runKeyRing $ minimalOp False $ parseCommonArgs margs
1705 case rt of
1706 KikiSuccess rt -> do
1707 let keyspec = concat . take 1 <$> Map.lookup "--secrets" margs
1708 nil = error "internal error!"
1709 fs = map fst $ tarContent rt keyspec nil nil nil
1710 mapM_ putStrLn fs
1711 err -> putStrLn $ errorString err
1712
1713tarC :: ([[String]],Map.Map String [String]) -> IO ()
1714tarC (sargs,margs) = do
1715 KikiResult rt report <- runKeyRing $ minimalOp False $ parseCommonArgs margs
1716 case rt of
1717 KikiSuccess rt -> do
1718 CTime pubtime <- modificationTime <$> getFileStatus (rtPubring rt)
1719 let keyspec = concat . take 1 <$> Map.lookup "--secrets" margs
1720 pubtime64 :: Int64
1721 pubtime64 = fromIntegral pubtime -- EpochTime=CTime is Int32 on some platforms
1722 fs :: [(String, (Int64,Either (IO (Maybe Char8.ByteString)) Char8.ByteString))]
1723 fs = tarContent rt keyspec build_ipsec (build_ssh rt pubtime64) (build_secret rt)
1724 es = do
1725 (n,(epoch_time_int64,ebs)) <- fs
1726 let mktar' = mktar n epoch_time_int64
1727 return $ case ebs of
1728 Right bs -> return $ either (const Nothing) Just $ mktar' bs
1729 Left iombs -> do
1730 mbs <- iombs
1731 case mbs of
1732 Nothing -> return Nothing
1733 Just bs -> return $ either (const Nothing) Just $ mktar' bs
1734 tarbs <- Tar.write . mapMaybe id <$> sequence es
1735 L.putStr tarbs
1736 err -> putStrLn $ errorString err
1737 where
1738 build_ipsec :: Num n => b -> c -> Packet -> d -> (n, Either a Char8.ByteString)
1739 build_ipsec ns addr ipsec sigs
1740 = ( fromIntegral $ timestamp ipsec
1741 , Right $ Char8.pack $ fromJust $ pemFromPacket ipsec)
1742 build_ssh rt timestamp sshs = (timestamp, Right $ Char8.unlines $ map knownhost sshs)
1743 where
1744 knownhost (kk,hostkey,sigs) = Char8.intercalate "," ns <> " " <> Char8.pack (sshblobFromPacket hostkey)
1745 where
1746 ns = onames ++ others
1747 Hostnames _ onames others _ = getHostnames $ fromJust $ lookupKeyData kk (rtKeyDB rt)
1748
1749 build_secret :: Num t => KeyRingRuntime -> Packet -> (t, Either (IO (Maybe Char8.ByteString)) b)
1750 build_secret rt k = ( fromIntegral $ timestamp k
1751 , Left $ fmap Char8.pack . (>>= secretPemFromPacket) <$> decrypt rt k )
1752
1753 mktar :: FilePath -> Tar.EpochTime -> L.ByteString -> Either String Tar.Entry
1754 mktar n epoch_time_int64 bs = do
1755 torpath <- Tar.toTarPath False n
1756 Right $ (Tar.fileEntry torpath bs) { Tar.entryTime = epoch_time_int64 }
1757
1758 decrypt :: KeyRingRuntime -> Packet -> IO (Maybe Packet)
1759 decrypt rt k@SecretKeyPacket { symmetric_algorithm = Unencrypted } = return $ Just k
1760 decrypt rt k = do
1761 r <- rtPassphrases rt (Unencrypted,S2K 100 "") (MappedPacket k Map.empty)
1762 case r of
1763 KikiSuccess p -> return $ Just p
1764 _ -> do
1765 hPutStrLn stderr $ "Failed to decrypt "++show (fingerprint k) ++ "."
1766 return Nothing
1767-- | 1635-- |
1768-- 1636--
1769-- no leading hyphen, returns Right (input string). 1637-- no leading hyphen, returns Right (input string).