From 0b77a1b4b6c779236934f453f08246e166656722 Mon Sep 17 00:00:00 2001 From: joe Date: Sat, 12 Apr 2014 03:06:16 -0400 Subject: deleted commented code --- kiki.hs | 441 ---------------------------------------------------------------- 1 file changed, 441 deletions(-) (limited to 'kiki.hs') 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 = -- cgit v1.2.3