summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2016-04-23 20:27:15 -0400
committerjoe <joe@jerkface.net>2016-04-23 20:27:15 -0400
commitec89ad06f3388b7c35f939f30011bea8f2304c6b (patch)
tree14acaf5c28499f030de68298a91732212f8b71c1 /KeyRing.hs
parentbdcc5cad33f8e0b1bbe6c178a1e225ac4e564311 (diff)
Propagate StreamInfo information (untested.)
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs44
1 files changed, 22 insertions, 22 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 0c1fc2a..b164527 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -278,7 +278,8 @@ data KeyFilter = KF_None -- ^ No keys will be imported.
278 deriving (Eq,Ord,Show) 278 deriving (Eq,Ord,Show)
279 279
280-- | This type describes how 'runKeyRing' will treat a file. 280-- | This type describes how 'runKeyRing' will treat a file.
281data StreamInfo = StreamInfo { access :: Access 281data StreamInfo = StreamInfo
282 { access :: Access
282 -- ^ Indicates whether the file is allowed to contain secret information. 283 -- ^ Indicates whether the file is allowed to contain secret information.
283 , typ :: FileType 284 , typ :: FileType
284 -- ^ Indicates the format and content type of the file. 285 -- ^ Indicates the format and content type of the file.
@@ -1290,7 +1291,7 @@ importSecretKey ::
1290 (MappedPacket -> IO (KikiCondition Packet)) 1291 (MappedPacket -> IO (KikiCondition Packet))
1291 -> KikiCondition 1292 -> KikiCondition
1292 (Map.Map KeyKey KeyData, [(FilePath, KikiReportAction)]) 1293 (Map.Map KeyKey KeyData, [(FilePath, KikiReportAction)])
1293 -> (FilePath, Maybe [Char], [KeyKey], FileType, t) 1294 -> (FilePath, Maybe [Char], [KeyKey], StreamInfo, t)
1294 -> IO (KikiCondition (Map.Map KeyKey KeyData, [(FilePath, KikiReportAction)])) 1295 -> IO (KikiCondition (Map.Map KeyKey KeyData, [(FilePath, KikiReportAction)]))
1295importSecretKey doDecrypt db' tup = do 1296importSecretKey doDecrypt db' tup = do
1296 try db' $ \(db',report0) -> do 1297 try db' $ \(db',report0) -> do
@@ -1534,7 +1535,7 @@ buildKeyDB ctx grip0 keyring = do
1534 let (topspec,subspec) = parseSpec grip usage 1535 let (topspec,subspec) = parseSpec grip usage
1535 ms = map fst $ filterMatches topspec (Map.toList db) 1536 ms = map fst $ filterMatches topspec (Map.toList db)
1536 cmd = initializer stream 1537 cmd = initializer stream
1537 return (n,subspec,ms,typ stream, cmd) 1538 return (n,subspec,ms,stream, cmd)
1538 imports <- filterM (\(n,_,_,_,_) -> doesFileExist n) pems 1539 imports <- filterM (\(n,_,_,_,_) -> doesFileExist n) pems
1539 db <- foldM (importSecretKey doDecrypt) (KikiSuccess (db,[])) imports 1540 db <- foldM (importSecretKey doDecrypt) (KikiSuccess (db,[])) imports
1540 try db $ \(db,reportPEMs) -> do 1541 try db $ \(db,reportPEMs) -> do
@@ -1769,9 +1770,9 @@ doImport
1769 :: Ord k => 1770 :: Ord k =>
1770 (MappedPacket -> IO (KikiCondition Packet)) 1771 (MappedPacket -> IO (KikiCondition Packet))
1771 -> Map.Map k KeyData 1772 -> Map.Map k KeyData
1772 -> (FilePath, Maybe [Char], [k], FileType, t) 1773 -> (FilePath, Maybe [Char], [k], StreamInfo, t)
1773 -> IO (KikiCondition (Map.Map k KeyData, [(FilePath,KikiReportAction)])) 1774 -> IO (KikiCondition (Map.Map k KeyData, [(FilePath,KikiReportAction)]))
1774doImport doDecrypt db (fname,subspec,ms,typ,_) = do 1775doImport doDecrypt db (fname,subspec,ms,typ -> typ,_) = do
1775 flip (maybe $ return CannotImportMasterKey) 1776 flip (maybe $ return CannotImportMasterKey)
1776 subspec $ \tag -> do 1777 subspec $ \tag -> do
1777 (certs,keys) <- case typ of 1778 (certs,keys) <- case typ of
@@ -2224,23 +2225,23 @@ writeKeyToFile False DNSPresentation fname packet = do
2224 2225
2225writePEMKeys :: (MappedPacket -> IO (KikiCondition Packet)) 2226writePEMKeys :: (MappedPacket -> IO (KikiCondition Packet))
2226 -> KeyDB 2227 -> KeyDB
2227 -> [(FilePath,Maybe String,[MappedPacket],FileType,Maybe Initializer)] 2228 -> [(FilePath,Maybe String,[MappedPacket],StreamInfo)]
2228 -> IO (KikiCondition [(FilePath,KikiReportAction)]) 2229 -> IO (KikiCondition [(FilePath,KikiReportAction)])
2229writePEMKeys doDecrypt db exports = do 2230writePEMKeys doDecrypt db exports = do
2230 ds <- mapM decryptKeys exports 2231 ds <- mapM decryptKeys exports
2231 let ds' = map functorToEither ds 2232 let ds' = map functorToEither ds
2232 if null (lefts ds') 2233 if null (lefts ds')
2233 then do 2234 then do
2234 rs <- mapM (\(f,typ,p) -> writeKeyToFile False typ (ArgFile f) p) 2235 rs <- mapM (\(f,stream,p) -> writeKeyToFile False (typ stream) (ArgFile f) p)
2235 (rights ds') 2236 (rights ds')
2236 return $ KikiSuccess (map (first $ resolveForReport Nothing) $ concat rs) 2237 return $ KikiSuccess (map (first $ resolveForReport Nothing) $ concat rs)
2237 else do 2238 else do
2238 return (head $ lefts ds') 2239 return (head $ lefts ds')
2239 where 2240 where
2240 decryptKeys (fname,subspec,[p],typ,_) = do 2241 decryptKeys (fname,subspec,[p],stream) = do
2241 pun <- doDecrypt p 2242 pun <- doDecrypt p
2242 try pun $ \pun -> do 2243 try pun $ \pun -> do
2243 return $ KikiSuccess (fname,typ,pun) 2244 return $ KikiSuccess (fname,stream,pun)
2244 2245
2245makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext 2246makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext
2246 -> Map.Map KeyKey MappedPacket 2247 -> Map.Map KeyKey MappedPacket
@@ -2392,8 +2393,7 @@ initializeMissingPEMFiles ::
2392 -> IO (KikiCondition ( (KeyDB,[( FilePath 2393 -> IO (KikiCondition ( (KeyDB,[( FilePath
2393 , Maybe String 2394 , Maybe String
2394 , [MappedPacket] 2395 , [MappedPacket]
2395 , FileType 2396 , StreamInfo )])
2396 , Maybe Initializer)])
2397 , [(FilePath,KikiReportAction)])) 2397 , [(FilePath,KikiReportAction)]))
2398initializeMissingPEMFiles operation ctx grip decrypt db = do 2398initializeMissingPEMFiles operation ctx grip decrypt db = do
2399 nonexistents <- 2399 nonexistents <-
@@ -2402,7 +2402,7 @@ initializeMissingPEMFiles operation ctx grip decrypt db = do
2402 f <- resolveInputFile ctx f 2402 f <- resolveInputFile ctx f
2403 return (f,t) 2403 return (f,t)
2404 2404
2405 let (missing,notmissing) = partition (\(_,_,ns,_,_)->null (ns >>= snd)) $ do 2405 let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do
2406 (fname,stream) <- nonexistents 2406 (fname,stream) <- nonexistents
2407 guard $ isMutable stream 2407 guard $ isMutable stream
2408 guard $ isSecretKeyFile (typ stream) 2408 guard $ isSecretKeyFile (typ stream)
@@ -2415,12 +2415,12 @@ initializeMissingPEMFiles operation ctx grip decrypt db = do
2415 ns = do 2415 ns = do
2416 (kk,kd) <- filterMatches topspec $ Map.toList db 2416 (kk,kd) <- filterMatches topspec $ Map.toList db
2417 return (kk , subkeysForExport subspec kd) 2417 return (kk , subkeysForExport subspec kd)
2418 return (fname,subspec,ns,(typ stream),initializer stream) 2418 return (fname,subspec,ns,stream)
2419 (exports0,ambiguous) = partition (\(_,_,ns,_,_)->null $ drop 1 $ (ns>>=snd)) 2419 (exports0,ambiguous) = partition (\(_,_,ns,_)->null $ drop 1 $ (ns>>=snd))
2420 notmissing 2420 notmissing
2421 exports = map (\(f,subspec,ns,typ,cmd) -> (f,subspec,ns >>= snd,typ,cmd)) exports0 2421 exports = map (\(f,subspec,ns,stream) -> (f,subspec,ns >>= snd,stream)) exports0
2422 2422
2423 ambiguity (f,topspec,subspec,_,_) = do 2423 ambiguity (f,topspec,subspec,_) = do
2424 return $ AmbiguousKeySpec f 2424 return $ AmbiguousKeySpec f
2425 2425
2426 ifnotnull (x:xs) f g = f x 2426 ifnotnull (x:xs) f g = f x
@@ -2432,10 +2432,10 @@ initializeMissingPEMFiles operation ctx grip decrypt db = do
2432 do 2432 do
2433 let cmds = mapMaybe getcmd missing 2433 let cmds = mapMaybe getcmd missing
2434 where 2434 where
2435 getcmd (fname,subspec,ms,typ,mcmd) = do 2435 getcmd (fname,subspec,ms,stream) = do
2436 cmd <- mcmd 2436 cmd <- initializer stream
2437 return (fname,subspec,ms,typ,cmd) 2437 return (fname,subspec,ms,stream,cmd)
2438 rs <- forM cmds $ \tup@(fname,subspec,ms,typ,cmd) -> do 2438 rs <- forM cmds $ \tup@(fname,subspec,ms,stream,cmd) -> do
2439 e <- systemEnv [ ("file",fname) 2439 e <- systemEnv [ ("file",fname)
2440 , ("usage",fromMaybe "" subspec) ] 2440 , ("usage",fromMaybe "" subspec) ]
2441 cmd 2441 cmd
@@ -2445,11 +2445,11 @@ initializeMissingPEMFiles operation ctx grip decrypt db = do
2445 2445
2446 v <- foldM (importSecretKey decrypt) 2446 v <- foldM (importSecretKey decrypt)
2447 (KikiSuccess (db,[])) $ do 2447 (KikiSuccess (db,[])) $ do
2448 ((f,subspec,ms,typ,cmd),r) <- rs 2448 ((f,subspec,ms,stream,cmd),r) <- rs
2449 guard $ case r of 2449 guard $ case r of
2450 ExternallyGeneratedFile -> True 2450 ExternallyGeneratedFile -> True
2451 _ -> False 2451 _ -> False
2452 return (f,subspec,map fst ms,typ,cmd) 2452 return (f,subspec,map fst ms,stream,cmd)
2453 2453
2454 try v $ \(db,import_rs) -> do 2454 try v $ \(db,import_rs) -> do
2455 return $ KikiSuccess ((db,exports), map (\((f,_,_,_,_),r)->(f,r)) rs 2455 return $ KikiSuccess ((db,exports), map (\((f,_,_,_,_),r)->(f,r)) rs