diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 135 |
1 files changed, 3 insertions, 132 deletions
@@ -1417,142 +1417,13 @@ 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" | 1420 | , " When this option is specified, the GNUPGHOME environment" |
1421 | , " variable is ignored and you must use --homedir to specify" | 1421 | , " variable is ignored and you must use --homedir to specify" |
1422 | , " a value other than /root/.gnupg." | 1422 | , " a value other than /root/.gnupg." |
1423 | , "" | 1423 | , "" |
1424 | ] ++ documentHomeDir ++ [""] ++ documentPassphraseFDFlag True True True | 1424 | ] ++ documentHomeDir ++ [""] ++ documentPassphraseFDFlag True True True |
1425 | kiki "init" args = do | ||
1426 | me <- getEffectiveUserID | ||
1427 | {- | ||
1428 | if me/=0 then error "This command requires root." else do | ||
1429 | -} | ||
1430 | let as = lefts $ map splitArg args | ||
1431 | lefts = mapMaybe isLeft where { isLeft (Left x) = Just x; isLeft _ = Nothing } | ||
1432 | bads = map fst as \\ ["passphrase-fd","homedir","chroot"] | ||
1433 | if not (null bads) then error ("Bad option: " ++ unwords bads) else do | ||
1434 | let rootdir = fmap (fromMaybe "") $ lookup "chroot" as | ||
1435 | let noChrootArg = rootdir == Nothing | ||
1436 | bUnprivileged = (me/=0) && noChrootArg | ||
1437 | if rootdir==Just "" then error "--chroot requires an argument" else do | ||
1438 | -- maybe id fchroot rootdir $ do | ||
1439 | args <- return $ map (second $ fromMaybe "") as | ||
1440 | |||
1441 | let homespec = mplus (slash <$> rootdir <*> lookup "homedir" args ) | ||
1442 | (fmap (++"/root/.gnupg") rootdir) | ||
1443 | sshkeygen size = Just $ concat [ "mkdir -p \"$(dirname $file)\" && " | ||
1444 | , "ssh-keygen -P \"\" -q -f $file -b " | ||
1445 | , show size ] | ||
1446 | mkdirFor path = do | ||
1447 | let dir = takeDirectory path | ||
1448 | -- putStrLn $ "mkdirFor " ++ show dir | ||
1449 | createDirectoryIfMissing True dir | ||
1450 | -- ssl = Just "mkdir -p \"$(dirname $file)\" && openssl genrsa -out $file 1024" | ||
1451 | (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec | ||
1452 | osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root" | ||
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 | |||
1458 | |||
1459 | -- Generate secring.gpg if it does not exist... | ||
1460 | gotsec <- doesFileExist secring | ||
1461 | when (not gotsec) $ do | ||
1462 | {- ssh-keygen to create master key... | ||
1463 | let mkpath = home ++ "/master-key" | ||
1464 | mkdirFor mkpath | ||
1465 | e <- systemEnv [ ("file",mkpath) ] (fromJust $ sshkeygen 4096) | ||
1466 | case e of | ||
1467 | ExitFailure num -> error "ssh-keygen failed to create master key" | ||
1468 | ExitSuccess -> return () | ||
1469 | [PEMPacket mk] <- readSecretPEMFile (ArgFile mkpath) | ||
1470 | writeInputFileL (InputFileContext secring pubring) | ||
1471 | HomeSec | ||
1472 | ( encode $ Message [mk { is_subkey = False }] ) | ||
1473 | -} | ||
1474 | master <- (\k -> k { is_subkey = False }) <$> generateKey (GenRSA $ 4096 `div` 8 ) | ||
1475 | mkdirFor secring | ||
1476 | writeInputFileL (InputFileContext secring pubring) | ||
1477 | HomeSec | ||
1478 | $ encode $ Message [master { is_subkey = False}] | ||
1479 | |||
1480 | gotpub <- doesFileExist pubring | ||
1481 | when (not gotpub) $ do | ||
1482 | mkdirFor pubring | ||
1483 | writeInputFileL (InputFileContext secring pubring) | ||
1484 | HomePub | ||
1485 | ( encode $ Message [] ) | ||
1486 | |||
1487 | -- Old paths.. | ||
1488 | -- | ||
1489 | -- Private | ||
1490 | -- pem tor /var/lib/tor/samizdat/private_key | ||
1491 | -- pem ssh-client %(home)/.ssh/id_rsa | ||
1492 | -- pem ssh-server /etc/ssh/ssh_host_rsa_key | ||
1493 | -- pem ipsec /etc/ipsec.d/private/%(onion).pem | ||
1494 | |||
1495 | -- Public | ||
1496 | -- ssh-client %(home)/.ssh/id_rsa.pub | ||
1497 | -- ssh-server /etc/ssh/ssh_host_rsa_key.pub | ||
1498 | -- ipsec /etc/ipsec.d/certs/%(onion).pem | ||
1499 | |||
1500 | -- First, we ensure that the tor key exists and is imported | ||
1501 | -- so that we know where to put the strongswan key. | ||
1502 | let passfd = fmap (FileDesc . read) $ lookup "passphrase-fd" args | ||
1503 | strm = StreamInfo { typ = KeyRingFile | ||
1504 | , fill = KF_None | ||
1505 | , spill = KF_All | ||
1506 | , access = AutoAccess | ||
1507 | , initializer = NoCreate | ||
1508 | , transforms = [] } | ||
1509 | buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp | ||
1510 | , fill = rtyp | ||
1511 | , spill = KF_All | ||
1512 | , access = AutoAccess | ||
1513 | , initializer = NoCreate | ||
1514 | , transforms = [] } | ||
1515 | peminfo bits usage = | ||
1516 | StreamInfo { typ = PEMFile | ||
1517 | , fill = KF_None -- KF_Match usage | ||
1518 | , spill = KF_Match usage | ||
1519 | , access = Sec | ||
1520 | , initializer = Internal (GenRSA $ bits `div` 8) | ||
1521 | , transforms = [] | ||
1522 | } | ||
1523 | sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa" | ||
1524 | sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key" | ||
1525 | op = KeyRingOperation | ||
1526 | { opFiles = Map.fromList $ | ||
1527 | [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) | ||
1528 | , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) | ||
1529 | , ( Generate 0 (GenRSA (1024 `div` 8)), strm { spill = KF_Match "tor" }) | ||
1530 | , ( Generate 1 (GenRSA (1024 `div` 8)), strm { spill = KF_Match "ipsec" }) | ||
1531 | , ( ArgFile sshcpath, (peminfo 2048 "ssh-client") ) | ||
1532 | , ( ArgFile sshspath, (peminfo 2048 "ssh-server") ) | ||
1533 | ] | ||
1534 | , opPassphrases = do pfd <- maybeToList passfd | ||
1535 | return $ PassphraseSpec Nothing Nothing pfd | ||
1536 | , opHome = homespec | ||
1537 | , opTransforms = [] | ||
1538 | } | ||
1539 | -- doNothing = return () | ||
1540 | nop = KeyRingOperation | ||
1541 | { opFiles = Map.empty | ||
1542 | , opPassphrases = do pfd <- maybeToList passfd | ||
1543 | return $ PassphraseSpec Nothing Nothing pfd | ||
1544 | , opHome=homespec, opTransforms = [] | ||
1545 | } | ||
1546 | -- if bUnprivileged then doNothing else mkdirFor torpath | ||
1547 | KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op) | ||
1548 | forM_ report $ \(fname,act) -> do | ||
1549 | putStrLn $ fname ++ ": " ++ reportString act | ||
1550 | rt <- case rt of | ||
1551 | BadPassphrase -> | ||
1552 | error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" | ||
1553 | _ -> unconditionally $ return rt | ||
1554 | 1425 | ||
1555 | when (not bUnprivileged) $ refreshCache rt rootdir | 1426 | kiki "init" args = run args $ importAndRefresh <$> ㄧchroot <*> ㄧhomedir |
1556 | 1427 | ||
1557 | kiki "delete" args | "--help" `elem` args = do | 1428 | kiki "delete" args | "--help" `elem` args = do |
1558 | putStr . unlines $ | 1429 | putStr . unlines $ |