Allow alternative key ciphers.

1 files changed, 38 insertions, 5 deletions

diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 90d1699..f9d4a4e 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -53,6 +53,36 @@ ciphername TripleDES   = "3des"
 ciphername (SymmetricAlgorithm w8) = "cipher-"++show w8
 ciphername c = map toLower $ show c
 
+cipherFromString "clear"       = Unencrypted
+cipherFromString "unencrypted" = Unencrypted
+cipherFromString s             =
+    case filter ( (== s) . ciphername) ciphers of
+        x:_                  -> x
+        -- _ | all isHexDigit s -> unhex s
+        _                    -> error $ "known ciphers: "++unwords (map ciphername ciphers)
+ {-
+ where
+#if defined(VERSION_memory)
+    unhex hx = case convertFromBase Base16 (S8.pack hx) of
+                Left e -> do
+                    -- Useful for debugging but insecure generally ;)
+                    -- putStrLn $ "convertFromBase error for input "++show hx++": "++show e
+                    return Nothing
+                Right bs -> return $ Just $ S8.unpack bs
+#elif defined(VERSION_dataenc)
+    unhex hx = maybe (return () {- putStrLn $ "dataenc error for input "++show hx -})
+                     return
+                     $ fmap (map $ chr . fromIntegral) $ Base16.decode hx
+#endif
+-}
+
+
+ciphers :: [SymmetricAlgorithm]
+ciphers = takeWhile notFallback $ map toEnum $ [0..4]++[7..]
+ where
+    notFallback (SymmetricAlgorithm _) = False
+    notFallback _                      = True
+
 -- |
 -- Regenerate /var/cache/kiki
 refresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO ()
@@ -111,8 +141,8 @@ outputReport report = do
     forM_ report $ \(fname,act) -> do
         putStrLn $ fname ++ ": " ++ reportString act
 
-importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO ()
-importAndRefresh root cmn = do
+importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> SymmetricAlgorithm -> IO ()
+importAndRefresh root cmn cipher = do
     let rootdir = do guard (root "x" /= "x")
                      Just $ root ""
 
@@ -163,7 +193,7 @@ importAndRefresh root cmn = do
         do rs <- writeKeyToFile (streaminfo { typ = PEMFile, access = Sec, spill = KF_Match "tor", fill = KF_All }) (FileDesc write_tor) tor_un
            -- outputReport $ map (first show) rs
            return ()
-        let default_cipher = (CAST5 {- AES128 -}, IteratedSaltedS2K SHA1 4073382889203176146 7864320)
+        let cipher's2k = (cipher {- AES128 -}, IteratedSaltedS2K SHA1 4073382889203176146 7864320)
             ctx = InputFileContext secring pubring
             main_passwds = withAgent $ do pfd <- maybeToList passfd
                                           return $ PassphraseSpec Nothing Nothing pfd
@@ -180,7 +210,7 @@ importAndRefresh root cmn = do
                                                      Nothing
                                     }
         transcoder <- makeMemoizingDecrypter passwordop ctx (Just master_un, uidentry)
-        master0 <- transcoder default_cipher master_un
+        master0 <- transcoder cipher's2k master_un
         case master0 of
             KikiSuccess master -> do
                 mkdirFor secring
@@ -563,8 +593,11 @@ slash (y:ys) xs       = y:slash ys xs
                 <$> optional (arg "--homedir")
                 <*> optional (FileDesc <$> read <$> arg "--passphrase-fd")
 
+ㄧcipher :: Args SymmetricAlgorithm
+ㄧcipher = fromMaybe CAST5 <$> optional (cipherFromString <$> arg "--cipher")
+
 kikiOptions :: ( [(String,Int)], [String] )
 kikiOptions = ( ss, ps )
  where
-    ss = [("--chroot",1),("--passphrase-fd",1),("--homedir",1)]
+    ss = [("--chroot",1),("--passphrase-fd",1),("--homedir",1),("--cipher",1)]
     ps = []