diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/KeyRing.hs | 12 | ||||
-rw-r--r-- | lib/Kiki.hs | 26 |
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 | ||
2701 | resolveTransform (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'. |
2700 | runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime) | 2710 | 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 | |||
39 | 39 | ||
40 | data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile } | 40 | data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile } |
41 | 41 | ||
42 | streaminfo :: StreamInfo | ||
43 | streaminfo = StreamInfo | ||
44 | { fill = KF_None | ||
45 | , spill = KF_None | ||
46 | , typ = KeyRingFile | ||
47 | , initializer = NoCreate | ||
48 | , access = AutoAccess | ||
49 | , transforms = [] | ||
50 | } | ||
42 | 51 | ||
43 | minimalOp :: CommonArgsParsed -> KeyRingOperation | 52 | minimalOp :: CommonArgsParsed -> KeyRingOperation |
44 | minimalOp cap = op | 53 | minimalOp 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 | ||
179 | replaceSshServerKeys 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 | ||