Fix /dev/log to be Stream or Datagram at runtime (fixes ganeti logger for certain users).

(Portage version: 2.2.0_alpha191/cvs/Linux x86_64, signed Manifest commit with key 611FF3AA)

3 files changed, 157 insertions, 1 deletions

diff --git a/dev-haskell/hslogger/ChangeLog b/dev-haskell/hslogger/ChangeLog
index 9bcaf724b4a3..2e5a3e587895 100644
--- a/dev-haskell/hslogger/ChangeLog
+++ b/dev-haskell/hslogger/ChangeLog
@@ -1,6 +1,13 @@
 # ChangeLog for dev-haskell/hslogger
 # Copyright 1999-2013 Gentoo Foundation; Distributed under the GPL v2
-# $Header: /var/cvsroot/gentoo-x86/dev-haskell/hslogger/ChangeLog,v 1.19 2013/07/21 17:41:48 ottxor Exp $
+# $Header: /var/cvsroot/gentoo-x86/dev-haskell/hslogger/ChangeLog,v 1.20 2013/08/13 13:06:24 slyfox Exp $
+
+*hslogger-1.2.1-r2 (13 Aug 2013)
+
+  13 Aug 2013; Sergei Trofimovich <slyfox@gentoo.org>
+  +files/hslogger-1.2.1-dev-log-rdetect.patch, +hslogger-1.2.1-r2.ebuild:
+  Fix /dev/log to be Stream or Datagram at runtime (fixes ganeti logger for
+  certain users).
 
   21 Jul 2013; Christoph Junghans <ottxor@gentoo.org> hslogger-1.2.1.ebuild:
   added ~amd64-linux (tested by me)
diff --git a/dev-haskell/hslogger/files/hslogger-1.2.1-dev-log-rdetect.patch b/dev-haskell/hslogger/files/hslogger-1.2.1-dev-log-rdetect.patch
new file mode 100644
index 000000000000..0da97310da1a
--- /dev/null
+++ b/dev-haskell/hslogger/files/hslogger-1.2.1-dev-log-rdetect.patch
@@ -0,0 +1,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))
diff --git a/dev-haskell/hslogger/hslogger-1.2.1-r2.ebuild b/dev-haskell/hslogger/hslogger-1.2.1-r2.ebuild
new file mode 100644
index 000000000000..31138a07d7a7
--- /dev/null
+++ b/dev-haskell/hslogger/hslogger-1.2.1-r2.ebuild
@@ -0,0 +1,30 @@
+# Copyright 1999-2013 Gentoo Foundation
+# Distributed under the terms of the GNU General Public License v2
+# $Header: /var/cvsroot/gentoo-x86/dev-haskell/hslogger/hslogger-1.2.1-r2.ebuild,v 1.1 2013/08/13 13:06:24 slyfox Exp $
+
+EAPI=5
+
+# ebuild generated by hackport 0.3.9999
+
+CABAL_FEATURES="bin lib profile haddock hoogle hscolour"
+inherit eutils haskell-cabal
+
+DESCRIPTION="Versatile logging framework"
+HOMEPAGE="http://software.complete.org/hslogger"
+SRC_URI="mirror://hackage/packages/archive/${PN}/${PV}/${P}.tar.gz"
+
+LICENSE="BSD"
+SLOT="0/${PV}"
+KEYWORDS="~amd64 ~sparc ~x86"
+IUSE=""
+
+RDEPEND="dev-haskell/mtl:=[profile?]
+		<dev-haskell/network-2.5:=[profile?]
+		>=dev-lang/ghc-6.10.4:="
+DEPEND="${RDEPEND}
+		>=dev-haskell/cabal-1.2"
+
+src_prepare() {
+	epatch "${FILESDIR}"/${P}-dev-log-rdetect.patch
+	epatch_user
+}