summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-05-09 20:44:38 -0400
committerjoe <joe@jerkface.net>2014-05-09 20:44:38 -0400
commitde1a24cf818af86841e5101c96183a83fd8b3cb5 (patch)
tree0fc43514c8e75da1bccd007fde2a24ab9ddae591 /KeyRing.hs
parente1fbcbd60344f8cc5d60ff611114e30209e3c8f2 (diff)
remove extractPEM/splitPEM in favor of pemParser
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs40
1 files changed, 4 insertions, 36 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index b0dff04..fe0f3cd 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -79,7 +79,6 @@ module KeyRing
79 , getBindings 79 , getBindings
80 , accBindings 80 , accBindings
81 , isSubkeySignature 81 , isSubkeySignature
82 , extractPEM
83 , torhash 82 , torhash
84 ) where 83 ) where
85 84
@@ -112,8 +111,8 @@ import Data.Time.Clock.POSIX ( POSIXTime )
112import Data.Bits ( Bits ) 111import Data.Bits ( Bits )
113import Data.Text.Encoding ( encodeUtf8 ) 112import Data.Text.Encoding ( encodeUtf8 )
114import qualified Data.Map as Map 113import qualified Data.Map as Map
115import qualified Data.ByteString.Lazy as L ( unpack, pack, null, readFile, writeFile 114import qualified Data.ByteString.Lazy as L ( unpack, null, readFile, writeFile
116 , ByteString, toChunks, hGetContents, hPut, concat, fromChunks, isSuffixOf ) 115 , ByteString, toChunks, hGetContents, hPut, concat, fromChunks )
117import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile) 116import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile)
118import qualified Crypto.Types.PubKey.ECC as ECC 117import qualified Crypto.Types.PubKey.ECC as ECC
119import qualified Codec.Binary.Base32 as Base32 118import qualified Codec.Binary.Base32 as Base32
@@ -152,6 +151,7 @@ import qualified Data.ByteString.Lazy.Char8 as Char8
152 151
153import TimeUtil 152import TimeUtil
154import PEM 153import PEM
154import ScanningParser
155import qualified Hosts 155import qualified Hosts
156import qualified CryptoCoins 156import qualified CryptoCoins
157import Base58 157import Base58
@@ -1386,7 +1386,7 @@ readKeyFromFile False "PEM" fname = do
1386 -- Therefore, we should attempt to preserve it. 1386 -- Therefore, we should attempt to preserve it.
1387 timestamp <- getInputFileTime ctx fname 1387 timestamp <- getInputFileTime ctx fname
1388 input <- readInputFileL ctx fname 1388 input <- readInputFileL ctx fname
1389 let dta = extractPEM "RSA PRIVATE KEY" input 1389 let dta = fmap pemBlob $ listToMaybe $ scanAndParse (pemParser $ Just "RSA PRIVATE KEY") $ Char8.lines input
1390 -- Char8.putStrLn $ "dta = " <> dta 1390 -- Char8.putStrLn $ "dta = " <> dta
1391 let rsa = do 1391 let rsa = do
1392 e <- decodeASN1 DER <$> dta 1392 e <- decodeASN1 DER <$> dta
@@ -1419,38 +1419,6 @@ readKeyFromFile False "PEM" fname = do
1419 } 1419 }
1420readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt) 1420readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt)
1421 1421
1422extractPEM :: ByteString -> ByteString -> Maybe ByteString
1423extractPEM typ pem = if L.null blob then Nothing else Just blob
1424 where
1425 blob = pemBlob $ fst $ splitPEM (Just typ) $ Char8.lines pem
1426
1427splitPEM :: Maybe ByteString -> [ByteString] -> (PEMBlob,([ByteString],[ByteString]))
1428splitPEM mtyp [] = (PEMBlob "" "", ([],[]))
1429splitPEM mtyp pem =
1430 case mblob of
1431 Just blob -> (PEMBlob typ blob,(bs,drop 1 rs))
1432 Nothing -> let (ret,(ts,us)) = splitPEM mtyp $ drop 1 rs
1433 in (ret, (bs++ys++ts,us))
1434 where
1435 mblob = L.pack <$> Base64.decode (Char8.unpack dta)
1436 dta = case ys of
1437 _:dta_lines -> Char8.concat dta_lines
1438 [] -> ""
1439 (typ,(bs,xs)) =
1440 case mtyp of
1441 Just typ -> (typ,) $ span (/="-----BEGIN " <> typ <> "-----") pem
1442 Nothing -> (L.concat $ take 1 typs, xs0)
1443 where
1444 xs0 = span (not . ("-----BEGIN " `Char8.isPrefixOf`))
1445 pem
1446 typs = do
1447 x0 <- fmap (Char8.drop 11) $ take 1 (fst xs0)
1448 guard $ "-----" `L.isSuffixOf` x0
1449 let typ = Char8.take (Char8.length x0 - 5) x0
1450 return typ
1451 (ys,rs) = span (/="-----END " <> typ <> "-----") xs
1452
1453
1454doImport 1422doImport
1455 :: Ord k => 1423 :: Ord k =>
1456 (MappedPacket -> IO (KikiCondition Packet)) 1424 (MappedPacket -> IO (KikiCondition Packet))