diff options
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 25 |
1 files changed, 22 insertions, 3 deletions
@@ -371,10 +371,9 @@ data KeyRingRuntime = KeyRingRuntime | |||
371 | , rtPassphrases :: MappedPacket -> IO (KikiCondition Packet) | 371 | , rtPassphrases :: MappedPacket -> IO (KikiCondition Packet) |
372 | } | 372 | } |
373 | 373 | ||
374 | -- | TODO: Packet Update should have deletion action | 374 | -- | Roster-entry level actions |
375 | -- and any other kind of roster-entry level | ||
376 | -- action. | ||
377 | data PacketUpdate = InducerSignature String [SignatureSubpacket] | 375 | data PacketUpdate = InducerSignature String [SignatureSubpacket] |
376 | | SubKeyDeletion KeyKey KeyKey | ||
378 | 377 | ||
379 | -- | This type is used to indicate where to obtain passphrases. | 378 | -- | This type is used to indicate where to obtain passphrases. |
380 | data PassphraseSpec = PassphraseSpec | 379 | data PassphraseSpec = PassphraseSpec |
@@ -2092,6 +2091,7 @@ performManipulations doDecrypt rt wk manip = do | |||
2092 | try (sequenceA r) $ \db -> do | 2091 | try (sequenceA r) $ \db -> do |
2093 | return $ KikiSuccess (rt { rtKeyDB = db },[]) | 2092 | return $ KikiSuccess (rt { rtKeyDB = db },[]) |
2094 | where | 2093 | where |
2094 | perform :: KikiCondition KeyData -> PacketUpdate -> IO (KikiCondition KeyData) | ||
2095 | perform kd (InducerSignature uid subpaks) = do | 2095 | perform kd (InducerSignature uid subpaks) = do |
2096 | try kd $ \kd -> do | 2096 | try kd $ \kd -> do |
2097 | flip (maybe $ return NoWorkingKey) wk $ \wk' -> do | 2097 | flip (maybe $ return NoWorkingKey) wk $ \wk' -> do |
@@ -2133,6 +2133,15 @@ performManipulations doDecrypt rt wk manip = do | |||
2133 | , om `Map.union` snd x ) | 2133 | , om `Map.union` snd x ) |
2134 | return $ KikiSuccess $ kd { keyUids = Map.adjust f uid (keyUids kd) } | 2134 | return $ KikiSuccess $ kd { keyUids = Map.adjust f uid (keyUids kd) } |
2135 | 2135 | ||
2136 | perform kd (SubKeyDeletion topk subk) = do | ||
2137 | try kd $ \kd -> do | ||
2138 | -- TODO: delete key from key database | ||
2139 | let kk = keykey $ packet $ keyMappedPacket kd | ||
2140 | kd' | kk /= topk = kd | ||
2141 | | otherwise = kd { keySubKeys = Map.filterWithKey pred $ keySubKeys kd } | ||
2142 | pred k _ = k == subk | ||
2143 | return $ KikiSuccess kd' | ||
2144 | |||
2136 | initializeMissingPEMFiles :: | 2145 | initializeMissingPEMFiles :: |
2137 | KeyRingOperation | 2146 | KeyRingOperation |
2138 | -> InputFileContext -> Maybe String | 2147 | -> InputFileContext -> Maybe String |
@@ -2308,6 +2317,7 @@ getBindings pkts = (sigs,bindings) | |||
2308 | kind = guard (code==1) >> hashed >>= maybeToList . usage | 2317 | kind = guard (code==1) >> hashed >>= maybeToList . usage |
2309 | return (code,(topkey b,subkey b), kind, hashed,claimants) | 2318 | return (code,(topkey b,subkey b), kind, hashed,claimants) |
2310 | 2319 | ||
2320 | resolveTransform :: Transform -> KeyRingRuntime -> KeyData -> [PacketUpdate] | ||
2311 | resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops | 2321 | resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops |
2312 | where | 2322 | where |
2313 | ops = map (\u -> InducerSignature u []) us | 2323 | ops = map (\u -> InducerSignature u []) us |
@@ -2340,6 +2350,15 @@ resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops | |||
2340 | gs = groupBy sameMaster (sortBy (comparing code) bindings') | 2350 | gs = groupBy sameMaster (sortBy (comparing code) bindings') |
2341 | 2351 | ||
2342 | 2352 | ||
2353 | resolveTransform (DeleteSubKey fp) rt kd@(KeyData k ksigs umap submap) = fmap (SubKeyDeletion topk) subk | ||
2354 | where | ||
2355 | topk = keykey $ packet k -- key to master of key to be deleted | ||
2356 | subk = do | ||
2357 | (k,sub) <- Map.toList submap | ||
2358 | guard (map toUpper fp == fingerprint (packet (subkeyMappedPacket sub))) | ||
2359 | return k | ||
2360 | |||
2361 | |||
2343 | -- | Load and update key files according to the specified 'KeyRingOperation'. | 2362 | -- | Load and update key files according to the specified 'KeyRingOperation'. |
2344 | runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime) | 2363 | runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime) |
2345 | runKeyRing operation = do | 2364 | runKeyRing operation = do |