#!/local/gauche/bin/gosh

;
; John D. Kilburg, Copyright (c) 2003.
;

(use srfi-1)
(use srfi-13)

(define session-alist '())

;
; Get the list for a specific session ID
;
(define (get-key key)
  (let ((thing (assoc key session-alist)))
    (if (boolean? thing) '() (cdr thing))))

;
; Add data for a specific session ID
;
(define (set-key sid key data)
  (let ((slist (get-key sid)))
    (set! session-alist (alist-delete sid session-alist))
    (set! session-alist
	  (alist-cons sid
		      (alist-cons key data slist)
		      session-alist))
    ))
  
;
; pipe server line handler.  extracts the date and recipient from the line.
;
(define (dopipe sid remainder ds)
  (rxmatch-let (rxmatch #/to=<([^>]+)>.*status=(\w+)/ remainder)
	       (#f recip status)
	       (set-key sid "to" recip)
	       (set-key sid "date" ds)))

;
; smtp server line handler.  extracts the date and recipient from the line.
;
(define (dosmtp sid remainder ds)
  (rxmatch-let (rxmatch #/to=<([^>]+)>.*status=(\w+)/ remainder)
	       (#f recip status)
	       (set-key sid "to" recip)
	       (set-key sid "date" ds)))

;
; These aren't interesting for my purposes right now so do nothing.
;
(define (dosmtpd sid remainder ds) #f)
(define (docleanup sid remainder ds) #f)

;
; qmgr server line handler.  extracts the date and the sender from the line.
;
(define (doqmgr sid remainder ds)
  (rxmatch-let (rxmatch #/from=<([^>]*)>/ remainder)
	       (#f sender)
	       (set-key sid "from" sender)
	       (set-key sid "date" ds)))

;
; Parse log line.  If its postfix action then dispatch off to a daemon
; specific parsing function.
;
(define (domatch line)
  (let ((match
	 (#/^([^\s]+\s[^\s]+\s[^\s]+)\s[^\s]+\spostfix\/(\w+)\[\d+\]: ([0-9A-Z]+):(.*)$/
	    line)))
    (if (not (boolean? match))
	(let ((daemon    (match 2))   ; daemon name
	      (sid       (match 3))   ; session ID
	      (remainder (match 4))   ; daemon-specific data
	      (ds        (match 1)))  ; date string
	  (cond ((string=? "pipe" daemon)
		 (dopipe sid remainder ds))
		((string=? "smtp" daemon)
		 (dosmtp sid remainder ds))
		((string=? "smtpd" daemon)
		 (dosmtpd sid remainder ds))
		((string=? "cleanup" daemon)
		 (docleanup sid remainder ds))
		((string=? "qmgr" daemon)
		 (doqmgr sid remainder ds)))))))

;
; Print line delimited version of session
;
(define (print-pretty from date flist)
  (display (format #f "from=~a, date=~a\n" from date))
  (for-each
   (lambda (s)
     (display (format #f "\t~a=~a\n" (car s) (cdr s))))
   flist))

;
; Print comma delimited version of session useful for grep'ing
;
(define (print-ugly from date flist)
  (display (format #f "from=~a, date=~a," from date))
  (for-each
   (lambda (s)
     (display (format #f "~a=~a," (car s) (cdr s))))
   flist)
  (newline))

;
; Prints a session.  First gets the date and sender from the session data.
; Searches for interesting lines given search-terms...if search-terms are
; located then print the session.  If no search-terms then print all
; sessions.
;
(define (print-session sess search-terms pretty)
  (let ((date "")
	(flist '())
	(from "")
	(found (if (or (null? search-terms) (= (length search-terms) 0))
		   #t #f)))
    (for-each
     (lambda (s)
       (cond
	((string=? "from" (car s)) (set! from (cdr s)))
	((string=? "date" (car s)) (set! date (cdr s)))
	(#t (begin
	      (if (not found)
		  (for-each
		   (lambda (term)
		     (if (string-contains-ci (cdr s) term) (set! found #t)))
		   search-terms))
	      (set! flist (cons s flist))))))
     (cdr sess))
    ;
    ; If search matched then print the session.
    ;
    (if found
	(if pretty
	    (print-pretty from date flist)
	    (print-ugly from date flist)))))

;
; Pass individual sessions to the session printing function.
;
(define (print-sessions search-terms)
  (for-each
   (lambda (thing)
     (print-session thing search-terms #t))
   session-alist))

;
; Read from stdin and pass lines off to be processed.  Count lines and
; print progress.  Pass the arguments off to the printing function to use
; for searching for interesting stuff.
;
(define (main args)
  (let ((lnum 0))
    (port-for-each
     (lambda (line)
       (domatch line)
       (set! lnum (+ lnum 1))
       (if (= (modulo lnum 10000) 0)
	   (format (current-error-port) "Lines processed: ~a\n" lnum)))
     read-line))
  (print-sessions (cdr args)))