From 334525e552b1da967c9f5b0576473c13bd2fd896 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Mon, 25 Apr 2016 21:02:28 -0400
Subject: cokiki replace ssh-server key.

---
 lib/KeyRing.hs | 12 +++++++++++-
 lib/Kiki.hs    | 26 ++++++++++++++++++++++++++
 2 files changed, 37 insertions(+), 1 deletion(-)

(limited to 'lib')

diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index 74b883f..8a4d870 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -329,7 +329,7 @@ data StreamInfo = StreamInfo
     -- ^ If 'typ' is 'PEMFile' and an 'External' 'initializer' string is set,
     -- then it is interpretted as a shell command that may be used to create
     -- the key if it does not exist.
-    , transforms :: [Transform] 
+    , transforms :: [Transform]
     -- ^ Per-file transformations that occur before the contents of a file are
     -- spilled into the common pool.
     }
@@ -431,6 +431,9 @@ data Transform =
         | DeleteSubkeyByFingerprint String
         -- ^ Delete the subkey specified by the given fingerprint and any
         -- associated signatures on that key.
+        | DeleteSubkeyByUsage String
+        -- ^ Delete the subkey specified by the given fingerprint and any
+        -- associated signatures on that key.
  deriving (Eq,Ord,Show)
 
 -- | This type describes an idempotent transformation (merge or import) on a
@@ -2695,6 +2698,13 @@ resolveTransform (DeleteSubkeyByFingerprint fp) rt kd@(KeyData k ksigs umap subm
         guard (map toUpper fp == fingerprint (packet (subkeyMappedPacket sub)))
         return k
 
+resolveTransform (DeleteSubkeyByUsage tag) rt kd@(KeyData k ksigs umap submap) = fmap (SubKeyDeletion topk) subk
+ where
+    topk = keykey $ packet k -- key to master of key to be deleted
+    subk = do
+        (k,SubKey p sigs) <- Map.toList submap
+        take 1 $ filter (has_tag tag) $ map (packet . fst) sigs
+        return k
 
 -- | Load and update key files according to the specified 'KeyRingOperation'.
 runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime)
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 575cf26..be99ed8 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -39,6 +39,15 @@ refresh root homepass = do
 
 data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile }
 
+streaminfo :: StreamInfo
+streaminfo = StreamInfo
+    { fill = KF_None
+    , spill = KF_None
+    , typ = KeyRingFile
+    , initializer = NoCreate
+    , access = AutoAccess
+    , transforms = []
+    }
 
 minimalOp :: CommonArgsParsed -> KeyRingOperation
 minimalOp cap = op
@@ -167,3 +176,20 @@ sshblobFromPacket k = blob
                 <$> optional (arg "--homedir")
                 <*> optional (FileDesc <$> read <$> arg "--passphrase-fd")
 
+replaceSshServerKeys root cmn = do
+    let homepass' = cmn { cap_homespec = fmap root (cap_homespec cmn) }
+        replaceSSH op = op { opFiles = files }
+            where
+                files = Map.adjust delssh HomeSec
+                        $ Map.adjust delssh HomePub
+                        $ Map.insert (ArgFile $ root "/etc/ssh/ssh_host_rsa_key") strm $ opFiles op
+                strm = streaminfo { typ = PEMFile, spill = KF_Match "ssh-server", access = Sec }
+                delssh strm = strm { transforms = DeleteSubkeyByUsage "ssh-server" : transforms strm
+                                   , fill = KF_All }
+    KikiResult r report <- runKeyRing $ minimalOp homepass'
+    case r of
+        KikiSuccess rt -> Kiki.refreshCache rt $ case root "" of
+                                                    "/" -> Nothing
+                                                    ""  -> Nothing
+                                                    pth -> Just pth
+        err            -> hPutStrLn stderr $ errorString err
-- 
cgit v1.2.3