diff options
author | joe <joe@jerkface.net> | 2013-08-15 03:36:20 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2013-08-15 03:36:20 -0400 |
commit | 6147c5d0c0c6d50270094f42bd7c7c071c475f1e (patch) | |
tree | 488c40462dfdbd744e0d0f5da8ea2e73d0e8391b /keys.hs | |
parent | 598b5b2cceb477a27c5ad981f52231556cbd58b9 (diff) |
workingkey command
Diffstat (limited to 'keys.hs')
-rw-r--r-- | keys.hs | 84 |
1 files changed, 71 insertions, 13 deletions
@@ -4,6 +4,7 @@ | |||
4 | {-# LANGUAGE RankNTypes #-} | 4 | {-# LANGUAGE RankNTypes #-} |
5 | {-# LANGUAGE FlexibleInstances #-} | 5 | {-# LANGUAGE FlexibleInstances #-} |
6 | {-# LANGUAGE DeriveDataTypeable #-} | 6 | {-# LANGUAGE DeriveDataTypeable #-} |
7 | {-# LANGUAGE CPP #-} | ||
7 | module Main where | 8 | module Main where |
8 | 9 | ||
9 | import Debug.Trace | 10 | import Debug.Trace |
@@ -217,7 +218,15 @@ parseUID str = UserIDRecord { | |||
217 | 218 | ||
218 | derToBase32 = map toLower . Base32.encode . S.unpack . SHA1.hashlazy | 219 | derToBase32 = map toLower . Base32.encode . S.unpack . SHA1.hashlazy |
219 | 220 | ||
220 | listKeys pkts = do | 221 | fpmatch grip key = |
222 | (==) Nothing | ||
223 | (fmap (backend (fingerprint key)) grip >>= guard . not) | ||
224 | where | ||
225 | backend xs ys = and $ zipWith (==) (reverse xs) (reverse ys) | ||
226 | |||
227 | listKeys pkts = listKeysFiltered Nothing pkts | ||
228 | |||
229 | listKeysFiltered grip pkts = do | ||
221 | let (certs,bs) = getBindings pkts | 230 | let (certs,bs) = getBindings pkts |
222 | as = accBindings bs | 231 | as = accBindings bs |
223 | defaultkind (k:_) hs = k | 232 | defaultkind (k:_) hs = k |
@@ -232,7 +241,9 @@ listKeys pkts = do | |||
232 | code (c,(m,s),_,_,_) = (fingerprint_material m,-c) | 241 | code (c,(m,s),_,_,_) = (fingerprint_material m,-c) |
233 | ownerkey (_,(a,_),_,_,_) = a | 242 | ownerkey (_,(a,_),_,_,_) = a |
234 | sameMaster (ownerkey->a) (ownerkey->b) = fingerprint_material a==fingerprint_material b | 243 | sameMaster (ownerkey->a) (ownerkey->b) = fingerprint_material a==fingerprint_material b |
235 | gs = groupBy sameMaster (sortBy (comparing code) as) | 244 | matchgrip ((code,(top,sub), kind, hashed,claimants):_) | fpmatch grip top = True |
245 | matchgrip _ = False | ||
246 | gs = filter matchgrip $ groupBy sameMaster (sortBy (comparing code) as) | ||
236 | subs <- gs | 247 | subs <- gs |
237 | let (code,(top,sub), kind, hashed,claimants):_ = subs | 248 | let (code,(top,sub), kind, hashed,claimants):_ = subs |
238 | subkeys = do | 249 | subkeys = do |
@@ -533,16 +544,26 @@ multiCommand ti choices = | |||
533 | -} | 544 | -} |
534 | 545 | ||
535 | data Arguments = | 546 | data Arguments = |
536 | List | 547 | List { homedir :: Maybe FilePath } |
537 | | AutoSign {input :: FilePath, output :: FilePath} | 548 | | WorkingKey { homedir :: Maybe FilePath } |
549 | | AutoSign { homedir :: Maybe FilePath, input :: FilePath, output :: FilePath} | ||
538 | deriving (Show, Data, Typeable) | 550 | deriving (Show, Data, Typeable) |
539 | 551 | ||
552 | #define HOMEOPTION (def &= explicit &= name "homedir" &= typDir ) | ||
553 | |||
540 | main = do | 554 | main = do |
541 | args <- cmdArgs $ modes | 555 | args <- cmdArgs $ modes |
542 | [ List &= help "list key pairs for which secrets are known" | 556 | [ List HOMEOPTION |
543 | &= auto | 557 | &= help "List key pairs in the secret keyring." |
544 | , AutoSign (def &= argPos 1 &= typFile ) (def &=argPos 2 &= typFile) | 558 | &= auto |
545 | &= help "auto-sign tor-style uids" ] | 559 | , WorkingKey HOMEOPTION |
560 | &= help "Shows the current working key set that will be used to make signatures." | ||
561 | , AutoSign HOMEOPTION (def &= argPos 1 &= typFile ) (def &=argPos 2 &= typFile) | ||
562 | &= (help . concat) | ||
563 | [ "Copies the first file to the second while adding" | ||
564 | , " signatures for tor-style uids that match" | ||
565 | , " cross-certified keys." ] | ||
566 | ] | ||
546 | &= program "keys" | 567 | &= program "keys" |
547 | &= summary "keys - a pgp key editing utility" | 568 | &= summary "keys - a pgp key editing utility" |
548 | doCmd args | 569 | doCmd args |
@@ -558,14 +579,51 @@ main = do | |||
558 | 579 | ||
559 | homevar = "GNUPGHOME" | 580 | homevar = "GNUPGHOME" |
560 | appdir = ".gnupg" | 581 | appdir = ".gnupg" |
582 | optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"] | ||
561 | 583 | ||
562 | doCmd List = do | 584 | getHomeDir cmd = do |
563 | homedir <- envhomedir Nothing | 585 | homedir <- envhomedir (homedir cmd) |
564 | flip (maybe (putStrLn "Could not find home directory.")) | 586 | flip (maybe (error "Could not determine home directory.")) |
565 | homedir $ \homedir -> do | 587 | homedir $ \homedir -> do |
566 | -- putStrLn $ "homedir = " ++show homedir | 588 | -- putStrLn $ "homedir = " ++show homedir |
567 | let secring = homedir ++ "/" ++ "secring.gpg" | 589 | let secring = homedir ++ "/" ++ "secring.gpg" |
568 | -- putStrLn $ "secring = " ++ show secring | 590 | -- putStrLn $ "secring = " ++ show secring |
569 | (Message msg) <- readPacketsFromFile secring | 591 | workingkey <- getWorkingKey homedir |
570 | putStrLn $ listKeys msg | 592 | return (homedir,secring,workingkey) |
593 | |||
594 | getWorkingKey homedir = do | ||
595 | let o = Nothing | ||
596 | h = Just homedir | ||
597 | args = ["hi"] | ||
598 | ofile <- fmap listToMaybe . flip (maybe (return [])) h $ \h -> | ||
599 | let optfiles = map (second ((h++"/")++)) | ||
600 | (maybe optfile_alts' (:[]) o') | ||
601 | optfile_alts' = zip (False:repeat True) optfile_alts | ||
602 | o' = fmap (False,) o | ||
603 | in filterM (doesFileExist . snd) optfiles | ||
604 | args <- flip (maybe $ return []) ofile $ | ||
605 | \(forgive,fname) -> parseOptionFile fname | ||
606 | let config = map (topair . words) args | ||
607 | where topair (x:xs) = (x,xs) | ||
608 | return $ lookup "default-key" config >>= listToMaybe | ||
609 | |||
610 | |||
611 | doCmd cmd@(List {}) = do | ||
612 | (homedir,secring,grip) <- getHomeDir cmd | ||
613 | (Message sec) <- readPacketsFromFile secring | ||
614 | putStrLn $ listKeys sec | ||
615 | |||
616 | doCmd cmd@(WorkingKey {}) = do | ||
617 | (homedir,secring,grip) <- getHomeDir cmd | ||
618 | (Message sec) <- readPacketsFromFile secring | ||
619 | putStrLn $ listKeysFiltered grip sec | ||
620 | return () | ||
621 | |||
622 | doCmd cmd@(AutoSign {}) = do | ||
623 | (homedir,secring,grip) <- getHomeDir cmd | ||
624 | (Message sec) <- readPacketsFromFile secring | ||
625 | (Message pub) <- readPacketsFromFile (input cmd) | ||
626 | putStrLn $ "Inspecting packets..." | ||
627 | putStrLn $ listKeys pub | ||
628 | return () | ||
571 | 629 | ||