summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-05-04 17:48:05 -0400
committerjoe <joe@jerkface.net>2014-05-04 17:48:05 -0400
commitb06f6ca1b87749619d13f97e8e99ea76ca776ecc (patch)
tree1d2df446a73d8bc1f8940d05880c9b8ca0ea2fe8 /KeyRing.hs
parentbe0e20cbb8f904a5091f88f32f353b5abed5cb06 (diff)
cosmetics, haddock.
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs112
1 files changed, 77 insertions, 35 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index f7ea780..7fe031c 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -27,11 +27,12 @@ module KeyRing
27 , KikiReportAction(..) 27 , KikiReportAction(..)
28 -- * Manipulating Keyrings 28 -- * Manipulating Keyrings
29 , runKeyRing 29 , runKeyRing
30 , KeyRingOperation(..)
30 , StreamInfo(..) 31 , StreamInfo(..)
32 , PassphraseSpec(..)
33 , Transform(..)
31 , Access(..) 34 , Access(..)
32 , KeyFilter(..) 35 , KeyFilter(..)
33 , KeyRingOperation(..)
34 , PassphraseSpec(..)
35 , errorString 36 , errorString
36 , reportString 37 , reportString
37 , KeyRingRuntime(..) 38 , KeyRingRuntime(..)
@@ -198,7 +199,7 @@ type PasswordFile = InputFile
198 199
199data FileType = KeyRingFile (Maybe PasswordFile) 200data FileType = KeyRingFile (Maybe PasswordFile)
200 -- ^ PasswordFile parameter is deprecated in favor 201 -- ^ PasswordFile parameter is deprecated in favor
201 -- of kPassphrases. TODO: remove it. 202 -- of opPassphrases. TODO: remove it.
202 | PEMFile 203 | PEMFile
203 | WalletFile -- (Maybe UsageTag) 204 | WalletFile -- (Maybe UsageTag)
204 | Hosts 205 | Hosts
@@ -216,18 +217,50 @@ data KeyFilter = KF_None -- ^ No keys will be imported.
216 -- identity (signed or self-authenticating). 217 -- identity (signed or self-authenticating).
217 | KF_All -- ^ All keys will be imported. 218 | KF_All -- ^ All keys will be imported.
218 219
220-- | This type describes how 'runKeyRing' will treat a file.
219data StreamInfo = StreamInfo 221data StreamInfo = StreamInfo
220 { access :: Access 222 { access :: Access
223 -- ^ Indicates whether the file is allowed to contain secret information.
221 , typ :: FileType 224 , typ :: FileType
225 -- ^ Indicates the format and content type of the file.
222 , fill :: KeyFilter 226 , fill :: KeyFilter
223 , spill :: KeyFilter -- ^ Currently respected for PEMFile and KeyRingFile. 227 -- ^ This filter controls what packets will be inserted into a file.
224 -- (TODO: WalletFile and Hosts) 228 , spill :: KeyFilter
225 -- Note that this is currently treated as a boolean 229 --
226 -- flag. KF_None means the file is not spillable 230 -- ^ Use this to indicate whether or not a file's contents should be
227 -- and anything else means that it is. 231 -- available for updating other files. Note that although its type is
232 -- 'KeyFilter', it is usually interpretted as a boolean flag. Details
233 -- depend on 'typ' and are as follows:
234 --
235 -- 'KeyRingFile':
236 --
237 -- * 'KF_None' - The file's contents will not be shared.
238 --
239 -- * otherwise - The file's contents will be shared.
240 --
241 -- 'PEMFile':
242 --
243 -- * 'KF_None' - The file's contents will not be shared.
244 --
245 -- * 'KF_Match' - The file's key will be shared with the specified
246 -- owner key and usage tag.
247 --
248 -- * otherwise - Unspecified. Do not use.
249 --
250 -- 'WalletFile': The 'spill' setting is ignored and the file's
251 -- contents are shared. (TODO)
252 --
253 -- 'Hosts': The 'spill' setting is ignored and the file's
254 -- contents are shared. (TODO)
255 --
228 , initializer :: Maybe String 256 , initializer :: Maybe String
257 -- ^ If 'typ' is 'PEMFile' and an 'initializer' string is set, then it is
258 -- interpretted as a shell command that may be used to create the key if it
259 -- does not exist.
229 , transforms :: [Transform] 260 , transforms :: [Transform]
230 -- ^ TODO: currently ignored 261 -- ^ Ignored. TODO: The intention is that we may indicate per-file
262 -- transformations that occur before a file's contents are spilled into the
263 -- common pool.
231 } 264 }
232 265
233 266
@@ -291,13 +324,22 @@ data PassphraseSpec = PassphraseSpec
291data Transform = Autosign 324data Transform = Autosign
292 deriving (Eq,Ord) 325 deriving (Eq,Ord)
293 326
327-- | This type describes an idempotent transformation (merge or import) on a
328-- set of GnuPG keyrings and other key files.
294data KeyRingOperation = KeyRingOperation 329data KeyRingOperation = KeyRingOperation
295 { kFiles :: Map.Map InputFile StreamInfo 330 { opFiles :: Map.Map InputFile StreamInfo
296 , kPassphrases :: [PassphraseSpec] 331 -- ^ Indicates files to be read or updated.
297 , kTransform :: [Transform] 332 , opPassphrases :: [PassphraseSpec]
333 -- ^ Indicates files or file descriptors where passphrases can be found.
334 , opTransforms :: [Transform]
335 -- ^ Transformations to be performed on the key pool after all files have
336 -- been read and before any have been written.
298 , kManip :: KeyRingRuntime -> KeyData -> [PacketUpdate]--[KeyRingAddress PacketUpdate] 337 , kManip :: KeyRingRuntime -> KeyData -> [PacketUpdate]--[KeyRingAddress PacketUpdate]
299 -- ^ TODO: this is deprecated in favor of kTransform (remove it) 338 -- ^ This is deprecated in favor of opTransforms (TODO: remove it)
300 , homeSpec :: Maybe String 339 , opHome :: Maybe FilePath
340 -- ^ If provided, this is the directory where the 'HomeSec' and 'HomePub'
341 -- files reside. Otherwise, the evironment variable $GNUPGHOME is consulted
342 -- and if that is not set, it falls back to $HOME/.gnupg.
301 } 343 }
302 344
303resolveInputFile :: InputFileContext -> InputFile -> [FilePath] 345resolveInputFile :: InputFileContext -> InputFile -> [FilePath]
@@ -321,7 +363,7 @@ resolveForReport mctx f = concat $ resolveInputFile ctx f
321filesToLock :: 363filesToLock ::
322 KeyRingOperation -> InputFileContext -> [FilePath] 364 KeyRingOperation -> InputFileContext -> [FilePath]
323filesToLock k ctx = do 365filesToLock k ctx = do
324 (f,stream) <- Map.toList (kFiles k) 366 (f,stream) <- Map.toList (opFiles k)
325 case fill stream of 367 case fill stream of
326 KF_None -> [] 368 KF_None -> []
327 _ -> resolveInputFile ctx f 369 _ -> resolveInputFile ctx f
@@ -473,13 +515,12 @@ instance Applicative KikiCondition where
473 Left err -> err 515 Left err -> err
474 Left err -> err 516 Left err -> err
475 517
476-- | This type is used to describe events triggered by a 518-- | This type is used to describe events triggered by 'runKeyRing'. In
477-- 'runKeyRing'. In addition to normal feedback 519-- addition to normal feedback (e.g. 'NewPacket'), it also may indicate
478-- (e.g. 'NewPacket'), it also may indicate non-fatal 520-- non-fatal IO exceptions (e.g. FailedExternal). Because a 'KeyRingOperation'
479-- IO exceptions (e.g. FailedExternal). Because a 'KeyRingOperation' 521-- may describe a very intricate multifaceted algorithm with many inputs and
480-- may describe a very intricate multifaceted algorithm with many 522-- outputs, an operation may be partially (or even mostly) successful even when
481-- inputs and outputs, an operation may be partially (or even mostly) 523-- some aspect failed.
482-- successful even when some aspect failed.
483data KikiReportAction = 524data KikiReportAction =
484 NewPacket String 525 NewPacket String
485 | MissingPacket String 526 | MissingPacket String
@@ -1029,7 +1070,7 @@ mergeHostFiles krd db ctx = do
1029 ishosts Hosts = True 1070 ishosts Hosts = True
1030 ishosts _ = False 1071 ishosts _ = False
1031 files istyp = do 1072 files istyp = do
1032 (f,stream) <- Map.toList (kFiles krd) 1073 (f,stream) <- Map.toList (opFiles krd)
1033 guard (istyp $ typ stream) 1074 guard (istyp $ typ stream)
1034 return f 1075 return f
1035 1076
@@ -1086,7 +1127,7 @@ writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do
1086 isMutableHosts (typ -> Hosts) = True 1127 isMutableHosts (typ -> Hosts) = True
1087 isMutableHosts _ = False 1128 isMutableHosts _ = False
1088 files istyp = do 1129 files istyp = do
1089 (f,stream) <- Map.toList (kFiles krd) 1130 (f,stream) <- Map.toList (opFiles krd)
1090 guard (istyp stream) 1131 guard (istyp stream)
1091 return f -- resolveInputFile ctx f 1132 return f -- resolveInputFile ctx f
1092 1133
@@ -1127,11 +1168,11 @@ buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation
1127buildKeyDB ctx grip0 keyring = do 1168buildKeyDB ctx grip0 keyring = do
1128 let 1169 let
1129 files isring = do 1170 files isring = do
1130 (f,stream) <- Map.toList (kFiles keyring) 1171 (f,stream) <- Map.toList (opFiles keyring)
1131 guard (isring $ typ stream) 1172 guard (isring $ typ stream)
1132 resolveInputFile ctx f 1173 resolveInputFile ctx f
1133 1174
1134 (ringMap,nonRingMap) = Map.partition (isring . typ) $ kFiles keyring 1175 (ringMap,nonRingMap) = Map.partition (isring . typ) $ opFiles keyring
1135 1176
1136 readp f stream = fmap readp0 $ readPacketsFromFile ctx f 1177 readp f stream = fmap readp0 $ readPacketsFromFile ctx f
1137 where 1178 where
@@ -1207,7 +1248,7 @@ buildKeyDB ctx grip0 keyring = do
1207 1248
1208 -- PEM files 1249 -- PEM files
1209 let pems = do 1250 let pems = do
1210 (n,stream) <- Map.toList $ kFiles keyring 1251 (n,stream) <- Map.toList $ opFiles keyring
1211 grip <- maybeToList grip 1252 grip <- maybeToList grip
1212 n <- resolveInputFile ctx n 1253 n <- resolveInputFile ctx n
1213 guard $ spillable stream && ispem (typ stream) 1254 guard $ spillable stream && ispem (typ stream)
@@ -1448,7 +1489,7 @@ writeWalletKeys krd db wk = do
1448 isMutableWallet (typ -> WalletFile {}) = True 1489 isMutableWallet (typ -> WalletFile {}) = True
1449 isMutableWallet _ = False 1490 isMutableWallet _ = False
1450 files pred = do 1491 files pred = do
1451 (f,stream) <- Map.toList (kFiles krd) 1492 (f,stream) <- Map.toList (opFiles krd)
1452 guard (pred stream) 1493 guard (pred stream)
1453 resolveInputFile (InputFileContext "" "") f 1494 resolveInputFile (InputFileContext "" "") f
1454 let writeWallet report n = do 1495 let writeWallet report n = do
@@ -1536,7 +1577,7 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled = do
1536 ctx = InputFileContext secring pubring 1577 ctx = InputFileContext secring pubring
1537 let s = do 1578 let s = do
1538 (f,f0,stream) <- do 1579 (f,f0,stream) <- do
1539 (f0,stream) <- Map.toList (kFiles krd) 1580 (f0,stream) <- Map.toList (opFiles krd)
1540 guard (isring $ typ stream) 1581 guard (isring $ typ stream)
1541 f <- resolveInputFile ctx f0 1582 f <- resolveInputFile ctx f0
1542 return (f,f0,stream) 1583 return (f,f0,stream)
@@ -1711,19 +1752,19 @@ makeMemoizingDecrypter operation ctx keys = do
1711 pws <- 1752 pws <-
1712 Traversable.mapM (cachedContents ctx . fromJust . pwfile . typ) 1753 Traversable.mapM (cachedContents ctx . fromJust . pwfile . typ)
1713 (Map.mapKeys (resolveForReport Nothing) -- see note (*) note above 1754 (Map.mapKeys (resolveForReport Nothing) -- see note (*) note above
1714 $ Map.filter (isJust . pwfile . typ) $ kFiles operation) 1755 $ Map.filter (isJust . pwfile . typ) $ opFiles operation)
1715 pws2 <- 1756 pws2 <-
1716 Traversable.mapM (cachedContents ctx) 1757 Traversable.mapM (cachedContents ctx)
1717 $ Map.fromList $ mapMaybe 1758 $ Map.fromList $ mapMaybe
1718 (\spec -> (,passSpecPassFile spec) `fmap` do 1759 (\spec -> (,passSpecPassFile spec) `fmap` do
1719 guard $ isNothing $ passSpecKeySpec spec 1760 guard $ isNothing $ passSpecKeySpec spec
1720 passSpecRingFile spec) 1761 passSpecRingFile spec)
1721 (kPassphrases operation) 1762 (opPassphrases operation)
1722 defpw <- do 1763 defpw <- do
1723 Traversable.mapM (cachedContents ctx . passSpecPassFile) 1764 Traversable.mapM (cachedContents ctx . passSpecPassFile)
1724 $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp) 1765 $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp)
1725 && isNothing (passSpecKeySpec sp)) 1766 && isNothing (passSpecKeySpec sp))
1726 $ kPassphrases operation 1767 $ opPassphrases operation
1727 unkeysRef <- newIORef (Map.empty :: Map.Map KeyKey Packet) 1768 unkeysRef <- newIORef (Map.empty :: Map.Map KeyKey Packet)
1728 return $ doDecrypt unkeysRef (pws `Map.union` pws2) defpw 1769 return $ doDecrypt unkeysRef (pws `Map.union` pws2) defpw
1729 where 1770 where
@@ -1830,7 +1871,7 @@ initializeMissingPEMFiles ::
1830initializeMissingPEMFiles operation ctx grip decrypt db = do 1871initializeMissingPEMFiles operation ctx grip decrypt db = do
1831 nonexistents <- 1872 nonexistents <-
1832 filterM (fmap not . doesFileExist . fst) 1873 filterM (fmap not . doesFileExist . fst)
1833 $ do (f,t) <- Map.toList (kFiles operation) 1874 $ do (f,t) <- Map.toList (opFiles operation)
1834 f <- resolveInputFile ctx f 1875 f <- resolveInputFile ctx f
1835 return (f,t) 1876 return (f,t)
1836 1877
@@ -1897,7 +1938,7 @@ combineTransforms operation rt kd = updates
1897 where 1938 where
1898 updates = kManip operation rt kd 1939 updates = kManip operation rt kd
1899 ++ concatMap (\t -> resolveTransform t rt kd) sanitized 1940 ++ concatMap (\t -> resolveTransform t rt kd) sanitized
1900 sanitized = group (sort (kTransform operation)) >>= take 1 1941 sanitized = group (sort (opTransforms operation)) >>= take 1
1901 1942
1902isSubkeySignature (SubkeySignature {}) = True 1943isSubkeySignature (SubkeySignature {}) = True
1903isSubkeySignature _ = False 1944isSubkeySignature _ = False
@@ -2024,9 +2065,10 @@ resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops
2024 gs = groupBy sameMaster (sortBy (comparing code) bindings') 2065 gs = groupBy sameMaster (sortBy (comparing code) bindings')
2025 2066
2026 2067
2068-- | Load and update key files according to the specified 'KeyRingOperation'.
2027runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime) 2069runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime)
2028runKeyRing operation = do 2070runKeyRing operation = do
2029 homedir <- getHomeDir (homeSpec operation) 2071 homedir <- getHomeDir (opHome operation)
2030 let try' :: KikiCondition a -> (a -> IO (KikiResult b)) -> IO (KikiResult b) 2072 let try' :: KikiCondition a -> (a -> IO (KikiResult b)) -> IO (KikiResult b)
2031 -- FIXME: try' should probably accept a list of KikiReportActions. 2073 -- FIXME: try' should probably accept a list of KikiReportActions.
2032 -- This would be useful for reporting on disk writes that have already 2074 -- This would be useful for reporting on disk writes that have already