work in progress: buildKeyDB

1 files changed, 0 insertions, 272 deletions

diff --git a/kiki.hs b/kiki.hs
index 365562b..d7ea9c7 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -347,13 +347,6 @@ isPublicMaster _ = False
 
 now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
 
-usage (NotationDataPacket
-        { human_readable = True
-        , notation_name  = "usage@"
-        , notation_value = u
-        }) = Just u
-usage _    = Nothing
-
 verifyBindings keys nonkeys = (top ++ filter isSubkeySignature embedded,othersigs)
  where
     verified = do
@@ -380,10 +373,6 @@ grip k = drop 32 $ fingerprint k
 
 smallpr k = drop 24 $ fingerprint k
 
--- matchpr computes the fingerprint of the given key truncated to
--- be the same lenght as the given fingerprint for comparison.
-matchpr fp k = reverse $ zipWith const (reverse (fingerprint k)) fp
-
 
 disjoint_fp ks = {- concatMap group2 $ -} transpose grouped
  where
@@ -587,58 +576,6 @@ listKeysFiltered grips pkts = do
     "master-key " ++ fingerprint top ++ "\n" ++ uid ++"  ...\n" ++ subkeys ++ "\n"
 
 
-data PGPKeyFlags =
-    Special
-    | Vouch -- Signkey
-    | Sign
-    | VouchSign
-    | Communication
-    | VouchCommunication
-    | SignCommunication
-    | VouchSignCommunication
-    | Storage
-    | VouchStorage
-    | SignStorage
-    | VouchSignStorage
-    | Encrypt
-    | VouchEncrypt
-    | SignEncrypt
-    | VouchSignEncrypt
- deriving (Eq,Show,Read,Enum)
-
-usageString flgs =
- case flgs of
-    Special -> "special"
-    Vouch -> "vouch" -- signkey
-    Sign -> "sign"
-    VouchSign -> "vouch-sign"
-    Communication -> "communication"
-    VouchCommunication -> "vouch-communication"
-    SignCommunication -> "sign-communication"
-    VouchSignCommunication -> "vouch-sign-communication"
-    Storage -> "storage"
-    VouchStorage -> "vouch-storage"
-    SignStorage -> "sign-storage"
-    VouchSignStorage -> "vouch-sign-storage"
-    Encrypt -> "encrypt"
-    VouchEncrypt -> "vouch-encrypt"
-    SignEncrypt -> "sign-encrypt"
-    VouchSignEncrypt -> "vouch-sign-encrypt"
-
-
-keyflags flgs@(KeyFlagsPacket {}) =
-    Just . toEnum $
-        (   bit 0x1 certify_keys
-        .|. bit 0x2 sign_data
-        .|. bit 0x4 encrypt_communication
-        .|. bit 0x8 encrypt_storage )     :: Maybe PGPKeyFlags
-    -- other flags:
-    --  split_key
-    --  authentication (ssh-client)
-    --  group_key
- where
-    bit v f = if f flgs then v else 0
-keyflags _ = Nothing
 
 
 modifyUID (UserIDPacket str) = UserIDPacket str'
@@ -666,53 +603,6 @@ 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,_) = 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..."
-    input <- L.readFile fname
-#if MIN_VERSION_binary(0,6,4)
-    return $
-      case decodeOrFail input of
-        Right (_,_,msg ) -> msg
-        Left  (_,_,_)    -> trace (fname++": read fail") $ Message []
-#else
-    return $ decode input
-#endif
-
 -- | Attempts to lock each file in the list.
 -- Returns a list of locks and a list of filenames
 -- that could not be locked.
@@ -984,12 +874,6 @@ getPassphrase cmd =
 
 #define HOMEOPTION (def &= explicit &= name "homedir" &= typDir )
 
-data KeySpec =
-      KeyGrip String
-    | KeyTag Packet String
-    | KeyUidMatch String
- deriving Show
-
 is40digitHex xs = ys == xs && length ys==40
   where
     ys = filter ishex xs
@@ -1062,7 +946,6 @@ sortByHint fname f = sortBy (comparing gethint)
     defnum = -1
 
 keyMappedPacket (KeyData k _ _ _) = k
