removed more unused bindings from kiki.hs

1 files changed, 6 insertions, 342 deletions

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
 
 
 {-