diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Kiki.hs | 43 |
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" | |||
53 | ciphername (SymmetricAlgorithm w8) = "cipher-"++show w8 | 53 | ciphername (SymmetricAlgorithm w8) = "cipher-"++show w8 |
54 | ciphername c = map toLower $ show c | 54 | ciphername c = map toLower $ show c |
55 | 55 | ||
56 | cipherFromString "clear" = Unencrypted | ||
57 | cipherFromString "unencrypted" = Unencrypted | ||
58 | cipherFromString s = | ||
59 | case filter ( (== s) . ciphername) ciphers of | ||
60 | x:_ -> x | ||
61 | -- _ | all isHexDigit s -> unhex s | ||
62 | _ -> error $ "known ciphers: "++unwords (map ciphername ciphers) | ||
63 | {- | ||
64 | where | ||
65 | #if defined(VERSION_memory) | ||
66 | unhex hx = case convertFromBase Base16 (S8.pack hx) of | ||
67 | Left e -> do | ||
68 | -- Useful for debugging but insecure generally ;) | ||
69 | -- putStrLn $ "convertFromBase error for input "++show hx++": "++show e | ||
70 | return Nothing | ||
71 | Right bs -> return $ Just $ S8.unpack bs | ||
72 | #elif defined(VERSION_dataenc) | ||
73 | unhex hx = maybe (return () {- putStrLn $ "dataenc error for input "++show hx -}) | ||
74 | return | ||
75 | $ fmap (map $ chr . fromIntegral) $ Base16.decode hx | ||
76 | #endif | ||
77 | -} | ||
78 | |||
79 | |||
80 | ciphers :: [SymmetricAlgorithm] | ||
81 | ciphers = takeWhile notFallback $ map toEnum $ [0..4]++[7..] | ||
82 | where | ||
83 | notFallback (SymmetricAlgorithm _) = False | ||
84 | notFallback _ = True | ||
85 | |||
56 | -- | | 86 | -- | |
57 | -- Regenerate /var/cache/kiki | 87 | -- Regenerate /var/cache/kiki |
58 | refresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO () | 88 | refresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO () |
@@ -111,8 +141,8 @@ outputReport report = do | |||
111 | forM_ report $ \(fname,act) -> do | 141 | forM_ report $ \(fname,act) -> do |
112 | putStrLn $ fname ++ ": " ++ reportString act | 142 | putStrLn $ fname ++ ": " ++ reportString act |
113 | 143 | ||
114 | importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO () | 144 | importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> SymmetricAlgorithm -> IO () |
115 | importAndRefresh root cmn = do | 145 | importAndRefresh root cmn cipher = do |
116 | let rootdir = do guard (root "x" /= "x") | 146 | let rootdir = do guard (root "x" /= "x") |
117 | Just $ root "" | 147 | Just $ root "" |
118 | 148 | ||
@@ -163,7 +193,7 @@ importAndRefresh root cmn = do | |||
163 | do rs <- writeKeyToFile (streaminfo { typ = PEMFile, access = Sec, spill = KF_Match "tor", fill = KF_All }) (FileDesc write_tor) tor_un | 193 | do rs <- writeKeyToFile (streaminfo { typ = PEMFile, access = Sec, spill = KF_Match "tor", fill = KF_All }) (FileDesc write_tor) tor_un |
164 | -- outputReport $ map (first show) rs | 194 | -- outputReport $ map (first show) rs |
165 | return () | 195 | return () |
166 | let default_cipher = (CAST5 {- AES128 -}, IteratedSaltedS2K SHA1 4073382889203176146 7864320) | 196 | let cipher's2k = (cipher {- AES128 -}, IteratedSaltedS2K SHA1 4073382889203176146 7864320) |
167 | ctx = InputFileContext secring pubring | 197 | ctx = InputFileContext secring pubring |
168 | main_passwds = withAgent $ do pfd <- maybeToList passfd | 198 | main_passwds = withAgent $ do pfd <- maybeToList passfd |
169 | return $ PassphraseSpec Nothing Nothing pfd | 199 | return $ PassphraseSpec Nothing Nothing pfd |
@@ -180,7 +210,7 @@ importAndRefresh root cmn = do | |||
180 | Nothing | 210 | Nothing |
181 | } | 211 | } |
182 | transcoder <- makeMemoizingDecrypter passwordop ctx (Just master_un, uidentry) | 212 | transcoder <- makeMemoizingDecrypter passwordop ctx (Just master_un, uidentry) |
183 | master0 <- transcoder default_cipher master_un | 213 | master0 <- transcoder cipher's2k master_un |
184 | case master0 of | 214 | case master0 of |
185 | KikiSuccess master -> do | 215 | KikiSuccess master -> do |
186 | mkdirFor secring | 216 | mkdirFor secring |
@@ -563,8 +593,11 @@ slash (y:ys) xs = y:slash ys xs | |||
563 | <$> optional (arg "--homedir") | 593 | <$> optional (arg "--homedir") |
564 | <*> optional (FileDesc <$> read <$> arg "--passphrase-fd") | 594 | <*> optional (FileDesc <$> read <$> arg "--passphrase-fd") |
565 | 595 | ||
596 | ㄧcipher :: Args SymmetricAlgorithm | ||
597 | ㄧcipher = fromMaybe CAST5 <$> optional (cipherFromString <$> arg "--cipher") | ||
598 | |||
566 | kikiOptions :: ( [(String,Int)], [String] ) | 599 | kikiOptions :: ( [(String,Int)], [String] ) |
567 | kikiOptions = ( ss, ps ) | 600 | kikiOptions = ( ss, ps ) |
568 | where | 601 | where |
569 | ss = [("--chroot",1),("--passphrase-fd",1),("--homedir",1)] | 602 | ss = [("--chroot",1),("--passphrase-fd",1),("--homedir",1),("--cipher",1)] |
570 | ps = [] | 603 | ps = [] |