summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@blackbird>2016-04-25 16:23:52 -0400
committerjoe <joe@blackbird>2016-04-25 16:23:52 -0400
commitbf1f1e3ec434272fe452f9b3016050b17b456eb2 (patch)
tree18333109d498d1f40fe41ac67f2a68c1c96fb87b
parentc4dcd6b04461dbeff178e90efa4d9b65bbb88228 (diff)
Fixed cokiki build
-rw-r--r--cokiki.hs27
-rw-r--r--kiki.cabal1
2 files changed, 20 insertions, 8 deletions
diff --git a/cokiki.hs b/cokiki.hs
index 3da337a..2cb6491 100644
--- a/cokiki.hs
+++ b/cokiki.hs
@@ -1,10 +1,15 @@
1{-# LANGUAGE OverloadedStrings #-}
2import Control.Applicative
3import Data.Bool
4import Data.Char
5import Data.Maybe
6import qualified Data.ByteString.Lazy.Char8 as L
7import qualified Data.ByteString.Lazy.Char8 as L8
8import qualified Kiki
9import System.Directory
1import System.Environment 10import System.Environment
2import System.IO 11import System.IO
3import System.Posix.User 12import System.Posix.User
4import qualified Kiki
5import Data.Char
6import qualified Data.ByteString.Lazy.Char8 as L8
7import qualified Data.ByteString.Lazy.Char8 as L
8 13
9usage = unlines 14usage = unlines
10 [ "cokiki <command>" 15 [ "cokiki <command>"
@@ -27,13 +32,13 @@ main = do
27 ["strongswan"] -> whenRoot strongswan 32 ["strongswan"] -> whenRoot strongswan
28 _ -> hPutStr stderr usage 33 _ -> hPutStr stderr usage
29 34
30maybeReadFile :: FilePath -> Maybe L.ByteString 35maybeReadFile :: FilePath -> IO (Maybe L.ByteString)
31maybeReadFile path = do 36maybeReadFile path = do
32 doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path) 37 doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path)
33 38
34sshClient 0 root = do 39sshClient 0 root = do
35 -- /etc/ssh/ssh_config <-- 'GlobalKnownHostsFile /var/cache/kiki/ssh_known_hosts' 40 -- /etc/ssh/ssh_config <-- 'GlobalKnownHostsFile /var/cache/kiki/ssh_known_hosts'
36 sshconfig <- fromMaybe [] parseSshConfig <$> maybeReadFile (root "/etc/ssh/ssh_config") 41 sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/ssh_config")
37 let (ps,qs) = sshSplitAtDirective "GlobalKnownHostsFile" sshconfig 42 let (ps,qs) = sshSplitAtDirective "GlobalKnownHostsFile" sshconfig
38 sshconfig' <- 43 sshconfig' <-
39 case qs of 44 case qs of
@@ -45,7 +50,7 @@ sshClient 0 root = do
45 -- /var/cache/kiki/ssh_known_hosts <-- contains known hosts from /root/.gnupg/... 50 -- /var/cache/kiki/ssh_known_hosts <-- contains known hosts from /root/.gnupg/...
46 51
47 52
48sshClient uid = return () 53sshClient uid root = return ()
49 54
50sshServer = do 55sshServer = do
51 -- /etc/ssh/sshd_config <-- 'HostKey /var/cache/kiki/ssh_host_ecdsa_key' etc. 56 -- /etc/ssh/sshd_config <-- 'HostKey /var/cache/kiki/ssh_host_ecdsa_key' etc.
@@ -67,7 +72,9 @@ parseSshConfig bs = map tokenize $ L8.lines bs
67 where (l', comment) = L8.break (=='#') l 72 where (l', comment) = L8.break (=='#') l
68 tokrel x y = isSpace x == isSpace y 73 tokrel x y = isSpace x == isSpace y
69 74
70sshSplitAtDirective d sshconfig = splitAt (sshIsDirective d) sshconfig 75unparseSshConfig ls = L8.unlines $ map L.concat $ ls
76
77sshSplitAtDirective d sshconfig = break (sshIsDirective d) sshconfig
71 78
72sshIsDirective d ls = 79sshIsDirective d ls =
73 case dropWhile isSpaceTok ls of 80 case dropWhile isSpaceTok ls of
@@ -76,3 +83,7 @@ sshIsDirective d ls =
76 where 83 where
77 isSpaceTok "" = True 84 isSpaceTok "" = True
78 isSpaceTok b = isSpace $ L8.head b 85 isSpaceTok b = isSpace $ L8.head b
86
87bool :: a -> a -> Bool -> a
88bool f _ False = f
89bool _ t True = t
diff --git a/kiki.cabal b/kiki.cabal
index fc86cb5..7c6edc2 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -63,6 +63,7 @@ Executable cokiki
63 Build-Depends: base >=4.6.0.0, 63 Build-Depends: base >=4.6.0.0,
64 bytestring, 64 bytestring,
65 unix, 65 unix,
66 directory,
66 kiki 67 kiki
67 68
68library 69library