diff options
author | joe <joe@jerkface.net> | 2016-04-25 20:20:45 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2016-04-25 20:20:45 -0400 |
commit | 6860098ed8f8b56eb5058e0c9c427abaa57021bf (patch) | |
tree | defc0ae2c6bcd08f489628be0633f99e6254a218 /cokiki.hs | |
parent | 3c8536fd92043283d20b9e19ae488e7fe64af236 (diff) |
more work on cokiki (ssh-client)
Diffstat (limited to 'cokiki.hs')
-rw-r--r-- | cokiki.hs | 22 |
1 files changed, 12 insertions, 10 deletions
@@ -23,6 +23,7 @@ usage = unlines | |||
23 | , " strongswan" | 23 | , " strongswan" |
24 | ] | 24 | ] |
25 | 25 | ||
26 | ㄧchroot :: Args (FilePath -> FilePath) | ||
26 | ㄧchroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id | 27 | ㄧchroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id |
27 | where | 28 | where |
28 | slash :: String -> String -> String | 29 | slash :: String -> String -> String |
@@ -38,11 +39,11 @@ main = do | |||
38 | | uid==0 = action | 39 | | uid==0 = action |
39 | | otherwise = hPutStrLn stderr "operation requires root." | 40 | | otherwise = hPutStrLn stderr "operation requires root." |
40 | let sel = case cmd of | 41 | let sel = case cmd of |
41 | ["ssh-client"] -> pure (sshClient uid) <*> ㄧchroot | 42 | ["ssh-client"] -> pure (sshClient uid) <*> ㄧchroot <*> Kiki.ㄧhomedir |
42 | ["ssh-server"] -> pure (whenRoot sshServer) | 43 | ["ssh-server"] -> pure (whenRoot sshServer) |
43 | ["strongswan"] -> pure (whenRoot strongswan) | 44 | ["strongswan"] -> pure (whenRoot strongswan) |
44 | _ -> pure $ hPutStr stderr usage | 45 | _ -> pure $ hPutStr stderr usage |
45 | spec = fancy [("--chroot",1)] [] "" | 46 | spec = fancy [("--chroot",1),("--passphrase-fd",1),("--homedir",1)] [] "" |
46 | case runArgs (parseInvocation spec args) sel of | 47 | case runArgs (parseInvocation spec args) sel of |
47 | Left e -> hPutStrLn stderr $ usageErrorMessage e | 48 | Left e -> hPutStrLn stderr $ usageErrorMessage e |
48 | Right io -> io | 49 | Right io -> io |
@@ -51,7 +52,7 @@ maybeReadFile :: FilePath -> IO (Maybe L.ByteString) | |||
51 | maybeReadFile path = do | 52 | maybeReadFile path = do |
52 | doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path) | 53 | doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path) |
53 | 54 | ||
54 | sshClient uid root = do | 55 | sshClient uid root cmn = do |
55 | -- /etc/ssh/ssh_config <-- 'GlobalKnownHostsFile /var/cache/kiki/ssh_known_hosts' | 56 | -- /etc/ssh/ssh_config <-- 'GlobalKnownHostsFile /var/cache/kiki/ssh_known_hosts' |
56 | sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/ssh_config") | 57 | sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/ssh_config") |
57 | let (ps,qs) = sshSplitAtDirective "GlobalKnownHostsFile" sshconfig | 58 | let (ps,qs) = sshSplitAtDirective "GlobalKnownHostsFile" sshconfig |
@@ -64,20 +65,21 @@ sshClient uid root = do | |||
64 | d:ds | elem "/var/cache/kiki/ssh_known_hosts" d | 65 | d:ds | elem "/var/cache/kiki/ssh_known_hosts" d |
65 | -> do hPutStrLn stderr "ssh-client already configured." | 66 | -> do hPutStrLn stderr "ssh-client already configured." |
66 | return Nothing | 67 | return Nothing |
67 | d:ds -> do hPutStrLn stderr "modifying GlobalKnownHostsFile not implemented" | 68 | d:ds -> do hPutStrLn stderr "modifying GlobalKnownHostsFile directive" |
68 | return Nothing | 69 | let hs = " " : "/var/cache/kiki/ssh_known_hosts" : drop 1 d |
69 | [] -> do | 70 | stmt = take 1 d ++ hs |
71 | return $ Just (ps ++ stmt : ds) | ||
72 | [] -> do -- Unconfigured add fresh directive. | ||
70 | let stmt = L8.unwords ["GlobalKnownHostsFile" | 73 | let stmt = L8.unwords ["GlobalKnownHostsFile" |
71 | , "/var/cache/kiki/ssh_known_hosts" | 74 | , "/var/cache/kiki/ssh_known_hosts" |
72 | , "/etc/ssh/ssh_known_hosts" | 75 | , "/etc/ssh/ssh_known_hosts" |
73 | , "/etc/ssh/ssh_known_hosts2" | 76 | , "/etc/ssh/ssh_known_hosts2" |
74 | ] | 77 | ] |
75 | return $ Just (sshconfig ++ parseSshConfig stmt) | 78 | return $ Just (sshconfig ++ parseSshConfig stmt) |
76 | -- sshconfig' `deepseq` return () -- force lazy input | 79 | sshconfig' `deepseq` return () -- force lazy input |
77 | maybe (return ()) (myWriteFile (root "/etc/ssh/ssh_config") . unparseSshConfig) sshconfig' | 80 | maybe (return ()) (myWriteFile (root "/etc/ssh/ssh_config") . unparseSshConfig) sshconfig' |
78 | -- /root/.gnupg/... <-- contains known hosts from /etc/ssh/ssh_known_hosts | 81 | -- /root/.gnupg/... <-- contains known hosts from /etc/ssh/ssh_known_hosts |
79 | 82 | Kiki.refresh root cmn | |
80 | -- Kiki.refresh | ||
81 | -- /var/cache/kiki/ssh_known_hosts <-- contains known hosts from /root/.gnupg/... | 83 | -- /var/cache/kiki/ssh_known_hosts <-- contains known hosts from /root/.gnupg/... |
82 | 84 | ||
83 | sshServer = do | 85 | sshServer = do |
@@ -87,7 +89,7 @@ sshServer = do | |||
87 | strongswan = do | 89 | strongswan = do |
88 | -- etc/ipsec.conf <-- 'include /var/cache/kiki/ipsec.conf' | 90 | -- etc/ipsec.conf <-- 'include /var/cache/kiki/ipsec.conf' |
89 | -- /root/.gnupg/... <-- contains newly-generated ipsec subkey | 91 | -- /root/.gnupg/... <-- contains newly-generated ipsec subkey |
90 | Kiki.refresh | 92 | Kiki.refresh id (Kiki.CommonArgsParsed Nothing Nothing) |
91 | -- /var/cache/kiki/ipsec.conf <-- contains configurations for each remote ipsec host | 93 | -- /var/cache/kiki/ipsec.conf <-- contains configurations for each remote ipsec host |
92 | -- /var/cache/kiki/ipsec.conf <-- contains '%default' configuration for this local host | 94 | -- /var/cache/kiki/ipsec.conf <-- contains '%default' configuration for this local host |
93 | -- /var/cache/kiki/ipsec.d/certs <-- contains relevant certs | 95 | -- /var/cache/kiki/ipsec.d/certs <-- contains relevant certs |