diff options
-rw-r--r-- | kiki.hs | 6 | ||||
-rw-r--r-- | lib/Kiki.hs | 43 |
2 files changed, 42 insertions, 7 deletions
@@ -1492,7 +1492,8 @@ kiki "init" args | "--help" `elem` args = do | |||
1492 | putStr . unlines $ | 1492 | putStr . unlines $ |
1493 | [ "kiki init [ --passphrase-fd=FD" | 1493 | [ "kiki init [ --passphrase-fd=FD" |
1494 | , " | --homedir[=HOMEDIR]" | 1494 | , " | --homedir[=HOMEDIR]" |
1495 | , " | --chroot=ROOTDIR ] ..." | 1495 | , " | --chroot=ROOTDIR ]" |
1496 | , " | --cipher="++intercalate "|" (map ciphername ciphers)++" ] ..." | ||
1496 | , "" | 1497 | , "" |
1497 | , "Modify your GnuPG keyring and update /var/cache/kiki. The following" | 1498 | , "Modify your GnuPG keyring and update /var/cache/kiki. The following" |
1498 | , "changes will occur to the keyring:" | 1499 | , "changes will occur to the keyring:" |
@@ -1512,9 +1513,10 @@ kiki "init" args | "--help" `elem` args = do | |||
1512 | , " variable is ignored and you must use --homedir to specify" | 1513 | , " variable is ignored and you must use --homedir to specify" |
1513 | , " a value other than /root/.gnupg." | 1514 | , " a value other than /root/.gnupg." |
1514 | , "" | 1515 | , "" |
1516 | , "" | ||
1515 | ] ++ documentHomeDir ++ [""] ++ documentPassphraseFDFlag True True True | 1517 | ] ++ documentHomeDir ++ [""] ++ documentPassphraseFDFlag True True True |
1516 | 1518 | ||
1517 | kiki "init" args = run args $ importAndRefresh <$> ㄧchroot <*> ㄧhomedir | 1519 | kiki "init" args = run args $ importAndRefresh <$> ㄧchroot <*> ㄧhomedir <*> ㄧcipher |
1518 | 1520 | ||
1519 | kiki "delete" args | "--help" `elem` args = do | 1521 | kiki "delete" args | "--help" `elem` args = do |
1520 | putStr . unlines $ | 1522 | putStr . unlines $ |
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 = [] |