summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/Kiki.hs21
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
30import qualified Data.ByteString.Lazy.Char8 as Char8 30import qualified Data.ByteString.Lazy.Char8 as Char8
31import qualified Data.Map.Strict as Map 31import qualified Data.Map.Strict as Map
32import qualified SSHKey as SSH 32import qualified SSHKey as SSH
33import Network.Socket -- (SockAddr)
33 34
34import CommandLine 35import CommandLine
35import KeyRing 36import 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
395strongswanForContact addr oname = Char8.unlines 398strongswanForContact 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