diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 113 |
1 files changed, 0 insertions, 113 deletions
@@ -110,50 +110,6 @@ RSAPrivateKey ::= SEQUENCE { | |||
110 | } | 110 | } |
111 | -} | 111 | -} |
112 | 112 | ||
113 | instance 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 | |||
157 | sshrsa :: Integer -> Integer -> Char8.ByteString | 113 | sshrsa :: Integer -> Integer -> Char8.ByteString |
158 | sshrsa e n = runPut $ do | 114 | sshrsa e n = runPut $ do |
159 | putWord32be 7 | 115 | putWord32be 7 |
@@ -212,14 +168,6 @@ getPackets = do | |||
212 | -} | 168 | -} |
213 | 169 | ||
214 | 170 | ||
215 | extractPEM 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 | |||
223 | writePEM typ dta = pem | 171 | writePEM 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 | ||
685 | readKeyFromFile 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 | } | ||
723 | readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt) | ||
724 | |||
725 | readPublicKey :: Char8.ByteString -> RSAPublicKey | 633 | readPublicKey :: Char8.ByteString -> RSAPublicKey |
726 | readPublicKey bs = maybe er id $ do | 634 | readPublicKey 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 | ||
1167 | doImport | ||
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) | ||
1173 | doImport 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. |
1189 | setHostnames :: (SockAddr -> Bool) -> Hosts.Hosts -> KeyData -> IO KeyData | 1076 | setHostnames :: (SockAddr -> Bool) -> Hosts.Hosts -> KeyData -> IO KeyData |
1190 | setHostnames pred hosts kd@(KeyData topmp topsigs uids subs) = | 1077 | setHostnames pred hosts kd@(KeyData topmp topsigs uids subs) = |