Merge branch 'master' of jotunheim:samizdat/kiki

2 files changed, 365 insertions, 144 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index f7ea780..ffd8183 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,27 +28,30 @@ module KeyRing
       KikiResult(..)
     , KikiCondition(..)
     , KikiReportAction(..)
+    , errorString
+    , reportString
     -- * Manipulating Keyrings
     , runKeyRing
+    , KeyRingOperation(..)
+    , PassphraseSpec(..)
+    , Transform(..)
+    -- , PacketUpdate(..)
+    -- , guardAuthentic
+    -- * Describing File Operations
     , StreamInfo(..)
     , Access(..)
+    , FileType(..)
+    , InputFile(..)
     , KeyFilter(..)
-    , KeyRingOperation(..)
-    , PassphraseSpec(..)
-    , errorString
-    , reportString
+    -- * Results of a KeyRing Operation
     , KeyRingRuntime(..)
-    , InputFile(..)
-    , FileType(..)
-    , importPublic
-    , importSecret
-    , subkeysOnly
-    , PacketUpdate(..)
-    , noManip
     , KeyDB
     , KeyData(..)
     , SubKey(..)
     , packet
+    , locations
+    , keyflags
+    -- * Miscelaneous Utilities
     , isKey
     , derRSA
     , derToBase32
@@ -53,21 +59,18 @@ module KeyRing
     , filterMatches
     , flattenKeys
     , flattenTop
-    , guardAuthentic
     , Hosts.Hosts
     , isCryptoCoinKey
-    , keyflags
-    , locations
     , matchpr
     , parseSpec
     , parseUID
+    , UserIDRecord(..)
     , pkcs8
     , RSAPublicKey(..)
     , rsaKeyFromPacket
     , secretToPublic
     , selectPublicKey
     , selectSecretKey
-    , UserIDRecord(..)
     , usage
     , usageString
     , walletImportFormat
@@ -129,7 +132,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 )
@@ -185,28 +187,42 @@ 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
 type Initializer = String
-type PasswordFile = InputFile
 
-data FileType = KeyRingFile (Maybe PasswordFile)
-              -- ^ PasswordFile parameter is deprecated in favor
-              -- of kPassphrases. TODO: remove it.
+data FileType = KeyRingFile
               | PEMFile
-              | WalletFile -- (Maybe UsageTag)
+              | WalletFile
               | Hosts
 
-data Access = AutoAccess -- ^ secret or public as appropriate based on existing content
+-- | 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.
+                         --   (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'.
 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
@@ -216,18 +232,54 @@ data KeyFilter = KF_None -- ^ No keys will be imported.
                               -- identity (signed or self-authenticating).
                | KF_All -- ^ All keys will be imported.
 
-data StreamInfo = StreamInfo
-    { access :: Access
+-- | 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.  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)
+    --
+    -- '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
+    -- ^ Per-file transformations that occur before the contents of a file are
+    -- spilled into the common pool.
     }
 
 
@@ -247,9 +299,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
@@ -261,11 +315,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
-                        , rtRingAccess :: Map.Map FilePath Access
+                        -- ^ The common information pool where files spilled
+                        -- their content and from which they received new
+                        -- content.
+                        , 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
+                        -- detected value that was used by the algorithm.
                         }
 
 -- | TODO: Packet Update should have deletion action
@@ -273,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
@@ -288,16 +352,31 @@ 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 <root@HOSTNAME.onion>
  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]
-    , kManip :: KeyRingRuntime -> KeyData -> [PacketUpdate]--[KeyRingAddress PacketUpdate]
-    -- ^ TODO: this is deprecated in favor of kTransform (remove it)
-    , homeSpec :: Maybe String
+    { 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.
+    , 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 +400,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 +552,14 @@ 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 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
@@ -957,8 +1037,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
@@ -978,11 +1061,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)
@@ -1029,7 +1116,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 +1173,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
 
@@ -1119,7 +1206,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
                                     )
@@ -1127,11 +1214,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 = Map.filter (isring . typ) $ opFiles keyring
 
         readp f stream = fmap readp0 $ readPacketsFromFile ctx f
          where
@@ -1147,7 +1234,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)
 
@@ -1157,8 +1244,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
@@ -1175,13 +1260,33 @@ 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
+                             }
+    transformed0 <-
+        let trans f (info,ps) = do
+                let manip = combineTransforms (transforms info)
+                    rt1 = rt0 { rtKeyDB = merge Map.empty f ps }
+                    acc = Just Sec /= Map.lookup f accs
+                r <- performManipulations doDecrypt rt1 mwk manip
+                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
+        reportTrans = concat $ Map.elems $ fmap fst transformed
 
     -- Wallets
     let importWalletKey wk db' (top,fname,sub,tag) = do
