From 0110bd961c87e1ca47e649519933b490ec38fd2d Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Tue, 16 Jul 2019 16:27:43 -0400 Subject: 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. --- kiki.hs | 132 ---------------------------------------------------------------- 1 file changed, 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 ," (sub-string of a user id without 'u:' prefix)" ] -kiki "tar" args = do - let parsed_args = processArgs sargspec [] "" args - sargspec = [("-t",0),("-c",0),("--secrets",1)] - ismode ("-t":_) = True - ismode ("-c":_) = True - ismode _ = False - case filter ismode (fst parsed_args) of - ["-t":_] -> tarT parsed_args - ["-c":_] -> tarC parsed_args - ["-A":_] -> putStrLn "unimplemented." -- import tar file? - _ -> kiki "tar" ["--help"] - kiki "verify" args | "--help" `elem` args = do putStr . unlines $ [ "kiki verify [--homedir HOMEDIR | --homeless] [[--keyring FILE] ...] FILE" @@ -1644,126 +1632,6 @@ sshkeyname :: Packet -> [FilePath] sshkeyname SecretKeyPacket { key_algorithm = RSA } = ["id_rsa"] sshkeyname _ = [] - -tarContent :: KeyRingRuntime - -> Maybe String - -> ([Char8.ByteString] -> SockAddr -> Packet -> [Packet] -> t ) - -> ([(KeyRing.KeyKey, Packet, [Packet])] -> t) - -> (Packet -> t) - -> [(String, t)] -tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" - where - ipsecs = do - (kk,ipsec,sigs) <- selectPublicKeyAndSigs (KeyUidMatch "",Just "ipsec") (rtKeyDB rt) - let kd = fromJust $ lookupKeyData kk (rtKeyDB rt) - Hostnames addr onames ns _ = getHostnames kd - oname <- onames - return ("etc/ipsec.d/certs/" ++ Char8.unpack oname ++ ".pem", pubpem ns addr ipsec sigs) - - sshs = case selectPublicKeyAndSigs (KeyUidMatch "",Just "ssh-host") (rtKeyDB rt) of - [] -> [] - ssh_sel -> [("etc/ssh/ssh_known_hosts", knownhosts ssh_sel)] - - secrets_kd = case fst . parseSpec "" <$> (++"/") <$> spec of - _ | spec == Just "-" || spec == Just "" - -> maybeToList (rtWorkingKey rt) - >>= return . fromJust . (`lookupKeyData` rtKeyDB rt) . keykey - Just topspec - -> map snd $ filterMatches topspec $ kkData $ rtKeyDB rt - w -> [] - - lookupSecret tag kd = take 1 $ snd $ (\(y:ys) -> seek_key (KeyTag y tag) ys) - $ snd $ seek_key (KeyGrip "") - $ map packet $ flattenTop "" False kd - - dir :: FilePath -> FilePath - dir d = d -- TODO: prepend prefix path? - - spem d k = (d, secpem k) - - secrets homedir = do - kd <- secrets_kd - let torkey = spem (dir "var/lib/tor/samizdat/private_key") <$> lookupSecret "tor" kd - sshcli = do k <- lookupSecret "ssh-client" kd - keyname <- sshkeyname k - return $ spem (dir $ homedir ++ "/.ssh/" ++ keyname) k - sshsvr = spem (dir "etc/ssh/ssh_host_rsa_key") <$> lookupSecret "ssh-host" kd - ipseckey = do - k <- lookupSecret "ipsec" kd - keyName <- ipsecKeyNames (getHostnames kd) - return $ spem (dir $ keyName) k - torkey ++ sshcli ++ sshsvr ++ ipseckey - -ipsecKeyNames :: Hostnames -> [String] -ipsecKeyNames (Hostnames _ onames _ _) = do - oname <- Char8.unpack <$> onames - return $ "etc/ipsec.d/private/"++oname++".pem" - -tarT :: ([[String]],Map.Map String [String]) -> IO () -tarT (sargs,margs) = do - KikiResult rt report <- runKeyRing $ minimalOp False $ parseCommonArgs margs - case rt of - KikiSuccess rt -> do - let keyspec = concat . take 1 <$> Map.lookup "--secrets" margs - nil = error "internal error!" - fs = map fst $ tarContent rt keyspec nil nil nil - mapM_ putStrLn fs - err -> putStrLn $ errorString err - -tarC :: ([[String]],Map.Map String [String]) -> IO () -tarC (sargs,margs) = do - KikiResult rt report <- runKeyRing $ minimalOp False $ parseCommonArgs margs - case rt of - KikiSuccess rt -> do - CTime pubtime <- modificationTime <$> getFileStatus (rtPubring rt) - let keyspec = concat . take 1 <$> Map.lookup "--secrets" margs - pubtime64 :: Int64 - pubtime64 = fromIntegral pubtime -- EpochTime=CTime is Int32 on some platforms - fs :: [(String, (Int64,Either (IO (Maybe Char8.ByteString)) Char8.ByteString))] - fs = tarContent rt keyspec build_ipsec (build_ssh rt pubtime64) (build_secret rt) - es = do - (n,(epoch_time_int64,ebs)) <- fs - let mktar' = mktar n epoch_time_int64 - return $ case ebs of - Right bs -> return $ either (const Nothing) Just $ mktar' bs - Left iombs -> do - mbs <- iombs - case mbs of - Nothing -> return Nothing - Just bs -> return $ either (const Nothing) Just $ mktar' bs - tarbs <- Tar.write . mapMaybe id <$> sequence es - L.putStr tarbs - err -> putStrLn $ errorString err - where - build_ipsec :: Num n => b -> c -> Packet -> d -> (n, Either a Char8.ByteString) - build_ipsec ns addr ipsec sigs - = ( fromIntegral $ timestamp ipsec - , Right $ Char8.pack $ fromJust $ pemFromPacket ipsec) - build_ssh rt timestamp sshs = (timestamp, Right $ Char8.unlines $ map knownhost sshs) - where - knownhost (kk,hostkey,sigs) = Char8.intercalate "," ns <> " " <> Char8.pack (sshblobFromPacket hostkey) - where - ns = onames ++ others - Hostnames _ onames others _ = getHostnames $ fromJust $ lookupKeyData kk (rtKeyDB rt) - - build_secret :: Num t => KeyRingRuntime -> Packet -> (t, Either (IO (Maybe Char8.ByteString)) b) - build_secret rt k = ( fromIntegral $ timestamp k - , Left $ fmap Char8.pack . (>>= secretPemFromPacket) <$> decrypt rt k ) - - mktar :: FilePath -> Tar.EpochTime -> L.ByteString -> Either String Tar.Entry - mktar n epoch_time_int64 bs = do - torpath <- Tar.toTarPath False n - Right $ (Tar.fileEntry torpath bs) { Tar.entryTime = epoch_time_int64 } - - decrypt :: KeyRingRuntime -> Packet -> IO (Maybe Packet) - decrypt rt k@SecretKeyPacket { symmetric_algorithm = Unencrypted } = return $ Just k - decrypt rt k = do - r <- rtPassphrases rt (Unencrypted,S2K 100 "") (MappedPacket k Map.empty) - case r of - KikiSuccess p -> return $ Just p - _ -> do - hPutStrLn stderr $ "Failed to decrypt "++show (fingerprint k) ++ "." - return Nothing -- | -- -- no leading hyphen, returns Right (input string). -- cgit v1.2.3