#!/usr/local/bin/scsh \
-dm -m program -e main -s
!#

;;;  ppplog.scm --- sieve ppp log files

;;;  Copyright (C) 2002-2003 by Walter C. Pelissero

;;;  Author: Walter C. Pelissero <walter@pelissero.de>
;;;  $Id: ppplog.scm,v 1.4 2003/11/20 23:41:24 wcp Exp $

;;;  This program is free software; you can redistribute it and/or
;;;  modify it under the terms of the GNU General Public License as
;;;  published by the Free Software Foundation; either version 2, or
;;;  (at your option) any later version.
;;;  This program is distributed in the hope that it will be useful,
;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;  General Public License for more details.
;;;  You should have received a copy of the GNU General Public License
;;;  along with this program; see the file COPYING.  If not, write to
;;;  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;;  Boston, MA 02111-1307, USA.

;;;  Commentary:


(define-structure program
  (export main)
  (open scheme scsh sort defrec-package list-lib)
  (begin
     
    (define *log-dir* "/var/log")

    (define-record log-entry
      month
      day
      time
      bytes-in
      bytes-out)


    ;; not the most cleaver way to do such thing
    (define month->number
      (let ((reversed-months (list "Dec" "Nov" "Oct" "Sep" "Aug" "Jul" "Jun" "May" "Apr" "Mar" "Feb" "Jan")))
	(lambda (month)
	  (length (member month reversed-months)))))


    (define (gather-data port)
      (let ((reader (field-reader (infix-splitter (rx (+ white)) -5))))
	(awk (reader port) (line fields) ((data '()))
	     ((: "IPCP: Connect time: " (submatch (+ digit))
		 " secs: " (submatch (+ digit)) " octets in, "
		 (submatch (+ digit))) =>
		 (lambda (match)
		   (cons (apply make-log-entry
				(month->number (car fields))
				(map string->number
				     (list 
				      (cadr fields)
				      (match:substring match 1)
				      (match:substring match 2)
				      (match:substring match 3)))) data))))))
    
    (define (sort-data data)
      (sort-list data (lambda (d1 d2)
			(cond ((= (log-entry:month d1) (log-entry:month d2))
			       (> (log-entry:day d1) (log-entry:day d2)))
			      (else
			       (> (log-entry:month d1) (log-entry:month d2)))))))

    (define (make-pad str n filler)
      (let ((missing (- n (string-length str))))
	(if (positive? missing)
	    (make-string missing (if (null? filler)
				     #\space
				     (car filler)))
	    "")))

    (define (pad-left str n . filler)
      (string-append (make-pad str n filler) str))
    
    (define (pad-right str n . filler)
      (string-append str (make-pad str n filler)))

    (define (format-time secs)
      (let ((pad (lambda (n c)
		   (pad-left (number->string n) 2 c))))
	(format #f "~a:~a:~a"
		(pad (quotient secs (* 60 60)) #\space)
		(pad (modulo (quotient secs 60) 60) #\0)
		(pad (modulo secs 60) #\0))))

    (define simplify-bytes
      (let* ((kilo 1024)
	     (mega (* kilo kilo))
	     (giga (* mega kilo))
	     (tera (* giga kilo)))
	(lambda (bytes)
	  (cond ((> bytes tera)
		 (format #f "~aT" (round (/ bytes tera))))
		((> bytes giga)
		 (format #f "~aG" (round (/ bytes giga))))
		((> bytes mega)
		 (format #f "~aM" (round (/ bytes mega))))
		((> bytes kilo)
		 (format #f "~aK" (round (/ bytes kilo))))
		(else
		 (format #f "~a " bytes))))))

    (define (print-entry e)
      (format #t "~a/~a ~a ~a ~a~%" (pad-left (number->string (log-entry:day e)) 2)
	      (pad-left (number->string (log-entry:month e)) 2 #\0)
	      (format-time (log-entry:time e))
	      (pad-left (simplify-bytes (log-entry:bytes-in e)) 5)
	      (pad-left (simplify-bytes (log-entry:bytes-out e)) 5)))

    (define (same-day? prec new)
      (and (= (log-entry:day prec)
	      (log-entry:day new))
	   (= (log-entry:month prec)
	      (log-entry:month new))))

    (define (compute-stats data)
      (fold (lambda (rec prec)
	      (let ((acc (car prec)))
		(cond ((not (same-day? acc rec))
		       (cons (copy-log-entry rec) prec))
		      (else
		       (set-log-entry:time acc (+ (log-entry:time rec)
						  (log-entry:time acc)))
		       (set-log-entry:bytes-in acc (+ (log-entry:bytes-in rec)
						  (log-entry:bytes-in acc)))
		       (set-log-entry:bytes-out acc (+ (log-entry:bytes-out rec)
						  (log-entry:bytes-out acc)))
		       prec))))
	    (list (copy-log-entry (car data)))
	    (cdr data)))

    (define (print-stats data)
      (for-each print-entry data))

    (define (make-stats)
      (let* ((gz-files (glob (string-append *log-dir* "/ppp.log.*.gz")))
	     (bz2-files (glob (string-append *log-dir* "/ppp.log.*.bz2")))
	     (port (run/port (begin
			       (run (cat ,(string-append *log-dir* "/ppp.log")))
			       (if (not (null? gz-files))
				   (run (zcat ,@gz-files)))
			       (if (not (null? bz2-files))
				   (run (bzcat ,@bz2-files)))))))
	(print-stats (compute-stats (sort-data (gather-data port))))
	(close-input-port port)))

    (define (main args)
      (make-stats))))


;;;
;;; Leave the following lines at end of file.
;;;
;;; Local Variables:
;;; mode:scheme
;;; scheme-program-name:"scsh"
;;; End: