diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Kiki.hs | 44 |
1 files changed, 24 insertions, 20 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs index 7fc96b3..e624ba6 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs | |||
@@ -333,7 +333,7 @@ importAndRefresh root cmn cipher = do | |||
333 | when (not bUnprivileged) $ refreshCache rt rootdir | 333 | when (not bUnprivileged) $ refreshCache rt rootdir |
334 | 334 | ||
335 | data IpsecPeerConfig = IpsecPeerConfig | 335 | data IpsecPeerConfig = IpsecPeerConfig |
336 | { contactname :: Char8.ByteString | 336 | { contactname :: UidHostname |
337 | , addr :: SockAddr | 337 | , addr :: SockAddr |
338 | , kd :: KeyData | 338 | , kd :: KeyData |
339 | } | 339 | } |
@@ -351,8 +351,8 @@ installIpsecPeerCertificate fw IpsecPeerConfig{..} = | |||
351 | flip (either warn') (pemFromPacket k :: Either String String) $ \pem -> do | 351 | flip (either warn') (pemFromPacket k :: Either String String) $ \pem -> do |
352 | case sshs of | 352 | case sshs of |
353 | (sshkey:_) -> do | 353 | (sshkey:_) -> do |
354 | theirHostname <- sshKeyToHostname sshkey | 354 | theirHostname <- ResolvableHostname <$> sshKeyToHostname sshkey |
355 | write fw (ipsecCertPath theirHostname) pem | 355 | write fw (ipsecCertPath contactname) pem |
356 | return $ strongswanPeerConfiguration addr contactname theirHostname | 356 | return $ strongswanPeerConfiguration addr contactname theirHostname |
357 | _ -> error "fuck." | 357 | _ -> error "fuck." |
358 | where | 358 | where |
@@ -370,13 +370,13 @@ installIpsecPeerCertificate fw IpsecPeerConfig{..} = | |||
370 | sshs = sortOn (Down . timestamp) | 370 | sshs = sortOn (Down . timestamp) |
371 | $ getSubkeys CrossSigned their_master (keySubKeys kd) "ssh-server" | 371 | $ getSubkeys CrossSigned their_master (keySubKeys kd) "ssh-server" |
372 | 372 | ||
373 | ipsecPath :: String -> Char8.ByteString -> String | 373 | ipsecPath :: String -> UidHostname -> String |
374 | ipsecPath theDirName theBaseName = "ipsec.d/" ++ theDirName ++ "/" ++ Char8.unpack theBaseName ++ ".pem" | 374 | ipsecPath theDirName (UidHostname theBaseName) = "ipsec.d/" ++ theDirName ++ "/" ++ Char8.unpack theBaseName ++ ".pem" |
375 | 375 | ||
376 | ipsecKeyPath :: Char8.ByteString -> FilePath | 376 | ipsecKeyPath :: UidHostname -> FilePath |
377 | ipsecKeyPath = ipsecPath "private" | 377 | ipsecKeyPath = ipsecPath "private" |
378 | 378 | ||
379 | ipsecCertPath :: Char8.ByteString -> FilePath | 379 | ipsecCertPath :: UidHostname -> FilePath |
380 | ipsecCertPath = ipsecPath "certs" | 380 | ipsecCertPath = ipsecPath "certs" |
381 | 381 | ||
382 | makeFileWriter :: (FilePath -> FilePath) -> (IO ()) -> FileWriter | 382 | makeFileWriter :: (FilePath -> FilePath) -> (IO ()) -> FileWriter |
@@ -453,11 +453,6 @@ generateHostsFile fw rt = do | |||
453 | KikiResult _ report <- runKeyRing op | 453 | KikiResult _ report <- runKeyRing op |
454 | outputReport report | 454 | outputReport report |
455 | 455 | ||
456 | names :: KeyRingRuntime -> Maybe Hostnames | ||
457 | names rt = do wk <- rtWorkingKey rt | ||
458 | -- XXX unnecessary signature check | ||
459 | return $ getHostnames (byKeyKey (rtKeyDB rt) Map.! keykey wk) | ||
460 | |||
461 | getssh :: (Char8.ByteString, SockAddr, KeyData) -> Char8.ByteString | 456 | getssh :: (Char8.ByteString, SockAddr, KeyData) -> Char8.ByteString |
462 | getssh (contactname,_addr,kd) = do | 457 | getssh (contactname,_addr,kd) = do |
463 | let their_master = packet $ keyMappedPacket kd | 458 | let their_master = packet $ keyMappedPacket kd |
@@ -468,6 +463,11 @@ getssh (contactname,_addr,kd) = do | |||
468 | taggedblobs = map (\b -> contactname <> " " <> b) blobs | 463 | taggedblobs = map (\b -> contactname <> " " <> b) blobs |
469 | Char8.unlines taggedblobs | 464 | Char8.unlines taggedblobs |
470 | 465 | ||
466 | data IpsecConfig = IpsecConfig { | ||
467 | ourGpgAddress :: SockAddr, | ||
468 | ourSigKey :: (), | ||
469 | peers :: [IpsecPeerConfig] | ||
470 | } | ||
471 | 471 | ||
472 | installIpsecConf :: FileWriter -> SockAddr -> Char8.ByteString -> [IpsecPeerConfig] -> IO () | 472 | installIpsecConf :: FileWriter -> SockAddr -> Char8.ByteString -> [IpsecPeerConfig] -> IO () |
473 | installIpsecConf fw wkaddr certBasename cs = do | 473 | installIpsecConf fw wkaddr certBasename cs = do |
@@ -500,11 +500,12 @@ refreshCache rt rootdir = do | |||
500 | fw <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config") | 500 | fw <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config") |
501 | generateHostsFile fw rt | 501 | generateHostsFile fw rt |
502 | fromMaybe (error "No working key.") $ do | 502 | fromMaybe (error "No working key.") $ do |
503 | Hostnames wkaddr onames _ _ <- names rt | 503 | wk <- rtWorkingKey rt |
504 | Hostnames wkaddr onames _ _ <- Just $ getHostnames (byKeyKey (rtKeyDB rt) Map.! keykey wk) | ||
504 | Just $ do | 505 | Just $ do |
505 | let oname = Char8.concat $ take 1 onames | 506 | let oname = UidHostname $ Char8.concat $ take 1 onames |
506 | bUnprivileged = False -- TODO | 507 | |
507 | if (oname == "") && (not bUnprivileged) then error "Missing tor key" else do | 508 | -- if (oname == "") then error "Missing tor key" else do |
508 | -- sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </> "id_rsa.pub" | 509 | -- sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </> "id_rsa.pub" |
509 | -- sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub" | 510 | -- sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub" |
510 | -- contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" | 511 | -- contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" |
@@ -544,7 +545,10 @@ rethrowKikiErrors BadPassphrase = | |||
544 | error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" | 545 | error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" |
545 | rethrowKikiErrors rt = unconditionally $ return rt | 546 | rethrowKikiErrors rt = unconditionally $ return rt |
546 | 547 | ||
547 | writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> String -> Char8.ByteString -> SockAddr -> IO () | 548 | newtype UidHostname = UidHostname Char8.ByteString |
549 | newtype ResolvableHostname = ResolvableHostname Char8.ByteString | ||
550 | |||
551 | writePublicKeyFiles :: KeyRingRuntime -> FileWriter -> String -> UidHostname -> SockAddr -> IO () | ||
548 | writePublicKeyFiles rt fw grip oname wkaddr = do | 552 | writePublicKeyFiles rt fw grip oname wkaddr = do |
549 | 553 | ||
550 | -- Finally, export public keys if they do not exist. | 554 | -- Finally, export public keys if they do not exist. |
@@ -554,7 +558,7 @@ writePublicKeyFiles rt fw grip oname wkaddr = do | |||
554 | 558 | ||
555 | let onionkeys = mapMaybe namedContact $ Map.elems $ byKeyKey $ rtKeyDB rt | 559 | let onionkeys = mapMaybe namedContact $ Map.elems $ byKeyKey $ rtKeyDB rt |
556 | cs = filter (\(_,_,kd) -> notme kd) onionkeys | 560 | cs = filter (\(_,_,kd) -> notme kd) onionkeys |
557 | cs' = cs <&> \(a,b,c) -> IpsecPeerConfig a b c | 561 | cs' = cs <&> \(a,b,c) -> IpsecPeerConfig (UidHostname a) b c |
558 | kk = keykey (fromJust $ rtWorkingKey rt) | 562 | kk = keykey (fromJust $ rtWorkingKey rt) |
559 | notme kd = keykey (keyPacket kd) /= kk | 563 | notme kd = keykey (keyPacket kd) /= kk |
560 | 564 | ||
@@ -580,8 +584,8 @@ sshKeyToHostname sshkey = do | |||
580 | "f=$(mktemp) && cat > \"$f\" && ssh-keygen -r _ -f \"$f\" |" ++ | 584 | "f=$(mktemp) && cat > \"$f\" && ssh-keygen -r _ -f \"$f\" |" ++ |
581 | " (read _ _ _ _ _ hash _ && echo -n $hash.ssh.cryptonomic.net); r=$?; rm -f \"$f\"; exit $r" | 585 | " (read _ _ _ _ _ hash _ && echo -n $hash.ssh.cryptonomic.net); r=$?; rm -f \"$f\"; exit $r" |
582 | 586 | ||
583 | strongswanPeerConfiguration :: SockAddr -> Char8.ByteString -> Char8.ByteString -> Char8.ByteString | 587 | strongswanPeerConfiguration :: SockAddr -> UidHostname -> ResolvableHostname -> Char8.ByteString |
584 | strongswanPeerConfiguration addr oname rightip = Char8.unlines | 588 | strongswanPeerConfiguration addr (UidHostname oname) (ResolvableHostname rightip) = Char8.unlines |
585 | [ "conn " <> oname | 589 | [ "conn " <> oname |
586 | , " right=" <> rightip | 590 | , " right=" <> rightip |
587 | , " rightsubnet=" <> p (showA addr) <> "/128" | 591 | , " rightsubnet=" <> p (showA addr) <> "/128" |