#lang scheme
(require
(lib "md5.ss" "file"))
(define (md5-bytes in)
(let* ([chars (bytes->string/utf-8 (md5 in))]
[count (/ (string-length chars) 2)]
[bytes (make-bytes count)])
(for ([i (in-range 0 count)])
(let ([j (* i 2)])
(bytes-set! bytes i (string->number (substring chars j (+ j 2)) 16))))
bytes))
(define growl%
(class object%
(init-field
name
notifications)
(init
[hostname "localhost"]
[port-no 9887])
(super-new)
(define socket
(udp-open-socket hostname port-no))
(udp-connect! socket hostname port-no)
(let ([message (open-output-bytes 'message)]
[name (string->bytes/utf-8 name)]
[defaults (for/fold ([defaults '()]) ([i (in-naturals)] [n notifications])
(if (or (null? (cddr n)) (caddr n))
(cons i defaults)
defaults))])
(write-byte 1 message) (write-byte 0 message)
(write-bytes (integer->integer-bytes (bytes-length name) 2 #f #t) message)
(write-byte (length notifications) message)
(write-byte (length defaults) message)
(write-bytes name message)
(for ([n notifications])
(let ([type (string->bytes/utf-8 (cadr n))])
(write-bytes (integer->integer-bytes (bytes-length type) 2 #f #t) message)
(write-bytes type message)))
(for ([d defaults])
(write-byte d message))
(write-bytes (md5-bytes (get-output-bytes message)) message)
(udp-send socket (get-output-bytes message)))
(define/public (notify id
#:title [title name] #:description description
#:priority [priority 0] #:sticky [sticky? #f])
(let ([n (assoc id notifications)])
(let ([message (open-output-bytes 'message)]
[name (string->bytes/utf-8 name)]
[type (string->bytes/utf-8 (cadr n))]
[title (string->bytes/utf-8 title)]
[description (string->bytes/utf-8 description)])
(write-byte 1 message) (write-byte 1 message)
(write-bytes
(integer->integer-bytes
(bitwise-ior
(case (min (max -2 priority) 2)
[(-2) 10]
[(-1) 12]
[( 0) 0]
[(+1) 2]
[(+2) 4])
(if sticky? 1 0))
2 #f #t)
message)
(write-bytes (integer->integer-bytes (bytes-length type) 2 #f #t) message)
(write-bytes (integer->integer-bytes (bytes-length title) 2 #f #t) message)
(write-bytes (integer->integer-bytes (bytes-length description) 2 #f #t) message)
(write-bytes (integer->integer-bytes (bytes-length name) 2 #f #t) message)
(write-bytes type message)
(write-bytes title message)
(write-bytes description message)
(write-bytes name message)
(write-bytes (md5-bytes (get-output-bytes message)) message)
(udp-send socket (get-output-bytes message)))))
(define/public (close)
(udp-close socket))))
(provide/contract
[growl% class?])