summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/KeyRing.hs12
-rw-r--r--lib/Kiki.hs26
2 files changed, 37 insertions, 1 deletions
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
329 -- ^ If 'typ' is 'PEMFile' and an 'External' 'initializer' string is set, 329 -- ^ If 'typ' is 'PEMFile' and an 'External' 'initializer' string is set,
330 -- then it is interpretted as a shell command that may be used to create 330 -- then it is interpretted as a shell command that may be used to create
331 -- the key if it does not exist. 331 -- the key if it does not exist.
332 , transforms :: [Transform] 332 , transforms :: [Transform]
333 -- ^ Per-file transformations that occur before the contents of a file are 333 -- ^ Per-file transformations that occur before the contents of a file are
334 -- spilled into the common pool. 334 -- spilled into the common pool.
335 } 335 }
@@ -431,6 +431,9 @@ data Transform =
431 | DeleteSubkeyByFingerprint String 431 | DeleteSubkeyByFingerprint String
432 -- ^ Delete the subkey specified by the given fingerprint and any 432 -- ^ Delete the subkey specified by the given fingerprint and any
433 -- associated signatures on that key. 433 -- associated signatures on that key.
434 | DeleteSubkeyByUsage String
435 -- ^ Delete the subkey specified by the given fingerprint and any
436 -- associated signatures on that key.
434 deriving (Eq,Ord,Show) 437 deriving (Eq,Ord,Show)
435 438
436-- | This type describes an idempotent transformation (merge or import) on a 439-- | 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
2695 guard (map toUpper fp == fingerprint (packet (subkeyMappedPacket sub))) 2698 guard (map toUpper fp == fingerprint (packet (subkeyMappedPacket sub)))
2696 return k 2699 return k
2697 2700
2701resolveTransform (DeleteSubkeyByUsage tag) rt kd@(KeyData k ksigs umap submap) = fmap (SubKeyDeletion topk) subk
2702 where
2703 topk = keykey $ packet k -- key to master of key to be deleted
2704 subk = do
2705 (k,SubKey p sigs) <- Map.toList submap
2706 take 1 $ filter (has_tag tag) $ map (packet . fst) sigs
2707 return k
2698 2708
2699-- | Load and update key files according to the specified 'KeyRingOperation'. 2709-- | Load and update key files according to the specified 'KeyRingOperation'.
2700runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime) 2710runKeyRing :: 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
39 39
40data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile } 40data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile }
41 41
42streaminfo :: StreamInfo
43streaminfo = StreamInfo
44 { fill = KF_None
45 , spill = KF_None
46 , typ = KeyRingFile
47 , initializer = NoCreate
48 , access = AutoAccess
49 , transforms = []
50 }
42 51
43minimalOp :: CommonArgsParsed -> KeyRingOperation 52minimalOp :: CommonArgsParsed -> KeyRingOperation
44minimalOp cap = op 53minimalOp cap = op
@@ -167,3 +176,20 @@ sshblobFromPacket k = blob
167 <$> optional (arg "--homedir") 176 <$> optional (arg "--homedir")
168 <*> optional (FileDesc <$> read <$> arg "--passphrase-fd") 177 <*> optional (FileDesc <$> read <$> arg "--passphrase-fd")
169 178
179replaceSshServerKeys root cmn = do
180 let homepass' = cmn { cap_homespec = fmap root (cap_homespec cmn) }
181 replaceSSH op = op { opFiles = files }
182 where
183 files = Map.adjust delssh HomeSec
184 $ Map.adjust delssh HomePub
185 $ Map.insert (ArgFile $ root "/etc/ssh/ssh_host_rsa_key") strm $ opFiles op
186 strm = streaminfo { typ = PEMFile, spill = KF_Match "ssh-server", access = Sec }
187 delssh strm = strm { transforms = DeleteSubkeyByUsage "ssh-server" : transforms strm
188 , fill = KF_All }
189 KikiResult r report <- runKeyRing $ minimalOp homepass'
190 case r of
191 KikiSuccess rt -> Kiki.refreshCache rt $ case root "" of
192 "/" -> Nothing
193 "" -> Nothing
194 pth -> Just pth
195 err -> hPutStrLn stderr $ errorString err