1 files changed, 123 insertions, 3 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
 import Data.List
 import Data.OpenPGP
 import Data.Functor
+import Data.Monoid
 import Data.Bits              ( (.|.) )
 import Control.Applicative    ( liftA2, (<$>) )
 import System.Directory       ( getHomeDirectory, doesFileExist )
@@ -27,15 +28,16 @@ import ControlMaybe ( handleIO_ )
 import Data.ASN1.Types ( toASN1, ASN1Object, fromASN1
        , ASN1(Start,End,IntVal,OID,BitString), ASN1ConstructionType(Sequence) )
 import Data.ASN1.BitArray ( BitArray(..), toBitArray )
-import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1' )
+import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1, decodeASN1' )
 import Data.ASN1.BinaryEncoding ( DER(..) )
 import Data.Time.Clock.POSIX ( getPOSIXTime )
 import qualified Data.Map as Map
-import qualified Data.ByteString.Lazy as L ( null, readFile, writeFile, ByteString, toChunks )
+import qualified Data.ByteString.Lazy as L ( pack, null, readFile, writeFile, ByteString, toChunks )
 import qualified Data.ByteString      as S ( unpack, splitAt, concat, cons )
-import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break ) 
+import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break, concat, lines )
 import qualified Crypto.Types.PubKey.ECC as ECC
 import qualified Codec.Binary.Base32 as Base32
+import qualified Codec.Binary.Base64 as Base64
 import qualified Crypto.Hash.SHA1 as SHA1
 import qualified Data.Text as T ( Text, unpack, pack,
         strip, reverse, drop, break, dropAround )
@@ -168,12 +170,59 @@ data RSAPrivateKey = RSAPrivateKey
     }
  deriving Show
 
+instance ASN1Object RSAPrivateKey where
+    toASN1 rsa@(RSAPrivateKey {})
+        = \xs -> Start Sequence
+               : IntVal 0
+               : mpiVal rsaN
+               : mpiVal rsaE
+               : mpiVal rsaD
+               : mpiVal rsaP
+               : mpiVal rsaQ
+               : mpiVal rsaDmodP1
+               : mpiVal rsaDmodQminus1
+               : mpiVal rsaCoefficient
+               : End Sequence
+               : xs
+                  where mpiVal f = IntVal x where MPI x = f rsa
+
+    fromASN1 ( Start Sequence
+             : IntVal _ -- version
+             : IntVal n
+             : IntVal e
+             : IntVal d
+             : IntVal p
+             : IntVal q
+             : IntVal dmodp1
+             : IntVal dmodqminus1
+             : IntVal coefficient
+             : ys) =
+        Right ( privkey, tail $ dropWhile notend ys)
+         where
+            notend (End Sequence) = False
+            notend _              = True
+            privkey = RSAPrivateKey
+                { rsaN = MPI n
+                , rsaE = MPI e
+                , rsaD = MPI d
+                , rsaP = MPI p
+                , rsaQ = MPI q
+                , rsaDmodP1 = MPI dmodp1
+                , rsaDmodQminus1 = MPI dmodqminus1
+                , rsaCoefficient = MPI coefficient
+                }
+    fromASN1 _ =
+        Left "fromASN1: RSAPrivateKey: unexpected format"
+
+
 
 data KikiCondition a = KikiSuccess a
     | FailedToLock [FilePath]
     | BadPassphrase
     | FailedToMakeSignature
     | CantFindHome
+    | AmbiguousKeySpec
+    | CannotImportMasterKey
  deriving ( Functor, Show )
 
 instance FunctorToMaybe KikiCondition where
@@ -479,6 +528,10 @@ buildKeyDB secring pubring grip0 keyring = do
 
     db <- foldM importWalletKey (KikiSuccess (db_rings,[])) wallet_keys
     try db $ \(db,report) -> do
+
+    -- todo: import PEMFiles
+    -- use_db <- foldM (doImport decrypt) use_db0 (map snd imports)
+
     return $ KikiSuccess ( (db, grip, wk), report )
 
 torhash key = maybe "" id $ derToBase32 <$> derRSA key
@@ -495,6 +548,73 @@ try x body =
            Left e -> return e
            Right x -> body x
 
+readKeyFromFile False "PEM" fname = do
+    -- warn $ fname ++ ": reading ..."
+    -- Note: The key's timestamp is included in it's fingerprint.
+    --       Therefore, we should attempt to preserve it.
+    timestamp <- handleIO_ (error $ fname++": modificaiton time?") $ 
+                    modificationTime <$> getFileStatus fname
+    input <- L.readFile fname
+    let dta = extractPEM "RSA PRIVATE KEY" input
+    -- Char8.putStrLn $ "dta = " <> dta
+    let rsa = do
+           e <- decodeASN1 DER . L.pack <$> Base64.decode (Char8.unpack dta)
+           asn1 <- either (const Nothing) Just e
+           k <- either (const Nothing) (Just . fst) (fromASN1 asn1)
+           let _ = k :: RSAPrivateKey
+           return k
+    -- putStrLn $ "rsa = "++ show rsa
+    return . Message $ do
+        rsa <- maybeToList rsa
+        return $ SecretKeyPacket
+            { version = 4
+            , timestamp = toEnum (fromEnum timestamp)
+            , key_algorithm = RSA
+            , key = [ -- public fields...
+                     ('n',rsaN rsa)
+                    ,('e',rsaE rsa)
+                    -- secret fields
+                    ,('d',rsaD rsa)
+                    ,('p',rsaQ rsa) -- Note: p & q swapped
+                    ,('q',rsaP rsa) -- Note: p & q swapped
+                    ,('u',rsaCoefficient rsa)
+                    ]
+            -- , ecc_curve = def
+            , s2k_useage = 0
+            , s2k = S2K 100 ""
+            , symmetric_algorithm = Unencrypted
+            , encrypted_data = ""
+            , is_subkey = True
+            }
+readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt)
+
+extractPEM typ pem = dta
+ where
+    dta = case ys of
+            _:dta_lines -> Char8.concat dta_lines
+            []          -> ""
+    xs = dropWhile (/="-----BEGIN " <> typ <> "-----") (Char8.lines pem)
+    ys = takeWhile (/="-----END " <> typ <> "-----") xs
+
+
+doImport
+  :: Ord k =>
+     (Packet -> IO (KikiCondition Packet))
+     -> Map.Map k KeyData
+     -> ([Char], Maybe [Char], [k], t)
+     -> IO (KikiCondition (Map.Map k KeyData, [(FilePath,KikiReportAction)]))
+doImport doDecrypt db (fname,subspec,ms,_) = do
+    let fetchkey = readKeyFromFile False "PEM" fname
+    flip (maybe $ return CannotImportMasterKey)
+         subspec $ \tag -> do
+    Message parsedkey <- fetchkey
+    flip (maybe $ return $ KikiSuccess (db,[]))
+         (listToMaybe parsedkey) $ \key -> do
+    let (m0,tailms) = splitAt 1 ms
+    if (not (null tailms) || null m0)
+        then return AmbiguousKeySpec
+        else doImportG doDecrypt db m0 tag fname key
+
 doImportG
   :: Ord k =>
      (Packet -> IO (KikiCondition Packet))