diff options
author | joe <joe@blackbird> | 2014-01-16 16:51:24 -0500 |
---|---|---|
committer | joe <joe@blackbird> | 2014-01-16 16:51:24 -0500 |
commit | 802c204c3202df3a3340ea0479cc11a34cd8a042 (patch) | |
tree | e90f123e41e2f690712645a334065690cdbc7fe4 /kiki.hs | |
parent | 214907bae05c29ccf24e106eb7f9bb9b77c161e6 (diff) |
Removed unused bindings.
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 55 |
1 files changed, 29 insertions, 26 deletions
@@ -230,7 +230,6 @@ sshrsa e n = runPut $ do | |||
230 | decode_sshrsa :: Char8.ByteString -> Maybe RSAPublicKey | 230 | decode_sshrsa :: Char8.ByteString -> Maybe RSAPublicKey |
231 | decode_sshrsa bs = do | 231 | decode_sshrsa bs = do |
232 | let (pre,bs1) = Char8.splitAt 11 bs | 232 | let (pre,bs1) = Char8.splitAt 11 bs |
233 | v = runPut (putWord32be 7 >> putByteString "ssh-rsa") | ||
234 | guard $ pre == runPut (putWord32be 7 >> putByteString "ssh-rsa") | 233 | guard $ pre == runPut (putWord32be 7 >> putByteString "ssh-rsa") |
235 | let rsakey = flip runGet bs1 $ do | 234 | let rsakey = flip runGet bs1 $ do |
236 | LengthPrefixedBE e <- get | 235 | LengthPrefixedBE e <- get |
@@ -429,7 +428,7 @@ getBindings :: | |||
429 | getBindings pkts = (sigs,bindings) | 428 | getBindings pkts = (sigs,bindings) |
430 | where | 429 | where |
431 | (sigs,concat->bindings) = unzip $ do | 430 | (sigs,concat->bindings) = unzip $ do |
432 | let (keys,nonkeys) = partition isKey pkts | 431 | let (keys,_) = partition isKey pkts |
433 | keys <- disjoint_fp keys | 432 | keys <- disjoint_fp keys |
434 | let (bs,sigs) = verifyBindings keys pkts | 433 | let (bs,sigs) = verifyBindings keys pkts |
435 | return . ((keys,sigs),) $ do | 434 | return . ((keys,sigs),) $ do |
@@ -530,9 +529,8 @@ listKeysFiltered grips pkts = do | |||
530 | matchgrip _ = False | 529 | matchgrip _ = False |
531 | gs = filter matchgrip $ groupBy sameMaster (sortBy (comparing code) as) | 530 | gs = filter matchgrip $ groupBy sameMaster (sortBy (comparing code) as) |
532 | showsigs claimants = map (\k -> " " ++ "^ signed: " ++ fingerprint k) claimants | 531 | showsigs claimants = map (\k -> " " ++ "^ signed: " ++ fingerprint k) claimants |
533 | subs <- gs | 532 | subs@((_,(top,_),_,_,_):_) <- gs |
534 | let (code,(top,sub), kind, hashed,claimants):_ = subs | 533 | let subkeys = do |
535 | subkeys = do | ||
536 | (code,(top,sub), kind, hashed,claimants) <- subs | 534 | (code,(top,sub), kind, hashed,claimants) <- subs |
537 | let ar = case code of | 535 | let ar = case code of |
538 | 0 -> " ??? " | 536 | 0 -> " ??? " |
@@ -540,7 +538,7 @@ listKeysFiltered grips pkts = do | |||
540 | 2 -> " <-- " | 538 | 2 -> " <-- " |
541 | 3 -> " <-> " | 539 | 3 -> " <-> " |
542 | formkind = take kindcol $ defaultkind kind hashed ++ repeat ' ' | 540 | formkind = take kindcol $ defaultkind kind hashed ++ repeat ' ' |
543 | torhash = maybe "" id $ derToBase32 <$> derRSA sub | 541 | -- torhash = maybe "" id $ derToBase32 <$> derRSA sub |
544 | (netid,kind') = maybe (0x0,"bitcoin") | 542 | (netid,kind') = maybe (0x0,"bitcoin") |
545 | (\n->(CryptoCoins.publicByteFromName n,n)) | 543 | (\n->(CryptoCoins.publicByteFromName n,n)) |
546 | $ listToMaybe kind | 544 | $ listToMaybe kind |
@@ -593,7 +591,7 @@ listKeysFiltered grips pkts = do | |||
593 | listToMaybe $ filter match torkeys | 591 | listToMaybe $ filter match torkeys |
594 | unlines $ [ " " ++ ar ++ "@" ++ " " ++ uid_full parsed ] | 592 | unlines $ [ " " ++ ar ++ "@" ++ " " ++ uid_full parsed ] |
595 | ++ showsigs secondary | 593 | ++ showsigs secondary |
596 | (_,sigs) = unzip certs | 594 | -- (_,sigs) = unzip certs |
597 | "master-key " ++ fingerprint top ++ "\n" ++ uid ++" ...\n" ++ subkeys ++ "\n" | 595 | "master-key " ++ fingerprint top ++ "\n" ++ uid ++" ...\n" ++ subkeys ++ "\n" |
598 | 596 | ||
599 | 597 | ||
@@ -696,7 +694,7 @@ readPacketsFromWallet wk fname = do | |||
696 | timestamp <- handleIO_ (error $ fname++": modificaiton time?") $ | 694 | timestamp <- handleIO_ (error $ fname++": modificaiton time?") $ |
697 | modificationTime <$> getFileStatus fname | 695 | modificationTime <$> getFileStatus fname |
698 | input <- L.readFile fname | 696 | input <- L.readFile fname |
699 | let (ks,junk) = slurpWIPKeys timestamp input | 697 | let (ks,_) = slurpWIPKeys timestamp input |
700 | when (not (null ks)) $ do | 698 | when (not (null ks)) $ do |
701 | -- decrypt wk | 699 | -- decrypt wk |
702 | -- create sigs | 700 | -- create sigs |
@@ -1369,7 +1367,7 @@ cross_merge doDecrypt grip0 keyrings wallets f = do | |||
1369 | forM_ wsns $ \(_,n) -> do | 1367 | forM_ wsns $ \(_,n) -> do |
1370 | let cs' = do | 1368 | let cs' = do |
1371 | (nw,mp) <- cs | 1369 | (nw,mp) <- cs |
1372 | let fns = Map.keys (locations mp) | 1370 | -- let fns = Map.keys (locations mp) |
1373 | -- trace ("COIN KEY: "++show fns) $ return () | 1371 | -- trace ("COIN KEY: "++show fns) $ return () |
1374 | guard . not $ Map.member n (locations mp) | 1372 | guard . not $ Map.member n (locations mp) |
1375 | let wip = walletImportFormat (CryptoCoins.private_byte_id nw) (packet mp) | 1373 | let wip = walletImportFormat (CryptoCoins.private_byte_id nw) (packet mp) |
@@ -1564,7 +1562,7 @@ doExport doDecrypt (db,use_db) (fname,subspec,ms,cmd) = | |||
1564 | return (Nothing,use_db) -- need another pass | 1562 | return (Nothing,use_db) -- need another pass |
1565 | export = do | 1563 | export = do |
1566 | let [kk] = ms | 1564 | let [kk] = ms |
1567 | Just (KeyData key sigs uids subkeys) = Map.lookup kk use_db | 1565 | Just (KeyData key _ _ subkeys) = Map.lookup kk use_db |
1568 | p = flip (maybe (Just $ packet key)) subspec $ \tag -> do | 1566 | p = flip (maybe (Just $ packet key)) subspec $ \tag -> do |
1569 | let subs = Map.elems subkeys | 1567 | let subs = Map.elems subkeys |
1570 | doSearch (SubKey sub_mp sigtrusts) = | 1568 | doSearch (SubKey sub_mp sigtrusts) = |
@@ -1674,11 +1672,11 @@ base58_decode str = do | |||
1674 | 1672 | ||
1675 | walletImportFormat idbyte k = secret_base58_foo | 1673 | walletImportFormat idbyte k = secret_base58_foo |
1676 | where | 1674 | where |
1677 | isSecret (SecretKeyPacket {}) = True | 1675 | -- isSecret (SecretKeyPacket {}) = True |
1678 | isSecret _ = False | 1676 | -- isSecret _ = False |
1679 | secret_base58_foo = base58_encode seckey | 1677 | secret_base58_foo = base58_encode seckey |
1680 | Just d = lookup 'd' (key k) | 1678 | Just d = lookup 'd' (key k) |
1681 | (len16,bigendian) = S.splitAt 2 (S.concat $ L.toChunks $ encode d) | 1679 | (_,bigendian) = S.splitAt 2 (S.concat $ L.toChunks $ encode d) |
1682 | seckey = S.cons idbyte bigendian | 1680 | seckey = S.cons idbyte bigendian |
1683 | 1681 | ||
1684 | 1682 | ||
@@ -1771,11 +1769,11 @@ decode_btc_key timestamp str = do | |||
1771 | -} | 1769 | -} |
1772 | secp256k1 = ECC.getCurveByName ECC.SEC_p256k1 | 1770 | secp256k1 = ECC.getCurveByName ECC.SEC_p256k1 |
1773 | ECC.Point x y = ECC.ecc_g $ ECC.common_curve secp256k1 | 1771 | ECC.Point x y = ECC.ecc_g $ ECC.common_curve secp256k1 |
1774 | pub = cannonical_eckey x y | 1772 | -- pub = cannonical_eckey x y |
1775 | hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub | 1773 | -- hash = S.cons network_id . RIPEMD160.hash . SHA256.hash . S.pack $ pub |
1776 | address = base58_encode hash | 1774 | -- address = base58_encode hash |
1777 | pubstr = concatMap (printf "%02x") $ pub | 1775 | -- pubstr = concatMap (printf "%02x") $ pub |
1778 | _ = pubstr :: String | 1776 | -- _ = pubstr :: String |
1779 | return $ {- trace (unlines ["pub="++show pubstr | 1777 | return $ {- trace (unlines ["pub="++show pubstr |
1780 | ,"add="++show address | 1778 | ,"add="++show address |
1781 | ,"y ="++show y | 1779 | ,"y ="++show y |
@@ -2104,7 +2102,7 @@ getHostnames (KeyData topmp _ uids subs) = (addr,(onames,othernames)) | |||
2104 | _ -> mzero | 2102 | _ -> mzero |
2105 | 2103 | ||
2106 | addr = fingerdress topk | 2104 | addr = fingerdress topk |
2107 | name = maybe "" id $ listToMaybe onames -- TODO: more than one tor key? | 2105 | -- name = maybe "" id $ listToMaybe onames -- TODO: more than one tor key? |
2108 | topk = packet topmp | 2106 | topk = packet topmp |
2109 | torkeys = do | 2107 | torkeys = do |
2110 | SubKey k sigs <- Map.elems subs | 2108 | SubKey k sigs <- Map.elems subs |
@@ -2129,7 +2127,7 @@ getHostnames (KeyData topmp _ uids subs) = (addr,(onames,othernames)) | |||
2129 | has_tag tag p = isSignaturePacket p | 2127 | has_tag tag p = isSignaturePacket p |
2130 | && or [ tag `elem` mapMaybe usage (hashed_subpackets p) | 2128 | && or [ tag `elem` mapMaybe usage (hashed_subpackets p) |
2131 | , tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) ] | 2129 | , tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) ] |
2132 | subkeyPacket (SubKey k _ ) = k | 2130 | -- subkeyPacket (SubKey k _ ) = k |
2133 | onames :: [L.ByteString] | 2131 | onames :: [L.ByteString] |
2134 | onames = map ( (<> ".onion") | 2132 | onames = map ( (<> ".onion") |
2135 | . Char8.pack | 2133 | . Char8.pack |
@@ -2323,12 +2321,14 @@ main = do | |||
2323 | return $ | 2321 | return $ |
2324 | if take 1 content =="=" then (spec,proto,drop 1 content) | 2322 | if take 1 content =="=" then (spec,proto,drop 1 content) |
2325 | else (spec,"base58",proto) | 2323 | else (spec,"base58",proto) |
2324 | {- | ||
2326 | publics = | 2325 | publics = |
2327 | flip map (maybe [] id $ Map.lookup "--public" margs) $ \specfile -> do | 2326 | flip map (maybe [] id $ Map.lookup "--public" margs) $ \specfile -> do |
2328 | let (spec,efile) = break (=='=') specfile | 2327 | let (spec,efile) = break (=='=') specfile |
2329 | guard $ take 1 efile=="=" | 2328 | guard $ take 1 efile=="=" |
2330 | let file= drop 1 efile | 2329 | let file= drop 1 efile |
2331 | Just (spec,file) | 2330 | Just (spec,file) |
2331 | -} | ||
2332 | keyrings_ = maybe [] id $ Map.lookup "--keyrings" margs | 2332 | keyrings_ = maybe [] id $ Map.lookup "--keyrings" margs |
2333 | wallets = maybe [] id $ Map.lookup "--wallets" margs | 2333 | wallets = maybe [] id $ Map.lookup "--wallets" margs |
2334 | passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs | 2334 | passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs |
@@ -2413,7 +2413,7 @@ main = do | |||
2413 | let (imports,exports) = partition fst fs | 2413 | let (imports,exports) = partition fst fs |
2414 | use_db <- foldM (doImport decrypt) use_db0 (map snd imports) | 2414 | use_db <- foldM (doImport decrypt) use_db0 (map snd imports) |
2415 | 2415 | ||
2416 | let (btcs,bad_btcs) = partition isSupportedBTC btcpairs | 2416 | let (btcs,_) = partition isSupportedBTC btcpairs |
2417 | isSupportedBTC (spec,"base58",cnt) = True | 2417 | isSupportedBTC (spec,"base58",cnt) = True |
2418 | isSupportedBTC _ = False | 2418 | isSupportedBTC _ = False |
2419 | dblist = Map.toList use_db | 2419 | dblist = Map.toList use_db |
@@ -2475,7 +2475,7 @@ main = do | |||
2475 | -- we filter U to be only finger-dresses | 2475 | -- we filter U to be only finger-dresses |
2476 | u1 = Hosts.filterAddrs (hasFingerDress db) u0 | 2476 | u1 = Hosts.filterAddrs (hasFingerDress db) u0 |
2477 | 2477 | ||
2478 | let nf h = map Char8.unpack $ Hosts.namesForAddress (fromJust $ Hosts.inet_pton "fdf4:ed98:29c7:6226:9bde:a5b4:d564:3321") h | 2478 | -- let nf h = map Char8.unpack $ Hosts.namesForAddress (fromJust $ Hosts.inet_pton "fdf4:ed98:29c7:6226:9bde:a5b4:d564:3321") h |
2479 | {- | 2479 | {- |
2480 | putStrLn $ "_ = {\n" ++ show (head hostdbs) ++ "}" | 2480 | putStrLn $ "_ = {\n" ++ show (head hostdbs) ++ "}" |
2481 | putStrLn $ "--> " ++ show (nf (head hostdbs)) | 2481 | putStrLn $ "--> " ++ show (nf (head hostdbs)) |
@@ -2566,7 +2566,6 @@ main = do | |||
2566 | getWorkingKey homedir = do | 2566 | getWorkingKey homedir = do |
2567 | let o = Nothing | 2567 | let o = Nothing |
2568 | h = Just homedir | 2568 | h = Just homedir |
2569 | args = ["hi"] | ||
2570 | ofile <- fmap listToMaybe . flip (maybe (return [])) h $ \h -> | 2569 | ofile <- fmap listToMaybe . flip (maybe (return [])) h $ \h -> |
2571 | let optfiles = map (second ((h++"/")++)) | 2570 | let optfiles = map (second ((h++"/")++)) |
2572 | (maybe optfile_alts' (:[]) o') | 2571 | (maybe optfile_alts' (:[]) o') |
@@ -2597,6 +2596,7 @@ main = do | |||
2597 | let torhash = maybe "" id $ derToBase32 <$> derRSA sub | 2596 | let torhash = maybe "" id $ derToBase32 <$> derRSA sub |
2598 | return (top,(torhash,sub)) | 2597 | return (top,(torhash,sub)) |
2599 | 2598 | ||
2599 | {- | ||
2600 | uidScan pub = scanl (\(mkey,u) w -> | 2600 | uidScan pub = scanl (\(mkey,u) w -> |
2601 | case () of | 2601 | case () of |
2602 | _ | isPublicMaster w -> (w,u) | 2602 | _ | isPublicMaster w -> (w,u) |
@@ -2607,6 +2607,7 @@ main = do | |||
2607 | ws | 2607 | ws |
2608 | where | 2608 | where |
2609 | w0:ws = pub | 2609 | w0:ws = pub |
2610 | -} | ||
2610 | 2611 | ||
2611 | signTorIds selfkey keys kd@(KeyData k ksigs umap submap) = do | 2612 | signTorIds selfkey keys kd@(KeyData k ksigs umap submap) = do |
2612 | umap' <- Traversable.mapM signIfTor (Map.mapWithKey (,) umap) | 2613 | umap' <- Traversable.mapM signIfTor (Map.mapWithKey (,) umap) |
@@ -2659,7 +2660,7 @@ main = do | |||
2659 | (fingerprint wkun) | 2660 | (fingerprint wkun) |
2660 | return (additional new_sig) -- (uid:sigs,additional,xs'',g') | 2661 | return (additional new_sig) -- (uid:sigs,additional,xs'',g') |
2661 | where | 2662 | where |
2662 | (sigs, xs'') = span isSignaturePacket xs' | 2663 | (sigs, _) = span isSignaturePacket xs' |
2663 | overs sig = signatures $ Message (keys++[mainpubkey,uid,sig]) | 2664 | overs sig = signatures $ Message (keys++[mainpubkey,uid,sig]) |
2664 | vs :: [ ( Packet -- signature | 2665 | vs :: [ ( Packet -- signature |
2665 | , Maybe SignatureOver -- Nothing means non-verified | 2666 | , Maybe SignatureOver -- Nothing means non-verified |
@@ -2689,8 +2690,9 @@ main = do | |||
2689 | -} | 2690 | -} |
2690 | (null $ selfsigs) | 2691 | (null $ selfsigs) |
2691 | signatures_over new_sig | 2692 | signatures_over new_sig |
2693 | {- | ||
2692 | modsig sig = sig { signature = map id (signature sig) } | 2694 | modsig sig = sig { signature = map id (signature sig) } |
2693 | where plus1 (MPI x) = MPI (x+1) | 2695 | where plus1 (MPI x) = MPI (x+1) |
2694 | params newtop = public ++ map fst (key newtop) ++ "}" | 2696 | params newtop = public ++ map fst (key newtop) ++ "}" |
2695 | where | 2697 | where |
2696 | public = case newtop of | 2698 | public = case newtop of |
@@ -2711,6 +2713,7 @@ main = do | |||
2711 | ,"new_sig isSignaturePacket(over) = " ++ (show . map isSignaturePacket $ new_sig) | 2713 | ,"new_sig isSignaturePacket(over) = " ++ (show . map isSignaturePacket $ new_sig) |
2712 | ,"issuer = " ++ show (map signature_issuer new_sig) | 2714 | ,"issuer = " ++ show (map signature_issuer new_sig) |
2713 | ]) | 2715 | ]) |
2716 | -} | ||
2714 | flgs = if keykey mainpubkey == keykey (fromJust selfkey) | 2717 | flgs = if keykey mainpubkey == keykey (fromJust selfkey) |
2715 | then keyFlags0 mainpubkey (map (\(x,_,_)->x) selfsigs) | 2718 | then keyFlags0 mainpubkey (map (\(x,_,_)->x) selfsigs) |
2716 | else [] | 2719 | else [] |
@@ -3128,7 +3131,7 @@ newKey wkun wk parsedkey tag pre uids subkeys output_file grip = do | |||
3128 | 3131 | ||
3129 | 3132 | ||
3130 | groupBindings pub = | 3133 | groupBindings pub = |
3131 | let (sigs,bindings) = getBindings pub | 3134 | let (_,bindings) = getBindings pub |
3132 | bindings' = accBindings bindings | 3135 | bindings' = accBindings bindings |
3133 | code (c,(m,s),_,_,_) = (fingerprint_material m,-c) | 3136 | code (c,(m,s),_,_,_) = (fingerprint_material m,-c) |
3134 | ownerkey (_,(a,_),_,_,_) = a | 3137 | ownerkey (_,(a,_),_,_,_) = a |