diff options
author | joe <joe@jerkface.net> | 2016-04-25 03:11:42 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2016-04-25 03:11:42 -0400 |
commit | 20131e89870ad889a76d44cb8ffcba3fbe00ecc1 (patch) | |
tree | 057846533904a2d57328facc56cbd9a5728f183b /kiki.hs | |
parent | 12717f251ae0c97b3b732ec0dc9c3aeda77e8016 (diff) |
Changed "init" command to cokiki (/var/cache/kiki) design.
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 184 |
1 files changed, 79 insertions, 105 deletions
@@ -53,7 +53,7 @@ import Control.Arrow (first,second) | |||
53 | import Data.Monoid ( (<>) ) | 53 | import Data.Monoid ( (<>) ) |
54 | import Data.Binary.Put | 54 | import Data.Binary.Put |
55 | 55 | ||
56 | import Data.OpenPGP.Util (verify,fingerprint) | 56 | import Data.OpenPGP.Util (verify,fingerprint,generateKey, GenerateKeyParams(..)) |
57 | import ScanningParser | 57 | import ScanningParser |
58 | import PEM | 58 | import PEM |
59 | import DotLock | 59 | import DotLock |
@@ -1048,7 +1048,7 @@ buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp | |||
1048 | , fill = rtyp | 1048 | , fill = rtyp |
1049 | , spill = KF_All | 1049 | , spill = KF_All |
1050 | , access = AutoAccess | 1050 | , access = AutoAccess |
1051 | , initializer = Nothing | 1051 | , initializer =NoCreate |
1052 | , transforms = [] } | 1052 | , transforms = [] } |
1053 | 1053 | ||
1054 | 1054 | ||
@@ -1105,7 +1105,7 @@ sync bExport bImport bSecret cmdarg args_raw = do | |||
1105 | then DNSPresentation | 1105 | then DNSPresentation |
1106 | else PEMFile | 1106 | else PEMFile |
1107 | , access = if bSecret then Sec else Pub | 1107 | , access = if bSecret then Sec else Pub |
1108 | , initializer = cmd' | 1108 | , initializer = maybe NoCreate External cmd' |
1109 | , transforms = [] | 1109 | , transforms = [] |
1110 | } ) | 1110 | } ) |
1111 | else if isNothing cmd' | 1111 | else if isNothing cmd' |
@@ -1233,7 +1233,7 @@ kiki "show" args = do | |||
1233 | streaminfo = StreamInfo { fill = KF_None | 1233 | streaminfo = StreamInfo { fill = KF_None |
1234 | , typ = KeyRingFile | 1234 | , typ = KeyRingFile |
1235 | , spill = KF_All | 1235 | , spill = KF_All |
1236 | , initializer = Nothing | 1236 | , initializer = NoCreate |
1237 | , access = AutoAccess | 1237 | , access = AutoAccess |
1238 | , transforms = [] | 1238 | , transforms = [] |
1239 | } | 1239 | } |
@@ -1317,7 +1317,7 @@ kiki "merge" args = do | |||
1317 | , typ = KeyRingFile | 1317 | , typ = KeyRingFile |
1318 | , spill = KF_None | 1318 | , spill = KF_None |
1319 | , fill = KF_None | 1319 | , fill = KF_None |
1320 | , initializer = Nothing | 1320 | , initializer = NoCreate |
1321 | , transforms = [] | 1321 | , transforms = [] |
1322 | } | 1322 | } |
1323 | updateFlow fil spil mtch flow = spill' $ fill' $ flow | 1323 | updateFlow fil spil mtch flow = spill' $ fill' $ flow |
@@ -1402,7 +1402,7 @@ kiki "merge" args = do | |||
1402 | Left ("autosign",Just "false")-> doAutosign False flow op | 1402 | Left ("autosign",Just "false")-> doAutosign False flow op |
1403 | Left ("passphrase-fd",Just pass) -> doPassphrase flow op pass | 1403 | Left ("passphrase-fd",Just pass) -> doPassphrase flow op pass |
1404 | Left ("create",Just cmd) -> | 1404 | Left ("create",Just cmd) -> |
1405 | ( flow { initializer = if null cmd then Nothing else Just cmd } | 1405 | ( flow { initializer = if null cmd then NoCreate else External cmd } |
1406 | , op ) | 1406 | , op ) |
1407 | Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile } , op ) | 1407 | Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile } , op ) |
1408 | Left ("type",Just "pem" ) -> ( flow { typ = PEMFile } , op ) | 1408 | Left ("type",Just "pem" ) -> ( flow { typ = PEMFile } , op ) |
@@ -1480,8 +1480,11 @@ kiki "init" args = do | |||
1480 | (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec | 1480 | (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec |
1481 | osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root" | 1481 | osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root" |
1482 | -- putStrLn $ "home = " ++ show (home,secring,pubring,mbwk) | 1482 | -- putStrLn $ "home = " ++ show (home,secring,pubring,mbwk) |
1483 | |||
1484 | -- Generate secring.gpg if it does not exist... | ||
1483 | gotsec <- doesFileExist secring | 1485 | gotsec <- doesFileExist secring |
1484 | when (not gotsec) $ do | 1486 | when (not gotsec) $ do |
1487 | {- ssh-keygen to create master key... | ||
1485 | let mkpath = home ++ "/master-key" | 1488 | let mkpath = home ++ "/master-key" |
1486 | mkdirFor mkpath | 1489 | mkdirFor mkpath |
1487 | e <- systemEnv [ ("file",mkpath) ] (fromJust $ sshkeygen 4096) | 1490 | e <- systemEnv [ ("file",mkpath) ] (fromJust $ sshkeygen 4096) |
@@ -1492,12 +1495,20 @@ kiki "init" args = do | |||
1492 | writeInputFileL (InputFileContext secring pubring) | 1495 | writeInputFileL (InputFileContext secring pubring) |
1493 | HomeSec | 1496 | HomeSec |
1494 | ( encode $ Message [mk { is_subkey = False }] ) | 1497 | ( encode $ Message [mk { is_subkey = False }] ) |
1498 | -} | ||
1499 | master <- generateKey (GenRSA $ 4096 `div` 8 ) | ||
1500 | writeInputFileL (InputFileContext secring pubring) | ||
1501 | HomeSec | ||
1502 | $ encode $ Message [master { is_subkey = False}] | ||
1503 | |||
1495 | gotpub <- doesFileExist pubring | 1504 | gotpub <- doesFileExist pubring |
1496 | when (not gotpub) $ do | 1505 | when (not gotpub) $ do |
1497 | writeInputFileL (InputFileContext secring pubring) | 1506 | writeInputFileL (InputFileContext secring pubring) |
1498 | HomePub | 1507 | HomePub |
1499 | ( encode $ Message [] ) | 1508 | ( encode $ Message [] ) |
1500 | 1509 | ||
1510 | -- Old paths.. | ||
1511 | -- | ||
1501 | -- Private | 1512 | -- Private |
1502 | -- pem tor /var/lib/tor/samizdat/private_key | 1513 | -- pem tor /var/lib/tor/samizdat/private_key |
1503 | -- pem ssh-client %(home)/.ssh/id_rsa | 1514 | -- pem ssh-client %(home)/.ssh/id_rsa |
@@ -1509,18 +1520,6 @@ kiki "init" args = do | |||
1509 | -- ssh-server /etc/ssh/ssh_host_rsa_key.pub | 1520 | -- ssh-server /etc/ssh/ssh_host_rsa_key.pub |
1510 | -- ipsec /etc/ipsec.d/certs/%(onion).pem | 1521 | -- ipsec /etc/ipsec.d/certs/%(onion).pem |
1511 | 1522 | ||
1512 | -- TODO: These should be read from a configuration file. | ||
1513 | -- (use SimpleConfig) | ||
1514 | let torpath = fromMaybe "" rootdir ++ "/var/lib/tor/samizdat/private_key" | ||
1515 | sshcpath0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </>"id_rsa" | ||
1516 | sshspath0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key" | ||
1517 | ipsecpath0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/private/%(onion).pem" | ||
1518 | sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </> "id_rsa.pub" | ||
1519 | sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub" | ||
1520 | ipsecpathpub0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" | ||
1521 | contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" | ||
1522 | |||
1523 | |||
1524 | -- First, we ensure that the tor key exists and is imported | 1523 | -- First, we ensure that the tor key exists and is imported |
1525 | -- so that we know where to put the strongswan key. | 1524 | -- so that we know where to put the strongswan key. |
1526 | let passfd = fmap (FileDesc . read) $ lookup "passphrase-fd" args | 1525 | let passfd = fmap (FileDesc . read) $ lookup "passphrase-fd" args |
@@ -1528,34 +1527,40 @@ kiki "init" args = do | |||
1528 | , fill = rtyp | 1527 | , fill = rtyp |
1529 | , spill = KF_All | 1528 | , spill = KF_All |
1530 | , access = AutoAccess | 1529 | , access = AutoAccess |
1531 | , initializer = Nothing | 1530 | , initializer = NoCreate |
1532 | , transforms = [] } | 1531 | , transforms = [] } |
1533 | peminfo bits usage = | 1532 | peminfo bits usage = |
1534 | StreamInfo { typ = PEMFile | 1533 | StreamInfo { typ = PEMFile |
1535 | , fill = KF_Match usage | 1534 | , fill = KF_Match usage |
1536 | , spill = KF_Match usage | 1535 | , spill = KF_Match usage |
1537 | , access = Sec | 1536 | , access = Sec |
1538 | , initializer = sshkeygen bits | 1537 | , initializer = Internal (GenRSA $ bits `div` 8) |
1539 | , transforms = [] | 1538 | , transforms = [] |
1540 | } | 1539 | } |
1540 | sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa" | ||
1541 | sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key" | ||
1541 | op = KeyRingOperation | 1542 | op = KeyRingOperation |
1542 | { opFiles = Map.fromList $ | 1543 | { opFiles = Map.fromList $ |
1543 | [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) | 1544 | [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) |
1544 | , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) | 1545 | , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) |
1545 | , ( ArgFile torpath, peminfo 1024 "tor" ) ] | 1546 | , ( Generate (GenRSA (1024 `div` 8)), peminfo 1024 "tor" ) |
1547 | , ( Generate (GenRSA (1024 `div` 8)), peminfo 1024 "ipsec" ) | ||
1548 | , ( ArgFile sshcpath, (peminfo 2048 "ssh-client") { fill = KF_None } ) | ||
1549 | , ( ArgFile sshspath, (peminfo 2048 "ssh-server") { fill = KF_None } ) | ||
1550 | ] | ||
1546 | , opPassphrases = do pfd <- maybeToList passfd | 1551 | , opPassphrases = do pfd <- maybeToList passfd |
1547 | return $ PassphraseSpec Nothing Nothing pfd | 1552 | return $ PassphraseSpec Nothing Nothing pfd |
1548 | , opHome = homespec | 1553 | , opHome = homespec |
1549 | , opTransforms = [] | 1554 | , opTransforms = [] |
1550 | } | 1555 | } |
1551 | doNothing = return () | 1556 | -- doNothing = return () |
1552 | nop = KeyRingOperation | 1557 | nop = KeyRingOperation |
1553 | { opFiles = Map.empty | 1558 | { opFiles = Map.empty |
1554 | , opPassphrases = do pfd <- maybeToList passfd | 1559 | , opPassphrases = do pfd <- maybeToList passfd |
1555 | return $ PassphraseSpec Nothing Nothing pfd | 1560 | return $ PassphraseSpec Nothing Nothing pfd |
1556 | , opHome=homespec, opTransforms = [] | 1561 | , opHome=homespec, opTransforms = [] |
1557 | } | 1562 | } |
1558 | if bUnprivileged then doNothing else mkdirFor torpath | 1563 | -- if bUnprivileged then doNothing else mkdirFor torpath |
1559 | KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op) | 1564 | KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op) |
1560 | forM_ report $ \(fname,act) -> do | 1565 | forM_ report $ \(fname,act) -> do |
1561 | putStrLn $ fname ++ ": " ++ reportString act | 1566 | putStrLn $ fname ++ ": " ++ reportString act |
@@ -1564,87 +1569,7 @@ kiki "init" args = do | |||
1564 | error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" | 1569 | error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" |
1565 | _ -> unconditionally $ return rt | 1570 | _ -> unconditionally $ return rt |
1566 | 1571 | ||
1567 | -- Now import, export, or generate the remaining secret keys. | 1572 | when (not bUnprivileged) $ refreshCache rt rootdir |
1568 | let oname' = do wk <- rtWorkingKey rt | ||
1569 | onionNameForContact (keykey wk) (rtKeyDB rt) | ||
1570 | if (oname' == Nothing) && (not bUnprivileged) then error "Missing tor key" else do | ||
1571 | let oname = fromMaybe "" oname' | ||
1572 | let [ sshcpath, sshcpathpub ] = {- map (interp (Map.fromList [("onion",oname)]))-} [ sshcpath0, sshcpathpub0 ] | ||
1573 | [ sshspath , ipsecpath ] = map (interp (Map.fromList [("onion",oname)])) [ sshspath0, ipsecpath0 ] | ||
1574 | [ sshspathpub, ipsecpathpub ] | ||
1575 | = map (interp (Map.fromList [("onion",oname)])) | ||
1576 | [ sshspathpub0, ipsecpathpub0 ] | ||
1577 | let opPriv = op | ||
1578 | { opFiles = Map.fromList $ | ||
1579 | [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) | ||
1580 | , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) | ||
1581 | , ( ArgFile ipsecpath, peminfo 1024 "ipsec" ) | ||
1582 | , ( ArgFile sshcpath, peminfo 2048 "ssh-client" ) | ||
1583 | , ( ArgFile sshspath, peminfo 2048 "ssh-server" ) ] | ||
1584 | , opPassphrases = [ PassphraseMemoizer (rtPassphrases rt) ] | ||
1585 | } | ||
1586 | opUnPriv = op | ||
1587 | { opFiles = Map.fromList $ | ||
1588 | [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) | ||
1589 | , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) | ||
1590 | , ( ArgFile sshcpath, peminfo 2048 "ssh-client" ) | ||
1591 | ] | ||
1592 | , opPassphrases = [ PassphraseMemoizer (rtPassphrases rt) ] | ||
1593 | } | ||
1594 | mapM_ mkdirFor $ [sshcpath,sshcpathpub] ++ if not bUnprivileged then [sshspath,ipsecpath,sshspathpub,ipsecpathpub] else [] | ||
1595 | KikiResult rt report <- runKeyRing (if bUnprivileged then opUnPriv else opPriv) | ||
1596 | forM_ report $ \(fname,act) -> do | ||
1597 | putStrLn $ fname ++ ": " ++ reportString act | ||
1598 | rt <- case rt of | ||
1599 | BadPassphrase -> | ||
1600 | error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" | ||
1601 | _ -> unconditionally $ return rt | ||
1602 | |||
1603 | -- Finally, export public keys if they do not exist. | ||
1604 | let writeFileWARNING fname bs = do | ||
1605 | --TODO | ||
1606 | hPutStrLn stderr $ fname ++ ": DID NOT CHECK TRUST (TODO)" | ||
1607 | writeFile fname bs | ||
1608 | flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do | ||
1609 | gotc <- doesFileExist (sshcpathpub) | ||
1610 | when (not gotc) $ do | ||
1611 | either warn (writeFile sshcpathpub) | ||
1612 | $ show_ssh' "ssh-client" grip (rtKeyDB rt) | ||
1613 | if (not bUnprivileged) | ||
1614 | then do | ||
1615 | goth <- doesFileExist (sshspathpub) | ||
1616 | when (not goth) $ do | ||
1617 | either warn (writeFile $ sshspathpub) | ||
1618 | $ show_ssh' "ssh-host" grip (rtKeyDB rt) | ||
1619 | goti <- doesFileExist (ipsecpathpub) | ||
1620 | when (not goti) $ do | ||
1621 | either warn (writeFile $ ipsecpathpub) | ||
1622 | $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket | ||
1623 | else return () | ||
1624 | |||
1625 | |||
1626 | let cs = filter notme (Map.elems $ rtKeyDB rt) | ||
1627 | kk = keykey (fromJust $ rtWorkingKey rt) | ||
1628 | notme kd = keykey (keyPacket kd) /= kk | ||
1629 | |||
1630 | installConctact kd = do | ||
1631 | -- The getHostnames command requires a valid cross-signed tor key | ||
1632 | -- for each onion name returned in (_,(ns,_)). | ||
1633 | let (_,(ns,_)) = getHostnames kd | ||
1634 | contactname = fmap Char8.unpack $ listToMaybe ns -- only first onion name. | ||
1635 | flip (maybe $ return ()) contactname $ \contactname -> do | ||
1636 | |||
1637 | let cpath = interp (Map.singleton "onion" contactname) contactipsec0 | ||
1638 | their_master = packet $ keyMappedPacket kd | ||
1639 | -- We find all cross-certified ipsec keys for the given cross-certified onion name. | ||
1640 | ipsecs = sortOn (Down . timestamp) | ||
1641 | $ getCrossSignedSubkeys their_master (keySubKeys kd) "ipsec" | ||
1642 | forM_ (take 1 ipsecs) $ \k -> do | ||
1643 | goti <- doesFileExist (cpath) | ||
1644 | when (not goti) $ do | ||
1645 | either warn (writeFile cpath) $ pemFromPacket k | ||
1646 | |||
1647 | mapM_ installConctact cs | ||
1648 | 1573 | ||
1649 | kiki "delete" args | "--help" `elem` args = do | 1574 | kiki "delete" args | "--help" `elem` args = do |
1650 | putStr . unlines $ | 1575 | putStr . unlines $ |
@@ -1721,6 +1646,55 @@ kiki "tar" args = do | |||
1721 | ["-A":_] -> putStrLn "unimplemented." -- import tar file? | 1646 | ["-A":_] -> putStrLn "unimplemented." -- import tar file? |
1722 | _ -> kiki "tar" ["--help"] | 1647 | _ -> kiki "tar" ["--help"] |
1723 | 1648 | ||
1649 | refreshCache rt rootdir = do | ||
1650 | |||
1651 | let mkpath pth = fromMaybe "" rootdir ++ "/var/cache/kiki/"++pth | ||
1652 | |||
1653 | write f bs = do | ||
1654 | createDirectoryIfMissing True $ takeDirectory f | ||
1655 | writeFile f bs | ||
1656 | |||
1657 | let oname' = do wk <- rtWorkingKey rt | ||
1658 | -- XXX unnecessary signature check | ||
1659 | onionNameForContact (keykey wk) (rtKeyDB rt) | ||
1660 | bUnprivileged = False -- TODO | ||
1661 | if (oname' == Nothing) && (not bUnprivileged) then error "Missing tor key" else do | ||
1662 | let oname = fromMaybe "" oname' | ||
1663 | -- sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </> "id_rsa.pub" | ||
1664 | -- sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub" | ||
1665 | -- contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" | ||
1666 | |||
1667 | -- Finally, export public keys if they do not exist. | ||
1668 | flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do | ||
1669 | either warn (write $ mkpath "root/.ssh/id_rsa.pub") | ||
1670 | $ show_ssh' "ssh-client" grip (rtKeyDB rt) | ||
1671 | either warn (write $ mkpath "ssh_host_rsa_key.pub") | ||
1672 | $ show_ssh' "ssh-server" grip (rtKeyDB rt) | ||
1673 | either warn (write $ mkpath "ipsec.d/certs/" ++ oname++".pem") | ||
1674 | $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket | ||
1675 | |||
1676 | let cs = filter notme (Map.elems $ rtKeyDB rt) | ||
1677 | kk = keykey (fromJust $ rtWorkingKey rt) | ||
1678 | notme kd = keykey (keyPacket kd) /= kk | ||
1679 | |||
1680 | installConctact kd = do | ||
1681 | -- The getHostnames command requires a valid cross-signed tor key | ||
1682 | -- for each onion name returned in (_,(ns,_)). | ||
1683 | let (_,(ns,_)) = getHostnames kd | ||
1684 | contactname = fmap Char8.unpack $ listToMaybe ns -- only first onion name. | ||
1685 | flip (maybe $ return ()) contactname $ \contactname -> do | ||
1686 | |||
1687 | let cpath = interp (Map.singleton "onion" contactname) "ipsec.d/certs/%(onion).pem" | ||
1688 | their_master = packet $ keyMappedPacket kd | ||
1689 | -- We find all cross-certified ipsec keys for the given cross-certified onion name. | ||
1690 | ipsecs = sortOn (Down . timestamp) | ||
1691 | $ getCrossSignedSubkeys their_master (keySubKeys kd) "ipsec" | ||
1692 | forM_ (take 1 ipsecs) $ \k -> do | ||
1693 | either warn (write $ mkpath cpath) $ pemFromPacket k | ||
1694 | |||
1695 | mapM_ installConctact cs | ||
1696 | |||
1697 | |||
1724 | tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" | 1698 | tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" |
1725 | where | 1699 | where |
1726 | ipsecs = do | 1700 | ipsecs = do |
@@ -1831,7 +1805,7 @@ minimalOp cap = op | |||
1831 | streaminfo = StreamInfo { fill = KF_None | 1805 | streaminfo = StreamInfo { fill = KF_None |
1832 | , typ = KeyRingFile | 1806 | , typ = KeyRingFile |
1833 | , spill = KF_All | 1807 | , spill = KF_All |
1834 | , initializer = Nothing | 1808 | , initializer = NoCreate |
1835 | , access = AutoAccess | 1809 | , access = AutoAccess |
1836 | , transforms = [] | 1810 | , transforms = [] |
1837 | } | 1811 | } |