4 files changed, 569 insertions, 125 deletions

diff --git a/CryptoCoins.hs b/CryptoCoins.hs
new file mode 100644
index 0000000..8ae092d
--- /dev/null
+++ b/CryptoCoins.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE ViewPatterns #-}
+module CryptoCoins where
+
+import Numeric
+import Data.Word
+import Data.Maybe
+
+data CoinNetwork = CoinNetwork
+    { network_name :: String
+    , public_byte_id :: Word8
+    , private_byte_id :: Word8
+    , source_code_uri :: String
+    }
+ deriving (Show,Read)
+
+-- For forks of bitcoin, grep sources for PUBKEY_ADDRESS
+-- That value + 0x80 will be the private_byte_id.
+-- information source: https://raw.github.com/zamgo/PHPCoinAddress/master/README.md
+coin_networks =
+   [ CoinNetwork "bitcoin"        0x00 0x80 "https://github.com/bitcoin/bitcoin"
+   , CoinNetwork "litecoin"       0x30 0xB0 "https://github.com/litecoin-project/litecoin"
+   , CoinNetwork "peercoin"       0x37 0xB7 "https://github.com/ppcoin/ppcoin" -- AKA: ppcoin
+   , CoinNetwork "namecoin"       0x34 0xB4 "https://github.com/namecoin/namecoin"
+   , CoinNetwork "bbqcoin"        0x05 0xD5 "https://github.com/overware/BBQCoin"
+   , CoinNetwork "bitbar"         0x19 0x99 "https://github.com/aLQ/bitbar"
+   , CoinNetwork "bytecoin"       0x12 0x80 "https://github.com/bryan-mills/bytecoin"
+   , CoinNetwork "chncoin"        0x1C 0x9C "https://github.com/CHNCoin/CHNCoin"
+   , CoinNetwork "devcoin"        0x00 0x80 "http://sourceforge.net/projects/galacticmilieu/files/DeVCoin"
+   , CoinNetwork "feathercoin"    0x0E 0x8E "https://github.com/FeatherCoin/FeatherCoin"
+   , CoinNetwork "freicoin"       0x00 0x80 "https://github.com/freicoin/freicoin"
+   , CoinNetwork "junkcoin"       0x10 0x90 "https://github.com/js2082/JKC"
+   , CoinNetwork "mincoin"        0x32 0xB2 "https://github.com/SandyCohen/mincoin"
+   , CoinNetwork "novacoin"       0x08 0x88 "https://github.com/CryptoManiac/novacoin"
+   , CoinNetwork "onecoin"        0x73 0xF3 "https://github.com/cre8r/onecoin"
+   , CoinNetwork "smallchange"    0x3E 0xBE "https://github.com/bfroemel/smallchange"
+   , CoinNetwork "terracoin"      0x00 0x80 "https://github.com/terracoin/terracoin"
+   , CoinNetwork "yacoin"         0x4D 0xCD "https://github.com/pocopoco/yacoin"
+   , CoinNetwork "bitcoin-t"      0x6F 0xEF ""
+   , CoinNetwork "bbqcoin-t"      0x19 0x99 ""
+   , CoinNetwork "bitbar-t"       0x73 0xF3 ""
+   ]
+   -- fairbrix          -    - https://github.com/coblee/Fairbrix
+   -- ixcoin            -    - https://github.com/ixcoin/ixcoin
+   -- royalcoin         -    - http://sourceforge.net/projects/royalcoin/
+
+lookupNetwork f b = listToMaybe $ filter (\n->f n==b) coin_networks
+
+nameFromSecretByte :: Word8 -> String
+nameFromSecretByte b = maybe (defaultName b) network_name (lookupNetwork private_byte_id b)
+ where
+    defaultName b = "?coin?"++hexit b
+      where
+        hexit b = pad0 $ showHex b "" 
+            where pad0 [c] = '0':c:[]
+                  pad0 cs  = take 2 cs
+
+publicByteFromName n = maybe (secretByteFromName n - 0x80) 
+                             -- exceptions to the above: bbqcoin, bytecoin
+                             public_byte_id
+                             (lookupNetwork network_name n)
+
+secretByteFromName n = maybe (defaultID n) private_byte_id (lookupNetwork network_name n)
+ where
+    defaultID ('?':'c':'o':'i':'n':'?':(readHex->((x,_):_))) 
+                = x
+    defaultID _ = 0x00
diff --git a/OpenPGP.hs b/OpenPGP.hs
deleted file mode 100644
index 75054b3..0000000
--- a/OpenPGP.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-module OpenPGP 
- ( verify
- , fingerprint
- , pgpSign
- , decryptSecretKey
- ) where
-
-import Data.OpenPGP as OpenPGP
-import Data.OpenPGP.CryptoAPI (verify,fingerprint,sign,decryptSecretKey)
-import Data.Time.Clock.POSIX
-import Control.Applicative ( (<$>) )
-import Crypto.Random (newGenIO,SystemRandom)
-import ControlMaybe
-
-now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
-
-stampit timestamp sig = sig { hashed_subpackets = hashed' }
- where
-    hashed_stamps   = filter isStamp (hashed_subpackets sig)
-    unhashed_stamps = filter isStamp (unhashed_subpackets sig)
-    hashed' = case hashed_stamps ++ unhashed_stamps of
-                [] -> SignatureCreationTimePacket (fromIntegral timestamp)
-                      : hashed_subpackets sig
-                _  -> hashed_subpackets sig
-    isStamp (SignatureCreationTimePacket {}) = True
-    isStamp _                                = False
-
--- | Make a signature
---
--- In order to set more options on a signature, pass in a signature packet.
-pgpSign :: 
-    OpenPGP.Message          -- ^ SecretKeys, one of which will be used
-    -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet
-    -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
-    -> String                -- ^ KeyID of key to choose
-    -> IO (Maybe OpenPGP.SignatureOver)
-pgpSign seckeys dta hash_algo keyid =
-    handleIO_ (return Nothing) $ do
-    timestamp <- now
-    g <- newGenIO :: IO SystemRandom
-    let sigs = map (stampit timestamp) $ signatures_over dta
-        dta' = dta { signatures_over = sigs }
-    let (r,g') = sign seckeys dta' hash_algo keyid timestamp g
-    return (Just r)
diff --git a/kiki.cabal b/kiki.cabal
index 0a517f0..8ce59a6 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -15,11 +15,13 @@ Executable kiki
     Main-is: kiki.hs
     Build-Depends:   base -any, cmdargs -any, directory -any,
                      openpgp-crypto-api -any,
-                     crypto-pubkey -any, cryptohash -any,
+                     crypto-pubkey (>=0.2.3), cryptohash -any,
+                     crypto-pubkey-types -any,
                      asn1-types -any, asn1-encoding -any,
                      dataenc -any, text -any, pretty -any, pretty-show -any,
                      bytestring -any, openpgp (==0.6.1), binary -any,
                      unix, time, crypto-api, cryptocipher (>=0.3.7),
-                     containers -any, process -any, filepath -any
+                     containers -any, process -any, filepath -any,
+                     hecc -any
     ghc-options:     -O2
     c-sources: dotlock.c
diff --git a/kiki.hs b/kiki.hs
index 196d080..edc36d6 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -14,7 +14,7 @@ import GHC.IO.Exception ( ioException, IOErrorType(..) )
 import Data.IORef
 import Data.Tuple
 import Data.Binary
-import Data.OpenPGP
+import Data.OpenPGP as OpenPGP
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as Char8
 import qualified Data.ByteString      as S
@@ -23,8 +23,7 @@ import Control.Monad
 import qualified Text.Show.Pretty as PP
 import Text.PrettyPrint as PP hiding ((<>))
 import Data.List
--- import Data.OpenPGP.CryptoAPI (verify,fingerprint,sign,decryptSecretKey)
-import OpenPGP
+import Data.OpenPGP.Util (verify,fingerprint,decryptSecretKey,pgpSign)
 import Data.Ord
 import Data.Maybe
 import Data.Bits
@@ -33,6 +32,12 @@ import Data.Text.Encoding
 import qualified Codec.Binary.Base32 as Base32
 import qualified Codec.Binary.Base64 as Base64
 import qualified Crypto.Hash.SHA1 as SHA1
+import qualified Crypto.Hash.SHA256 as SHA256
+import qualified Crypto.Hash.RIPEMD160 as RIPEMD160
+import qualified Crypto.Types.PubKey.ECC as ECC
+-- import qualified Crypto.Types.PubKey.ECDSA as ECDSA
+-- import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
+
 import Data.Char (toLower)
 import qualified Crypto.PubKey.RSA as RSA
 -- import Crypto.Random (newGenIO,SystemRandom)
@@ -40,6 +45,8 @@ import Data.ASN1.Types
 import Data.ASN1.Encoding
 import Data.ASN1.BinaryEncoding
 import Data.ASN1.BitArray
+import qualified Data.Foldable as Foldable
+import qualified Data.Sequence as Sequence
 import Control.Applicative
 import System.Environment
 import System.Directory
@@ -49,14 +56,15 @@ import System.Process
 import System.Posix.IO (fdToHandle,fdRead)
 import System.Posix.Files
 import System.Posix.Signals
+import System.Posix.Types (EpochTime)
 import System.Process.Internals (runGenProcess_,defaultSignal)
-import System.IO (hPutStrLn,stderr)
+import System.IO (hPutStrLn,stderr,withFile,IOMode(..))
 import System.IO.Error
 import ControlMaybe
 import Data.Char
 import Control.Arrow (first,second)
-import Data.Traversable hiding (mapM,forM)
-import qualified Data.Traversable as Traversable (mapM,forM)
+import Data.Traversable hiding (mapM,forM,sequence)
+import qualified Data.Traversable as Traversable (mapM,forM,sequence)
 import System.Console.CmdArgs
 -- import System.Posix.Time
 import Data.Time.Clock.POSIX
@@ -64,7 +72,30 @@ import Data.Monoid ((<>))
 -- import Data.X509
 import qualified Data.Map as Map
 import DotLock
+import Codec.Crypto.ECC.Base -- hecc package
+import Text.Printf
+import Math.NumberTheory.Moduli
+import qualified CryptoCoins as CryptoCoins
+
+
+-- instance Default S.ByteString where def = S.empty
+
+-- DER-encoded elliptic curve ids
+nistp256_id  = 0x2a8648ce3d030107
+secp256k1_id = 0x2b8104000a
+
+isCryptoCoinKey p =
+    and [ isKey p
+        , key_algorithm p == ECDSA
+        , lookup 'c' (key p) == Just (MPI secp256k1_id)
+        ]
 
+getCryptoCoinTag p | isSignaturePacket p = do
+    -- CryptoCoins.secret
+    let sps = hashed_subpackets p ++ unhashed_subpackets p
+    u <- listToMaybe $ mapMaybe usage sps
+    CryptoCoins.lookupNetwork CryptoCoins.network_name u
+getCryptoCoinTag _ = Nothing
 
 warn str = hPutStrLn stderr str
 
@@ -201,6 +232,7 @@ derRSA rsa = do
     k <- rsaKeyFromPacket rsa
     return $ encodeASN1 DER (toASN1 k [])
 
+rsaPrivateKeyFromPacket :: Packet -> Maybe RSAPrivateKey
 rsaPrivateKeyFromPacket pkt@(SecretKeyPacket {}) = do
     -- public fields...
     n <- lookup 'n' $ key pkt
@@ -238,13 +270,11 @@ getPackets = do
         Left  (_,_,_)            -> return []
 
 
-instance Default S.ByteString where def = S.empty
-
 secretToPublic pkt@(SecretKeyPacket {}) =
     PublicKeyPacket { version = version pkt
                     , timestamp = timestamp pkt
                     , key_algorithm = key_algorithm pkt
-                    , ecc_curve = ecc_curve pkt
+                    -- , ecc_curve = ecc_curve pkt
                     , key = let seckey = key pkt
                                 pubs = public_key_fields (key_algorithm pkt)
                             in filter (\(k,v) -> k `elem` pubs) seckey
@@ -452,6 +482,10 @@ fpmatch grip key =
 
 listKeys pkts = listKeysFiltered [] pkts
 
+ecc_curve k = printf "%x" num :: String
+ where unmpi (MPI num) = num
+       num =  maybe 0 unmpi $ lookup 'c' (key k)
+
 listKeysFiltered grips pkts = do
     let (certs,bs) = getBindings pkts
         as = accBindings bs
@@ -483,6 +517,9 @@ listKeysFiltered grips pkts = do
                         3 -> " <-> "
                 formkind = take kindcol $ defaultkind kind hashed ++ repeat ' '
                 torhash = maybe "" id $ derToBase32 <$> derRSA sub
+                (netid,kind') = maybe (0x0,"bitcoin")
+                                      (\n->(CryptoCoins.publicByteFromName n,n))
+                                      $ listToMaybe kind
             unlines $
                 concat  [ " "
                         -- , grip top
@@ -491,8 +528,13 @@ listKeysFiltered grips pkts = do
                         , " "
                         , fingerprint sub
                         -- , " " ++ torhash
+                        -- , " " ++ (concatMap (printf "%02X") $ S.unpack (ecc_curve sub))
                         ] -- ++ ppShow hashed
-                    :  showsigs claimants
+                    : if isCryptoCoinKey sub
+                        -- then ("      " ++ "B⃦ " ++ bitcoinAddress sub) : showsigs claimants
+                        -- then ("      " ++ "BTC " ++ bitcoinAddress sub) : showsigs claimants
+                        then ("      " ++ "¢ "++kind'++":" ++ bitcoinAddress netid sub) : showsigs claimants
+                        else showsigs claimants
         torkeys = do
             (code,(top,sub), kind, hashed,claimants) <- subs
             guard ("tor" `elem` kind)
@@ -607,6 +649,42 @@ expandPath path (c:cs) | c/='/'    = path ++ "/" ++ (c:cs)
 expandPath path []                 = []
 
 
+-- type TimeStamp = Word32
+
+slurpWIPKeys :: System.Posix.Types.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString])
+slurpWIPKeys stamp "" = ([],[])
+slurpWIPKeys stamp cs =
+    let (b58,xs) = Char8.span (\x -> elem x base58chars) cs
+        mb        = decode_btc_key stamp (Char8.unpack b58)
+    in if L.null b58 
+        then let (ys,xs') = Char8.break (\x -> elem x base58chars) cs
+                 (ks,js)  = slurpWIPKeys stamp xs'
+             in (ks,ys:js) 
+        else let (ks,js) = slurpWIPKeys stamp xs
+             in maybe (ks,b58:js) (\(net,Message [k])->((net,k):ks,js)) mb
+
+readPacketsFromWallet :: 
+    Maybe Packet
+    -> FilePath 
+    -> IO [(Packet,Packet,(Packet,Map.Map FilePath Packet))]
+readPacketsFromWallet wk fname = do
+    timestamp <- handleIO_ (error $ fname++": modificaiton time?") $ 
+                    modificationTime <$> getFileStatus fname
+    input <- L.readFile fname
+    let (ks,junk) = slurpWIPKeys timestamp input
+    when (not (null ks)) $ do
+        -- decrypt wk
+        -- create sigs
+        -- return key/sig pairs
+        return ()
+    return $ do
+        wk <- maybeToList wk
+        guard (not $ null ks)
+        let prep (tagbyte,k) = (wk,k,(k,Map.singleton tag wk))
+                                where tag = CryptoCoins.nameFromSecretByte tagbyte
+        (wk,MarkerPacket,(MarkerPacket,Map.empty))
+         :map prep ks
+
 readPacketsFromFile :: FilePath -> IO Message
 readPacketsFromFile fname = do
     -- warn $ fname ++ ": reading..."
@@ -614,7 +692,7 @@ readPacketsFromFile fname = do
     return $
       case decodeOrFail input of
         Right (_,_,msg ) -> msg
-        Left  (_,_,_)    -> Message []
+        Left  (_,_,_)    -> trace (fname++": read fail") $ Message []
 
 lockFiles fs = do
     let dolock f = do
@@ -806,26 +884,29 @@ guessKeyFormat 'S' "ssh-client" = "PEM"
 guessKeyFormat 'S' "ssh-host"   = "PEM"
 guessKeyFormat _   _            = "PEM" -- "PGP"
 
-writeKeyToFile False "PEM" fname packet = do
-    flip (maybe (return ()))
-         (rsaPrivateKeyFromPacket packet) -- RSAPrivateKey
-        $ \rsa -> do
-    let asn1 = toASN1 rsa []
-        bs = encodeASN1 DER asn1
-        dta = Base64.encode (L.unpack bs)
-        output = writePEM "RSA PRIVATE KEY" dta
-        stamp = toEnum . fromEnum $ timestamp packet
-    createDirectoryIfMissing True (takeDirectory fname)
-    handleIO_ (warn $ fname ++ ": write failure") $ do
-        saved_mask <- setFileCreationMask 0o077
-        writeFile fname output
-        -- Note: The key's timestamp is included in it's fingerprint.
-        --       Therefore, we should attempt to preserve it.
-        setFileTimes fname stamp stamp
-        setFileCreationMask saved_mask
+writeKeyToFile False "PEM" fname packet =
+    case key_algorithm packet of
+    RSA -> do
+        flip (maybe (return ()))
+             (rsaPrivateKeyFromPacket packet) -- RSAPrivateKey
+            $ \rsa -> do
+        let asn1 = toASN1 rsa []
+            bs = encodeASN1 DER asn1
+            dta = Base64.encode (L.unpack bs)
+            output = writePEM "RSA PRIVATE KEY" dta
+            stamp = toEnum . fromEnum $ timestamp packet
+        createDirectoryIfMissing True (takeDirectory fname)
+        handleIO_ (warn $ fname ++ ": write failure") $ do
+            saved_mask <- setFileCreationMask 0o077
+            writeFile fname output
+            -- Note: The key's timestamp is included in it's fingerprint.
+            --       Therefore, we should attempt to preserve it.
+            setFileTimes fname stamp stamp
+            setFileCreationMask saved_mask
+            return ()
+        warn $ fname ++ ": exported"
         return ()
-    -- warn $ fname++ ": wrote"
-    return ()
+    algo -> warn $ fname ++ ": unable to export "++show algo++" key "++fingerprint packet
 
 readKeyFromFile False "PEM" fname = do
     -- warn $ fname ++ ": reading ..."
@@ -849,7 +930,6 @@ readKeyFromFile False "PEM" fname = do
             { version = 4
             , timestamp = toEnum (fromEnum timestamp)
             , key_algorithm = RSA
-            , ecc_curve = def
             , key = [ -- public fields...
                      ('n',rsaN rsa)
                     ,('e',rsaE rsa)
@@ -859,6 +939,7 @@ readKeyFromFile False "PEM" fname = do
                     ,('q',rsaP rsa) -- Note: p & q swapped
                     ,('u',rsaCoefficient rsa)
                     ]
+            -- , ecc_curve = def
             , s2k_useage = 0
             , s2k = S2K 100 ""
             , symmetric_algorithm = Unencrypted
@@ -923,9 +1004,16 @@ origin p n = OriginFlags ispub n
 type OriginMap = Map.Map FilePath OriginFlags
 data MappedPacket = MappedPacket
         { packet :: Packet
+        , usage_tag :: Maybe String
         , locations :: OriginMap
         }
 
+mappedPacket filename p = MappedPacket 
+    { packet = p
+    , usage_tag = Nothing
+    , locations = Map.singleton filename (origin p (-1))
+    }
+
 type TrustMap = Map.Map FilePath Packet
 type SigAndTrust = ( MappedPacket
                    , TrustMap     ) -- trust packets
@@ -945,7 +1033,7 @@ keykey key =
     -- Note: The key's timestamp is included in it's fingerprint.
     --       Therefore, the same key with a different timestamp is
     --       considered distinct using this keykey implementation.
-    fingerprint_material key -- TODO: smaller key?
+    fingerprint_material (key {timestamp=0}) -- TODO: smaller key?
 
 
 
@@ -954,7 +1042,7 @@ uidkey (UserIDPacket str) = str
 -- Compare master keys, LT is prefered for merging
 keycomp (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
 keycomp (PublicKeyPacket {}) (SecretKeyPacket {}) = GT
-keycomp a b | a==b = EQ
+keycomp a b | keykey a==keykey b = EQ
 keycomp a b = error $ unlines ["Unable to merge keys:"
                               , fingerprint a
                               , PP.ppShow a
@@ -965,7 +1053,7 @@ keycomp a b = error $ unlines ["Unable to merge keys:"
 -- Compare subkeys, LT is prefered for merging
 subcomp (SecretKeyPacket {}) (PublicKeyPacket {}) = LT
 subcomp (PublicKeyPacket {}) (SecretKeyPacket {}) = GT
-subcomp a b | a==b = EQ
+subcomp a b | keykey a==keykey b = EQ
 subcomp a b = error $ unlines ["Unable to merge subs:"
                               , fingerprint a
                               , PP.ppShow a
@@ -975,10 +1063,16 @@ subcomp a b = error $ unlines ["Unable to merge subs:"
 subcomp_m a b = subcomp (packet a) (packet b)
 
 merge :: KeyDB -> FilePath -> Message -> KeyDB
-merge db filename (Message ps) = foldl mergeit db (zip [0..] qs)
+merge db filename (Message ps) = merge_ db filename qs
  where
     qs = scanPackets filename ps
-    asMapped n p = MappedPacket p (Map.singleton filename (origin p n))
+
+merge_ :: KeyDB -> FilePath -> [(Packet,Packet,(Packet,Map.Map FilePath Packet))]
+                -> KeyDB
+merge_ db filename qs = foldl mergeit db (zip [0..] qs)
+ where
+    asMapped n p = let m = mappedPacket filename p
+                   in m { locations = fmap (\x->x {originalNum=n}) (locations m) }
     asSigAndTrust n (p,tm) = (asMapped n p,tm)
     emptyUids = Map.empty
     -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets
@@ -997,8 +1091,8 @@ merge db filename (Message ps) = foldl mergeit db (zip [0..] qs)
           = case v of
              Nothing -> Just $ KeyData (asMapped n p) [] emptyUids Map.empty
              Just (KeyData key sigs uids subkeys) | keykey (packet key) == keykey p
-                     -> Just $ KeyData ( MappedPacket (minimumBy keycomp [packet key,p])
-                                                      (Map.insert filename (origin p n) (locations key)) )
+                     -> Just $ KeyData ( (asMapped n (minimumBy keycomp [packet key,p]))
+                                          { locations = Map.insert filename (origin p n) (locations key) } )
                                        sigs
                                        uids
                                        subkeys
@@ -1028,8 +1122,8 @@ merge db filename (Message ps) = foldl mergeit db (zip [0..] qs)
     mergeSubkey :: Int -> Packet -> Maybe SubKey -> Maybe SubKey
     mergeSubkey n p Nothing                  = Just $ SubKey (asMapped n p) []
     mergeSubkey n p (Just (SubKey key sigs)) = Just $
-        SubKey (MappedPacket (minimumBy subcomp [packet key,p])
-                             (Map.insert filename (origin p n) (locations key)))
+        SubKey ((asMapped n (minimumBy subcomp [packet key,p]))
+                 { locations = Map.insert filename (origin p n) (locations key) })
                sigs
 
     mergeUid :: Int ->(Packet,a) -> Maybe ([SigAndTrust],OriginMap) -> Maybe ([SigAndTrust],OriginMap)
@@ -1049,15 +1143,15 @@ merge db filename (Message ps) = foldl mergeit db (zip [0..] qs)
                in xs ++ (mergeSameSig n sig y : ys')
 
 
-    isSameSig (a,_) (MappedPacket b _,_) | isSignaturePacket a && isSignaturePacket b =
+    isSameSig (a,_) (MappedPacket {packet=b},_) | isSignaturePacket a && isSignaturePacket b =
         a { unhashed_subpackets=[] } == b { unhashed_subpackets = [] }
-    isSameSig (a,_) (MappedPacket b _,_) = a==b
+    isSameSig (a,_) (MappedPacket {packet=b},_) = a==b
 
     mergeSameSig :: Int -> (Packet,TrustMap) -> (MappedPacket,TrustMap) -> (MappedPacket, TrustMap)
-    mergeSameSig n (a,ta) (MappedPacket b locs,tb) | isSignaturePacket a && isSignaturePacket b =
-       ( MappedPacket (b { unhashed_subpackets =
+    mergeSameSig n (a,ta) (m@(MappedPacket{packet=b,locations=locs}),tb) | isSignaturePacket a && isSignaturePacket b =
+       ( m { packet = (b { unhashed_subpackets =
                             foldl mergeItem (unhashed_subpackets b) (unhashed_subpackets a) })
-                      (Map.insert filename (origin a n) locs)
+           , locations = Map.insert filename (origin a n) locs }
         , tb `Map.union` ta )
 
      where
@@ -1100,21 +1194,22 @@ flattenAllUids fname ispub uids =
 
 flattenUid :: FilePath -> Bool -> (String,([SigAndTrust],OriginMap)) -> [MappedPacket]
 flattenUid fname ispub (str,(sigs,om)) = 
-    MappedPacket (UserIDPacket str) om : concatSort fname head (unsig fname ispub) sigs
+    (mappedPacket "" $ UserIDPacket str) {locations=om} : concatSort fname head (unsig fname ispub) sigs
 
 flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket]
 flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs
 
 unk :: Bool -> MappedPacket -> MappedPacket
 unk isPublic = if isPublic then toPacket secretToPublic else id
-                where toPacket f (MappedPacket p m) = MappedPacket (f p) m
+                where toPacket f mp@(MappedPacket {packet=p}) = mp {packet=(f p)}
 
 unsig :: FilePath -> Bool -> SigAndTrust -> [MappedPacket]
 unsig fname isPublic (sig,trustmap) = 
     [sig]++ map (asMapped (-1)) ( take 1 . Map.elems $ Map.filterWithKey f trustmap)
   where
     f n _ = n==fname -- && trace ("fname=n="++show n) True
-    asMapped n p = MappedPacket p (Map.singleton fname (origin p n))
+    asMapped n p = let m = mappedPacket fname p
+                   in m { locations = fmap (\x->x {originalNum=n}) (locations m) }
 
 ifSecret (SecretKeyPacket {}) t f = t
 ifSecret _                    t f = f
@@ -1123,7 +1218,7 @@ showPacket :: Packet -> String
 showPacket p | isKey p   = (if is_subkey p 
                               then showPacket0 p
                               else ifSecret p "----Secret-----" "----Public-----")
-                           ++ " "++ fingerprint p
+                           ++ " "++show (key_algorithm p)++" "++fingerprint p
              | isUserID p = showPacket0 p ++ " " ++ show (uidkey p)
              | otherwise = showPacket0 p
 showPacket0 p = concat . take 1 $ words (show p)
@@ -1172,26 +1267,78 @@ writeOutKeyrings lkmap db = do
         -- warn $ "writing "++f
         L.writeFile f (encode m)
 
-cross_merge keyrings f = do
+cross_merge doDecrypt grip0 keyrings wallets f = do
         let relock = do
                 (fsns,failed_locks) <- lockFiles keyrings
-                forM_ failed_locks $ \f -> warn $ "Failed to lock: " ++ f
-                return (fsns,failed_locks)
+                (wsns,failed_wlocks) <- lockFiles wallets
+                forM_ (failed_locks++failed_wlocks) $ \f -> warn $ "Failed to lock: " ++ f
+                return (fsns,wsns,failed_locks,failed_wlocks)
             sec_n:_ = keyrings
-        (fsns,failed_locks) <- relock
+        (fsns,wsns,failed_locks,failed_wlocks) <- relock
         -- let (lks,fs) = unzip fsns
         -- forM_ fs $ \f -> warn $ "locked: " ++ f
         let readp n = fmap (n,) (readPacketsFromFile n)
+            readw wk n = fmap (n,) (readPacketsFromWallet wk n)
         let pass n (fsns,failed_locks) = do
                 ms <- mapM readp (map snd fsns++failed_locks)
-                let db = foldl' (uncurry . merge) Map.empty ms
+                let db0 = foldl' (uncurry . merge) Map.empty ms
                     fstkey = listToMaybe $ mapMaybe isSecringKey ms 
                               where isSecringKey (fn,Message ps)
                                         | fn==sec_n = listToMaybe ps
                                     isSecringKey _  = Nothing
+                    grip = grip0 `mplus` (fingerprint <$> fstkey)
+                    wk = listToMaybe $ do
+                            fp <- maybeToList grip
+                            elm <- Map.toList db0
+                            guard $ matchSpec (KeyGrip fp) elm
+                            let undata (KeyData p _ _ _) = packet p
+                            return $ undata (snd elm)
+                wms <- mapM (readw wk) (map snd wsns++failed_wlocks)
+                let -- db1= foldl' (uncurry . merge_) db0 wms
+                    ts = do
+                        maybeToList wk
+                        (fname,xs) <- wms
+                        (_,sub,(_,m)) <- xs
+                        (tag,top) <- Map.toList m
+                        return (top,fname,sub,tag)
+
+                -- sig' <- makeSig doDecrypt top fname subkey_p tag mbsig
+                    importWalletKey db' (top,fname,sub,tag) = do
+                        doImportG doDecrypt 
+                                  db'
+                                  (fmap keykey $ maybeToList wk)
+                                  tag
+                                  fname
+                                  sub
+                db <- foldM importWalletKey db0 ts
+                let cs = do
+                        wk <- maybeToList wk
+                        let kk = keykey wk
+                        KeyData top topsigs uids subs <- maybeToList $ Map.lookup kk db
+                        (subkk,SubKey mp sigs) <- Map.toList subs
+                        let sub = packet mp
+                        guard $ isCryptoCoinKey sub
+                        tag <- take 1 $ mapMaybe getCryptoCoinTag (map (packet . fst) sigs)
+                        return (tag,mp)
+
+                -- export wallet keys
+                forM_ wsns $ \(_,n) -> do
+                    let cs' = do
+                        (nw,mp) <- cs
+                        let fns = Map.keys (locations mp)
+                        -- trace ("COIN KEY: "++show fns) $ return ()
+                        guard . not $ Map.member n (locations mp)
+                        let wip = walletImportFormat (CryptoCoins.private_byte_id nw) (packet mp)
+                        return (CryptoCoins.network_name nw,wip)
+                    handleIO_ (return ()) $ do
+                    withFile n AppendMode $ \fh -> do
+                    forM_ cs' $ \(net,wip) -> do
+                        warn $ n++": new WalletKey "++net
+                        hPutStrLn fh wip
+
                 -- unlockFiles fsns ----------- Originally, I did this to enable altering the gpg keyrings
                 ------------------------------- from external tools. 
-                (db',_) <- f (sec_n,fstkey) db
+                (db',_) <- f (sec_n,grip) db
                 -- lk <- relock --------------- The design is not quite safe, so it is disabled for now.
                 let lk = (fsns,failed_locks) -- 
                 -------------------------------
@@ -1202,6 +1349,7 @@ cross_merge keyrings f = do
         let lkmap = Map.fromList $ map swap fsns
         writeOutKeyrings lkmap db
         unlockFiles fsns
+        unlockFiles wsns
         return ()
 
 
@@ -1234,12 +1382,16 @@ show_wk secring_file grip db = do
 
 show_all db = do
     let Message packets = flattenKeys True db
+    -- let ks = filter isKey packets
+    -- forM_ ks (warn . showPacket)
+    -- warn $ "BEGIN LIST "++show (length packets)++" packets."
     putStrLn $ listKeys packets
+    -- warn $ "END   LIST "++show (length packets)++" packets."
 
 show_pem keyspec wkgrip db = do
     let s = parseSpec wkgrip keyspec
     flip (maybe $ warn (keyspec ++ ": not found") >> return ())
-         (selectKey s db)
+         (selectPublicKey s db)
          $ \k -> do
     let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k
         der = encodeASN1 DER (toASN1 rsa [])
@@ -1247,6 +1399,14 @@ show_pem keyspec wkgrip db = do
     putStrLn $
         writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec)
 
+show_wip keyspec wkgrip db = do
+    let s = parseSpec wkgrip keyspec
+    flip (maybe $ warn (keyspec ++ ": not found") >> return ())
+         (selectSecretKey s db)
+         $ \k -> do
+    let nwb = maybe 0x80 CryptoCoins.secretByteFromName $ snd s
+    putStrLn $ walletImportFormat nwb k
+
 parseSpec :: String -> String -> (KeySpec,Maybe String)
 parseSpec grip spec = (topspec,subspec)
  where
@@ -1343,7 +1503,6 @@ doExport doDecrypt (db,use_db) (fname,subspec,ms,cmd) =
         pun <- doDecrypt p
         flip (maybe $ error "Bad passphrase?") pun $ \pun -> do
         writeKeyToFile False "PEM" fname pun
-        warn $ fname ++ ": exported"
         return (db,use_db)
 
 findTag tag wk subkey subsigs = (xs',minsig,ys')
@@ -1374,25 +1533,242 @@ findTag tag wk subkey subsigs = (xs',minsig,ys')
                     isNotation _ = False
                 return (tag `elem` ks, sig)
 
+applyCurve curve x = x*x*x + x*a + b where (a,b)=(geta curve,getb curve)
+
+secp256k1_oid = [1,3,132,0,10]
+secp256k1_curve = ECi l a b p r
+ where
+    -- y² = x³ + 7 (mod p)
+    p = 0x0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F 
+    a = 0
+    b = 7
+    -- group order  (also order of base point G)
+    r = n
+    n = 0x0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141 
+    -- cofactor
+    h = 1 
+    -- bit length
+    l = 256
+
+secp256k1_G = ECPa secp256k1_curve 
+                0x79BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798
+                0x483ADA7726A3C4655DA4FBFC0E1108A8FD17B448A68554199C47D08FFB10D4B8 
+    {-
+    The base point G in compressed form is:
+
+        G = 02 79BE667E F9DCBBAC 55A06295 CE870B07 029BFCDB 2DCE28D9 59F2815B 16F81798 
+
+    and in uncompressed form is:
+
+        G = 04 79BE667E F9DCBBAC 55A06295 CE870B07 029BFCDB 2DCE28D9 59F2815B 16F81798
+               483ADA77 26A3C465 5DA4FBFC 0E1108A8 FD17B448 A6855419 9C47D08F FB10D4B8 
+    -}
+
+base58chars = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
+
+base58digits :: [Char] -> Maybe [Int]
+base58digits str = sequence mbs
+ where
+    mbs = map (flip elemIndex base58chars) str
+    
+-- 5HueCGU8rMjxEXxiPuD5BDku4MkFqeZyd4dZ1jvhTVqvbTLvyTJ
+base58_decode :: [Char] -> Maybe (Word8,[Word8])
+base58_decode str = do
+    ds <- base58digits str
+    let n = foldl' (\a b-> a*58 + b) 0 $ ( map fromIntegral ds :: [Integer] )
+        rbytes = unfoldr getbyte n
+        getbyte d = do
+            guard (d/=0)
+            let (q,b) = d `divMod` 256
+            return (fromIntegral b,q)
+    
+    let (rcksum,rpayload) = splitAt 4 $ rbytes
+        a_payload = reverse rpayload
+        hash_result = S.take 4 . SHA256.hash . SHA256.hash . S.pack $ a_payload
+        expected_hash = S.pack $ reverse rcksum
+        (network_id,payload) = splitAt 1 a_payload
+    
+    network_id <- listToMaybe network_id
+    guard (hash_result==expected_hash)
+    return (network_id,payload)
+
+walletImportFormat idbyte k = secret_base58_foo
+ where
+    isSecret (SecretKeyPacket {}) = True
+    isSecret _                    = False
+    secret_base58_foo = base58_encode seckey
+    Just d = lookup 'd' (key k)
+    (len16,bigendian) = S.splitAt 2 (S.concat $ L.toChunks $ encode d)
+    seckey = S.cons idbyte bigendian
+
+
+base58_encode :: S.ByteString -> String
+base58_encode hash = replicate zcount '1' ++ map (base58chars !!) (reverse rdigits)
+  where
+    zcount = S.length . S.takeWhile (==0) $ hash
+    cksum = S.take 4 . SHA256.hash . SHA256.hash $ hash
+    n = foldl' (\a b->a*256+b) 0 . map asInteger $ concatMap S.unpack [hash, cksum]
+    asInteger x = fromIntegral x :: Integer
+    rdigits = unfoldr getdigit n
+     where
+        getdigit d = do
+            guard (d/=0)
+            let (q,b) = d `divMod` 58
+            return (fromIntegral b,q)
+
+cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8]
+ where
+  numToBytes n = reverse $ unfoldr getbyte n
+    where
+        getbyte d = do
+            guard (d/=0)
+            let (q,b) = d `divMod` 256
+            return (fromIntegral b,q)
+  pad32 xs = replicate zlen 0 ++ xs
+    where
+        zlen = 32 - length xs
+    
+oidToDER ns = S.pack $ b1 : concatMap encode ys
+ where
+    (xs,ys) = splitAt 2 ns
+    b1 = fromIntegral $ foldl' (\a b->a*40+b) 0 xs
+    encode x | x <= 127  = [fromIntegral x]
+             | otherwise = (\(x:xs)-> reverse (x:map (0x80 .|.) xs)) 
+                            (base128r x)
+    base128r n = unfoldr getbyte n
+     where
+        getbyte d = do
+            guard (d/=0)
+            let (q,b) = d `divMod` 128
+            return (fromIntegral b,q)
+
+nistp256=[1,2,840,10045,3,1,7]
+nistp256_der=[0x2A,0x86,0x48,0xCE,0x3D,0x03,0x01,0x07]
+-- "\x2a\x86\x48\xce\x3d\x03\x01\x07"
+{-     OID                  Curve description              Curve name
+    ----------------------------------------------------------------   
+    1.2.840.10045.3.1.7  NIST Curve P-256 [FIPS 186-2]  "NIST P-256"
+    1.3.132.0.34         NIST Curve P-384 [FIPS 186-2]  "NIST P-384"  
+    1.3.132.0.35         NIST Curve P-521 [FIPS 186-2]  "NIST P-521"  
+
+    Implementations MUST implement "NIST P-256", "NIST P-384" and "NIST
+    P-521".  The hexadecimal representation used in the public and
+    private key encodings are:
+
+    Curve Name   Len  Hexadecimal representation of the OID
+    ----------------------------------------------------------------   
+    "NIST P-256"  8   0x2A, 0x86, 0x48, 0xCE, 0x3D, 0x03, 0x01, 0x07 
+    "NIST P-384"  6   0x05, 0x2B, 0x81, 0x04, 0x00, 0x22            
+    "NIST P-521"  6   0x05, 0x2B, 0x81, 0x04, 0x00, 0x23          
+-}
+
+bitcoinAddress network_id k = address
+    where
+            Just (MPI x) = lookup 'x' (key k)
+            Just (MPI y) = lookup 'y' (key k)
+            pub = cannonical_eckey x y
+            hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $  pub
+            address = base58_encode hash
+
+-- gpg supported ECDSA curve: 2A8648CE3D030107
+-- 2A 86 48 CE 3D 03 01 07 
+-- 1,2,134,72,206,61,3,1,7
+--  6*128+0x48 840
+--  0x4e*128+0x3d 10045
+-- 1.2.840.10045.3.1.7  --> NIST P-256
+--
+decode_btc_key timestamp str = do
+    (network_id,us) <- base58_decode str
+    return . (network_id,) $ Message $ do
+        let d = foldl' (\a b->a*256+b) 0 (map fromIntegral us :: [Integer])
+            xy = secp256k1_G `pmul` d
+            x = getx xy
+            y = gety xy
+            -- y² = x³ + 7 (mod p)
+            y' = sqrtModP' (applyCurve secp256k1_curve x) (getp secp256k1_curve)
+            y'' = sqrtModPList (applyCurve secp256k1_curve x) (getp secp256k1_curve)
+            pub = cannonical_eckey x y
+            hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $  pub
+            address = base58_encode hash
+            pubstr = concatMap (printf "%02x") $ pub
+            _ = pubstr :: String
+        return $ {- trace (unlines ["pub="++show pubstr
+                                ,"add="++show address
+                                ,"y  ="++show y
+                                ,"y' ="++show y'
+                                ,"y''="++show y'']) -}
+            SecretKeyPacket 
+            { version = 4
+            , timestamp = toEnum (fromEnum timestamp)
+            , key_algorithm = ECDSA
+            , key = [ -- public fields...
+                     ('c',MPI secp256k1_id) -- secp256k1 (bitcoin curve)
+                    ,('l',MPI 256)
+                    ,('x',MPI x)
+                    ,('y',MPI y)
+                    -- secret fields
+                    ,('d',MPI d)
+                    ]
+            , s2k_useage = 0
+            , s2k = S2K 100 ""
+            , symmetric_algorithm = Unencrypted
+            , encrypted_data = ""
+            , is_subkey = True
+            }
+
+doBTCImport doDecrypt db (ms,subspec,content) = do
+    let fetchkey = do
+            timestamp <- now
+            let mbk = fmap discardNetworkID $ decode_btc_key timestamp content
+                discardNetworkID = snd
+            return $ maybe (Message []) id mbk
+    let error s = do
+                        warn s
+                        exitFailure
+    flip (maybe $ error "Cannot import master key.")
+         subspec $ \tag -> do
+    Message parsedkey <- fetchkey
+    flip (maybe $ return db)
+         (listToMaybe parsedkey) $ \key -> do
+    let (m0,tailms) = splitAt 1 ms
+    when (not (null tailms) || null m0)
+        $ error "Key specification is ambiguous."
+    doImportG doDecrypt db m0 tag "" key
+
 doImport doDecrypt db (fname,subspec,ms,_) = do
+    let fetchkey = readKeyFromFile False "PEM" fname
     let error s = do
                         warn s
                         exitFailure
     flip (maybe $ error "Cannot import master key.")
          subspec $ \tag -> do
-    Message parsedkey <- readKeyFromFile False "PEM" fname
+    Message parsedkey <- fetchkey
     flip (maybe $ return db)
          (listToMaybe parsedkey) $ \key -> do
     let (m0,tailms) = splitAt 1 ms
     when (not (null tailms) || null m0)
         $ error "Key specification is ambiguous."
+    doImportG doDecrypt db m0 tag fname key
+
+doImportG doDecrypt db m0 tag fname key = do
+    let error s = do
+                        warn s
+                        exitFailure
     let kk = head m0
         Just (KeyData top topsigs uids subs) = Map.lookup kk db
         subkk = keykey key
-        (is_new, subkey) = maybe (True, SubKey (MappedPacket key (Map.singleton fname (origin key (-1))))
+        (is_new, subkey) = maybe (True, SubKey (mappedPacket fname key)
                                                [])
-                                 (False,)
+                                 ( (False,) . addOrigin )
                                  (Map.lookup subkk subs)
+                             where
+                                addOrigin (SubKey mp sigs) = 
+                                    let mp' = mp
+                                          { locations = Map.insert fname
+                                                             (origin (packet mp) (-1))
+                                                             (locations mp) }
+                                    in SubKey mp' sigs
+        subs' = Map.insert subkk subkey subs
 
         istor = do
             guard (tag == "tor")
@@ -1421,7 +1797,8 @@ doImport doDecrypt db (fname,subspec,ms,_) = do
                      $ \sig -> do
                 let om = Map.singleton fname (origin sig (-1))
                     trust = Map.empty
-                return $ Map.insert idstr ([(MappedPacket sig om,trust)],om) uids
+                return $ Map.insert idstr ([( (mappedPacket fname sig) {locations=om}
+                                            ,trust)],om) uids
 
     let SubKey subkey_p subsigs = subkey
         wk = packet top
@@ -1438,7 +1815,7 @@ doImport doDecrypt db (fname,subspec,ms,_) = do
         Nothing          -> doInsert Nothing db    -- we need to create a new sig
         Just (True,sig)  -> -- we can deduce is_new == False
                             -- we may need to add a tor id
-                            return $ Map.insert kk (KeyData top topsigs uids' subs) db
+                            return $ Map.insert kk (KeyData top topsigs uids' subs') db
         Just (False,sig) -> doInsert (Just sig) db -- We have a sig, but is missing usage@ tag
 
 
@@ -1451,7 +1828,7 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do
             flip (maybe $ error "Failed to make signature.") 
                  (new_sig >>= listToMaybe . signatures_over) 
                  $ \new_sig -> do
-            let mp' = MappedPacket new_sig (Map.singleton fname (origin new_sig (-1)))
+            let mp' = mappedPacket fname new_sig
             return (mp', Map.empty)
         parsedkey = [packet $ subkey_p]
         hashed0 =
@@ -1479,7 +1856,9 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do
                                          (sigpackets 0x19
                                                      hashed0
                                                      [IssuerPacket subgrip]))
-                        SHA1
+                        (if key_algorithm (head parsedkey)==ECDSA
+                            then SHA256
+                            else SHA1)
                         subgrip
     let iss = IssuerPacket (fingerprint wk)
         cons_iss back_sig = iss : map EmbeddedSignaturePacket (signatures_over back_sig)
@@ -1582,7 +1961,12 @@ kiki_usage = do
         ,"     --keyrings FILE FILE..."
         ,"                Provide keyring files other than the implicit secring.gpg and"
         ,"                pubring.gpg in the --homedir.  This option is implicit unless"
-        ,"                --keypairs is used."
+        ,"                --keypairs or --wallets is used."
+        ,""
+        ,"     --wallets  FILE FILE..."
+        ,"                Provide wallet files with secret crypto-coin keys in Wallet"
+        ,"                Import Format.  The keys will be treated as subkeys of your"
+        ,"                current working key (the one shown by --show-wk)."
         ,""
         ,"     --keypairs KEYSPEC KEYSPEC..."
         ,"                Each KEYSPEC specifies that a key should match the content and"
@@ -1602,6 +1986,9 @@ kiki_usage = do
         ,"     --show-pem SPEC"
         ,"                Outputs the PKCS #8 public key corresponding to SPEC."
         ,""
+        ,"     --show-wip SPEC"
+        ,"                Outputs the secret crypto-coin key in Wallet Input Format."
+        ,""
         ,"     --help     Shows this help screen."
         ]
 
@@ -1639,7 +2026,7 @@ main = do
                                      , ("--show-wip",1)
                                      , ("--help",0)
                                      ]
-                          argspec = map fst sargspec ++ ["--keyrings","--keypairs"]
+                          argspec = map fst sargspec ++ ["--keyrings","--keypairs","--wallets"] 
                                         -- "--bitcoin-keypairs"
                                         -- Disabled.  We shouldn't accept private key
                                         -- data on the command line.
@@ -1670,6 +2057,17 @@ main = do
                 guard $ take 1 bdmcb == "}"
                 let cmd = (drop 1 . reverse . drop 1) bdmcb
                 Just (spec,file,cmd)
+        btcpairs0 =
+            flip map (maybe [] id $ Map.lookup "--bitcoin-keypairs" margs) $ \specfile -> do
+                let (spec,efilecmd) = break (=='=') specfile
+                (spec,protocnt) <- do
+                    return $ if take 1 efilecmd=="=" then (spec,drop 1 efilecmd)
+                                                     else ("",spec)
+                let (proto,content) = break (==':') protocnt
+                spec <- return $ if null spec then "bitcoin" else spec
+                return $ 
+                    if take 1 content =="=" then (spec,proto,drop 1 content)
+                                            else (spec,"base58",proto)
         publics =
             flip map (maybe [] id $ Map.lookup "--public" margs) $ \specfile -> do
                 let (spec,efile) = break (=='=') specfile
@@ -1677,6 +2075,7 @@ main = do
                 let file= drop 1 efile
                 Just (spec,file)
         keyrings_ = maybe [] id $ Map.lookup "--keyrings" margs
+        wallets   = maybe [] id $ Map.lookup "--wallets" margs
         passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs
         decrypt wk = do
             -- warn $ "decryptKey "++fingerprint wk
@@ -1706,6 +2105,7 @@ main = do
         exitFailure
 
     let keypairs = catMaybes keypairs0
+        btcpairs = catMaybes btcpairs0
 
     (homedir,secring,pubring,grip0) <- getHomeDir ( concat <$> Map.lookup "--homedir" margs)
 
@@ -1717,9 +2117,7 @@ main = do
     putStrLn $ "keyrings = "++show keyrings
     -}
 
-    cross_merge keyrings $ \(secfile,fstkey) db -> do
-        let grip = grip0 `mplus` (fingerprint <$> fstkey)
-
+    cross_merge decrypt grip0 keyrings wallets $ \(secfile,grip) db -> do
         let get_use_db = maybe (return db) import_db 
                             $ Map.lookup "--import" margs
             import_db _ = do
@@ -1733,7 +2131,7 @@ main = do
                 altered = map (second append_loc) to_alters
                 append_loc (KeyData p a b c) = KeyData p' a b c
                  where p' = p { locations = Map.insert pubring
-                                                       (origin (packet p) (-1))
+                                                       (origin (secretToPublic (packet p)) (-1))
                                                        (locations p) 
                               }
                 dont_have (KeyData p _ _ _) = not . Map.member pubring
@@ -1741,8 +2139,8 @@ main = do
         use_db0 <- get_use_db
 
         let pkeypairs = maybe [] id $ do
-                            g <- grip
-                            return $ map (\(spec,f,cmd)-> (parseSpec g spec,f,cmd)) keypairs
+                            keygrip <- grip
+                            return $ map (\(spec,f,cmd)-> (parseSpec keygrip spec,f,cmd)) keypairs
         fs <- forM pkeypairs $ \((topspec,subspec),f,cmd) -> do
             -- Note that it's important to discard the KeyData objects
             -- returned by filterMatches and retain only the keys.
@@ -1752,8 +2150,24 @@ main = do
             f_found <- doesFileExist f
             return (f_found,(f,subspec,ms,cmd))
 
+
         let (imports,exports) = partition fst fs
         use_db <- foldM (doImport decrypt) use_db0 (map snd imports)
+
+        let (btcs,bad_btcs) = partition isSupportedBTC btcpairs
+            isSupportedBTC (spec,"base58",cnt) = True
+            isSupportedBTC _                   = False
+            dblist = Map.toList use_db
+            pbtcs = maybe [] id $ do
+                        keygrip <- grip
+                        let conv (spec,proto,cnt) = 
+                                    let (topspec,subspec) = parseSpec keygrip spec
+                                        ms = map fst $ filterMatches topspec dblist
+                                    in (ms,subspec,cnt)
+                        return $ map conv btcs
+
+        use_db <- foldM (doBTCImport decrypt) use_db pbtcs
+
         (ret_db,_) <- foldM (doExport decrypt) (Just use_db,use_db) (map snd exports)
 
         use_db <-
@@ -1782,6 +2196,7 @@ main = do
             let shspec = Map.fromList [("--show-wk", const $ show_wk secfile grip)
                                       ,("--show-all",const $ show_all)
                                       ,("--show-pem",\[x] -> show_pem x $ maybe "" id grip)
+                                      ,("--show-wip",\[x] -> show_wip x $ maybe "" id grip)
                                       ,("--help", \_ _ ->kiki_usage)]
                 shargs = mapMaybe (\(x:xs) -> (,xs) <$> Map.lookup x shspec) sargs
 
@@ -1869,9 +2284,10 @@ main = do
                     let uidxs0 = map packet $ flattenUid "" True (str,ps)
                     -- addition<- signSelfAuthTorKeys' selfkey g keys grip timestamp mkey uidxs0
                     additional <- signSelfAuthTorKeys' selfkey   keys grip           mkey uidxs0
-                    let ps' = ( map ( (,tmap) . flip MappedPacket om) additional 
+                    let ps' = ( map ( (,tmap) . toMappedPacket om) additional 
                                  ++ fst ps
                               , Map.union om (snd ps) )
+                        toMappedPacket om p = (mappedPacket "" p) {locations=om}
                         om = Map.singleton "--autosign" (origin p (-1)) where p = UserIDPacket str
                         tmap = Map.empty
                     return ps'
@@ -2080,12 +2496,12 @@ main = do
 
     -}
 
+    {-
     doCmd cmd@(Cross_Merge {}) = do
         (homedir,secring,pubring,grip0) <- getHomeDir (homedir cmd)
         -- grip0 may be empty, in which case we should use the first key
         cross_merge (secring:pubring:files cmd) $ \_ db -> return $ (Just db,db)
 
-    {-
     doCmd cmd@(CatPub {}) = do
         let spec:files = catpub_args cmd
         let (topspec,subspec) = unprefix '/' spec
@@ -2394,11 +2810,15 @@ isTopKey _ = False
 filterMatches :: KeySpec -> [(KeyKey,KeyData)] -> [(KeyKey,KeyData)]
 filterMatches spec ks = filter (matchSpec spec) ks
 
-selectKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
-selectKey (spec,mtag) db = do
-    -- Note: Because of the behavior of flattenKeys,
-    --       selectKey cannot return a SecretKeyPacket
-    let Message ps = flattenKeys True db
+selectSecretKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
+selectSecretKey (spec,mtag) db = selectKey0 False (spec,mtag) db
+
+selectPublicKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
+selectPublicKey (spec,mtag) db = selectKey0 True (spec,mtag) db
+
+selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
+selectKey0 wantPublic (spec,mtag) db = do
+    let Message ps = flattenKeys wantPublic db
         ys = snd $ seek_key spec ps
     flip (maybe (listToMaybe ys)) mtag $ \tag -> do
     let (subspec,ys1) = (KeyTag y tag,ys1) where y:ys1 = ys