@@ -1207,7 +1312,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)
@@ -1227,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
@@ -1448,7 +1553,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
@@ -1494,10 +1599,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 ()
@@ -1536,7 +1637,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)
@@ -1564,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
@@ -1708,24 +1809,26 @@ 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) $ 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
+    return $ doDecrypt unkeysRef ({- pws `Map.union` -} pws2) defpw
  where
     doDecrypt :: IORef (Map.Map KeyKey Packet)
                 -> Map.Map FilePath (IO S.ByteString)
@@ -1764,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
@@ -1830,7 +1932,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)
 
@@ -1892,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 (kTransform operation)) >>= take 1
+    updates = -- kManip operation rt kd ++
+              concatMap (\t -> resolveTransform t rt kd) sanitized
+    sanitized = group (sort trans) >>= take 1
 
 isSubkeySignature (SubkeySignature {}) = True
 isSubkeySignature _                    = False
@@ -2024,9 +2126,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
@@ -2074,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)
@@ -2485,10 +2587,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
diff --git a/kiki.hs b/kiki.hs
index b3147ff..00e458f 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)
@@ -735,18 +705,10 @@ 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)
-        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
@@ -758,22 +720,25 @@ sync bExport bImport bSecret cmdarg args_raw = do
                                                , fill = rtyp
                                                , spill = KF_All
                                                , access = AutoAccess
-                                               , initializer = Nothing }
+                                               , initializer = Nothing
+                                               , transforms = [] }
         kikiOp = KeyRingOperation
-            { kFiles = Map.fromList $
+            { 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 []
                 ++ if bSecret then walts else []
                 ++ hosts
-            , kManip = maybe noManip (const doAutosign) $ Map.lookup "--autosign" margs
-            , homeSpec = homespec
+            , opPassphrases = do pfile <- maybeToList passfd
+                                 return $ PassphraseSpec Nothing Nothing pfile
+            , opTransforms = maybe [] (const [Autosign]) $ Map.lookup "--autosign" margs
+            , opHome = homespec
             }
 
     (\f -> maybe f (const $ kiki_usage bSecret cmdarg) $ Map.lookup "--help" margs) $ do
@@ -860,13 +825,14 @@ kiki "show" args = do
         hosts = []
         walts = []
         streaminfo = StreamInfo { fill = KF_None
-                                , typ = KeyRingFile passfd
+                                , typ = KeyRingFile
                                 , spill = KF_All
                                 , initializer = Nothing
                                 , access = AutoAccess
+                                , transforms = []
                                 }
         kikiOp = KeyRingOperation
-            { kFiles = Map.fromList $
+            { opFiles = Map.fromList $
                 [ ( HomeSec, streaminfo { access = Sec })
                 , ( HomePub, streaminfo { access = Pub })
                 ]
@@ -874,8 +840,10 @@ kiki "show" args = do
                 ++ pems 
                 ++ walts 
                 ++ hosts
-            , kManip = noManip 
-            , homeSpec = homespec
+            , opPassphrases = do pfile <- maybeToList passfd
+                                 return $ PassphraseSpec Nothing Nothing pfile
+            , opTransforms = []
+            , opHome = homespec
             }
 
     (\f -> maybe f (const $ kiki_usage False "show") $ Map.lookup "--help" margs) $ do
@@ -904,6 +872,158 @@ kiki "show" args = do
     forM_ report $ \(fname,act) -> do
         putStrLn $ fname ++ ": " ++ reportString act
 
+kiki "merge" [] = do
+    putStr . unlines $
+        [ "kiki merge [ --passphrase-fd=FD ... ]"
+        , "           ( --home[=HOMEDIR]"
+        , "           | --type=(keyring|pem|wallet|hosts)"
+        , "           | --access=[auto|secret|public]"
+        , "           | --flow=(fill|spill|sync)[,(subkeys|match=SPEC)]"
+        , "           | --create=CMD"
+        , "           | --autosign[=no]"
+        , "           | --"
+        , "           | FILE ) ..."]
+kiki "merge" args | "--help" `elem` args = do
+    kiki "merge" []
+    -- TODO: more help
+kiki "merge" args = do
+    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) } )
+
+    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
+            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 ("passphrase-fd",Just pass) -> doPassphrase flow op pass
+            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 { typ=KeyRingFile
+                                                         , access=Pub }
+                                 $ Map.insert HomeSec flow { typ=KeyRingFile
+                                                           , 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 =
+    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" )
@@ -916,6 +1036,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