From c4dcd6b04461dbeff178e90efa4d9b65bbb88228 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 25 Apr 2016 16:11:59 -0400 Subject: cokiki executable. --- cokiki.hs | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 78 insertions(+) create mode 100644 cokiki.hs diff --git a/cokiki.hs b/cokiki.hs new file mode 100644 index 0000000..3da337a --- /dev/null +++ b/cokiki.hs @@ -0,0 +1,78 @@ +import System.Environment +import System.IO +import System.Posix.User +import qualified Kiki +import Data.Char +import qualified Data.ByteString.Lazy.Char8 as L8 +import qualified Data.ByteString.Lazy.Char8 as L + +usage = unlines + [ "cokiki " + , "" + , "COMMANDS" + , " ssh-client" + , " ssh-server" + , " strongswan" + ] + +main = do + args <- getArgs + uid <- getEffectiveUserID + let whenRoot action + | uid==0 = action + | otherwise = hPutStrLn stderr "operaiton requires root." + case args of + ["ssh-client"] -> sshClient uid id + ["ssh-server"] -> whenRoot sshServer + ["strongswan"] -> whenRoot strongswan + _ -> hPutStr stderr usage + +maybeReadFile :: FilePath -> Maybe L.ByteString +maybeReadFile path = do + doesFileExist path >>= bool (return Nothing) (Just <$> L.readFile path) + +sshClient 0 root = do + -- /etc/ssh/ssh_config <-- 'GlobalKnownHostsFile /var/cache/kiki/ssh_known_hosts' + sshconfig <- fromMaybe [] parseSshConfig <$> maybeReadFile (root "/etc/ssh/ssh_config") + let (ps,qs) = sshSplitAtDirective "GlobalKnownHostsFile" sshconfig + sshconfig' <- + case qs of + d:ds -> error "modify GlobalKnownHostsFile" + [] -> error "append GlobalKnownHostsFile" + L.writeFile (root "/var/cache/kiki/ssh_known_hosts") $ unparseSshConfig sshconfig' + -- /root/.gnupg/... <-- contains known hosts from /etc/ssh/ssh_known_hosts + Kiki.refresh + -- /var/cache/kiki/ssh_known_hosts <-- contains known hosts from /root/.gnupg/... + + +sshClient uid = return () + +sshServer = do + -- /etc/ssh/sshd_config <-- 'HostKey /var/cache/kiki/ssh_host_ecdsa_key' etc. + return () + +strongswan = do + -- etc/ipsec.conf <-- 'include /var/cache/kiki/ipsec.conf' + -- /root/.gnupg/... <-- contains newly-generated ipsec subkey + Kiki.refresh + -- /var/cache/kiki/ipsec.conf <-- contains configurations for each remote ipsec host + -- /var/cache/kiki/ipsec.conf <-- contains '%default' configuration for this local host + -- /var/cache/kiki/ipsec.d/certs <-- contains relevant certs + -- /var/cache/kiki/ipsec.d/private <-- contains private key + + +parseSshConfig bs = map tokenize $ L8.lines bs + where + tokenize l = L8.groupBy tokrel l' ++ [comment] + where (l', comment) = L8.break (=='#') l + tokrel x y = isSpace x == isSpace y + +sshSplitAtDirective d sshconfig = splitAt (sshIsDirective d) sshconfig + +sshIsDirective d ls = + case dropWhile isSpaceTok ls of + g:_ | g == d -> True + _ -> False + where + isSpaceTok "" = True + isSpaceTok b = isSpace $ L8.head b -- cgit v1.2.3