From 67e72b1bcb9cf4a4d1bcfde6a3f87ed2dc2ff209 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 28 Apr 2014 17:41:00 -0400 Subject: changed kFiles to use StreamInfo as element type. --- KeyRing.hs | 91 +++++++++++++++++++++++++++----------------------------------- kiki.hs | 32 ++++++++++++++-------- 2 files changed, 60 insertions(+), 63 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index ac92b14..4e6c512 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -6,6 +6,8 @@ {-# LANGUAGE DoAndIfThenElse #-} module KeyRing ( runKeyRing + , StreamInfo(..) + , KeyFilter(..) , KeyRingOperation(..) , KikiResult(..) , KikiCondition(..) @@ -15,7 +17,6 @@ module KeyRing , KeyRingRuntime(..) , InputFile(..) , FileType(..) - , RefType(..) , importPublic , importSecret , subkeysOnly @@ -172,10 +173,10 @@ data Access = AutoAccess -- ^ secret or public as appropriate based on existing | Sec -- ^ secret information | Pub -- ^ public information +-- | TODO: Implement keyfilters other than KF_None and KF_All +-- This should make kImports obsolete. data KeyFilter = KF_None | KF_Match String | KF_Subkeys | KF_Authentic | KF_All --- | TODO: This should replace the element type of kFiles --- and kImports will be obsolete. data StreamInfo = StreamInfo { access :: Access , typ :: FileType @@ -183,22 +184,10 @@ data StreamInfo = StreamInfo , spill :: KeyFilter , initializer :: Maybe String } --- | RefType is perhaps not a good name for this... --- It is sort of like a read/write flag, although --- semantically, it is indicating the intention of --- an action and not just the access level of an --- object. -data RefType = ConstRef - -- ^ merge into database but do not update - | MutableRef (Maybe Initializer) - -- ^ sync into database - -- update dabase and also update file - -- Initializer is a shell command that creates - -- the file; eg, ssh-keygen - -isMutable :: RefType -> Bool -isMutable (MutableRef {}) = True -isMutable _ = False + +isMutable :: StreamInfo -> Bool +isMutable stream | KF_None <- fill stream = False +isMutable _ = True isring :: FileType -> Bool isring (KeyRingFile {}) = True @@ -212,10 +201,6 @@ iswallet :: FileType -> Bool iswallet (WalletFile {}) = True iswallet _ = False -rtyp_initializer :: RefType -> Maybe Initializer -rtyp_initializer (MutableRef x) = x -rtyp_initializer _ = Nothing - getUsage :: MonadPlus m => FileType -> m UsageTag getUsage (PEMFile usage) = return usage @@ -239,7 +224,7 @@ noManip :: KeyRingRuntime -> KeyData -> [PacketUpdate] noManip _ _ = [] data KeyRingOperation = KeyRingOperation - { kFiles :: Map.Map InputFile (RefType,FileType) + { kFiles :: Map.Map InputFile StreamInfo , kImports :: Map.Map InputFile (KeyRingRuntime -> KeyData -> Maybe Bool) -- ^ -- Indicates what pgp master keys get written to which keyring files. @@ -265,10 +250,10 @@ resolveInputFile secring pubring = resolve filesToLock :: KeyRingOperation -> FilePath -> FilePath -> [FilePath] filesToLock k secring pubring = do - (f,(rtyp,ftyp)) <- Map.toList (kFiles k) - case rtyp of - ConstRef -> [] - MutableRef {} -> resolveInputFile secring pubring f + (f,stream) <- Map.toList (kFiles k) + case fill stream of + KF_None -> [] + _ -> resolveInputFile secring pubring f -- kret :: a -> KeyRingOperation a @@ -860,8 +845,8 @@ mergeHostFiles krd db secring pubring = do ishosts Hosts = True ishosts _ = False files istyp = do - (f,(rtyp,ftyp)) <- Map.toList (kFiles krd) - guard (istyp ftyp) + (f,stream) <- Map.toList (kFiles krd) + guard (istyp $ typ stream) resolveInputFile secring pubring f hostdbs0 <- mapM (fmap Hosts.decode . L.readFile) hns @@ -915,11 +900,12 @@ writeHostsFiles -> IO [(FilePath, KikiReportAction)] writeHostsFiles krd secring pubring (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do let hns = files isMutableHosts - isMutableHosts (MutableRef _,Hosts) = True - isMutableHosts _ = False + isMutableHosts stream | KF_None <- fill stream = False + isMutableHosts stream | Hosts <- typ stream = True + isMutableHosts _ = False files istyp = do - (f,typ) <- Map.toList (kFiles krd) - guard (istyp typ) + (f,stream) <- Map.toList (kFiles krd) + guard (istyp stream) resolveInputFile secring pubring f -- 3. add hostnames from gpg for addresses not in U @@ -955,8 +941,8 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do let files isring = do - (f,(rtyp,ftyp)) <- Map.toList (kFiles keyring) - guard (isring ftyp) + (f,stream) <- Map.toList (kFiles keyring) + guard (isring $ typ stream) resolveInputFile secring pubring f readp n = fmap (n,) (readPacketsFromFile n) @@ -1007,12 +993,12 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do -- PEM files let pems = do - (n,(rtyp,ftyp)) <- Map.toList $ kFiles keyring + (n,stream) <- Map.toList $ kFiles keyring grip <- maybeToList grip - (topspec,subspec) <- fmap (parseSpec grip) $ getUsage ftyp + (topspec,subspec) <- fmap (parseSpec grip) $ getUsage (typ stream) n <- resolveInputFile secring pubring n let ms = map fst $ filterMatches topspec (Map.toList db) - cmd = rtyp_initializer rtyp + cmd = initializer stream return (n,subspec,ms,cmd) imports <- filterM (\(n,_,_,_) -> doesFileExist n) pems db <- foldM (importPEMKey doDecrypt) (KikiSuccess (db,[])) imports @@ -1238,11 +1224,12 @@ writeWalletKeys :: KeyRingOperation -> KeyDB -> Maybe Packet -> IO (KikiConditio writeWalletKeys krd db wk = do let cs = db `coinKeysOwnedBy` wk -- export wallet keys - isMutableWallet (MutableRef {}) (WalletFile {}) = True - isMutableWallet _ _ = False + isMutableWallet stream | KF_None <- fill stream = False + isMutableWallet stream | WalletFile {} <- typ stream = True + isMutableWallet _ = False files pred = do - (f,(rtyp,ftyp)) <- Map.toList (kFiles krd) - guard (pred rtyp ftyp) + (f,stream) <- Map.toList (kFiles krd) + guard (pred stream) resolveInputFile "" "" f let writeWallet report n = do let cs' = do @@ -1319,10 +1306,10 @@ writeRingKeys krd rt {- db wk secring pubring -} = do pubring = rtPubring rt let s = do (f,f0,mutable) <- do - (f0,(rtyp,ftyp)) <- Map.toList (kFiles krd) - guard (isring ftyp) + (f0,stream) <- Map.toList (kFiles krd) + guard (isring $ typ stream) f <- resolveInputFile secring pubring f0 - return (f,f0,isMutable rtyp) + return (f,f0,isMutable stream) let x = do let wanted kd@(KeyData p _ _ _) = mplus (fmap originallyPublic $ Map.lookup f $ locations p) @@ -1468,9 +1455,9 @@ makeMemoizingDecrypter operation secring pubring = do -- TODO: head will throw an exception if a File Descriptor operation -- file is present. We probably should change OriginMap to use InputFile -- instead of FilePath. - Traversable.mapM (cachedContents secring pubring . fromJust . pwfile . snd) + Traversable.mapM (cachedContents secring pubring . fromJust . pwfile . typ) (Map.mapKeys (head . resolveInputFile secring pubring) - $ Map.filter (isJust . pwfile . snd) $ kFiles operation) + $ Map.filter (isJust . pwfile . typ) $ kFiles operation) unkeysRef <- newIORef Map.empty return $ doDecrypt unkeysRef pws where @@ -1574,10 +1561,10 @@ initializeMissingPEMFiles operation secring pubring grip decrypt db = do return (f,t) let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do - (fname,(rtyp,ftyp)) <- nonexistents - guard $ isMutable rtyp + (fname,stream) <- nonexistents + guard $ isMutable stream (topspec,subspec) <- fmap (parseSpec $ fromMaybe "" grip) - $ getUsage ftyp + $ getUsage $ typ stream -- ms will contain duplicates if a top key has multiple matching -- subkeys. This is intentional. let -- ms = map (keykey . fst) $ selectAll True (topspec,subspec) db @@ -1585,7 +1572,7 @@ initializeMissingPEMFiles operation secring pubring grip decrypt db = do ns = do (kk,kd) <- filterMatches topspec $ Map.toList db return (kk , subkeysForExport subspec kd) - return (fname,subspec,ns,rtyp_initializer rtyp) + return (fname,subspec,ns,initializer stream) (exports0,ambiguous) = partition (\(_,_,ns,_)->null $ drop 1 $ (ns>>=snd)) notmissing exports = map (\(f,subspec,ns,cmd) -> (f,subspec,ns >>= snd,cmd)) exports0 diff --git a/kiki.hs b/kiki.hs index f5e3863..d9e12b6 100644 --- a/kiki.hs +++ b/kiki.hs @@ -808,22 +808,24 @@ sync bExport bImport bSecret cmdarg args_raw = do let keypairs = catMaybes keypairs0 homespec = join . take 1 <$> Map.lookup "--homedir" margs passfd = fmap (FileDesc . read) passphrase_fd - reftyp = if bExport then MutableRef Nothing - else ConstRef + reftyp = if bExport then KF_All + else KF_None pems = flip map keypairs $ \(usage,path,cmd) -> let cmd' = mfilter (not . null) (Just cmd) in if bExport - then (ArgFile path, (MutableRef cmd', PEMFile usage)) + then (ArgFile path, StreamInfo { fill = KF_All + , typ = PEMFile usage + , initializer = cmd' }) else if isNothing cmd' - then (ArgFile path, (ConstRef, PEMFile usage)) + then (ArgFile path, buildStreamInfo KF_None (PEMFile usage)) else error "Unexpected PEM file initializer." - walts = map (\fname -> (ArgFile fname, (reftyp, WalletFile))) + walts = map (\fname -> (ArgFile fname, buildStreamInfo reftyp WalletFile)) wallets - rings = map (\fname -> (ArgFile fname, (reftyp, KeyRingFile passfd))) + rings = map (\fname -> (ArgFile fname, buildStreamInfo reftyp (KeyRingFile passfd))) keyrings_ hosts = maybe [] (map decorate) $ Map.lookup "--hosts" margs - where decorate fname = (ArgFile fname, (reftyp, Hosts)) + where decorate fname = (ArgFile fname, buildStreamInfo reftyp Hosts) importStyle = maybe (\_ _ -> subkeysOnly) (\f rt kd -> f rt kd >> importPublic) $ mplus import_f importifauth_f @@ -832,10 +834,15 @@ sync bExport bImport bSecret cmdarg args_raw = do return $ \rt kd -> Just () importifauth_f = do Map.lookup "--import-if-authentic" margs return guardAuthentic + buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp, fill = rtyp } kikiOp = KeyRingOperation { kFiles = Map.fromList $ - [ ( HomeSec, (if bSecret && bImport then MutableRef Nothing else ConstRef, KeyRingFile passfd) ) - , ( HomePub, (if bImport then MutableRef Nothing else ConstRef, KeyRingFile Nothing) ) + [ ( HomeSec, buildStreamInfo (if bSecret && bImport then KF_All + else KF_None) + (KeyRingFile passfd) ) + , ( HomePub, buildStreamInfo (if bImport then KF_All + else KF_None) + (KeyRingFile Nothing) ) ] ++ rings ++ if bSecret then pems else [] @@ -929,10 +936,13 @@ kiki "show" args = do rings = [] hosts = [] walts = [] + streaminfo = StreamInfo { fill = KF_None + , typ = KeyRingFile passfd + } kikiOp = KeyRingOperation { kFiles = Map.fromList $ - [ ( HomeSec, (ConstRef, KeyRingFile passfd) ) - , ( HomePub, (ConstRef, KeyRingFile Nothing) ) + [ ( HomeSec, streaminfo ) + , ( HomePub, streaminfo ) ] ++ rings ++ pems -- cgit v1.2.3