From bb7640591e32e117c68b3ce54114bf562a67beaf Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 21 Apr 2014 20:07:23 -0400 Subject: removed more unused bindings from kiki.hs --- KeyRing.hs | 17 +++ kiki.hs | 348 ++----------------------------------------------------------- 2 files changed, 23 insertions(+), 342 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index 0fc30ef..9775ef5 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -70,6 +70,23 @@ import ProcessUtils (systemEnv, ExitCode(ExitFailure, ExitSuccess) ) -- DER-encoded elliptic curve ids nistp256_id = 0x2a8648ce3d030107 secp256k1_id = 0x2b8104000a +-- "\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 +-} data HomeDir = HomeDir { homevar :: String diff --git a/kiki.hs b/kiki.hs index 532c2ab..32b86bd 100644 --- a/kiki.hs +++ b/kiki.hs @@ -38,9 +38,6 @@ import Control.Applicative import System.Environment import System.Exit import System.IO (hPutStrLn,stderr) -#if ! MIN_VERSION_base(4,6,0) -import ControlMaybe ( handleIO_ ) -#endif import Data.Char import Control.Arrow (first,second) -- import Data.Traversable hiding (mapM,forM,sequence) @@ -51,7 +48,7 @@ import Control.Arrow (first,second) import qualified Data.Map as Map import DotLock -- import Codec.Crypto.ECC.Base -- hecc package -import Text.Printf +-- import Text.Printf import qualified CryptoCoins as CryptoCoins import LengthPrefixedBE import Data.Binary.Put (putWord32be,runPut,putByteString) @@ -62,10 +59,6 @@ import Base58 -- instance Default S.ByteString where def = S.empty --- DER-encoded elliptic curve ids -nistp256_id = 0x2a8648ce3d030107 -secp256k1_id = 0x2b8104000a - warn str = hPutStrLn stderr str @@ -113,20 +106,12 @@ getPackets = do -} -isEmbeddedSignature (EmbeddedSignaturePacket {}) = True -isEmbeddedSignature _ = False - isCertificationSig (CertificationSignature {}) = True isCertificationSig _ = True -issuer (IssuerPacket issuer) = Just issuer -issuer _ = Nothing isSubkeySignature (SubkeySignature {}) = True isSubkeySignature _ = False -isPublicMaster k@(PublicKeyPacket {}) = not $ is_subkey k -isPublicMaster _ = False - verifyBindings keys nonkeys = (top ++ filter isSubkeySignature embedded,othersigs) where verified = do @@ -149,8 +134,6 @@ verifyBindings keys nonkeys = (top ++ filter isSubkeySignature embedded,othersig guard (not . null $ signatures_over v) return v -grip k = drop 32 $ fingerprint k - smallpr k = drop 24 $ fingerprint k @@ -167,13 +150,6 @@ disjoint_fp ks = {- concatMap group2 $ -} transpose grouped group2 [] = [] -} -verifyBindingsEx :: [Packet] -> ([SignatureOver], [SignatureOver]) -- ^ (binding signatures, other signatures) -verifyBindingsEx pkts = bicat . unzip $ do - let (keys,_) = partition isKey pkts - keys <- disjoint_fp keys - return $ verifyBindings keys pkts - where - bicat (xs,ys) = (concat xs,concat ys) getBindings :: [Packet] @@ -234,9 +210,11 @@ 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 @@ -326,213 +304,20 @@ listKeysFiltered grips pkts = do +{- modifyUID (UserIDPacket str) = UserIDPacket str' where (fstname,rst) = break (==' ') str str' = mod fstname ++ rst - mod "Bob" = "Bob Fucking" + mod "Bob" = "Bob Slacking" mod x = x modifyUID other = other +-} -todo = error "unimplemented" - -#if ! MIN_VERSION_base(4,6,0) -lookupEnv var = - handleIO_ (return Nothing) $ fmap Just (getEnv var) -#endif - -unmaybe def = fmap (maybe def id) - -expandPath path (c:cs) | c/='/' = path ++ "/" ++ (c:cs) - | otherwise = c:cs -expandPath path [] = [] -- type TimeStamp = Word32 --- | Attempts to lock each file in the list. --- Returns a list of locks and a list of filenames --- that could not be locked. -lockFiles :: [FilePath] -> IO ( [(DotLock,FilePath)], [FilePath] ) -lockFiles fs = do - ls <- forM fs $ \f -> do - lk <- dotlock_create f 0 - v <- flip (maybe $ return Nothing) lk $ \lk -> do - e <- dotlock_take lk (-1) - return $ if e==0 then Just lk - else Nothing - return (v,f) - let (lks, fails) = partition (isJust . fst) ls - return (map (\(lk,f)->(fromJust lk,f)) lks, map snd fails) - -unlockFiles lks = forM_ lks $ \(lk,f) -> do - -- warn $ "unlocking "++show f - dotlock_release lk - -{- -options_from_file :: - (forall a. [String] -> Term a -> IO (Either EvalExit a)) - -> Term b - -> (String,String,Term (Maybe String)) - -> ([String],Term (Maybe String)) - -> IO [String] -options_from_file unwrapCmd term (homevar,appdir,home) (optfile_alts,options_file) = doit - where - homedir = envhomedir <$> home - envhomedir opt = do - gnupghome <- lookupEnv homevar >>= - \d -> return $ d >>= guard . (/="") >> d - home <- flip fmap getHomeDirectory $ - \d -> fmap (const d) $ guard (d/="") - let homegnupg = (++('/':appdir)) <$> home - let val = (opt `mplus` gnupghome `mplus` homegnupg) - return $ val - - doit = do - args <- getArgs - {- - let wants_help = - not . null $ filter cryForHelp args - where cryForHelp "--help" = True - cryForHelp "--version" = True - cryForHelp x = - and (zipWith (==) x "--help=") - -} - (o,h) <- do - val <- unwrapCmd args (liftA2 (,) options_file homedir) - case val of - Left e -> return (Nothing,Nothing) - Right (o,h) -> (o,) <$> h - ofile <- fmap listToMaybe . flip (maybe (return [])) h $ \h -> - let optfiles = map (second ((h++"/")++)) - (maybe optfile_alts' (:[]) o') - optfile_alts' = zip (False:repeat True) optfile_alts - o' = fmap (False,) o - in filterM (doesFileExist . snd) optfiles - args <- flip (maybe $ return args) ofile $ \(forgive,fname) -> do - let h' = fromJust h - newargs <- (:) <$> pure ("homedir "++h') <*> parseOptionFile fname - let toArgs = toHead ("--"++) . words - toHead f (x:xs) = f x : xs - toHead f [] = [] - voidTerm = fmap (const ()) - appendArgs as [] = return as - appendArgs as (configline:cs) = do - let xs = toArgs configline - w <-unwrap (xs++as) (voidTerm term,defTI) - case w of - Left _ -> appendArgs as cs - Right _ -> appendArgs (xs++as) cs - -- TODO: check errors if forgive = False - appendArgs args newargs - return args - -runWithOptionsFile :: (Term (IO b), TermInfo) -> IO b -runWithOptionsFile (term,ti) = do - as <- options_from_file unwrapCmd - term - ("GNUPGHOME",".gnupg",opt_homedir) - (["keys.conf","gpg.conf-2","gpg.conf"] - ,opt_options) - q <- eval as (term , ti) - q - where - unwrapCmd args term = unwrap args (term,defTI) - -runChoiceWithOptionsFile :: - (Term (IO b), TermInfo) -> [(Term (IO b), TermInfo)] -> IO b -runChoiceWithOptionsFile (realterm,ti) choices = do - as <- options_from_file unwrapCmd - realterm - ("GNUPGHOME",".gnupg",opt_homedir) - (["keys.conf","gpg.conf-2","gpg.conf"] - ,opt_options) - -- putStrLn $ "as = " ++ show as - q <- evalChoice as (realterm , ti) choices - q - where - unwrapCmd args t = - unwrapChoice args (realterm <:> t,ti) (map (neuter t) choices) - neuter term (t,ti) = (t <:> term, ti) - -data Command = - List - | Autosign - deriving (Eq,Show,Read,Enum) - -capitolizeFirstLetter (x:xs) = toUpper x : xs -capitolizeFirstLetter xs = xs - -instance ArgVal Command where - converter = - ( maybe (Left $ text "unknown command") Right - . fmap fst . listToMaybe . reads - . capitolizeFirstLetter . map toLower - , text . map toLower . show - ) -class AutoMaybe a -instance AutoMaybe Command -instance (ArgVal a, AutoMaybe a) => ArgVal (Maybe a) where - converter = - ( toRight Just . fst converter - , maybe (text "(unspecified)") id . fmap (snd converter) - ) - -toRight f (Right x) = Right (f x) -toRight f (Left y) = Left y - -cmd :: Term Command -cmd = required . pos 0 Nothing $ posInfo - { posName = "command" - , posDoc = "What action to perform." - } - -a <:> b = flip const <$> a <*> b -infixr 2 <:> - -selectAction cmd actions = actions !! fromEnum cmd - -cmdInfo :: ArgVal cmd => - cmd -> String -> Term a -> (cmd, (Term a, TermInfo)) -cmdInfo cmd doc action = - ( cmd - , ( action - , defTI { termName = print cmd - , termDoc = doc } ) ) - where - print = show . snd converter - -cmdlist :: (Command, (Term (IO ()), TermInfo)) -cmdlist = cmdInfo List "list key pairs for which secrets are known" $ - (>>= putStrLn . listKeys . unMessage) <$> secret_packets - where unMessage (Message pkts) = pkts - -cmdautosign = cmdInfo Autosign "auto-sign tor-style uids" $ - pure (putStrLn "autosign") - - -multiCommand :: - TermInfo - -> [(Command, (Term a, TermInfo))] - -> ( (Term a, TermInfo) - , [(Term a, TermInfo)] ) -multiCommand ti choices = - ( ( selectAction <$> cmd <*> sequenceA (map strip choices) - , ti ) - , map snd choices ) - where - selectAction cmd choices = - fromJust $ lookup (cmd::Command) choices - strip (cmd,(action,_)) = fmap (cmd,) action --} - - -trimCR bs = fst $ S.spanEnd (\x -> x==10 || x==13) bs - -guessKeyFormat 'P' "ssh-client" = "SSH" -guessKeyFormat 'S' "ssh-client" = "PEM" -guessKeyFormat 'S' "ssh-host" = "PEM" -guessKeyFormat _ _ = "PEM" -- "PGP" readPublicKey :: Char8.ByteString -> RSAPublicKey readPublicKey bs = maybe er id $ do @@ -557,44 +342,6 @@ getPassphrase cmd = #define HOMEOPTION (def &= explicit &= name "homedir" &= typDir ) -writeOutKeyrings :: Map.Map FilePath t -> KeyDB -> IO () -writeOutKeyrings lkmap db = do - let ks = Map.elems db - fs = Map.keys (foldr unionfiles Map.empty ks) - where unionfiles (KeyData p _ _ _) m = - Map.union m (locations p) - fromfile f (KeyData p _ _ _) = Map.member f $ locations p - let s = do - f <- fs - let x = do - d@(KeyData p _ _ _) <- filter (fromfile f) (sortByHint f keyMappedPacket ks) - n <- maybeToList $ Map.lookup f (locations p) - flattenTop f (originallyPublic n) d - changes = filter isnew x - where isnew p = isNothing (Map.lookup f $ locations p) - {- - trace (unlines $ ( (f ++ ":") : map (showPacket . packet) x) ++ - ( "CHANGES: " : map ((" "++) . showPacket . packet) changes)) $ do - -} - return (f,(changes,x)) - towrites <- fmap catMaybes $ Control.Monad.forM s $ \(f,(changes,x)) -> do - let noop = return Nothing - write f = return (Just f) - case changes of - [] -> noop -- warn (f ++": nothing to do.") >> noop - cs -> case Map.lookup f lkmap of - Just lk -> do - forM_ cs $ \c -> warn $ f++": new "++showPacket (packet c) - write (f,lk,x) - Nothing -> do - forM_ cs $ \c -> warn $ f++": missing "++showPacket (packet c) - noop - forM_ towrites $ \(f,lk,x) -> do - let m = Message $ map packet x - -- warn $ "writing "++f - L.writeFile f (encode m) - - toLast f [] = [] toLast f [x] = [f x] @@ -715,39 +462,6 @@ cannonical_eckey x y = 0x4:pad32(numToBytes x) ++ pad32(numToBytes y) :: [Word8] 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 @@ -815,51 +529,6 @@ whoseKey rsakey db = filter matchkey (Map.elems db) s2 <- signatures . Message $ [k,sub,subsig] signatures_over $ verify (Message [sub]) s2 -workingKey grip use_db = listToMaybe $ do - fp <- maybeToList grip - elm <- Map.toList use_db - guard $ matchSpec (KeyGrip fp) elm - return $ keyPacket (snd elm) - -has_good_sig wk (KeyData k sigs uids subs) = any goodsig $ Map.toList uids - where - goodsig (uidstr,(sigs,_)) = not . null $ do - sig0 <- fmap (packet . fst) sigs - pre_ov <- signatures (Message [packet k, UserIDPacket uidstr, sig0]) - signatures_over $ verify (Message [wk]) pre_ov - -markForImport - :: Ord d => - Map.Map String a - -> Maybe String - -> FilePath - -> Map.Map d KeyData - -> IO (Map.Map d KeyData) -markForImport margs grip pubring db = maybe (return db) import_db $ wantToImport - where wantToImport = mplus import_f importifauth_f - where - import_f = do Map.lookup "--import" margs - return dont_have - importifauth_f = do Map.lookup "--import-if-authentic" margs - return isauth - dont_have (KeyData p _ _ _) = not . Map.member pubring - $ locations p - isauth keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk - where wk = workingKey grip db - import_db dont_have = do - forM_ to_alters $ \(_,KeyData c _ _ _) -> - warn $ pubring ++ ": new "++showPacket (packet c) - let db' = Map.union (Map.fromList altered) - db - return db' - where - to_alters = filter (dont_have . snd) $ Map.toList db - 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 (secretToPublic (packet p)) (-1)) - (locations p) - } kiki_usage = do putStr . unlines $ @@ -1149,11 +818,6 @@ groupBindings pub = gs = {- filter matchgrip $ -} groupBy sameMaster (sortBy (comparing code) bindings') in gs -isTopKey p@(SecretKeyPacket {}) | not (is_subkey p) = True -isTopKey p@(PublicKeyPacket {}) | not (is_subkey p) = True -isTopKey _ = False - -groupTops ps = groupBy (\_ b -> not (isTopKey b)) ps {- -- cgit v1.2.3