X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Main.hs;h=3df4d8b23a910a86ce895238dac27e26c0e9cf4d;hp=46eb3e2ad4867ef7361cb8c681a7ac2ac10d7f41;hb=HEAD;hpb=43113f26d3e61c96d896724c5509abe67b6a99e7

diff --git a/Main.hs b/Main.hs
index 46eb3e2..3df4d8b 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,10 +1,14 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE
+    CPP
+  , UnicodeSyntax
+  #-}
+import           Control.Exception
 import           Control.Monad
 import           Data.List
 import           Data.Maybe
-import           Network
+import Network.Socket
 import           Network.HTTP.Lucu
-import           OpenSSL
+import OpenSSL
 import           Rakka.Environment
 import           Rakka.Resource.CheckAuth
 import           Rakka.Resource.DumpRepos
@@ -15,18 +19,20 @@ import           Rakka.Resource.Object
 import           Rakka.Resource.Render
 import           Rakka.Resource.Search
 import           Rakka.Resource.SystemConfig
--- import           Rakka.Resource.TrackBack
 import           Rakka.Resource.Users
 import           Rakka.Storage
 import           Subversion
-import           System.Console.GetOpt
+import           System.Console.GetOpt -- FIXME: Use better library than this.
 import           System.Directory
 import           System.Environment
 import           System.Exit
+import           System.FilePath
 import           System.IO
 import           System.Log.Handler.Simple
 import           System.Log.Logger
 import           System.Posix.Files
+import           System.Posix.IO
+import           System.Posix.Process
 import           System.Posix.Types
 import           System.Posix.User
 
@@ -36,19 +42,19 @@ logger = "Main"
 
 
 data CmdOpt
-    = OptPortNum   PortNumber
+    = OptPortNum   ServiceName
     | OptLSDir     FilePath
     | OptUserName  String
     | OptGroupName String
     | OptLogLevel  Priority
-    | OptDisableStderrLog
+    | OptVerbose
     | OptRebuildIndex
     | OptHelp
     deriving (Eq, Show)
 
 
-defaultPort :: PortNumber
-defaultPort = toEnum 8080
+defaultPort ∷ ServiceName
+defaultPort = "8080"
 
 defaultLocalStateDir :: FilePath
 defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP
@@ -66,8 +72,8 @@ defaultLogLevel = NOTICE
 
 options :: [OptDescr CmdOpt]
 options = [ Option ['p'] ["port"]
-                   (ReqArg (OptPortNum . toEnum . read) "NUM")
-                   ("Port number to listen. (default: " ++ show defaultPort ++ ")")
+                   (ReqArg OptPortNum "NUM")
+                   ("Port number to listen. (default: " ++ defaultPort ++ ")")
 
           , Option ['d'] ["localstatedir"]
                    (ReqArg OptLSDir "DIR")
@@ -85,13 +91,13 @@ options = [ Option ['p'] ["port"]
                    (ReqArg (OptLogLevel . read) "LEVEL")
                    ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")
 
-          , Option [] ["disable-stderr-log"]
-                   (NoArg OptDisableStderrLog)
-                   "Disable logging to stderr."
+          , Option ['v'] ["verbose"]
+                   (NoArg OptVerbose)
+                   "Enable logging to stderr."
 
-          , Option [] ["rebuild-index"]
+          , Option ['r'] ["rebuild-index"]
                    (NoArg OptRebuildIndex)
-                   "Rebuild the index database."
+                   "Rebuild the index database. (Only for debug purposes)"
 
           , Option ['h'] ["help"]
                    (NoArg OptHelp)
@@ -128,18 +134,23 @@ main = withOpenSSL $
           gid     <- getGroupID opts
           lsdir   <- getLocalStateDir opts
 
+          -- Create our localstatedir *before* dropping privileges.
           createLocalStateDir lsdir uid gid
 
           setGroupID gid
           setUserID  uid
 
-          setupLogger opts
-          env <- setupEnv lsdir portNum
+          -- Now that we have our localstatedir. Let's acquire a lock
+          -- on the lockfile. Then create other files.
+          withSystemLock (lsdir </> "lock") $
+            withPidFile (lsdir </> "pid") $
+              do setupLogger opts
+                 env ← setupEnv lsdir portNum
 
-          rebuildIndexIfRequested env opts
+                 rebuildIndexIfRequested env opts
 
-          infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
-          runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
+                 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
+                 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]
 
           
 resTree :: Environment -> ResTree
@@ -154,21 +165,18 @@ resTree env
                 , (["search.html" ], resSearch       env)
                 , (["search.xml"  ], resSearch       env)
                 , (["systemConfig"], resSystemConfig env)
-                -- , (["trackback"   ], resTrackBack    env)
 		, (["users"       ], resUsers        env)
                 ]
 
-
-getPortNum :: [CmdOpt] -> IO PortNumber
+getPortNum ∷ [CmdOpt] → IO ServiceName
 getPortNum opts
-    = do let xs = mapMaybe (\ x -> case x of
-                                     OptPortNum n -> Just n
-                                     _            -> Nothing) opts
+    = do let xs = mapMaybe (\x → case x of
+                                   OptPortNum n → Just n
+                                   _            → Nothing) opts
          case xs of
-           []     -> return defaultPort
-           (x:[]) -> return x
-           _      -> error "too many --port options."
-
+           []     → return defaultPort
+           (x:[]) → return x
+           _      → error "too many --port options."
 
 getUserID :: [CmdOpt] -> IO UserID
 getUserID opts
@@ -213,16 +221,16 @@ getLocalStateDir opts
 
 setupLogger :: [CmdOpt] -> IO ()
 setupLogger opts
-    = do let disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
-             logHandlers      = if disableStderrLog then
-                                    []
-                                else
-                                    [verboseStreamHandler stderr DEBUG]
-             logLevel         = fromMaybe defaultLogLevel
-                                $ do OptLogLevel l <- find (\ x -> case x of
-                                                                     OptLogLevel _ -> True
-                                                                     _             -> False) opts
-                                     return l
+    = do let verbose     = find (== OptVerbose) opts /= Nothing
+             logHandlers = if verbose then
+                               [verboseStreamHandler stderr DEBUG]
+                           else
+                               [] -- FIXME: enable file log
+             logLevel    = fromMaybe defaultLogLevel
+                           $ do OptLogLevel l <- find (\ x -> case x of
+                                                                OptLogLevel _ -> True
+                                                                _             -> False) opts
+                                return l
 
          logHandlers' <- sequence logHandlers
          updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)
@@ -241,3 +249,29 @@ rebuildIndexIfRequested env opts
                                                _               -> False) opts
          when rebuild
                   $ rebuildIndex (envStorage env)
+
+withSystemLock :: FilePath -> IO a -> IO a
+withSystemLock lockfile = bracket lock' unlock' . const
+    where
+      lock' :: IO Fd
+      lock' = do fd <- openFd
+                       lockfile
+                       ReadWrite
+                       (Just 420) -- 0644, -rw-r--r--
+                       defaultFileFlags
+                 setLock fd (WriteLock, AbsoluteSeek, 0, 0)
+                 return fd
+
+      unlock' :: Fd -> IO ()
+      unlock' = closeFd
+
+withPidFile :: FilePath -> IO a -> IO a
+withPidFile lockfile = bracket_ mkPid' delPid'
+    where
+      mkPid' :: IO ()
+      mkPid' = withFile lockfile WriteMode $ \ h ->
+               do pid <- getProcessID
+                  hPutStrLn h (show pid)
+
+      delPid' :: IO ()
+      delPid' = removeFile lockfile