-keyPacket (KeyData k _ _ _) = packet k
 
 writeOutKeyrings :: Map.Map FilePath t -> KeyDB -> IO ()
 writeOutKeyrings lkmap db = do
@@ -1417,34 +1300,6 @@ secp256k1_G = ECPa secp256k1_curve
     -}
 -}
 
-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
@@ -1530,48 +1385,6 @@ bitcoinAddress network_id k = address
 --  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)
-            -}
-            secp256k1 = ECC.getCurveByName ECC.SEC_p256k1
-            ECC.Point x y = ECC.ecc_g $ ECC.common_curve secp256k1
-            -- 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
@@ -2494,26 +2307,6 @@ selectKey0 wantPublic (spec,mtag) db = do
         zs = snd $ seek_key subspec ys1
     listToMaybe zs
 
-matchSpec (KeyGrip grip) (_,KeyData p _ _ _) 
-    | matchpr grip (packet p)==grip = True
-    | otherwise                     = False
-
-matchSpec (KeyTag key tag) (_,KeyData _ sigs _ _) = not . null $ filter match ps
- where
-    ps = map (packet .fst) sigs
-    match p = isSignaturePacket p
-                && has_tag tag p
-                && has_issuer key p
-    has_issuer key p = isJust $ do
-        issuer <- signature_issuer p
-        guard $ matchpr issuer key == issuer
-    has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p)
-                    || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p))
-
-matchSpec (KeyUidMatch pat) (_,KeyData _ _ uids _) = not $ null us
-  where
-    us = filter (isInfixOf pat) $ Map.keys uids
-
 seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet])
 seek_key (KeyGrip grip) sec = (pre, subs)
   where
@@ -2614,68 +2407,3 @@ sigpackets typ hashed unhashed = return $
         0 -- Word16 -- Left 16 bits of the signed hash value
         [] -- [MPI]
 
-keyFlags  wkun uids = keyFlags0 wkun (filter isSignaturePacket uids)
- {-
- where
-    vs = map (verify (Message [wkun])) (signatures (Message (wkun:uids)))
-    ws = map signatures_over vs
-    xs = filter null ws
-    -}
-
-keyFlags0 wkun uidsigs = concat
-                      [ keyflags
-                      , preferredsym
-                      , preferredhash
-                      , preferredcomp
-                      , features ]
-
- where
-    subs = concatMap hashed_subpackets uidsigs
-    keyflags = filterOr isflags subs $
-               KeyFlagsPacket { certify_keys = True
-                              , sign_data = True
-                              , encrypt_communication = False
-                              , encrypt_storage = False
-                              , split_key = False
-                              , authentication = False
-                              , group_key = False
-                              }
-    preferredsym = filterOr ispreferedsym subs $
-               PreferredSymmetricAlgorithmsPacket
-                              [ AES256
-                              , AES192
-                              , AES128
-                              , CAST5
-                              , TripleDES
-                              ]
-    preferredhash = filterOr ispreferedhash subs $
-               PreferredHashAlgorithmsPacket
-                              [ SHA256
-                              , SHA1
-                              , SHA384
-                              , SHA512
-                              , SHA224
-                              ]
-    preferredcomp = filterOr ispreferedcomp subs $
-               PreferredCompressionAlgorithmsPacket
-                              [ ZLIB
-                              , BZip2
-                              , ZIP
-                              ]
-    features = filterOr isfeatures subs $
-               FeaturesPacket { supports_mdc = True
-                              }
-
-    filterOr pred xs def = if null rs then [def] else rs where rs=filter pred xs
-
-    isflags (KeyFlagsPacket {}) = True
-    isflags _ = False
-    ispreferedsym (PreferredSymmetricAlgorithmsPacket {}) = True
-    ispreferedsym _ = False
-    ispreferedhash (PreferredHashAlgorithmsPacket {}) = True
-    ispreferedhash _ = False
-    ispreferedcomp (PreferredCompressionAlgorithmsPacket {}) = True
-    ispreferedcomp _ = False
-    isfeatures (FeaturesPacket {}) = True
-    isfeatures _ = False
-