summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--kiki.cabal5
-rw-r--r--kiki.hs30
2 files changed, 28 insertions, 7 deletions
diff --git a/kiki.cabal b/kiki.cabal
index 8ce59a6..7bd661e 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -14,14 +14,13 @@ build-type: Simple
14Executable kiki 14Executable kiki
15 Main-is: kiki.hs 15 Main-is: kiki.hs
16 Build-Depends: base -any, cmdargs -any, directory -any, 16 Build-Depends: base -any, cmdargs -any, directory -any,
17 openpgp-crypto-api -any, 17 openpgp-util -any,
18 crypto-pubkey (>=0.2.3), cryptohash -any, 18 crypto-pubkey (>=0.2.3), cryptohash -any,
19 crypto-pubkey-types -any, 19 crypto-pubkey-types -any,
20 asn1-types -any, asn1-encoding -any, 20 asn1-types -any, asn1-encoding -any,
21 dataenc -any, text -any, pretty -any, pretty-show -any, 21 dataenc -any, text -any, pretty -any, pretty-show -any,
22 bytestring -any, openpgp (==0.6.1), binary -any, 22 bytestring -any, openpgp (==0.6.1), binary -any,
23 unix, time, crypto-api, cryptocipher (>=0.3.7), 23 unix, time, crypto-api, cryptocipher (>=0.3.7),
24 containers -any, process -any, filepath -any, 24 containers -any, process -any, filepath -any
25 hecc -any
26 ghc-options: -O2 25 ghc-options: -O2
27 c-sources: dotlock.c 26 c-sources: dotlock.c
diff --git a/kiki.hs b/kiki.hs
index edc36d6..0ecfa1c 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -72,9 +72,8 @@ import Data.Monoid ((<>))
72-- import Data.X509 72-- import Data.X509
73import qualified Data.Map as Map 73import qualified Data.Map as Map
74import DotLock 74import DotLock
75import Codec.Crypto.ECC.Base -- hecc package 75-- import Codec.Crypto.ECC.Base -- hecc package
76import Text.Printf 76import Text.Printf
77import Math.NumberTheory.Moduli
78import qualified CryptoCoins as CryptoCoins 77import qualified CryptoCoins as CryptoCoins
79 78
80 79
@@ -961,7 +960,7 @@ data KeySpec =
961 KeyGrip String 960 KeyGrip String
962 | KeyTag Packet String 961 | KeyTag Packet String
963 | KeyUidMatch String 962 | KeyUidMatch String
964 963 deriving Show
965 964
966is40digitHex xs = ys == xs && length ys==40 965is40digitHex xs = ys == xs && length ys==40
967 where 966 where
@@ -1399,6 +1398,15 @@ show_pem keyspec wkgrip db = do
1399 putStrLn $ 1398 putStrLn $
1400 writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec) 1399 writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec)
1401 1400
1401show_key keyspec wkgrip db = do
1402 let s = parseSpec "" keyspec
1403 let ps = do
1404 (_,k) <- filterMatches (fst s) (Map.toList db)
1405 mp <- flattenTop "" True k
1406 return $ packet mp
1407 -- putStrLn $ "show key " ++ show s
1408 putStrLn $ listKeys ps
1409
1402show_wip keyspec wkgrip db = do 1410show_wip keyspec wkgrip db = do
1403 let s = parseSpec wkgrip keyspec 1411 let s = parseSpec wkgrip keyspec
1404 flip (maybe $ warn (keyspec ++ ": not found") >> return ()) 1412 flip (maybe $ warn (keyspec ++ ": not found") >> return ())
@@ -1414,8 +1422,11 @@ parseSpec grip spec = (topspec,subspec)
1414 (toptyp,top) = unprefix ':' topspec0 1422 (toptyp,top) = unprefix ':' topspec0
1415 (subtyp,sub) = unprefix ':' subspec0 1423 (subtyp,sub) = unprefix ':' subspec0
1416 topspec = case () of 1424 topspec = case () of
1417 _ | null top && (subtyp=="fp" || (null subtyp && is40digitHex sub)) 1425 _ | null top && or [ subtyp=="fp"
1426 , null subtyp && is40digitHex sub
1427 ]
1418 -> KeyGrip sub 1428 -> KeyGrip sub
1429 _ | null top && null grip -> KeyUidMatch sub
1419 _ | null top -> KeyGrip grip 1430 _ | null top -> KeyGrip grip
1420 _ | toptyp=="fp" || (null toptyp && is40digitHex top) 1431 _ | toptyp=="fp" || (null toptyp && is40digitHex top)
1421 -> {- trace "using top" $ -} KeyGrip top 1432 -> {- trace "using top" $ -} KeyGrip top
@@ -1533,6 +1544,7 @@ findTag tag wk subkey subsigs = (xs',minsig,ys')
1533 isNotation _ = False 1544 isNotation _ = False
1534 return (tag `elem` ks, sig) 1545 return (tag `elem` ks, sig)
1535 1546
1547{-
1536applyCurve curve x = x*x*x + x*a + b where (a,b)=(geta curve,getb curve) 1548applyCurve curve x = x*x*x + x*a + b where (a,b)=(geta curve,getb curve)
1537 1549
1538secp256k1_oid = [1,3,132,0,10] 1550secp256k1_oid = [1,3,132,0,10]
@@ -1563,6 +1575,7 @@ secp256k1_G = ECPa secp256k1_curve
1563 G = 04 79BE667E F9DCBBAC 55A06295 CE870B07 029BFCDB 2DCE28D9 59F2815B 16F81798 1575 G = 04 79BE667E F9DCBBAC 55A06295 CE870B07 029BFCDB 2DCE28D9 59F2815B 16F81798
1564 483ADA77 26A3C465 5DA4FBFC 0E1108A8 FD17B448 A6855419 9C47D08F FB10D4B8 1576 483ADA77 26A3C465 5DA4FBFC 0E1108A8 FD17B448 A6855419 9C47D08F FB10D4B8
1565 -} 1577 -}
1578-}
1566 1579
1567base58chars = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" 1580base58chars = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
1568 1581
@@ -1681,12 +1694,16 @@ decode_btc_key timestamp str = do
1681 (network_id,us) <- base58_decode str 1694 (network_id,us) <- base58_decode str
1682 return . (network_id,) $ Message $ do 1695 return . (network_id,) $ Message $ do
1683 let d = foldl' (\a b->a*256+b) 0 (map fromIntegral us :: [Integer]) 1696 let d = foldl' (\a b->a*256+b) 0 (map fromIntegral us :: [Integer])
1697 {-
1684 xy = secp256k1_G `pmul` d 1698 xy = secp256k1_G `pmul` d
1685 x = getx xy 1699 x = getx xy
1686 y = gety xy 1700 y = gety xy
1687 -- y² = x³ + 7 (mod p) 1701 -- y² = x³ + 7 (mod p)
1688 y' = sqrtModP' (applyCurve secp256k1_curve x) (getp secp256k1_curve) 1702 y' = sqrtModP' (applyCurve secp256k1_curve x) (getp secp256k1_curve)
1689 y'' = sqrtModPList (applyCurve secp256k1_curve x) (getp secp256k1_curve) 1703 y'' = sqrtModPList (applyCurve secp256k1_curve x) (getp secp256k1_curve)
1704 -}
1705 secp256k1 = ECC.getCurveByName ECC.SEC_p256k1
1706 ECC.Point x y = ECC.ecc_g $ ECC.common_curve secp256k1
1690 pub = cannonical_eckey x y 1707 pub = cannonical_eckey x y
1691 hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub 1708 hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub
1692 address = base58_encode hash 1709 address = base58_encode hash
@@ -1981,6 +1998,9 @@ kiki_usage = do
1981 ," --show-wk Show fingerprints for the working key (which will be used to" 1998 ," --show-wk Show fingerprints for the working key (which will be used to"
1982 ," make signatures) and all its subkeys and UID." 1999 ," make signatures) and all its subkeys and UID."
1983 ,"" 2000 ,""
2001 ," --show-key Show fingerprints for the specified key and all its subkeys"
2002 ," and UID."
2003 ,""
1984 ," --show-all Show fingerprints and UIDs and usage tags for all known keys." 2004 ," --show-all Show fingerprints and UIDs and usage tags for all known keys."
1985 ,"" 2005 ,""
1986 ," --show-pem SPEC" 2006 ," --show-pem SPEC"
@@ -2022,6 +2042,7 @@ main = do
2022 , ("--autosign",0) 2042 , ("--autosign",0)
2023 , ("--show-wk",0) 2043 , ("--show-wk",0)
2024 , ("--show-all",0) 2044 , ("--show-all",0)
2045 , ("--show-key",1)
2025 , ("--show-pem",1) 2046 , ("--show-pem",1)
2026 , ("--show-wip",1) 2047 , ("--show-wip",1)
2027 , ("--help",0) 2048 , ("--help",0)
@@ -2195,6 +2216,7 @@ main = do
2195 -- On last pass, interpret --show-* commands. 2216 -- On last pass, interpret --show-* commands.
2196 let shspec = Map.fromList [("--show-wk", const $ show_wk secfile grip) 2217 let shspec = Map.fromList [("--show-wk", const $ show_wk secfile grip)
2197 ,("--show-all",const $ show_all) 2218 ,("--show-all",const $ show_all)
2219 ,("--show-key",\[x] -> show_key x $ maybe "" id grip)
2198 ,("--show-pem",\[x] -> show_pem x $ maybe "" id grip) 2220 ,("--show-pem",\[x] -> show_pem x $ maybe "" id grip)
2199 ,("--show-wip",\[x] -> show_wip x $ maybe "" id grip) 2221 ,("--show-wip",\[x] -> show_wip x $ maybe "" id grip)
2200 ,("--help", \_ _ ->kiki_usage)] 2222 ,("--help", \_ _ ->kiki_usage)]