diff --git a/Program/Mighty/Report.hs b/Program/Mighty/Report.hs --- a/Program/Mighty/Report.hs +++ b/Program/Mighty/Report.hs @@ -23,11 +23,20 @@ import GHC.IO.Exception (IOErrorType (..)) import Network.Wai import Network.Wai.Handler.Warp (InvalidRequest) -import Network.Wai.Handler.Warp.Internal (TimeoutThread(..)) +import System.Exit (ExitCode) import System.IO import System.IO.Error (ioeGetErrorType) import System.Posix (getProcessID) +import Network.HTTP2.Client (HTTP2Error) +#ifdef HTTP_OVER_TLS +import Network.TLS (TLSException) +import Network.Wai.Handler.WarpTLS (WarpTLSException) +#ifdef HTTP_OVER_QUIC +import Network.QUIC (QUICException) +#endif +#endif + import Program.Mighty.ByteString data Method = FileOnly | FileAndStdout deriving (Eq) @@ -55,16 +64,25 @@ ---------------------------------------------------------------- +{- FOURMOLU_DISABLE -} warpHandler :: Reporter -> Maybe Request -> SomeException -> IO () warpHandler rpt _ se - | Just ThreadKilled <- fromException se = return () - | Just TimeoutThread <- fromException se = return () - | Just (_ :: InvalidRequest) <- fromException se = return () - | Just (e :: IOException) <- fromException se = + | Just (_ :: ExitCode) <- fromException se = return () + | Just (e :: IOException) <- fromException se = if ioeGetErrorType e `elem` [ResourceVanished, InvalidArgument] then return () else report rpt $ bshow se + | Just (_ :: InvalidRequest) <- fromException se = return () -- Warp + | Just (_ :: HTTP2Error) <- fromException se = return () +#ifdef HTTP_OVER_TLS + | Just (_ :: TLSException) <- fromException se = return () + | Just (_ :: WarpTLSException) <- fromException se = return () +#ifdef HTTP_OVER_QUIC + | Just (_ :: QUICException) <- fromException se = return () +#endif +#endif | otherwise = report rpt $ bshow se +{- FOURMOLU_ENABLE -} ---------------------------------------------------------------- diff --git a/mighttpd2.cabal b/mighttpd2.cabal --- a/mighttpd2.cabal +++ b/mighttpd2.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: mighttpd2 -version: 4.0.8 +version: 4.0.9 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto @@ -23,6 +23,7 @@ extra-source-files: Program/Mighty/Dhall/Option.dhall conf/example.dhall + utils/restart.sh source-repository head type: git @@ -71,11 +72,12 @@ filepath, http-date, http-types, + http2, network, parsec >=3, resourcet, - streaming-commons, split, + streaming-commons, text, unix, unix-time, @@ -91,6 +93,16 @@ cpp-options: -DDHALL build-depends: dhall + if flag(tls) + build-depends: + tls, + warp-tls + + if flag(quic) + build-depends: + quic, + http3 + executable mighty main-is: Mighty.hs hs-source-dirs: src @@ -145,7 +157,7 @@ if flag(quic) build-depends: quic >= 0.2 && < 0.3, - warp-quic >= 0.0.1 + warp-quic >= 0.0.2 if impl(ghc >=8) default-extensions: Strict StrictData @@ -178,6 +190,7 @@ test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs + build-tool-depends: hspec-discover:hspec-discover hs-source-dirs: test src other-modules: ConfigSpec diff --git a/src/Mighty.hs b/src/Mighty.hs --- a/src/Mighty.hs +++ b/src/Mighty.hs @@ -41,7 +41,7 @@ debug = opt_debug_mode opt rpt = initReporter debug reportFile run = server opt rpt route - if debug then run else background opt run + if debug then run id else run (background opt) where getOptRoute = getArgs >>= eachCase svrnm = programName ++ "/" ++ programVersion @@ -100,12 +100,10 @@ background :: Option -> IO () -> IO () background opt svr = do - putStrLn $ "Serving on port " ++ show port ++ " and detaching this terminal..." + putStrLn $ "Detaching this terminal..." putStrLn $ "(If errors occur, they will be written in \"" ++ reportFileName opt ++ "\".)" hFlush stdout daemonize svr - where - port = opt_port opt reportFileName :: Option -> FilePath reportFileName opt diff --git a/src/Server.hs b/src/Server.hs --- a/src/Server.hs +++ b/src/Server.hs @@ -6,13 +6,15 @@ import Control.Concurrent (runInUnboundThread) import Control.Exception (try) -import Control.Monad (unless, when) +import Control.Monad (unless) import qualified Data.ByteString.Char8 as BS import Data.Either (fromRight) -import Data.List (sort) -import Data.Maybe (fromMaybe) import Data.Streaming.Network (bindPortTCP, bindPortUDP) +#if __GLASGOW_HASKELL__ >= 906 import GHC.Conc.Sync +import Data.List (sort) +import Data.Maybe (fromMaybe) +#endif import qualified Network.HTTP.Client as H import Network.Socket (Socket, close) import Network.Wai @@ -20,7 +22,6 @@ import Network.Wai.Handler.Warp import Network.Wai.Logger import System.Exit (ExitCode(..), exitSuccess) -import System.IO import System.IO.Error (ioeGetErrorString) import System.Posix (exitImmediately, Handler(..), getProcessID, setFileMode) import System.Posix.Signals (sigCHLD) @@ -73,35 +74,37 @@ ---------------------------------------------------------------- -server :: Option -> Reporter -> RouteDB -> IO () -server opt rpt route = reportDo rpt $ do +server :: Option -> Reporter -> RouteDB -> (IO () -> IO ()) -> IO () +server opt rpt route runMighty = reportDo rpt $ do labelMe "Mighty main" unlimit openFileNumber svc <- openService opt - unless debug writePidFile - rdr <- newRouteDBRef route - tmgr <- T.initialize (naturalToInt (opt_connection_timeout opt) * 1000000) - (mcred, smgr) <- setup opt - _changed <- setGroupUser (opt_user opt) (opt_group opt) - logCheck logtype - -- "Time cacher of FastLogger (AutoUpdate)" - (zdater,_) <- clockDateCacher - -- Loggerset of FastLogger (Debounce) - ap <- initLogger FromSocket logtype zdater - let lgr = apacheLogger ap - remover = logRemover ap - pushlgr = serverpushLogger ap - -- HTTP Client Manager - mgr <- getManager opt - setHandlers opt rpt svc remover rdr + runMighty $ do + unless debug writePidFile + rdr <- newRouteDBRef route + let usec = naturalToInt (opt_connection_timeout opt) * 1000000 + T.withManager usec $ \tmgr -> do + (mcred, smgr) <- setup opt + _changed <- setGroupUser (opt_user opt) (opt_group opt) + logCheck logtype + -- "Time cacher of FastLogger (AutoUpdate)" + (zdater,_) <- clockDateCacher + -- Loggerset of FastLogger (Debounce) + ap <- initLogger FromSocket logtype zdater + let lgr = apacheLogger ap + remover = logRemover ap + pushlgr = serverpushLogger ap + -- HTTP Client Manager + mgr <- getManager opt + setHandlers opt rpt svc remover rdr - report rpt "Mighty started" - runInUnboundThread $ do - labelMe "Mighty main (bound thread)" - mighty opt rpt svc lgr pushlgr mgr rdr mcred smgr tmgr - report rpt "Mighty retired" - remover - exitSuccess + report rpt "Mighty started" + runInUnboundThread $ do + labelMe "Mighty main (bound thread)" + mighty opt rpt svc lgr pushlgr mgr rdr mcred smgr tmgr + report rpt "Mighty retired" + remover + exitSuccess where debug = opt_debug_mode opt port = opt_port opt @@ -140,13 +143,14 @@ closeService svc -- this lets warp break infoHandler = Catch $ do labelMe "Info signale handler" - threadSummary >>= mapM_ (putStrLn . showT) - showT (i, l, s) = i ++ " " ++ l ++ ": " ++ show s + threadSummary >>= mapM_ (report rpt . showT) + showT (i, l, s) = BS.pack (i ++ " " ++ l ++ ": " ++ show s) reloadHandler = Catch $ do ifRouteFileIsValid rpt opt $ \newroute -> do writeRouteDBRef rdr newroute report rpt "Mighty reloaded" +#if __GLASGOW_HASKELL__ >= 906 threadSummary :: IO [(String, String, ThreadStatus)] threadSummary = (sort <$> listThreads) >>= mapM summary where @@ -155,6 +159,10 @@ l <- fromMaybe "(no name)" <$> threadLabel t s <- threadStatus t return (idstr, l, s) +#else +threadSummary :: IO [(String, String, String)] +threadSummary = return [] +#endif #ifdef HTTP_OVER_TLS loadCredentials :: Option -> IO Credentials @@ -168,9 +176,9 @@ strip = dropWhileEnd isSpace . dropWhile isSpace split "" = [] split s = case break (',' ==) s of - ("",r) -> split (tail r) + ("",r) -> split $ drop 1 r (s',"") -> [s'] - (s',r) -> s' : split (tail r) + (s',r) -> s' : split (drop 1 r) chain_files = map strip $ split $ opt_tls_chain_files opt #endif @@ -221,12 +229,10 @@ #endif where app = fileCgiApp cspec filespec cgispec revproxyspec rdr - debug = opt_debug_mode opt -- We don't use setInstallShutdownHandler because we may use -- two sockets for HTTP and HTTPS. setting = setPort (naturalToInt $ opt_port opt) -- just in case $ setHost (fromString (opt_host opt)) -- just in case - $ setOnException (if debug then printStdout else warpHandler rpt) $ setManager tmgr $ setFdCacheDuration (naturalToInt $ opt_fd_cache_duration opt) $ setFileInfoCacheDuration 10 @@ -308,25 +314,25 @@ openService opt | service == 1 = do s <- bindPortTCP httpsPort hostpref - debugMessage $ urlForHTTPS httpsPort + putStrLn $ urlForHTTPS httpsPort return $ HttpsOnly s | service == 2 = do s1 <- bindPortTCP httpPort hostpref s2 <- bindPortTCP httpsPort hostpref - debugMessage $ urlForHTTP httpPort - debugMessage $ urlForHTTPS httpsPort + putStrLn $ urlForHTTP httpPort + putStrLn $ urlForHTTPS httpsPort return $ HttpAndHttps s1 s2 | service == 3 = do s1 <- bindPortTCP httpPort hostpref s2 <- bindPortTCP httpsPort hostpref ss3 <- mapM (bindPortUDP quicPort) quicAddrs - debugMessage $ urlForHTTP httpPort - debugMessage $ urlForHTTPS httpsPort - debugMessage "QUIC is also available via Alt-Svc" + putStrLn $ urlForHTTP httpPort + putStrLn $ urlForHTTPS httpsPort + putStrLn "QUIC is also available via Alt-Svc" return $ QUIC s1 s2 ss3 | otherwise = do s <- bindPortTCP httpPort hostpref - debugMessage $ urlForHTTP httpPort + putStrLn $ urlForHTTP httpPort return $ HttpOnly s where httpPort = naturalToInt $ opt_port opt @@ -335,10 +341,6 @@ quicAddrs = fromString <$> opt_quic_addr opt hostpref = fromString $ opt_host opt service = opt_service opt - debug = opt_debug_mode opt - debugMessage msg = when debug $ do - putStrLn msg - hFlush stdout urlForHTTP 80 = "http://localhost/" urlForHTTP p = "http://localhost:" ++ show p ++ "/" urlForHTTPS 443 = "https://localhost/" @@ -384,9 +386,13 @@ #endif labelMe :: String -> IO () +#if __GLASGOW_HASKELL__ >= 906 labelMe lbl = do tid <- myThreadId labelThread tid lbl +#else +labelMe _ = return () +#endif runHTTP :: Settings -> Socket -> Application -> IO () runHTTP setting s app = do diff --git a/src/WaiApp.hs b/src/WaiApp.hs --- a/src/WaiApp.hs +++ b/src/WaiApp.hs @@ -57,7 +57,7 @@ (host, _) = hostPort req rawpath = rawPathInfo req path = urlDecode False rawpath - dotFile = BS.isPrefixOf "." rawpath || BS.isInfixOf "/." rawpath + dotFile = not (BS.isPrefixOf "/.well-known/" rawpath) && (BS.isPrefixOf "." rawpath || BS.isInfixOf "/." rawpath) mmp um = case getBlock host um of Nothing -> Fail Just blk -> getRoute path blk diff --git a/utils/restart.sh b/utils/restart.sh new file mode 100644 --- /dev/null +++ b/utils/restart.sh @@ -0,0 +1,24 @@ +#! /bin/sh + +# A shell script to restart mighty: +# * The current mighty is retired +# * A new mighty is started + +# Assuming this directory contains everything. +MIGHTY_PATH=/usr/local/mighty +# % ls -1 /usr/local/mighty +# conf +# mighty* +# mightyctl* +# restart.sh* +# route +# webroot/ + +# Assuming that the following entries is included in "route" +# /.well-known/acme-challenge/ -> /usr/local/mighty/webroot/.well-known/acme-challenge/ + +# This script can be used with "certbot renew" +# % sudo certbot renew --webroot -w /usr/local/mighty/webroot --deploy-hook /usr/local/mighty/restart.sh + +${MIGHTY_PATH}/mightyctl retire +${MIGHTY_PATH}/mighty ${MIGHTY_PATH}/conf ${MIGHTY_PATH}/route +RTS -N2