diff options
-rw-r--r-- | kiki.cabal | 5 | ||||
-rw-r--r-- | kiki.hs | 30 |
2 files changed, 28 insertions, 7 deletions
@@ -14,14 +14,13 @@ build-type: Simple | |||
14 | Executable kiki | 14 | Executable 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 |
@@ -72,9 +72,8 @@ import Data.Monoid ((<>)) | |||
72 | -- import Data.X509 | 72 | -- import Data.X509 |
73 | import qualified Data.Map as Map | 73 | import qualified Data.Map as Map |
74 | import DotLock | 74 | import DotLock |
75 | import Codec.Crypto.ECC.Base -- hecc package | 75 | -- import Codec.Crypto.ECC.Base -- hecc package |
76 | import Text.Printf | 76 | import Text.Printf |
77 | import Math.NumberTheory.Moduli | ||
78 | import qualified CryptoCoins as CryptoCoins | 77 | import 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 | ||
966 | is40digitHex xs = ys == xs && length ys==40 | 965 | is40digitHex 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 | ||
1401 | show_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 | |||
1402 | show_wip keyspec wkgrip db = do | 1410 | show_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 | {- | ||
1536 | applyCurve curve x = x*x*x + x*a + b where (a,b)=(geta curve,getb curve) | 1548 | applyCurve curve x = x*x*x + x*a + b where (a,b)=(geta curve,getb curve) |
1537 | 1549 | ||
1538 | secp256k1_oid = [1,3,132,0,10] | 1550 | secp256k1_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 | ||
1567 | base58chars = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" | 1580 | base58chars = "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)] |