summaryrefslogtreecommitdiff
path: root/cokiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'cokiki.hs')
-rw-r--r--cokiki.hs87
1 files changed, 79 insertions, 8 deletions
diff --git a/cokiki.hs b/cokiki.hs
index fc69037..daebf0f 100644
--- a/cokiki.hs
+++ b/cokiki.hs
@@ -1,17 +1,21 @@
1{-# LANGUAGE OverloadedStrings #-} 1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE CPP #-} 2{-# LANGUAGE CPP #-}
3{-# LANGUAGE PatternGuards #-}
3import Control.Applicative 4import Control.Applicative
4import Control.DeepSeq 5import Control.DeepSeq
5import Data.Bool 6import Data.Bool
6import Data.Char 7import Data.Char
7import Data.List 8import Data.List
8import Data.Maybe 9import Data.Maybe
10import Data.Monoid
9import qualified Data.ByteString.Lazy.Char8 as L 11import qualified Data.ByteString.Lazy.Char8 as L
10import qualified Data.ByteString.Lazy.Char8 as L8 12import qualified Data.ByteString.Lazy.Char8 as L8
13import qualified Data.ByteString.Char8 as S8
11import qualified Kiki 14import qualified Kiki
12import System.Directory 15import System.Directory
13import System.FilePath.Posix (takeDirectory) 16import System.FilePath.Posix (takeDirectory)
14import System.Environment 17import System.Environment
18import System.Exit
15import System.IO 19import System.IO
16import System.Posix.User 20import System.Posix.User
17import CommandLine 21import CommandLine
@@ -45,20 +49,30 @@ usage = unlines
45 , "" 49 , ""
46 , " strongswan Modify /etc/ipsec.conf to include settings from" 50 , " strongswan Modify /etc/ipsec.conf to include settings from"
47 , " /var/cache/kiki/ipsec.conf." 51 , " /var/cache/kiki/ipsec.conf."
52 , ""
53 , " tor Modify /etc/tor/torrc to configure a tor hidden"
54 , " service for email (smtp), ssh, and http ports."
48 ] 55 ]
49 56
50main = do 57main = do
51 (cmd,args) <- splitAt 1 <$> getArgs 58 (cmd,args) <- splitAt 1 <$> getArgs
52 uid <- getEffectiveUserID 59 uid <- getEffectiveUserID
53 let sel = case cmd of 60 let msel = case cmd of
54 ["ssh-client"] -> sshClient uid <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir 61 ["ssh-client"] -> Just $ sshClient uid <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir
55 ["ssh-server"] -> sshServer uid <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir 62 ["ssh-server"] -> Just $ sshServer uid <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir
56 ["strongswan"] -> strongswan uid <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir 63 ["strongswan"] -> Just $ strongswan uid <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir
57 _ -> pure $ hPutStr stderr usage 64 ["tor"] -> Just $ configureTor uid <$> Kiki.ㄧchroot <*> Kiki.ㄧhomedir
65 _ -> Nothing
58 spec = uncurry fancy Kiki.kikiOptions "" 66 spec = uncurry fancy Kiki.kikiOptions ""
59 case runArgs (parseInvocation spec args) sel of 67 errorQuit msg = do
60 Left e -> hPutStrLn stderr $ usageErrorMessage e 68 hPutStr stderr msg
61 Right io -> io 69 System.Exit.exitFailure
70 fromMaybe (errorQuit usage) $ do
71 sel <- msel
72 Just $ do
73 case runArgs (parseInvocation spec args) sel of
74 Left e -> errorQuit $ usageErrorMessage e
75 Right io -> io
62 76
63maybeReadFile :: FilePath -> IO (Maybe L.ByteString) 77maybeReadFile :: FilePath -> IO (Maybe L.ByteString)
64maybeReadFile path = do 78maybeReadFile path = do
@@ -131,6 +145,62 @@ strongswan uid root cmn = whenRoot uid root cmn $ do
131 -- etc/ipsec.conf <-- 'include /var/cache/kiki/ipsec.conf' 145 -- etc/ipsec.conf <-- 'include /var/cache/kiki/ipsec.conf'
132 Kiki.importAndRefresh root cmn 146 Kiki.importAndRefresh root cmn
133 147
148configureTor uid root cmn = whenRoot uid root cmn $ do
149 -- Parsing as if ssh config, that's not right, but good enough for now.
150 torrc <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/tor/torrc")
151 let p:gs = groupBy (\_ d -> not $ sshIsDirective "HiddenServiceDir" d) $ ["#"]:torrc
152 (fs, hs) = break (\(d:ds) -> elem "/var/cache/kiki/config/tor/" d) gs
153 case hs of
154 (d:ds):ks
155 | (pre:ports) <- groupBy (\_ d -> not $ sshIsDirective "HiddenServicePort" d) $ ["#"]:ds
156 , (got,need) <- partition (hasPort ports) ["80","22","25"]
157 -> case need of
158 [] -> hPutStrLn stderr "tor is already configured."
159 ns | (addr:_) <- mapMaybe (fmap fst . splitAddr . word 2) ds
160 -> do hPutStrLn stderr "binding tor ports for configured address"
161 bindports addr ns
162 | otherwise
163 -> do hPutStrLn stderr "binding tor ports for 127.0.0.1"
164 bindports "127.0.0.1" ns
165 where
166 bindports :: L.ByteString -> [L.ByteString] -> IO ()
167 bindports addr ns = do
168 let binds = map mkport ns
169 mkport n = ["HiddenServicePort"," ",n," ",addr <> ":" <> n]
170 torrc' = concat $ drop 1 p : fs ++ (d:binds ++ ds):ks
171 torrc' `deepseq` return () -- force lazy input
172 myWriteFile (root "/etc/tor/torrc") $ unparseSshConfig torrc'
173
174 hasPort :: [[[L.ByteString]]] -> L.ByteString -> Bool
175 hasPort ports p = not $ null $ flip filter ports
176 $ (==p) . word 1 . concat . take 1
177
178 word :: Int -> [L.ByteString] -> L.ByteString
179 word n toks = words !! n
180 where
181 words = filter (not . L8.any isSpace . L8.take 1)
182 toks
183
184 splitAddr lb
185 | S8.null saddr = Nothing
186 | otherwise = Just ( L.fromChunks [S8.init saddr]
187 , L.fromChunks [sport])
188 where
189 (saddr,sport) = S8.breakEnd (==':') sb
190 sb = S8.concat $ L.toChunks $ L.take 60 lb
191
192 [] -> do hPutStrLn stderr $ "configuring new hidden service"
193 let torrc' = torrc
194 ++ [ []
195 , ["HiddenServiceDir"," ","/var/cache/kiki/config/tor/"]
196 , ["HiddenServicePort"," ","80"," ","127.0.0.1:80"]
197 , ["HiddenServicePort"," ","22"," ","127.0.0.1:22"]
198 , ["HiddenServicePort"," ","25"," ","127.0.0.1:25"] ]
199 myWriteFile (root "/etc/tor/torrc") $ unparseSshConfig torrc'
200 Kiki.importAndRefresh root cmn
201 return ()
202
203
134parseSshConfig :: L.ByteString -> [[L.ByteString]] 204parseSshConfig :: L.ByteString -> [[L.ByteString]]
135parseSshConfig bs = map tokenize $ L8.lines bs 205parseSshConfig bs = map tokenize $ L8.lines bs
136 where 206 where
@@ -150,6 +220,7 @@ sshIsDirective d ls =
150 isSpaceTok "" = True 220 isSpaceTok "" = True
151 isSpaceTok b = isSpace $ L8.head b 221 isSpaceTok b = isSpace $ L8.head b
152 222
223
153#if !MIN_VERSION_base(4,7,0) 224#if !MIN_VERSION_base(4,7,0)
154bool :: a -> a -> Bool -> a 225bool :: a -> a -> Bool -> a
155bool f _ False = f 226bool f _ False = f