summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Kiki.hs43
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"
53ciphername (SymmetricAlgorithm w8) = "cipher-"++show w8 53ciphername (SymmetricAlgorithm w8) = "cipher-"++show w8
54ciphername c = map toLower $ show c 54ciphername c = map toLower $ show c
55 55
56cipherFromString "clear" = Unencrypted
57cipherFromString "unencrypted" = Unencrypted
58cipherFromString 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
80ciphers :: [SymmetricAlgorithm]
81ciphers = 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
58refresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO () 88refresh :: (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
114importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO () 144importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> SymmetricAlgorithm -> IO ()
115importAndRefresh root cmn = do 145importAndRefresh 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
566kikiOptions :: ( [(String,Int)], [String] ) 599kikiOptions :: ( [(String,Int)], [String] )
567kikiOptions = ( ss, ps ) 600kikiOptions = ( 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 = []