1 files changed, 1 insertions, 145 deletions

diff --git a/kiki.hs b/kiki.hs
index 0b884ae..5bd6951 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -43,7 +43,6 @@ import qualified Data.Map as Map
 import Control.Arrow   (first,second)
 import Data.Monoid ( (<>) )
 import Data.Binary.Put
-import System.Posix.User
 
 import CommandLine
 import Data.OpenPGP.Util (verify, fingerprint, GenerateKeyParams(..))
@@ -1312,8 +1311,6 @@ kiki "merge" [] = do
         , "                   don't write)."
         , ""
         , "  --create=(rsa:SIZE|cmd:CMD)"
-        , "                   Note: With --flow=spill, a dummy file name must still be"
-        , "                   provided so that the command line can be parsed."
         , ""
         , "  --autosign[=no]"
         , ""
@@ -1536,16 +1533,7 @@ kiki "init" args | "--help" `elem` args = do
         , ""
         ] ++ documentHomeDir ++ [""] ++ documentPassphraseFDFlag True True True
 
-kiki "init" args = do
-    rootOK <- case runArgs ([],args) dashdashChroot of
-        Left e     -> hPutStrLn stderr (usageErrorMessage e) >> return False
-        Right root -> if root "x" /= root "x"
-                        then return True
-                        else fmap (==0) $ getEffectiveUserID
-    if rootOK
-        then run args $ importAndRefresh <$> dashdashChroot <*> dashdashHomedir <*> dashdashCipher
-        else do hPutStrLn stderr "Missing --chroot option.  Permision denied."
-                exitFailure
+kiki "init" args = run args $ importAndRefresh <$> dashdashChroot <*> dashdashHomedir <*> dashdashCipher
 kiki "spawn" args | "--help" `elem` args =
     putStr . unlines $
         [ "kiki spawn [ --passphrase-fd=FD"
@@ -1612,18 +1600,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 +1620,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).