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