summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs135
1 files changed, 3 insertions, 132 deletions
diff --git a/kiki.hs b/kiki.hs
index f239410..3f1843f 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -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
1425kiki "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 1426kiki "init" args = run args $ importAndRefresh <$> ㄧchroot <*> ㄧhomedir
1556 1427
1557kiki "delete" args | "--help" `elem` args = do 1428kiki "delete" args | "--help" `elem` args = do
1558 putStr . unlines $ 1429 putStr . unlines $