#!/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 (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 xrecip xstatus)
	       (let ((trans (get-trans id)))
		 (slot-push! trans 'recip recip)
		 (slot-push! trans 'status status))))

(define (dosmtp id line)
  (rxmatch-let (rxmatch #/to=<([^>]+)>.*status=(\w+)/ line)
	       (#f recip status)
	       (let ((trans (get-trans id)))
		 (slot-push! trans 'recip recip)
		 (slot-push! trans 'status status))))

(define (dosmtpd id line)
  (rxmatch-let (rxmatch #/client=(.*)$/ line)
	       (#f client)
	       (let ((trans (get-trans id)))
		 (slot-push! trans 'client client))))

(define (doqmgr id line)
  (rxmatch-let (rxmatch #/from=<([^>]+)>/ line)
	       (#f sender)
	       (let ((trans (get-trans id)))
		 (slot-push! trans 'sender sender))))

(define (docleanup id line)
  (rxmatch-let (rxmatch #/message-id=<([^>]+)>/ line)
	       (#f mid)
	       (let ((trans (get-trans id)))
		 (slot-push! trans 'mid 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 ": ")
  (if (not (null? vallist))
      (for-each
       (lambda (thing)
	 (print leader "\t\t" thing))
       vallist)
      (print leader "\t\t<no-" name ">")))

(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))