diff -pruN 3.4.6-1/cbits/setcap.c 4.0.2-1/cbits/setcap.c --- 3.4.6-1/cbits/setcap.c 1970-01-01 00:00:00.000000000 +0000 +++ 4.0.2-1/cbits/setcap.c 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,53 @@ +#if defined(__linux__) +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "Rts.h" + +void set_capabilities (uint32_t cap) { + cap_user_header_t header = malloc(sizeof(*header)); + header->version = _LINUX_CAPABILITY_VERSION_3; + header->pid = 0; + + cap_user_data_t data = malloc(sizeof(*data)); + data->effective = cap; + data->permitted = cap; + data->inheritable = 0; + + capset(header,data); + + free(header); + free(data); +} + +void handler(int signum) { + uint32_t cap = 1 << CAP_NET_BIND_SERVICE; + set_capabilities (cap); +} + +void FlagDefaultsHook () { + if (geteuid() == 0) { + prctl(PR_SET_SECUREBITS, SECBIT_KEEP_CAPS, 0L, 0L, 0L); + + struct sigaction sa; + memset(&sa, 0, sizeof(sa)); + sa.sa_handler = handler; + sa.sa_flags = SA_RESTART; + sigaction(SIGUSR1, &sa, NULL); + } +} + +void send_signal (int tid, int sig) { + int tgid = getpid(); + syscall(SYS_tgkill, tgid, tid, sig); +} +#else +void send_signal (int tid, int sig) {} +#endif diff -pruN 3.4.6-1/conf/example.conf 4.0.2-1/conf/example.conf --- 3.4.6-1/conf/example.conf 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/conf/example.conf 2001-09-09 01:46:40.000000000 +0000 @@ -3,14 +3,15 @@ Port: 80 # IP address or "*" Host: * Debug_Mode: Yes # Yes or No -# If available, "nobody" is much more secure for User:. +# If available, "nobody" is much more secure for User: User: root -# If available, "nobody" is much more secure for Group:. +# If available, "nobody" is much more secure for Group: Group: root Pid_File: /var/run/mighty.pid Report_File: /tmp/mighty_report Logging: Yes # Yes or No -Log_File: /var/log/mighty # The directory must be writable by User: +# The directory must be writable by User: +Log_File: /var/log/mighty Log_File_Size: 16777216 # bytes Log_Backup_Number: 10 Index_File: index.html @@ -19,11 +20,19 @@ Status_File_Dir: /usr/local/share/mighty Connection_Timeout: 30 # seconds Proxy_Timeout: 0 # seconds, 0 is default of http-client, ie 30 seconds Fd_Cache_Duration: 10 # seconds -# Server_Name: Mighttpd/3.x.y +# 0 is HTTP only +# 1 is HTTPS only +# 2 is for both HTTP and HTTPs +# 3 is for HTTP, HTTPs and QUIC(HTTP/3) +Service: 0 Tls_Port: 443 -Tls_Cert_File: cert.pem # should change this with an absolute path +# should change this with an absolute path +Tls_Cert_File: cert.pem # should change this with comma-separated absolute paths Tls_Chain_Files: chain.pem -# Currently, Tls_Key_File must not be encrypted. +# Currently, Tls_Key_File must not be encrypted Tls_Key_File: privkey.pem # should change this with an absolute path -Service: 0 # 0 is HTTP only, 1 is HTTPS only, 2 is both +Quic_Addr: 127.0.0.1,::1 +Quic_Port: 443 +#Quic_Debug_Dir: /var/log/mighy/quic-debug/ +#Quic_Qlog_Dir: /varlog/mighty/qlog/ diff -pruN 3.4.6-1/debian/changelog 4.0.2-1/debian/changelog --- 3.4.6-1/debian/changelog 2020-06-17 00:56:31.000000000 +0000 +++ 4.0.2-1/debian/changelog 2022-08-02 19:02:22.000000000 +0000 @@ -1,3 +1,14 @@ +mighttpd2 (4.0.2-1) unstable; urgency=medium + + [ Ilias Tsitsimpis ] + * Declare compliance with Debian policy 4.6.1 + * Remove developer Kristoffer H Rose from Uploaders. + + [ Clint Adams ] + * New upstream version. + + -- Clint Adams Tue, 02 Aug 2022 15:02:22 -0400 + mighttpd2 (3.4.6-1) unstable; urgency=medium * New upstream version. diff -pruN 3.4.6-1/debian/control 4.0.2-1/debian/control --- 3.4.6-1/debian/control 2020-06-17 00:56:31.000000000 +0000 +++ 4.0.2-1/debian/control 2022-08-02 19:02:22.000000000 +0000 @@ -21,10 +21,16 @@ Build-Depends: debhelper (>= 10), libghc-http-types-prof, libghc-network-dev, libghc-resourcet-dev, + libghc-resourcet-prof, + libghc-split-dev, + libghc-split-prof, libghc-streaming-commons-dev, libghc-time-dev, libghc-transformers-dev, libghc-unix-time-dev, + libghc-unix-time-prof, + libghc-unliftio-dev, + libghc-unliftio-prof, libghc-unordered-containers-dev, libghc-wai-dev (>= 3.2), libghc-wai-dev (<< 3.3), @@ -32,15 +38,19 @@ Build-Depends: debhelper (>= 10), libghc-wai-app-file-cgi-dev (>= 3.1.9), libghc-wai-app-file-cgi-dev (<< 3.2), libghc-wai-app-file-cgi-prof, - libghc-warp-dev (>= 3.3), + libghc-warp-dev (>= 3.3.15), libghc-warp-dev (<< 3.4), libghc-warp-prof, libghc-http-client-dev (>= 0.5), libghc-old-locale-dev, - libghc-tls-dev, - libghc-wai-http2-extra-dev (>= 0.1), + libghc-old-locale-prof, + libghc-time-manager-dev, + libghc-time-manager-prof, + libghc-wai-http2-extra-dev (>= 0.1.3), + libghc-wai-http2-extra-prof, libghc-wai-logger-dev (>= 2.3.0), libghc-wai-logger-prof, + libghc-warp-dev (>= 3.3.13), libghc-hspec-dev (>= 1.3), Build-Depends-Indep: ghc-doc, libghc-async-doc, @@ -53,14 +63,16 @@ Build-Depends-Indep: ghc-doc, libghc-http-types-doc, libghc-network-doc, libghc-resourcet-doc, + libghc-split-doc, libghc-streaming-commons-doc, libghc-unix-time-doc, + libghc-unliftio-doc, libghc-unordered-containers-doc, libghc-wai-doc, libghc-wai-app-file-cgi-doc, libghc-warp-doc, -Standards-Version: 4.5.0 -Homepage: http://www.mew.org/~kazu/proj/mighttpd/ +Standards-Version: 4.6.1 +Homepage: https://kazu-yamamoto.github.io/mighttpd2/ Vcs-Browser: https://salsa.debian.org/haskell-team/DHG_packages/tree/master/p/mighttpd2 Vcs-Git: https://salsa.debian.org/haskell-team/DHG_packages.git [p/mighttpd2] diff -pruN 3.4.6-1/mighttpd2.cabal 4.0.2-1/mighttpd2.cabal --- 3.4.6-1/mighttpd2.cabal 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/mighttpd2.cabal 2001-09-09 01:46:40.000000000 +0000 @@ -1,5 +1,5 @@ Name: mighttpd2 -Version: 3.4.6 +Version: 4.0.2 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -9,15 +9,24 @@ Description: High performance files and CGI on WAI/warp. Reverse proxy functionality is also provided to connect web applications behind. -Homepage: http://www.mew.org/~kazu/proj/mighttpd/ +Homepage: https://kazu-yamamoto.github.io/mighttpd2/ Category: Network, Web Cabal-Version: >= 1.10 Build-Type: Simple Data-Dir: conf Data-Files: example.conf example.route +Extra-Source-Files: Program/Mighty/Dhall/Option.dhall Flag tls - Description: Support http over tls (https). + Description: Support HTTP over TLS (HTTPS). + Default: False + +Flag quic + Description: Support HTTP over QUIC (HTTP/3). + Default: False + +Flag dhall + Description: Support Dhall Default: False Library @@ -33,6 +42,8 @@ Library Program.Mighty.Resource Program.Mighty.Route Program.Mighty.Signal + Program.Mighty.Dhall.Option + Program.Mighty.Types Build-Depends: base >= 4.9 && < 5 , array , async @@ -50,14 +61,20 @@ Library , parsec >= 3 , resourcet , streaming-commons + , split + , text , unix , unix-time , unordered-containers , wai >= 3.2 && < 3.3 , wai-app-file-cgi >= 3.1.9 && < 3.2 - , warp >= 3.3 && < 3.4 + , warp >= 3.3.15 && < 3.4 + , unliftio if impl(ghc >= 8) Default-Extensions: Strict StrictData + if flag(dhall) + Cpp-Options: -DDHALL + Build-Depends: dhall Executable mighty Default-Language: Haskell2010 @@ -68,7 +85,18 @@ Executable mighty Cpp-Options: -DHTTP_OVER_TLS Build-Depends: async , tls-session-manager >= 0.0.2.0 - Build-Depends: base >= 4.0 && < 5 + if flag(quic) + Cpp-Options: -DHTTP_OVER_QUIC + Build-Depends: async + , base16-bytestring + if os(linux) + C-sources: cbits/setcap.c + Cpp-Options: -DDROP_EXCEPT_BIND + + if flag(dhall) + Cpp-Options: -DDHALL + Build-Depends: dhall + Build-Depends: base >= 4.9 && < 5 , bytestring , directory , filepath @@ -81,14 +109,18 @@ Executable mighty , transformers , unix , streaming-commons + , time-manager , wai >= 3.2 && < 3.3 , wai-app-file-cgi >= 3.1.9 && < 3.2 , wai-logger >= 2.3.0 - , warp >= 3.3 && < 3.4 - , wai-http2-extra >= 0.1 + , warp >= 3.3.13 && < 3.4 + , wai-http2-extra >= 0.1.3 if flag(tls) Build-Depends: tls - , warp-tls >= 3.2.7 && < 3.3 + , warp-tls >= 3.2.12 && < 3.4 + if flag(quic) + Build-Depends: quic + , warp-quic Other-Modules: Server WaiApp Paths_mighttpd2 @@ -100,7 +132,7 @@ Executable mighty-mkindex HS-Source-Dirs: utils, src Main-Is: mkindex.hs GHC-Options: -Wall - Build-Depends: base >= 4 && < 5 + Build-Depends: base >= 4.9 && < 5 , directory , old-locale , time @@ -111,7 +143,7 @@ Executable mightyctl HS-Source-Dirs: utils, src Main-Is: mightyctl.hs GHC-Options: -Wall - Build-Depends: base >= 4 && < 5 + Build-Depends: base >= 4.9 && < 5 , unix , mighttpd2 if impl(ghc >= 8) @@ -124,15 +156,18 @@ Test-Suite spec Type: exitcode-stdio-1.0 Other-Modules: ConfigSpec RouteSpec - Build-Depends: base >= 4 && < 5 + Build-Depends: base >= 4.9 && < 5 , hspec >= 1.3 , mighttpd2 , http-client >= 0.5 if flag(tls) Build-Depends: tls - , warp-tls >= 3.2.7 && < 3.3 + , warp-tls >= 3.2.12 && < 3.4 if impl(ghc >= 8) Default-Extensions: Strict StrictData + if flag(dhall) + Cpp-Options: -DDHALL + Build-Depends: dhall Source-Repository head Type: git diff -pruN 3.4.6-1/Program/Mighty/Config.hs 4.0.2-1/Program/Mighty/Config.hs --- 3.4.6-1/Program/Mighty/Config.hs 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/Program/Mighty/Config.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,86 +1,152 @@ -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, OverloadedStrings #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} module Program.Mighty.Config ( -- * Parsing a configuration file. parseOption +#ifdef DHALL + , parseOptionDhall +#else + , Natural +#endif -- * Creating 'Option'. , defaultOption -- * Types , Option(..) ) where -#if __GLASGOW_HASKELL__ < 709 -import Control.Applicative hiding (many,optional,(<|>)) -#endif -import Program.Mighty.Parser +import Data.List.Split (splitOn) import Text.Parsec import Text.Parsec.ByteString.Lazy +#ifdef DHALL +import Data.String (fromString) +import qualified Data.Text as T +import Dhall(Generic, Natural, input, auto, FromDhall) +import qualified Program.Mighty.Dhall.Option as Do + +#else +import Program.Mighty.Types +#endif + +import Program.Mighty.Parser ---------------------------------------------------------------- +data Option = Option { + opt_port :: Natural + , opt_host :: String + , opt_debug_mode :: Bool + , opt_user :: String + , opt_group :: String + , opt_pid_file :: FilePath + , opt_report_file :: FilePath + , opt_logging :: Bool + , opt_log_file :: FilePath + , opt_log_file_size :: Natural + , opt_log_backup_number :: Natural + , opt_index_file :: FilePath + , opt_index_cgi :: FilePath + , opt_status_file_dir :: FilePath + , opt_connection_timeout :: Natural + , opt_proxy_timeout :: Natural + , opt_fd_cache_duration :: Natural + , opt_service :: Natural + , opt_tls_port :: Natural + , opt_tls_cert_file :: FilePath + , opt_tls_chain_files :: FilePath + , opt_tls_key_file :: FilePath + , opt_quic_port :: Natural + , opt_quic_addr :: [String] + , opt_quic_debug_dir :: Maybe FilePath + , opt_quic_qlog_dir :: Maybe FilePath + , opt_server_name :: String + , opt_routing_file :: Maybe String +#ifdef DHALL +} deriving (Eq, Show, Generic) +#else +} deriving (Eq, Show) +#endif + +#ifdef DHALL +instance FromDhall Option +#endif + -- | Getting a default 'Option'. -defaultOption :: String -- ^ A default server name (e.g. \"Mighttpd/3.0.0\") - -> Option -defaultOption svrnm = Option { +defaultOption :: Option +defaultOption = Option { opt_port = 8080 , opt_host = "*" , opt_debug_mode = True - , opt_user = "root" + , opt_user = "root" , opt_group = "root" - , opt_pid_file = "/var/run/mighty.pid" + , 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_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_server_name = svrnm - , opt_routing_file = Nothing + , opt_proxy_timeout = 0 + , opt_fd_cache_duration = 10 + , opt_service = 0 , opt_tls_port = 443 - , opt_tls_cert_file = "cert.pem" + , opt_tls_cert_file = "cert.pem" , opt_tls_chain_files = "chain.pem" - , opt_tls_key_file = "privkey.pem" - , opt_service = 0 + , opt_tls_key_file = "privkey.pem" + , opt_quic_port = 443 + , opt_quic_addr = ["127.0.0.1"] + , opt_quic_debug_dir = Nothing + , opt_quic_qlog_dir = Nothing + , opt_server_name = "Dummy" + , opt_routing_file = Nothing } -data Option = Option { - opt_port :: !Int - , opt_host :: !String - , opt_debug_mode :: !Bool - , opt_user :: !String - , opt_group :: !String - , opt_pid_file :: !FilePath - , opt_report_file :: !FilePath - , opt_logging :: !Bool - , opt_log_file :: !FilePath - , opt_log_file_size :: !Int - , opt_log_backup_number :: !Int - , opt_index_file :: !FilePath - , opt_index_cgi :: !FilePath - , opt_status_file_dir :: !FilePath - , opt_connection_timeout :: !Int - , opt_proxy_timeout :: !Int - , opt_fd_cache_duration :: !Int - , opt_server_name :: !String - , opt_routing_file :: !(Maybe FilePath) - , opt_tls_port :: !Int - , opt_tls_cert_file :: !FilePath - , opt_tls_chain_files :: !FilePath - , opt_tls_key_file :: !FilePath - , opt_service :: !Int -} deriving (Eq,Show) - ---------------------------------------------------------------- - -- | Parsing a configuration file to get an 'Option'. -parseOption :: FilePath -> String -> IO Option -parseOption file svrnm = makeOpt (defaultOption svrnm) <$> parseConfig file +parseOption :: FilePath -> IO Option +parseOption file = makeOpt defaultOption <$> parseConfig file + +#ifdef DHALL +parseOptionDhall :: FilePath -> IO Option +parseOptionDhall = fmap optionFromDhall . input auto . fromString + +optionFromDhall :: Do.Option -> Option +optionFromDhall o = Option + { opt_port = Do.port o + , opt_host = T.unpack $ Do.host o + , opt_debug_mode = Do.debugMode o + , opt_user = T.unpack $ Do.user o + , opt_group = T.unpack $ Do.group o + , opt_pid_file = T.unpack $ Do.pidFile o + , opt_report_file = T.unpack $ Do.reportFile o + , opt_logging = Do.logging o + , opt_log_file = T.unpack $ Do.logFile o + , opt_log_file_size = Do.logFileSize o + , opt_log_backup_number = Do.logBackupNumber o + , opt_index_file = T.unpack $ Do.indexFile o + , opt_index_cgi = T.unpack $ Do.indexCgi o + , opt_status_file_dir = T.unpack $ Do.statusFileDir o + , opt_connection_timeout = Do.connectionTimeout o + , opt_proxy_timeout = Do.proxyTimeout o + , opt_fd_cache_duration = Do.fdCacheDuration o + , opt_service = Do.service o + , opt_tls_port = Do.tlsPort o + , opt_tls_cert_file = T.unpack $ Do.tlsCertFile o + , opt_tls_chain_files = T.unpack $ Do.tlsChainFiles o + , opt_tls_key_file = T.unpack $ Do.tlsKeyFile o + , opt_quic_addr = T.unpack <$> Do.quicAddr o + , opt_quic_port = Do.quicPort o + , opt_quic_debug_dir = T.unpack <$> Do.quicDebugDir o + , opt_quic_qlog_dir = T.unpack <$> Do.quicQlogDir o + , opt_server_name = "Dummy" + , opt_routing_file = Nothing +} +#endif ---------------------------------------------------------------- @@ -103,13 +169,17 @@ makeOpt def conf = Option { , opt_connection_timeout = get "Connection_Timeout" opt_connection_timeout , opt_proxy_timeout = get "Proxy_Timeout" opt_proxy_timeout , opt_fd_cache_duration = get "Fd_Cache_Duration" opt_fd_cache_duration - , opt_server_name = get "Server_Name" opt_server_name - , opt_routing_file = Nothing + , opt_service = get "Service" opt_service , opt_tls_port = get "Tls_Port" opt_tls_port , opt_tls_cert_file = get "Tls_Cert_File" opt_tls_cert_file , opt_tls_chain_files = get "Tls_Chain_Files" opt_tls_chain_files , opt_tls_key_file = get "Tls_Key_File" opt_tls_key_file - , opt_service = get "Service" opt_service + , opt_quic_addr = get "Quic_Addr" opt_quic_addr + , opt_quic_port = get "Quic_Port" opt_quic_port + , opt_quic_debug_dir = get "Quic_Debug_Dir" opt_quic_debug_dir + , opt_quic_qlog_dir = get "Quic_Qlog_Dir" opt_quic_qlog_dir + , opt_server_name = "Dummy" + , opt_routing_file = Nothing } where get k func = maybe (func def) fromConf $ lookup k conf @@ -118,13 +188,13 @@ makeOpt def conf = Option { type Conf = (String, ConfValue) -data ConfValue = CV_Int Int | CV_Bool Bool | CV_String String deriving (Eq,Show) +data ConfValue = CV_Natural Natural | CV_Bool Bool | CV_String String deriving (Eq,Show) class FromConf a where fromConf :: ConfValue -> a -instance FromConf Int where - fromConf (CV_Int n) = n +instance FromConf Natural where + fromConf (CV_Natural n) = n fromConf _ = error "fromConf int" instance FromConf Bool where @@ -135,6 +205,15 @@ instance FromConf String where fromConf (CV_String s) = s fromConf _ = error "fromConf string" +instance FromConf (Maybe String) where + fromConf (CV_String "") = Nothing + fromConf (CV_String s) = Just s + fromConf _ = error "fromConf string" + +instance FromConf [String] where + fromConf (CV_String s) = splitOn "," s + fromConf _ = error "fromConf string" + ---------------------------------------------------------------- parseConfig :: FilePath -> IO [Conf] @@ -157,15 +236,15 @@ sep :: Parser () sep = () <$ char ':' *> spcs value :: Parser ConfValue -value = choice [try cv_int, try cv_bool, cv_string] +value = choice [try cv_natural, try cv_bool, cv_string] -- Trailing should be included in try to allow IP addresses. -cv_int :: Parser ConfValue -cv_int = CV_Int . read <$> many1 digit <* trailing +cv_natural :: Parser ConfValue +cv_natural = CV_Natural . read <$> many1 digit <* trailing cv_bool :: Parser ConfValue cv_bool = CV_Bool True <$ string "Yes" <* trailing <|> - CV_Bool False <$ string "No" <* trailing + CV_Bool False <$ string "No" <* trailing cv_string :: Parser ConfValue cv_string = CV_String <$> many (noneOf " \t\n") <* trailing diff -pruN 3.4.6-1/Program/Mighty/Dhall/Option.dhall 4.0.2-1/Program/Mighty/Dhall/Option.dhall --- 3.4.6-1/Program/Mighty/Dhall/Option.dhall 1970-01-01 00:00:00.000000000 +0000 +++ 4.0.2-1/Program/Mighty/Dhall/Option.dhall 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,27 @@ +{ port : Natural +, host : Text +, debugMode : Bool +, user : Text +, group : Text +, pidFile : Text +, reportFile : Text +, logging : Bool +, logFile : Text +, logFileSize : Natural +, logBackupNumber : Natural +, indexFile : Text +, indexCgi : Text +, statusFileDir : Text +, connectionTimeout : Natural +, proxyTimeout : Natural +, fdCacheDuration : Natural +, service : Natural +, tlsPort : Natural +, tlsCertFile : Text +, tlsChainFiles : Text +, tlsKeyFile : Text +, quicPort : Natural +, quicAddr : List Text +, quicDebugDir : Optional Text +, quicQlogDir : Optional Text +} \ No newline at end of file diff -pruN 3.4.6-1/Program/Mighty/Dhall/Option.hs 4.0.2-1/Program/Mighty/Dhall/Option.hs --- 3.4.6-1/Program/Mighty/Dhall/Option.hs 1970-01-01 00:00:00.000000000 +0000 +++ 4.0.2-1/Program/Mighty/Dhall/Option.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} + +module Program.Mighty.Dhall.Option where + +#ifdef DHALL +import Dhall.TH + +Dhall.TH.makeHaskellTypes + [ SingleConstructor "Option" "MakeOption" "./Program/Mighty/Dhall/Option.dhall" + ] +#endif diff -pruN 3.4.6-1/Program/Mighty/Parser.hs 4.0.2-1/Program/Mighty/Parser.hs --- 3.4.6-1/Program/Mighty/Parser.hs 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/Program/Mighty/Parser.hs 2001-09-09 01:46:40.000000000 +0000 @@ -14,14 +14,11 @@ module Program.Mighty.Parser ( , comment ) where -#if __GLASGOW_HASKELL__ < 709 -import Control.Applicative hiding (many,(<|>)) -#endif -import Control.Exception import qualified Data.ByteString.Lazy.Char8 as BL import System.IO import Text.Parsec import Text.Parsec.ByteString.Lazy +import UnliftIO.Exception -- $setup -- >>> import Data.Either diff -pruN 3.4.6-1/Program/Mighty/Process.hs 4.0.2-1/Program/Mighty/Process.hs --- 3.4.6-1/Program/Mighty/Process.hs 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/Program/Mighty/Process.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,13 +1,10 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Program.Mighty.Process ( getMightyPid ) where -#if __GLASGOW_HASKELL__ < 709 -import Control.Applicative -#endif import Control.Monad.Trans.Resource (runResourceT) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS @@ -17,7 +14,6 @@ import qualified Data.Conduit.List as CL import Data.Conduit.Process import Data.Function import Data.List -import Data.Ord import System.Posix.Types ---------------------------------------------------------------- @@ -65,7 +61,7 @@ findParent ps = deleteAloneChild $ maste candidates = map head $ filter (\xs -> length xs == 1) -- master is alone $ groupBy ((==) `on` ppid) - $ sortBy (comparing ppid) rest + $ sortOn ppid rest deleteAloneChild :: [PsResult] -> [PsResult] @@ -79,7 +75,7 @@ deleteAloneChild (p:ps) = p : deleteAlon -- | Getting the process id of a running Mighty. getMightyPid :: IO [ProcessID] -getMightyPid = (map pid . findParent) <$> runPS +getMightyPid = map pid . findParent <$> runPS ---------------------------------------------------------------- diff -pruN 3.4.6-1/Program/Mighty/Report.hs 4.0.2-1/Program/Mighty/Report.hs --- 3.4.6-1/Program/Mighty/Report.hs 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/Program/Mighty/Report.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,10 +1,10 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module Program.Mighty.Report ( Reporter , initReporter - , finReporter , report , reportDo , warpHandler @@ -14,8 +14,6 @@ module Program.Mighty.Report ( #if __GLASGOW_HASKELL__ < 709 import Control.Applicative #endif -import Control.Exception -import qualified Control.Exception as E (catch) import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS @@ -23,65 +21,46 @@ import Data.UnixTime import GHC.IO.Exception (IOErrorType(..)) import Network.Wai import Network.Wai.Handler.Warp (InvalidRequest) -import Network.Wai.Handler.Warp.Internal (TimeoutThread(..)) import System.IO import System.IO.Error (ioeGetErrorType) import System.Posix (getProcessID) +import UnliftIO.Exception import Program.Mighty.ByteString data Method = FileOnly | FileAndStdout deriving Eq -data Reporter = Reporter Method Handle +data Reporter = Reporter Method FilePath -initReporter :: Bool -> FilePath -> IO (Either SomeException Reporter) -initReporter debug reportFile = try $ Reporter method <$> openFile reportFile AppendMode +initReporter :: Bool -> FilePath -> Reporter +initReporter debug reportFile = Reporter method reportFile where method | debug = FileAndStdout | otherwise = FileOnly -finReporter :: Reporter -> IO () -finReporter (Reporter _ rpthdl) = hClose rpthdl - report :: Reporter -> ByteString -> IO () -report (Reporter method rpthdl) msg = handle (\(SomeException _) -> return ()) $ do +report (Reporter method reportFile) msg = handle (\(SomeException _) -> return ()) $ do pid <- BS.pack . show <$> getProcessID tm <- getUnixTime >>= formatUnixTime "%d %b %Y %H:%M:%S" let logmsg = BS.concat [tm, ": pid = ", pid, ": ", msg, "\n"] - BS.hPutStr rpthdl logmsg - hFlush rpthdl + BS.appendFile reportFile logmsg when (method == FileAndStdout) $ BS.putStr logmsg ---------------------------------------------------------------- reportDo :: Reporter -> IO () -> IO () -reportDo rpt act = act `E.catch` warpHandler rpt Nothing +reportDo rpt act = act `catchAny` warpHandler rpt Nothing ---------------------------------------------------------------- warpHandler :: Reporter -> Maybe Request -> SomeException -> IO () -warpHandler rpt _ e = throwIO e `catches` handlers - where - handlers = [Handler ah, Handler th, Handler ih, Handler oh, Handler sh] - ah :: AsyncException -> IO () - ah ThreadKilled = norecode - ah x = recode x - th :: TimeoutThread -> IO () - th TimeoutThread = norecode - ih :: InvalidRequest -> IO () - ih _ = norecode - oh :: IOException -> IO () - oh x - | et `elem` ignEts = norecode - | otherwise = recode x - where - et = ioeGetErrorType x - ignEts = [ResourceVanished, InvalidArgument] - sh :: SomeException -> IO () - sh x = recode x - norecode = return () - recode :: Exception e => e -> IO () - recode = report rpt . bshow +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 ---------------------------------------------------------------- diff -pruN 3.4.6-1/Program/Mighty/Resource.hs 4.0.2-1/Program/Mighty/Resource.hs --- 3.4.6-1/Program/Mighty/Resource.hs 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/Program/Mighty/Resource.hs 2001-09-09 01:46:40.000000000 +0000 @@ -6,12 +6,8 @@ module Program.Mighty.Resource ( , unlimit ) where -#if __GLASGOW_HASKELL__ < 709 -import Control.Applicative -#endif -import Control.Exception -import Control.Monad import System.Posix +import UnliftIO.Exception ---------------------------------------------------------------- @@ -24,12 +20,15 @@ amIrootUser = (== 0) <$> getRealUserID -- | Setting user and group. setGroupUser :: String -- ^ User -> String -- ^ Group - -> IO () + -> IO Bool setGroupUser user group = do root <- amIrootUser - when root $ do + if root then do getGroupEntryForName group >>= setGroupID . groupID getUserEntryForName user >>= setUserID . userID + return True + else + return False ---------------------------------------------------------------- diff -pruN 3.4.6-1/Program/Mighty/Route.hs 4.0.2-1/Program/Mighty/Route.hs --- 3.4.6-1/Program/Mighty/Route.hs 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/Program/Mighty/Route.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,5 +1,6 @@ -{-# LANGUAGE OverloadedStrings, TupleSections #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} module Program.Mighty.Route ( -- * Paring a routing file @@ -19,13 +20,13 @@ module Program.Mighty.Route ( , writeRouteDBRef ) where -#if __GLASGOW_HASKELL__ < 709 -import Control.Applicative hiding (many,(<|>)) -#endif import Control.Monad import Data.ByteString import qualified Data.ByteString.Char8 as BS import Data.IORef +#ifdef DHALL +import GHC.Natural (Natural) +#endif import Network.Wai.Application.Classic import Text.Parsec import Text.Parsec.ByteString.Lazy @@ -39,7 +40,12 @@ type Src = Path -- | A physical path in a file system. 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 diff -pruN 3.4.6-1/Program/Mighty/Types.hs 4.0.2-1/Program/Mighty/Types.hs --- 3.4.6-1/Program/Mighty/Types.hs 1970-01-01 00:00:00.000000000 +0000 +++ 4.0.2-1/Program/Mighty/Types.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Program.Mighty.Types (Natural, naturalToInt) where + +#ifdef DHALL +import GHC.Natural (Natural, naturalToWord) + +naturalToInt :: Natural -> Int +naturalToInt = fromIntegral . naturalToWord +#else +type Natural = Int + +naturalToInt :: Natural -> Int +naturalToInt = id +#endif diff -pruN 3.4.6-1/Program/Mighty.hs 4.0.2-1/Program/Mighty.hs --- 3.4.6-1/Program/Mighty.hs 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/Program/Mighty.hs 2001-09-09 01:46:40.000000000 +0000 @@ -12,6 +12,7 @@ module Program.Mighty ( , module Program.Mighty.Process , module Program.Mighty.Resource , module Program.Mighty.Signal + , module Program.Mighty.Types ) where import Program.Mighty.ByteString @@ -23,3 +24,4 @@ import Program.Mighty.Report import Program.Mighty.Resource import Program.Mighty.Route import Program.Mighty.Signal +import Program.Mighty.Types diff -pruN 3.4.6-1/src/Mighty.hs 4.0.2-1/src/Mighty.hs --- 3.4.6-1/src/Mighty.hs 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/src/Mighty.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,10 +1,15 @@ -{-# LANGUAGE OverloadedStrings, CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Main where -#ifndef HTTP_OVER_TLS +#ifndef HTTP_OVER_QUIC import Control.Monad (when) #endif + +#ifdef DHALL +import Data.List (isSuffixOf) +#endif import Data.Version (showVersion) import Network.Wai.Application.Classic hiding (()) import System.Directory (getCurrentDirectory) @@ -34,8 +39,8 @@ main = do checkTLS opt let reportFile = reportFileName opt debug = opt_debug_mode opt - rpt <- initReporter debug reportFile >>= checkReporter reportFile - let run = server opt rpt route + rpt = initReporter debug reportFile + run = server opt rpt route if debug then run else background opt run where getOptRoute = getArgs >>= eachCase @@ -43,8 +48,9 @@ main = do eachCase args | n == 0 = do root <- amIrootUser - let opt | root = (defaultOption svrnm) { opt_port = 80 } - | otherwise = defaultOption svrnm + let opt0 = defaultOption { opt_server_name = svrnm } + let opt | root = opt0 { opt_port = 80 } + | otherwise = opt0 dir <- getCurrentDirectory let dst = fromString . addTrailingPathSeparator $ dir route = [Block ["*"] [RouteFile "/" dst]] @@ -52,9 +58,18 @@ main = do | n == 2 = do let config_file = args !! 0 routing_file <- getAbsoluteFile (args !! 1) - opt <- parseOption config_file svrnm +#ifdef DHALL + let isDhall = ".dhall" `Data.List.isSuffixOf` config_file + opt <- if isDhall + then parseOptionDhall config_file + else parseOption config_file +#else + opt <- parseOption config_file +#endif route <- parseRoute routing_file defaultDomain defaultPort - let opt' = opt {opt_routing_file = Just routing_file} + let opt' = opt { opt_routing_file = Just routing_file + , opt_server_name = svrnm + } return (opt',route) | otherwise = do hPutStrLn stderr "Usage: mighty" @@ -67,14 +82,15 @@ main = do | otherwise = do dir <- getCurrentDirectory return $ dir normalise file - checkReporter _ (Right rpt) = return rpt - checkReporter reportFile (Left e) = do - hPutStrLn stderr $ reportFile ++ " is not writable" - hPrint stderr e - exitFailure #ifdef HTTP_OVER_TLS +#ifdef HTTP_OVER_QUIC checkTLS _ = return () #else + checkTLS opt = when (opt_service opt > 2) $ do + hPutStrLn stderr "This mighty does not support QUIC" + exitFailure +#endif +#else checkTLS opt = when (opt_service opt > 1) $ do hPutStrLn stderr "This mighty does not support TLS" exitFailure diff -pruN 3.4.6-1/src/Server.hs 4.0.2-1/src/Server.hs --- 3.4.6-1/src/Server.hs 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/src/Server.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,4 +1,6 @@ -{-# LANGUAGE OverloadedStrings, CPP, BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} module Server (server, defaultDomain, defaultPort) where @@ -6,13 +8,9 @@ import Control.Concurrent (runInUnboundT import Control.Exception (try) import Control.Monad (unless, when) import qualified Data.ByteString.Char8 as BS -#ifdef HTTP_OVER_TLS -import Data.Char (isSpace) -import Data.List (dropWhile, dropWhileEnd, break) -#endif import Data.Streaming.Network (bindPortTCP) -import Network.Socket (Socket, close) import qualified Network.HTTP.Client as H +import Network.Socket (Socket, close) import Network.Wai.Application.Classic hiding (()) import Network.Wai.Handler.Warp import Network.Wai.Logger @@ -21,6 +19,7 @@ import System.IO import System.IO.Error (ioeGetErrorString) import System.Posix (exitImmediately, Handler(..), getProcessID, setFileMode) import System.Posix.Signals (sigCHLD) +import qualified System.TimeManager as T import Program.Mighty import WaiApp @@ -28,12 +27,32 @@ import WaiApp import qualified Network.Wai.Middleware.Push.Referer as P #ifdef HTTP_OVER_TLS -import Control.Concurrent.Async (concurrently) -import Control.Monad (void) -import Network.Wai.Handler.WarpTLS +import Control.Concurrent.Async (concurrently_) +import Data.Char (isSpace) +import Data.List (dropWhileEnd) +import Network.TLS (Credentials(..),SessionManager) +import qualified Network.TLS as TLS import Network.TLS.SessionManager +import qualified Network.TLS.SessionManager as SM +import Network.Wai.Handler.WarpTLS +#ifdef HTTP_OVER_QUIC +import Control.Concurrent.Async (mapConcurrently_) +import Data.Bits +import Data.ByteString (ByteString) +import Data.List (find) +import Data.Maybe (fromJust) +import qualified Network.QUIC.Internal as Q +import Network.Wai.Handler.WarpQUIC +#ifdef DROP_EXCEPT_BIND +import Control.Monad (forM_) +import Foreign.C.Types (CInt(..)) +import System.Directory (listDirectory) +import System.Posix.Signals (sigUSR1) +#endif +#endif #else -data TLSSettings = TLSSettings +data Credentials +data SessionManager #endif ---------------------------------------------------------------- @@ -41,13 +60,13 @@ data TLSSettings = TLSSettings defaultDomain :: Domain defaultDomain = "localhost" -defaultPort :: Int +defaultPort :: Natural defaultPort = 80 openFileNumber :: Integer openFileNumber = 10000 -logBufferSize :: Int +logBufferSize :: Natural logBufferSize = 4 * 1024 * 10 managerNumber :: Int @@ -65,8 +84,18 @@ server opt rpt route = reportDo rpt $ do svc <- openService opt unless debug writePidFile rdr <- newRouteDBRef route - tlsSetting <- getTlsSetting opt - setGroupUser (opt_user opt) (opt_group opt) + tmgr <- T.initialize (naturalToInt (opt_connection_timeout opt) * 1000000) +#ifdef HTTP_OVER_TLS + mcred <- Just <$> loadCredentials opt + smgr <- Just <$> SM.newSessionManager SM.defaultConfig { dbMaxSize = 1000 } +#else + let mcred = Nothing + smgr = Nothing +#endif + _changed <- setGroupUser (opt_user opt) (opt_group opt) +#ifdef DROP_EXCEPT_BIND + when _changed dropExceptBind +#endif logCheck logtype (zdater,_) <- clockDateCacher ap <- initLogger FromSocket logtype zdater @@ -77,9 +106,8 @@ server opt rpt route = reportDo rpt $ do setHandlers opt rpt svc remover rdr report rpt "Mighty started" - runInUnboundThread $ mighty opt rpt svc lgr pushlgr mgr rdr tlsSetting + runInUnboundThread $ mighty opt rpt svc lgr pushlgr mgr rdr mcred smgr tmgr report rpt "Mighty retired" - finReporter rpt remover exitSuccess where @@ -95,12 +123,12 @@ server opt rpt route = reportDo rpt $ do logspec = FileLogSpec { log_file = opt_log_file opt , log_file_size = fromIntegral $ opt_log_file_size opt - , log_backup_number = opt_log_backup_number opt + , log_backup_number = naturalToInt $ opt_log_backup_number opt } logtype | not (opt_logging opt) = LogNone - | debug = LogStdout logBufferSize - | otherwise = LogFile logspec logBufferSize + | debug = LogStdout $ naturalToInt logBufferSize + | otherwise = LogFile logspec $ naturalToInt logBufferSize setHandlers :: Option -> Reporter -> Service -> LogRemover -> RouteDBRef -> IO () setHandlers opt rpt svc remover rdr = do @@ -112,41 +140,34 @@ setHandlers opt rpt svc remover rdr = do where stopHandler = Catch $ do report rpt "Mighty finished" - finReporter rpt closeService svc remover exitImmediately ExitSuccess retireHandler = Catch $ do report rpt "Mighty retiring" closeService svc -- this lets warp break - infoHandler = Catch $ report rpt "obsolted" + infoHandler = Catch $ report rpt "obsoleted" reloadHandler = Catch $ do ifRouteFileIsValid rpt opt $ \newroute -> do writeRouteDBRef rdr newroute report rpt "Mighty reloaded" -getTlsSetting :: Option -> IO TLSSettings -getTlsSetting _opt = #ifdef HTTP_OVER_TLS - case opt_service _opt of - 0 -> return defaultTlsSettings -- this is dummy - _ -> do cert <- BS.readFile $ opt_tls_cert_file _opt - let strip = dropWhileEnd isSpace . dropWhile isSpace - split "" = [] - split s = case break (',' ==) s of - ("",r) -> split (tail r) - (s',"") -> [s'] - (s',r) -> s' : split (tail r) - chain_files = map strip $ split $ opt_tls_chain_files _opt - chains <- mapM BS.readFile chain_files - key <- BS.readFile $ opt_tls_key_file _opt - let settings0 = tlsSettingsChainMemory cert chains key - settings = settings0 { - tlsSessionManagerConfig = Just defaultConfig { dbMaxSize = 1000 } - } - return settings -#else - return TLSSettings +loadCredentials :: Option -> IO Credentials +loadCredentials opt = do + cert <- BS.readFile $ opt_tls_cert_file opt + chains <- mapM BS.readFile chain_files + key <- BS.readFile $ opt_tls_key_file opt + let Right cred = TLS.credentialLoadX509ChainFromMemory cert chains key + return $ Credentials [cred] + where + strip = dropWhileEnd isSpace . dropWhile isSpace + split "" = [] + split s = case break (',' ==) s of + ("",r) -> split (tail r) + (s',"") -> [s'] + (s',r) -> s' : split (tail r) + chain_files = map strip $ split $ opt_tls_chain_files opt #endif ---------------------------------------------------------------- @@ -163,35 +184,56 @@ ifRouteFileIsValid rpt opt act = case op mighty :: Option -> Reporter -> Service -> ApacheLogger -> ServerPushLogger -> ConnPool -> RouteDBRef - -> TLSSettings + -> Maybe Credentials -> Maybe SessionManager -> T.Manager -> IO () -mighty opt rpt svc lgr pushlgr mgr rdr _tlsSetting +mighty opt rpt svc lgr pushlgr mgr rdr _mcreds _msmgr tmgr = reportDo rpt $ case svc of HttpOnly s -> runSettingsSocket setting s app #ifdef HTTP_OVER_TLS - HttpsOnly s -> runTLSSocket _tlsSetting setting s app - HttpAndHttps s1 s2 -> void $ concurrently + HttpsOnly s -> runTLSSocket tlsSetting setting s app + HttpAndHttps s1 s2 -> concurrently_ (runSettingsSocket setting s1 app) - (runTLSSocket _tlsSetting setting s2 app) + (runTLSSocket tlsSetting setting s2 app) +#ifdef HTTP_OVER_QUIC + QUIC s1 s2 -> do + let quicPort' = BS.pack $ show quicPort + strver Q.Version1 = "" + strver v = BS.append "-" $ BS.pack $ show $ fromVersion v + quicDrafts = map strver quicVersions + value v = BS.concat ["h3",v,"=\":",quicPort',"\""] + altsvc = BS.intercalate "," $ map value quicDrafts + settingT = setAltSvc altsvc setting + mapConcurrently_ id [runSettingsSocket setting s1 app + ,runTLSSocket tlsSetting settingT s2 app + ,runQUIC qconf setting app + ] +#else + _ -> error "never reach" +#endif #else _ -> error "never reach" #endif where - app = P.pushOnReferer P.defaultSettings - (fileCgiApp cspec filespec cgispec revproxyspec rdr) + app = P.pushOnReferer P.defaultSettings $ 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 (opt_port opt) -- just in case + 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) - $ setTimeout (opt_connection_timeout opt) -- seconds - $ setFdCacheDuration (opt_fd_cache_duration opt) + $ setManager tmgr + $ setFdCacheDuration (naturalToInt $ opt_fd_cache_duration opt) $ setFileInfoCacheDuration 10 $ setServerName serverName $ setLogger lgr $ setServerPushLogger pushlgr defaultSettings +#ifdef HTTP_OVER_TLS + tlsSetting = defaultTlsSettings { + tlsCredentials = _mcreds + , tlsSessionManager = _msmgr + } +#endif serverName = BS.pack $ opt_server_name opt cspec = ClassicAppSpec { softwareName = serverName @@ -207,10 +249,41 @@ mighty opt rpt svc lgr pushlgr mgr rdr _ revproxyspec = RevProxyAppSpec { revProxyManager = mgr } +#ifdef HTTP_OVER_QUIC + quicAddr = read <$> opt_quic_addr opt + quicPort = fromIntegral $ opt_quic_port opt + quicVersions = Q.scVersions Q.defaultServerConfig + qconf = Q.defaultServerConfig { + Q.scAddresses = (,quicPort) <$> quicAddr + , Q.scALPN = Just chooseALPN + , Q.scRequireRetry = False + , Q.scSessionManager = fromJust _msmgr + , Q.scUse0RTT = True + , Q.scDebugLog = opt_quic_debug_dir opt + , Q.scQLog = opt_quic_qlog_dir opt + , Q.scCredentials = fromJust _mcreds + } + +chooseALPN :: Q.Version -> [ByteString] -> IO ByteString +chooseALPN ver protos = case find (\x -> x == h3 || x == hq) protos of + Nothing -> return "" + Just proto -> return proto + where + h3 | ver == Q.Version1 = "h3" + | otherwise = "h3-" `BS.append` BS.pack (show (fromVersion ver)) + hq | ver == Q.Version1 = "hq-interop" + | otherwise = "hq-" `BS.append` BS.pack (show (fromVersion ver)) + +fromVersion :: Q.Version -> Int +fromVersion (Q.Version ver) = fromIntegral (0x000000ff .&. ver) +#endif ---------------------------------------------------------------- -data Service = HttpOnly Socket | HttpsOnly Socket | HttpAndHttps Socket Socket +data Service = HttpOnly Socket + | HttpsOnly Socket + | HttpAndHttps Socket Socket + | QUIC Socket Socket ---------------------------------------------------------------- @@ -226,13 +299,20 @@ openService opt debugMessage $ urlForHTTP httpPort debugMessage $ urlForHTTPS httpsPort return $ HttpAndHttps s1 s2 + | service == 3 = do + s1 <- bindPortTCP httpPort hostpref + s2 <- bindPortTCP httpsPort hostpref + debugMessage $ urlForHTTP httpPort + debugMessage $ urlForHTTPS httpsPort + debugMessage "QUIC is also available via Alt-Svc" + return $ QUIC s1 s2 | otherwise = do s <- bindPortTCP httpPort hostpref debugMessage $ urlForHTTP httpPort return $ HttpOnly s where - httpPort = opt_port opt - httpsPort = opt_tls_port opt + httpPort = naturalToInt $ opt_port opt + httpsPort = naturalToInt $ opt_tls_port opt hostpref = fromString $ opt_host opt service = opt_service opt debug = opt_debug_mode opt @@ -251,6 +331,7 @@ closeService :: Service -> IO () closeService (HttpOnly s) = close s closeService (HttpsOnly s) = close s closeService (HttpAndHttps s1 s2) = close s1 >> close s2 +closeService (QUIC s1 s2) = close s1 >> close s2 ---------------------------------------------------------------- @@ -264,4 +345,16 @@ getManager opt = H.newManager H.defaultM where responseTimeout | opt_proxy_timeout opt == 0 = H.managerResponseTimeout H.defaultManagerSettings - | otherwise = H.responseTimeoutMicro (opt_proxy_timeout opt * 1000000) -- micro seconds + | otherwise = H.responseTimeoutMicro (naturalToInt $ opt_proxy_timeout opt * 1000000) -- micro seconds + +#ifdef DROP_EXCEPT_BIND +foreign import ccall unsafe "send_signal" + c_send_signal :: CInt -> CInt -> IO () + +dropExceptBind :: IO () +dropExceptBind = do + pid <- getProcessID + strtids <- listDirectory ("/proc/" ++ show pid ++ "/task") + let tids = map read strtids :: [Int] + forM_ tids $ \tid -> c_send_signal (fromIntegral tid) sigUSR1 +#endif diff -pruN 3.4.6-1/src/WaiApp.hs 4.0.2-1/src/WaiApp.hs --- 3.4.6-1/src/WaiApp.hs 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/src/WaiApp.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,4 +1,5 @@ -{-# LANGUAGE OverloadedStrings, CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module WaiApp (fileCgiApp) where @@ -36,7 +37,7 @@ fileCgiApp cspec filespec cgispec revpro 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 prt) req respond + revProxyApp cspec revproxyspec (RevProxyRoute src dst dom (naturalToInt prt)) req respond where (host, _) = hostPort req rawpath = rawPathInfo req diff -pruN 3.4.6-1/test/ConfigSpec.hs 4.0.2-1/test/ConfigSpec.hs --- 3.4.6-1/test/ConfigSpec.hs 2019-06-25 05:04:17.000000000 +0000 +++ 4.0.2-1/test/ConfigSpec.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,3 +1,6 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} + module ConfigSpec where import Program.Mighty @@ -7,8 +10,44 @@ spec :: Spec spec = do describe "parseConfig" $ do it "parses example.conf correctly" $ do - res <- parseOption "conf/example.conf" "foo" - res `shouldBe` ans + res <- parseOption "conf/example.conf" + res { opt_server_name = "foo" } `shouldBe` ans + +#ifdef DHALL + describe "parseDhall" $ do + it "parses example.dhall correctly" $ do + res <- parseOptionDhall "./conf/example.dhall" + res { opt_server_name = "foo" } `shouldBe` ans +#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_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_fd_cache_duration = 10, opt_server_name = "foo", opt_routing_file = Nothing, opt_tls_port = 443, opt_tls_cert_file = "cert.pem", opt_tls_chain_files = "chain.pem", opt_tls_key_file = "privkey.pem", opt_service = 0, opt_report_file = "/tmp/mighty_report", opt_proxy_timeout = 0} +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 = ["127.0.0.1","::1"] + , opt_quic_port = 443 + , opt_quic_debug_dir = Nothing + , opt_quic_qlog_dir = Nothing + , opt_server_name = "foo" + , opt_routing_file = Nothing + }