diff options
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 74 |
1 files changed, 71 insertions, 3 deletions
@@ -19,7 +19,7 @@ import Data.Monoid | |||
19 | import Data.Tuple ( swap ) | 19 | import Data.Tuple ( swap ) |
20 | import Data.Bits ( (.|.) ) | 20 | import Data.Bits ( (.|.) ) |
21 | import Control.Applicative ( liftA2, (<$>) ) | 21 | import Control.Applicative ( liftA2, (<$>) ) |
22 | import System.Directory ( getHomeDirectory, doesFileExist ) | 22 | import System.Directory ( getHomeDirectory, doesFileExist, createDirectoryIfMissing ) |
23 | import Control.Arrow ( first, second ) | 23 | import Control.Arrow ( first, second ) |
24 | import Data.OpenPGP.Util (verify,fingerprint,decryptSecretKey,pgpSign) | 24 | import Data.OpenPGP.Util (verify,fingerprint,decryptSecretKey,pgpSign) |
25 | import Data.ByteString.Lazy ( ByteString ) | 25 | import Data.ByteString.Lazy ( ByteString ) |
@@ -34,7 +34,8 @@ import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1, decodeASN1' ) | |||
34 | import Data.ASN1.BinaryEncoding ( DER(..) ) | 34 | import Data.ASN1.BinaryEncoding ( DER(..) ) |
35 | import Data.Time.Clock.POSIX ( getPOSIXTime ) | 35 | import Data.Time.Clock.POSIX ( getPOSIXTime ) |
36 | import qualified Data.Map as Map | 36 | import qualified Data.Map as Map |
37 | import qualified Data.ByteString.Lazy as L ( pack, null, readFile, writeFile, ByteString, toChunks ) | 37 | import qualified Data.ByteString.Lazy as L ( unpack, pack, null, readFile, writeFile |
38 | , ByteString, toChunks ) | ||
38 | import qualified Data.ByteString as S ( unpack, splitAt, concat, cons ) | 39 | import qualified Data.ByteString as S ( unpack, splitAt, concat, cons ) |
39 | import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break, concat, lines ) | 40 | import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break, concat, lines ) |
40 | import qualified Crypto.Types.PubKey.ECC as ECC | 41 | import qualified Crypto.Types.PubKey.ECC as ECC |
@@ -44,7 +45,9 @@ import qualified Crypto.Hash.SHA1 as SHA1 | |||
44 | import qualified Data.Text as T ( Text, unpack, pack, | 45 | import qualified Data.Text as T ( Text, unpack, pack, |
45 | strip, reverse, drop, break, dropAround ) | 46 | strip, reverse, drop, break, dropAround ) |
46 | import System.Posix.Types (EpochTime) | 47 | import System.Posix.Types (EpochTime) |
47 | import System.Posix.Files ( modificationTime, getFileStatus ) | 48 | import System.Posix.Files ( modificationTime, getFileStatus |
49 | , setFileCreationMask, setFileTimes ) | ||
50 | import System.FilePath ( takeDirectory ) | ||
48 | import System.IO (hPutStrLn,withFile,IOMode(..)) | 51 | import System.IO (hPutStrLn,withFile,IOMode(..)) |
49 | import Data.Binary ( encode ) | 52 | import Data.Binary ( encode ) |
50 | 53 | ||
@@ -260,6 +263,8 @@ data KikiReportAction = | |||
260 | | WarnFailedToMakeSignature | 263 | | WarnFailedToMakeSignature |
261 | | FailedExternal Int | 264 | | FailedExternal Int |
262 | | ExternallyGeneratedFile | 265 | | ExternallyGeneratedFile |
266 | | UnableToExport KeyAlgorithm String | ||
267 | | FailedFileWrite | ||
263 | 268 | ||
264 | data KikiResult a = KikiResult | 269 | data KikiResult a = KikiResult |
265 | { kikiCondition :: KikiCondition a | 270 | { kikiCondition :: KikiCondition a |
@@ -999,6 +1004,69 @@ subkeysForExport subspec (KeyData key _ _ subkeys) = do | |||
999 | sigtrusts | 1004 | sigtrusts |
1000 | in fmap fst v==Just True | 1005 | in fmap fst v==Just True |
1001 | 1006 | ||
1007 | writePEM typ dta = pem | ||
1008 | where | ||
1009 | pem = unlines . concat $ | ||
1010 | [ ["-----BEGIN " <> typ <> "-----"] | ||
1011 | , split64s dta | ||
1012 | , ["-----END " <> typ <> "-----"] ] | ||
1013 | split64s "" = [] | ||
1014 | split64s dta = line : split64s rest where (line,rest) = splitAt 64 dta | ||
1015 | |||
1016 | -- 64 byte lines | ||
1017 | |||
1018 | rsaPrivateKeyFromPacket :: Packet -> Maybe RSAPrivateKey | ||
1019 | rsaPrivateKeyFromPacket pkt@(SecretKeyPacket {}) = do | ||
1020 | -- public fields... | ||
1021 | n <- lookup 'n' $ key pkt | ||
1022 | e <- lookup 'e' $ key pkt | ||
1023 | -- secret fields | ||
1024 | MPI d <- lookup 'd' $ key pkt | ||
1025 | MPI q <- lookup 'p' $ key pkt -- Note: p & q swapped | ||
1026 | MPI p <- lookup 'q' $ key pkt -- Note: p & q swapped | ||
1027 | |||
1028 | -- Note: Here we fail if 'u' key is missing. | ||
1029 | -- Ideally, it would be better to compute (inverse q) mod p | ||
1030 | -- see Algebra.Structures.EuclideanDomain.extendedEuclidAlg | ||
1031 | -- (package constructive-algebra) | ||
1032 | coefficient <- lookup 'u' $ key pkt | ||
1033 | |||
1034 | let dmodp1 = MPI $ d `mod` (p - 1) | ||
1035 | dmodqminus1 = MPI $ d `mod` (q - 1) | ||
1036 | return $ RSAPrivateKey | ||
1037 | { rsaN = n | ||
1038 | , rsaE = e | ||
1039 | , rsaD = MPI d | ||
1040 | , rsaP = MPI p | ||
1041 | , rsaQ = MPI q | ||
1042 | , rsaDmodP1 = dmodp1 | ||
1043 | , rsaDmodQminus1 = dmodqminus1 | ||
1044 | , rsaCoefficient = coefficient } | ||
1045 | rsaPrivateKeyFromPacket _ = Nothing | ||
1046 | |||
1047 | |||
1048 | writeKeyToFile False "PEM" fname packet = | ||
1049 | case key_algorithm packet of | ||
1050 | RSA -> do | ||
1051 | flip (maybe (return [])) | ||
1052 | (rsaPrivateKeyFromPacket packet) -- RSAPrivateKey | ||
1053 | $ \rsa -> do | ||
1054 | let asn1 = toASN1 rsa [] | ||
1055 | bs = encodeASN1 DER asn1 | ||
1056 | dta = Base64.encode (L.unpack bs) | ||
1057 | output = writePEM "RSA PRIVATE KEY" dta | ||
1058 | stamp = toEnum . fromEnum $ timestamp packet | ||
1059 | createDirectoryIfMissing True (takeDirectory fname) | ||
1060 | handleIO_ (return [(fname, FailedFileWrite)]) $ do | ||
1061 | saved_mask <- setFileCreationMask 0o077 | ||
1062 | writeFile fname output | ||
1063 | -- Note: The key's timestamp is included in it's fingerprint. | ||
1064 | -- Therefore, we should attempt to preserve it. | ||
1065 | setFileTimes fname stamp stamp | ||
1066 | setFileCreationMask saved_mask | ||
1067 | return [(fname, ExportedSubkey)] | ||
1068 | algo -> return [(fname, UnableToExport algo $ fingerprint packet)] | ||
1069 | |||
1002 | writePEMKeys :: KeyDB | 1070 | writePEMKeys :: KeyDB |
1003 | -> [(FilePath,Maybe String,[Packet],Maybe Initializer)] | 1071 | -> [(FilePath,Maybe String,[Packet],Maybe Initializer)] |
1004 | -> IO (KikiCondition [(FilePath,KikiReportAction)]) | 1072 | -> IO (KikiCondition [(FilePath,KikiReportAction)]) |