diff options
-rw-r--r-- | lib/Kiki.hs | 21 |
1 files changed, 12 insertions, 9 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs index dc228bb..8d99499 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs | |||
@@ -30,6 +30,7 @@ import qualified Data.ByteString.Lazy as L | |||
30 | import qualified Data.ByteString.Lazy.Char8 as Char8 | 30 | import qualified Data.ByteString.Lazy.Char8 as Char8 |
31 | import qualified Data.Map.Strict as Map | 31 | import qualified Data.Map.Strict as Map |
32 | import qualified SSHKey as SSH | 32 | import qualified SSHKey as SSH |
33 | import Network.Socket -- (SockAddr) | ||
33 | 34 | ||
34 | import CommandLine | 35 | import CommandLine |
35 | import KeyRing | 36 | import KeyRing |
@@ -342,19 +343,21 @@ refreshCache rt rootdir = do | |||
342 | either warn (write $ mkpath "ipsec.d/certs/" ++ Char8.unpack oname++".pem") | 343 | either warn (write $ mkpath "ipsec.d/certs/" ++ Char8.unpack oname++".pem") |
343 | $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket | 344 | $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket |
344 | 345 | ||
345 | let cs = filter notme (Map.elems $ rtKeyDB rt) | 346 | let onionkeys = mapMaybe namedContact $ Map.elems $ rtKeyDB rt |
347 | cs = filter (\(_,_,kd) -> notme kd) onionkeys | ||
346 | kk = keykey (fromJust $ rtWorkingKey rt) | 348 | kk = keykey (fromJust $ rtWorkingKey rt) |
347 | notme kd = keykey (keyPacket kd) /= kk | 349 | notme kd = keykey (keyPacket kd) /= kk |
348 | 350 | ||
349 | installConctact :: KeyData -> IO Char8.ByteString | 351 | namedContact kd = do |
350 | installConctact kd = do | ||
351 | -- The getHostnames command requires a valid cross-signed tor key | 352 | -- The getHostnames command requires a valid cross-signed tor key |
352 | -- for each onion name returned in (_,(ns,_)). | 353 | -- for each onion name returned in (_,(ns,_)). |
353 | let (addr,(ns,_)) = getHostnames kd | 354 | let (addr,(ns,_)) = getHostnames kd |
354 | contactname = fmap Char8.unpack $ listToMaybe ns -- only first onion name. | 355 | fmap (\n -> (n,addr, kd)) $ listToMaybe ns -- only first onion name. |
355 | flip (maybe $ return Char8.empty) contactname $ \contactname -> do | ||
356 | 356 | ||
357 | let cpath = interp (Map.singleton "onion" contactname) "ipsec.d/certs/%(onion).pem" | 357 | installConctact :: (L.ByteString, SockAddr, KeyData) -> IO Char8.ByteString |
358 | installConctact (contactname,addr,kd) = do | ||
359 | |||
360 | let cpath = interp (Map.singleton "onion" (Char8.unpack contactname)) "ipsec.d/certs/%(onion).pem" | ||
358 | their_master = packet $ keyMappedPacket kd | 361 | their_master = packet $ keyMappedPacket kd |
359 | -- We find all cross-certified ipsec keys for the given cross-certified onion name. | 362 | -- We find all cross-certified ipsec keys for the given cross-certified onion name. |
360 | ipsecs :: [Packet] | 363 | ipsecs :: [Packet] |
@@ -393,12 +396,12 @@ refreshCache rt rootdir = do | |||
393 | commit | 396 | commit |
394 | 397 | ||
395 | strongswanForContact addr oname = Char8.unlines | 398 | strongswanForContact addr oname = Char8.unlines |
396 | [ "conn " <> p oname | 399 | [ "conn " <> oname |
397 | , " right=%" <> p oname <> ".ipv4" | 400 | , " right=%" <> oname <> ".ipv4" |
398 | , " rightsubnet=" <> p (showA addr) <> "/128" | 401 | , " rightsubnet=" <> p (showA addr) <> "/128" |
399 | , " rightauth=pubkey" | 402 | , " rightauth=pubkey" |
400 | , " rightid=" <> p (showA addr) | 403 | , " rightid=" <> p (showA addr) |
401 | , " rightrsasigkey=" <> p (oname) <> ".pem" | 404 | , " rightrsasigkey=" <> oname <> ".pem" |
402 | ] | 405 | ] |
403 | where p = Char8.pack | 406 | where p = Char8.pack |
404 | 407 | ||