From e75916e1370bc772ba4cf643f0ac0ecae0300d1c Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 21 Apr 2014 19:49:41 -0400 Subject: removed unused imports and binds from kiki.hs --- kiki.hs | 192 ++++------------------------------------------------------------ 1 file changed, 10 insertions(+), 182 deletions(-) diff --git a/kiki.hs b/kiki.hs index d1d8bb3..532c2ab 100644 --- a/kiki.hs +++ b/kiki.hs @@ -8,75 +8,51 @@ {-# LANGUAGE CPP #-} module Main where -import Debug.Trace -import GHC.Exts (Down(..)) -import GHC.IO.Exception ( ioException, IOErrorType(..) ) import Data.IORef -import Data.Tuple import Data.Binary import Data.OpenPGP as OpenPGP import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as Char8 import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as S8 import Control.Monad -import qualified Text.Show.Pretty as PP -import Text.PrettyPrint as PP hiding ((<>)) +-- import qualified Text.Show.Pretty as PP +-- import Text.PrettyPrint as PP hiding ((<>)) import Data.List -import Data.OpenPGP.Util (verify,fingerprint,decryptSecretKey,pgpSign) +import Data.OpenPGP.Util (verify,fingerprint) import Data.Ord import Data.Maybe import Data.Bits import qualified Data.Text as T import Data.Text.Encoding -import qualified Codec.Binary.Base32 as Base32 import qualified Codec.Binary.Base64 as Base64 -import qualified Crypto.Hash.SHA1 as SHA1 import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Hash.RIPEMD160 as RIPEMD160 -import qualified Crypto.Types.PubKey.ECC as ECC -- import qualified Crypto.Types.PubKey.ECDSA as ECDSA -- import qualified Crypto.PubKey.ECC.ECDSA as ECDSA -import Data.Char (toLower) -import qualified Crypto.PubKey.RSA as RSA -- import Crypto.Random (newGenIO,SystemRandom) import Data.ASN1.Types import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding -import Data.ASN1.BitArray -import qualified Data.Foldable as Foldable -import qualified Data.Sequence as Sequence import Control.Applicative import System.Environment -import System.Directory -import System.FilePath import System.Exit -import System.Process -import System.Posix.IO (fdToHandle,fdRead) -import System.Posix.Files -import System.Posix.Signals -import System.Posix.Types (EpochTime) -import System.Process.Internals (runGenProcess_,defaultSignal) -import System.IO (hPutStrLn,stderr,withFile,IOMode(..)) -import System.IO.Error -import ControlMaybe +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) -import qualified Data.Traversable as Traversable (mapM,forM,sequence) +-- import Data.Traversable hiding (mapM,forM,sequence) +-- import qualified Data.Traversable as Traversable (mapM,forM,sequence) -- import System.Console.CmdArgs -- import System.Posix.Time -import Data.Time.Clock.POSIX -import Data.Monoid ((<>)) -- import Data.X509 import qualified Data.Map as Map import DotLock -- import Codec.Crypto.ECC.Base -- hecc package import Text.Printf import qualified CryptoCoins as CryptoCoins -import qualified Hosts -import Network.Socket -- (SockAddr) import LengthPrefixedBE import Data.Binary.Put (putWord32be,runPut,putByteString) import Data.Binary.Get (runGet) @@ -360,8 +336,7 @@ modifyUID other = other todo = error "unimplemented" -#if MIN_VERSION_base(4,6,0) -#else +#if ! MIN_VERSION_base(4,6,0) lookupEnv var = handleIO_ (return Nothing) $ fmap Just (getEnv var) #endif @@ -1047,17 +1022,6 @@ main = do guard $ take 1 bdmcb == "}" let cmd = (drop 1 . reverse . drop 1) bdmcb Just (spec,file,cmd) - btcpairs0 = - flip map (maybe [] id $ Map.lookup "--bitcoin-keypairs" margs) $ \specfile -> do - let (spec,efilecmd) = break (=='=') specfile - (spec,protocnt) <- do - return $ if take 1 efilecmd=="=" then (spec,drop 1 efilecmd) - else ("",spec) - let (proto,content) = break (==':') protocnt - spec <- return $ if null spec then "bitcoin" else spec - return $ - if take 1 content =="=" then (spec,proto,drop 1 content) - else (spec,"base58",proto) {- publics = flip map (maybe [] id $ Map.lookup "--public" margs) $ \specfile -> do @@ -1069,28 +1033,6 @@ main = do keyrings_ = maybe [] id $ Map.lookup "--keyrings" margs wallets = maybe [] id $ Map.lookup "--wallets" margs passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs - decrypt wk = do - -- warn $ "decryptKey "++fingerprint wk - unkeys <- readIORef unkeysRef - let kk = keykey wk - flip (flip maybe $ return . Just) (Map.lookup kk unkeys) $ do - let ret wkun = do writeIORef unkeysRef (Map.insert kk wkun unkeys) - return (Just wkun) - if symmetric_algorithm wk == Unencrypted then ret wk else do - pw <- do - pw <- readIORef pwRef - flip (flip maybe return) pw $ do - case passphrase_fd of - Just fd -> do pwh <- fdToHandle (read fd) - pw <- fmap trimCR $ S.hGetContents pwh - writeIORef pwRef (Just pw) - return pw - Nothing -> return "" - let wkun = do - k <- decryptSecretKey pw wk - guard (symmetric_algorithm k == Unencrypted) - return k - maybe (return Nothing) ret wkun when (not . null $ filter isNothing keypairs0) $ do warn "syntax error" @@ -1101,7 +1043,6 @@ main = do $ Map.lookup "--show-whose-key" margs let keypairs = catMaybes keypairs0 - btcpairs = catMaybes btcpairs0 {- putStrLn $ "wallets = "++show wallets @@ -1110,22 +1051,6 @@ main = do putStrLn $ "publics = "++show publics -} - let auto_sign_feature rt = do - use_db <- - flip (maybe $ return (rtKeyDB rt)) - (lookup "--autosign" $ map (\(x:xs)->(x,xs)) sargs) - $ \_ -> do - let keys = map keyPacket $ Map.elems (rtKeyDB rt) - wk = workingKey (rtGrip rt) (rtKeyDB rt) - -- g <- newGenIO - -- stamp <- now - wkun <- flip (maybe $ return Nothing) wk $ \wk -> do - wkun <- decrypt wk - maybe (error $ "Bad passphrase?") (return . Just) wkun - -- return . snd $ Map.mapAccum (signTorIds stamp wkun keys) g use_db - Traversable.mapM (signTorIds wkun keys) (rtKeyDB rt) - return use_db - let homespec = join . take 1 <$> Map.lookup "--homedir" margs passfd = fmap (FileDesc . read) passphrase_fd pems = flip map keypairs @@ -1206,103 +1131,6 @@ main = do let torhash = maybe "" id $ derToBase32 <$> derRSA sub return (top,(torhash,sub)) - - signTorIds selfkey keys kd@(KeyData k ksigs umap submap) = do - umap' <- Traversable.mapM signIfTor (Map.mapWithKey (,) umap) - return (KeyData k ksigs umap' submap) :: IO KeyData - where - mkey = packet k - signIfTor (str,ps) = - if isTorID str - then do - let uidxs0 = map packet $ flattenUid "" True (str,ps) - -- addition<- signSelfAuthTorKeys' selfkey g keys grip timestamp mkey uidxs0 - additional <- signSelfAuthTorKeys' selfkey keys grip mkey uidxs0 - let ps' = ( map ( (,tmap) . toMappedPacket om) additional - ++ fst ps - , Map.union om (snd ps) ) - toMappedPacket om p = (mappedPacket "" p) {locations=om} - om = Map.singleton "--autosign" (origin p (-1)) where p = UserIDPacket str - tmap = Map.empty - return ps' - else return ps - - torbindings = getTorKeys (map packet $ flattenTop "" True kd) - isTorID str = and [ uid_topdomain parsed == "onion" - , uid_realname parsed `elem` ["","Anonymous"] - , uid_user parsed == "root" - , fmap (match . fst) (lookup mkey torbindings) - == Just True ] - where parsed = parseUID str - match = ( (==subdom) . take (fromIntegral len)) - subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)] - subdom = Char8.unpack subdom0 - len = T.length (uid_subdomain parsed) - - - signSelfAuthTorKeys' selfkey keys grip mainpubkey (uid:xs') = do - new_sig <- let wkun = fromJust selfkey - tor_ov = makeInducerSig mainpubkey wkun uid flgs - in pgpSign (Message [wkun]) - tor_ov - SHA1 - (fingerprint wkun) - return (additional new_sig) -- (uid:sigs,additional,xs'',g') - where - (sigs, _) = span isSignaturePacket xs' - overs sig = signatures $ Message (keys++[mainpubkey,uid,sig]) - vs :: [ ( Packet -- signature - , Maybe SignatureOver -- Nothing means non-verified - , Packet ) -- key who signed - ] - vs = do - sig <- sigs - o <- overs sig - k <- keys - let ov = verify (Message [k]) $ o - take 1 $ signatures_over ov - return (sig,Just ov,k) - selfsigs = filter (\(sig,v,whosign) -> isJust (v >> selfkey >>= guard - . (== keykey whosign) - . keykey)) - vs - additional new_sig = do - new_sig <- maybeToList new_sig - guard $ {- trace (unlines $ [ "selfsigs = "++show (map ((\(_,_,k)->fingerprint k)) selfsigs) - , " for mainkey = "++fingerprint mainpubkey] ) - -} - (null $ selfsigs) - signatures_over new_sig - {- - modsig sig = sig { signature = map id (signature sig) } - where plus1 (MPI x) = MPI (x+1) - params newtop = public ++ map fst (key newtop) ++ "}" - where - public = case newtop of - PublicKeyPacket {} -> "public{" - SecretKeyPacket {} -> if L.null (encrypted_data newtop ) - then "secret{" - else "encrypted{" - _ -> "??????{" - traceSig newtop newuid new_sig = (unlines ["mainpubkey:"++ show (fingerprint mainpubkey) - ,"new_sig topkey:"++ (show . fingerprint $ newtop) - ,"new_sig topkey params: "++ params newtop - ,"new_sig user_id:"++ (show newuid) - ,"new_sig |over| = " ++ (show . length $ new_sig) - ,"new_sig hashed = " ++ (PP.ppShow . concatMap hashed_subpackets $ new_sig) - ,"new_sig unhashed = " ++ (show . concatMap unhashed_subpackets $ new_sig) - ,"new_sig type: " ++ (show . map signature_type $ new_sig) - ,"new_sig signature:" ++ (show . concatMap signature $ new_sig) - ,"new_sig isSignaturePacket(over) = " ++ (show . map isSignaturePacket $ new_sig) - ,"issuer = " ++ show (map signature_issuer new_sig) - ]) - -} - flgs = if keykey mainpubkey == keykey (fromJust selfkey) - then keyFlags0 mainpubkey (map (\(x,_,_)->x) selfsigs) - else [] - - - isSameKey a b = sort (key apub) == sort (key bpub) where apub = secretToPublic a -- cgit v1.2.3