diff options
-rw-r--r-- | KeyRing.hs | 29 | ||||
-rw-r--r-- | kiki.hs | 14 |
2 files changed, 30 insertions, 13 deletions
@@ -2158,7 +2158,9 @@ rsaPrivateKeyFromPacket pkt@(SecretKeyPacket {}) = do | |||
2158 | , rsaCoefficient = coefficient } | 2158 | , rsaCoefficient = coefficient } |
2159 | rsaPrivateKeyFromPacket _ = Nothing | 2159 | rsaPrivateKeyFromPacket _ = Nothing |
2160 | 2160 | ||
2161 | secretPemFromPacket packet = | 2161 | secretPemFromPacket packet = pemFromPacket Sec packet |
2162 | |||
2163 | pemFromPacket Sec packet = | ||
2162 | case key_algorithm packet of | 2164 | case key_algorithm packet of |
2163 | RSA -> do | 2165 | RSA -> do |
2164 | rsa <- rsaPrivateKeyFromPacket packet -- RSAPrivateKey | 2166 | rsa <- rsaPrivateKeyFromPacket packet -- RSAPrivateKey |
@@ -2168,11 +2170,24 @@ secretPemFromPacket packet = | |||
2168 | output = writePEM "RSA PRIVATE KEY" dta | 2170 | output = writePEM "RSA PRIVATE KEY" dta |
2169 | Just output | 2171 | Just output |
2170 | algo -> Nothing | 2172 | algo -> Nothing |
2173 | pemFromPacket Pub packet = | ||
2174 | case key_algorithm packet of | ||
2175 | RSA -> do | ||
2176 | rsa <- rsaKeyFromPacket packet | ||
2177 | let asn1 = toASN1 (pkcs8 rsa) [] | ||
2178 | bs = encodeASN1 DER asn1 | ||
2179 | dta = Base64.encode (L.unpack bs) | ||
2180 | output = writePEM "PUBLIC KEY" dta | ||
2181 | Just output | ||
2182 | algo -> Nothing | ||
2183 | pemFromPacket AutoAccess p@(PublicKeyPacket {}) = pemFromPacket Pub p | ||
2184 | pemFromPacket AutoAccess p@(SecretKeyPacket {}) = pemFromPacket Sec p | ||
2185 | pemFromPacket AutoAccess _ = Nothing | ||
2171 | 2186 | ||
2172 | writeKeyToFile :: | 2187 | writeKeyToFile :: |
2173 | Bool -> FileType -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)] | 2188 | Bool -> StreamInfo -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)] |
2174 | writeKeyToFile False PEMFile fname packet = do | 2189 | writeKeyToFile False stream@(StreamInfo { typ = PEMFile }) fname packet = do |
2175 | case secretPemFromPacket packet of | 2190 | case pemFromPacket (access stream) packet of |
2176 | Just output -> do | 2191 | Just output -> do |
2177 | let stamp = toEnum . fromEnum $ timestamp packet | 2192 | let stamp = toEnum . fromEnum $ timestamp packet |
2178 | handleIO_ (return [(fname, FailedFileWrite)]) $ do | 2193 | handleIO_ (return [(fname, FailedFileWrite)]) $ do |
@@ -2184,7 +2199,7 @@ writeKeyToFile False PEMFile fname packet = do | |||
2184 | return [(fname, ExportedSubkey)] | 2199 | return [(fname, ExportedSubkey)] |
2185 | Nothing -> return [(fname, UnableToExport (key_algorithm packet) $ fingerprint packet)] | 2200 | Nothing -> return [(fname, UnableToExport (key_algorithm packet) $ fingerprint packet)] |
2186 | 2201 | ||
2187 | writeKeyToFile False DNSPresentation fname packet = do | 2202 | writeKeyToFile False StreamInfo { typ = DNSPresentation } fname packet = do |
2188 | case key_algorithm packet of | 2203 | case key_algorithm packet of |
2189 | RSA -> do | 2204 | RSA -> do |
2190 | flip (maybe (return [])) | 2205 | flip (maybe (return [])) |
@@ -2232,12 +2247,14 @@ writePEMKeys doDecrypt db exports = do | |||
2232 | let ds' = map functorToEither ds | 2247 | let ds' = map functorToEither ds |
2233 | if null (lefts ds') | 2248 | if null (lefts ds') |
2234 | then do | 2249 | then do |
2235 | rs <- mapM (\(f,stream,p) -> writeKeyToFile False (typ stream) (ArgFile f) p) | 2250 | rs <- mapM (\(f,stream,p) -> writeKeyToFile False stream (ArgFile f) p) |
2236 | (rights ds') | 2251 | (rights ds') |
2237 | return $ KikiSuccess (map (first $ resolveForReport Nothing) $ concat rs) | 2252 | return $ KikiSuccess (map (first $ resolveForReport Nothing) $ concat rs) |
2238 | else do | 2253 | else do |
2239 | return (head $ lefts ds') | 2254 | return (head $ lefts ds') |
2240 | where | 2255 | where |
2256 | decryptKeys (fname,subspec,[p],stream@(StreamInfo { access=Pub })) | ||
2257 | = return $ KikiSuccess (fname,stream,packet p) -- public keys are never encrypted. | ||
2241 | decryptKeys (fname,subspec,[p],stream) = do | 2258 | decryptKeys (fname,subspec,[p],stream) = do |
2242 | pun <- doDecrypt p | 2259 | pun <- doDecrypt p |
2243 | try pun $ \pun -> do | 2260 | try pun $ \pun -> do |
@@ -804,8 +804,7 @@ documentAutoSignFlag bExport bImport bSecret = | |||
804 | ," 'tor' subkey corresponding to the address HOSTNAME.onion." | 804 | ," 'tor' subkey corresponding to the address HOSTNAME.onion." |
805 | ,""] | 805 | ,""] |
806 | documentKeyPairsOption :: Bool -> Bool -> Bool -> [String] | 806 | documentKeyPairsOption :: Bool -> Bool -> Bool -> [String] |
807 | documentKeyPairsOption bExport bImport False = [] | 807 | documentKeyPairsOption bExport bImport bSecret = |
808 | documentKeyPairsOption bExport bImport bSecret@True = | ||
809 | [" --keypairs [KEYSPEC ...]" | 808 | [" --keypairs [KEYSPEC ...]" |
810 | ," A keypair is a secret key coupled with it's corresponding public" | 809 | ," A keypair is a secret key coupled with it's corresponding public" |
811 | ," key, both of which are ordinarily stored in a single file in PEM" | 810 | ," key, both of which are ordinarily stored in a single file in PEM" |
@@ -1041,7 +1040,7 @@ buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp | |||
1041 | -- bImport: --import and --import-if-authentic | 1040 | -- bImport: --import and --import-if-authentic |
1042 | sync :: Bool -> Bool -> Bool -> String -> [String] -> IO () | 1041 | sync :: Bool -> Bool -> Bool -> String -> [String] -> IO () |
1043 | sync bExport bImport bSecret cmdarg args_raw = do | 1042 | sync bExport bImport bSecret cmdarg args_raw = do |
1044 | let (sargs,margs) = processArgs sargspec polyVariadicArgs "--keyrings" args_raw | 1043 | let (sargs,margs) = processArgs sargspec polyVariadicArgs "--keypairs" args_raw |
1045 | sargspec = [ ("--show-wk",0) | 1044 | sargspec = [ ("--show-wk",0) |
1046 | , ("--autosign",0) | 1045 | , ("--autosign",0) |
1047 | {-, ("--show-all",0) | 1046 | {-, ("--show-all",0) |
@@ -1054,9 +1053,10 @@ sync bExport bImport bSecret cmdarg args_raw = do | |||
1054 | ++ do guard bImport | 1053 | ++ do guard bImport |
1055 | [ ("--import",0), ("--import-if-authentic",0) ] | 1054 | [ ("--import",0), ("--import-if-authentic",0) ] |
1056 | polyVariadicArgs = ["--keyrings" | 1055 | polyVariadicArgs = ["--keyrings" |
1057 | ,"--hosts" ] | 1056 | ,"--hosts" |
1057 | ,"--keypairs"] | ||
1058 | ++ do guard bSecret | 1058 | ++ do guard bSecret |
1059 | [ "--keypairs", "--wallets" ] | 1059 | [ "--wallets" ] |
1060 | -- putStrLn $ "margs = " ++ show (Map.assocs margs) | 1060 | -- putStrLn $ "margs = " ++ show (Map.assocs margs) |
1061 | unkeysRef <- newIORef Map.empty | 1061 | unkeysRef <- newIORef Map.empty |
1062 | pwRef <- newIORef Nothing | 1062 | pwRef <- newIORef Nothing |
@@ -1087,7 +1087,7 @@ sync bExport bImport bSecret cmdarg args_raw = do | |||
1087 | , typ = if "dns-" `isPrefixOf` usage | 1087 | , typ = if "dns-" `isPrefixOf` usage |
1088 | then DNSPresentation | 1088 | then DNSPresentation |
1089 | else PEMFile | 1089 | else PEMFile |
1090 | , access = Sec | 1090 | , access = if bSecret then Sec else Pub |
1091 | , initializer = cmd' | 1091 | , initializer = cmd' |
1092 | , transforms = [] | 1092 | , transforms = [] |
1093 | } ) | 1093 | } ) |
@@ -1121,7 +1121,7 @@ sync bExport bImport bSecret cmdarg args_raw = do | |||
1121 | KeyRingFile ) | 1121 | KeyRingFile ) |
1122 | ] | 1122 | ] |
1123 | ++ rings | 1123 | ++ rings |
1124 | ++ if bSecret then pems else [] | 1124 | ++ pems |
1125 | ++ if bSecret then walts else [] | 1125 | ++ if bSecret then walts else [] |
1126 | ++ hosts | 1126 | ++ hosts |
1127 | , opPassphrases = do pfile <- maybeToList passfd | 1127 | , opPassphrases = do pfile <- maybeToList passfd |