summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--kiki.cabal4
-rw-r--r--lib/GnuPGAgent.hs4
-rw-r--r--lib/KeyRing.hs428
-rw-r--r--lib/PacketTranscoder.hs204
-rw-r--r--lib/Types.hs263
5 files changed, 472 insertions, 431 deletions
diff --git a/kiki.cabal b/kiki.cabal
index 44abdb5..8eb4f17 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -93,7 +93,9 @@ library
93 GnuPGAgent 93 GnuPGAgent
94 other-modules: TimeUtil, 94 other-modules: TimeUtil,
95 ControlMaybe, 95 ControlMaybe,
96 Compat 96 Compat,
97 Types,
98 PacketTranscoder
97 99
98 Build-Depends: base >=4.6.0.0, 100 Build-Depends: base >=4.6.0.0,
99 asn1-encoding, 101 asn1-encoding,
diff --git a/lib/GnuPGAgent.hs b/lib/GnuPGAgent.hs
index 165fdf2..4a0e8c8 100644
--- a/lib/GnuPGAgent.hs
+++ b/lib/GnuPGAgent.hs
@@ -12,7 +12,6 @@ module GnuPGAgent
12import Debug.Trace 12import Debug.Trace
13import Control.Monad 13import Control.Monad
14import Data.Char 14import Data.Char
15import Data.String
16import Data.OpenPGP 15import Data.OpenPGP
17import Data.OpenPGP.Util 16import Data.OpenPGP.Util
18import Network.Socket 17import Network.Socket
@@ -195,6 +194,3 @@ mpi_nbits (MPI n) = 8 * fromIntegral len
195 b | L.head b == 0x0 -> L.length b - 1 194 b | L.head b == 0x0 -> L.length b - 1
196 | otherwise -> L.length b 195 | otherwise -> L.length b
197 196
198
199testkey = SecretKeyPacket {version = 4, timestamp = 1472243938, key_algorithm = RSA, key = [('n',MPI 925098108806375345974135594703587915335809897839280536758475464131261107271275275932941944111979646806461228101207851537942631933552941000008763874178530420365203962506983368285394789190952706134189777248228503641959576566803847321978843353927484729746589488105067415601601958095348374608399772919464713280387221943804165023869848572344992805664813501588760551986737643636299927619834836785540438897016892383261773529795165480003163651143689566476205133258213375814625458146741502313336447508506512546267421431425245630464604235460425475063276208764001900603879017446724640013942643622160007288636580727874256816955228499258020260878806702335205106422310450767943433083341074984990460601274996333576709631004285781450883843918772938883789506765607663117687871326332910317916884385080960167806232865135145253097892026144191502423556603525411279749089026836608340578157620006555362884552555447347323681257897414720771902270571787966952008017289476385955943926940452534284336204814865498532173422146165623516746915729611768809058047983375615970447956865689598628436093143714990376442967204932522864539829901037938858768502028897029767875742018399924904388125541551233394021154526824492768592689377932549076041702724833113848612007956279),('e',MPI 65537)], s2k_useage = 255, s2k = IteratedSaltedS2K SHA1 4073382889203176146 7864320, symmetric_algorithm = CAST5, encrypted_data = fromString "\NUL\ESC\145\219\220k\SOH\147}\236K\165\207\&9g\245Nl\\)l\193\224{\251\180T\240\150\184\164:Fbx\t\SI\143\213\202?\137\158zd\247\188W\227l\NUL\154s\173\NUL\"k\162\243\rh\233\215\181\207\&7\223\DC3^t\187\158\248\177\ENQ\225\\\186\168\EM\177\211\162U\132\229Nx\227\&8\SYN\234\136\229\142;\252\&90L;\161\181\SO\152\198\&4\153\SUBs\235\195\153N\196\194 [\244+\217\242l\217.\183\186\205(\186\NUL\164\143>\215\168\207}\191\172($\168\139)O\ESCq\GS\138\213\243\229<\187\252\153)\NUL\128\136\237\RS\ETX\216\185\176I\239\185\228\v(\251\&4\233\&3$\236\195\NAKr\234\190J\216y\DC1\av\159\164\CAN\EOT\167\202})\128\182j\195\145]\144\r\232(\215\187\&1K\245\170\218\144\179\205\SOH\180-\185\DC1\168l\195\149\196\191\&9\156\196E\253\159h\154II\180\f\r\211\242\167~\214\223\219S\194\239\192\250\211Z\162\NAK\183M\209\230\&1yd\145\SOH\249\129\ESC\147\EM\237y\vK12O\205\ESC\r\224J\188\189\231\132\153JT\151f8\209\220#~S\165Q\249\SOH\182)\182\244\222\198i\180\221\170Q\238X\206\218\222\164gy\239\&7\136\183P\204\&5\NAK&\ESCC\GS\192\202\SO\241x\145MM\207\229\135\151\189,t\231r\194\196\233[\225\136\234\164r\176NXY\157\&2?\129% g\200\222\150\209\DLEQ\144\FS\181\&4#\US\DC28\179\190\240y3gr\170&\194\CAN)3r\235\252\153\EM\211\a\195\251\187\236\&1\197:\192\158\US\US\163v\153\223\141\254\209\206n\178h\140\&1-\fM\b\SOH\207\155\USb.,\NAKw\247\US\225\b)\236\EM\ENQn}\SUB-\193\f\138F\255P\216\242\164\145\136\213\171\252\254t\178\v\207\187\211\229\161\133\238\146\162\166SrT\168\135\244d6]\151\a\153\156\232\207|\152\223\174\EMj\130\240\211\141\203\167Kl\163\179R\152\225\221m\224!\238\176\217\162\158 fv\149wX\226\132\137H\138\235\207vwN\DC1\DEL'T\171\219\222\n\220V@\249U\227\SUBr\223NE\158=c\189\ACK3H\220\174\&3\139\135\254\246\165\EOTT\248\RS\132\160\219\EMb\188\200\165\138\178\163\STX\170\161\248\217\&1\186\&2r~\243\143\145b\154(\138\161\179\217\ACK\176\243\163IC\176\189Q_\206w\188=\254\143=\175\188\ENQaP\197\SI*\151\242m\178\184\208\SYN@\128\143\DC3-J\163\164{\206<\SUBxG\SI\NUL\153%\187\142\&6\f\186O\142\128'\128\150{\165\156e\201\175\159\185\b\NAK\246M\182\&4\SOH\161\231UV\220\148\245$\173\247-C\212\179\190Z$\184\RSZ\130~\t\249\138r?\201\231\200\190m\128%c\204\ENQH3S\140\228\&8\243\NAK\DC4O\218\162\146R\221\134\217%%\164@#\139\a\STX\218Y\132h\ETX(=\245\135\239|rN\\2\250\\\FS\155:p\247\213\252D']*\137\220\128\232\ar\134\DC4\131\194\SUB\169\130\&6\SI\131\151J!\220\135V\210m!\EM\241\134\158v\200~\190;z\237\218\DC3\NULT\164\151\135|\185\EOT\161c\196QA\228.\ENQ\227d\220\128\238\191&Pw\f'\153\180\DC3\201\SI=0\218\130~\167\t5\172EBA\238D\219\208\168\b\252Y\236\220,\144\&1\239\177\n\DC4\DLE\238\v\ETB\168\246\185\212\239\231\212\212sl\254.\197\216\130g\163\&5\211*\150\243g\220\247\140M\190\172\216\250\248\130\207\&5f\223;=}qU?\\\237\243\ENQ\241[\198\248u\139\a\139\175\247\224\252_N\146G\201\NUL\170{\191\237\140\SYNH2\ESCg\RS\233\175}\189\136\250\240\129\US\187\193\194\189\SUBK\SO\209\177F\200\SOH\173\196kw_)_\227\162\186\DC2\132\181\b@\ACKGo\222f\251br\CAN3~\139\DC2U\bQ\241\CAN:\213\135s\138\GSPIk*\236\&2a;o\247\239\202\145\212(2\223\DEL\bz\157\242@\STX\180g\193\202\230\186\135\189\177l\163\216o\230\&6\DC2\198\164\182\&5\ETX%\228\"!\245\ENQ\180\234\ACK\US\174\249\SO\US\168\STX,\ETB\n\249/\177\179\247Fw$\DLEB\ACK\224\231\EOT\ETB\247\213\182v\180\FS\247\205\222+P&\228\213\216\138ez\189N9x\v\228\217\207L}\ETX&\133\206\vRSM)\SOH\217\253\RS\204\252\249p\v\ACKL!u\SI\\\ETXD\128\&9\152\fy\241\202\204\164\151p\142\147c\207)\130\179'm\211\128I\207\ENQ\r\bcMWt\222\156\&1\199\DLE\157\&0z[H\146\SOHg\238\234\185\181\141\172c\245[\NUL\197\205\ENQ\fM\177\230\253\209~^\213W1'\GS\142\249\SIZ\204\254\240\DC3\231=b!\225@\247x\135\135\226\251[\RS&;\135}\196t\SUBi\CAN\DC14]e\206-l\205\SI\253\222\139y\139V\242\150k\248\191\231\195\211W\226t\170\DLE\174\243\186\211\189\152D\216\235\163\220+\194\247!o^F\198\145M", is_subkey = False}
200
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index a055dad..313258d 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -211,6 +211,8 @@ import FunctorToMaybe
211import DotLock 211import DotLock
212import ProcessUtils (systemEnv, ExitCode(ExitFailure, ExitSuccess) ) 212import ProcessUtils (systemEnv, ExitCode(ExitFailure, ExitSuccess) )
213import GnuPGAgent as Agent 213import GnuPGAgent as Agent
214import Types
215import PacketTranscoder
214 216
215-- DER-encoded elliptic curve ids 217-- DER-encoded elliptic curve ids
216-- nistp256_id = 0x2a8648ce3d030107 218-- nistp256_id = 0x2a8648ce3d030107
@@ -247,114 +249,6 @@ home = HomeDir
247 , optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"] 249 , optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"]
248 } 250 }
249 251
250data InputFile = HomeSec
251 -- ^ A file named secring.gpg located in the home directory.
252 -- See 'opHome'.
253 | HomePub
254 -- ^ A file named pubring.gpg located in the home directory.
255 -- See 'opHome'.
256 | ArgFile FilePath
257 -- ^ Contents will be read or written from the specified path.
258 | FileDesc Posix.Fd
259 -- ^ Contents will be read or written from the specified file
260 -- descriptor.
261 | Pipe Posix.Fd Posix.Fd
262 -- ^ Contents will be read from the first descriptor and updated
263 -- content will be writen to the second. Note: Don't use Pipe
264 -- for 'Wallet' files. (TODO: Wallet support)
265 | Generate Int GenerateKeyParams
266 -- ^ New key packets will be generated if there is no
267 -- matching content already in the key pool. The integer is
268 -- a unique id number so that multiple generations can be
269 -- inserted into 'opFiles'
270 deriving (Eq,Ord,Show)
271
272-- type UsageTag = String
273data Initializer = NoCreate | Internal GenerateKeyParams | External String
274 deriving (Eq,Ord,Show)
275
276data FileType = KeyRingFile
277 | PEMFile
278 | WalletFile
279 | DNSPresentation
280 | Hosts
281 deriving (Eq,Ord,Enum,Show)
282
283-- | Use this type to indicate whether a file of type 'KeyRingFile' is expected
284-- to contain secret or public PGP key packets. Note that it is not supported
285-- to mix both in the same file and that the secret key packets include all of
286-- the information contained in their corresponding public key packets.
287data Access = AutoAccess -- ^ secret or public as appropriate based on existing content.
288 -- (see 'rtRingAccess')
289 | Sec -- ^ secret information
290 | Pub -- ^ public information
291 deriving (Eq,Ord,Show)
292
293-- | Note that the documentation here is intended for when this value is
294-- assigned to 'fill'. For other usage, see 'spill'.
295data KeyFilter = KF_None -- ^ No keys will be imported.
296 | KF_Match String -- ^ Only the key that matches the spec will be imported.
297 | KF_Subkeys -- ^ Subkeys will be imported if their owner key is
298 -- already in the ring. TODO: Even if their signatures
299 -- are bad?
300 | KF_Authentic -- ^ Keys are imported if they belong to an authenticated
301 -- identity (signed or self-authenticating).
302 | KF_All -- ^ All keys will be imported.
303 deriving (Eq,Ord,Show)
304
305-- | This type describes how 'runKeyRing' will treat a file.
306data StreamInfo = StreamInfo
307 { access :: Access
308 -- ^ Indicates whether the file is allowed to contain secret information.
309 , typ :: FileType
310 -- ^ Indicates the format and content type of the file.
311 , fill :: KeyFilter
312 -- ^ This filter controls what packets will be inserted into a file.
313 , spill :: KeyFilter
314 --
315 -- ^ Use this to indicate whether or not a file's contents should be
316 -- available for updating other files. Note that although its type is
317 -- 'KeyFilter', it is usually interpretted as a boolean flag. Details
318 -- depend on 'typ' and are as follows:
319 --
320 -- 'KeyRingFile':
321 --
322 -- * 'KF_None' - The file's contents will not be shared.
323 --
324 -- * otherwise - The file's contents will be shared.
325 --
326 -- 'PEMFile':
327 --
328 -- * 'KF_None' - The file's contents will not be shared.
329 --
330 -- * 'KF_Match' - The file's key will be shared with the specified owner
331 -- key and usage tag. If 'fill' is also a 'KF_Match', then it must be
332 -- equal to this value; changing the usage or owner of a key is not
333 -- supported via the fill/spill mechanism.
334 --
335 -- * otherwise - Unspecified. Do not use.
336 --
337 -- 'WalletFile':
338 --
339 -- * The 'spill' setting is ignored and the file's contents are shared.
340 -- (TODO)
341 --
342 -- 'Hosts':
343 --
344 -- * The 'spill' setting is ignored and the file's contents are shared.
345 -- (TODO)
346 --
347 , initializer :: Initializer
348 -- ^ If 'typ' is 'PEMFile' and an 'External' 'initializer' string is set,
349 -- then it is interpretted as a shell command that may be used to create
350 -- the key if it does not exist.
351 , transforms :: [Transform]
352 -- ^ Per-file transformations that occur before the contents of a file are
353 -- spilled into the common pool.
354 }
355 deriving (Eq,Show)
356
357
358spillable :: StreamInfo -> Bool 252spillable :: StreamInfo -> Bool
359spillable (spill -> KF_None) = False 253spillable (spill -> KF_None) = False
360spillable _ = True 254spillable _ = True
@@ -387,10 +281,6 @@ usageFromFilter (KF_Match usage) = return usage
387usageFromFilter _ = mzero 281usageFromFilter _ = mzero
388 282
389 283
390type PacketTranscoder = (SymmetricAlgorithm,S2K) -> MappedPacket -> IO (KikiCondition Packet)
391
392type PacketDecrypter = MappedPacket -> IO (KikiCondition Packet)
393
394data KeyRingRuntime = KeyRingRuntime 284data KeyRingRuntime = KeyRingRuntime
395 { rtPubring :: FilePath 285 { rtPubring :: FilePath
396 -- ^ Path to the file represented by 'HomePub' 286 -- ^ Path to the file represented by 'HomePub'
@@ -418,84 +308,6 @@ data KeyRingRuntime = KeyRingRuntime
418data PacketUpdate = InducerSignature String [SignatureSubpacket] 308data PacketUpdate = InducerSignature String [SignatureSubpacket]
419 | SubKeyDeletion KeyKey KeyKey 309 | SubKeyDeletion KeyKey KeyKey
420 310
421-- | This type is used to indicate where to obtain passphrases.
422data PassphraseSpec = PassphraseSpec
423 { passSpecRingFile :: Maybe FilePath
424 -- ^ If not Nothing, the passphrase is to be used for packets
425 -- from this file.
426 , passSpecKeySpec :: Maybe String
427 -- ^ Non-Nothing value reserved for future use.
428 -- (TODO: Use this to implement per-key passphrase associations).
429 , passSpecPassFile :: InputFile
430 -- ^ The passphrase will be read from this file or file descriptor.
431 }
432 -- | Use this to carry pasphrases from a previous run.
433 | PassphraseMemoizer PacketTranscoder
434 | PassphraseAgent
435
436instance Show PassphraseSpec where
437 show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c)
438 show (PassphraseMemoizer _) = "PassphraseMemoizer"
439instance Eq PassphraseSpec where
440 PassphraseSpec a b c == PassphraseSpec d e f
441 = and [a==d,b==e,c==f]
442 _ == _
443 = False
444
445
446
447data Transform =
448 Autosign
449 -- ^ This operation will make signatures for any tor-style UID
450 -- that matches a tor subkey and thus can be authenticated without
451 -- requring the judgement of a human user.
452 --
453 -- A tor-style UID is one of the following form:
454 --
455 -- > Anonymous <root@HOSTNAME.onion>
456 | DeleteSubkeyByFingerprint String
457 -- ^ Delete the subkey specified by the given fingerprint and any
458 -- associated signatures on that key.
459 | DeleteSubkeyByUsage String
460 -- ^ Delete the subkey specified by the given fingerprint and any
461 -- associated signatures on that key.
462 deriving (Eq,Ord,Show)
463
464-- | This type describes an idempotent transformation (merge or import) on a
465-- set of GnuPG keyrings and other key files.
466data KeyRingOperation = KeyRingOperation
467 { opFiles :: Map.Map InputFile StreamInfo
468 -- ^ Indicates files to be read or updated.
469 , opPassphrases :: [PassphraseSpec]
470 -- ^ Indicates files or file descriptors where passphrases can be found.
471 , opTransforms :: [Transform]
472 -- ^ Transformations to be performed on the key pool after all files have
473 -- been read and before any have been written.
474 , opHome :: Maybe FilePath
475 -- ^ If provided, this is the directory where the 'HomeSec' and 'HomePub'
476 -- files reside. Otherwise, the evironment variable $GNUPGHOME is consulted
477 -- and if that is not set, it falls back to $HOME/.gnupg.
478 }
479 deriving (Eq,Show)
480
481resolveInputFile :: InputFileContext -> InputFile -> [FilePath]
482resolveInputFile ctx = resolve
483 where
484 resolve HomeSec = return (homesecPath ctx)
485 resolve HomePub = return (homepubPath ctx)
486 resolve (ArgFile f) = return f
487 resolve _ = []
488
489resolveForReport :: Maybe InputFileContext -> InputFile -> FilePath
490resolveForReport mctx (Pipe fdr fdw) = resolveForReport mctx (ArgFile str)
491 where str = case (fdr,fdw) of
492 (0,1) -> "-"
493 _ -> "&pipe" ++ show (fdr,fdw)
494resolveForReport mctx (FileDesc fd) = resolveForReport mctx (ArgFile str)
495 where str = "&" ++ show fd
496resolveForReport mctx f = concat $ resolveInputFile ctx f
497 where ctx = fromMaybe (InputFileContext "&secret" "&public") mctx
498
499filesToLock :: 311filesToLock ::
500 KeyRingOperation -> InputFileContext -> [FilePath] 312 KeyRingOperation -> InputFileContext -> [FilePath]
501filesToLock k ctx = do 313filesToLock k ctx = do
@@ -635,33 +447,6 @@ instance ASN1Object RSAPrivateKey where
635 447
636 448
637 449
638-- | This type is used to indicate success or failure
639-- and in the case of success, return the computed object.
640-- The 'FunctorToMaybe' class is implemented to facilitate
641-- branching on failture.
642data KikiCondition a = KikiSuccess a
643 | FailedToLock [FilePath]
644 | BadPassphrase
645 | FailedToMakeSignature
646 | CantFindHome
647 | AmbiguousKeySpec FilePath
648 | CannotImportMasterKey
649 | NoWorkingKey
650 deriving ( Functor, Show )
651
652instance FunctorToMaybe KikiCondition where
653 functorToMaybe (KikiSuccess a) = Just a
654 functorToMaybe _ = Nothing
655
656instance Applicative KikiCondition where
657 pure a = KikiSuccess a
658 f <*> a =
659 case functorToEither f of
660 Right f -> case functorToEither a of
661 Right a -> pure (f a)
662 Left err -> err
663 Left err -> err
664
665-- | This type is used to describe events triggered by 'runKeyRing'. In 450-- | This type is used to describe events triggered by 'runKeyRing'. In
666-- addition to normal feedback (e.g. 'NewPacket'), it also may indicate 451-- addition to normal feedback (e.g. 'NewPacket'), it also may indicate
667-- non-fatal IO exceptions (e.g. 'FailedExternal'). Because a 452-- non-fatal IO exceptions (e.g. 'FailedExternal'). Because a
@@ -1349,18 +1134,6 @@ seek_key (KeyUidMatch pat) ps
1349 uidStr _ = "" 1134 uidStr _ = ""
1350 1135
1351 1136
1352data InputFileContext = InputFileContext
1353 { homesecPath :: FilePath
1354 , homepubPath :: FilePath
1355 }
1356
1357readInputFileS :: InputFileContext -> InputFile -> IO S.ByteString
1358readInputFileS ctx (Pipe fd _) = fdToHandle fd >>= S.hGetContents
1359readInputFileS ctx (FileDesc fd) = fdToHandle fd >>= S.hGetContents
1360readInputFileS ctx inp = do
1361 let fname = resolveInputFile ctx inp
1362 fmap S.concat $ mapM S.readFile fname
1363
1364readInputFileL :: InputFileContext -> InputFile -> IO L.ByteString 1137readInputFileL :: InputFileContext -> InputFile -> IO L.ByteString
1365readInputFileL ctx (Pipe fd _) = fdToHandle fd >>= L.hGetContents 1138readInputFileL ctx (Pipe fd _) = fdToHandle fd >>= L.hGetContents
1366readInputFileL ctx (FileDesc fd) = fdToHandle fd >>= L.hGetContents 1139readInputFileL ctx (FileDesc fd) = fdToHandle fd >>= L.hGetContents
@@ -1436,27 +1209,6 @@ doesInputFileExist ctx f = do
1436-} 1209-}
1437 1210
1438 1211
1439-- | Reads contents of an 'InputFile' or returns the cached content from a prior call.
1440-- An optional prompt is provided and will be printed on stdout only in the case that
1441-- the provided 'InputFile' is 'FileDesc' 0 (i.e. stdin).
1442cachedContents :: Maybe S.ByteString -> InputFileContext -> InputFile -> IO (IO S.ByteString)
1443cachedContents maybePrompt ctx fd = do
1444 ref <- newIORef Nothing
1445 return $ get maybePrompt ref fd
1446 where
1447 trimCR bs = fst $ S.spanEnd (\x -> x==10 || x==13) bs
1448
1449 get maybePrompt ref fd = do
1450 pw <- readIORef ref
1451 flip (flip maybe return) pw $ do
1452 if fd == FileDesc 0 then case maybePrompt of
1453 Just prompt -> S.hPutStr stderr prompt
1454 Nothing -> return ()
1455 else return ()
1456 pw <- fmap trimCR $ readInputFileS ctx fd
1457 writeIORef ref (Just pw)
1458 return pw
1459
1460generateSubkey :: 1212generateSubkey ::
1461 PacketTranscoder 1213 PacketTranscoder
1462 -> KikiCondition (KeyData, [(FilePath, KikiReportAction)]) -- db 1214 -> KikiCondition (KeyData, [(FilePath, KikiReportAction)]) -- db
@@ -2589,115 +2341,6 @@ writePEMKeys doDecrypt db exports = do
2589 try pun $ \pun -> do 2341 try pun $ \pun -> do
2590 return $ KikiSuccess (fname,stream,pun) 2342 return $ KikiSuccess (fname,stream,pun)
2591 2343
2592makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext
2593 -> Map.Map KeyKey (OriginMapped Query)
2594 -> IO PacketTranscoder
2595makeMemoizingDecrypter operation ctx keys = do
2596 if null chains then do
2597 -- (*) Notice we do not pass ctx to resolveForReport.
2598 -- This is because the merge function does not currently use a context
2599 -- and the pws map keys must match the MappedPacket locations.
2600 -- TODO: Perhaps these should both be of type InputFile rather than
2601 -- FilePath?
2602 -- pws :: Map.Map FilePath (IO S.ByteString)
2603 {-
2604 -- This disabled code obtained password sources from StreamInfo records.
2605 pws <-
2606 Traversable.mapM (cachedContents ctx . fromJust . pwfile . typ)
2607 (Map.mapKeys (resolveForReport Nothing) -- see note (*) note above
2608 $ Map.filter (isJust . pwfile . typ) $ opFiles operation)
2609 -}
2610 let prompt = Just "Enter possibly multi-line passphrase (Press CTRL-D when finished):\n"
2611 -- List of file-specific password sources.
2612 pws2 <-
2613 Traversable.mapM (cachedContents prompt ctx)
2614 $ Map.fromList $ mapMaybe
2615 (\spec -> (,passSpecPassFile spec) `fmap` do
2616 guard $ isNothing $ passSpecKeySpec spec
2617 passSpecRingFile spec)
2618 passspecs
2619 -- List of general password sources.
2620 defpw <- do
2621 Traversable.mapM (cachedContents prompt ctx . passSpecPassFile)
2622 $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp)
2623 && isNothing (passSpecKeySpec sp))
2624 $ passspecs
2625 unkeysRef <- newIORef (Map.empty :: Map.Map KeyKey Packet)
2626 return $ doDecrypt unkeysRef ({- pws `Map.union` -} pws2) defpw (not $ null agentspec)
2627 else let PassphraseMemoizer f = head chains
2628 in return f
2629 where
2630 (chains,passspecs0) = partition isChain $ opPassphrases operation
2631 where isChain (PassphraseMemoizer {}) = True
2632 isChain _ = False
2633 (agentspec,passspecs) = partition isAgent $ opPassphrases operation
2634 where isAgent PassphraseAgent = True
2635 isAgent _ = False
2636 doDecrypt :: IORef (Map.Map KeyKey Packet)
2637 -> Map.Map FilePath (IO S.ByteString)
2638 -> Maybe (IO S.ByteString)
2639 -> Bool
2640 -> (SymmetricAlgorithm,S2K)
2641 -> MappedPacket
2642 -> IO (KikiCondition Packet)
2643 doDecrypt unkeysRef pws defpw agent_requested (dest_alg,dest_s2k) mp0 = do
2644 unkeys <- readIORef unkeysRef
2645 let (mp,qry) = fromMaybe (mp0,Query (packet mp0) "anonymous2" Nothing) $ do
2646 k <- Map.lookup kk keys
2647 return (mergeKeyPacket "decrypt" mp0 (fmap queryPacket k), packet k)
2648 wk = packet mp0
2649 kk = keykey wk
2650 fs = Map.keys $ locations mp
2651
2652 decryptIt [] = return BadPassphrase
2653 decryptIt (getpw:getpws) = tries 1 getpw (decryptIt getpws)
2654 where
2655 tries count getpw recurse = do
2656 -- TODO: This function should use mergeKeyPacket to
2657 -- combine the packet with it's unspilled version before
2658 -- attempting to decrypt it. Note: We are uninterested
2659 -- in the 'locations' field, so this would effectively
2660 -- allow you to run 'decryptIt' on an unencrypted public key
2661 -- to obtain it's secret key.
2662 (pw,wants_retry) <- getpw (if count>1 then AskAgain "Bad pasphrase." else Ask,qry)
2663 let wkun = fromMaybe wk $ do
2664 guard $ symmetric_algorithm (packet mp) /= Unencrypted
2665 decryptSecretKey pw (packet mp)
2666
2667 case symmetric_algorithm wkun of
2668
2669 Unencrypted -> do
2670 writeIORef unkeysRef (Map.insert kk wkun unkeys)
2671 ek <- if dest_alg==Unencrypted
2672 then return $ Just wkun
2673 else encryptSecretKey pw dest_s2k dest_alg wkun
2674 case ek of
2675 Nothing | wants_retry && count<3 -> tries (count+1) getpw recurse
2676 Nothing -> recurse
2677 Just wken -> return $ KikiSuccess wken
2678
2679 _ -> recurse
2680
2681 getpws = (map (const . fmap (,False)) $ mapMaybe (`Map.lookup` pws) fs ++ maybeToList defpw) ++ [ agentpw | agent_requested ]
2682
2683 agentpw (ask,qry) = do
2684 s <- session
2685 fromMaybe (return ("",False)) $ do
2686 s <- s
2687 Just $ do
2688 case ask of AskAgain _ -> clearPassphrase s (queryPacket qry)
2689 _ -> return ()
2690 mbpw <- getPassphrase s ask qry
2691 quit s
2692 return ( maybe "" S8.pack mbpw, True)
2693
2694 if symmetric_algorithm wk == dest_alg
2695 && ( symmetric_algorithm wk == Unencrypted || s2k wk == dest_s2k )
2696 then return (KikiSuccess wk)
2697 else maybe (decryptIt getpws)
2698 (return . KikiSuccess)
2699 $ Map.lookup kk unkeys
2700
2701performManipulations :: 2344performManipulations ::
2702 (PacketDecrypter) 2345 (PacketDecrypter)
2703 -> KeyRingRuntime 2346 -> KeyRingRuntime
@@ -3162,19 +2805,6 @@ lookupEnv var =
3162 handleIO_ (return Nothing) $ fmap Just (getEnv var) 2805 handleIO_ (return Nothing) $ fmap Just (getEnv var)
3163#endif 2806#endif
3164 2807
3165isKey :: Packet -> Bool
3166isKey (PublicKeyPacket {}) = True
3167isKey (SecretKeyPacket {}) = True
3168isKey _ = False
3169
3170isUserID :: Packet -> Bool
3171isUserID (UserIDPacket {}) = True
3172isUserID _ = False
3173
3174isTrust :: Packet -> Bool
3175isTrust (TrustPacket {}) = True
3176isTrust _ = False
3177
3178sigpackets :: 2808sigpackets ::
3179 Monad m => 2809 Monad m =>
3180 Word8 -> [SignatureSubpacket] -> [SignatureSubpacket] -> m Packet 2810 Word8 -> [SignatureSubpacket] -> [SignatureSubpacket] -> m Packet
@@ -3497,32 +3127,10 @@ makeSig doDecrypt top fname subkey_p tags mbsig = do
3497 return $ fmap (,[]) newsig 3127 return $ fmap (,[]) newsig
3498 3128
3499 3129
3500-- | The position and acces a packet had before the operation
3501data OriginFlags = OriginFlags
3502 { originallyPublic :: Bool
3503 -- ^ false if SecretKeyPacket
3504 , originalNum :: Int
3505 -- ^ packets are numbered, starting from 1..
3506 } deriving Show
3507
3508type OriginMap = Map.Map FilePath OriginFlags
3509
3510type MappedPacket = OriginMapped Packet
3511data OriginMapped a = MappedPacket
3512 { packet :: a
3513 , locations :: OriginMap
3514 } deriving Show
3515instance Functor OriginMapped where
3516 fmap f (MappedPacket x ls) = MappedPacket (f x) ls
3517
3518type TrustMap = Map.Map FilePath Packet 3130type TrustMap = Map.Map FilePath Packet
3519type SigAndTrust = ( MappedPacket 3131type SigAndTrust = ( MappedPacket
3520 , TrustMap ) -- trust packets 3132 , TrustMap ) -- trust packets
3521 3133
3522-- | The 'KeyKey'-type is used to store the information of a key
3523-- which is used for finger-printing
3524type KeyKey = [ByteString]
3525
3526data SubKey = SubKey MappedPacket [SigAndTrust] deriving Show 3134data SubKey = SubKey MappedPacket [SigAndTrust] deriving Show
3527 3135
3528-- | This is a GPG Identity which includes a master key and all its UIDs and 3136-- | This is a GPG Identity which includes a master key and all its UIDs and
@@ -3554,15 +3162,6 @@ mappedPacketWithHint filename p hint = MappedPacket
3554 , locations = Map.singleton filename (origin p hint) 3162 , locations = Map.singleton filename (origin p hint)
3555 } 3163 }
3556 3164
3557keykey :: Packet -> KeyKey
3558keykey key =
3559 -- Note: The key's timestamp is normally included in it's fingerprint.
3560 -- This is undesirable for kiki because it causes the same
3561 -- key to be imported multiple times and show as apparently
3562 -- distinct keys with different fingerprints.
3563 -- Thus, we will remove the timestamp.
3564 fingerprint_material (key {timestamp=0}) -- TODO: smaller key?
3565
3566uidkey :: Packet -> String 3165uidkey :: Packet -> String
3567uidkey (UserIDPacket str) = str 3166uidkey (UserIDPacket str) = str
3568 3167
@@ -3598,29 +3197,6 @@ onionName kd = (addr,name)
3598 (addr,(name:_,_)) = getHostnames kd 3197 (addr,(name:_,_)) = getHostnames kd
3599-} 3198-}
3600 3199
3601-- | Compare different versions if the same key pair. Public versions
3602-- are considered greater. If the two packets do not represent the same
3603-- key or the packets are not keys at all, an error will result that
3604-- includes the context provided as the first argument.
3605keyCompare :: String -> Packet -> Packet -> Ordering
3606keyCompare what (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
3607keyCompare what (PublicKeyPacket {}) (SecretKeyPacket {}) = GT
3608keyCompare what a b | keykey a==keykey b = EQ
3609keyCompare what a b = error $ unlines ["Unable to merge "++what++":"
3610 , if isKey a then fingerprint a else ""
3611 , PP.ppShow a
3612 , if isKey b then fingerprint b else ""
3613 , PP.ppShow b
3614 ]
3615
3616-- | Merge two representations of the same key, prefering secret version
3617-- because they have more information.
3618mergeKeyPacket :: String -> MappedPacket -> MappedPacket -> MappedPacket
3619mergeKeyPacket what key p =
3620 key { packet = minimumBy (keyCompare what) [packet key,packet p]
3621 , locations = Map.union (locations key) (locations p)
3622 }
3623
3624 3200
3625merge_ :: KeyDB -> FilePath -> [(Packet,Packet,(Packet,Map.Map FilePath Packet))] 3201merge_ :: KeyDB -> FilePath -> [(Packet,Packet,(Packet,Map.Map FilePath Packet))]
3626 -> KeyDB 3202 -> KeyDB
diff --git a/lib/PacketTranscoder.hs b/lib/PacketTranscoder.hs
new file mode 100644
index 0000000..651b00c
--- /dev/null
+++ b/lib/PacketTranscoder.hs
@@ -0,0 +1,204 @@
1{-# LANGUAGE TupleSections #-}
2{-# LANGUAGE OverloadedStrings #-}
3module PacketTranscoder where
4
5import Control.Monad
6import Data.IORef
7import Data.List
8import Data.Maybe
9import Data.OpenPGP
10import Data.OpenPGP.Util
11import GnuPGAgent
12import qualified Data.ByteString as S
13import qualified Data.ByteString.Char8 as S8
14import qualified Data.Map as Map
15import qualified Data.Traversable as Traversable
16import System.IO ( stderr)
17import System.Posix.IO ( fdToHandle )
18import Text.Show.Pretty as PP ( ppShow )
19import Types
20
21-- | Merge two representations of the same key, prefering secret version
22-- because they have more information.
23mergeKeyPacket :: String -> MappedPacket -> MappedPacket -> MappedPacket
24mergeKeyPacket what key p =
25 key { packet = minimumBy (keyCompare what) [packet key,packet p]
26 , locations = Map.union (locations key) (locations p)
27 }
28
29-- | Compare different versions if the same key pair. Public versions
30-- are considered greater. If the two packets do not represent the same
31-- key or the packets are not keys at all, an error will result that
32-- includes the context provided as the first argument.
33keyCompare :: String -> Packet -> Packet -> Ordering
34keyCompare what (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
35keyCompare what (PublicKeyPacket {}) (SecretKeyPacket {}) = GT
36keyCompare what a b | keykey a==keykey b = EQ
37keyCompare what a b = error $ unlines ["Unable to merge "++what++":"
38 , if isKey a then fingerprint a else ""
39 , PP.ppShow a
40 , if isKey b then fingerprint b else ""
41 , PP.ppShow b
42 ]
43
44resolveInputFile :: InputFileContext -> InputFile -> [FilePath]
45resolveInputFile ctx = resolve
46 where
47 resolve HomeSec = return (homesecPath ctx)
48 resolve HomePub = return (homepubPath ctx)
49 resolve (ArgFile f) = return f
50 resolve _ = []
51
52resolveForReport :: Maybe InputFileContext -> InputFile -> FilePath
53resolveForReport mctx (Pipe fdr fdw) = resolveForReport mctx (ArgFile str)
54 where str = case (fdr,fdw) of
55 (0,1) -> "-"
56 _ -> "&pipe" ++ show (fdr,fdw)
57resolveForReport mctx (FileDesc fd) = resolveForReport mctx (ArgFile str)
58 where str = "&" ++ show fd
59resolveForReport mctx f = concat $ resolveInputFile ctx f
60 where ctx = fromMaybe (InputFileContext "&secret" "&public") mctx
61
62readInputFileS :: InputFileContext -> InputFile -> IO S.ByteString
63readInputFileS ctx (Pipe fd _) = fdToHandle fd >>= S.hGetContents
64readInputFileS ctx (FileDesc fd) = fdToHandle fd >>= S.hGetContents
65readInputFileS ctx inp = do
66 let fname = resolveInputFile ctx inp
67 fmap S.concat $ mapM S.readFile fname
68
69
70
71-- | Reads contents of an 'InputFile' or returns the cached content from a prior call.
72-- An optional prompt is provided and will be printed on stdout only in the case that
73-- the provided 'InputFile' is 'FileDesc' 0 (i.e. stdin).
74cachedContents :: Maybe S.ByteString -> InputFileContext -> InputFile -> IO (IO S.ByteString)
75cachedContents maybePrompt ctx fd = do
76 ref <- newIORef Nothing
77 return $ get maybePrompt ref fd
78 where
79 trimCR bs = fst $ S.spanEnd (\x -> x==10 || x==13) bs
80
81 get maybePrompt ref fd = do
82 pw <- readIORef ref
83 flip (flip maybe return) pw $ do
84 if fd == FileDesc 0 then case maybePrompt of
85 Just prompt -> S.hPutStr stderr prompt
86 Nothing -> return ()
87 else return ()
88 pw <- fmap trimCR $ readInputFileS ctx fd
89 writeIORef ref (Just pw)
90 return pw
91
92
93
94makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext
95 -> Map.Map KeyKey (OriginMapped Query)
96 -> IO PacketTranscoder
97makeMemoizingDecrypter operation ctx keys = do
98 if null chains then do
99 -- (*) Notice we do not pass ctx to resolveForReport.
100 -- This is because the merge function does not currently use a context
101 -- and the pws map keys must match the MappedPacket locations.
102 -- TODO: Perhaps these should both be of type InputFile rather than
103 -- FilePath?
104 -- pws :: Map.Map FilePath (IO S.ByteString)
105 {-
106 -- This disabled code obtained password sources from StreamInfo records.
107 pws <-
108 Traversable.mapM (cachedContents ctx . fromJust . pwfile . typ)
109 (Map.mapKeys (resolveForReport Nothing) -- see note (*) note above
110 $ Map.filter (isJust . pwfile . typ) $ opFiles operation)
111 -}
112 let prompt = Just "Enter possibly multi-line passphrase (Press CTRL-D when finished):\n"
113 -- List of file-specific password sources.
114 pws2 <-
115 Traversable.mapM (cachedContents prompt ctx)
116 $ Map.fromList $ mapMaybe
117 (\spec -> (,passSpecPassFile spec) `fmap` do
118 guard $ isNothing $ passSpecKeySpec spec
119 passSpecRingFile spec)
120 passspecs
121 -- List of general password sources.
122 defpw <- do
123 Traversable.mapM (cachedContents prompt ctx . passSpecPassFile)
124 $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp)
125 && isNothing (passSpecKeySpec sp))
126 $ passspecs
127 unkeysRef <- newIORef (Map.empty :: Map.Map KeyKey Packet)
128 return $ doDecrypt unkeysRef ({- pws `Map.union` -} pws2) defpw (not $ null agentspec)
129 else let PassphraseMemoizer f = head chains
130 in return f
131 where
132 (chains,passspecs0) = partition isChain $ opPassphrases operation
133 where isChain (PassphraseMemoizer {}) = True
134 isChain _ = False
135 (agentspec,passspecs) = partition isAgent passspecs0
136 where isAgent PassphraseAgent = True
137 isAgent _ = False
138 doDecrypt :: IORef (Map.Map KeyKey Packet)
139 -> Map.Map FilePath (IO S.ByteString)
140 -> Maybe (IO S.ByteString)
141 -> Bool
142 -> (SymmetricAlgorithm,S2K)
143 -> MappedPacket
144 -> IO (KikiCondition Packet)
145 doDecrypt unkeysRef pws defpw agent_requested (dest_alg,dest_s2k) mp0 = do
146 unkeys <- readIORef unkeysRef
147 let (mp,qry) = fromMaybe (mp0,Query (packet mp0) "anonymous2" Nothing) $ do
148 k <- Map.lookup kk keys
149 return (mergeKeyPacket "decrypt" mp0 (fmap queryPacket k), packet k)
150 wk = packet mp0
151 kk = keykey wk
152 fs = Map.keys $ locations mp
153
154 decryptIt [] = return BadPassphrase
155 decryptIt (getpw:getpws) = tries 1 getpw (decryptIt getpws)
156 where
157 tries count getpw recurse = do
158 -- TODO: This function should use mergeKeyPacket to
159 -- combine the packet with it's unspilled version before
160 -- attempting to decrypt it. Note: We are uninterested
161 -- in the 'locations' field, so this would effectively
162 -- allow you to run 'decryptIt' on an unencrypted public key
163 -- to obtain it's secret key.
164 (pw,wants_retry) <- getpw (if count>1 then AskAgain "Bad pasphrase." else Ask,qry)
165 let wkun = fromMaybe wk $ do
166 guard $ symmetric_algorithm (packet mp) /= Unencrypted
167 decryptSecretKey pw (packet mp)
168
169 case symmetric_algorithm wkun of
170
171 Unencrypted -> do
172 writeIORef unkeysRef (Map.insert kk wkun unkeys)
173 ek <- if dest_alg==Unencrypted
174 then return $ Just wkun
175 else encryptSecretKey pw dest_s2k dest_alg wkun
176 case ek of
177 Nothing | wants_retry && count<3 -> tries (count+1) getpw recurse
178 Nothing -> recurse
179 Just wken -> return $ KikiSuccess wken
180
181 _ -> recurse
182
183 getpws = (map (const . fmap (,False)) $ mapMaybe (`Map.lookup` pws) fs ++ maybeToList defpw) ++ [ agentpw | agent_requested ]
184
185 -- TODO: First we should try the master key with AskNot.
186 -- If that fails, we should try the subkey.
187 agentpw (ask,qry) = do
188 s <- session
189 fromMaybe (return ("",False)) $ do
190 s <- s
191 Just $ do
192 case ask of AskAgain _ -> clearPassphrase s (queryPacket qry)
193 _ -> return ()
194 mbpw <- getPassphrase s ask qry
195 quit s
196 return ( maybe "" S8.pack mbpw, True)
197
198 if symmetric_algorithm wk == dest_alg
199 && ( symmetric_algorithm wk == Unencrypted || s2k wk == dest_s2k )
200 then return (KikiSuccess wk)
201 else maybe (decryptIt getpws)
202 (return . KikiSuccess)
203 $ Map.lookup kk unkeys
204
diff --git a/lib/Types.hs b/lib/Types.hs
new file mode 100644
index 0000000..9aa0340
--- /dev/null
+++ b/lib/Types.hs
@@ -0,0 +1,263 @@
1{-# LANGUAGE DeriveFunctor #-}
2module Types where
3
4import Data.Map as Map (Map)
5import Data.OpenPGP
6import Data.OpenPGP.Util
7import FunctorToMaybe
8import qualified System.Posix.Types as Posix
9import qualified Data.ByteString.Lazy as L
10
11-- | This type describes an idempotent transformation (merge or import) on a
12-- set of GnuPG keyrings and other key files.
13data KeyRingOperation = KeyRingOperation
14 { opFiles :: Map InputFile StreamInfo
15 -- ^ Indicates files to be read or updated.
16 , opPassphrases :: [PassphraseSpec]
17 -- ^ Indicates files or file descriptors where passphrases can be found.
18 , opTransforms :: [Transform]
19 -- ^ Transformations to be performed on the key pool after all files have
20 -- been read and before any have been written.
21 , opHome :: Maybe FilePath
22 -- ^ If provided, this is the directory where the 'HomeSec' and 'HomePub'
23 -- files reside. Otherwise, the evironment variable $GNUPGHOME is consulted
24 -- and if that is not set, it falls back to $HOME/.gnupg.
25 }
26 deriving (Eq,Show)
27
28data InputFile = HomeSec
29 -- ^ A file named secring.gpg located in the home directory.
30 -- See 'opHome'.
31 | HomePub
32 -- ^ A file named pubring.gpg located in the home directory.
33 -- See 'opHome'.
34 | ArgFile FilePath
35 -- ^ Contents will be read or written from the specified path.
36 | FileDesc Posix.Fd
37 -- ^ Contents will be read or written from the specified file
38 -- descriptor.
39 | Pipe Posix.Fd Posix.Fd
40 -- ^ Contents will be read from the first descriptor and updated
41 -- content will be writen to the second. Note: Don't use Pipe
42 -- for 'Wallet' files. (TODO: Wallet support)
43 | Generate Int GenerateKeyParams
44 -- ^ New key packets will be generated if there is no
45 -- matching content already in the key pool. The integer is
46 -- a unique id number so that multiple generations can be
47 -- inserted into 'opFiles'
48 deriving (Eq,Ord,Show)
49
50-- | This type describes how 'runKeyRing' will treat a file.
51data StreamInfo = StreamInfo
52 { access :: Access
53 -- ^ Indicates whether the file is allowed to contain secret information.
54 , typ :: FileType
55 -- ^ Indicates the format and content type of the file.
56 , fill :: KeyFilter
57 -- ^ This filter controls what packets will be inserted into a file.
58 , spill :: KeyFilter
59 --
60 -- ^ Use this to indicate whether or not a file's contents should be
61 -- available for updating other files. Note that although its type is
62 -- 'KeyFilter', it is usually interpretted as a boolean flag. Details
63 -- depend on 'typ' and are as follows:
64 --
65 -- 'KeyRingFile':
66 --
67 -- * 'KF_None' - The file's contents will not be shared.
68 --
69 -- * otherwise - The file's contents will be shared.
70 --
71 -- 'PEMFile':
72 --
73 -- * 'KF_None' - The file's contents will not be shared.
74 --
75 -- * 'KF_Match' - The file's key will be shared with the specified owner
76 -- key and usage tag. If 'fill' is also a 'KF_Match', then it must be
77 -- equal to this value; changing the usage or owner of a key is not
78 -- supported via the fill/spill mechanism.
79 --
80 -- * otherwise - Unspecified. Do not use.
81 --
82 -- 'WalletFile':
83 --
84 -- * The 'spill' setting is ignored and the file's contents are shared.
85 -- (TODO)
86 --
87 -- 'Hosts':
88 --
89 -- * The 'spill' setting is ignored and the file's contents are shared.
90 -- (TODO)
91 --
92 , initializer :: Initializer
93 -- ^ If 'typ' is 'PEMFile' and an 'External' 'initializer' string is set,
94 -- then it is interpretted as a shell command that may be used to create
95 -- the key if it does not exist.
96 , transforms :: [Transform]
97 -- ^ Per-file transformations that occur before the contents of a file are
98 -- spilled into the common pool.
99 }
100 deriving (Eq,Show)
101
102
103-- | This type is used to indicate where to obtain passphrases.
104data PassphraseSpec = PassphraseSpec
105 { passSpecRingFile :: Maybe FilePath
106 -- ^ If not Nothing, the passphrase is to be used for packets
107 -- from this file.
108 , passSpecKeySpec :: Maybe String
109 -- ^ Non-Nothing value reserved for future use.
110 -- (TODO: Use this to implement per-key passphrase associations).
111 , passSpecPassFile :: InputFile
112 -- ^ The passphrase will be read from this file or file descriptor.
113 }
114 -- | Use this to carry pasphrases from a previous run.
115 | PassphraseMemoizer PacketTranscoder
116 | PassphraseAgent
117
118instance Show PassphraseSpec where
119 show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c)
120 show (PassphraseMemoizer _) = "PassphraseMemoizer"
121instance Eq PassphraseSpec where
122 PassphraseSpec a b c == PassphraseSpec d e f
123 = and [a==d,b==e,c==f]
124 _ == _
125 = False
126
127
128
129data Transform =
130 Autosign
131 -- ^ This operation will make signatures for any tor-style UID
132 -- that matches a tor subkey and thus can be authenticated without
133 -- requring the judgement of a human user.
134 --
135 -- A tor-style UID is one of the following form:
136 --
137 -- > Anonymous <root@HOSTNAME.onion>
138 | DeleteSubkeyByFingerprint String
139 -- ^ Delete the subkey specified by the given fingerprint and any
140 -- associated signatures on that key.
141 | DeleteSubkeyByUsage String
142 -- ^ Delete the subkey specified by the given fingerprint and any
143 -- associated signatures on that key.
144 deriving (Eq,Ord,Show)
145
146-- | Use this type to indicate whether a file of type 'KeyRingFile' is expected
147-- to contain secret or public PGP key packets. Note that it is not supported
148-- to mix both in the same file and that the secret key packets include all of
149-- the information contained in their corresponding public key packets.
150data Access = AutoAccess -- ^ secret or public as appropriate based on existing content.
151 -- (see 'rtRingAccess')
152 | Sec -- ^ secret information
153 | Pub -- ^ public information
154 deriving (Eq,Ord,Show)
155
156data FileType = KeyRingFile
157 | PEMFile
158 | WalletFile
159 | DNSPresentation
160 | Hosts
161 deriving (Eq,Ord,Enum,Show)
162
163-- type UsageTag = String
164data Initializer = NoCreate | Internal GenerateKeyParams | External String
165 deriving (Eq,Ord,Show)
166
167
168
169type PacketTranscoder = (SymmetricAlgorithm,S2K) -> MappedPacket -> IO (KikiCondition Packet)
170type PacketDecrypter = MappedPacket -> IO (KikiCondition Packet)
171
172-- | Note that the documentation here is intended for when this value is
173-- assigned to 'fill'. For other usage, see 'spill'.
174data KeyFilter = KF_None -- ^ No keys will be imported.
175 | KF_Match String -- ^ Only the key that matches the spec will be imported.
176 | KF_Subkeys -- ^ Subkeys will be imported if their owner key is
177 -- already in the ring. TODO: Even if their signatures
178 -- are bad?
179 | KF_Authentic -- ^ Keys are imported if they belong to an authenticated
180 -- identity (signed or self-authenticating).
181 | KF_All -- ^ All keys will be imported.
182 deriving (Eq,Ord,Show)
183
184-- | The position and acces a packet had before the operation
185data OriginFlags = OriginFlags
186 { originallyPublic :: Bool
187 -- ^ false if SecretKeyPacket
188 , originalNum :: Int
189 -- ^ packets are numbered, starting from 1..
190 } deriving Show
191
192type OriginMap = Map FilePath OriginFlags
193
194type MappedPacket = OriginMapped Packet
195data OriginMapped a = MappedPacket
196 { packet :: a
197 , locations :: OriginMap
198 } deriving Show
199instance Functor OriginMapped where
200 fmap f (MappedPacket x ls) = MappedPacket (f x) ls
201
202-- | This type is used to indicate success or failure
203-- and in the case of success, return the computed object.
204-- The 'FunctorToMaybe' class is implemented to facilitate
205-- branching on failture.
206data KikiCondition a = KikiSuccess a
207 | FailedToLock [FilePath]
208 | BadPassphrase
209 | FailedToMakeSignature
210 | CantFindHome
211 | AmbiguousKeySpec FilePath
212 | CannotImportMasterKey
213 | NoWorkingKey
214 deriving ( Functor, Show )
215
216instance FunctorToMaybe KikiCondition where
217 functorToMaybe (KikiSuccess a) = Just a
218 functorToMaybe _ = Nothing
219
220instance Applicative KikiCondition where
221 pure a = KikiSuccess a
222 f <*> a =
223 case functorToEither f of
224 Right f -> case functorToEither a of
225 Right a -> pure (f a)
226 Left err -> err
227 Left err -> err
228
229data InputFileContext = InputFileContext
230 { homesecPath :: FilePath
231 , homepubPath :: FilePath
232 }
233
234
235-- | The 'KeyKey'-type is used to store the information of a key
236-- which is used for finger-printing and as a lookup key into
237-- maps. This type may be changed to an actual fingerprint in
238-- in the future.
239type KeyKey = [L.ByteString]
240
241keykey :: Packet -> KeyKey
242keykey key =
243 -- Note: The key's timestamp is normally included in it's fingerprint.
244 -- This is undesirable for kiki because it causes the same
245 -- key to be imported multiple times and show as apparently
246 -- distinct keys with different fingerprints.
247 -- Thus, we will remove the timestamp.
248 fingerprint_material (key {timestamp=0}) -- TODO: smaller key?
249
250isKey :: Packet -> Bool
251isKey (PublicKeyPacket {}) = True
252isKey (SecretKeyPacket {}) = True
253isKey _ = False
254
255isUserID :: Packet -> Bool
256isUserID (UserIDPacket {}) = True
257isUserID _ = False
258
259isTrust :: Packet -> Bool
260isTrust (TrustPacket {}) = True
261isTrust _ = False
262
263
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-01 10:12:19 +0000