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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
Detect "/dev/log" socket type (Stream / Dgram) at runtime
as it does openlog from glibc.
Patch based on report by George Diamantopoulos:
https://groups.google.com/forum/#!topic/ganeti/xnj-WctN7HY/discussion
Original bug report
https://github.com/jgoerzen/hslogger/issues/1
Reported-by: George Diamantopoulos
Signed-off-by: Sergei Trofimovich <slyfox@gentoo.org>
diff --git a/src/System/Log/Handler/Syslog.hs b/src/System/Log/Handler/Syslog.hs
index 52cbdc3..62337f8 100644
--- a/src/System/Log/Handler/Syslog.hs
+++ b/src/System/Log/Handler/Syslog.hs
@@ -42,11 +42,12 @@ module System.Log.Handler.Syslog(
Option(..)
) where
+import qualified Control.Exception as E
import System.Log
import System.Log.Formatter
import System.Log.Handler
import Data.Bits
-import Network.Socket
+import Network.Socket as S
import Network.BSD
import Data.List
#ifndef mingw32_HOST_OS
@@ -131,6 +132,7 @@ data SyslogHandler = SyslogHandler {options :: [Option],
identity :: String,
logsocket :: Socket,
address :: SockAddr,
+ sock_type :: SocketType,
priority :: Priority,
formatter :: LogFormatter SyslogHandler
}
@@ -171,9 +173,29 @@ openlog_local :: String -- ^ Path to FIFO
-> Priority -- ^ Priority limit
-> IO SyslogHandler
openlog_local fifopath ident options fac pri =
- do
- s <- socket AF_UNIX Datagram 0
- openlog_generic s (SockAddrUnix fifopath) ident options fac pri
+ do (s, t) <- do -- "/dev/log" is usually Datagram,
+ -- but most of syslog loggers allow it to be
+ -- of Stream type. glibc's" openlog()"
+ -- does roughly the similar thing:
+ -- http://www.gnu.org/software/libc/manual/html_node/openlog.html
+
+ s <- socket AF_UNIX Stream 0
+ tryStream s `E.catch` (onIOException (fallbackToDgram s))
+ openlog_generic s (SockAddrUnix fifopath) t ident options fac pri
+
+ where onIOException :: IO a -> E.IOException -> IO a
+ onIOException a _ = a
+
+ tryStream :: Socket -> IO (Socket, SocketType)
+ tryStream s =
+ do connect s (SockAddrUnix fifopath)
+ return (s, Stream)
+
+ fallbackToDgram :: Socket -> IO (Socket, SocketType)
+ fallbackToDgram s =
+ do S.close s -- close Stream variant
+ d <- socket AF_UNIX Datagram 0
+ return (d, Datagram)
#endif
{- | Log to a remote server via UDP. -}
@@ -190,23 +212,25 @@ openlog_remote fam hostname port ident options fac pri =
he <- getHostByName hostname
s <- socket fam Datagram 0
let addr = SockAddrInet port (head (hostAddresses he))
- openlog_generic s addr ident options fac pri
-
+ openlog_generic s addr Datagram ident options fac pri
+
{- | The most powerful initialization mechanism. Takes an open datagram
socket. -}
openlog_generic :: Socket -- ^ A datagram socket
-> SockAddr -- ^ Address for transmissions
+ -> SocketType -- ^ socket connection mode (stream / datagram)
-> String -- ^ Program name
-> [Option] -- ^ 'Option's
-> Facility -- ^ Facility value
-> Priority -- ^ Priority limit
-> IO SyslogHandler
-openlog_generic sock addr ident opt fac pri =
+openlog_generic sock addr sock_t ident opt fac pri =
return (SyslogHandler {options = opt,
facility = fac,
identity = ident,
logsocket = sock,
address = addr,
+ sock_type = sock_t,
priority = pri,
formatter = syslogFormatter
})
@@ -234,12 +258,14 @@ instance LogHandler SyslogHandler where
getLevel sh = priority sh
setFormatter sh f = sh{formatter = f}
getFormatter sh = formatter sh
- emit sh (_, msg) _ =
- let
+ emit sh (_, msg) _ =
+ let
sendstr :: String -> IO String
sendstr [] = return []
sendstr omsg = do
- sent <- sendTo (logsocket sh) omsg (address sh)
+ sent <- case sock_type sh of
+ Datagram -> sendTo (logsocket sh) omsg (address sh)
+ Stream -> send (logsocket sh) omsg
sendstr (genericDrop sent omsg)
in do
if (elem PERROR (options sh))
|
GitWeb