Lo strumento va memorizzato in un file eseguibile /usr/local/bin/qm-log-scan; il file di configurazione va memorizzato in un file /usr/local/etc/qm-log-scan.conf

Il file di configurazione ha questa forma

set MAIL_LOG /usr/local/psa/var/log/maillog

set QMAIL_ROOT /var/qmail

set RUN_PATH /var/run/qm-log-scan

set LOG_DIRNAME log
set LAST_RUN_FILENAME lastrun

set MAIL_DEST server@webfusion.it

e permette di configurare questi parametri

• Il nome del file contentente il maillog (variabile MAIL_LOG)
• Il percorso in cui si trova il programma qmail, inclusa la configurazione e le code (variabile QMAIL_ROOT)
• Il percorso in cui lo script qm-log-scan memorizza i propri log e file temporanei (variabile RUN_PATH)
• Il nome della directory all’interno di RUN_PATH in cui memorizzare i log (variabile LOG_DIRNAME)
• Il nome del file all’interno di RUN_PATH in cui memorizzare i dati raccolti nell’ultima esecuzione dello script (variabile LAST_RUN_FILENAME)
• L’indirizzo email a cui inviare le notifiche (variabile MAIL_DEST)

Quello che segue, invece, è lo script

#!/usr/bin/tclsh


