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)