gentoo-overlay/dev-haskell/hslogger/files/hslogger-1.2.1-dev-log-rdetect.patch

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))