1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
module IRE.Server
( server
) where
import Control.Exception.Base (bracket, catch, throwIO)
import Data.Bits ((.|.))
import Data.Yaml.Include (decodeFileEither)
import Network.Socket
(Family(AF_INET, AF_UNIX), SockAddr(..), Socket,
SocketOption(ReuseAddr), SocketType(Stream), bind, close,
getSocketName, inet_addr, listen, maxListenQueue, setSocketOption,
socket)
import Network.Wai.Handler.Warp
(Port, defaultSettings, runSettingsSocket)
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)
import System.IO.Error (isDoesNotExistError)
import System.Posix.Files
(fileExist, groupReadMode, groupWriteMode, ownerReadMode,
ownerWriteMode, removeLink, setFileMode, socketMode)
import IRE.Application (app)
import IRE.Config (ConfigFile(..), defaultConfig)
import qualified IRE.Logging as Log
import IRE.YOLO (newDetector)
type Listen = Either Port FilePath
server :: FilePath -> FilePath -> IO ()
server rootDir configFile = do
cf <- readConfigFile configFile
net <- newDetector (cfYOLO cf)
Log.start Log.Debug
let socketSpec =
case cfSocket cf of
Just p -> Right p
Nothing -> Left $ cfPort cf
bracket
(createSocket socketSpec)
closeSocket
(\sock -> do
listen sock maxListenQueue
runSettingsSocket defaultSettings sock =<< app rootDir net)
readConfigFile :: FilePath -> IO ConfigFile
readConfigFile f = do
e <- fileExist f
if e
then do
r <- decodeFileEither f
case r of
Left ex -> do
hPutStrLn stderr $ "FATAL: " ++ f ++ ": " ++ show ex
exitFailure
Right cf -> return cf
else return defaultConfig
createSocket :: Listen -> IO Socket
createSocket (Right path) = do
removeIfExists path
sock <- socket AF_UNIX Stream 0
bind sock $ SockAddrUnix path
setFileMode path $
socketMode .|. ownerWriteMode .|. ownerReadMode .|. groupWriteMode .|.
groupReadMode
Log.info $ "Listening on UNIX socket `" ++ path ++ "'"
return sock
createSocket (Left port) = do
sock <- socket AF_INET Stream 0
setSocketOption sock ReuseAddr 1
addr <- inet_addr "127.0.0.1"
bind sock $ SockAddrInet (fromIntegral port) addr
Log.info $ "Listening on localhost:" ++ show port
return sock
closeSocket :: Socket -> IO ()
closeSocket sock = do
name <- getSocketName sock
close sock
case name of
SockAddrUnix path -> removeIfExists path
_ -> return ()
removeIfExists :: FilePath -> IO ()
removeIfExists fileName = removeLink fileName `catch` handleExists
where
handleExists e
| isDoesNotExistError e = return ()
| otherwise = throwIO e
|
