diff options
-rw-r--r-- | cokiki.hs | 11 | ||||
-rw-r--r-- | kiki.hs | 15 | ||||
-rw-r--r-- | lib/Kiki.hs | 10 |
3 files changed, 22 insertions, 14 deletions
@@ -29,15 +29,6 @@ usage = unlines | |||
29 | , " strongswan: TODO" | 29 | , " strongswan: TODO" |
30 | ] | 30 | ] |
31 | 31 | ||
32 | ㄧchroot :: Args (FilePath -> FilePath) | ||
33 | ㄧchroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id | ||
34 | where | ||
35 | slash :: String -> String -> String | ||
36 | slash "/" ('/':xs) = '/':xs | ||
37 | slash "" ('/':xs) = '/':xs | ||
38 | slash "" xs = '/':xs | ||
39 | slash (y:ys) xs = y:slash ys xs | ||
40 | |||
41 | main = do | 32 | main = do |
42 | (cmd,args) <- splitAt 1 <$> getArgs | 33 | (cmd,args) <- splitAt 1 <$> getArgs |
43 | uid <- getEffectiveUserID | 34 | uid <- getEffectiveUserID |
@@ -45,7 +36,7 @@ main = do | |||
45 | | uid==0 = action | 36 | | uid==0 = action |
46 | | otherwise = hPutStrLn stderr "operation requires root." | 37 | | otherwise = hPutStrLn stderr "operation requires root." |
47 | let sel = case cmd of | 38 | let sel = case cmd of |
48 | ["ssh-client"] -> pure (sshClient uid) <*> ㄧchroot <*> Kiki.ㄧhomedir | 39 | ["ssh-client"] -> pure (sshClient uid) <*> Kiki.ㄧchroot <*> Kiki.ㄧhomedir |
49 | ["ssh-server"] -> pure (whenRoot sshServer) | 40 | ["ssh-server"] -> pure (whenRoot sshServer) |
50 | ["strongswan"] -> pure (whenRoot strongswan) | 41 | ["strongswan"] -> pure (whenRoot strongswan) |
51 | _ -> pure $ hPutStr stderr usage | 42 | _ -> pure $ hPutStr stderr usage |
@@ -1401,7 +1401,7 @@ kiki "merge" args = do | |||
1401 | kiki "init" args | "--help" `elem` args = do | 1401 | kiki "init" args | "--help" `elem` args = do |
1402 | putStr . unlines $ | 1402 | putStr . unlines $ |
1403 | [ "kiki init [ --passphrase-fd=FD" | 1403 | [ "kiki init [ --passphrase-fd=FD" |
1404 | , " | --home[=HOMEDIR]" | 1404 | , " | --homedir[=HOMEDIR]" |
1405 | , " | --chroot=ROOTDIR ] ..." | 1405 | , " | --chroot=ROOTDIR ] ..." |
1406 | , "" | 1406 | , "" |
1407 | , "Initialize a GnuPG keyring for use with kiki. After completion, you" | 1407 | , "Initialize a GnuPG keyring for use with kiki. After completion, you" |
@@ -1417,6 +1417,9 @@ kiki "init" args | "--help" `elem` args = do | |||
1417 | , " --chroot=ROOTDIR" | 1417 | , " --chroot=ROOTDIR" |
1418 | , " Use ROOTDIR for input of ssh keys and export files to" | 1418 | , " Use ROOTDIR for input of ssh keys and export files to" |
1419 | , " ROOTDIR/var/cache/kiki instead of the current system path." | 1419 | , " ROOTDIR/var/cache/kiki instead of the current system path." |
1420 | , " When this option is specified, the GNUPGHOME environment" | ||
1421 | , " variable is ignored and you must use --homedir to specify" | ||
1422 | , " a value other than /root/.gnupg." | ||
1420 | , "" | 1423 | , "" |
1421 | ] ++ documentHomeDir ++ [""] ++ documentPassphraseFDFlag True True True | 1424 | ] ++ documentHomeDir ++ [""] ++ documentPassphraseFDFlag True True True |
1422 | kiki "init" args = do | 1425 | kiki "init" args = do |
@@ -1426,7 +1429,7 @@ kiki "init" args = do | |||
1426 | -} | 1429 | -} |
1427 | let as = lefts $ map splitArg args | 1430 | let as = lefts $ map splitArg args |
1428 | lefts = mapMaybe isLeft where { isLeft (Left x) = Just x; isLeft _ = Nothing } | 1431 | lefts = mapMaybe isLeft where { isLeft (Left x) = Just x; isLeft _ = Nothing } |
1429 | bads = map fst as \\ ["passphrase-fd","home","chroot"] | 1432 | bads = map fst as \\ ["passphrase-fd","homedir","chroot"] |
1430 | if not (null bads) then error ("Bad option: " ++ unwords bads) else do | 1433 | if not (null bads) then error ("Bad option: " ++ unwords bads) else do |
1431 | let rootdir = fmap (fromMaybe "") $ lookup "chroot" as | 1434 | let rootdir = fmap (fromMaybe "") $ lookup "chroot" as |
1432 | let noChrootArg = rootdir == Nothing | 1435 | let noChrootArg = rootdir == Nothing |
@@ -1435,7 +1438,7 @@ kiki "init" args = do | |||
1435 | -- maybe id fchroot rootdir $ do | 1438 | -- maybe id fchroot rootdir $ do |
1436 | args <- return $ map (second $ fromMaybe "") as | 1439 | args <- return $ map (second $ fromMaybe "") as |
1437 | 1440 | ||
1438 | let homespec = mplus ( (++) <$> rootdir <*> lookup "home" args ) | 1441 | let homespec = mplus (slash <$> rootdir <*> lookup "homedir" args ) |
1439 | (fmap (++"/root/.gnupg") rootdir) | 1442 | (fmap (++"/root/.gnupg") rootdir) |
1440 | sshkeygen size = Just $ concat [ "mkdir -p \"$(dirname $file)\" && " | 1443 | sshkeygen size = Just $ concat [ "mkdir -p \"$(dirname $file)\" && " |
1441 | , "ssh-keygen -P \"\" -q -f $file -b " | 1444 | , "ssh-keygen -P \"\" -q -f $file -b " |
@@ -1447,7 +1450,11 @@ kiki "init" args = do | |||
1447 | -- ssl = Just "mkdir -p \"$(dirname $file)\" && openssl genrsa -out $file 1024" | 1450 | -- ssl = Just "mkdir -p \"$(dirname $file)\" && openssl genrsa -out $file 1024" |
1448 | (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec | 1451 | (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec |
1449 | osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root" | 1452 | osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root" |
1450 | -- putStrLn $ "home = " ++ show (home,secring,pubring,mbwk) | 1453 | putStrLn $ "gnupg home = " ++ show (home,secring,pubring,mbwk) |
1454 | putStrLn $ "os home = " ++ show osHomeDir | ||
1455 | -- gnupg home = ("TESTS/tmpgh","TESTS/tmpgh/secring.gpg","TESTS/tmpgh/pubring.gpg",Nothing) | ||
1456 | -- os home = "/root" | ||
1457 | |||
1451 | 1458 | ||
1452 | -- Generate secring.gpg if it does not exist... | 1459 | -- Generate secring.gpg if it does not exist... |
1453 | gotsec <- doesFileExist secring | 1460 | gotsec <- doesFileExist secring |
diff --git a/lib/Kiki.hs b/lib/Kiki.hs index be99ed8..ec34542 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs | |||
@@ -193,3 +193,13 @@ replaceSshServerKeys root cmn = do | |||
193 | "" -> Nothing | 193 | "" -> Nothing |
194 | pth -> Just pth | 194 | pth -> Just pth |
195 | err -> hPutStrLn stderr $ errorString err | 195 | err -> hPutStrLn stderr $ errorString err |
196 | |||
197 | ㄧchroot :: Args (FilePath -> FilePath) | ||
198 | ㄧchroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id | ||
199 | |||
200 | slash :: String -> String -> String | ||
201 | slash "/" ('/':xs) = '/':xs | ||
202 | slash "" ('/':xs) = '/':xs | ||
203 | slash "" xs = '/':xs | ||
204 | slash (y:ys) xs = y:slash ys xs | ||
205 | |||