summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-05-10 22:40:26 -0400
committerjoe <joe@jerkface.net>2014-05-10 22:40:26 -0400
commit6492f127b8decb19ad1fe4b5552cc31b4ababb5d (patch)
treef463b949a0eaff06468c77ce59d92bda94677d14 /KeyRing.hs
parent840d37a6dcab32e8dec673945cf3e4f5c99815b5 (diff)
oops, added cert parsing to readKeyFromFile. Also: code comments.
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs39
1 files changed, 28 insertions, 11 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index adbf23c..18dc60d 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -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
1526doImportG 1526doImportG
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--
2515signature_time :: SignatureOver -> Word32 2521signature_time :: SignatureOver -> Word32
2516signature_time ov = case if null cs then ds else cs of 2522signature_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--
2538findTag :: 2555findTag ::
2539 String 2556 String
2540 -> Packet 2557 -> Packet