{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Kiki where import Control.Applicative import Control.Arrow import Control.Concurrent import Control.Exception import Control.Monad import Data.ASN1.BinaryEncoding import Data.ASN1.Encoding import Data.ASN1.Types import Data.Binary import Data.Bool import Data.Char import Data.List import Data.Maybe import Data.Monoid import Data.OpenPGP import Data.OpenPGP.Util import Data.Ord import qualified Data.Traversable as T (mapM) import System.Directory import System.FilePath.Posix as FilePath import System.IO import System.IO.Error import System.IO.Temp import System.Posix.Files import System.Posix.IO as Posix (createPipe) import System.Posix.User import System.Process #if defined(VERSION_memory) import Data.ByteArray.Encoding import qualified Data.ByteString.Char8 as S8 #elif defined(VERSION_dataenc) import qualified Codec.Binary.Base64 as Base64 #endif import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as Char8 import qualified Data.Map.Strict as Map import Network.Socket import ProcessUtils import qualified SSHKey as SSH import CommandLine import DotLock import GnuPGAgent (Query (..)) import KeyRing hiding (pemFromPacket) withAgent :: [PassphraseSpec] -> [PassphraseSpec] withAgent [] = [PassphraseAgent] withAgent ps = ps ciphername Unencrypted = "-" 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 () refresh root homepass = do let homepass' = homepass { cap_homespec = fmap root (cap_homespec homepass) } KikiResult r report <- runKeyRing $ minimalOp homepass' let mroot = case root "" of "/" -> Nothing "" -> Nothing pth -> Just pth case r of KikiSuccess rt -> refreshCache rt mroot _ -> return () -- XXX: silent fail? data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile } streaminfo :: StreamInfo streaminfo = StreamInfo { fill = KF_None , spill = KF_None , typ = KeyRingFile , initializer = NoCreate , access = AutoAccess , transforms = [] } minimalOp :: CommonArgsParsed -> KeyRingOperation minimalOp cap = op where streaminfo = StreamInfo { fill = KF_None , typ = KeyRingFile , spill = KF_All , initializer = NoCreate , access = AutoAccess , transforms = [] } op = KeyRingOperation { opFiles = Map.fromList $ [ ( HomeSec, streaminfo { access = Sec }) , ( HomePub, streaminfo { access = Pub }) ] , opPassphrases = withAgent $ do pfile <- maybeToList (cap_passfd cap) return $ PassphraseSpec Nothing Nothing pfile , opTransforms = [] , opHome = cap_homespec cap } run :: [String] -> Args (IO ()) -> IO () run args x = case runArgs (parseInvocation (uncurry fancy kikiOptions "") args) x of Left e -> hPutStrLn stderr $ usageErrorMessage e Right io -> io outputReport :: [(FilePath, KikiReportAction)] -> IO () outputReport report = do forM_ report $ \(fname,act) -> do putStrLn $ fname ++ ": " ++ reportString act importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> SymmetricAlgorithm -> IO () importAndRefresh root cmn cipher = do let rootdir = do guard (root "x" /= "x") Just $ root "" me <- getEffectiveUserID let noChrootArg = rootdir == Nothing bUnprivileged = (me/=0) && noChrootArg bool id (error "--chroot requires an argument") (rootdir==Just "") $ do let homespec = mplus (slash <$> rootdir <*> cap_homespec cmn) (fmap (++"/root/.gnupg") rootdir) sshkeygen size = Just $ concat [ "mkdir -p \"$(dirname $file)\" && " , "ssh-keygen -P \"\" -q -f $file -b " , show size ] mkdirFor path = do let dir = takeDirectory path -- putStrLn $ "mkdirFor " ++ show dir createDirectoryIfMissing True dir -- ssl = Just "mkdir -p \"$(dirname $file)\" && openssl genrsa -out $file 1024" (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root" old_umask <- setFileCreationMask(0o077); -- Generate secring.gpg if it does not exist... gotsec <- doesFileExist secring let passfd = cap_passfd cmn (torgen,pwds) <- bool id (const $ return (Generate 0 $ GenRSA $ 1024 `div` 8, [])) gotsec $ do {- ssh-keygen to create master key... let mkpath = home ++ "/master-key" mkdirFor mkpath e <- systemEnv [ ("file",mkpath) ] (fromJust $ sshkeygen 4096) case e of ExitFailure num -> error "ssh-keygen failed to create master key" ExitSuccess -> return () [PEMPacket mk] <- readSecretPEMFile (ArgFile mkpath) writeInputFileL (InputFileContext secring pubring) HomeSec ( encode $ Message [mk { is_subkey = False }] ) -} master_un <- (\k -> MappedPacket (k { is_subkey = False }) Map.empty) <$> generateKey (GenRSA $ 4096 `div` 8 ) tor_un <- generateKey (GenRSA $ 1024 `div` 8 ) (read_tor,write_tor) <- Posix.createPipe 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 () cipher's2k <- do IteratedSaltedS2K _ salt _ <- randomS2K SHA1 -- (cipher {- AES128 -}, IteratedSaltedS2K SHA1 4073382889203176146 7864320) return $ (cipher {- AES128 -}, IteratedSaltedS2K SHA1 salt (15 * 2^19)) let ctx = InputFileContext secring pubring main_passwds = withAgent $ do pfd <- maybeToList passfd return $ PassphraseSpec Nothing Nothing pfd passwordop = KeyRingOperation { opFiles = Map.empty , opPassphrases = main_passwds , opHome = homespec , opTransforms = [] } let uidentry = Map.singleton (keykey $ packet master_un) $ master_un { packet = Query (packet master_un) (torUIDFromKey tor_un) Nothing } transcoder <- makeMemoizingDecrypter passwordop ctx (Just master_un, uidentry) master0 <- transcoder cipher's2k master_un case master0 of KikiSuccess master -> do mkdirFor secring writeInputFileL ctx HomeSec $ encode $ Message [master] putStrLn "Wrote master key" return (FileDesc read_tor, [PassphraseMemoizer transcoder]) er -> do hPutStrLn stderr ("warning: " ++ errorString er) hPutStrLn stderr "warning: keys will not be encrypted."; mkdirFor secring writeInputFileL ctx HomeSec $ encode $ Message [packet master_un] putStrLn "Wrote master key" return (Generate 0 (GenRSA $ 1024 `div` 8 ), []) gotpub <- doesFileExist pubring when (not gotpub) $ do mkdirFor pubring writeInputFileL (InputFileContext secring pubring) HomePub ( encode $ Message [] ) setFileCreationMask(old_umask); -- Old paths.. -- -- Private -- pem tor /var/lib/tor/samizdat/private_key -- pem ssh-client %(home)/.ssh/id_rsa -- pem ssh-server /etc/ssh/ssh_host_rsa_key -- pem ipsec /etc/ipsec.d/private/%(onion).pem -- Public -- ssh-client %(home)/.ssh/id_rsa.pub -- ssh-server /etc/ssh/ssh_host_rsa_key.pub -- ipsec /etc/ipsec.d/certs/%(onion).pem -- First, we ensure that the tor key exists and is imported -- so that we know where to put the strongswan key. let strm = StreamInfo { typ = KeyRingFile , fill = KF_None , spill = KF_All , access = AutoAccess , initializer = NoCreate , transforms = [] } buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp , fill = rtyp , spill = KF_All , access = AutoAccess , initializer = NoCreate , transforms = [] } peminfo bits usage = StreamInfo { typ = PEMFile , fill = KF_None -- KF_Match usage , spill = KF_Match usage , access = Sec , initializer = Internal (GenRSA $ bits `div` 8) , transforms = [] } sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa" sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key" op = KeyRingOperation { opFiles = Map.fromList $ [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) , ( torgen , case torgen of FileDesc _ -> StreamInfo { typ = PEMFile , fill = KF_Match "tor" , spill = KF_Match "tor" , access = Sec , initializer = NoCreate , transforms = [] } _ -> strm { spill = KF_Match "tor" }) , ( Generate 1 (GenRSA (2048 `div` 8)), strm { spill = KF_Match "ipsec" }) , ( ArgFile sshcpath, (peminfo 2048 "ssh-client") ) , ( ArgFile sshspath, (peminfo 2048 "ssh-server") ) , ( Generate 2 (GenRSA (4096 `div` 8)), strm { spill = KF_Match "encrypt" }) , ( Generate 3 (GenRSA (4096 `div` 8)), strm { spill = KF_Match "sign" }) ] , opPassphrases = withAgent $ pwds ++ do pfd <- maybeToList passfd return $ PassphraseSpec Nothing Nothing pfd , opHome = homespec , opTransforms = [] } -- doNothing = return () nop = KeyRingOperation { opFiles = Map.empty , opPassphrases = withAgent $ do pfd <- maybeToList passfd return $ PassphraseSpec Nothing Nothing pfd , opHome=homespec, opTransforms = [] } -- if bUnprivileged then doNothing else mkdirFor torpath KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op) outputReport report rt <- case rt of BadPassphrase -> error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" _ -> unconditionally $ return rt when (not bUnprivileged) $ refreshCache rt rootdir refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () refreshCache rt rootdir = do let getMkPathAndCommit destdir = do let cachedir = takeDirectory destdir unslash ('/':xs) = xs unslash xs = xs timeout = -1 -- TODO: set milisecond timeout on dotlock createDirectoryIfMissing True cachedir tmpdir <- createTempDirectory cachedir (takeBaseName destdir ++ ".") createSymbolicLink (makeRelative cachedir tmpdir) (tmpdir ++ ".link") lock <- dotlock_create destdir 0 T.mapM (flip dotlock_take timeout) lock let mkpath pth = tmpdir unslash (makeRelative destdir pth) commit = do oldcommit <- (Just <$> readSymbolicLink destdir) `catch` \e -> do when (not $ isDoesNotExistError e) $ warn (show e) return Nothing -- Note: Files not written to are considered deleted, -- otherwise call readyReadBeforeWrite on them. rename (tmpdir ++ ".link") destdir er <- T.mapM dotlock_release lock void $ T.mapM removeDirectoryRecursive (FilePath.combine cachedir <$> oldcommit) -- Present transaction is Write only (or Write-Before-Read) which is fine. -- If ever Read-Before-Write is required, uncomment and use: -- let readyReadBeforeWrite pth = do -- let copyIt = do -- createDirectoryIfMissing True (takeDirectory (mkpath pth)) -- copyFile (destdir unslash (makeRelative destdir pth) (mkpath pth) -- doesFileExist (mkpath pth) >>= flip when copyIt -- return (mkpath pth) return (mkpath, commit {-, readyReadBeforeWrite -}) (mkpath, commit) <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config") -- Generete hosts file. let hostspath = mkpath "hosts" op = KeyRingOperation { opFiles = Map.fromList $ [ ( HomePub, streaminfo { typ=KeyRingFile, spill=KF_All, access=Pub } ) , ( ArgFile hostspath, streaminfo { typ=Hosts, spill=KF_None, fill=KF_All, access=Pub } ) ] , opPassphrases = [] , opHome = Just $ takeDirectory (rtPubring rt) , opTransforms = [] } KikiResult _ report <- runKeyRing op outputReport report let write' wr f bs = do createDirectoryIfMissing True $ takeDirectory f wr f bs write = write' writeFile writeL = write' L.writeFile writeL077 f bs = do old_umask <- setFileCreationMask 0o077 writeL f bs setFileCreationMask old_umask let names = do wk <- rtWorkingKey rt -- XXX unnecessary signature check return $ getHostnames (rtKeyDB rt Map.! keykey wk) bUnprivileged = False -- TODO oname = Char8.concat $ do (_,(os,_)) <- maybeToList names take 1 os fromMaybe (error "No working key.") $ do (wkaddr,_) <- names Just $ do if (oname == "") && (not bUnprivileged) then error "Missing tor key" else do -- sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir ".ssh" "id_rsa.pub" -- sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub" -- contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" flip (maybe $ warn "missing working key?") (rtWorkingKey rt) $ \wk -> do let grip = fingerprint wk wkkd = rtKeyDB rt Map.! keykey wk getSecret tag = sortOn (Down . timestamp) $ getSubkeys Unsigned wk (keySubKeys wkkd) tag exportOp = withOutgoing $ minimalOp (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt) Nothing) where withOutgoing op = op { opFiles = opFiles op `Map.union` Map.fromList outgoing_secrets , opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] } outgoing_secrets = [ send "ipsec" (mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem") "missing ipsec key?" , send "ssh-client" (mkpath "root/.ssh/id_rsa") "missing ssh-client key?" , send "ssh-server" (mkpath "ssh_host_rsa_key") "missing ssh host key?" , send "tor" (mkpath "tor/private_key") "missing tor key?" ] send usage path warning = ( ArgFile path, StreamInfo { typ = PEMFile , fill = KF_Match usage , spill = KF_None , access = Sec , initializer = WarnMissing warning , transforms = [] }) KikiResult rt' report <- runKeyRing exportOp outputReport report -- outputReport $ map (first $ resolveForReport ctx) $ filter ((/=ExportedSubkey) . snd) report rt <- case rt' of BadPassphrase -> error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" _ -> unconditionally $ return rt' {- let writeSecret tag path warning = do let my_ks :: [Packet] my_ks = getSecret tag case my_ks of se0:_ -> do sc1 <- rtPassphrases rt (Unencrypted,S2K 100 "") $ MappedPacket se0 Map.empty let sec = case sc1 of KikiSuccess s -> s _ -> se0 report <- writeKeyToFile streaminfo { typ = PEMFile , access = Sec , spill = KF_All } (ArgFile path) sec let ctx = Just $ InputFileContext "secring.gpg" "pubring.gpg" outputReport $ map (first $ resolveForReport ctx) $ filter ((/=ExportedSubkey) . snd) report _ -> warn warning writeSecret "ipsec" (mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem") "missing ipsec key?" -- TODO: probably we should add multiple entries for the case that there -- are multiple secret master-keys each with distinct tor and ipsec keys. writeL077 (mkpath "ipsec.secrets") $ ": RSA /var/cache/kiki/config/ipsec.d/private/" <> oname <> ".pem" writeSecret "ssh-client" (mkpath "root/.ssh/id_rsa") "missing ssh-client key?" writeSecret "ssh-server" (mkpath "ssh_host_rsa_key") "missing ssh host key?" writeSecret "tor" (mkpath "tor/private_key") "missing tor key?" -} -- Finally, export public keys if they do not exist. either warn (write $ mkpath "root/.ssh/id_rsa.pub") $ show_ssh' "ssh-client" grip (rtKeyDB rt) either warn (write $ mkpath "ssh_host_rsa_key.pub") $ show_ssh' "ssh-server" grip (rtKeyDB rt) either warn (write $ mkpath "ipsec.d/certs/" ++ Char8.unpack oname++".pem") $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket let onionkeys = mapMaybe namedContact $ Map.elems $ rtKeyDB rt cs = filter (\(_,_,kd) -> notme kd) onionkeys kk = keykey (fromJust $ rtWorkingKey rt) notme kd = keykey (keyPacket kd) /= kk namedContact kd = do -- The getHostnames command requires a valid cross-signed tor key -- for each onion name returned in (_,(ns,_)). let (addr,(ns,_)) = getHostnames kd fmap (\n -> (n,addr, kd)) $ listToMaybe ns -- only first onion name. installConctact :: (L.ByteString, SockAddr, KeyData) -> IO Char8.ByteString installConctact (contactname,addr,kd) = do let cpath = interp (Map.singleton "onion" (Char8.unpack contactname)) "ipsec.d/certs/%(onion).pem" their_master = packet $ keyMappedPacket kd -- We find all cross-certified ipsec keys for the given cross-certified onion name. ipsecs :: [Packet] ipsecs = sortOn (Down . timestamp) $ getSubkeys CrossSigned their_master (keySubKeys kd) "ipsec" -- ++ getSubkeys CrossSigned their_master (keySubKeys kd) "strongswan" sshs :: [Packet] sshs = sortOn (Down . timestamp) $ getSubkeys CrossSigned their_master (keySubKeys kd) "ssh-server" bss <- forM (take 1 ipsecs) $ \k -> do let warn' x = warn x >> return Char8.empty flip (either warn') (pemFromPacket k :: Either String String) $ \pem -> do write (mkpath cpath) pem case take 1 sshs of [sshkey] -> do (_,(sout,serr)) <- runExternal "(f=$(mktemp); cat > \"$f\"; ssh-keygen -l -f \"$f\" | (read _ hash _; echo -n $hash.ssh.cryptonomic.net) | tr -d ':')" (Just $ sshblobFromPacket sshkey) -- ssh-keygen -l -f /dev/stdin -- putStrLn $ "wtf="++show(sout,serr, sshblobFromPacket sshkey) return $ strongswanForContact addr contactname (Char8.fromChunks [sout]) [] -> error "fuck." return $ Char8.concat bss known_hosts = L.concat $ map getssh onionkeys getssh (contactname,addr,kd) = do let their_master = packet $ keyMappedPacket kd sshs :: [Packet] sshs = sortOn (Down . timestamp) $ getSubkeys CrossSigned their_master (keySubKeys kd) "ssh-server" blobs = mapMaybe sshblobFromPacketL sshs taggedblobs = map (\b -> contactname <> " " <> b) blobs Char8.unlines taggedblobs writeL (mkpath "ssh_known_hosts") known_hosts cons <- mapM installConctact cs writeL (mkpath "ipsec.conf") . Char8.unlines $ [ "conn %default" , " ikelifetime=60m" , " keylife=20m" , " rekeymargin=3m" , " keyingtries=%forever" , " keyexchange=ikev2" , " dpddelay=10s" , " dpdaction=restart" , " left=%defaultroute" , " leftsubnet=" <> Char8.pack (showA wkaddr) <> "/128" , " leftauth=pubkey" , " leftid=" <> Char8.pack (showA wkaddr) , " leftrsasigkey=" <> oname <> ".pem" , " leftikeport=4500" , " rightikeport=4500" , " right=%any" , " rightauth=pubkey" , " type=tunnel" , " auto=route" , "" ] ++ filter (not . Char8.null) cons commit strongswanForContact addr oname rightip = Char8.unlines [ "conn " <> oname , " right=lan." <> rightip , " rightsubnet=" <> p (showA addr) <> "/128" , " rightauth=pubkey" , " rightid=" <> p (showA addr) , " rightrsasigkey=" <> oname <> ".pem" ] where p = Char8.pack -- conn hiotuxliwisbp6mi.onion -- right=%hiotuxliwisbp6mi.onion.ipv4 -- rightsubnet=fdcc:76c8:cb34:74e6:2aa3:cb39:abc8:d403/128 -- rightauth=pubkey -- rightid=fdcc:76c8:cb34:74e6:2aa3:cb39:abc8:d403 -- rightrsasigkey=hiotuxliwisbp6mi.onion.pem showA addr = if null bracket then pre else drop 1 pre where (pre,bracket) = break (==']') (show addr) #if !MIN_VERSION_base(4,8,0) sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) #endif pemFromPacket k = do let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k der = encodeASN1 DER (toASN1 rsa []) #if defined(VERSION_memory) qq = S8.unpack $ convertToBase Base64 (L.toStrict der) #elif defined(VERSION_dataenc) qq = Base64.encode (L.unpack der) #endif return $ writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec) show_pem keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db pemFromPacket show_pem' keyspec wkgrip db keyfmt = do let s = parseSpec wkgrip keyspec flip (maybe . Left $ keyspec ++ ": not found") (selectPublicKey s db) keyfmt warn str = hPutStrLn stderr str show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db show_ssh' keyspec wkgrip db = do let s = parseSpec wkgrip keyspec flip (maybe . Left $ keyspec ++ ": not found") (selectPublicKey s db) $ return . sshblobFromPacket -- | -- interpolate %var patterns in a string. interp vars raw = es >>= interp1 where gs = groupBy (\_ c -> c/='%') raw es = dropWhile null $ gobbleEscapes ("":gs) where gobbleEscapes :: [String] -> [String] gobbleEscapes (a:"%":b:bs) = (a++b) : gobbleEscapes bs gobbleEscapes (g:gs) = g : gobbleEscapes gs gobbleEscapes [] = [] interp1 ('%':'(':str) = fromMaybe "" (Map.lookup key vars) ++ drop 1 rest where (key,rest) = break (==')') str interp1 plain = plain sshblobFromPacket k = Char8.unpack $ fromJust $ sshblobFromPacketL k sshblobFromPacketL k = do RSAKey (MPI n) (MPI e) <- rsaKeyFromPacket k return $ SSH.keyblob (n,e) {- replaceSshServerKeys root cmn = do let homepass' = cmn { cap_homespec = fmap root (cap_homespec cmn) } replaceSSH op = op { opFiles = files } where files = Map.adjust delssh HomeSec $ Map.adjust delssh HomePub $ Map.insert (ArgFile $ root "/etc/ssh/ssh_host_rsa_key") strm $ opFiles op strm = streaminfo { typ = PEMFile, spill = KF_Match "ssh-server", access = Sec } delssh strm = strm { transforms = DeleteSubkeyByUsage "ssh-server" : transforms strm , fill = KF_All } KikiResult r report <- runKeyRing $ minimalOp homepass' case r of KikiSuccess rt -> Kiki.refreshCache rt $ case root "" of "/" -> Nothing "" -> Nothing pth -> Just pth err -> hPutStrLn stderr $ errorString err -} slash :: String -> String -> String slash "/" ('/':xs) = '/':xs slash "" ('/':xs) = '/':xs slash "" xs = '/':xs slash (y:ys) xs = y:slash ys xs dashdashChroot :: Args (FilePath -> FilePath) dashdashChroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id dashdashHomedir :: Args CommonArgsParsed dashdashHomedir = CommonArgsParsed <$> optional (arg "--homedir") <*> optional (FileDesc <$> read <$> arg "--passphrase-fd") dashdashCipher :: Args SymmetricAlgorithm dashdashCipher = fromMaybe CAST5 <$> optional (cipherFromString <$> arg "--cipher") kikiOptions :: ( [(String,Int)], [String] ) kikiOptions = ( ss, ps ) where ss = [("--chroot",1),("--passphrase-fd",1),("--homedir",1),("--cipher",1)] ps = []