#
# defs.tcl by bdolicki@arsdigita.com
# Part of the ArsDigita MTA monitor
#
# Scheduling is at the end of the file


proc maybe_log message {
 ## Comment this out if you are annnoyed with too much logging.
 ns_log Notice "mmon: $message"
}

proc mmon_toolbar {} {
  ## Create a toolbar with links delimited by "|" character.  If the
  ## current page is among the pages in the toolbar, it will appear on
  ## the toolbar as ordinary text rather than as a link.
  set full_url_list [split [ns_conn url] /]
  set end_url [lindex $full_url_list [expr [llength $full_url_list] - 1]]
  set items {
   {controlpanel.tcl "Control panel"}
   {adhoc.tcl "Ad hoc test"}
   {server-add.tcl "Add a server"}
   {doc.html "Documentation"}
   {data-model.txt "Data model"}
   {mmon.ini.txt "mmon.ini"}
  }
  foreach url_text $items {
   set url [lindex $url_text 0]
   set text [lindex $url_text 1]
   if {$end_url == $url} {
      append toolbar "$text | "
   } {append toolbar "<a href=\"$url\">$text</a> | "}
  }
  return [string trimright $toolbar "| "]
}

proc mmon_once {} {
    set db [ns_db gethandle]
    set list_of_ids [database_to_tcl_list $db "
        SELECT server_id from mmon_servers
    "]
    ns_db releasehandle $db
    mmon_list_of_ids "$list_of_ids"
}

proc  mmon_list_of_ids  server_ids {
  set db [ns_db gethandle]
  set run_count [database_to_tcl_string $db "select mmon_run_count.nextval from dual"]
  ## This global array reduces somewhat the number of DB transactions:
  ## We want it to be unique for this run (so that we can run multiple copies
  ## of this procedure concurrently) and we embed run_count into its name:
  ns_share sent_emailets_$run_count

  ##
  #  Part One - The Sender (testing SMTP port response and sending emailets)
  ##

  foreach server_id $server_ids {
     maybe_log "Monitoring the server $server_id"
     ns_db dml $db "BEGIN TRANSACTION"
     ## Let's lock this server's row just in case...
     set selection [ns_db 0or1row $db "
           SELECT *
             FROM mmon_servers
            WHERE server_id = $server_id
       FOR UPDATE"]
     if {$selection == ""} {
         ## this row got deleted from the database while we were running this
         ns_db dml $db "END TRANSACTION"
         continue
     }
     set_variables_after_query
     ## Now variables such as: ip_or_hostname, smtp_port, smtp_ok_p, last_unbounced_emailet_id... are set
     maybe_log "Mmon testing $ip_or_hostname ..."
     set timeout [mmon_smtp_timeout]
     set bounce_timeout [mmon_bounce_timeout]
     ## Trap #1 for SMTP problems:
     ## Try to connect to the SMTP port...
     if { [catch {
       maybe_log "Connecting to the port $smtp_port of $ip_or_hostname..."
       set sock [ns_sockopen $ip_or_hostname $smtp_port]
       maybe_log "Connected to $ip_or_hostname:$smtp_port!"
     } errMsg ] } {
       # We weren't able to connect to the port.
       maybe_log "Couldn't connect to $ip_or_hostname:$smtp_port: $errMsg"
       if {$smtp_ok_p == "t"} {
          # Record the new state of affairs in the database:
          mmon_updatedb_smtp_problem $db $server_id $errMsg
       }
       ns_db dml $db "END TRANSACTION"
       continue
     }
     set rfp [lindex $sock 0]
     set wfp [lindex $sock 1]
     ## Trap #2 for SMTP problems:
     ## Parlez-Vous SMTP?
     if { [catch {
       mmon_smtp_recv $rfp 220 $timeout
       mmon_smtp_send $wfp "HELO AOLserver [ns_info hostname]" $timeout
       mmon_smtp_recv $rfp 250 $timeout
     } errMsg ] } {
       ## Although we were able to connect to the SMTP server the chat
       ## sequence has failed.  The SMTP server is not working
       ## properly.  Let's do our best to close the conversation
       ## cleanly:
       catch {mmon_end_smtp_chat $rfp $wfp $timeout}
       maybe_log "$ip_or_hostname didn't want to talk to us :-("
       if {$smtp_ok_p == "t"} {
          ## Record the new state of affairs in the database:
          mmon_updatedb_smtp_problem $db $server_id $errMsg
       }
       ns_db dml $db "END TRANSACTION"
       continue
     }
     ## We have successfully started a chat sequence with the SMTP server.
     ## That may be a big news for someone:
     if {$smtp_ok_p == "f"} {
        ## Record the good news in the database:
        mmon_updatedb_smtp_working $db $server_id
     }
     ## The next step is to try to send an emailet
     if {$last_unbounced_emailet_id != ""} {
        # We don't want to touch servers from which we are still
        # expecting emailets.
        maybe_log "Still waiting for an emailet for server_id $server_id, skipping..."
        ns_db dml $db "END TRANSACTION"
        continue
     }
     if {$run_count % $run_period != $run_group} {
        # It's not time for actually sending emailets to this server
        catch {mmon_end_smtp_chat $rfp $wfp $timeout}
        # (I like to dress with catch {} everything that talks to the
        #   remote server because I don't want the whole procedure to
        #   fail just because there is a problem witho one MTA)
        ns_db dml $db "END TRANSACTION"
        continue
     }
     ## Let's try to send an emailet
     set emailet_id [ns_time]:$server_id:$run_count
     set subject emailet_id=$emailet_id
     set from [mmon_local_receiver]
     set body "
         This is a test message from the ArsDigita Mail Transport Agent\n\
         Monitor.  Normally, humans should never read what you are reading now.\n\
         The recipient of this message should be a program which should simply\n\
         reply to it.  More info on ArsDigita MTA Monitor can be found at\n\
         [mmon_about_url]
     "
     ## Trap #3 for SMTP problems:
     ## Try to actually send an emailet to the SMTP server...
     if {[catch {
        mmon_sendmail_no_begin_no_end $ip_or_hostname $timeout $bouncer_email {} \
                                      $from $subject $body {} $rfp $wfp 
     } errMsg ] } {
        ## We were not able to send the emailet.  The SMTP server is still not
        ## working properly.
        catch {mmon_end_smtp_chat $rfp $wfp $timeout}
        maybe_log "We were still unable to send an emailet to $ip_or_hostname"
        if {$smtp_ok_p == "t"} {
           # Record the new state of affairs in the database:
           mmon_updatedb_smtp_problem $db $server_id $errMsg
        }
        ns_db dml $db  "END TRANSACTION"
        continue
     }
     ## We have successfully sent the emailet.
     catch {mmon_end_smtp_chat $rfp $wfp $timeout}
     maybe_log "Successfully sent the emailet $emailet_id to $ip_or_hostname"
     ## Let's record that in the global array:
     array set sent_emailets_$run_count [list $server_id $emailet_id]
     ns_db dml $db  "END TRANSACTION"
     continue
  } 
  # ---- End of the loop over $server_ids

  ##
  #  Part Two - The Checker (checking whether the emailets have bounced)
  ##

  if { [info exists sent_emailets_$run_count] } {
    # We have sent some emailets in the Part One.  Let's see if they will come back.
    ## Allow some time for the emailets we sent in Part One to bounce...
    ## Someone might need this handle during that time:
    ns_db releasehandle $db
    ns_sleep $bounce_timeout
    set db [ns_db gethandle]
    ## Now, let's see what has happened to emailets we sent some 60 seconds
    ## ago. We expect that for most of them the Receiver has set the array
    ## value to ""
    foreach server_id [array names sent_emailets_$run_count] {
       set emailet_id [lindex [array get sent_emailets_$run_count $server_id] 1] 
       if { $emailet_id == ""} {
          # The Receiver has set this array value to "".  That means that
          # this emailet has happily arrived, let's go to the next one:
          continue
       }
       # If we are here it means that the emailet sent to the server $server_id
       # hasn't bounced on time.
       ## As this is a shared array we want to be sure that somebody hasn't put
       ## a noninteger:
       if {![regexp {^[0-9][0-9]*$} $server_id]} continue
       ns_db dml $db "BEGIN TRANSACTION"
       set selection [ns_db 0or1row $db "
             SELECT *
               FROM mmon_servers
              WHERE server_id = $server_id
         FOR UPDATE"]
       if {$selection == ""} {
           ns_db dml $db "END TRANSACTION"
           continue
       }
       set_variables_after_query
       ## Before we proceed, let's make sure that we don't overwrite
       ## possible good news that are being written to the database right
       ## now by the Receiver (i.e. that the Receiver has the last word):
       if { [lindex [array get sent_emailets_$run_count $server_id] 1] == ""} {
          ns_db dml $db "END TRANSACTION"
          continue
       }
       set errMsg "emailet hasn't bounced"
       mmon_updatedb_throughput_problem $db $server_id $emailet_id $errMsg
       ns_db dml $db "END TRANSACTION"
       # In the rare event that the Receiver has got the emailet since
       # we last checked (couple of lines above and couple of
       # microseconds ago), his SELECT will begin now, he will see the
       # changes we have just made in the database and the good news
       # will be registered in the database imediatelly after the bad
       # news.
    }
    # ---- End of the loop over [array names sent_emailets_$run_count]
    ## Let's clean up a little bit
    unset sent_emailets_$run_count
  }
  # ---- End of if { [info exists sent_emailets_$run_count] } 

  ##
  #  Part Three - The Messenger (sending notifications)
  ##

  set minutes_since_last_notification [
       database_to_tcl_string $db "
          SELECT (sysdate - last_notification_time)*1440
            FROM mmon_global_state
  "]
  maybe_log "Last notification sent $minutes_since_last_notification minutes ago"
  if {$minutes_since_last_notification >= [mmon_min_notification_interval]
      || $minutes_since_last_notification == ""} {
     # If less than fifteen minutes has passed since last notification
     # we simply skip this part and leave it for another occasion
     ns_db dml $db "BEGIN TRANSACTION"
     set selection [ns_db select $db "
       SELECT event_id, to_char(l.event_time, 'YYYY-MM-DD HH24:MI:SS') as event_time,
              l.event_description, l.error_message, s.server_id, s.ip_or_hostname
         FROM mmon_log l, mmon_servers s
        WHERE l.server_id = s.server_id
          AND l.event_reported_p = 'f'
     ORDER BY l.server_id, event_id
   FOR UPDATE
     "] 
     set events_count 0
     set servers_involved_count 0
     set last_server_id "fooXbar"
     set report ""
     while {[ns_db getrow $db $selection]} {
        set_variables_after_query
        incr events_count
        if {$last_server_id != $server_id} {
           incr servers_involved_count
        }
        append report "$server_id $event_time $ip_or_hostname $event_description $error_message\n"
        set last_server_id $server_id
     }
     if {$report != ""} {
        set notification_email [mmon_notification_email]
        set notification_robot_email [mmon_notification_robot_email]
        set subject "$events_count new event(s) involving $servers_involved_count server(s)"
        if [catch {ns_sendmail $notification_email $notification_robot_email $subject $report}] {
          maybe_log "Sending notification failed.  Retrying..."
          ns_sleep 10
          if [catch {ns_sendmail $notification_email $notification_robot_email $subject $report}] {
            maybe_log "Sending notification failed again.  Quitting..."
            set sent_notifications_p 0
          } else {
            set sent_notifications_p 1
            maybe_log "The Second attempt to send notification succeeded."
          }
        } else {
          set sent_notifications_p 1
          maybe_log "Successfully sent the notification."
        }
        if {$sent_notifications_p} {
           ns_db dml $db "
             UPDATE mmon_log
                SET event_reported_p = 't'
              WHERE event_reported_p = 'f'
           "
           ns_db dml $db "
             UPDATE mmon_global_state
                SET last_notification_time = sysdate
           "
        }
     }
     ns_db dml $db "END TRANSACTION"
  }
  ns_db releasehandle $db

}

proc mmon_updatedb_smtp_problem {db server_id {errMsg ""}} {
     ns_db dml $db "BEGIN TRANSACTION"
     ns_db dml $db "UPDATE mmon_servers
                       SET smtp_ok_p = 'f'
                     WHERE server_id = $server_id"
     ns_db dml $db "
       INSERT INTO mmon_log (event_id, server_id, event_time, event_description, error_message)
            VALUES (mmon_event_count.nextval, $server_id, sysdate, 'smtp_problem', [ns_dbquotevalue $errMsg])"
     ns_db dml $db "END TRANSACTION"
}

proc mmon_updatedb_smtp_working {db server_id} {
     ns_db dml $db "BEGIN TRANSACTION"
     ns_db dml $db "UPDATE mmon_servers
                       SET smtp_ok_p = 't'
                     WHERE server_id = $server_id"
     ns_db dml $db "
      INSERT INTO mmon_log (event_id, server_id, event_time, event_description)
           VALUES (mmon_event_count.nextval, $server_id, sysdate, 'smtp_working')"
     ns_db dml $db "END TRANSACTION"
}

proc mmon_updatedb_throughput_problem {db server_id emailet_id errMsg} {
  ns_db dml $db "BEGIN TRANSACTION"
  ns_db dml $db "UPDATE mmon_servers
                    SET last_unbounced_emailet_id = '$emailet_id'
                  WHERE server_id = $server_id" 

  ns_db dml $db "INSERT INTO mmon_log (
                           event_id, server_id, event_time, event_description, error_message, emailet_id)
                      VALUES (
   mmon_event_count.nextval, $server_id, sysdate, 'unbounced_emailet', [ns_dbquotevalue $errMsg], '$emailet_id')"
  ns_db dml $db "END TRANSACTION"
}

proc mmon_system_owner {} {
    set custom_owner [mmon_parameter SystemOwner]
    if ![empty_string_p $custom_owner] {
        return $custom_owner
    } else {
        return SetSystemOwner@ini.file
    }
}

proc mmon_host_administrator {} {
    set custom_host_admin [mmon_parameter HostAdministrator]
    if ![empty_string_p $custom_host_admin] {
        return $custom_host_admin
    } else {
        return SetHostAdministrator@ini.file
    }
}

proc mmon_signature {} {
    return "<address><a href=\"mailto:[mmon_system_owner]\">[mmon_system_owner]</a></address>"

}

proc mmon_about_url {} {
    set custom_about_url [mmon_parameter AboutURL]
    if ![empty_string_p $custom_about_url] {
        return $custom_about_url
    } else {
        return SetAboutURL@ini.file
    }
}

proc mmon_about_link {} {
    return "<a href=\"[mmon_about_url]\">ArsDigita MTA Monitor</a>"
}

proc mmon_system_name {} {
    set custom_name [mmon_parameter SystemName]
    if ![empty_string_p $custom_name] {
	return $custom_name 
    } else {
	return "ArsDigita MTA Monitor"
    }
}

proc mmon_local_receiver {} {
   return "[mmon_parameter LocalReceiver]"
}

proc mmon_min_notification_interval {} {
    set min_notification_interval [mmon_parameter MinNotificationInterval]
    if ![empty_string_p $min_notification_interval] {
        return $min_notification_interval
    } else {
        return 15
    }
}

proc mmon_notification_email {} {
    set notification_email [mmon_parameter NotificationEmail]
    if ![empty_string_p $notification_email] {
        return $notification_email
    } else {
        return 15
    }
}

proc mmon_return_error_page {status msg {longmsg {}}} {
    ns_return $status text/html "<html>
<head>
<title>$msg</title>
</head>
<body bgcolor=#ffffff text=#000000>
<h2>$msg</h2>
<hr>
$longmsg
<p>
You can
<a href=\"mailto:[mmon_host_administrator]\">send the administrator
email at [mmon_host_administrator]</a>.
<hr>
<a href=\"mailto:[mmon_system_owner]\">[mmon_system_owner]</a>
</body>
</html>"

return -code return

}

proc mmon_stream_database_error {} {
    ns_write "<p>
Our server <strong>can't connect to the relational database right now</strong>.  This
is presumably because of a system administration problem.  You can <a
href=\"mailto:[mmon_host_administrator]\">send the administrator
email at [mmon_host_administrator]</a> and ask him/her to fix 
[ns_conn location]."

return

}



proc mmon_adhoc_test {bouncer_email ip_or_hostname smtp_timeout bounce_timeout} {

   ## This procedure uses ns_write to give the user warm feeling
   ## of what's going on.  That means that the caling procedure
   ## has to output HTTP headers.
   
   ns_share sent_emailets_0
   
   set smtp_port 25
   set bcclist {}
   set from [mmon_local_receiver]
   set body "
This is a test message from the ArsDigita Mail Transport Agent
Monitor.  Normally, humans should never read what you are reading now.
The recipient of this message should be a program which should simply
reply to it.  More info on ArsDigita MTA Monitor can be found at
[mmon_about_url]
"
   set extraheaders {}
   
   set emailet_id [ns_time]:$ip_or_hostname:0
   # The second field is normally server_id.  As we don't use the database
   # in ad hoc testing we set it to ip_or_hostname instead.  That will
   # signal the Receiver that tis is an ad hoc test.  Similarly, we set
   # the third field (normally run_count) to zero.
   set sent_emailets_0($ip_or_hostname) $emailet_id
   set subject "emailet_id=$emailet_id"
   
   if ![regexp {^[0-9][0-9]*$} $bounce_timeout] {
     ns_write "Er... would you please submit an <strong>integer</strong>
      instead of \"<strong>$bounce_timeout</strong>\"  
      " 
     return 0
   }

   ns_write "<p>Let's try to send an emailet to $ip_or_hostname...</p>"
   
   if [catch {mmon_sendmail $ip_or_hostname $smtp_port $smtp_timeout $bouncer_email \
                           $bcclist $from $subject $body \
                           $extraheaders} errMsg
   ] then {ns_write "Oooops, something has gone wrong: <strong>$errMsg</strong><br>"
   return 0
   } else {ns_write "<blockquote>Sent!</blockquote>
   OK, now let's see if we'll receive an anwer...
   <blockquote>
   "}
   
   set RetriesCount 1
   while {$RetriesCount <= $bounce_timeout} {
     ns_sleep 1
     if {"$sent_emailets_0($ip_or_hostname)" == ""} {
       ns_write "Got it!</blockquote>
       The MTA at the port $smtp_port on $ip_or_hostname is working.
       "
       return 1
     }
     ns_write "$RetriesCount ...<br>"
     incr RetriesCount
   }
   
   ns_write "</blockquote>
   Hmmmm. We <strong>haven't got an answer</strong> after $bounce_timeout
   seconds.  It looks like the connection between our server and
   <tt>$ip_or_hostname</tt> is kinda slow.  Maybe the script that should
   respond to every email sent to <tt>$bouncer_email</tt> is not working.
   Or maybe <b>$bounce_timeout</b> is too short.  Or maybe there is even a real
   problem with your MTA!"

   return 0
}

proc mmon_mail_daily_report {} {
    set db [ns_db gethandle]
    set bad_events_week [database_to_tcl_list $db "
      SELECT COUNT(*) FROM mmon_log
      WHERE (event_description = 'smtp_problem' OR event_description = 'unbounced_emailet')
        AND event_time > sysdate - 7
    "]
    
    set servers_involved_week [database_to_tcl_list $db "
      SELECT COUNT(*)
        FROM (SELECT DISTINCT server_id FROM mmon_log
               WHERE (event_description = 'smtp_problem' OR event_description = 'unbounced_emailet')
                 AND event_time > sysdate - 7)
    "]
    
    set bad_events_day [database_to_tcl_list $db "
      SELECT COUNT(*) FROM mmon_log
      WHERE (event_description = 'smtp_problem' OR event_description = 'unbounced_emailet')
        AND event_time > sysdate - 1
    "]
    
    set servers_involved_day [database_to_tcl_list $db "
      SELECT COUNT(*)
        FROM (SELECT DISTINCT server_id FROM mmon_log
               WHERE (event_description = 'smtp_problem' OR event_description = 'unbounced_emailet')
                 AND event_time > sysdate - 1)
    "]

    set subject "MTA performance report [ns_fmttime [ns_time] {%a %e %h}]"

    set body "
      $bad_events_day bad events involving $servers_involved_day servers in last 24 hours
      $bad_events_week bad events involving $servers_involved_week servers in last 7 days
    "
    
    set selection [ns_db select $db "
      SELECT *
        FROM mmon_servers
       WHERE last_unbounced_emailet_id is not NULL
          OR smtp_ok_p = 'f'"]

    set still_down ""
    while {[ns_db getrow $db $selection]} {
      set_variables_after_query
      append still_down "
      $ip_or_hostname"
      set emailet_loss 0
      if {$last_unbounced_emailet_id != ""} {
         append still_down " Emailet loss"
         set emailet_loss 1
      }
      if {$smtp_ok_p == "f"} {
         if {$emailet_loss == 1} {append still_down " | "}
         append still_down " SMTP problem"
      }
    }
    if {$still_down != ""} {
      append body "
      Following servers are still having problems:
      $still_down
      "
    }

    ns_db releasehandle $db
    set notification_email [mmon_notification_email]
    set notification_robot_email [mmon_notification_robot_email]
    ns_sendmail $notification_email $notification_robot_email $subject $body
}

proc mmon_smtp_timeout {} {
return [mmon_parameter SMTPTimeout]
}

proc mmon_minutes_between_smtp_checks {} {
return [mmon_parameter MinutesBetweenSMTPChecks "" 5]
}

proc mmon_bounce_timeout {} {
return [mmon_parameter BounceTimeout "" 60]
}

proc mmon_notification_robot_email {} {
return [mmon_parameter NotificationRobotEmail]
}

proc mmon_enabled {} {
return [mmon_parameter MonitorEnabled]
}

# These three procedures: mmon_smtp_send, mmon_smtp_recv and mmon_sendmail
# are the copies of the procedures beginning with underscores found at
# modules/tcl/sendmail.tcl.  I could simply have used them directly, but
# as they are not documented their interface might change in the future
# releases of AOLserver.  It's safer to repeat them here.  Besides,
# we might want to customize them...


proc mmon_smtp_send {wfp string timeout} {
    if {[lindex [ns_sockselect -timeout $timeout {} $wfp {}] 1] == ""} {
	error "Timeout writing to SMTP host"
    }
    puts $wfp $string\r
    flush $wfp
}

proc mmon_smtp_recv {rfp check timeout} {
    while (1) {
	if {[lindex [ns_sockselect -timeout $timeout $rfp {} {}] 0] == ""} {
	    error "Timeout reading from SMTP host"
	}
	set line [gets $rfp]
	set code [string range $line 0 2]
	if ![string match $check $code] {
	    error "Expected a $check status line; got:\n$line"
	}
	if ![string match "-" [string range $line 3 3]] {
	    break;
	}
    }
}

proc mmon_sendmail {smtp smtpport timeout tolist bcclist \
	from subject body extraheaders} {
    
    ## Put the tolist in the headers
    set rfcto [join $tolist ", "]
    
    ## Build headers
    set msg "To: $rfcto\nFrom: $from\nSubject: $subject\nDate: [ns_httptime [ns_time]]"
    
    ## Insert extra headers, if any (not for BCC)
    if ![string match "" $extraheaders] {
	set size [ns_set size $extraheaders]
	for {set i 0} {$i < $size} {incr i} {
	    append msg "\n[ns_set key $extraheaders $i]: [ns_set value $extraheaders $i]"
	}
    }
    
    ## Blank line between headers and body
    append msg "\n\n$body\n"
    
    ## Terminate body with a solitary period
    foreach line [split $msg "\n"] { 
	if [string match . $line] {
	    append data .
	}
	append data $line
	append data "\r\n"
    }
    append data .
    
    ## Open the connection
    set sock [ns_sockopen $smtp $smtpport]
    set rfp [lindex $sock 0]
    set wfp [lindex $sock 1]

    ## Perform the SMTP conversation
    if { [catch {
	mmon_smtp_recv $rfp 220 $timeout
	mmon_smtp_send $wfp "HELO AOLserver [ns_info hostname]" $timeout
	mmon_smtp_recv $rfp 250 $timeout
	mmon_smtp_send $wfp "MAIL FROM:<$from>" $timeout
	mmon_smtp_recv $rfp 250 $timeout
	
	## Loop through To list via multiple RCPT TO lines
	foreach toto $tolist {
	    mmon_smtp_send $wfp "RCPT TO:<$toto>" $timeout
	    mmon_smtp_recv $rfp 250 $timeout	
	}
	
	## Loop through BCC list via multiple RCPT TO lines
	## A BCC should never, ever appear in the header.  Ever.  Not even.
	foreach bccto $bcclist {
	    mmon_smtp_send $wfp "RCPT TO:<$bccto>" $timeout
	    mmon_smtp_recv $rfp 250 $timeout
	}
	
	mmon_smtp_send $wfp DATA $timeout
	mmon_smtp_recv $rfp 354 $timeout
	mmon_smtp_send $wfp $data $timeout
	mmon_smtp_recv $rfp 250 $timeout
	mmon_smtp_send $wfp QUIT $timeout
	mmon_smtp_recv $rfp 221 $timeout
    } errMsg ] } {
	## Error, close and report
	close $rfp
	close $wfp
	return -code error $errMsg
    }

    ## Close the connection
    close $rfp
    close $wfp
}

## This is a slightly customized version of _ns_sendmail. I have simply
## stripped the opening and closing lines.
proc mmon_sendmail_no_begin_no_end {smtp timeout tolist bcclist \
	from subject body extraheaders rfp wfp} {
    
    ## Put the tolist in the headers
    set rfcto [join $tolist ", "]
    
    ## Build headers
    set msg "To: $rfcto\nFrom: $from\nSubject: $subject\nDate: [ns_httptime [ns_time]]"
    
    ## Insert extra headers, if any (not for BCC)
    if ![string match "" $extraheaders] {
	set size [ns_set size $extraheaders]
	for {set i 0} {$i < $size} {incr i} {
	    append msg "\n[ns_set key $extraheaders $i]: [ns_set value $extraheaders $i]"
	}
    }
    
    ## Blank line between headers and body
    append msg "\n\n$body\n"
    
    ## Terminate body with a solitary period
    foreach line [split $msg "\n"] { 
	if [string match . $line] {
	    append data .
	}
	append data $line
	append data "\r\n"
    }
    append data .
    
    ## The connection is already open, and HELO message exchanged
    ## Perform the body of the SMTP conversation
    if { [catch {
	mmon_smtp_send $wfp "MAIL FROM:<$from>" $timeout
	mmon_smtp_recv $rfp 250 $timeout
	
	## Loop through To list via multiple RCPT TO lines
	foreach toto $tolist {
	    mmon_smtp_send $wfp "RCPT TO:<$toto>" $timeout
	    mmon_smtp_recv $rfp 250 $timeout	
	}
	
	## Loop through BCC list via multiple RCPT TO lines
	## A BCC should never, ever appear in the header.  Ever.  Not even.
	foreach bccto $bcclist {
	    mmon_smtp_send $wfp "RCPT TO:<$bccto>" $timeout
	    mmon_smtp_recv $rfp 250 $timeout
	}
	
	mmon_smtp_send $wfp DATA $timeout
	mmon_smtp_recv $rfp 354 $timeout
	mmon_smtp_send $wfp $data $timeout
	mmon_smtp_recv $rfp 250 $timeout
    } errMsg ] } {
	## Error
	return -code error $errMsg
    }
    ## The caller will say QUIT and close.
}

proc mmon_end_smtp_chat {rfp wfp timeout} {
     mmon_smtp_send $wfp "QUIT" $timeout
     mmon_smtp_recv $rfp 221 $timeout
     close $rfp
     close $wfp
}

proc mmon_parameter {name {subsection ""} {default ""}} {
# This is a clone of ad_parameter found in ad-defs.tcl
# of the ArsDigita Community System, ver. 1.3
    set server_name [ns_info server]
    append config_path "ns/server/" $server_name "/mmon"
    if ![empty_string_p $subsection] {
        append config_path "/$subsection"
    }
    set config_value [ns_config $config_path $name]
    if ![empty_string_p $config_value] {
        return $config_value
    } else {
        return $default
    }
}

proc mmon_context_bar args {
# This is a clone of ad_context_bar from ad-navigation.tcl
# of the ArsDigita Community System.
    set choices [list]
    set index 0
    foreach arg $args {
        incr index
        if { $index == [llength $args] } {
            lappend choices $arg
        } else {
            lappend choices "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>"
        }
    }
    return [join $choices " : "]
}

proc mmon_return_complaint {exception_count exception_text} {
# This is a clone of ad_return_complaint from ad-defs.tcl
# of the ArsDigita Community System.
    if { $exception_count == 1 } {
        set problem_string "a problem"
        set please_correct "it"
    } else {
        set problem_string "some problems"
        set please_correct "them"
    }
            
    ns_return 200 text/html "<html><head>
<title>Problem with Your Input</title></head>
<body bgcolor=white text=black>
<h2>Problem with Your Input</h2>

to <a href=/>[mmon_system_name]</a>

<hr>

We had $problem_string processing your entry:
        
<ul> 
        
$exception_text
        
</ul>
        
Please back up using your browser, correct $please_correct, and
resubmit your entry.
        
<p>
        
Thank you.
<hr>
[mmon_signature]
</body>
</html>        
"}



if {[mmon_enabled]} {
   ns_share -init {set mmon_already_scheduled 0} mmon_already_scheduled
   
   if { !$mmon_already_scheduled } {
       set mmon_already_scheduled 1
       ns_log Notice "scheduling the MTA monitor"
       set seconds_between_smtp_checks [expr 60 * [mmon_minutes_between_smtp_checks]]
       ns_schedule_proc -thread $seconds_between_smtp_checks mmon_once
       ns_log Notice "MTA monitor scheduled"
       ns_schedule_daily -thread 20 53 mmon_mail_daily_report
   }
} else {
  ns_log Notice "MTA Monitor disabled"
}
