diff options
-rw-r--r-- | cokiki.hs | 27 | ||||
-rw-r--r-- | kiki.cabal | 1 |
2 files changed, 20 insertions, 8 deletions
@@ -1,10 +1,15 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | import Control.Applicative | ||
3 | import Data.Bool | ||
4 | import Data.Char | ||
5 | import Data.Maybe | ||
6 | import qualified Data.ByteString.Lazy.Char8 as L | ||
7 | import qualified Data.ByteString.Lazy.Char8 as L8 | ||
8 | import qualified Kiki | ||
9 | import System.Directory | ||
1 | import System.Environment | 10 | import System.Environment |
2 | import System.IO | 11 | import System.IO |
3 | import System.Posix.User | 12 | import System.Posix.User |
4 | import qualified Kiki | ||
5 | import Data.Char | ||
6 | import qualified Data.ByteString.Lazy.Char8 as L8 | ||
7 | import qualified Data.ByteString.Lazy.Char8 as L | ||
8 | 13 | ||
9 | usage = unlines | 14 | usage = 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 | ||
30 | maybeReadFile :: FilePath -> Maybe L.ByteString | 35 | maybeReadFile :: FilePath -> IO (Maybe L.ByteString) |
31 | maybeReadFile path = do | 36 | maybeReadFile path = do |
32 | doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path) | 37 | doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path) |
33 | 38 | ||
34 | sshClient 0 root = do | 39 | sshClient 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 | ||
48 | sshClient uid = return () | 53 | sshClient uid root = return () |
49 | 54 | ||
50 | sshServer = do | 55 | sshServer = 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 | ||
70 | sshSplitAtDirective d sshconfig = splitAt (sshIsDirective d) sshconfig | 75 | unparseSshConfig ls = L8.unlines $ map L.concat $ ls |
76 | |||
77 | sshSplitAtDirective d sshconfig = break (sshIsDirective d) sshconfig | ||
71 | 78 | ||
72 | sshIsDirective d ls = | 79 | sshIsDirective 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 | |||
87 | bool :: a -> a -> Bool -> a | ||
88 | bool f _ False = f | ||
89 | bool _ t True = t | ||
@@ -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 | ||
68 | library | 69 | library |