summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--KeyRing.hs29
-rw-r--r--kiki.hs14
2 files changed, 30 insertions, 13 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index b164527..53a1a34 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -2158,7 +2158,9 @@ rsaPrivateKeyFromPacket pkt@(SecretKeyPacket {}) = do
2158 , rsaCoefficient = coefficient } 2158 , rsaCoefficient = coefficient }
2159rsaPrivateKeyFromPacket _ = Nothing 2159rsaPrivateKeyFromPacket _ = Nothing
2160 2160
2161secretPemFromPacket packet = 2161secretPemFromPacket packet = pemFromPacket Sec packet
2162
2163pemFromPacket 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
2173pemFromPacket 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
2183pemFromPacket AutoAccess p@(PublicKeyPacket {}) = pemFromPacket Pub p
2184pemFromPacket AutoAccess p@(SecretKeyPacket {}) = pemFromPacket Sec p
2185pemFromPacket AutoAccess _ = Nothing
2171 2186
2172writeKeyToFile :: 2187writeKeyToFile ::
2173 Bool -> FileType -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)] 2188 Bool -> StreamInfo -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)]
2174writeKeyToFile False PEMFile fname packet = do 2189writeKeyToFile 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
2187writeKeyToFile False DNSPresentation fname packet = do 2202writeKeyToFile 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
diff --git a/kiki.hs b/kiki.hs
index 7c0c4b2..8ee88c6 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -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 ,""]
806documentKeyPairsOption :: Bool -> Bool -> Bool -> [String] 806documentKeyPairsOption :: Bool -> Bool -> Bool -> [String]
807documentKeyPairsOption bExport bImport False = [] 807documentKeyPairsOption bExport bImport bSecret =
808documentKeyPairsOption 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
1042sync :: Bool -> Bool -> Bool -> String -> [String] -> IO () 1041sync :: Bool -> Bool -> Bool -> String -> [String] -> IO ()
1043sync bExport bImport bSecret cmdarg args_raw = do 1042sync 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