Permalink
Switch branches/tags
upstream/1.2.10 upstream/1.2.3 upstream/1.1.2 upstream/1.1.0 upstream/1.0.12 upstream/1.0.11 upstream/1.0.10 upstream/1.0.10+dfsg1 upstream/1.0.9 hslogger/1.2.9 hslogger/1.0.10 debian/1.1.4+dfsg1-1 debian/1.0.10+dfsg1-1 debian/1.0.10-1 debian/1.0.9-4 debian/1.0.9-3 debian/1.0.9-2 debian/1.0.9-1 debian/1.0.8-3 debian/1.0.8-2 debian/1.0.8-1 debian/1.0.7.2 debian/1.0.7.1 debian/1.0.6.2 debian/1.0.6.1 debian/1.0.6.0 converted-from-darcs UPSTREAM_child_2005-02-14 UPSTREAM_BlockIO_2005-02-14 Tests_pass Tests_pass_Hugs RELEASE_hslogger_1.0.5.0 RELEASE_hslogger_1.0.4 RELEASE_hslogger_1.0.3.1 RELEASE_hslogger_1.0.1 RELEASE_hslogger_1.0.0 REL0.10.7 REL0.10.6 REL0.10.5 REL0.10.4 REL0.10.3 REL0.10.2 ProgressMeter_now_basically_functional Now_compiles_post-rename,_refs_#1 Now_compiles_on_Windows MILESTONE_0.18 DEBIAN_missingh_0.16.3 DEBIAN_missingh_0.16.2 DEBIAN_missingh_0.16.0 DEBIAN_missingh_0.14.5 DEBIAN_missingh_0.14.4 DEBIAN_missingh_0.14.3 DEBIAN_missingh_0.14.2 DEBIAN_missingh_0.14.0 DEBIAN_missingh_0.13.0 DEBIAN_missingh_0.12.3 DEBIAN_missingh_0.12.1 DEBIAN_missingh_0.12.0 DEBIAN_missingh_0.11.5 DEBIAN_missingh_0.11.4 DEBIAN_missingh_0.11.3 DEBIAN_missingh_0.11.1 DEBIAN_missingh_0.11.0 DEBIAN_missingh_0.10.10 DEBIAN_missingh_0.10.9 DEBIAN_missingh_0.10.7.sarge.1 DEBIAN_hslogger_1.0.5.0 DEBIAN_hslogger_1.0.4 DEBIAN_hslogger_1.0.3.1 DEBIAN_hslogger_1.0.3 DEBIAN_hslogger_1.0.2 DEBIAN_hslogger_1.0.1 DEBIAN_hslogger_1.0.0 Conversion_from_MissingH_Arch_repository Compiles_now Checkpointing_here Builds_on_Windows Before_splitting_off_components_from_MissingH Before_removing_large_packages Before_major_transition_work Before_GHC_6.6_transition 1.2.7
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
142 lines (112 sloc) 4.71 KB
{- |
Module : System.Log.Handler.Growl
Copyright : Copyright (C) 2007-2011 John Goerzen <jgoerzen@complete.org>
License : BSD3
Maintainer : Richard M. Neswold, Jr. <rich.neswold@gmail.com>
Stability : provisional
Portability: portable
Simple log handlers
Written by Richard M. Neswold, Jr. rich.neswold\@gmail.com
-}
module System.Log.Handler.Growl(addTarget, growlHandler)
where
import Data.Char
import Data.Word
import Network.Socket
import Network.BSD
import System.Log
import System.Log.Handler
import System.Log.Formatter
data GrowlHandler = GrowlHandler { priority :: Priority,
formatter :: LogFormatter GrowlHandler,
appName :: String,
skt :: Socket,
targets :: [HostAddress] }
instance LogHandler GrowlHandler where
setLevel gh p = gh { priority = p }
getLevel = priority
setFormatter gh f = gh { formatter = f }
getFormatter = formatter
emit gh lr _ = let pkt = buildNotification gh nmGeneralMsg lr
in mapM_ (sendNote (skt gh) pkt) (targets gh)
close gh = let pkt = buildNotification gh nmClosingMsg
(WARNING, "Connection closing.")
s = skt gh
in mapM_ (sendNote s pkt) (targets gh) >> sClose s
sendNote :: Socket -> String -> HostAddress -> IO Int
sendNote s pkt ha = sendTo s pkt (SockAddrInet 9887 ha)
-- Right now there are two "notification names": "message" and
-- "disconnecting". All log messages are sent using the "message"
-- name. When the handler gets closed properly, the "disconnecting"
-- notification gets sent.
nmGeneralMsg :: String
nmGeneralMsg = "message"
nmClosingMsg :: String
nmClosingMsg = "disconnecting"
{- | Creates a Growl handler. Once a Growl handler has been created,
machines that are to receive the message have to be specified. -}
growlHandler :: String -- ^ The name of the service
-> Priority -- ^ Priority of handler
-> IO GrowlHandler
growlHandler nm pri =
do { s <- socket AF_INET Datagram 0
; return GrowlHandler { priority = pri, appName = nm, formatter=nullFormatter,
skt = s, targets = [] }
}
-- Converts a Word16 into a string of two characters. The value is
-- emitted in network byte order.
emit16 :: Word16 -> String
emit16 v = let (h, l) = (fromEnum v) `divMod` 256 in [chr h, chr l]
emitLen16 :: [a] -> String
emitLen16 = emit16 . fromIntegral . length
-- Takes a Service record and generates a network packet
-- representing the service.
buildRegistration :: GrowlHandler -> String
buildRegistration s = concat fields
where fields = [ ['\x1', '\x4'],
emitLen16 (appName s),
emitLen8 appNotes,
emitLen8 appNotes,
appName s,
foldl packIt [] appNotes,
['\x0' .. (chr (length appNotes - 1))] ]
packIt a b = a ++ (emitLen16 b) ++ b
appNotes = [ nmGeneralMsg, nmClosingMsg ]
emitLen8 v = [chr $ length v]
{- | Adds a remote machine's address to the list of targets that will
receive log messages. Calling this function sends a registration
packet to the machine. This function will throw an exception if
the host name cannot be found. -}
addTarget :: HostName -> GrowlHandler -> IO GrowlHandler
addTarget hn gh = do { he <- getHostByName hn
; let ha = hostAddress he
sa = SockAddrInet 9887 ha
in do { sendTo (skt gh) (buildRegistration gh) sa
; return gh { targets = ha:(targets gh) } } }
-- Converts a Priority type into the subset of integers needed in the
-- network packet's flag field.
toFlags :: Priority -> Word16
toFlags DEBUG = 12
toFlags INFO = 10
toFlags NOTICE = 0
toFlags WARNING = 2
toFlags ERROR = 3 -- Same as WARNING, but "sticky" bit set
toFlags CRITICAL = 3 -- Same as WARNING, but "sticky" bit set
toFlags ALERT = 4
toFlags EMERGENCY = 5 -- Same as ALERT, but "sticky" bit set
-- Creates a network packet containing a notification record.
buildNotification :: GrowlHandler
-> String
-> LogRecord
-> String
buildNotification gh nm (p, msg) = concat fields
where fields = [ ['\x1', '\x5'],
emit16 (toFlags p),
emitLen16 nm,
emit16 0,
emitLen16 msg,
emitLen16 (appName gh),
nm,
[],
msg,
appName gh ]