summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2016-05-02 00:03:11 +0000
committerjoe <joe@jerkface.net>2016-05-02 00:03:11 +0000
commitc070e563c3c1a04dc722c495acea5f9739c3334b (patch)
treeb127e9eeec18c74c3fe959374937f3f69673d202 /lib
parentfcf8a0fab06fbf2e5689455e36732ac9aaba2181 (diff)
generate known_hosts + fixes to trasactional symlink code.
Diffstat (limited to 'lib')
-rw-r--r--lib/Kiki.hs29
1 files changed, 21 insertions, 8 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 8d99499..cfff667 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -17,7 +17,7 @@ import Data.OpenPGP
17import Data.OpenPGP.Util 17import Data.OpenPGP.Util
18import Data.Ord 18import Data.Ord
19import System.Directory 19import System.Directory
20import System.FilePath.Posix 20import System.FilePath.Posix as FilePath
21import System.IO 21import System.IO
22import System.IO.Temp 22import System.IO.Temp
23import System.IO.Error 23import System.IO.Error
@@ -228,7 +228,7 @@ refreshCache rt rootdir = do
228 timeout = -1 -- TODO: set milisecond timeout on dotlock 228 timeout = -1 -- TODO: set milisecond timeout on dotlock
229 createDirectoryIfMissing True cachedir 229 createDirectoryIfMissing True cachedir
230 tmpdir <- createTempDirectory cachedir ("transaction." ++ takeBaseName destdir) 230 tmpdir <- createTempDirectory cachedir ("transaction." ++ takeBaseName destdir)
231 createSymbolicLink tmpdir (tmpdir ++ ".link") 231 createSymbolicLink (makeRelative cachedir tmpdir) (tmpdir ++ ".link")
232 lock <- dotlock_create destdir 0 232 lock <- dotlock_create destdir 0
233 T.mapM (flip dotlock_take timeout) lock 233 T.mapM (flip dotlock_take timeout) lock
234 let mkpath pth = tmpdir </> unslash (makeRelative destdir pth) 234 let mkpath pth = tmpdir </> unslash (makeRelative destdir pth)
@@ -241,7 +241,7 @@ refreshCache rt rootdir = do
241 -- otherwise call readyReadBeforeWrite on them. 241 -- otherwise call readyReadBeforeWrite on them.
242 rename (tmpdir ++ ".link") destdir 242 rename (tmpdir ++ ".link") destdir
243 er <- T.mapM dotlock_release lock 243 er <- T.mapM dotlock_release lock
244 void $ T.mapM removeDirectoryRecursive oldcommit 244 void $ T.mapM removeDirectoryRecursive (FilePath.combine cachedir <$> oldcommit)
245 -- Present transaction is Write only (or Write-Before-Read) which is fine. 245 -- Present transaction is Write only (or Write-Before-Read) which is fine.
246 -- If ever Read-Before-Write is required, uncomment and use: 246 -- If ever Read-Before-Write is required, uncomment and use:
247 -- let readyReadBeforeWrite pth = do 247 -- let readyReadBeforeWrite pth = do
@@ -370,6 +370,19 @@ refreshCache rt rootdir = do
370 return $ strongswanForContact addr contactname 370 return $ strongswanForContact addr contactname
371 return $ Char8.concat bss 371 return $ Char8.concat bss
372 372
373 known_hosts = L.concat $ map getssh onionkeys
374
375 getssh (contactname,addr,kd) = do
376 let their_master = packet $ keyMappedPacket kd
377 sshs :: [Packet]
378 sshs = sortOn (Down . timestamp)
379 $ getSubkeys CrossSigned their_master (keySubKeys kd) "ssh-server"
380 blobs = mapMaybe sshblobFromPacketL sshs
381 taggedblobs = map (\b -> contactname <> " " <> b) blobs
382 Char8.unlines taggedblobs
383
384 writeL (mkpath "ssh_known_hosts") known_hosts
385
373 cons <- mapM installConctact cs 386 cons <- mapM installConctact cs
374 writeL (mkpath "ipsec.conf") . Char8.unlines 387 writeL (mkpath "ipsec.conf") . Char8.unlines
375 $ [ "conn %default" 388 $ [ "conn %default"
@@ -461,11 +474,11 @@ interp vars raw = es >>= interp1
461 where (key,rest) = break (==')') str 474 where (key,rest) = break (==')') str
462 interp1 plain = plain 475 interp1 plain = plain
463 476
464sshblobFromPacket k = blob 477sshblobFromPacket k = Char8.unpack $ fromJust $ sshblobFromPacketL k
465 where 478
466 Just (RSAKey (MPI n) (MPI e)) = rsaKeyFromPacket k 479sshblobFromPacketL k = do
467 bs = SSH.keyblob (n,e) 480 RSAKey (MPI n) (MPI e) <- rsaKeyFromPacket k
468 blob = Char8.unpack bs 481 return $ SSH.keyblob (n,e)
469 482
470replaceSshServerKeys root cmn = do 483replaceSshServerKeys root cmn = do
471 let homepass' = cmn { cap_homespec = fmap root (cap_homespec cmn) } 484 let homepass' = cmn { cap_homespec = fmap root (cap_homespec cmn) }