From b06f6ca1b87749619d13f97e8e99ea76ca776ecc Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 4 May 2014 17:48:05 -0400 Subject: cosmetics, haddock. --- KeyRing.hs | 112 ++++++++++++++++++++++++++++++++++++++++++------------------- kiki.hs | 8 ++--- 2 files changed, 81 insertions(+), 39 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 , KikiReportAction(..) -- * Manipulating Keyrings , runKeyRing + , KeyRingOperation(..) , StreamInfo(..) + , PassphraseSpec(..) + , Transform(..) , Access(..) , KeyFilter(..) - , KeyRingOperation(..) - , PassphraseSpec(..) , errorString , reportString , KeyRingRuntime(..) @@ -198,7 +199,7 @@ type PasswordFile = InputFile data FileType = KeyRingFile (Maybe PasswordFile) -- ^ PasswordFile parameter is deprecated in favor - -- of kPassphrases. TODO: remove it. + -- of opPassphrases. TODO: remove it. | PEMFile | WalletFile -- (Maybe UsageTag) | Hosts @@ -216,18 +217,50 @@ data KeyFilter = KF_None -- ^ No keys will be imported. -- identity (signed or self-authenticating). | KF_All -- ^ All keys will be imported. +-- | This type describes how 'runKeyRing' will treat a file. data StreamInfo = StreamInfo { access :: Access + -- ^ Indicates whether the file is allowed to contain secret information. , typ :: FileType + -- ^ Indicates the format and content type of the file. , fill :: KeyFilter - , spill :: KeyFilter -- ^ Currently respected for PEMFile and KeyRingFile. - -- (TODO: WalletFile and Hosts) - -- Note that this is currently treated as a boolean - -- flag. KF_None means the file is not spillable - -- and anything else means that it is. + -- ^ This filter controls what packets will be inserted into a file. + , spill :: KeyFilter + -- + -- ^ Use this to indicate whether or not a file's contents should be + -- available for updating other files. Note that although its type is + -- 'KeyFilter', it is usually interpretted as a boolean flag. Details + -- depend on 'typ' and are as follows: + -- + -- 'KeyRingFile': + -- + -- * 'KF_None' - The file's contents will not be shared. + -- + -- * otherwise - The file's contents will be shared. + -- + -- 'PEMFile': + -- + -- * 'KF_None' - The file's contents will not be shared. + -- + -- * 'KF_Match' - The file's key will be shared with the specified + -- owner key and usage tag. + -- + -- * otherwise - Unspecified. Do not use. + -- + -- 'WalletFile': The 'spill' setting is ignored and the file's + -- contents are shared. (TODO) + -- + -- 'Hosts': The 'spill' setting is ignored and the file's + -- contents are shared. (TODO) + -- , initializer :: Maybe String + -- ^ If 'typ' is 'PEMFile' and an 'initializer' string is set, then it is + -- interpretted as a shell command that may be used to create the key if it + -- does not exist. , transforms :: [Transform] - -- ^ TODO: currently ignored + -- ^ Ignored. TODO: The intention is that we may indicate per-file + -- transformations that occur before a file's contents are spilled into the + -- common pool. } @@ -291,13 +324,22 @@ data PassphraseSpec = PassphraseSpec data Transform = Autosign deriving (Eq,Ord) +-- | This type describes an idempotent transformation (merge or import) on a +-- set of GnuPG keyrings and other key files. data KeyRingOperation = KeyRingOperation - { kFiles :: Map.Map InputFile StreamInfo - , kPassphrases :: [PassphraseSpec] - , kTransform :: [Transform] + { opFiles :: Map.Map InputFile StreamInfo + -- ^ Indicates files to be read or updated. + , opPassphrases :: [PassphraseSpec] + -- ^ Indicates files or file descriptors where passphrases can be found. + , opTransforms :: [Transform] + -- ^ Transformations to be performed on the key pool after all files have + -- been read and before any have been written. , kManip :: KeyRingRuntime -> KeyData -> [PacketUpdate]--[KeyRingAddress PacketUpdate] - -- ^ TODO: this is deprecated in favor of kTransform (remove it) - , homeSpec :: Maybe String + -- ^ This is deprecated in favor of opTransforms (TODO: remove it) + , opHome :: Maybe FilePath + -- ^ If provided, this is the directory where the 'HomeSec' and 'HomePub' + -- files reside. Otherwise, the evironment variable $GNUPGHOME is consulted + -- and if that is not set, it falls back to $HOME/.gnupg. } resolveInputFile :: InputFileContext -> InputFile -> [FilePath] @@ -321,7 +363,7 @@ resolveForReport mctx f = concat $ resolveInputFile ctx f filesToLock :: KeyRingOperation -> InputFileContext -> [FilePath] filesToLock k ctx = do - (f,stream) <- Map.toList (kFiles k) + (f,stream) <- Map.toList (opFiles k) case fill stream of KF_None -> [] _ -> resolveInputFile ctx f @@ -473,13 +515,12 @@ instance Applicative KikiCondition where Left err -> err Left err -> err --- | This type is used to describe events triggered by a --- 'runKeyRing'. In addition to normal feedback --- (e.g. 'NewPacket'), it also may indicate non-fatal --- IO exceptions (e.g. FailedExternal). Because a 'KeyRingOperation' --- may describe a very intricate multifaceted algorithm with many --- inputs and outputs, an operation may be partially (or even mostly) --- successful even when some aspect failed. +-- | This type is used to describe events triggered by 'runKeyRing'. In +-- addition to normal feedback (e.g. 'NewPacket'), it also may indicate +-- non-fatal IO exceptions (e.g. FailedExternal). Because a 'KeyRingOperation' +-- may describe a very intricate multifaceted algorithm with many inputs and +-- outputs, an operation may be partially (or even mostly) successful even when +-- some aspect failed. data KikiReportAction = NewPacket String | MissingPacket String @@ -1029,7 +1070,7 @@ mergeHostFiles krd db ctx = do ishosts Hosts = True ishosts _ = False files istyp = do - (f,stream) <- Map.toList (kFiles krd) + (f,stream) <- Map.toList (opFiles krd) guard (istyp $ typ stream) return f @@ -1086,7 +1127,7 @@ writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do isMutableHosts (typ -> Hosts) = True isMutableHosts _ = False files istyp = do - (f,stream) <- Map.toList (kFiles krd) + (f,stream) <- Map.toList (opFiles krd) guard (istyp stream) return f -- resolveInputFile ctx f @@ -1127,11 +1168,11 @@ buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation buildKeyDB ctx grip0 keyring = do let files isring = do - (f,stream) <- Map.toList (kFiles keyring) + (f,stream) <- Map.toList (opFiles keyring) guard (isring $ typ stream) resolveInputFile ctx f - (ringMap,nonRingMap) = Map.partition (isring . typ) $ kFiles keyring + (ringMap,nonRingMap) = Map.partition (isring . typ) $ opFiles keyring readp f stream = fmap readp0 $ readPacketsFromFile ctx f where @@ -1207,7 +1248,7 @@ buildKeyDB ctx grip0 keyring = do -- PEM files let pems = do - (n,stream) <- Map.toList $ kFiles keyring + (n,stream) <- Map.toList $ opFiles keyring grip <- maybeToList grip n <- resolveInputFile ctx n guard $ spillable stream && ispem (typ stream) @@ -1448,7 +1489,7 @@ writeWalletKeys krd db wk = do isMutableWallet (typ -> WalletFile {}) = True isMutableWallet _ = False files pred = do - (f,stream) <- Map.toList (kFiles krd) + (f,stream) <- Map.toList (opFiles krd) guard (pred stream) resolveInputFile (InputFileContext "" "") f let writeWallet report n = do @@ -1536,7 +1577,7 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled = do ctx = InputFileContext secring pubring let s = do (f,f0,stream) <- do - (f0,stream) <- Map.toList (kFiles krd) + (f0,stream) <- Map.toList (opFiles krd) guard (isring $ typ stream) f <- resolveInputFile ctx f0 return (f,f0,stream) @@ -1711,19 +1752,19 @@ makeMemoizingDecrypter operation ctx keys = do pws <- Traversable.mapM (cachedContents ctx . fromJust . pwfile . typ) (Map.mapKeys (resolveForReport Nothing) -- see note (*) note above - $ Map.filter (isJust . pwfile . typ) $ kFiles operation) + $ Map.filter (isJust . pwfile . typ) $ opFiles operation) pws2 <- Traversable.mapM (cachedContents ctx) $ Map.fromList $ mapMaybe (\spec -> (,passSpecPassFile spec) `fmap` do guard $ isNothing $ passSpecKeySpec spec passSpecRingFile spec) - (kPassphrases operation) + (opPassphrases operation) defpw <- do Traversable.mapM (cachedContents ctx . passSpecPassFile) $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp) && isNothing (passSpecKeySpec sp)) - $ kPassphrases operation + $ opPassphrases operation unkeysRef <- newIORef (Map.empty :: Map.Map KeyKey Packet) return $ doDecrypt unkeysRef (pws `Map.union` pws2) defpw where @@ -1830,7 +1871,7 @@ initializeMissingPEMFiles :: initializeMissingPEMFiles operation ctx grip decrypt db = do nonexistents <- filterM (fmap not . doesFileExist . fst) - $ do (f,t) <- Map.toList (kFiles operation) + $ do (f,t) <- Map.toList (opFiles operation) f <- resolveInputFile ctx f return (f,t) @@ -1897,7 +1938,7 @@ combineTransforms operation rt kd = updates where updates = kManip operation rt kd ++ concatMap (\t -> resolveTransform t rt kd) sanitized - sanitized = group (sort (kTransform operation)) >>= take 1 + sanitized = group (sort (opTransforms operation)) >>= take 1 isSubkeySignature (SubkeySignature {}) = True isSubkeySignature _ = False @@ -2024,9 +2065,10 @@ resolveTransform Autosign rt kd@(KeyData k ksigs umap submap) = ops gs = groupBy sameMaster (sortBy (comparing code) bindings') +-- | Load and update key files according to the specified 'KeyRingOperation'. runKeyRing :: KeyRingOperation -> IO (KikiResult KeyRingRuntime) runKeyRing operation = do - homedir <- getHomeDir (homeSpec operation) + homedir <- getHomeDir (opHome operation) let try' :: KikiCondition a -> (a -> IO (KikiResult b)) -> IO (KikiResult b) -- FIXME: try' should probably accept a list of KikiReportActions. -- This would be useful for reporting on disk writes that have already diff --git a/kiki.hs b/kiki.hs index b5f5191..5ad012a 100644 --- a/kiki.hs +++ b/kiki.hs @@ -760,7 +760,7 @@ sync bExport bImport bSecret cmdarg args_raw = do , access = AutoAccess , initializer = Nothing } kikiOp = KeyRingOperation - { kFiles = Map.fromList $ + { opFiles = Map.fromList $ [ ( HomeSec, buildStreamInfo (if bSecret && bImport then KF_All else KF_None) (KeyRingFile passfd) ) @@ -773,7 +773,7 @@ sync bExport bImport bSecret cmdarg args_raw = do ++ if bSecret then walts else [] ++ hosts , kManip = maybe noManip (const doAutosign) $ Map.lookup "--autosign" margs - , homeSpec = homespec + , opHome = homespec } (\f -> maybe f (const $ kiki_usage bSecret cmdarg) $ Map.lookup "--help" margs) $ do @@ -866,7 +866,7 @@ kiki "show" args = do , access = AutoAccess } kikiOp = KeyRingOperation - { kFiles = Map.fromList $ + { opFiles = Map.fromList $ [ ( HomeSec, streaminfo { access = Sec }) , ( HomePub, streaminfo { access = Pub }) ] @@ -875,7 +875,7 @@ kiki "show" args = do ++ walts ++ hosts , kManip = noManip - , homeSpec = homespec + , opHome = homespec } (\f -> maybe f (const $ kiki_usage False "show") $ Map.lookup "--help" margs) $ do -- cgit v1.2.3 From eff37fcdb4ca72340cc6393179b37f546e37f237 Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 4 May 2014 18:47:25 -0400 Subject: Haddock edits and removed some exports related to the now-removed kImports interface. --- KeyRing.hs | 79 ++++++++++++++++++++++++++++++++++++++++---------------------- kiki.hs | 8 ------- 2 files changed, 51 insertions(+), 36 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index 7fe031c..361d007 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -5,12 +5,15 @@ -- Maintainer : joe@jerkface.net -- Stability : experimental -- --- kiki is a command-line utility for manipulating GnuPG's keyring files. --- This module is the programmer-facing API it uses to do that. +-- kiki is a command-line utility for manipulating GnuPG's keyring files. This +-- module is the programmer-facing API it uses to do that. -- -- Note: This is *not* a public facing API. I (the author) consider this -- library to be internal to kiki and subject to change at my whim. -- +-- Typically, a client to this module would prepare a 'KeyRingOperation' +-- describing what he wants done, and then invoke 'runKeyRing' to make it +-- happen. {-# LANGUAGE CPP #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} @@ -25,28 +28,32 @@ module KeyRing KikiResult(..) , KikiCondition(..) , KikiReportAction(..) + , errorString + , reportString -- * Manipulating Keyrings , runKeyRing , KeyRingOperation(..) - , StreamInfo(..) , PassphraseSpec(..) , Transform(..) + , PacketUpdate(..) + , noManip + , guardAuthentic + -- * Describing File Operations + , StreamInfo(..) , Access(..) + , FileType(..) + , InputFile(..) , KeyFilter(..) - , errorString - , reportString + -- * Results of a KeyRing Operation , KeyRingRuntime(..) - , InputFile(..) - , FileType(..) - , importPublic - , importSecret - , subkeysOnly - , PacketUpdate(..) - , noManip , KeyDB , KeyData(..) + , UserIDRecord(..) , SubKey(..) , packet + , locations + , keyflags + -- * Miscelaneous Utilities , isKey , derRSA , derToBase32 @@ -54,11 +61,8 @@ module KeyRing , filterMatches , flattenKeys , flattenTop - , guardAuthentic , Hosts.Hosts , isCryptoCoinKey - , keyflags - , locations , matchpr , parseSpec , parseUID @@ -68,7 +72,6 @@ module KeyRing , secretToPublic , selectPublicKey , selectSecretKey - , UserIDRecord(..) , usage , usageString , walletImportFormat @@ -204,6 +207,10 @@ data FileType = KeyRingFile (Maybe PasswordFile) | WalletFile -- (Maybe UsageTag) | Hosts +-- | Use this type to indicate whether a file of type 'KeyRingFile' is expected +-- to contain secret or public PGP key packets. Note that it is not supported +-- to mix both in the same file and that the secret key packets include all of +-- the information contained in their corresponding public key packets. data Access = AutoAccess -- ^ secret or public as appropriate based on existing content | Sec -- ^ secret information | Pub -- ^ public information @@ -218,8 +225,7 @@ data KeyFilter = KF_None -- ^ No keys will be imported. | KF_All -- ^ All keys will be imported. -- | This type describes how 'runKeyRing' will treat a file. -data StreamInfo = StreamInfo - { access :: Access +data StreamInfo = StreamInfo { access :: Access -- ^ Indicates whether the file is allowed to contain secret information. , typ :: FileType -- ^ Indicates the format and content type of the file. @@ -242,25 +248,29 @@ data StreamInfo = StreamInfo -- -- * 'KF_None' - The file's contents will not be shared. -- - -- * 'KF_Match' - The file's key will be shared with the specified - -- owner key and usage tag. + -- * 'KF_Match' - The file's key will be shared with the specified owner + -- key and usage tag. -- -- * otherwise - Unspecified. Do not use. -- - -- 'WalletFile': The 'spill' setting is ignored and the file's - -- contents are shared. (TODO) + -- 'WalletFile': + -- + -- * The 'spill' setting is ignored and the file's contents are shared. + -- (TODO) + -- + -- 'Hosts': -- - -- 'Hosts': The 'spill' setting is ignored and the file's - -- contents are shared. (TODO) + -- * The 'spill' setting is ignored and the file's contents are shared. + -- (TODO) -- , initializer :: Maybe String -- ^ If 'typ' is 'PEMFile' and an 'initializer' string is set, then it is - -- interpretted as a shell command that may be used to create the key if it - -- does not exist. + -- interpretted as a shell command that may be used to create the key if + -- it does not exist. , transforms :: [Transform] -- ^ Ignored. TODO: The intention is that we may indicate per-file - -- transformations that occur before a file's contents are spilled into the - -- common pool. + -- transformations that occur before the contents of a file are spilled + -- into the common pool. } @@ -294,11 +304,24 @@ usageFromFilter _ = mzero data KeyRingRuntime = KeyRingRuntime { rtPubring :: FilePath + -- ^ Path to the file represented by 'HomePub' , rtSecring :: FilePath + -- ^ Path to the file represented by 'HomeSec' , rtGrip :: Maybe String + -- ^ Fingerprint or portion of a fingerprint used + -- to identify the working GnuPG identity used to + -- make signatures. , rtWorkingKey :: Maybe Packet + -- ^ The master key of the working GnuPG identity. , rtKeyDB :: KeyDB + -- ^ The common information pool where files spilled + -- their content and from which they received new + -- content. , rtRingAccess :: Map.Map FilePath Access + -- ^ The 'Access' values used for files of type + -- 'KeyRingFile'. If 'AutoAccess' was specified + -- for a file, this 'Map.Map' will indicate the + -- detected value that was used by the algorithm. } -- | TODO: Packet Update should have deletion action diff --git a/kiki.hs b/kiki.hs index 5ad012a..19d8beb 100644 --- a/kiki.hs +++ b/kiki.hs @@ -739,14 +739,6 @@ sync bExport bImport bSecret cmdarg args_raw = do keyrings_ hosts = maybe [] (map decorate) $ Map.lookup "--hosts" margs where decorate fname = (ArgFile fname, buildStreamInfo reftyp Hosts) - importStyle = maybe (\_ _ -> subkeysOnly) - (\f rt kd -> f rt kd >> importPublic) - $ mplus import_f importifauth_f - where - import_f = do Map.lookup "--import" margs - return $ \rt kd -> Just () - importifauth_f = do Map.lookup "--import-if-authentic" margs - return guardAuthentic pubfill = maybe KF_Subkeys id $ mplus import_f importifauth_f where -- cgit v1.2.3 From e665efa8b642a441b7516d1467a7266459cac6ec Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 4 May 2014 19:05:47 -0400 Subject: document Autosign symbol --- KeyRing.hs | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index 361d007..294933f 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -48,7 +48,6 @@ module KeyRing , KeyRingRuntime(..) , KeyDB , KeyData(..) - , UserIDRecord(..) , SubKey(..) , packet , locations @@ -66,6 +65,7 @@ module KeyRing , matchpr , parseSpec , parseUID + , UserIDRecord(..) , pkcs8 , RSAPublicKey(..) , rsaKeyFromPacket @@ -215,6 +215,8 @@ data Access = AutoAccess -- ^ secret or public as appropriate based on existing | Sec -- ^ secret information | Pub -- ^ public information +-- | Note that the documentation here is intended for when this value is +-- assigned to 'fill'. For other usage, see 'spill'. data KeyFilter = KF_None -- ^ No keys will be imported. | KF_Match String -- ^ Only the key that matches the spec will be imported. | KF_Subkeys -- ^ Subkeys will be imported if their owner key is @@ -344,7 +346,15 @@ data PassphraseSpec = PassphraseSpec -- ^ The passphrase will be read from this file or file descriptor. } -data Transform = Autosign +data Transform = + Autosign + -- ^ This operation will make signatures for any tor-style UID + -- that matches a tor subkey and thus can be authenticated without + -- requring the judgement of a human user. + -- + -- A tor-style UID is one of the following form: + -- + -- > Anonymous deriving (Eq,Ord) -- | This type describes an idempotent transformation (merge or import) on a @@ -2550,10 +2560,8 @@ type SigAndTrust = ( MappedPacket type KeyKey = [ByteString] data SubKey = SubKey MappedPacket [SigAndTrust] --- | This is a GPG Identity. It's poorly named --- but we are keeping the name around until --- we're sure we wont be cutting and pasting --- code with master any more. +-- | This is a GPG Identity which includes a master key and all its UIDs and +-- subkeys and associated signatures. data KeyData = KeyData { keyMappedPacket :: MappedPacket -- main key , keySigAndTrusts :: [SigAndTrust] -- sigs on main key , keyUids :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids -- cgit v1.2.3 From 8eaa721b660d94fac606ff9907a2f6e98a879e45 Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 4 May 2014 19:21:00 -0400 Subject: Addressed warnings in KeyRing.hs --- KeyRing.hs | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index 294933f..0944bd2 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -133,7 +133,6 @@ import Foreign.Storable #endif import System.FilePath ( takeDirectory ) import System.IO (hPutStrLn,withFile,IOMode(..), Handle, hPutStr) -import Foreign.C.Types ( CTime ) import Data.IORef import System.Posix.IO ( fdToHandle ) import qualified Data.Traversable as Traversable ( mapM ) @@ -550,10 +549,12 @@ instance Applicative KikiCondition where -- | This type is used to describe events triggered by 'runKeyRing'. In -- addition to normal feedback (e.g. 'NewPacket'), it also may indicate --- non-fatal IO exceptions (e.g. FailedExternal). Because a 'KeyRingOperation' --- may describe a very intricate multifaceted algorithm with many inputs and --- outputs, an operation may be partially (or even mostly) successful even when --- some aspect failed. +-- non-fatal IO exceptions (e.g. 'FailedExternal'). Because a +-- 'KeyRingOperation' may describe a very intricate multifaceted algorithm with +-- many inputs and outputs, an operation may be partially (or even mostly) +-- successful even when I/O failures occured. In this situation, the files may +-- not have all the information they were intended to store, but they will be +-- in a valid format for GnuPG or kiki to operate on in the future. data KikiReportAction = NewPacket String | MissingPacket String @@ -1031,8 +1032,11 @@ writeStamped0 ctx inp stamp dowrite bs = do dowrite (Right fname) bs setFileTimes fname stamp stamp +{- This may be useful later. Commented for now, as it is not used. + - writeStampedL :: InputFileContext -> InputFile -> Posix.EpochTime -> L.ByteString -> IO () writeStampedL ctx f stamp bs = writeStamped0 ctx f stamp (either L.hPut L.writeFile) bs +-} writeStamped :: InputFileContext -> InputFile -> Posix.EpochTime -> String -> IO () writeStamped ctx f stamp str = writeStamped0 ctx f stamp (either hPutStr writeFile) str @@ -1052,11 +1056,15 @@ getInputFileTime ctx (resolveInputFile ctx -> [fname]) = do handleIO_ (error $ fname++": modificaiton time?") $ modificationTime <$> getFileStatus fname +{- + - This may be useful later. Commented for now as it is not used. + - doesInputFileExist :: InputFileContext -> InputFile -> IO Bool doesInputFileExist ctx f = do case resolveInputFile ctx f of [n] -> doesFileExist n _ -> return True +-} cachedContents :: InputFileContext -> InputFile -> IO (IO S.ByteString) @@ -1205,7 +1213,7 @@ buildKeyDB ctx grip0 keyring = do guard (isring $ typ stream) resolveInputFile ctx f - (ringMap,nonRingMap) = Map.partition (isring . typ) $ opFiles keyring + ringMap = Map.filter (isring . typ) $ opFiles keyring readp f stream = fmap readp0 $ readPacketsFromFile ctx f where @@ -1568,10 +1576,6 @@ importPublic = Just True importSecret :: Maybe Bool importSecret = Just False --- | returns Nothing to indicate that no new master --- keys will be imported. -subkeysOnly :: Maybe Bool -subkeysOnly = Nothing -- TODO: Do we need to memoize this? guardAuthentic :: KeyRingRuntime -> KeyData -> Maybe () -- cgit v1.2.3 From 8ce5dba16886a1b19f5254e8d62810c303215387 Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 4 May 2014 19:31:13 -0400 Subject: Address interface changes and warnings in kiki.hs --- kiki.hs | 48 +++++++++++++----------------------------------- 1 file changed, 13 insertions(+), 35 deletions(-) diff --git a/kiki.hs b/kiki.hs index 19d8beb..1e4f1e4 100644 --- a/kiki.hs +++ b/kiki.hs @@ -32,7 +32,6 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as Char8 import qualified Data.Map as Map -import qualified Data.Text as T import Control.Arrow (first,second) import Data.Binary.Get (runGet) import Data.Binary.Put (putWord32be,runPut,putByteString) @@ -598,37 +597,6 @@ kiki_usage bSecret cmd = putStr $ ," 5E24CD442AA6965D2012E62A905C24185D5379C2" ] -doAutosign rt kd@(KeyData k ksigs umap submap) = ops - where - ops = map (\u -> InducerSignature u []) us - us = filter torStyle $ Map.keys umap - torStyle str = and [ uid_topdomain parsed == "onion" - , uid_realname parsed `elem` ["","Anonymous"] - , uid_user parsed == "root" - , fmap (match . fst) (lookup (packet k) torbindings) - == Just True ] - where parsed = parseUID str - match = (==subdom) . take (fromIntegral len) - subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)] - subdom = Char8.unpack subdom0 - len = T.length (uid_subdomain parsed) - torbindings = getTorKeys (map packet $ flattenTop "" True kd) - getTorKeys pub = do - xs <- groupBindings pub - (_,(top,sub),us,_,_) <- xs - guard ("tor" `elem` us) - let torhash = fromMaybe "" $ derToBase32 <$> derRSA sub - return (top,(torhash,sub)) - - groupBindings pub = gs - where (_,bindings) = getBindings pub - bindings' = accBindings bindings - code (c,(m,s),_,_,_) = (fingerprint_material m,-c) - ownerkey (_,(a,_),_,_,_) = a - sameMaster (ownerkey->a) (ownerkey->b) - = fingerprint_material a==fingerprint_material b - gs = groupBy sameMaster (sortBy (comparing code) bindings') - processArgs sargspec polyVariadicArgs defaultPoly args_raw = (sargs,margs) where (args,trail1) = break (=="--") args_raw @@ -725,7 +693,9 @@ sync bExport bImport bSecret cmdarg args_raw = do , spill = KF_Match usage , typ = PEMFile , access = Sec - , initializer = cmd' }) + , initializer = cmd' + , transforms = [] + } ) else if isNothing cmd' then ( ArgFile path , (buildStreamInfo KF_None PEMFile) @@ -750,7 +720,8 @@ sync bExport bImport bSecret cmdarg args_raw = do , fill = rtyp , spill = KF_All , access = AutoAccess - , initializer = Nothing } + , initializer = Nothing + , transforms = [] } kikiOp = KeyRingOperation { opFiles = Map.fromList $ [ ( HomeSec, buildStreamInfo (if bSecret && bImport then KF_All @@ -764,7 +735,10 @@ sync bExport bImport bSecret cmdarg args_raw = do ++ if bSecret then pems else [] ++ if bSecret then walts else [] ++ hosts - , kManip = maybe noManip (const doAutosign) $ Map.lookup "--autosign" margs + , opPassphrases = do pfile <- maybeToList passfd + return $ PassphraseSpec Nothing Nothing pfile + , opTransforms = maybe [] (const [Autosign]) $ Map.lookup "--autosign" margs + , kManip = noManip , opHome = homespec } @@ -856,6 +830,7 @@ kiki "show" args = do , spill = KF_All , initializer = Nothing , access = AutoAccess + , transforms = [] } kikiOp = KeyRingOperation { opFiles = Map.fromList $ @@ -866,6 +841,9 @@ kiki "show" args = do ++ pems ++ walts ++ hosts + , opPassphrases = do pfile <- maybeToList passfd + return $ PassphraseSpec Nothing Nothing pfile + , opTransforms = [] , kManip = noManip , opHome = homespec } -- cgit v1.2.3 From ace2d142a6824a1d73ebf8b602c495d8b91524fc Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 4 May 2014 19:35:35 -0400 Subject: removed deprecated kManip field. --- KeyRing.hs | 6 ++---- kiki.hs | 2 -- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index 0944bd2..a96d6a2 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -366,8 +366,6 @@ data KeyRingOperation = KeyRingOperation , opTransforms :: [Transform] -- ^ Transformations to be performed on the key pool after all files have -- been read and before any have been written. - , kManip :: KeyRingRuntime -> KeyData -> [PacketUpdate]--[KeyRingAddress PacketUpdate] - -- ^ This is deprecated in favor of opTransforms (TODO: remove it) , opHome :: Maybe FilePath -- ^ If provided, this is the directory where the 'HomeSec' and 'HomePub' -- files reside. Otherwise, the evironment variable $GNUPGHOME is consulted @@ -1973,8 +1971,8 @@ interpretManip kd manip = return kd combineTransforms :: KeyRingOperation -> KeyRingRuntime -> KeyData -> [PacketUpdate] combineTransforms operation rt kd = updates where - updates = kManip operation rt kd - ++ concatMap (\t -> resolveTransform t rt kd) sanitized + updates = -- kManip operation rt kd ++ + concatMap (\t -> resolveTransform t rt kd) sanitized sanitized = group (sort (opTransforms operation)) >>= take 1 isSubkeySignature (SubkeySignature {}) = True diff --git a/kiki.hs b/kiki.hs index 1e4f1e4..a3c0a56 100644 --- a/kiki.hs +++ b/kiki.hs @@ -738,7 +738,6 @@ sync bExport bImport bSecret cmdarg args_raw = do , opPassphrases = do pfile <- maybeToList passfd return $ PassphraseSpec Nothing Nothing pfile , opTransforms = maybe [] (const [Autosign]) $ Map.lookup "--autosign" margs - , kManip = noManip , opHome = homespec } @@ -844,7 +843,6 @@ kiki "show" args = do , opPassphrases = do pfile <- maybeToList passfd return $ PassphraseSpec Nothing Nothing pfile , opTransforms = [] - , kManip = noManip , opHome = homespec } -- cgit v1.2.3 From 2f31a27316faf3de5008fcb5f49316e5178827e6 Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 4 May 2014 19:47:21 -0400 Subject: haddock updates --- KeyRing.hs | 31 +++++++++++++++++++------------ 1 file changed, 19 insertions(+), 12 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index a96d6a2..9d046b6 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -35,9 +35,8 @@ module KeyRing , KeyRingOperation(..) , PassphraseSpec(..) , Transform(..) - , PacketUpdate(..) - , noManip - , guardAuthentic + -- , PacketUpdate(..) + -- , guardAuthentic -- * Describing File Operations , StreamInfo(..) , Access(..) @@ -188,11 +187,20 @@ home = HomeDir } data InputFile = HomeSec + -- ^ A file named secring.gpg located in the home directory. + -- See 'opHome'. | HomePub + -- ^ A file named pubring.gpg located in the home directory. + -- See 'opHome'. | ArgFile FilePath + -- ^ Contents will be read or written from the specified path. | FileDesc Posix.Fd + -- ^ Contents will be read or written from the specified file + -- descriptor. | Pipe Posix.Fd Posix.Fd - -- ^ Note: Don't use Pipe for wallet files. (TODO) + -- ^ Contents will be read from the first descriptor and updated + -- content will be writen to the second. Note: Don't use Pipe + -- for 'Wallet' files. (TODO: Wallet support) deriving (Eq,Ord) -- type UsageTag = String @@ -250,24 +258,26 @@ data StreamInfo = StreamInfo { access :: Access -- * 'KF_None' - The file's contents will not be shared. -- -- * 'KF_Match' - The file's key will be shared with the specified owner - -- key and usage tag. + -- key and usage tag. If 'fill' is also a 'KF_Match', then it must be + -- equal to this value; changing the usage or owner of a key is not + -- supported via the fill/spill mechanism. -- -- * otherwise - Unspecified. Do not use. -- -- 'WalletFile': -- -- * The 'spill' setting is ignored and the file's contents are shared. - -- (TODO) + -- (TODO) -- -- 'Hosts': -- -- * The 'spill' setting is ignored and the file's contents are shared. - -- (TODO) + -- (TODO) -- , initializer :: Maybe String -- ^ If 'typ' is 'PEMFile' and an 'initializer' string is set, then it is - -- interpretted as a shell command that may be used to create the key if - -- it does not exist. + -- interpretted as a shell command that may be used to create the key if it + -- does not exist. , transforms :: [Transform] -- ^ Ignored. TODO: The intention is that we may indicate per-file -- transformations that occur before the contents of a file are spilled @@ -330,9 +340,6 @@ data KeyRingRuntime = KeyRingRuntime -- action. data PacketUpdate = InducerSignature String [SignatureSubpacket] -noManip :: KeyRingRuntime -> KeyData -> [PacketUpdate] -noManip _ _ = [] - -- | This type is used to indicate where to obtain passphrases. data PassphraseSpec = PassphraseSpec { passSpecRingFile :: Maybe FilePath -- cgit v1.2.3 From b845dc5c5ebad65472c43c6037fc32654562bc71 Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 4 May 2014 20:09:19 -0400 Subject: removed deprecated argument to KeyRingFile --- KeyRing.hs | 15 ++++++++------- kiki.hs | 8 ++++---- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index 9d046b6..b0d1b67 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -205,13 +205,10 @@ data InputFile = HomeSec -- type UsageTag = String type Initializer = String -type PasswordFile = InputFile -data FileType = KeyRingFile (Maybe PasswordFile) - -- ^ PasswordFile parameter is deprecated in favor - -- of opPassphrases. TODO: remove it. +data FileType = KeyRingFile | PEMFile - | WalletFile -- (Maybe UsageTag) + | WalletFile | Hosts -- | Use this type to indicate whether a file of type 'KeyRingFile' is expected @@ -301,9 +298,11 @@ ispem :: FileType -> Bool ispem (PEMFile {}) = True ispem _ = False -pwfile :: FileType -> Maybe PasswordFile +{- +pwfile :: FileType -> Maybe InputFile pwfile (KeyRingFile f) = f pwfile _ = Nothing +-} iswallet :: FileType -> Bool iswallet (WalletFile {}) = True @@ -1791,10 +1790,12 @@ makeMemoizingDecrypter operation ctx keys = do -- TODO: Perhaps these should both be of type InputFile rather than -- FilePath? -- pws :: Map.Map FilePath (IO S.ByteString) + {- pws <- Traversable.mapM (cachedContents ctx . fromJust . pwfile . typ) (Map.mapKeys (resolveForReport Nothing) -- see note (*) note above $ Map.filter (isJust . pwfile . typ) $ opFiles operation) + -} pws2 <- Traversable.mapM (cachedContents ctx) $ Map.fromList $ mapMaybe @@ -1808,7 +1809,7 @@ makeMemoizingDecrypter operation ctx keys = do && isNothing (passSpecKeySpec sp)) $ opPassphrases operation unkeysRef <- newIORef (Map.empty :: Map.Map KeyKey Packet) - return $ doDecrypt unkeysRef (pws `Map.union` pws2) defpw + return $ doDecrypt unkeysRef ({- pws `Map.union` -} pws2) defpw where doDecrypt :: IORef (Map.Map KeyKey Packet) -> Map.Map FilePath (IO S.ByteString) diff --git a/kiki.hs b/kiki.hs index a3c0a56..cae8ae8 100644 --- a/kiki.hs +++ b/kiki.hs @@ -705,7 +705,7 @@ sync bExport bImport bSecret cmdarg args_raw = do , (buildStreamInfo reftyp WalletFile) { access = Sec })) wallets rings = map (\fname -> ( ArgFile fname - , buildStreamInfo reftyp $ KeyRingFile passfd)) + , buildStreamInfo reftyp KeyRingFile )) keyrings_ hosts = maybe [] (map decorate) $ Map.lookup "--hosts" margs where decorate fname = (ArgFile fname, buildStreamInfo reftyp Hosts) @@ -726,10 +726,10 @@ sync bExport bImport bSecret cmdarg args_raw = do { opFiles = Map.fromList $ [ ( HomeSec, buildStreamInfo (if bSecret && bImport then KF_All else KF_None) - (KeyRingFile passfd) ) + KeyRingFile ) , ( HomePub, buildStreamInfo (if bImport then pubfill else KF_None) - (KeyRingFile Nothing) ) + KeyRingFile ) ] ++ rings ++ if bSecret then pems else [] @@ -825,7 +825,7 @@ kiki "show" args = do hosts = [] walts = [] streaminfo = StreamInfo { fill = KF_None - , typ = KeyRingFile passfd + , typ = KeyRingFile , spill = KF_All , initializer = Nothing , access = AutoAccess -- cgit v1.2.3 From 50da2308364e1c27d8d3fb7230f6e188b36a73b4 Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 4 May 2014 20:20:04 -0400 Subject: haddock link --- KeyRing.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/KeyRing.hs b/KeyRing.hs index b0d1b67..57f80d9 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -215,7 +215,8 @@ data FileType = KeyRingFile -- to contain secret or public PGP key packets. Note that it is not supported -- to mix both in the same file and that the secret key packets include all of -- the information contained in their corresponding public key packets. -data Access = AutoAccess -- ^ secret or public as appropriate based on existing content +data Access = AutoAccess -- ^ secret or public as appropriate based on existing content. + -- (see 'rtRingAccess') | Sec -- ^ secret information | Pub -- ^ public information -- cgit v1.2.3 From 67904f836d39cc844f85c2570d5a634d59a8f020 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 5 May 2014 20:32:36 -0400 Subject: The 'merge' command exposes low-level KeyRingOperation functionality. --- kiki.hs | 107 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 107 insertions(+) diff --git a/kiki.hs b/kiki.hs index cae8ae8..f99a928 100644 --- a/kiki.hs +++ b/kiki.hs @@ -872,6 +872,112 @@ kiki "show" args = do forM_ report $ \(fname,act) -> do putStrLn $ fname ++ ": " ++ reportString act +kiki "merge" args = do + let op = snd $ foldl' buildOp (flow,noop) args + noop = KeyRingOperation + { opFiles = Map.empty + , opTransforms = [] + , opHome = Nothing + , opPassphrases = [] + } + flow = StreamInfo + { access = AutoAccess + , typ = KeyRingFile + , spill = KF_None + , fill = KF_None + , initializer = Nothing + , transforms = [] + } + updateFlow fil spil mtch flow = spill' $ fill' $ flow + where + fill' flow = flow { fill = if fil then val else KF_None } + spill' flow = flow { spill = if spil then val else KF_None } + val = either (\subkeys -> if subkeys then KF_Subkeys else KF_All) + KF_Match + mtch + parseFlow spec = + if null bads + then Just ( ( "spill" `elem` goods + || "sync" `elem` goods + , "fill" `elem` goods + || "sync" `elem` goods ) + , maybe (Left $ "subkeys" `elem` goods) + Right + match ) + else Nothing + where + ws = case groupBy (\_ c->c/=',') spec of + w:xs -> w:map (drop 1) xs + [] -> [] + (goods,bads) = partition acceptable ws + acceptable "spill" = True + acceptable "fill" = True + acceptable "sync" = True + acceptable "subkeys" = True + acceptable s | "match=" `isPrefixOf` s = True + acceptable _ = False + match = listToMaybe $ do + m <- filter ("match=" `isPrefixOf`) goods + return $ drop 6 m + + buildOp (flow,op) arg = + case splitArg arg of + Right fname -> + ( flow + , op { opFiles= Map.insert (ArgFile fname) flow (opFiles op) }) + Left ("autosign",Nothing) -> + if Map.null (opFiles op) + then (flow, op { opTransforms = opTransforms op ++ [Autosign] }) + else (flow { transforms = transforms flow ++ [Autosign] }, op) + Left ("noautosign",Nothing) -> + ( flow { transforms = filter (/=Autosign) (transforms flow) } + , op { opTransforms = filter (/=Autosign) (opTransforms op) } ) + Left ("create",Just cmd) -> + ( flow { initializer = if null cmd then Nothing else Just cmd } + , op ) + Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile }, op ) + Left ("type",Just "pem" ) -> ( flow { typ = PEMFile }, op ) + Left ("type",Just "wallet" ) -> ( flow { typ = WalletFile }, op ) + Left ("type",Just "hosts" ) -> ( flow { typ = Hosts }, op ) + Left ("access",Just "public") -> ( flow { access = Pub }, op ) + Left ("access",Just "secret") -> ( flow { access = Sec }, op ) + Left ("access",Just "auto") -> ( flow { access = AutoAccess }, op ) + Left ("home",mb) -> + ( flow + , op { opFiles = Map.insert HomePub flow { access=Pub } + $ Map.insert HomeSec flow { access=Sec } + $ opFiles op + , opHome = opHome op `mplus` mb + } + ) + Left ("flow",Just flowspec) -> + case parseFlow flowspec of + Just ( (fil,spil), mtch ) -> + ( updateFlow fil spil mtch flow + , op ) + Nothing -> error "Valid flow words are: spill,fill,sync,subkeys or match=KEYSPEC" + Left (option,_) -> error $ "Unrecognized option: " ++ option + KikiResult rt report <- runKeyRing op + case rt of + KikiSuccess rt -> return () + err -> putStrLn $ errorString err + forM_ report $ \(fname,act) -> do + putStrLn $ fname ++ ": " ++ reportString act + +splitArg :: String -> Either (String,Maybe String) String +splitArg arg = + case hyphens of + "" -> Right name + "-" -> error $ "Unrecognized option: " ++ arg + _ -> Left $ parseLongOption name + where + (hyphens, name) = span (=='-') arg + parseLongOption name = (key,val v) + where + (key,v) = break (=='=') name + val ('=':vs) = Just vs + val _ = Nothing + commands :: [(String,String)] commands = [ ( "help", "display usage information" ) @@ -884,6 +990,7 @@ commands = , ( "export-secret", "export (both public and secret) information into your keyring" ) , ( "export-public", "import (public) information into your keyring" ) , ( "working-key", "show the current working master key and its subkeys" ) + , ( "merge", "low level import/export operation" ) ] main = do -- cgit v1.2.3 From 9deb2a81dcfc3c4489824d5a753cbe03fe82c492 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 5 May 2014 21:40:16 -0400 Subject: better usage message for "merge" command --- kiki.hs | 200 +++++++++++++++++++++++++++++++++++++--------------------------- 1 file changed, 116 insertions(+), 84 deletions(-) diff --git a/kiki.hs b/kiki.hs index f99a928..a7189f0 100644 --- a/kiki.hs +++ b/kiki.hs @@ -872,97 +872,129 @@ kiki "show" args = do forM_ report $ \(fname,act) -> do putStrLn $ fname ++ ": " ++ reportString act +kiki "merge" [] = do + putStr . unlines $ + [ "kiki merge ( --home[=HOMEDIR]" + , " | --type=(keyring|pem|wallet|hosts)" + , " | --access=[auto|secret|public]" + , " | --flow=(fill|spill|sync)[,(subkeys|match=KEYSPEC)]" + , " | --create=CMD" + , " | --autosign[=no]" + , " | --" + , " | FILE ) ..."] +kiki "merge" args | "--help" `elem` args = do + kiki "merge" [] + -- TODO: more help kiki "merge" args = do - let op = snd $ foldl' buildOp (flow,noop) args - noop = KeyRingOperation - { opFiles = Map.empty - , opTransforms = [] - , opHome = Nothing - , opPassphrases = [] - } - flow = StreamInfo - { access = AutoAccess - , typ = KeyRingFile - , spill = KF_None - , fill = KF_None - , initializer = Nothing - , transforms = [] - } - updateFlow fil spil mtch flow = spill' $ fill' $ flow - where - fill' flow = flow { fill = if fil then val else KF_None } - spill' flow = flow { spill = if spil then val else KF_None } - val = either (\subkeys -> if subkeys then KF_Subkeys else KF_All) - KF_Match - mtch - parseFlow spec = - if null bads - then Just ( ( "spill" `elem` goods - || "sync" `elem` goods - , "fill" `elem` goods - || "sync" `elem` goods ) - , maybe (Left $ "subkeys" `elem` goods) - Right - match ) - else Nothing - where - ws = case groupBy (\_ c->c/=',') spec of - w:xs -> w:map (drop 1) xs - [] -> [] - (goods,bads) = partition acceptable ws - acceptable "spill" = True - acceptable "fill" = True - acceptable "sync" = True - acceptable "subkeys" = True - acceptable s | "match=" `isPrefixOf` s = True - acceptable _ = False - match = listToMaybe $ do - m <- filter ("match=" `isPrefixOf`) goods - return $ drop 6 m - - buildOp (flow,op) arg = - case splitArg arg of - Right fname -> - ( flow - , op { opFiles= Map.insert (ArgFile fname) flow (opFiles op) }) - Left ("autosign",Nothing) -> - if Map.null (opFiles op) - then (flow, op { opTransforms = opTransforms op ++ [Autosign] }) - else (flow { transforms = transforms flow ++ [Autosign] }, op) - Left ("noautosign",Nothing) -> - ( flow { transforms = filter (/=Autosign) (transforms flow) } - , op { opTransforms = filter (/=Autosign) (opTransforms op) } ) - Left ("create",Just cmd) -> - ( flow { initializer = if null cmd then Nothing else Just cmd } - , op ) - Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile }, op ) - Left ("type",Just "pem" ) -> ( flow { typ = PEMFile }, op ) - Left ("type",Just "wallet" ) -> ( flow { typ = WalletFile }, op ) - Left ("type",Just "hosts" ) -> ( flow { typ = Hosts }, op ) - Left ("access",Just "public") -> ( flow { access = Pub }, op ) - Left ("access",Just "secret") -> ( flow { access = Sec }, op ) - Left ("access",Just "auto") -> ( flow { access = AutoAccess }, op ) - Left ("home",mb) -> - ( flow - , op { opFiles = Map.insert HomePub flow { access=Pub } - $ Map.insert HomeSec flow { access=Sec } - $ opFiles op - , opHome = opHome op `mplus` mb - } - ) - Left ("flow",Just flowspec) -> - case parseFlow flowspec of - Just ( (fil,spil), mtch ) -> - ( updateFlow fil spil mtch flow - , op ) - Nothing -> error "Valid flow words are: spill,fill,sync,subkeys or match=KEYSPEC" - Left (option,_) -> error $ "Unrecognized option: " ++ option KikiResult rt report <- runKeyRing op case rt of KikiSuccess rt -> return () err -> putStrLn $ errorString err forM_ report $ \(fname,act) -> do putStrLn $ fname ++ ": " ++ reportString act + where + (_,(_,op)) = foldl' buildOp (True,(flow,noop)) args + noop = KeyRingOperation + { opFiles = Map.empty + , opTransforms = [] + , opHome = Nothing + , opPassphrases = [] + } + flow = StreamInfo + { access = AutoAccess + , typ = KeyRingFile + , spill = KF_None + , fill = KF_None + , initializer = Nothing + , transforms = [] + } + updateFlow fil spil mtch flow = spill' $ fill' $ flow + where + fill' flow = flow { fill = if fil then val else KF_None } + spill' flow = flow { spill = if spil then val else KF_None } + val = either (\subkeys -> if subkeys then KF_Subkeys else KF_All) + KF_Match + mtch + parseFlow spec = + if null bads + then Just ( ( "spill" `elem` goods + || "sync" `elem` goods + , "fill" `elem` goods + || "sync" `elem` goods ) + , maybe (Left $ "subkeys" `elem` goods) + Right + match ) + else Nothing + where + ws = case groupBy (\_ c->c/=',') spec of + w:xs -> w:map (drop 1) xs + [] -> [] + (goods,bads) = partition acceptable ws + acceptable "spill" = True + acceptable "fill" = True + acceptable "sync" = True + acceptable "subkeys" = True + acceptable s | "match=" `isPrefixOf` s = True + acceptable _ = False + match = listToMaybe $ do + m <- filter ("match=" `isPrefixOf`) goods + return $ drop 6 m + + doFile :: StreamInfo -> KeyRingOperation -> FilePath -> (StreamInfo,KeyRingOperation) + doFile flow op fname = + ( flow + , op { opFiles= Map.insert (ArgFile fname) flow (opFiles op) }) + + doAutosign :: Bool -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) + doAutosign True flow op = + if Map.null (opFiles op) + then (flow, op { opTransforms = opTransforms op ++ [Autosign] }) + else (flow { transforms = transforms flow ++ [Autosign] }, op) + doAutosign False flow op = + ( flow { transforms = filter (/=Autosign) (transforms flow) } + , op { opTransforms = filter (/=Autosign) (opTransforms op) } ) + + buildOp (False,(flow,op)) fname = (False,doFile flow op fname) + buildOp (True,(flow,op)) arg@(splitArg->parsed) = + case parsed of + Left ("",Nothing) -> (False,(flow,op)) + _ -> (True,) dispatch + where + dispatch = + case parsed of + Right fname -> doFile flow op fname + Left ("autosign",Nothing) -> doAutosign True flow op + Left ("autosign",Just "y") -> doAutosign True flow op + Left ("autosign",Just "yes") -> doAutosign True flow op + Left ("autosign",Just "true") -> doAutosign True flow op + Left ("autosign",Just "n") -> doAutosign False flow op + Left ("autosign",Just "no") -> doAutosign False flow op + Left ("autosign",Just "false")-> doAutosign False flow op + Left ("create",Just cmd) -> + ( flow { initializer = if null cmd then Nothing else Just cmd } + , op ) + Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile }, op ) + Left ("type",Just "pem" ) -> ( flow { typ = PEMFile }, op ) + Left ("type",Just "wallet" ) -> ( flow { typ = WalletFile }, op ) + Left ("type",Just "hosts" ) -> ( flow { typ = Hosts }, op ) + Left ("access",Just "public") -> ( flow { access = Pub }, op ) + Left ("access",Just "secret") -> ( flow { access = Sec }, op ) + Left ("access",Just "auto") -> ( flow { access = AutoAccess }, op ) + Left ("home",mb) -> + ( flow + , op { opFiles = Map.insert HomePub flow { access=Pub } + $ Map.insert HomeSec flow { access=Sec } + $ opFiles op + , opHome = opHome op `mplus` mb + } + ) + Left ("flow",Just flowspec) -> + case parseFlow flowspec of + Just ( (fil,spil), mtch ) -> + ( updateFlow fil spil mtch flow + , op ) + Nothing -> error "Valid flow words are: spill,fill,sync,subkeys or match=KEYSPEC" + Left (option,_) -> error $ "Unrecognized option: " ++ option splitArg :: String -> Either (String,Maybe String) String splitArg arg = -- cgit v1.2.3 From b67c7e1a1fab761159e45505579e9ab6d8ec78d8 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 5 May 2014 21:57:23 -0400 Subject: renamed merge KEYSPEC to SPEC for consistency with other commands. --- kiki.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kiki.hs b/kiki.hs index a7189f0..6c72eb5 100644 --- a/kiki.hs +++ b/kiki.hs @@ -877,7 +877,7 @@ kiki "merge" [] = do [ "kiki merge ( --home[=HOMEDIR]" , " | --type=(keyring|pem|wallet|hosts)" , " | --access=[auto|secret|public]" - , " | --flow=(fill|spill|sync)[,(subkeys|match=KEYSPEC)]" + , " | --flow=(fill|spill|sync)[,(subkeys|match=SPEC)]" , " | --create=CMD" , " | --autosign[=no]" , " | --" -- cgit v1.2.3 From 9cf8e1743d4c8039d36b13b7cecf6413fd80c9ad Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 6 May 2014 01:29:09 -0400 Subject: per file transforms --- KeyRing.hs | 48 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 32 insertions(+), 16 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index 57f80d9..023c027 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -219,6 +219,7 @@ data Access = AutoAccess -- ^ secret or public as appropriate based on existing -- (see 'rtRingAccess') | Sec -- ^ secret information | Pub -- ^ public information + deriving (Eq,Ord,Show) -- | Note that the documentation here is intended for when this value is -- assigned to 'fill'. For other usage, see 'spill'. @@ -328,7 +329,7 @@ data KeyRingRuntime = KeyRingRuntime -- ^ The common information pool where files spilled -- their content and from which they received new -- content. - , rtRingAccess :: Map.Map FilePath Access + , rtRingAccess :: Map.Map InputFile Access -- ^ The 'Access' values used for files of type -- 'KeyRingFile'. If 'AutoAccess' was specified -- for a file, this 'Map.Map' will indicate the @@ -1206,7 +1207,7 @@ buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation Hosts.Hosts, [(SockAddr, (KeyKey, KeyKey))], [SockAddr]) - ,Map.Map FilePath Access + ,Map.Map InputFile Access ,MappedPacket -> IO (KikiCondition Packet) ,Map.Map InputFile Message ) @@ -1234,7 +1235,7 @@ buildKeyDB ctx grip0 keyring = do readw wk n = fmap (n,) (readPacketsFromWallet wk (ArgFile n)) -- KeyRings (todo: KikiCondition reporting?) - (db_rings,mwk,grip,accs,keys,unspilled) <- do + (spilled,mwk,grip,accs,keys,unspilled) <- do ringPackets <- Map.traverseWithKey readp ringMap let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message) @@ -1244,8 +1245,6 @@ buildKeyDB ctx grip0 keyring = do (_,Message ps) <- Map.lookup HomeSec ringPackets listToMaybe ps (spilled,unspilled) = Map.partition (spillable . fst) ringPackets - db_rings = Map.foldlWithKey mergeIt Map.empty spilled - where mergeIt db f (_,ps) = merge db f ps keys :: Map.Map KeyKey MappedPacket keys = Map.foldl slurpkeys Map.empty $ Map.mapWithKey filterSecrets ringPackets @@ -1262,13 +1261,32 @@ buildKeyDB ctx grip0 keyring = do let matchfp mp = not (is_subkey p) && matchpr fp p == fp where p = packet mp Map.elems $ Map.filter matchfp keys - accs = Map.mapKeys (concat . resolveInputFile ctx) - $ fmap (access . fst) ringPackets - return (db_rings,wk,grip,accs,keys,fmap snd unspilled) + accs = fmap (access . fst) ringPackets + return (spilled,wk,grip,accs,keys,fmap snd unspilled) doDecrypt <- makeMemoizingDecrypter keyring ctx keys let wk = fmap packet mwk + rt0 = KeyRingRuntime { rtPubring = homepubPath ctx + , rtSecring = homesecPath ctx + , rtGrip = grip + , rtWorkingKey = wk + , rtRingAccess = accs + , rtKeyDB = Map.empty + } + transformed <- + let trans f (info,ps) = do + let manip = combineTransforms (transforms info) + rt1 = rt0 { rtKeyDB = merge Map.empty f ps } + acc = True + r <- performManipulations doDecrypt rt1 mwk manip + return $ either (const (info,ps)) + (\(rt2,report) -> (info,flattenKeys acc $ rtKeyDB rt2)) + $ functorToEither r + in Map.traverseWithKey trans spilled + let db_rings = Map.foldlWithKey' mergeIt Map.empty transformed + where + mergeIt db f (info,ps) = merge db f ps -- Wallets let importWalletKey wk db' (top,fname,sub,tag) = do @@ -1647,7 +1665,7 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled = do importByExistingMaster kd@(KeyData p _ _ _) = fmap originallyPublic $ Map.lookup f $ locations p d <- sortByHint f keyMappedPacket (Map.elems db') - acc <- maybeToList $ Map.lookup f (rtRingAccess rt) + acc <- maybeToList $ Map.lookup f0 (rtRingAccess rt) only_public <- maybeToList $ wantedForFill acc (fill stream) d case fill stream of KF_Match usage -> do grip <- maybeToList $ rtGrip rt @@ -1849,12 +1867,11 @@ makeMemoizingDecrypter operation ctx keys = do performManipulations :: (MappedPacket -> IO (KikiCondition Packet)) - -> KeyRingOperation -> KeyRingRuntime -> Maybe MappedPacket -> (KeyRingRuntime -> KeyData -> [PacketUpdate]) -> IO (KikiCondition (KeyRingRuntime,[(FilePath,KikiReportAction)])) -performManipulations doDecrypt operation rt wk manip = do +performManipulations doDecrypt rt wk manip = do let db = rtKeyDB rt performAll kd = foldM perform (KikiSuccess kd) $ manip rt kd r <- Traversable.mapM performAll db @@ -1977,12 +1994,12 @@ interpretManip kd (KeyRingAddress kk sk (InducerSignature ps)) = error "todo" interpretManip kd manip = return kd -} -combineTransforms :: KeyRingOperation -> KeyRingRuntime -> KeyData -> [PacketUpdate] -combineTransforms operation rt kd = updates +combineTransforms :: [Transform] -> KeyRingRuntime -> KeyData -> [PacketUpdate] +combineTransforms trans rt kd = updates where updates = -- kManip operation rt kd ++ concatMap (\t -> resolveTransform t rt kd) sanitized - sanitized = group (sort (opTransforms operation)) >>= take 1 + sanitized = group (sort trans) >>= take 1 isSubkeySignature (SubkeySignature {}) = True isSubkeySignature _ = False @@ -2160,10 +2177,9 @@ runKeyRing operation = do } r <- performManipulations decrypt - operation rt wk - (combineTransforms operation) + (combineTransforms $ opTransforms operation) try' r $ \(rt,report_manips) -> do r <- writeWalletKeys operation (rtKeyDB rt) (fmap packet wk) -- cgit v1.2.3 From 94efc2744b7d6288dd08b7e3f74337345ae0efb0 Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 6 May 2014 01:40:43 -0400 Subject: reporting for per-file transformations --- KeyRing.hs | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index 023c027..ffd8183 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -266,21 +266,20 @@ data StreamInfo = StreamInfo { access :: Access -- 'WalletFile': -- -- * The 'spill' setting is ignored and the file's contents are shared. - -- (TODO) + -- (TODO) -- -- 'Hosts': -- -- * The 'spill' setting is ignored and the file's contents are shared. - -- (TODO) + -- (TODO) -- , initializer :: Maybe String -- ^ If 'typ' is 'PEMFile' and an 'initializer' string is set, then it is -- interpretted as a shell command that may be used to create the key if it -- does not exist. , transforms :: [Transform] - -- ^ Ignored. TODO: The intention is that we may indicate per-file - -- transformations that occur before the contents of a file are spilled - -- into the common pool. + -- ^ Per-file transformations that occur before the contents of a file are + -- spilled into the common pool. } @@ -1274,19 +1273,20 @@ buildKeyDB ctx grip0 keyring = do , rtRingAccess = accs , rtKeyDB = Map.empty } - transformed <- + transformed0 <- let trans f (info,ps) = do let manip = combineTransforms (transforms info) rt1 = rt0 { rtKeyDB = merge Map.empty f ps } - acc = True + acc = Just Sec /= Map.lookup f accs r <- performManipulations doDecrypt rt1 mwk manip - return $ either (const (info,ps)) - (\(rt2,report) -> (info,flattenKeys acc $ rtKeyDB rt2)) - $ functorToEither r - in Map.traverseWithKey trans spilled + try r $ \(rt2,report) -> do + return $ KikiSuccess (report,(info,flattenKeys acc $ rtKeyDB rt2)) + in fmap sequenceA $ Map.traverseWithKey trans spilled + try transformed0 $ \transformed -> do let db_rings = Map.foldlWithKey' mergeIt Map.empty transformed where - mergeIt db f (info,ps) = merge db f ps + mergeIt db f (_,(info,ps)) = merge db f ps + reportTrans = concat $ Map.elems $ fmap fst transformed -- Wallets let importWalletKey wk db' (top,fname,sub,tag) = do @@ -1332,7 +1332,7 @@ buildKeyDB ctx grip0 keyring = do try r $ \((db,hs),reportHosts) -> do return $ KikiSuccess ( (db, grip, mwk, hs, accs, doDecrypt, unspilled) - , reportWallets ++ reportPEMs ) + , reportTrans ++ reportWallets ++ reportPEMs ++ reportHosts ) torhash :: Packet -> String torhash key = fromMaybe "" $ derToBase32 <$> derRSA key -- cgit v1.2.3 From 4f495163b6ff423baee8306098152a0435dcdc89 Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 6 May 2014 01:58:11 -0400 Subject: --home files are always --type=keyring regardless of prior option. --- kiki.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/kiki.hs b/kiki.hs index 6c72eb5..5017b38 100644 --- a/kiki.hs +++ b/kiki.hs @@ -982,8 +982,10 @@ kiki "merge" args = do Left ("access",Just "auto") -> ( flow { access = AutoAccess }, op ) Left ("home",mb) -> ( flow - , op { opFiles = Map.insert HomePub flow { access=Pub } - $ Map.insert HomeSec flow { access=Sec } + , op { opFiles = Map.insert HomePub flow { typ=KeyRingFile + , access=Pub } + $ Map.insert HomeSec flow { typ=KeyRingFile + , access=Sec } $ opFiles op , opHome = opHome op `mplus` mb } -- cgit v1.2.3 From 3da9f37f578fe6462a3a69e739bb7e21d78f4b89 Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 6 May 2014 02:27:44 -0400 Subject: Implemented --passphrase-fd for 'merge' command --- kiki.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/kiki.hs b/kiki.hs index 5017b38..c84bce2 100644 --- a/kiki.hs +++ b/kiki.hs @@ -874,7 +874,8 @@ kiki "show" args = do kiki "merge" [] = do putStr . unlines $ - [ "kiki merge ( --home[=HOMEDIR]" + [ "kiki merge [ --passphrase-fd=FD ]" + , " ( --home[=HOMEDIR]" , " | --type=(keyring|pem|wallet|hosts)" , " | --access=[auto|secret|public]" , " | --flow=(fill|spill|sync)[,(subkeys|match=SPEC)]" @@ -954,6 +955,16 @@ kiki "merge" args = do ( flow { transforms = filter (/=Autosign) (transforms flow) } , op { opTransforms = filter (/=Autosign) (opTransforms op) } ) + doPassphrase :: StreamInfo -> KeyRingOperation -> String -> (StreamInfo,KeyRingOperation) + doPassphrase flow op pass = + if Map.null (opFiles op) + then ( flow + , op { opPassphrases = PassphraseSpec Nothing Nothing pfd + : opPassphrases op } ) + else error "passphrase-fd must come before any file arguments or --home" + where + pfd = FileDesc (read pass) + buildOp (False,(flow,op)) fname = (False,doFile flow op fname) buildOp (True,(flow,op)) arg@(splitArg->parsed) = case parsed of @@ -970,6 +981,7 @@ kiki "merge" args = do Left ("autosign",Just "n") -> doAutosign False flow op Left ("autosign",Just "no") -> doAutosign False flow op Left ("autosign",Just "false")-> doAutosign False flow op + Left ("passphrase-fd",Just pass) -> doPassphrase flow op pass Left ("create",Just cmd) -> ( flow { initializer = if null cmd then Nothing else Just cmd } , op ) -- cgit v1.2.3 From 08787650f5d99bb9110bb9d7ef92ac249be865ad Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 6 May 2014 02:30:44 -0400 Subject: update usage to reflect multiple passphrases are suported --- kiki.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kiki.hs b/kiki.hs index c84bce2..3bc291f 100644 --- a/kiki.hs +++ b/kiki.hs @@ -874,7 +874,7 @@ kiki "show" args = do kiki "merge" [] = do putStr . unlines $ - [ "kiki merge [ --passphrase-fd=FD ]" + [ "kiki merge [ --passphrase-fd=FD ... ]" , " ( --home[=HOMEDIR]" , " | --type=(keyring|pem|wallet|hosts)" , " | --access=[auto|secret|public]" @@ -965,7 +965,7 @@ kiki "merge" args = do where pfd = FileDesc (read pass) - buildOp (False,(flow,op)) fname = (False,doFile flow op fname) + buildOp (False,(flow,op)) fname = (False,doFile flow op fname) buildOp (True,(flow,op)) arg@(splitArg->parsed) = case parsed of Left ("",Nothing) -> (False,(flow,op)) -- cgit v1.2.3