deleted commented code

1 files changed, 0 insertions, 441 deletions

diff --git a/kiki.hs b/kiki.hs
index 59dc575..fb6321c 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -2557,17 +2557,6 @@ main = do
     return()
  where
 
-    {-
-    getPGPEnviron cmd = do
-        (homedir,secring,pubring,grip) <- getHomeDir (homedir cmd)
-        (Message sec) <- readPacketsFromFile secring
-        let (keys,_) = partition (\k -> case k of
-                                   { SecretKeyPacket {} -> True
-                                   ; _                  -> False })
-                                 sec
-        return (homedir,sec, grip `mplus` fmap fingerprint (listToMaybe keys))
-    -}
-
     getTorKeys pub = do
         xs <- groupBindings pub
         (_,(top,sub),us,_,_) <- xs
@@ -2575,18 +2564,6 @@ main = do
         let torhash = maybe "" id $ derToBase32 <$> derRSA sub
         return (top,(torhash,sub))
 
-    {-
-    uidScan pub = scanl (\(mkey,u) w ->
-                             case () of
-                              _ | isPublicMaster w -> (w,u)
-                              _ | isUserID w -> (mkey,w)
-                              _ | otherwise  -> (mkey,u)
-                            )
-                          (w0,w0)
-                          ws
-                        where
-                            w0:ws = pub
-    -}
 
     signTorIds selfkey keys kd@(KeyData k ksigs umap submap) = do
         umap' <- Traversable.mapM signIfTor (Map.mapWithKey (,) umap)
@@ -2620,15 +2597,6 @@ main = do
                             subdom = Char8.unpack subdom0
                             len = T.length (uid_subdomain parsed)
 
-    {-
-    signSelfAuthTorKeys selfkey g sec grip timestamp xs = ys
-     where
-        keys = filter isKey sec
-        mainpubkey = fst (head xs)
-        uidxs0 = map snd xs
-        (uidxs, additional, xs'',g') = signSelfAuthTorKeys' selfkey g keys grip timestamp mainpubkey uidxs0
-        ys = uidxs++ additional++xs''
-    -}
 
     signSelfAuthTorKeys' selfkey keys grip mainpubkey (uid:xs') = do
         new_sig <- let wkun = fromJust selfkey
@@ -2652,12 +2620,6 @@ main = do
             let ov = verify (Message [k]) $ o
             signatures_over ov
             return (sig,Just ov,k)
-        {-
-        mainsigs = filter (\(sig,v,whosign) -> isJust (v >> Just mainpubkey >>= guard 
-                                                                   . (== keykey whosign) 
-                                                                   . keykey))
-                          vs
-        -}
         selfsigs = filter (\(sig,v,whosign) -> isJust (v >> selfkey >>= guard 
                                                                    . (== keykey whosign) 
                                                                    . keykey))
@@ -2696,417 +2658,14 @@ main = do
         flgs = if keykey mainpubkey == keykey (fromJust selfkey)
                 then keyFlags0 mainpubkey (map (\(x,_,_)->x) selfsigs)
                 else []
