1{-# LANGUAGE CPP #-}
2
3{- |
4   Module     : System.Log.Handler.Syslog
5   Copyright  : Copyright (C) 2004-2011 John Goerzen
6   License    : BSD3
7
8   Portability: portable
9
10Syslog handler for the Haskell Logging Framework
11
12Written by John Goerzen, jgoerzen\@complete.org
13
14This module implements an interface to the Syslog service commonly
15found in Unix\/Linux systems.  This interface is primarily of interest to
16developers of servers, as Syslog does not typically display messages in
17an interactive fashion.
18
19This module is written in pure Haskell and is capable of logging to a local
20or remote machine using the Syslog protocol.
21
22You can create a new Syslog 'LogHandler' by calling 'openlog'.
23
24More information on the Haskell Logging Framework can be found at
25"System.Log.Logger".  This module can also be used outside
26of the rest of that framework for those interested in that.
27-}
28
29module System.Log.Handler.Syslog(
30                                       SyslogHandler, -- No constructors.
31                                       -- * Handler Initialization
32                                       openlog,
33                                       -- * Advanced handler initialization
34#ifndef mingw32_HOST_OS
35                                       openlog_local,
36#endif
37                                       openlog_remote,
38                                       openlog_generic,
39                                       -- * Data Types
40                                       Facility(..),
41                                       Option(..)
42                                       ) where
43
44import qualified Control.Exception as E
45import System.Log
46import System.Log.Formatter
47import System.Log.Handler
48import Data.Bits
49import qualified Network.Socket as S
50import qualified Network.Socket.ByteString as SBS
51import qualified Network.BSD as S
52import Data.List (genericDrop)
53#ifndef mingw32_HOST_OS
54import System.Posix.Process(getProcessID)
55#endif
56import System.IO
57import Control.Monad (void, when)
58
59import UTF8
60
61send :: S.Socket -> String -> IO Int
62send s = SBS.send s . toUTF8BS
63
64sendTo :: S.Socket -> String -> S.SockAddr -> IO Int
65sendTo s str = SBS.sendTo s (toUTF8BS str)
66
67code_of_pri :: Priority -> Int
68code_of_pri p = case p of
69                       EMERGENCY -> 0
70                       ALERT -> 1
71                       CRITICAL -> 2
72                       ERROR -> 3
73                       WARNING -> 4
74                       NOTICE -> 5
75                       INFO -> 6
76                       DEBUG -> 7
77
78{- | Facilities are used by the system to determine where messages
79are sent. -}
80
81data Facility =
82              KERN                      -- ^ Kernel messages; you should likely never use this in your programs
83              | USER                    -- ^ General userland messages.  Use this if nothing else is appropriate
84              | MAIL                    -- ^ E-Mail system
85              | DAEMON                  -- ^ Daemon (server process) messages
86              | AUTH                    -- ^ Authentication or security messages
87              | SYSLOG                  -- ^ Internal syslog messages; you should likely never use this in your programs
88              | LPR                     -- ^ Printer messages
89              | NEWS                    -- ^ Usenet news
90              | UUCP                    -- ^ UUCP messages
91              | CRON                    -- ^ Cron messages
92              | AUTHPRIV                -- ^ Private authentication messages
93              | FTP                     -- ^ FTP messages
94              | LOCAL0                  -- ^ LOCAL0 through LOCAL7 are reserved for you to customize as you wish
95              | LOCAL1
96              | LOCAL2
97              | LOCAL3
98              | LOCAL4
99              | LOCAL5
100              | LOCAL6
101              | LOCAL7
102                deriving (Eq, Show, Read)
103
104code_of_fac :: Facility -> Int
105code_of_fac f = case f of
106                       KERN -> 0
107                       USER -> 1
108                       MAIL -> 2
109                       DAEMON -> 3
110                       AUTH -> 4
111                       SYSLOG -> 5
112                       LPR -> 6
113                       NEWS -> 7
114                       UUCP -> 8
115                       CRON -> 9
116                       AUTHPRIV -> 10
117                       FTP -> 11
118                       LOCAL0 -> 16
119                       LOCAL1 -> 17
120                       LOCAL2 -> 18
121                       LOCAL3 -> 19
122                       LOCAL4 -> 20
123                       LOCAL5 -> 21
124                       LOCAL6 -> 22
125                       LOCAL7 -> 23
126
127makeCode :: Facility -> Priority -> Int
128makeCode fac pri =
129    let faccode = code_of_fac fac
130        pricode = code_of_pri pri in
131        (faccode `shiftL` 3) .|. pricode
132
133{- | Options for 'openlog'. -}
134
135data Option = PID                       -- ^ Automatically log process ID (PID) with each message
136            | PERROR                    -- ^ Send a copy of each message to stderr
137            deriving (Eq,Show,Read)
138
139data SyslogHandler = SyslogHandler {options :: [Option],
140                                    facility :: Facility,
141                                    identity :: String,
142                                    logsocket :: S.Socket,
143                                    address :: S.SockAddr,
144                                    sock_type :: S.SocketType,
145                                    priority :: Priority,
146                                    formatter :: LogFormatter SyslogHandler
147                                   }
148
149{- | Initialize the Syslog system using the local system's default interface,
150\/dev\/log.  Will return a new 'System.Log.Handler.LogHandler'.
151
152On Windows, instead of using \/dev\/log, this will attempt to send
153UDP messages to something listening on the syslog port (514) on localhost.
154
155Use 'openlog_remote' if you need more control.
156-}
157
158openlog :: String                       -- ^ The name of this program -- will be prepended to every log message
159        -> [Option]                     -- ^ A list of 'Option's.  The list [] is perfectly valid.  ['PID'] is probably most common here.
160        -> Facility                     -- ^ The 'Facility' value to pass to the syslog system for every message logged
161        -> Priority                     -- ^ Messages logged below this priority will be ignored.  To include every message, set this to 'DEBUG'.
162        -> IO SyslogHandler             -- ^ Returns the new handler
163
164#ifdef mingw32_HOST_OS
165openlog = openlog_remote S.AF_INET "localhost" 514
166#elif darwin_HOST_OS
167openlog = openlog_local "/var/run/syslog"
168#else
169openlog = openlog_local "/dev/log"
170#endif
171
172{- | Initialize the Syslog system using an arbitrary Unix socket (FIFO).
173
174Not supported under Windows.
175-}
176
177#ifndef mingw32_HOST_OS
178openlog_local :: String                 -- ^ Path to FIFO
179              -> String                 -- ^ Program name
180              -> [Option]               -- ^ 'Option's
181              -> Facility               -- ^ Facility value
182              -> Priority               -- ^ Priority limit
183              -> IO SyslogHandler
184openlog_local fifopath ident options' fac pri =
185    do (s, t) <- do -- "/dev/log" is usually Datagram,
186                    -- but most of syslog loggers allow it to be
187                    -- of Stream type. glibc's" openlog()"
188                    -- does roughly the similar thing:
189                    --     http://www.gnu.org/software/libc/manual/html_node/openlog.html
190
191                    s <- S.socket S.AF_UNIX S.Stream 0
192                    tryStream s `E.catch` (onIOException (fallbackToDgram s))
193       openlog_generic s (S.SockAddrUnix fifopath) t ident options' fac pri
194
195  where onIOException :: IO a -> E.IOException -> IO a
196        onIOException a _ = a
197
198        tryStream :: S.Socket -> IO (S.Socket, S.SocketType)
199        tryStream s =
200            do S.connect s (S.SockAddrUnix fifopath)
201               return (s, S.Stream)
202
203        fallbackToDgram :: S.Socket -> IO (S.Socket, S.SocketType)
204        fallbackToDgram s =
205            do S.close s -- close Stream variant
206               d <- S.socket S.AF_UNIX S.Datagram 0
207               return (d, S.Datagram)
208#endif
209
210{- | Log to a remote server via UDP. -}
211openlog_remote :: S.Family              -- ^ Usually AF_INET or AF_INET6; see Network.Socket
212               -> S.HostName            -- ^ Remote hostname.  Some use @localhost@
213               -> S.PortNumber          -- ^ 514 is the default for syslog
214               -> String                -- ^ Program name
215               -> [Option]              -- ^ 'Option's
216               -> Facility              -- ^ Facility value
217               -> Priority              -- ^ Priority limit
218               -> IO SyslogHandler
219openlog_remote fam hostname port ident options' fac pri =
220    do
221    he <- S.getHostByName hostname
222    s <- S.socket fam S.Datagram 0
223    let addr = S.SockAddrInet port (head (S.hostAddresses he))
224    openlog_generic s addr S.Datagram ident options' fac pri
225
226{- | The most powerful initialization mechanism.  Takes an open datagram
227socket. -}
228openlog_generic :: S.Socket             -- ^ A datagram socket
229                -> S.SockAddr           -- ^ Address for transmissions
230                -> S.SocketType         -- ^ socket connection mode (stream / datagram)
231                -> String               -- ^ Program name
232                -> [Option]             -- ^ 'Option's
233                -> Facility             -- ^ Facility value
234                -> Priority             -- ^ Priority limit
235                -> IO SyslogHandler
236openlog_generic sock addr sock_t ident opt fac pri =
237    return (SyslogHandler {options = opt,
238                            facility = fac,
239                            identity = ident,
240                            logsocket = sock,
241                            address = addr,
242                            sock_type = sock_t,
243                            priority = pri,
244                            formatter = syslogFormatter
245                          })
246
247syslogFormatter :: LogFormatter SyslogHandler
248syslogFormatter sh (p,msg) logname =
249    let format = "[$loggername/$prio] $msg"
250    in varFormatter [] format sh (p,msg) logname
251
252
253instance LogHandler SyslogHandler where
254    setLevel sh p = sh{priority = p}
255    getLevel sh = priority sh
256    setFormatter sh f = sh{formatter = f}
257    getFormatter sh = formatter sh
258    emit sh (prio, msg) _ = do
259      when (elem PERROR (options sh)) (hPutStrLn stderr msg)
260      pidPart <- getPidPart
261      void $ sendstr (toSyslogFormat msg pidPart)
262      where
263        sendstr :: String -> IO String
264        sendstr [] = return []
265        sendstr omsg = do
266          sent <- case sock_type sh of
267                    S.Datagram -> sendTo (logsocket sh) omsg (address sh)
268                    S.Stream   -> send   (logsocket sh) omsg
269          sendstr (genericDrop sent omsg)
270        toSyslogFormat msg' pidPart =
271            "<" ++ code ++ ">" ++ identity' ++ pidPart ++ ": " ++ msg' ++ "\0"
272        code = show $ makeCode (facility sh) prio
273        identity' = identity sh
274        getPidPart = if elem PID (options sh)
275                     then getPid >>= \pid -> return ("[" ++ pid ++ "]")
276                     else return ""
277        getPid :: IO String
278        getPid =
279#ifndef mingw32_HOST_OS
280          getProcessID >>= return . show
281#else
282          return "windows"
283#endif
284
285    close sh = S.close (logsocket sh)
286