summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-04-16 01:32:14 -0400
committerjoe <joe@jerkface.net>2014-04-16 01:32:14 -0400
commitf1560618fe37f7ec434e78cabd681802048cfb4c (patch)
tree304697313f97754f04d21df0fc8f0c9d1dccea83 /KeyRing.hs
parent7761528025b4288527c34d0bb68c71ef2e90a51a (diff)
create nonexistent PEM files via external shell commands
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs81
1 files changed, 55 insertions, 26 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index d5eb9ea..798ad38 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -51,6 +51,7 @@ import qualified CryptoCoins as CryptoCoins
51import Base58 51import Base58
52import FunctorToMaybe 52import FunctorToMaybe
53import DotLock 53import DotLock
54import ProcessUtils (systemEnv, ExitCode(ExitFailure, ExitSuccess) )
54 55
55-- DER-encoded elliptic curve ids 56-- DER-encoded elliptic curve ids
56nistp256_id = 0x2a8648ce3d030107 57nistp256_id = 0x2a8648ce3d030107
@@ -68,19 +69,27 @@ home = HomeDir
68 , optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"] 69 , optfile_alts = ["keys.conf","gpg.conf-2","gpg.conf"]
69 } 70 }
70 71
71data InputFile = HomeSec | HomePub | ArgFile FilePath | FileDesc Int 72data InputFile = HomeSec
73 | HomePub
74 | ArgFile FilePath
75 | FileDesc Int
72 76
73type UsageTag = String 77type UsageTag = String
74type Initializer = String 78type Initializer = String
75type PassWordFile = InputFile 79type PassWordFile = InputFile
76 80
77data FileType = KeyRingFile PassWordFile | PEMFile UsageTag | WalletFile 81data FileType = KeyRingFile PassWordFile
82 | PEMFile UsageTag
83 | WalletFile -- (Maybe UsageTag)
78 84
79data RefType = ConstRef | MutableRef (Maybe Initializer) 85data RefType = ConstRef | MutableRef (Maybe Initializer)
80 86
81initializer (MutableRef x) = x 87initializer (MutableRef x) = x
82initializer _ = Nothing 88initializer _ = Nothing
83 89
90getUsage (PEMFile usage) = return usage
91getUsage _ = mzero
92
84 93
85data KeyRingRuntime = KeyRingRuntime 94data KeyRingRuntime = KeyRingRuntime
86 { rtPubring :: FilePath 95 { rtPubring :: FilePath
@@ -247,6 +256,8 @@ data KikiReportAction =
247 | YieldSecretKeyPacket String 256 | YieldSecretKeyPacket String
248 | UnableToUpdateExpiredSignature 257 | UnableToUpdateExpiredSignature
249 | WarnFailedToMakeSignature 258 | WarnFailedToMakeSignature
259 | FailedExternal Int
260 | ExternallyGeneratedFile
250 261
251data KikiResult a = KikiResult 262data KikiResult a = KikiResult
252 { kikiCondition :: KikiCondition a 263 { kikiCondition :: KikiCondition a
@@ -480,6 +491,8 @@ data KeySpec =
480 | KeyUidMatch String 491 | KeyUidMatch String
481 deriving Show 492 deriving Show
482 493
494-- | Parse a key specification.
495-- The first argument is a grip for the default working key.
483parseSpec :: String -> String -> (KeySpec,Maybe String) 496parseSpec :: String -> String -> (KeySpec,Maybe String)
484parseSpec grip spec = (topspec,subspec) 497parseSpec grip spec = (topspec,subspec)
485 where 498 where
@@ -525,11 +538,8 @@ buildKeyDB secring pubring grip0 keyring = do
525 let isring (KeyRingFile {}) = True 538 let isring (KeyRingFile {}) = True
526 isring _ = False 539 isring _ = False
527 540
528 getUsage (PEMFile usage) = return usage 541 iswallet (WalletFile {}) = True
529 getUsage _ = mzero 542 iswallet _ = False
530
531 iswallet WalletFile = True
532 iswallet _ = False
533 543
534 files isring = do 544 files isring = do
535 (f,(rtyp,ftyp)) <- Map.toList (kFiles keyring) 545 (f,(rtyp,ftyp)) <- Map.toList (kFiles keyring)
@@ -812,7 +822,7 @@ writeWalletKeys :: KeyRingData -> KeyDB -> Maybe Packet -> IO (KikiCondition [(F
812writeWalletKeys krd db wk = do 822writeWalletKeys krd db wk = do
813 let cs = db `coinKeysOwnedBy` wk 823 let cs = db `coinKeysOwnedBy` wk
814 -- export wallet keys 824 -- export wallet keys
815 isMutableWallet (MutableRef {}) WalletFile = True 825 isMutableWallet (MutableRef {}) (WalletFile {}) = True
816 isMutableWallet _ _ = False 826 isMutableWallet _ _ = False
817 files pred = do 827 files pred = do
818 (f,(rtyp,ftyp)) <- Map.toList (kFiles krd) 828 (f,(rtyp,ftyp)) <- Map.toList (kFiles krd)
@@ -853,11 +863,6 @@ writeRingKeys :: KeyRingData -> KeyDB -> Maybe Packet
853 -> IO (KikiCondition [(FilePath,KikiReportAction)]) 863 -> IO (KikiCondition [(FilePath,KikiReportAction)])
854writeRingKeys krd db wk secring pubring = do 864writeRingKeys krd db wk secring pubring = do
855 let ks = Map.elems db 865 let ks = Map.elems db
856 {-
857 fs = Map.keys (foldr unionfiles Map.empty ks)
858 where unionfiles (KeyData p _ _ _) m =
859 Map.union m (locations p)
860 -}
861 isring (KeyRingFile {}) = True 866 isring (KeyRingFile {}) = True
862 isring _ = False 867 isring _ = False
863 isMutable (MutableRef {}) = True 868 isMutable (MutableRef {}) = True
@@ -869,9 +874,6 @@ writeRingKeys krd db wk secring pubring = do
869 return (n,isMutable rtyp) 874 return (n,isMutable rtyp)
870 fromfile f kd@(KeyData p _ _ _) = 875 fromfile f kd@(KeyData p _ _ _) =
871 Map.member f $ locations p 876 Map.member f $ locations p
872 {- maybe (Map.member f $ locations p)
873 (\pred -> pred kd)
874 (Map.lookup f $ kImports krd) -}
875 let s = do 877 let s = do
876 (f,mutable) <- fs 878 (f,mutable) <- fs
877 let x = do 879 let x = do
@@ -921,12 +923,31 @@ runKeyRing keyring op = do
921 if e==0 then return $ Just lk 923 if e==0 then return $ Just lk
922 else dotlock_destroy lk >> return Nothing 924 else dotlock_destroy lk >> return Nothing
923 return (v,f) 925 return (v,f)
924 let (lked, map snd -> failed) = partition (isJust . fst) lks 926 let (lked, map snd -> failed_locks) = partition (isJust . fst) lks
925 ret = if null failed then KikiSuccess () else FailedToLock failed 927 ret <-
926 ret <- case functorToEither ret of 928 if not $ null failed_locks
927 Right {} -> do 929 then return $ KikiResult (FailedToLock failed_locks) []
928 bresult <- buildKeyDB secring pubring grip0 keyring -- build db 930 else do
929 try' bresult $ \((db,grip,wk),report1) -> do 931 -- create nonexistent files via external commands
932 report_externals <- do
933 let cmds = do
934 (f,(rtyp,ftyp)) <- Map.toList (kFiles keyring)
935 cmd <- maybeToList (initializer rtyp)
936 (_,subspec) <- fmap (parseSpec "") $ getUsage ftyp
937 fname <- resolveInputFile secring pubring f
938 return (fname,maybe "" id subspec,cmd)
939 forM cmds $ \(fname,usage,cmd) -> do
940 e <- systemEnv [ ("file",fname)
941 , ("usage",usage) ]
942 cmd
943 case e of
944 ExitFailure num -> return (fname,FailedExternal num)
945 ExitSuccess -> return (fname,ExternallyGeneratedFile)
946
947 -- merge all keyrings, PEM files, and wallets
948 bresult <- buildKeyDB secring pubring grip0 keyring
949
950 try' bresult $ \((db,grip,wk),report_imports) -> do
930 a <- return $ op KeyRingRuntime 951 a <- return $ op KeyRingRuntime
931 { rtPubring = pubring 952 { rtPubring = pubring
932 , rtSecring = secring 953 , rtSecring = secring
@@ -935,12 +956,20 @@ runKeyRing keyring op = do
935 , rtGrip = grip 956 , rtGrip = grip
936 , rtKeyDB = db 957 , rtKeyDB = db
937 } 958 }
959
938 r <- writeWalletKeys keyring db wk 960 r <- writeWalletKeys keyring db wk
939 try' r $ \report2 -> do 961 try' r $ \report_wallets -> do
962
940 r <- writeRingKeys keyring db wk secring pubring 963 r <- writeRingKeys keyring db wk secring pubring
941 try' r $ \report3 -> do 964 try' r $ \report_rings -> do
942 return $ KikiResult (KikiSuccess a) (report1 ++ report3) 965
943 Left err -> return $ KikiResult err [] 966 -- writePEMKeys
967
968 return $ KikiResult (KikiSuccess a)
969 $ concat [ report_externals
970 , report_imports
971 , report_wallets
972 , report_rings ]
944 973
945 forM_ lked $ \(Just lk, fname) -> do dotlock_release lk 974 forM_ lked $ \(Just lk, fname) -> do dotlock_release lk
946 dotlock_destroy lk -- todo: verify we want this 975 dotlock_destroy lk -- todo: verify we want this