mighttpd2 4.0.5 → 4.0.6
raw patch · 16 files changed
+296/−246 lines, 16 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Program/Mighty.hs +16/−14
- Program/Mighty/ByteString.hs +0/−1
- Program/Mighty/Dhall/Option.hs +5/−5
- Program/Mighty/Network.hs +2/−2
- Program/Mighty/Parser.hs +17/−17
- Program/Mighty/Process.hs +34/−30
- Program/Mighty/Report.hs +17/−17
- Program/Mighty/Resource.hs +22/−16
- Program/Mighty/Route.hs +55/−45
- Program/Mighty/Signal.hs +11/−10
- Setup.hs +1/−0
- mighttpd2.cabal +1/−1
- src/WaiApp.hs +55/−39
- test/ConfigSpec.hs +33/−32
- test/RouteSpec.hs +11/−1
- utils/mightyctl.hs +16/−16
Program/Mighty.hs view
@@ -1,19 +1,21 @@ -- | Special library for Mighty. module Program.Mighty (- -- * Parsers- module Program.Mighty.Config- , module Program.Mighty.Route- , module Program.Mighty.Parser- -- * State- , module Program.Mighty.Report- -- * Utilities- , module Program.Mighty.ByteString- , module Program.Mighty.Network- , module Program.Mighty.Process- , module Program.Mighty.Resource- , module Program.Mighty.Signal- , module Program.Mighty.Types- ) where+ -- * Parsers+ module Program.Mighty.Config,+ module Program.Mighty.Route,+ module Program.Mighty.Parser,++ -- * State+ module Program.Mighty.Report,++ -- * Utilities+ module Program.Mighty.ByteString,+ module Program.Mighty.Network,+ module Program.Mighty.Process,+ module Program.Mighty.Resource,+ module Program.Mighty.Signal,+ module Program.Mighty.Types,+) where import Program.Mighty.ByteString import Program.Mighty.Config
Program/Mighty/ByteString.hs view
@@ -12,4 +12,3 @@ -- | Appending two 'ByteString'. (+++) :: ByteString -> ByteString -> ByteString (+++) = BS.append-
Program/Mighty/Dhall/Option.hs view
@@ -1,9 +1,9 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} module Program.Mighty.Dhall.Option where
Program/Mighty/Network.hs view
@@ -1,6 +1,6 @@ module Program.Mighty.Network (- daemonize- ) where+ daemonize,+) where import Control.Monad import System.Exit
Program/Mighty/Parser.hs view
@@ -1,19 +1,17 @@-{-# LANGUAGE CPP #-}- -- | Parsers for Mighty- module Program.Mighty.Parser (- -- * Utilities- parseFile- -- * Parsers- , spcs- , spcs1- , spc- , commentLines- , trailing- , comment- ) where+ -- * Utilities+ parseFile, + -- * Parsers+ spcs,+ spcs1,+ spc,+ commentLines,+ trailing,+ comment,+) where+ import qualified Data.ByteString.Lazy.Char8 as BL import System.IO import Text.Parsec@@ -21,8 +19,8 @@ import UnliftIO.Exception -- $setup+-- >>> :seti -XOverloadedStrings -- >>> import Data.Either--- >>> let isLeft = either (const True) (const False) -- | Parsing a file. -- If parsing fails, an 'IOException' is thrown.@@ -33,7 +31,7 @@ bs <- BL.hGetContents hdl case parse p "parseFile" bs of Right x -> return x- Left e -> throwIO . userError . show $ e+ Left e -> throwIO . userError . show $ e -- | 'Parser' to consume zero or more white spaces --@@ -75,12 +73,14 @@ -- | 'Parser' to consume a trailing comment ----- >>> parse trailing "" "# comments\n"+-- >>> parse trailing "" " # comments\n" -- Right ()+-- >>> parse trailing "" " \n"+-- Right () -- >>> isLeft $ parse trailing "" "X# comments\n" -- True trailing :: Parser ()-trailing = () <$ (spcs *> comment *> newline <|> spcs *> newline)+trailing = () <$ (spcs *> optional comment *> newline) -- | 'Parser' to consume a trailing comment --
Program/Mighty/Process.hs view
@@ -2,8 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} module Program.Mighty.Process (- getMightyPid- ) where+ getMightyPid,+) where import Control.Monad.Trans.Resource (runResourceT) import Data.ByteString.Char8 (ByteString)@@ -18,20 +18,22 @@ ---------------------------------------------------------------- -data PsResult = PsResult {- uid :: ByteString- , pid :: ProcessID- , ppid :: ProcessID- , command :: ByteString- } deriving (Eq, Show)+data PsResult = PsResult+ { uid :: ByteString+ , pid :: ProcessID+ , ppid :: ProcessID+ , command :: ByteString+ }+ deriving (Eq, Show) toPsResult :: [ByteString] -> PsResult-toPsResult (a:b:c:_:_:_:_:h:_) = PsResult {- uid = a- , pid = maybe 0 (fromIntegral . fst) $ BS.readInt b- , ppid = maybe 0 (fromIntegral . fst) $ BS.readInt c- , command = h- }+toPsResult (a : b : c : _ : _ : _ : _ : h : _) =+ PsResult+ { uid = a+ , pid = maybe 0 (fromIntegral . fst) $ BS.readInt b+ , ppid = maybe 0 (fromIntegral . fst) $ BS.readInt c+ , command = h+ } toPsResult _ = PsResult "unknown" 0 0 "unknown" ----------------------------------------------------------------@@ -39,16 +41,18 @@ runPS :: IO [PsResult] runPS = snd <$> runResourceT (sourceCmdWithConsumer "ps -ef" consumer) where- consumer = CB.lines+ consumer =+ CB.lines .| CL.map BS.words .| CL.map toPsResult .| CL.filter mighty .| CL.consume commandName = last . split '/' . command- mighty ps = "mighty" `BS.isInfixOf` name- && not ("mightyctl" `BS.isInfixOf` name)- where- name = commandName ps+ mighty ps =+ "mighty" `BS.isInfixOf` name+ && not ("mightyctl" `BS.isInfixOf` name)+ where+ name = commandName ps ---------------------------------------------------------------- @@ -57,16 +61,16 @@ where iAmMaster p = ppid p == 1 masters = filter iAmMaster ps- rest = filter (not.iAmMaster) ps- candidates = map head- $ filter (\xs -> length xs == 1) -- master is alone- $ groupBy ((==) `on` ppid)- $ sortOn ppid rest-+ rest = filter (not . iAmMaster) ps+ candidates =+ map head $+ filter (\xs -> length xs == 1) $ -- master is alone+ groupBy ((==) `on` ppid) $+ sortOn ppid rest deleteAloneChild :: [PsResult] -> [PsResult] deleteAloneChild [] = []-deleteAloneChild (p:ps) = p : deleteAloneChild (filter noParent ps)+deleteAloneChild (p : ps) = p : deleteAloneChild (filter noParent ps) where parent = pid p noParent x = ppid x /= parent@@ -81,7 +85,7 @@ split :: Char -> ByteString -> [ByteString] split _ "" = []-split c s = case BS.break (c==) s of- ("",r) -> split c (BS.tail r)- (s',"") -> [s']- (s',r) -> s' : split c (BS.tail r)+split c s = case BS.break (c ==) s of+ ("", r) -> split c (BS.tail r)+ (s', "") -> [s']+ (s', r) -> s' : split c (BS.tail r)
Program/Mighty/Report.hs view
@@ -3,13 +3,13 @@ {-# LANGUAGE ScopedTypeVariables #-} module Program.Mighty.Report (- Reporter- , initReporter- , report- , reportDo- , warpHandler- , printStdout- ) where+ Reporter,+ initReporter,+ report,+ reportDo,+ warpHandler,+ printStdout,+) where #if __GLASGOW_HASKELL__ < 709 import Control.Applicative@@ -18,7 +18,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import Data.UnixTime-import GHC.IO.Exception (IOErrorType(..))+import GHC.IO.Exception (IOErrorType (..)) import Network.Wai import Network.Wai.Handler.Warp (InvalidRequest) import System.IO@@ -28,15 +28,15 @@ import Program.Mighty.ByteString -data Method = FileOnly | FileAndStdout deriving Eq+data Method = FileOnly | FileAndStdout deriving (Eq) data Reporter = Reporter Method FilePath initReporter :: Bool -> FilePath -> Reporter initReporter debug reportFile = Reporter method reportFile where method- | debug = FileAndStdout- | otherwise = FileOnly+ | debug = FileAndStdout+ | otherwise = FileOnly report :: Reporter -> ByteString -> IO () report (Reporter method reportFile) msg = handle (\(SomeException _) -> return ()) $ do@@ -55,12 +55,12 @@ warpHandler :: Reporter -> Maybe Request -> SomeException -> IO () warpHandler rpt _ se- | Just (_ :: InvalidRequest) <- fromException se = return ()- | Just (e :: IOException) <- fromException se =- if ioeGetErrorType e `elem` [ResourceVanished,InvalidArgument]- then return ()- else report rpt $ bshow se- | otherwise = report rpt $ bshow se+ | Just (_ :: InvalidRequest) <- fromException se = return ()+ | Just (e :: IOException) <- fromException se =+ if ioeGetErrorType e `elem` [ResourceVanished, InvalidArgument]+ then return ()+ else report rpt $ bshow se+ | otherwise = report rpt $ bshow se ----------------------------------------------------------------
Program/Mighty/Resource.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE CPP #-} module Program.Mighty.Resource (- amIrootUser- , setGroupUser- , unlimit- ) where+ amIrootUser,+ setGroupUser,+ unlimit,+) where import System.Posix import UnliftIO.Exception@@ -18,17 +18,21 @@ ---------------------------------------------------------------- -- | Setting user and group.-setGroupUser :: String -- ^ User- -> String -- ^ Group- -> IO Bool+setGroupUser+ :: String+ -- ^ User+ -> String+ -- ^ Group+ -> IO Bool setGroupUser user group = do root <- amIrootUser- if root then do- getGroupEntryForName group >>= setGroupID . groupID- getUserEntryForName user >>= setUserID . userID- return True- else- return False+ if root+ then do+ getGroupEntryForName group >>= setGroupID . groupID+ getUserEntryForName user >>= setUserID . userID+ return True+ else+ return False ---------------------------------------------------------------- @@ -36,8 +40,10 @@ unlimit :: Integer -> IO () unlimit limit = handle (\(SomeException _) -> return ()) $ do hard <- hardLimit <$> getResourceLimit ResourceOpenFiles- let lim = if hard == ResourceLimitInfinity then- ResourceLimits (ResourceLimit limit) hard+ let lim =+ if hard == ResourceLimitInfinity+ then+ ResourceLimits (ResourceLimit limit) hard else- ResourceLimits hard hard+ ResourceLimits hard hard setResourceLimit ResourceOpenFiles lim
Program/Mighty/Route.hs view
@@ -3,23 +3,25 @@ {-# LANGUAGE TupleSections #-} module Program.Mighty.Route (- -- * Paring a routing file- parseRoute- -- * Types- , RouteDB- , Route(..)- , Block(..)- , Src- , Dst- , Domain- , Port- -- * RouteDBRef- , RouteDBRef- , newRouteDBRef- , readRouteDBRef- , writeRouteDBRef- ) where+ -- * Paring a routing file+ parseRoute, + -- * Types+ RouteDB,+ Route (..),+ Block (..),+ Src,+ Dst,+ Domain,+ Port,++ -- * RouteDBRef+ RouteDBRef,+ newRouteDBRef,+ readRouteDBRef,+ writeRouteDBRef,+) where+ import Control.Monad import Data.ByteString import qualified Data.ByteString.Char8 as BS@@ -36,31 +38,37 @@ ---------------------------------------------------------------- -- | A logical path specified in URL.-type Src = Path+type Src = Path+ -- | A physical path in a file system.-type Dst = Path-type Domain = ByteString+type Dst = Path++type Domain = ByteString #ifdef DHALL type Port = Natural #else type Port = Int #endif -data Block = Block [Domain] [Route] deriving (Eq,Show)-data Route = RouteFile Src Dst- | RouteRedirect Src Dst- | RouteCGI Src Dst- | RouteRevProxy Src Dst Domain Port- deriving (Eq,Show)-type RouteDB = [Block]+data Block = Block [Domain] [Route] deriving (Eq, Show)+data Route+ = RouteFile Src Dst+ | RouteRedirect Src Dst+ | RouteCGI Src Dst+ | RouteRevProxy Src Dst Domain Port+ deriving (Eq, Show)+type RouteDB = [Block] ---------------------------------------------------------------- -- | Parsing a route file.-parseRoute :: FilePath- -> Domain -- ^ A default domain, typically \"localhost\"- -> Port -- ^ A default port, typically 80.- -> IO RouteDB+parseRoute+ :: FilePath+ -> Domain+ -- ^ A default domain, typically \"localhost\"+ -> Port+ -- ^ A default port, typically 80.+ -> IO RouteDB parseRoute file ddom dport = parseFile (routeDB ddom dport) file routeDB :: Domain -> Port -> Parser RouteDB@@ -70,12 +78,12 @@ block ddom dport = Block <$> cdomains <*> many croute where cdomains = domains <* commentLines- croute = route ddom dport <* commentLines+ croute = route ddom dport <* commentLines domains :: Parser [Domain] domains = open *> doms <* close <* trailing where- open = () <$ char '[' *> spcs+ open = () <$ char '[' *> spcs close = () <$ char ']' *> spcs doms = (domain `sepBy1` sep) <* spcs domain = BS.pack <$> many1 (noneOf "[], \t\n")@@ -88,26 +96,27 @@ s <- src o <- op case o of- OpFile -> RouteFile s <$> dst <* trailing+ OpFile -> RouteFile s <$> dst <* trailing OpRedirect -> RouteRedirect s <$> dst' <* trailing- OpCGI -> RouteCGI s <$> dst <* trailing+ OpCGI -> RouteCGI s <$> dst <* trailing OpRevProxy -> do- (dom,prt,d) <- domPortDst ddom dport+ (dom, prt, d) <- domPortDst ddom dport return $ RouteRevProxy s d dom prt where src = path dst = path dst' = path'- op0 = OpFile <$ string "->"- <|> OpRedirect <$ string "<<"- <|> OpCGI <$ string "=>"- <|> OpRevProxy <$ string ">>"- op = op0 <* spcs+ op0 =+ OpFile <$ string "->"+ <|> OpRedirect <$ string "<<"+ <|> OpCGI <$ string "=>"+ <|> OpRevProxy <$ string ">>"+ op = op0 <* spcs path :: Parser Path path = do c <- char '/'- BS.pack . (c:) <$> many (noneOf "[], \t\n") <* spcs+ BS.pack . (c :) <$> many (noneOf "[], \t\n") <* spcs path' :: Parser Path path' = BS.pack <$> many (noneOf "[], \t\n") <* spcs@@ -115,14 +124,15 @@ -- [host1][:port2]/path2 domPortDst :: Domain -> Port -> Parser (Domain, Port, Dst)-domPortDst ddom dport = (ddom,,) <$> port <*> path- <|> try((,,) <$> domain <*> port <*> path)- <|> (,dport,) <$> domain <*> path+domPortDst ddom dport =+ (ddom,,) <$> port <*> path+ <|> try ((,,) <$> domain <*> port <*> path)+ <|> (,dport,) <$> domain <*> path where domain = BS.pack <$> many1 (noneOf ":/[], \t\n") port = do void $ char ':'- read <$> many1 (oneOf ['0'..'9'])+ read <$> many1 (oneOf ['0' .. '9']) ----------------------------------------------------------------
Program/Mighty/Signal.hs view
@@ -1,13 +1,14 @@ module Program.Mighty.Signal (- -- * Signals- sigStop- , sigReload- , sigRetire- , sigInfo- -- * Signal handling- , setHandler- ) where+ -- * Signals+ sigStop,+ sigReload,+ sigRetire,+ sigInfo, + -- * Signal handling+ setHandler,+) where+ import Control.Monad import System.Posix @@ -15,7 +16,7 @@ -- | The signal to stop Mighty. sigStop :: Signal-sigStop = sigTERM+sigStop = sigTERM -- | The signal to reload a configration file. sigReload :: Signal@@ -27,7 +28,7 @@ -- | The signal to get information from Mighty. sigInfo :: Signal-sigInfo = sigUSR2+sigInfo = sigUSR2 ----------------------------------------------------------------
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
mighttpd2.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: mighttpd2-version: 4.0.5+version: 4.0.6 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto <kazu@iij.ad.jp>
src/WaiApp.hs view
@@ -5,77 +5,93 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS-import Network.HTTP.Types (preconditionFailed412, movedPermanently301, urlDecode, badRequest400)+import Network.HTTP.Types (+ badRequest400,+ movedPermanently301,+ preconditionFailed412,+ urlDecode,+ ) import Network.Wai (Application, responseLBS)-import Network.Wai.Internal import Network.Wai.Application.Classic+import Network.Wai.Internal import Program.Mighty data Perhaps a = Found a | Redirect | Fail -fileCgiApp :: ClassicAppSpec -> FileAppSpec -> CgiAppSpec -> RevProxyAppSpec- -> RouteDBRef -> Application+fileCgiApp+ :: ClassicAppSpec+ -> FileAppSpec+ -> CgiAppSpec+ -> RevProxyAppSpec+ -> RouteDBRef+ -> Application fileCgiApp cspec filespec cgispec revproxyspec rdr req respond- | dotFile = do+ | dotFile = do let st = badRequest400 fastResponse respond st defaultHeader "Bad Request\r\n"- | otherwise = do- um <- readRouteDBRef rdr- case mmp um of- Fail -> do- let st = preconditionFailed412- fastResponse respond st defaultHeader "Precondition Failed\r\n"- Redirect -> do- let st = movedPermanently301- hdr = defaultHeader ++ redirectHeader req'- fastResponse respond st hdr "Moved Permanently\r\n"- Found (RouteFile src dst) ->- fileApp cspec filespec (FileRoute src dst) req' respond- Found (RouteRedirect src dst) ->- redirectApp cspec (RedirectRoute src dst) req' respond- Found (RouteCGI src dst) ->- cgiApp cspec cgispec (CgiRoute src dst) req' respond- Found (RouteRevProxy src dst dom prt) ->- revProxyApp cspec revproxyspec (RevProxyRoute src dst dom (naturalToInt prt)) req respond+ | otherwise = do+ um <- readRouteDBRef rdr+ case mmp um of+ Fail -> do+ let st = preconditionFailed412+ fastResponse respond st defaultHeader "Precondition Failed\r\n"+ Redirect -> do+ let st = movedPermanently301+ hdr = defaultHeader ++ redirectHeader req'+ fastResponse respond st hdr "Moved Permanently\r\n"+ Found (RouteFile src dst) ->+ fileApp cspec filespec (FileRoute src dst) req' respond+ Found (RouteRedirect src dst) ->+ redirectApp cspec (RedirectRoute src dst) req' respond+ Found (RouteCGI src dst) ->+ cgiApp cspec cgispec (CgiRoute src dst) req' respond+ Found (RouteRevProxy src dst dom prt) ->+ revProxyApp+ cspec+ revproxyspec+ (RevProxyRoute src dst dom (naturalToInt prt))+ req+ respond where (host, _) = hostPort req rawpath = rawPathInfo req path = urlDecode False rawpath dotFile = BS.isPrefixOf "." rawpath || BS.isInfixOf "/." rawpath mmp um = case getBlock host um of- Nothing -> Fail+ Nothing -> Fail Just blk -> getRoute path blk fastResponse resp st hdr body = resp $ responseLBS st hdr body defaultHeader = [("Content-Type", "text/plain")]- req' = req { rawPathInfo = path } -- FIXME+ req' = req{rawPathInfo = path} -- FIXME getBlock :: ByteString -> RouteDB -> Maybe [Route] getBlock _ [] = Nothing getBlock key (Block doms maps : ms)- | "*" `elem` doms = Just maps- | key `elem` doms = Just maps- | otherwise = getBlock key ms+ | "*" `elem` doms = Just maps+ | key `elem` doms = Just maps+ | otherwise = getBlock key ms getRoute :: ByteString -> [Route] -> Perhaps Route-getRoute _ [] = Fail-getRoute key (m:ms)- | src `isPrefixOf` key = Found m- | src `isMountPointOf` key = Redirect- | otherwise = getRoute key ms+getRoute _ [] = Fail+getRoute key (m : ms)+ | src `isPrefixOf` key = Found m+ | src `isMountPointOf` key = Redirect+ | otherwise = getRoute key ms where src = routeSource m routeSource :: Route -> Src-routeSource (RouteFile src _) = src-routeSource (RouteRedirect src _) = src-routeSource (RouteCGI src _) = src+routeSource (RouteFile src _) = src+routeSource (RouteRedirect src _) = src+routeSource (RouteCGI src _) = src routeSource (RouteRevProxy src _ _ _) = src isPrefixOf :: Path -> ByteString -> Bool isPrefixOf src key = src `BS.isPrefixOf` key isMountPointOf :: Path -> ByteString -> Bool-isMountPointOf src key = hasTrailingPathSeparator src- && BS.length src - BS.length key == 1- && key `BS.isPrefixOf` src+isMountPointOf src key =+ hasTrailingPathSeparator src+ && BS.length src - BS.length key == 1+ && key `BS.isPrefixOf` src
test/ConfigSpec.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module ConfigSpec where @@ -11,7 +11,7 @@ describe "parseConfig" $ do it "parses example.conf correctly" $ do res <- parseOption "conf/example.conf"- res { opt_server_name = "foo" } `shouldBe` ans+ res{opt_server_name = "foo"} `shouldBe` ans #ifdef DHALL describe "parseDhall" $ do@@ -21,33 +21,34 @@ #endif ans :: Option-ans = Option- { opt_port = 80- , opt_host = "*"- , opt_debug_mode = True- , opt_user = "root"- , opt_group = "root"- , opt_pid_file = "/var/run/mighty.pid"- , opt_report_file = "/tmp/mighty_report"- , opt_logging = True- , opt_log_file = "/var/log/mighty"- , opt_log_file_size = 16777216- , opt_log_backup_number = 10- , opt_index_file = "index.html"- , opt_index_cgi = "index.cgi"- , opt_status_file_dir = "/usr/local/share/mighty/status"- , opt_connection_timeout = 30- , opt_proxy_timeout = 0- , opt_fd_cache_duration = 10- , opt_service = 0- , opt_tls_port = 443- , opt_tls_cert_file = "cert.pem"- , opt_tls_chain_files = "chain.pem"- , opt_tls_key_file = "privkey.pem"- , opt_quic_addr = ["0.0.0.0","::"]- , opt_quic_port = 443- , opt_quic_debug_dir = Nothing- , opt_quic_qlog_dir = Nothing- , opt_server_name = "foo"- , opt_routing_file = Nothing- }+ans =+ Option+ { opt_port = 80+ , opt_host = "*"+ , opt_debug_mode = True+ , opt_user = "root"+ , opt_group = "root"+ , opt_pid_file = "/var/run/mighty.pid"+ , opt_report_file = "/tmp/mighty_report"+ , opt_logging = True+ , opt_log_file = "/var/log/mighty"+ , opt_log_file_size = 16777216+ , opt_log_backup_number = 10+ , opt_index_file = "index.html"+ , opt_index_cgi = "index.cgi"+ , opt_status_file_dir = "/usr/local/share/mighty/status"+ , opt_connection_timeout = 30+ , opt_proxy_timeout = 0+ , opt_fd_cache_duration = 10+ , opt_service = 0+ , opt_tls_port = 443+ , opt_tls_cert_file = "cert.pem"+ , opt_tls_chain_files = "chain.pem"+ , opt_tls_key_file = "privkey.pem"+ , opt_quic_addr = ["0.0.0.0", "::"]+ , opt_quic_port = 443+ , opt_quic_debug_dir = Nothing+ , opt_quic_qlog_dir = Nothing+ , opt_server_name = "foo"+ , opt_routing_file = Nothing+ }
test/RouteSpec.hs view
@@ -14,4 +14,14 @@ res `shouldBe` ans ans :: [Block]-ans = [Block ["localhost","www.example.com"] [RouteCGI "/~alice/cgi-bin/" "/home/alice/public_html/cgi-bin/",RouteFile "/~alice/" "/home/alice/public_html/",RouteCGI "/cgi-bin/" "/export/cgi-bin/",RouteRevProxy "/app/cal/" "/calendar/" "example.net" 80,RouteRevProxy "/app/wiki/" "/" "127.0.0.1" 3000,RouteFile "/" "/export/www/"]]+ans =+ [ Block+ ["localhost", "www.example.com"]+ [ RouteCGI "/~alice/cgi-bin/" "/home/alice/public_html/cgi-bin/"+ , RouteFile "/~alice/" "/home/alice/public_html/"+ , RouteCGI "/cgi-bin/" "/export/cgi-bin/"+ , RouteRevProxy "/app/cal/" "/calendar/" "example.net" 80+ , RouteRevProxy "/app/wiki/" "/" "127.0.0.1" 3000+ , RouteFile "/" "/export/www/"+ ]+ ]
utils/mightyctl.hs view
@@ -6,15 +6,15 @@ import System.Posix.Signals import System.Posix.Types -import Program.Mighty (getMightyPid, sigStop, sigReload, sigRetire, sigInfo)+import Program.Mighty (getMightyPid, sigInfo, sigReload, sigRetire, sigStop) commandDB :: [(String, Signal)]-commandDB = [- ("stop", sigStop)- , ("reload", sigReload)- , ("retire", sigRetire)- , ("info", sigInfo)- ]+commandDB =+ [ ("stop", sigStop)+ , ("reload", sigReload)+ , ("retire", sigRetire)+ , ("info", sigInfo)+ ] usage :: IO a usage = do@@ -26,41 +26,41 @@ main :: IO () main = do- (sig,mpid) <- getArgs >>= checkArgs+ (sig, mpid) <- getArgs >>= checkArgs pid <- maybe getProcessIdWithPS return mpid signalProcess sig pid checkArgs :: [String] -> IO (Signal, Maybe ProcessID)-checkArgs [cmd] = do+checkArgs [cmd] = do sig <- getSignal cmd return (sig, Nothing)-checkArgs [cmd,num] = do+checkArgs [cmd, num] = do sig <- getSignal cmd pid <- getProcessId num return (sig, Just pid)-checkArgs _ = usage+checkArgs _ = usage getSignal :: String -> IO Signal getSignal cmd = check $ lookup cmd commandDB where check (Just sig) = return sig- check Nothing = do+ check Nothing = do putStrLn $ "No such command: " ++ cmd usage getProcessId :: String -> IO ProcessID getProcessId num = check $ reads num where- check [(pid,"")] = return . fromIntegral $ (pid :: Int)- check _ = do+ check [(pid, "")] = return . fromIntegral $ (pid :: Int)+ check _ = do putStrLn $ "No such process id: " ++ num usage getProcessIdWithPS :: IO ProcessID getProcessIdWithPS = getMightyPid >>= check where- check [] = putStrLn "No Mighty found" >> usage+ check [] = putStrLn "No Mighty found" >> usage check [pid] = return pid- check pids = do+ check pids = do putStrLn $ "Multiple Mighty found: " ++ intercalate ", " (map show pids) usage