diff options
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 39 |
1 files changed, 28 insertions, 11 deletions
@@ -1462,7 +1462,7 @@ readSecretPEMFile fname = do | |||
1462 | -- Therefore, we should attempt to preserve it. | 1462 | -- Therefore, we should attempt to preserve it. |
1463 | timestamp <- getInputFileTime ctx fname | 1463 | timestamp <- getInputFileTime ctx fname |
1464 | input <- readInputFileL ctx fname | 1464 | input <- readInputFileL ctx fname |
1465 | let dta = catMaybes $ scanAndParse pkcs1 $ Char8.lines input | 1465 | let dta = catMaybes $ scanAndParse (pkcs1 <> cert) $ Char8.lines input |
1466 | pkcs1 = fmap (parseRSAPrivateKey . pemBlob) | 1466 | pkcs1 = fmap (parseRSAPrivateKey . pemBlob) |
1467 | $ pemParser $ Just "RSA PRIVATE KEY" | 1467 | $ pemParser $ Just "RSA PRIVATE KEY" |
1468 | cert = fmap (fmap (PEMPacket . pcertKey) . parseCertBlob False . pemBlob) | 1468 | cert = fmap (fmap (PEMPacket . pcertKey) . parseCertBlob False . pemBlob) |
@@ -1504,9 +1504,16 @@ doImport doDecrypt db (fname,subspec,ms,_) = do | |||
1504 | flip (maybe $ return CannotImportMasterKey) | 1504 | flip (maybe $ return CannotImportMasterKey) |
1505 | subspec $ \tag -> do | 1505 | subspec $ \tag -> do |
1506 | ps <- readSecretPEMFile (ArgFile fname) | 1506 | ps <- readSecretPEMFile (ArgFile fname) |
1507 | foldM (importPemThing tag) (KikiSuccess (db,[])) ps | 1507 | let (mapMaybe spemCert -> certs,mapMaybe spemPacket-> keys) |
1508 | = partition (isJust . spemCert) ps | ||
1509 | -- TODO Probably we need to move to a new design where signature | ||
1510 | -- packets are merged into the database in one phase with null | ||
1511 | -- signatures, and then the signatures are made in the next phase. | ||
1512 | -- This would let us merge annotations (like certificates) from | ||
1513 | -- seperate files. | ||
1514 | foldM (importPEMKey tag certs) (KikiSuccess (db,[])) keys | ||
1508 | where | 1515 | where |
1509 | importPemThing tag prior (PEMPacket key) = do | 1516 | importPEMKey tag certs prior key = do |
1510 | try prior $ \(db,report) -> do | 1517 | try prior $ \(db,report) -> do |
1511 | let (m0,tailms) = splitAt 1 ms | 1518 | let (m0,tailms) = splitAt 1 ms |
1512 | if (not (null tailms) || null m0) | 1519 | if (not (null tailms) || null m0) |
@@ -1515,13 +1522,6 @@ doImport doDecrypt db (fname,subspec,ms,_) = do | |||
1515 | r <- doImportG doDecrypt db m0 tag fname key | 1522 | r <- doImportG doDecrypt db m0 tag fname key |
1516 | try r $ \(db',report') -> do | 1523 | try r $ \(db',report') -> do |
1517 | return $ KikiSuccess (db',report++report') | 1524 | return $ KikiSuccess (db',report++report') |
1518 | importPemThing tag prior (PEMCertificate cert) = do | ||
1519 | -- TODO Probably we need to move to a new design where signature | ||
1520 | -- packets are merged into the database in one phase with null | ||
1521 | -- signatures, and then the signatures are made in the next phase. | ||
1522 | -- This would let us merge annotations (like certificates) from | ||
1523 | -- seperate files. | ||
1524 | return prior | ||
1525 | 1525 | ||
1526 | doImportG | 1526 | doImportG |
1527 | :: Ord k => | 1527 | :: Ord k => |
@@ -1589,6 +1589,7 @@ doImportG doDecrypt db m0 tag fname key = do | |||
1589 | wk = packet top | 1589 | wk = packet top |
1590 | (xs',minsig,ys') = findTag tag wk key subsigs | 1590 | (xs',minsig,ys') = findTag tag wk key subsigs |
1591 | doInsert mbsig db = do | 1591 | doInsert mbsig db = do |
1592 | -- NEW SUBKEY BINDING SIGNATURE | ||
1592 | sig' <- makeSig doDecrypt top fname subkey_p tag mbsig | 1593 | sig' <- makeSig doDecrypt top fname subkey_p tag mbsig |
1593 | try sig' $ \(sig',report) -> do | 1594 | try sig' $ \(sig',report) -> do |
1594 | report <- return $ fmap (fname,) report ++ [(fname, YieldSignature)] | 1595 | report <- return $ fmap (fname,) report ++ [(fname, YieldSignature)] |
@@ -2512,8 +2513,13 @@ readPacketsFromFile ctx fname = do | |||
2512 | return $ decode input | 2513 | return $ decode input |
2513 | #endif | 2514 | #endif |
2514 | 2515 | ||
2516 | -- | Get the time stamp of a signature. | ||
2517 | -- | ||
2518 | -- Warning: This function checks unhashed_subpackets if no timestamp occurs in | ||
2519 | -- the hashed section. TODO: change this? | ||
2520 | -- | ||
2515 | signature_time :: SignatureOver -> Word32 | 2521 | signature_time :: SignatureOver -> Word32 |
2516 | signature_time ov = case if null cs then ds else cs of | 2522 | signature_time ov = case (if null cs then ds else cs) of |
2517 | [] -> minBound | 2523 | [] -> minBound |
2518 | xs -> maximum xs | 2524 | xs -> maximum xs |
2519 | where | 2525 | where |
@@ -2535,6 +2541,17 @@ splitAtMinBy comp xs = minimumBy comp' xxs | |||
2535 | 2541 | ||
2536 | 2542 | ||
2537 | 2543 | ||
2544 | -- | Given a usage@ tag, the working master key, one of its subkeys and a list | ||
2545 | -- of signatures on that subkey, yields: | ||
2546 | -- | ||
2547 | -- * preceding list of signatures | ||
2548 | -- | ||
2549 | -- * The most recent valid signature made by the working key along with a | ||
2550 | -- flag that indicates whether or not the given usage tag occurs in it or, | ||
2551 | -- if no valid signature from the working key is present, Nothing. | ||
2552 | -- | ||
2553 | -- * following list of signatures | ||
2554 | -- | ||
2538 | findTag :: | 2555 | findTag :: |
2539 | String | 2556 | String |
2540 | -> Packet | 2557 | -> Packet |