diff options
author | Andrew Cady <d@jerkface.net> | 2019-07-16 16:27:43 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2019-07-16 17:52:10 -0400 |
commit | 0110bd961c87e1ca47e649519933b490ec38fd2d (patch) | |
tree | b347565a4a9a7e16d565ccfe4c0ee71f09611bb5 | |
parent | 27f408f64ce250938f236bc624fb4d4624fc1c62 (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.hs | 132 |
1 files changed, 0 insertions, 132 deletions
@@ -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 | ||
1615 | kiki "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 | |||
1627 | kiki "verify" args | "--help" `elem` args = do | 1615 | kiki "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] | |||
1644 | sshkeyname SecretKeyPacket { key_algorithm = RSA } = ["id_rsa"] | 1632 | sshkeyname SecretKeyPacket { key_algorithm = RSA } = ["id_rsa"] |
1645 | sshkeyname _ = [] | 1633 | sshkeyname _ = [] |
1646 | 1634 | ||
1647 | |||
1648 | tarContent :: KeyRingRuntime | ||
1649 | -> Maybe String | ||
1650 | -> ([Char8.ByteString] -> SockAddr -> Packet -> [Packet] -> t ) | ||
1651 | -> ([(KeyRing.KeyKey, Packet, [Packet])] -> t) | ||
1652 | -> (Packet -> t) | ||
1653 | -> [(String, t)] | ||
1654 | tarContent 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 | |||
1697 | ipsecKeyNames :: Hostnames -> [String] | ||
1698 | ipsecKeyNames (Hostnames _ onames _ _) = do | ||
1699 | oname <- Char8.unpack <$> onames | ||
1700 | return $ "etc/ipsec.d/private/"++oname++".pem" | ||
1701 | |||
1702 | tarT :: ([[String]],Map.Map String [String]) -> IO () | ||
1703 | tarT (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 | |||
1713 | tarC :: ([[String]],Map.Map String [String]) -> IO () | ||
1714 | tarC (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). |