-        -- (new_sig,g') = todo g mainpubkey (fromJust selfkey) uid timestamp flgs
-        {-
-        new_sig <- let wkun = fromJust selfkey
-                   in pgpSign (Message [wkun])
-                              tor_ov
-                              SHA1
-                              (fingerprint wkun)
-        -}
 
-        -- ys = uid:sigs++ additional++xs''
 
-    {-
-    doCmd cmd@(List {}) = do
-        (homedir,secring,grip) <- getHomeDir cmd
-        (Message sec) <- readPacketsFromFile secring
-        putStrLn $ listKeys sec
-
-    doCmd cmd@(WorkingKey {}) = do
-        (homedir,secring,grip) <- getHomeDir cmd
-        (Message sec) <- readPacketsFromFile secring
-        -- let s2k' = map s2k (filter isKey sec)
-        -- putStrLn $ "s2k = " ++ show s2k'
-        putStrLn $ listKeysFiltered (maybeToList grip) sec
-        return ()
-
-    doCmd cmd@(AutoSign {}) = do
-        ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome
-          , sec   -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg
-          , grip  -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321"
-          ) <- getPGPEnviron cmd
-        flip (maybe (error "No working key?")) grip $ \grip -> do
-        pw <- getPassphrase cmd
-        let (pre, wk:subs) = seek_key (KeyGrip grip) sec
-            wkun = if symmetric_algorithm wk == Unencrypted
-                    then Just wk
-                    else do
-                        k <- decryptSecretKey pw wk
-                        guard (symmetric_algorithm k == Unencrypted)
-                        return k
-        flip (maybe (error "Bad passphrase?")) wkun$ \wkun -> do
-        -- putStrLn $ "getPGPEnviron -> " ++ show (homedir,length sec,grip)
-        (Message pub) <- readPacketsFromFile (input cmd)
-        putStrLn $ listKeys pub
-        -- forM_ (zip [1..] pub) $ \(i,k) -> do
-        --     putStrLn $ show i ++ ": " ++ show k
-        let torbindings = getTorKeys pub
-            keyed = uidScan pub
-            marked = zipWith doit keyed pub
-            doit (mkey,u) packet = (isTorID packet, (mkey,u,packet))
-                where
-                    isTorID (UserIDPacket 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)
-
-                    isTorID _                  = False
-
-        g <- newGenIO
-        timestamp <- now
-        -- timestamp <- epochTime
-        let xs:xss = groupBy (\_ (b,_)->not b) marked
-            pub' = map (snd . cleanup) xs
-                    ++ concatMap (signSelfAuthTorKeys (Just wkun) (g::SystemRandom) sec grip timestamp)
-                                 (map (map cleanup) xss)
-            cleanup (_,(topkey,_,pkt)) = (topkey,pkt)
-        putStrLn $ "-------- signed ------> " -- ++ show (length pub, length pub')
-        putStrLn ""
-        putStrLn $ listKeysFiltered (map fingerprint (filter isPublicMaster pub'))  (sec++pub')
-
-        let signed_bs = encode (Message pub')
-        L.writeFile (output cmd) signed_bs
-
-    doCmd cmd@(Public {}) = do
-        ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome
-          , sec   -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg
-          , grip  -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321"
-          ) <- getPGPEnviron cmd
-        let pub = map secretToPublic sec
-            bs = encode (Message pub)
-        L.writeFile (output cmd) bs
-
-    doCmd cmd@(DumpPackets {}) = do
-        ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome
-          , sec   -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg
-          , grip  -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321"
-          ) <- getPGPEnviron cmd
-        p <- case files cmd of
-                    [] -> return sec
-                    fs -> do
-                            ms <- mapM readPacketsFromFile fs
-                            let unwrap (Message ps) = ps
-                            return (concatMap unwrap ms)
-        if map toLower (marshal_test cmd) `elem` ["y","yes"]
-            then L.putStr $ encode (Message p)
-            else putStrLn $ PP.ppShow p
-
-    doCmd cmd@(MergeSecrets {}) = do
-        ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome
-          , sec   -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg
-          , grip  -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321"
-          ) <- getPGPEnviron cmd
-        let db = merge Map.empty "%secring" (Message sec)
-        ms <- mapM readPacketsFromFile' (files cmd)
-        let db' = foldl' (uncurry . merge) db ms
-            m = flattenKeys False db'
-        L.putStr (encode m)
-        return ()
-
-    -}
-
-    {-
-    doCmd cmd@(Cross_Merge {}) = do
-        (homedir,secring,pubring,grip0) <- getHomeDir (homedir cmd)
-        -- grip0 may be empty, in which case we should use the first key
-        cross_merge (secring:pubring:files cmd) $ \_ db -> return $ (Just db,db)
-
-    doCmd cmd@(CatPub {}) = do
-        let spec:files = catpub_args cmd
-        let (topspec,subspec) = unprefix '/' spec
-            (toptyp,top) = unprefix ':' topspec
-            (subtyp,sub) = unprefix ':' subspec
-
-        {-
-        putStrLn $ "files = " ++ show files
-        putStrLn $ "topspec = " ++show (toptyp,top)
-        putStrLn $ "subspec = " ++show (subtyp,sub)
-        -}
-        ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome
-          , sec   -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg
-          , grip  -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321"
-          ) <- getPGPEnviron cmd
-
-        flip (maybe (error "No working key?")) grip $ \grip -> do
-
-        ms <- mapM readPacketsFromFile' files
-        let db = merge Map.empty "%secring" (Message sec)
-            db' = foldl' (uncurry . merge) db ms
-            m = flattenKeys True db'
-            Message allpkts = m
-
-        let topspec = case () of
-                        _ | null top && (subtyp=="fp" || (null subtyp && is40digitHex sub))
-                                     -> KeyGrip sub
-                        _ | null top -> KeyGrip grip
-                        _ | toptyp=="fp" || (null toptyp && is40digitHex top)
-                                     -> {- trace "using top" $ -} KeyGrip top
-                        _ | toptyp=="u" -> KeyUidMatch top
-                        _ | otherwise -> KeyUidMatch top
-            (pre, wksubs) = seek_key topspec allpkts
-        if null wksubs then error ("No match for "++spec) else do
-        let wk:subs = wksubs
-            (_,wksubs') = seek_key topspec subs -- ambiguity check
-            (_,ys) = case subtyp of
-                        "t" -> seek_key (KeyTag wk sub) subs
-                        "fp" | top=="" -> ([],wk:subs)
-                        "" | top=="" && is40digitHex sub -> ([],wk:subs)
-                        "" -> seek_key (KeyTag wk sub) subs
-        when (not (null ys)) $ do
-        let (_,ys') = seek_key (KeyTag wk sub) (tail ys) -- ambiguity check
-            k = head ys
-            rsa = pkcs8 . fromJust $ rsaKeyFromPacket k
-            der = encodeASN1 DER (toASN1 rsa [])
-            qq  = Base64.encode (L.unpack der)
-            split64 [] = []
-            split64 qq = as : split64 bs where (as,bs) = splitAt 64 qq
-        -- putStrLn $ "top = " ++ show top
-        -- putStrLn $ "wk = " ++ fingerprint wk
-        -- putStrLn $ fingerprint k
-        {-
-        putStrLn $ show rsa
-        putStrLn $ show der
-        -}
-        if null ys' && null wksubs'
-         then
-            putStr $ unlines (["-----BEGIN PUBLIC KEY-----"]
-                              ++split64 qq
-                              ++["-----END PUBLIC KEY-----"])
-         else
-            error "Key specification is ambiguous."
-
-    doCmd cmd@(Add {}) = do
-        ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome
-          , sec   -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg
-          , grip  -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321"
-          ) <- getPGPEnviron cmd
-        pw <- getPassphrase cmd
-
-        flip (maybe (error "No working key?")) grip $ \grip -> do
-
-        let (pre, wk:subs) = seek_key (KeyGrip grip) sec
-            wkun = if symmetric_algorithm wk == Unencrypted
-                    then Just wk
-                    else do
-                        k <- decryptSecretKey pw wk
-                        guard (symmetric_algorithm k == Unencrypted)
-                        return k
-
-        flip (maybe (error "Bad passphrase?")) wkun$ \wkun -> do
-
-        let (uids,subkeys) = break isSubkey subs
-            isSubkey p = isKey p && is_subkey p
-
-            (subkeys',remainder) = break isTopKey subkeys
-            isTopKey p@(SecretKeyPacket {}) | not (is_subkey p) = True
-            isTopKey _ = False
-
-        let parseKeySpec hint spec = case break (==':') spec of
-                                    (fmt,_:file) -> (fmt,file)
-                                    (file,"") -> (guessKeyFormat hint (key_usage cmd), file)
-            (secfmt,secfile) = parseKeySpec 'S' $ seckey cmd
-            -- (pubfmt,pubfile) = parseKeySpec 'P' $ pubkey cmd
-        Message parsedkey <- readKeyFromFile False secfmt secfile
-
-        let pkf = fingerprint (head parsedkey)
-            (prepk,pks) = seek_key (KeyGrip pkf) subkeys'
-
-        g <- newGenIO
-        timestamp <- now
-        let uids' = do
-                        torkey <- parsedkey
-                        if key_usage cmd /= "tor"
-                         then uids
-                         else let ps = makeTorUID (g::SystemRandom)
-                                                  timestamp
-                                                  wkun
-                                                  (keyFlags wkun uids)
-                                                  wk
-                                                  torkey
-                                  toruid = head ps
-                              in if toruid `elem` uids then uids else uids ++ ps
-        if not (null pks)
-            then existingKey (prepk,pks) remainder  wkun wk parsedkey (key_usage cmd) pre uids' subkeys (output cmd) grip
-            else newKey                             wkun wk parsedkey (key_usage cmd) pre uids' subkeys (output cmd) grip
-
-    doCmd cmd@(PemFP {}) = do
-        let parseKeySpec hint spec = case break (==':') spec of
-                                        (fmt,_:file) -> (fmt,file)
-                                        (file,"") -> (guessKeyFormat hint ("ssh-host"), file)
-            (secfmt,secfile) = parseKeySpec 'S' $ seckey cmd
-        Message seckey <- readKeyFromFile False secfmt secfile
-        -- Message pubkey <- readKeyFromFile True  pubfmt pubfile
-        -- Tor requires public key file... TODO
-        -- let torhash sub = maybe "" id $ derToBase32 <$> derRSA sub
-        putStrLn $ fingerprint (head seckey) -- ++ " " ++ torhash (head seckey)
-
-    -}
 
 isSameKey a b = sort (key apub) == sort (key bpub)
  where
     apub = secretToPublic a
     bpub = secretToPublic b
 
-{-
-existingKey (prepk,pks) remainder wkun wk parsedkey tag pre uids subkeys output_file grip = do
-        -- putStrLn "Key already present."
-        let pk:trail = pks
-            (trailsigs,trail') = span isSignaturePacket trail
-            (mysigs,notmines) = partition (endsWith grip . maybe "%bad%" id . signature_issuer)
-                                          trailsigs
-            endsWith big small = drop (length big - length small) big == small
-            vs = map (\sig ->
-                      (sig, map (verify (Message [wk]))
-                               (signatures $ Message [wk,pk,sig])))
-                     mysigs
-            (verified,unverified) = partition (not . null . snd) vs
-            sorted = sortBy (comparing (Down . signature_time . head . snd)) verified
-        -- Note: format allows for signatures of type 0x28 Subkey revocation signature.
-        case sorted of
-            [] -> do
-                    putStrLn "Adding valid signature to existing key..."
-                    newKey wkun wk [pk] tag pre uids (trail++prepk++remainder) output_file grip
-            (sig,ov):vs -> do
-                -- sig exists.
-                -- update sig to contain usage@ = tag
-                let hs = filter (\p->isNotation p && notation_name p=="usage@") (hashed_subpackets sig)
-                    ks = map notation_value hs
-                    isNotation (NotationDataPacket {}) = True
-                    isNotation _ = False
-                    noop = do
-                        -- Nothing to do
-                        let sec' = pre ++ [wk] ++ uids ++ subkeys
-                        putStrLn $ tag ++ " key already present."
-                        L.writeFile output_file (encode (Message sec'))
-                if tag `elem` ks
-                    then noop
-                    else do
-                        g <- newGenIO
-                        timestamp <- now
-                        let isCreation (SignatureCreationTimePacket {}) = True
-                            isCreation _ = False
-                            isExpiration (SignatureExpirationTimePacket {}) = True
-                            isExpiration _ = False
-                            (cs,ps) = partition isCreation (hashed_subpackets sig)
-                            (es,qs) = partition isExpiration ps
-                            stamp = listToMaybe . sortBy (comparing Down) $
-                                     map unwrap cs where unwrap (SignatureCreationTimePacket x) = x
-                            exp = listToMaybe $ sort $
-                                     map unwrap es where unwrap (SignatureExpirationTimePacket x) = x
-                            expires = liftA2 (+) stamp exp
-                        if fmap ( (< timestamp) . fromIntegral) expires == Just True then do
-                            putStrLn $ "Unable to update expired signature"
-                            noop
-                        else do
-                            let new_sig = fst $ sign (Message [wkun])
-                                                     (SubkeySignature wk
-                                                        (head parsedkey)
-                                                         [sig'] )
-                                                 SHA1
-                                                 grip
-                                                 timestamp
-                                                 (g::SystemRandom)
-                                times = (:) (SignatureExpirationTimePacket (fromIntegral timestamp))
-                                            $ maybeToList $ do
-                                                e <- expires
-                                                return $ SignatureExpirationTimePacket (e - fromIntegral timestamp)
-                                notation = NotationDataPacket
-                                            { notation_name = "usage@"
-                                            , notation_value = tag
-                                            , human_readable = True }
-                                sig' = sig { hashed_subpackets = times ++ [notation] ++ qs }
-
-                        -- noop let sec' = pre ++ [wk] ++ uids ++ subkeys
-                                sec' = pre
-                                        ++ [wk]
-                                        ++ uids
-                                        ++ prepk
-                                        ++ [pk]
-                                        ++ signatures_over new_sig
-                                        ++ map fst vs
-                                        ++ map fst unverified
-                                        ++ notmines
-                                        ++ trail'
-                                        ++ remainder
-                            putStrLn $ "Adding usage@="++tag
-                            L.writeFile output_file (encode (Message sec'))
-
-newKey wkun wk parsedkey tag pre uids subkeys output_file grip = do
-        g <- newGenIO
-        timestamp <- now
-
-        let
-                new_sig = fst $ sign (Message [wkun])
-                             (SubkeySignature wk
-                                              (head parsedkey)
-                                              (sigpackets 0x18
-                                                          hashed0
-                                                          ( IssuerPacket (fingerprint wk)
-                                                            : map EmbeddedSignaturePacket (signatures_over back_sig))))
-                             SHA1
-                             grip
-                             timestamp
-                             (g::SystemRandom)
-
-                hashed0 =
-                    [ KeyFlagsPacket
-                        { certify_keys = False
-                        , sign_data = False
-                        , encrypt_communication = False
-                        , encrypt_storage = False
-                        , split_key = False
-                        , authentication = True
-                        , group_key = False }
-                    , NotationDataPacket
-                        { human_readable = True
-                        , notation_name = "usage@"
-                        , notation_value = tag
-                        }
-                    , SignatureCreationTimePacket (fromIntegral timestamp)
-                    ]
-
-                subgrip = fingerprint (head parsedkey)
-
-                back_sig = fst $ sign (Message parsedkey)
-                             (SubkeySignature wk
-                                              (head parsedkey)
-                                              (sigpackets 0x19
-                                                          hashed0
-                                                          [IssuerPacket subgrip]))
-                             SHA1
-                             subgrip
-                             timestamp
-                             (g::SystemRandom)
-
-        let sec' = pre ++ [wk] ++ uids ++ parsedkey ++ signatures_over new_sig ++ subkeys
-        putStrLn $ listKeys sec'
-
-        L.writeFile output_file (encode (Message sec'))
-
-        {-
-        let backsigs = do
-                sig <- signatures (Message sec')
-                sigover <- signatures_over sig
-                subp <- unhashed_subpackets sigover
-                -- guard (isEmbeddedSignature subp)
-                subp <- maybeToList (backsig subp)
-                over <- signatures (Message (filter isKey sec ++ [subp]))
-                return over
-
-        -- putStrLn $ PP.ppShow backsigs
-        -}
-
-        return ()
--}
-
 
 
 groupBindings pub =