Gauche:LogScanner
scanning postfix log
Shiro (2003/01/03 14:18:19 PST): John Kilburg contributed his script to scan postfix log. One of the Gauche's goal is to make it easy to hack up this kind of scripts (well, a kind of throwaway scripts), and I think this can be an example for those who need to write similar stuff. (NB: I added '0' at the end of main, to conform SRFI-22).
A friend of mine has been bothering me about scheme and another friend pointed out Gauche. So, I wrote a program.
I would've posted this on the Gauche Wiliki but I'm not a Japanese reader and feared that I would cause more harm than good. If this is sufficiently interesting please post it where appropriate.
Thanks for Gauche. --john
#!/usr/local/gauche/bin/gosh ; ; Author: John Kilburg <john@physics.unlv.edu> ; ; Parse logs for postfix email sessions and try to print the relevent info. ; This is my second ``useful'' scheme program so be kind... ; (define-class <trans> () ((recip :init-keyword :recip :accessor recip-slot) (sender :init-keyword :sender :accessor sender-slot) (status :init-keyword :status :accessor status-slot) (client :init-keyword :client :accessor client-slot) (mid :init-keyword :mid :accessor mid-slot))) (define trans-hash (make-hash-table 'string=?)) (define mid-hash (make-hash-table 'string=?)) (define (set-slot accessor trans val) (set! (accessor trans) (cons val (accessor trans)))) (define (get-trans key) (if (hash-table-exists? trans-hash key) (hash-table-get trans-hash key) (let ((trans (make <trans> :recip (list) :sender (list) :status (list) :client (list) :mid (list)))) (hash-table-put! trans-hash key trans) trans))) (define (dopipe id line) (rxmatch-let (rxmatch #/to=<([^>]+)>.*status=(\w+)/ line) (#f recip status) (let ((trans (get-trans id))) (set-slot recip-slot trans recip) (set-slot status-slot trans status)))) (define (dosmtp id line) (rxmatch-let (rxmatch #/to=<([^>]+)>.*status=(\w+)/ line) (#f recip status) (let ((trans (get-trans id))) (set-slot recip-slot trans recip) (set-slot status-slot trans status)))) (define (dosmtpd id line) (rxmatch-let (rxmatch #/client=(.*)$/ line) (#f client) (let ((trans (get-trans id))) (set-slot client-slot trans client)))) (define (doqmgr id line) (rxmatch-let (rxmatch #/from=<([^>]+)>/ line) (#f sender) (let ((trans (get-trans id))) (set-slot sender-slot trans sender)))) (define (docleanup id line) (rxmatch-let (rxmatch #/message-id=<([^>]+)>/ line) (#f mid) (let ((trans (get-trans id))) (set-slot mid-slot trans mid) (hash-table-push! mid-hash mid id)))) (define (domatch line) (rxmatch-let (rxmatch #/postfix\/(\w+)\[\d+\]: ([0-9A-Z]+):(.*)$/ line) (#f daemon sessid remainder) (cond ((string=? "pipe" daemon) (dopipe sessid remainder)) ((string=? "smtp" daemon) (dosmtp sessid remainder)) ((string=? "smtpd" daemon) (dosmtpd sessid remainder)) ((string=? "cleanup" daemon) (docleanup sessid remainder)) ((string=? "qmgr" daemon) (doqmgr sessid remainder))))) (define (print-detail-list leader name vallist) (print leader "\t" name ": ") (for-each (lambda (thing) (print leader "\t\t" thing)) vallist)) (define (print-trans leader key trans) (print leader key ": ") (print-detail-list leader "Client" (client-slot trans)) (print-detail-list leader "Recip" (recip-slot trans)) (print-detail-list leader "Sender" (sender-slot trans)) (print-detail-list leader "MID" (mid-slot trans)) (print-detail-list leader "Status" (status-slot trans))) (define (print-sessions) (hash-table-for-each trans-hash (lambda (key val) (print-trans "" key val) (for-each (lambda (mid) (for-each (lambda (sessid) (if (not (string=? sessid key)) (print-trans "\t" sessid (get-trans sessid)))) (hash-table-get mid-hash mid))) (mid-slot val))))) (define (main args) (port-for-each (lambda (line) (with-error-handler (lambda (eo) ()) (lambda () (domatch line)))) read-line) (print-sessions) 0)