mighttpd2-4.0.9: src/Mighty.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

#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)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.FilePath (addTrailingPathSeparator, isAbsolute, normalise, (</>))
import System.IO

import Program.Mighty

import Server
import Paths_mighttpd2 as P

----------------------------------------------------------------

programName :: String
programName = "Mighttpd"

programVersion :: String
programVersion = showVersion P.version

----------------------------------------------------------------

main :: IO ()
main = do
    (opt,route) <- getOptRoute
    checkTLS opt
    let reportFile = reportFileName opt
        debug = opt_debug_mode opt
        rpt = initReporter debug reportFile
        run = server opt rpt route
    if debug then run id else run (background opt)
  where
    getOptRoute = getArgs >>= eachCase
    svrnm = programName ++ "/" ++ programVersion
    eachCase args
      | n == 0 = do
          root <- amIrootUser
          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]]
          return (opt, route)
      | n == 2 = do
          let config_file = args !! 0
          routing_file <- getAbsoluteFile (args !! 1)
#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
                         , opt_server_name = svrnm
                         }
          return (opt',route)
      | otherwise = do
          hPutStrLn stderr "Usage: mighty"
          hPutStrLn stderr "       mighty config_file routing_file"
          exitFailure
      where
        n = length args
    getAbsoluteFile file
      | isAbsolute file = return file
      | otherwise       = do
          dir <- getCurrentDirectory
          return $ dir </> normalise file
#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
#endif

----------------------------------------------------------------

background :: Option -> IO () -> IO ()
background opt svr = do
    putStrLn $ "Detaching this terminal..."
    putStrLn $ "(If errors occur, they will be written in \"" ++ reportFileName opt ++ "\".)"
    hFlush stdout
    daemonize svr

reportFileName :: Option -> FilePath
reportFileName opt
  | port == 80 = rfile
  | otherwise  = rfile ++ show port
  where
    rfile = opt_report_file opt
    port = opt_port opt