##
# Restituisce una lista dei domini presenti nella macchina
#
proc get_domains {} {
	set paths [glob /var/www/vhosts/*]
	foreach path $paths {
		lappend domains [file tail $path]
	}
	return $domains
}




#
# Variabili di configurazione
#
source /usr/local/etc/qm-log-scan.conf

set LOG_PATH [file join $RUN_PATH $LOG_DIRNAME]
set LAST_RUN [file join $RUN_PATH $LAST_RUN_FILENAME]
set QMAIL_QSTAT [file join $QMAIL_ROOT bin qmail-qstat]

if { ![file isdirectory $RUN_PATH] } { file mkdir $RUN_PATH }
if { ![file isdirectory $LOG_PATH] } { file mkdir $LOG_PATH }
if { [file isfile $LAST_RUN] } { source $LAST_RUN }
if { ![info exists start_time] } { set start_time 0 }
if { ![info exists last_pid] } { set last_pid {} }

# ottengo i domini
set domains [get_domains]


#
# verifico l'esistenza delle liste di conteggi email inviate e destinatari
# per ciascuna mailbox
#
# se queste liste esistono, sono state caricate dal file $LAST_RUN
#
if { ![info exists last_senders] } {
	set last_senders {}
}
if { ![info exists last_receivers] } {
	set last_receivers {}
}

# i conteggi di questa esecuzione li metto in due array
array set senders {}
array set receivers {}



#
# Apro il file di log!!
#
if { [catch {set fd [open $MAIL_LOG]}] } {
	exit 1
}

set start 0
set last_time $start_time

# Scansione del log
while { ! [ eof $fd ] } {

	# prendo una riga dal log
	gets $fd line

	# verifico se la riga corrisponde ad un 'invio di posta'
	if { [regexp -line -- {^(.+) (?:\S+) qmail-queue-handlers\[(\d+)]: from=(.*)$} $line result date pid sender] } {

		# istante di invio
		set time [clock scan $date]

		# con questo blocco, verifico se ho superato l'ultima lettura fatta in precedenza;
		# se così non è, passo all'iterazione successiva
		if { !$start } {
			if { $time > $start_time } {
				set start 1
			} else {
				if { $time == $start_time && ($pid == $last_pid || $last_pid == 0)  } {
					set start 1
				}
				continue
			}
		}

		
		# se arrivo qui, mi trovo tra le letture nuove

		set last_pid $pid
		set last_time $time

		# verifico che il mittente segua il formato di un indirizzo email
		if { [string match *@* $sender] } {

			# suddivido il mittente in mailbox e dominio
			set splitted [split $sender @]
			set mailbox [lindex $splitted 0]
			set domain  [lindex $splitted 1]

			# mi interessa solo la posta in uscita: il dominio deve essere tra quelli
			# disponibili sulla macchina
			if { [lsearch $domains $domain] != -1 } {

				# ho un invio da parte di una mailbox ...

				# lo registro ...
				if { [info exists senders($mailbox@$domain)] } {
					incr senders($mailbox@$domain)
				} else {
					set senders($mailbox@$domain) 1
				}

				# ... e passo a cercare i destinatari
				while { ! [ eof $fd ] } {

					# leggo la riga successiva
					gets $fd subline

					# se è un log di qmail-queue-handlers, allora devo vedere il contenuto
					if { [regexp -line -- "^(?:.+) (?:\\S+) qmail-queue-handlers\\\[$pid\]:(.*)\$" $subline full type] } {

						set type [string trim $type]

						# è un destinatario?
						if { [string match to=* $type] } {
							
							# tolta la stringa 'to=' dall'inizio di $type, il resto è il destinatario
							set receiver [string range $type 3 end]

							if { [string match *@* $receiver] } {
								if { [info exists receivers($mailbox@$domain)] } {
									incr receivers($mailbox@$domain)
								} else {
									set receivers($mailbox@$domain) 1
								}
							}

						} else {
							# no: dato che subito dopo la riga del 'from' devono esserci le righe del 'to',
							# se c'è un'altro log di qmail-queue-handlers allora sono finiti i destinatari
							# per questo messaggio. Esco dal ciclo
							break
						}

					} else {
						# non è un log di qmail-queue-handlers: probabilmente un altro processo
						# ha scritto nel log
					}
				}

			}
		}
	}
}

catch {close $fd}

# SCANSIONE DEL MAIL LOG TERMINATA


set now [clock seconds]
set machine_now [clock format $now -format "%Y%m%d-%H%M%S"]
set human_now   [clock format $now -format "%Y-%m-%d %H:%M:%S"]
set human_start [clock format $start_time -format "%Y-%m-%d %H:%M:%S"]

# è tempo di convertire le precedenti letture in array
array set aLastSenders   $last_senders
array set aLastReceivers $last_receivers

set format "%-50s %7s %13s %12s"

set logfile [file join $LOG_PATH $machine_now.txt]
set log [open $logfile w]

puts $log "Rapporto di invio mail dalla macchina [info hostname] del $human_now\n"

if { ![catch {exec $QMAIL_QSTAT} result] } {

	set lines [split $result "\n"]

	set in_queue [string trim [lindex [split [lindex $lines 0] :] end]]
	set not_proc [string trim [lindex [split [lindex $lines 1] :] end]]

	puts $log "Messaggi in coda: $in_queue   Non ancora elaborati: $not_proc\n\n"
} else {
	puts $log "Impossibile determinare la lunghezza della coda: $result\n\n"
}

puts $log "Dall'ultima esecuzione ($human_start) c'e' stata questa attivita':\n"
puts $log [format $format "<casella>" "<invii>" "<destinatari>" "<dest/invio>"]

foreach {mb count} [array get senders] {
	if { [info exists receivers($mb)] } {
		set recs $receivers($mb)
	} else {
		set recs 0
	}

	puts $log [format $format $mb $count $recs [expr {double($recs) / $count}]]

	# aggiorniamo i dati cumulativi

	# mittente...
	if { [info exists aLastSenders($mb)] } {
		incr aLastSenders($mb) $count
	} else {
		set aLastSenders($mb) $count
	}

	# destinatario...
	if { [info exists aLastReceivers($mb)] } {
		incr aLastReceivers($mb) $recs
	} else {
		set aLastReceivers($mb) $recs
	}
}

puts $log "\n"
puts $log "Dati cumulativi delle attivita' delle caselle.\n"
puts $log [format $format "<casella>" "<invii>" "<destinatari>" "<dest/invio>"]

foreach {mb count} [array get aLastSenders] {
	if { [info exists aLastReceivers($mb)] } {
		set recs $aLastReceivers($mb)
	} else {
		set recs 0
	}

	puts $log [format $format $mb $count $recs [expr {double($recs) / $count}]]
}

# chiudo (e salvo) il file di log
catch {close $log}

# TODO stampo su stdout i dati che andranno in $LAST_RUN

set last_senders   [array get aLastSenders]
set last_receivers [array get aLastReceivers]

set fd [open $LAST_RUN w]

puts $fd "set start_time $last_time"
puts $fd "set last_pid $last_pid"
puts $fd "set last_senders \[list $last_senders]"
puts $fd "set last_receivers \[list $last_receivers]"

catch {close $fd}

exec mail -s "qm-log-scan: $human_now ([info hostname])" -q $logfile $MAIL_DEST

exit 0