packages feed

GrowlNotify-0.1: growlnotify.hs

import Data.Word
import Data.Binary.Put
import qualified Data.ByteString.Lazy as B
import qualified Char
import Data.Digest.MD5
import Network.Socket
import System (getArgs)


growl_udp_port=9887
growl_protocol_version=1
growl_type_registration=0
growl_type_notification=1

makeBS s =  B.pack $ map (fromIntegral . Char.ord) s

putString :: String -> Put
putString = do putLazyByteString . makeBS

-- register this application and its notification with growl
-- any notifications will be on by default
registrationPacket :: String -> [String]  -> B.ByteString
registrationPacket appName notiNames = runPut $ do
    putWord8 growl_protocol_version
    putWord8 growl_type_registration
    putWord16be $ fromIntegral $ length appName
    putWord8 $ fromIntegral $ lengthnames
    putWord8 $ fromIntegral $ lengthnames
    putString appName
    mapM_ addNotification notiNames
    mapM_ putWord8 [0..(fromIntegral lengthnames)-1]
    where
        addNotification :: String -> Put
        addNotification s = do
            putWord16be $ fromIntegral $ length s
            putLazyByteString $ makeBS s
        lengthnames = length notiNames

-- make a notification
notificationPacket :: String -> String -> String -> String -> B.ByteString
notificationPacket appName notification title description = runPut $ do
    putWord8 growl_protocol_version
    putWord8 growl_type_notification
    putWord16be 0
    putLength notification
    putLength title
    putLength description
    putLength appName
    putString notification
    putString title
    putString description
    putString appName
    where
        putLength = putWord16be . fromIntegral . length

addMD5Sum :: String -> B.ByteString -> B.ByteString
addMD5Sum password message = B.append message s
    where
        s = B.pack $ hash $ map fromIntegral $ B.unpack $ B.append message bspassword
        bspassword = makeBS password

main = do
    args <- getArgs
    (server,title, message) <- case args of
        server:title:message -> return $ (server, title, message)
        _                    -> error "Usage: server title message"
    let b =  registrationPacket "growlnotify" ["Command-Line Growl Notification"]
    let m = addMD5Sum "None" b
    let b2 = notificationPacket "growlnotify" "Command-Line Growl Notification" title (unwords message)
    let m2 = addMD5Sum "None" b2
    doit server m 
    doit server m2
    where
        port   = 9887
        doit server m = do
            let d = map (Char.chr . fromIntegral) $ B.unpack m
            s <- socket AF_INET Datagram  0
            write server s d
            sClose s
        write :: String -> Socket -> String -> IO ()
        write server sock s = do
            addr <- inet_addr server
            sendTo sock s (SockAddrInet (fromIntegral port) addr) 
            return ()