@@ -1,3 +1,8 @@
1+{-# LANGUAGE CPP #-}
2+#if defined(IPROUTE_SUPPORTED)
3+{-# LANGUAGE TemplateHaskell #-}
4+#endif
5+
16{-# LANGUAGE ConstraintKinds #-}
27{-# LANGUAGE FlexibleContexts #-}
38{-# LANGUAGE FlexibleInstances #-}
@@ -62,12 +67,15 @@ import Snap.Core (Snap)
6267import System.Environment
6368import System.IO
6469import System.Process
65−import System.Exit (ExitCode(..))
6670import Text.URI (URI)
6771import qualified Text.URI as URI
6872import Text.URI.Lens
6973import Web.Cookie
7074
75+#if defined(IPROUTE_SUPPORTED)
76+import qualified System.Which
77+#endif
78+
7179run
7280 :: Int -- ^ Port to run the backend
7381 -> ([Text] -> Snap ()) -- ^ Static asset handler
@@ -99,7 +107,7 @@ runServeAsset rootPath = Snap.serveAsset "" rootPath . T.unpack . T.intercalate
99107
100108getConfigRoute :: Map Text ByteString -> Either Text URI
101109getConfigRoute configs = case Map.lookup "common/route" configs of
102− Just r ->
110+ Just r ->
103111 let stripped = T.strip (T.decodeUtf8 r)
104112 in case URI.mkURI stripped of
105113 Just route -> Right route
@@ -122,20 +130,20 @@ runWidget conf configs frontend validFullEncoder = do
122130 settings = setBeforeMainLoop beforeMainLoop (setPort port (setTimeout 3600 defaultSettings))
123131 -- Providing TLS here will also incidentally provide it to proxied requests to the backend.
124132 prepareRunner = case (uri ^? uriScheme . _Just . unRText) of
125− Just "https" -> do
133+ Just "https" -> do
126134 -- Generate a private key and self-signed certificate for TLS
127135 privateKey <- RSA.generateRSAKey' 2048 3
128136
129137 certRequest <- X509Request.newX509Req
130138 _ <- X509Request.setPublicKey certRequest privateKey
131− _ <- X509Request.signX509Req certRequest privateKey Nothing
139+ _ <- X509Request.signX509Req certRequest privateKey Nothing
132140
133141 cert <- X509.newX509 >>= X509Request.makeX509FromReq certRequest
134142 _ <- X509.setPublicKey cert privateKey
135143 now <- getCurrentTime
136144 _ <- X509.setNotBefore cert $ addUTCTime (-1) now
137145 _ <- X509.setNotAfter cert $ addUTCTime (365 * 24 * 60 * 60) now
138− _ <- X509.signX509 cert privateKey Nothing
146+ _ <- X509.signX509 cert privateKey Nothing
139147
140148 certByteString <- BSUTF8.fromString <$> PEM.writeX509 cert
141149 privateKeyByteString <- BSUTF8.fromString <$> PEM.writePKCS8PrivateKey privateKey Nothing
@@ -212,17 +220,22 @@ logPortBindErr p e = getProcessIdForPort p >>= \case
212220 Nothing -> putStrLn $ "runWidget: " <> show e
213221 Just pid -> putStrLn $ unwords [ "Port", show p, "is being used by process ID", show pid <> ".", "Please kill that process or change the port in config/common/route."]
214222
223+ssPath :: Maybe String
224+ssPath =
225+#if defined(IPROUTE_SUPPORTED)
226+ Just $(System.Which.staticWhich "ss")
227+#else
228+ Nothing
229+#endif
230+
215231getProcessIdForPort :: Int -> IO (Maybe Int)
216−getProcessIdForPort port = do
217− -- First check if 'ss' is available
218− (c, _, _) <- readProcessWithExitCode "which" ["ss"] mempty
219− case c of
220− ExitSuccess -> do
221− xs <- lines <$> readProcess "ss" ["-lptn", "sport = " <> show port] mempty
222− case uncons xs of
223− Just (_, x:_) -> return $ A.maybeResult $ A.parse parseSsPid $ BSC.pack x
224− _ -> return Nothing
225− _ -> return Nothing
232+getProcessIdForPort port = case ssPath of
233+ Just ss -> do
234+ xs <- lines <$> readProcess ss ["-lptn", "sport = " <> show port] mempty
235+ case uncons xs of
236+ Just (_, x:_) -> return $ A.maybeResult $ A.parse parseSsPid $ BSC.pack x
237+ _ -> return Nothing
238+ _ -> return Nothing
226239
227240parseSsPid :: A.Parser Int
228241parseSsPid = do