summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-04-15 18:35:00 -0400
committerjoe <joe@jerkface.net>2014-04-15 18:35:00 -0400
commit27961dacaf2806581c79d26c287d340d596f890b (patch)
treeab1667ea7c64f44bb96414b119335675a30691a4
parent000f67e46b9ac8f19d2fe589d8c8fff1a0ffa216 (diff)
moved doImport to KeyRing.hs
-rw-r--r--KeyRing.hs126
-rw-r--r--kiki.hs113
2 files changed, 123 insertions, 116 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index b738a25..e3d41d8 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -14,6 +14,7 @@ import Data.Ord
14import Data.List 14import Data.List
15import Data.OpenPGP 15import Data.OpenPGP
16import Data.Functor 16import Data.Functor
17import Data.Monoid
17import Data.Bits ( (.|.) ) 18import Data.Bits ( (.|.) )
18import Control.Applicative ( liftA2, (<$>) ) 19import Control.Applicative ( liftA2, (<$>) )
19import System.Directory ( getHomeDirectory, doesFileExist ) 20import System.Directory ( getHomeDirectory, doesFileExist )
@@ -27,15 +28,16 @@ import ControlMaybe ( handleIO_ )
27import Data.ASN1.Types ( toASN1, ASN1Object, fromASN1 28import Data.ASN1.Types ( toASN1, ASN1Object, fromASN1
28 , ASN1(Start,End,IntVal,OID,BitString), ASN1ConstructionType(Sequence) ) 29 , ASN1(Start,End,IntVal,OID,BitString), ASN1ConstructionType(Sequence) )
29import Data.ASN1.BitArray ( BitArray(..), toBitArray ) 30import Data.ASN1.BitArray ( BitArray(..), toBitArray )
30import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1' ) 31import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1, decodeASN1' )
31import Data.ASN1.BinaryEncoding ( DER(..) ) 32import Data.ASN1.BinaryEncoding ( DER(..) )
32import Data.Time.Clock.POSIX ( getPOSIXTime ) 33import Data.Time.Clock.POSIX ( getPOSIXTime )
33import qualified Data.Map as Map 34import qualified Data.Map as Map
34import qualified Data.ByteString.Lazy as L ( null, readFile, writeFile, ByteString, toChunks ) 35import qualified Data.ByteString.Lazy as L ( pack, null, readFile, writeFile, ByteString, toChunks )
35import qualified Data.ByteString as S ( unpack, splitAt, concat, cons ) 36import qualified Data.ByteString as S ( unpack, splitAt, concat, cons )
36import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break ) 37import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break, concat, lines )
37import qualified Crypto.Types.PubKey.ECC as ECC 38import qualified Crypto.Types.PubKey.ECC as ECC
38import qualified Codec.Binary.Base32 as Base32 39import qualified Codec.Binary.Base32 as Base32
40import qualified Codec.Binary.Base64 as Base64
39import qualified Crypto.Hash.SHA1 as SHA1 41import qualified Crypto.Hash.SHA1 as SHA1
40import qualified Data.Text as T ( Text, unpack, pack, 42import qualified Data.Text as T ( Text, unpack, pack,
41 strip, reverse, drop, break, dropAround ) 43 strip, reverse, drop, break, dropAround )
@@ -168,12 +170,59 @@ data RSAPrivateKey = RSAPrivateKey
168 } 170 }
169 deriving Show 171 deriving Show
170 172
173instance ASN1Object RSAPrivateKey where
174 toASN1 rsa@(RSAPrivateKey {})
175 = \xs -> Start Sequence
176 : IntVal 0
177 : mpiVal rsaN
178 : mpiVal rsaE
179 : mpiVal rsaD
180 : mpiVal rsaP
181 : mpiVal rsaQ
182 : mpiVal rsaDmodP1
183 : mpiVal rsaDmodQminus1
184 : mpiVal rsaCoefficient
185 : End Sequence
186 : xs
187 where mpiVal f = IntVal x where MPI x = f rsa
188
189 fromASN1 ( Start Sequence
190 : IntVal _ -- version
191 : IntVal n
192 : IntVal e
193 : IntVal d
194 : IntVal p
195 : IntVal q
196 : IntVal dmodp1
197 : IntVal dmodqminus1
198 : IntVal coefficient
199 : ys) =
200 Right ( privkey, tail $ dropWhile notend ys)
201 where
202 notend (End Sequence) = False
203 notend _ = True
204 privkey = RSAPrivateKey
205 { rsaN = MPI n
206 , rsaE = MPI e
207 , rsaD = MPI d
208 , rsaP = MPI p
209 , rsaQ = MPI q
210 , rsaDmodP1 = MPI dmodp1
211 , rsaDmodQminus1 = MPI dmodqminus1
212 , rsaCoefficient = MPI coefficient
213 }
214 fromASN1 _ =
215 Left "fromASN1: RSAPrivateKey: unexpected format"
216
217
171 218
172data KikiCondition a = KikiSuccess a 219data KikiCondition a = KikiSuccess a
173 | FailedToLock [FilePath] 220 | FailedToLock [FilePath]
174 | BadPassphrase 221 | BadPassphrase
175 | FailedToMakeSignature 222 | FailedToMakeSignature
176 | CantFindHome 223 | CantFindHome
224 | AmbiguousKeySpec
225 | CannotImportMasterKey
177 deriving ( Functor, Show ) 226 deriving ( Functor, Show )
178 227
179instance FunctorToMaybe KikiCondition where 228instance FunctorToMaybe KikiCondition where
@@ -479,6 +528,10 @@ buildKeyDB secring pubring grip0 keyring = do
479 528
480 db <- foldM importWalletKey (KikiSuccess (db_rings,[])) wallet_keys 529 db <- foldM importWalletKey (KikiSuccess (db_rings,[])) wallet_keys
481 try db $ \(db,report) -> do 530 try db $ \(db,report) -> do
531
532 -- todo: import PEMFiles
533 -- use_db <- foldM (doImport decrypt) use_db0 (map snd imports)
534
482 return $ KikiSuccess ( (db, grip, wk), report ) 535 return $ KikiSuccess ( (db, grip, wk), report )
483 536
484torhash key = maybe "" id $ derToBase32 <$> derRSA key 537torhash key = maybe "" id $ derToBase32 <$> derRSA key
@@ -495,6 +548,73 @@ try x body =
495 Left e -> return e 548 Left e -> return e
496 Right x -> body x 549 Right x -> body x
497 550
551readKeyFromFile False "PEM" fname = do
552 -- warn $ fname ++ ": reading ..."
553 -- Note: The key's timestamp is included in it's fingerprint.
554 -- Therefore, we should attempt to preserve it.
555 timestamp <- handleIO_ (error $ fname++": modificaiton time?") $
556 modificationTime <$> getFileStatus fname
557 input <- L.readFile fname
558 let dta = extractPEM "RSA PRIVATE KEY" input
559 -- Char8.putStrLn $ "dta = " <> dta
560 let rsa = do
561 e <- decodeASN1 DER . L.pack <$> Base64.decode (Char8.unpack dta)
562 asn1 <- either (const Nothing) Just e
563 k <- either (const Nothing) (Just . fst) (fromASN1 asn1)
564 let _ = k :: RSAPrivateKey
565 return k
566 -- putStrLn $ "rsa = "++ show rsa
567 return . Message $ do
568 rsa <- maybeToList rsa
569 return $ SecretKeyPacket
570 { version = 4
571 , timestamp = toEnum (fromEnum timestamp)
572 , key_algorithm = RSA
573 , key = [ -- public fields...
574 ('n',rsaN rsa)
575 ,('e',rsaE rsa)
576 -- secret fields
577 ,('d',rsaD rsa)
578 ,('p',rsaQ rsa) -- Note: p & q swapped
579 ,('q',rsaP rsa) -- Note: p & q swapped
580 ,('u',rsaCoefficient rsa)
581 ]
582 -- , ecc_curve = def
583 , s2k_useage = 0
584 , s2k = S2K 100 ""
585 , symmetric_algorithm = Unencrypted
586 , encrypted_data = ""
587 , is_subkey = True
588 }
589readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt)
590
591extractPEM typ pem = dta
592 where
593 dta = case ys of
594 _:dta_lines -> Char8.concat dta_lines
595 [] -> ""
596 xs = dropWhile (/="-----BEGIN " <> typ <> "-----") (Char8.lines pem)
597 ys = takeWhile (/="-----END " <> typ <> "-----") xs
598
599
600doImport
601 :: Ord k =>
602 (Packet -> IO (KikiCondition Packet))
603 -> Map.Map k KeyData
604 -> ([Char], Maybe [Char], [k], t)
605 -> IO (KikiCondition (Map.Map k KeyData, [(FilePath,KikiReportAction)]))
606doImport doDecrypt db (fname,subspec,ms,_) = do
607 let fetchkey = readKeyFromFile False "PEM" fname
608 flip (maybe $ return CannotImportMasterKey)
609 subspec $ \tag -> do
610 Message parsedkey <- fetchkey
611 flip (maybe $ return $ KikiSuccess (db,[]))
612 (listToMaybe parsedkey) $ \key -> do
613 let (m0,tailms) = splitAt 1 ms
614 if (not (null tailms) || null m0)
615 then return AmbiguousKeySpec
616 else doImportG doDecrypt db m0 tag fname key
617
498doImportG 618doImportG
499 :: Ord k => 619 :: Ord k =>
500 (Packet -> IO (KikiCondition Packet)) 620 (Packet -> IO (KikiCondition Packet))
diff --git a/kiki.hs b/kiki.hs
index 66e3e4f..b23e304 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -110,50 +110,6 @@ RSAPrivateKey ::= SEQUENCE {
110} 110}
111-} 111-}
112 112
113instance ASN1Object RSAPrivateKey where
114 toASN1 rsa@(RSAPrivateKey {})
115 = \xs -> Start Sequence
116 : IntVal 0
117 : mpiVal rsaN
118 : mpiVal rsaE
119 : mpiVal rsaD
120 : mpiVal rsaP
121 : mpiVal rsaQ
122 : mpiVal rsaDmodP1
123 : mpiVal rsaDmodQminus1
124 : mpiVal rsaCoefficient
125 : End Sequence
126 : xs
127 where mpiVal f = IntVal x where MPI x = f rsa
128
129 fromASN1 ( Start Sequence
130 : IntVal _ -- version
131 : IntVal n
132 : IntVal e
133 : IntVal d
134 : IntVal p
135 : IntVal q
136 : IntVal dmodp1
137 : IntVal dmodqminus1
138 : IntVal coefficient
139 : ys) =
140 Right ( privkey, tail $ dropWhile notend ys)
141 where
142 notend (End Sequence) = False
143 notend _ = True
144 privkey = RSAPrivateKey
145 { rsaN = MPI n
146 , rsaE = MPI e
147 , rsaD = MPI d
148 , rsaP = MPI p
149 , rsaQ = MPI q
150 , rsaDmodP1 = MPI dmodp1
151 , rsaDmodQminus1 = MPI dmodqminus1
152 , rsaCoefficient = MPI coefficient
153 }
154 fromASN1 _ =
155 Left "fromASN1: RSAPrivateKey: unexpected format"
156
157sshrsa :: Integer -> Integer -> Char8.ByteString 113sshrsa :: Integer -> Integer -> Char8.ByteString
158sshrsa e n = runPut $ do 114sshrsa e n = runPut $ do
159 putWord32be 7 115 putWord32be 7
@@ -212,14 +168,6 @@ getPackets = do
212-} 168-}
213 169
214 170
215extractPEM typ pem = dta
216 where
217 dta = case ys of
218 _:dta_lines -> Char8.concat dta_lines
219 [] -> ""
220 xs = dropWhile (/="-----BEGIN " <> typ <> "-----") (Char8.lines pem)
221 ys = takeWhile (/="-----END " <> typ <> "-----") xs
222
223writePEM typ dta = pem 171writePEM typ dta = pem
224 where 172 where
225 pem = unlines . concat $ 173 pem = unlines . concat $
@@ -682,46 +630,6 @@ writeKeyToFile False "PEM" fname packet =
682 return () 630 return ()
683 algo -> warn $ fname ++ ": unable to export "++show algo++" key "++fingerprint packet 631 algo -> warn $ fname ++ ": unable to export "++show algo++" key "++fingerprint packet
684 632
685readKeyFromFile False "PEM" fname = do
686 -- warn $ fname ++ ": reading ..."
687 -- Note: The key's timestamp is included in it's fingerprint.
688 -- Therefore, we should attempt to preserve it.
689 timestamp <- handleIO_ (error $ fname++": modificaiton time?") $
690 modificationTime <$> getFileStatus fname
691 input <- L.readFile fname
692 let dta = extractPEM "RSA PRIVATE KEY" input
693 -- Char8.putStrLn $ "dta = " <> dta
694 let rsa = do
695 e <- decodeASN1 DER . L.pack <$> Base64.decode (Char8.unpack dta)
696 asn1 <- either (const Nothing) Just e
697 k <- either (const Nothing) (Just . fst) (fromASN1 asn1)
698 let _ = k :: RSAPrivateKey
699 return k
700 -- putStrLn $ "rsa = "++ show rsa
701 return . Message $ do
702 rsa <- maybeToList rsa
703 return $ SecretKeyPacket
704 { version = 4
705 , timestamp = toEnum (fromEnum timestamp)
706 , key_algorithm = RSA
707 , key = [ -- public fields...
708 ('n',rsaN rsa)
709 ,('e',rsaE rsa)
710 -- secret fields
711 ,('d',rsaD rsa)
712 ,('p',rsaQ rsa) -- Note: p & q swapped
713 ,('q',rsaP rsa) -- Note: p & q swapped
714 ,('u',rsaCoefficient rsa)
715 ]
716 -- , ecc_curve = def
717 , s2k_useage = 0
718 , s2k = S2K 100 ""
719 , symmetric_algorithm = Unencrypted
720 , encrypted_data = ""
721 , is_subkey = True
722 }
723readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt)
724
725readPublicKey :: Char8.ByteString -> RSAPublicKey 633readPublicKey :: Char8.ByteString -> RSAPublicKey
726readPublicKey bs = maybe er id $ do 634readPublicKey bs = maybe er id $ do
727 let (pre,bs1) = Char8.splitAt 7 bs 635 let (pre,bs1) = Char8.splitAt 7 bs
@@ -1164,27 +1072,6 @@ doBTCImport doDecrypt db (ms,subspec,content) = do
1164 $ error "Key specification is ambiguous." 1072 $ error "Key specification is ambiguous."
1165 doImportG doDecrypt db m0 tag "" key 1073 doImportG doDecrypt db m0 tag "" key
1166 1074
1167doImport
1168 :: Ord k =>
1169 (Packet -> IO (Maybe Packet))
1170 -> Map.Map k KeyData
1171 -> ([Char], Maybe [Char], [k], t)
1172 -> IO (Map.Map k KeyData)
1173doImport doDecrypt db (fname,subspec,ms,_) = do
1174 let fetchkey = readKeyFromFile False "PEM" fname
1175 let error s = do
1176 warn s
1177 exitFailure
1178 flip (maybe $ error "Cannot import master key.")
1179 subspec $ \tag -> do
1180 Message parsedkey <- fetchkey
1181 flip (maybe $ return db)
1182 (listToMaybe parsedkey) $ \key -> do
1183 let (m0,tailms) = splitAt 1 ms
1184 when (not (null tailms) || null m0)
1185 $ error "Key specification is ambiguous."
1186 doImportG doDecrypt db m0 tag fname key
1187
1188-- We return into IO in case we want to make a signature here. 1075-- We return into IO in case we want to make a signature here.
1189setHostnames :: (SockAddr -> Bool) -> Hosts.Hosts -> KeyData -> IO KeyData 1076setHostnames :: (SockAddr -> Bool) -> Hosts.Hosts -> KeyData -> IO KeyData
1190setHostnames pred hosts kd@(KeyData topmp topsigs uids subs) = 1077setHostnames pred hosts kd@(KeyData topmp topsigs uids subs) =