;"MidgardSMTP version 1.2"
;"Copyright 1996, 1997, 1998 Midgard Systems and Adam 'Martian' Smyth"

;"This code 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"
;"of the License, 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."

;"The License is available at http://www.gnu.org/copyleft/gpl.html"

;"The author can be contacted at martian@midgard.org"
;"It is *strongly requested* that users of this code register with the author."

;"The latest release of this code can be found at"
;" http://www.midgard.org:8080/~martian/Code/MOO/smtp.moo"

;" This module is designed to be pasted as-is into a connection to a MOO server."
;" To install this module, you must be a wizard.";
;" Install in this order: FUP, $daemon, $network_utils, $dns_utils, $smtp"

;"Dependancy checks"

;"Wizperms are required for installation"
;if(!`player.wizard ! ANY');while(read()!=";\"End of Module\"");endwhile;endif

;"$daemon must be installed first."
;if(!`valid($daemon) ! ANY');while(read()!=";\"End of Module\"");endwhile;endif

;"$network_utils must be installed first."
;if(!`valid($network_utils) ! ANY');while(read()!=";\"End of Module\"");endwhile;endif

;"$dns_utils must be installed first."
;if(!`valid($dns_utils) ! ANY');while(read()!=";\"End of Module\"");endwhile;endif

;"FUP must be installed for log cycling to work."
;"If you don't wish to write process logs to disk,"
;"the code below will have to be modified."
;"Specifically, see :log and :CycleLog."
;if(!`function_info("fileappend") ! ANY');while(read()!=";\"End of Module\"");endwhile;endif

;"$list_utils:enlist must exist."
;"Install it if it doesn't."
;if(`$object_utils:has_verb($list_utils,"enlist") ! ANY');while(read()!=";\"-----\"");endwhile;endif
@verb $list_utils:enlist this none this rxd
@program $list_utils:enlist
"Makes sure the argument is a list.";
"If given a list, enlist returns the argument as it is.";
"For any other argument x, enlist returns {x}";
{x} = args;
return typeof(x) == LIST ? x | {x};
.
;"-----"

;"Begining installation..."

;"Simple sanity check. Don't make more than one, if it already exists.";
;if(`valid($smtp) ! ANY');while(read()!=";\"-----\"");endwhile;endif
@create $daemon called SMTP Daemon,smtpd,SMTP,MidgardSMTP
@corify SMTP as $smtp
;"-----"

;$smtp.description=$command_utils:read_lines()
Simple Mail Transfer Protocol Daemon.

Written by Martian
.

;$smtp.help_msg=$command_utils:read_lines()
This is the SMTP system developed by Martian at MidgardMOO

The latest release of this code can be found at http://www.midgard.org:8080/~martian/Code/MOO/smtp.moo

Installation/Setup notes:
 .localhost should contain a list of all names by which this machine is known. This allows the server to deliver mail locally.
 .Aliased maps user names to player objnums. For example, mail sent to root@<yoursite> will, by default, be directed to #2 (Usually the ArchWizard).
 .logfile contains {path, filename} for the log file. This information is passed to fileappend in :CycleLog.
 .retry_interval is the number of seconds to pause between attempts to deliver a failed message.
 .ErrorAlertPeriod is the number of seconds after which a failed delivery will prompt a warning to the sender that delivery has not gone through.
 .ErrorFailPeriod is the number of seconds after which a failed delivery will be given up on.
.

@prop $smtp."localhost" {"localhost"} r
@prop $smtp."Aliased" {{"root", #2}, {"webmaster", #2}, {"postmaster", #2}} r
@prop $smtp."logfile" {"logs", "smtp.processlog.txt"} rc
@prop $smtp."retry_interval" 900 rc
@prop $smtp."ErrorAlertPeriod" 14400 rc
@prop $smtp."ErrorFailPeriod" 172800 rc
@prop $smtp."data_que" {} ""
@prop $smtp."error_que" {} ""
@prop $smtp."process_task" 0 ""
@prop $smtp."process_error_task" 0 ""
@prop $smtp."ProcessLog" {} ""
@prop $smtp."mail_name" "" rc
@set $smtp."ListenPort" to 25
@set $smtp."service" to "SMTP"
@set $smtp."version" to "1.2"

@verb $smtp:"process_session" this none this rxd
@program $smtp:process_session
if (caller != this)
  return E_PERM;
endif
notify(player, tostr("220 ", $network.site, " ", this:version(), " ready at ", ctime()));
this:debug("SEND:220 ", $network.site, " ", this:version(), " ready at ", ctime());
host = $string_utils:connection_hostname(connection_name(player));
Helohost = "";
Rcpt = {};
returnpath = "";
gotreturnpath = 0;
lines = {};
while ((line = `read(player) ! E_INVARG') != "QUIT" && line != E_INVARG)
  this:debug("RECV:", line);
  if (match(line, "^HELO"))
    if (length(line) < 6)
      notify(player, "501 HELO requires domain address.");
      this:debug("SEND:501 HELO requires domain address.");
    else
      Helohost = line[6..length(line)];
      notify(player, tostr("250 ", $network.site, " Hello ", host, ", good to be working with you"));
      this:debug("SEND:250 ", $network.site, " Hello ", host, ", good to be working with you");
    endif
  elseif (match(line, "^MAIL"))
    if (!Helohost)
      notify(player, "503 Must have HELO before MAIL");
      this:debug("SEND:503 Must have HELO before MAIL");
    else
      if (match(line, "^MAIL FROM:.+$"))
        returnpath = line[11..length(line)];
        returnpath = $string_utils:strip_chars(returnpath, "<>");
        gotreturnpath = 1;
        notify(player, tostr("250 Sender ", returnpath, " ok"));
        this:debug("SEND:250 Sender ", returnpath, " ok");
      else
        notify(player, "501 Bad parameter");
        this:debug("SEND:501 Bad parameter");
      endif
    endif
  elseif (match(line, "^RCPT"))
    if (!gotreturnpath)
      notify(player, "503 Must have MAIL before RCPT");
      this:debug("SEND:503 Must have MAIL before RCPT");
    else
      if (match(line, "^RCPT TO:<?.+>?$"))
        Recipient = line[9..$];
        if (match(Recipient, "^<.+>$"))
          Recipient = Recipient[2..$ - 1];
        endif
        Rcpt = {@Rcpt, Recipient};
        notify(player, tostr("250 Recipient ", Recipient, " ok"));
        this:debug("SEND:250 Recipient ", Recipient, " ok");
      else
        notify(player, "501 Bad parameter");
        this:debug("SEND:501 Bad parameter");
      endif
    endif
  elseif (match(line, "^DATA"))
    if (!Rcpt)
      notify(player, "503 Must have RCPT before DATA");
      this:debug("SEND:503 Must have RCPT before DATA");
    else
      if (line == "DATA")
        notify(player, "354 Enter data, end with \".\"");
        this:debug("SEND:354 Enter data, end with \".\"");
        while ((line = `read(player) ! E_INVARG') != "." && line != E_INVARG)
          if (line && line[1] == ".")
            line = line[2..length(line)];
          endif
          lines = {@lines, line};
          this:debug("RECV:", line);
        endwhile
        if (line == E_INVARG)
          return;
        endif
        this:debug("RECV:", line);
        this.data_que = {@this.data_que, {host, Helohost, returnpath, Rcpt, lines}};
        notify(player, "250 Message accepted for delivery");
        this:debug("SEND:250 Message accepted for delivery");
        Rcpt = {};
        returnpath = "";
        lines = {};
      else
        notify(player, "504 No Parameters needed for DATA");
        this:debug("SEND:504 No Parameters needed for DATA");
      endif
    endif
  elseif (match(line, "^RSET"))
    Rcpt = {};
    returnpath = "";
    gotreturnpath = 0;
    lines = {};
    notify(player, "250 Data Reset");
    this:debug("SEND:250 Data Reset");
  elseif (match(line, "^NOOP"))
    notify(player, "250 Nothing Done");
    this:debug("SEND:250 Nothing Done");
  else
    notify(player, "502 Command not yet implemented");
    this:debug("SEND:502 Command not yet implemented");
  endif
endwhile
if (line != E_INVARG)
  this:debug("RECV:", line);
  notify(player, tostr("221 ", $network.site, " ", this:version(), " closing session"));
  this:debug("SEND:221 ", $network.site, " ", this:version(), " closing session");
  while (`buffered_output_length(player) ! E_INVARG')
    suspend(1);
  endwhile
  boot_player(player);
endif
fork (0)
  this:process_que();
endfork
.

@verb $smtp:"version" this none this rxd
@program $smtp:version
return tostr("MOO-SMTP Daemon v", this.version);
.

@verb $smtp:"NetMail2MOOMail Net2MOO N2M" this none this rxd
@program $smtp:NetMail2MOOMail
{From, To, Msg} = args;
To = $string_utils:english_list(To);
Subject = "";
Date = time();
for Line in (Msg)
  if (match(Line, "^From: ") && match(Line, ".* <.*>"))
    From = Line[index(Line, "<") + 1..index(Line, ">") - 1];
    break;
  endif
endfor
for Line in (Msg)
  if (match(Line, "^Subject:"))
    Subject = $string_utils:trim(Line[9..$]) || " ";
    break;
  endif
endfor
if (0)
  for Line in (Msg)
    if (match(Line, "^Date:"))
      Date = $network_utils:InetDateToTime(Line[7..$]);
      break;
    endif
  endfor
endif
return {Date, From, To, Subject, "", @Msg};
.

@verb $smtp:"process_message" this none this rxd
@program $smtp:process_message
if (caller != this)
  return E_PERM;
endif
QueIndex = args[1];
{Host, Helo, From, Rcpt, Msg} = this.data_que[QueIndex];
Date = $network_utils:INetSTDTime();
i = "" in Msg;
if (!(MsgID = this:MessageID(Msg)))
  MsgID = this:GenerateMsgID();
  Msg[i..i] = {tostr("Message-ID: <", MsgID, ">"), ""};
  this.data_que[QueIndex][5] = Msg;
endif
if (Host != "localhost")
  Msg = {tostr("Received: from ", Helo, Helo != Host ? " (" + Host + ")" | "", " by ", $network.site, "; ", Date), @Msg};
endif
Text = {tostr("From ", $string_utils:strip_chars(From, "<>"), " ", Date), tostr("Return-Path: ", From), @Msg};
ErrorRcpt = {};
for Who in (Rcpt)
  {Account, Site} = $string_utils:explode(Who, "@");
  if (Site in this.localhost)
    if (valid(Dest = this:MatchRecipient(Account)))
      this:raw_send(this:N2M(From, Rcpt, Text), Dest, From);
    elseif (`valid($list_server) && (Dest = $list_server:MatchRecipient(Account)) ! ANY => 0')
      $list_server:receive_message(Dest, From, Who, Msg);
    elseif (valid(Dest = $string_utils:match_player(Account)) && !$object_utils:isa(Dest, $guest))
      this:raw_send(this:N2M(From, Rcpt, Text), Dest, From);
    else
      ErrorRcpt = {@ErrorRcpt, {Site, {Account}, {$network.site}, "No such recipient", 1}};
    endif
    this.data_que[QueIndex][4] = setremove(this.data_que[QueIndex][4], Who);
    this:log(From, Who, MsgID, value_bytes(Msg));
  endif
  $command_utils:suspend_if_needed(0);
endfor
if (this.data_que[QueIndex][4])
  this:SendMessage(From, QueIndex, Msg);
endif
if (ErrorRcpt)
  this:ReturnError(From, ErrorRcpt, Msg);
endif
.

@verb $smtp:"MatchRecipient" this none this rxd
@program $smtp:MatchRecipient
if (Rcpt = $list_utils:assoc(args[1], this.Aliased, 1))
  return Rcpt[2];
else
  return $nothing;
endif
.

@verb $smtp:"SendMessage" this none this rx
@program $smtp:SendMessage
if (!caller_perms().wizard)
  return E_PERM;
endif
{From, QueIndex, Msg} = args;
if (typeof(QueIndex) != INT)
  "Must be a new message. Append it to the queue.";
  this.data_que = {@this.data_que, {$network.site, $network.site, From, $list_utils:enlist(QueIndex), Msg}};
  fork (5)
    this:process_que();
  endfork
  return 1;
endif
MsgID = this:MessageID(Msg);
Rcpt = this.data_que[QueIndex][4];
Sites = {};
for Who in (Rcpt)
  {Account, Site} = $string_utils:explode(Who, "@");
  if (i = $list_utils:iassoc(Site, Sites, 1))
    Sites[i][2] = setadd(Sites[i][2], Who);
  else
    Sites = {@Sites, {Site, {Who}, {}}};
  endif
  $command_utils:suspend_if_needed(0);
endfor
ErrorRcpt = {};
for i in [1..length(Sites)]
  if ((Sites[i][3] = this:FindMailPath(Sites[i][1])) == E_NONE)
    ErrorRcpt = {@ErrorRcpt, {Sites[i][1], Sites[i][2], Sites[i][3], "Site does not exist.", 1}};
  elseif ((Result = this:raw_sendmail(@Sites[i], From, Msg)) != 1)
    if (typeof(Result) == LIST)
      ErrorRcpt = {@ErrorRcpt, {Sites[i][1], Result, Sites[i][3], "Recipients invalid", 1}};
    else
      ErrorRcpt = {@ErrorRcpt, {Sites[i][1], Sites[i][2], Sites[i][3], Result, 0}};
    endif
  else
    this:log(From, Sites[i][2], MsgID, value_bytes(Msg));
  endif
  this.data_que[QueIndex][4] = $set_utils:diff(this.data_que[QueIndex][4], Sites[i][2]);
endfor
if (ErrorRcpt)
  this:ReturnError(From, ErrorRcpt, Msg);
  return 0;
endif
return 1;
.

@verb $smtp:"ReturnError" this none this rxd
@program $smtp:ReturnError
if (caller != this)
  return E_PERM;
endif
"ErrorRcpt = {{Site, {Recipients}, {Maildrops}, \"Error Message\", Final}, ...}";
{From, ErrorRcpt, Msg} = args;
ErrorTo = From;
for line in (Msg)
  if (m = match(line, "^Errors-to: %(.*%)$"))
    ErrorTo = substitute("%1", m);
    break;
  endif
endfor
if (!ErrorTo)
  "No return path, can't return an error.";
  return;
endif
MsgID = this:MessageID(Msg);
Text = {tostr("Date: ", $network_utils:INetSTDTime()), tostr("From: SMTP-System <postmaster@", $network.site, ">"), "Subject: Mail Bounce", tostr("To: ", ErrorTo), ""};
Final = Alert = Retry = {};
for Item in (ErrorRcpt)
  if (Item[5] == 1)
    Final = setadd(Final, Item);
  elseif (Item[5] == -1)
    Alert = setadd(Alert, Item);
  else
    Retry = setadd(Retry, Item);
  endif
endfor
if (Final)
  Text = {@Text, tostr("The system is unable to deliver this message to the following recipients."), ""};
  for Error in (Final)
    Text = {@Text, tostr($string_utils:english_list(Error[2]), " - ", Error[4])};
    this:log(From, Error[2], MsgID, value_bytes(Msg));
  endfor
  Text = {@Text, ""};
endif
if (Alert)
  Text = {@Text, "The following is for informational purposes only."};
  Text = {@Text, tostr("The system has been unable to deliver this message to the following recipients for ", $time_utils:english_time(this.ErrorAlertPeriod), ".")};
  Text = {@Text, tostr("The system will continue to attempt to deliver the mail for ", $time_utils:english_time(this.ErrorFailPeriod - this.ErrorAlertPeriod), "."), ""};
  for Error in (Alert)
    Text = {@Text, tostr(Error[1], " - ", Error[4])};
  endfor
  Text = {@Text, ""};
endif
if (Alert || Final)
  Text = {@Text, ""};
  for line in (Msg)
    Text = {@Text, tostr("> ", line)};
    $command_utils:suspend_if_needed(0);
  endfor
  this:SendMessage("", {ErrorTo}, Text);
endif
if (Retry)
  for Error in (Retry)
    this.error_que = {@this.error_que, {@Error[1..4], From, Msg, time(), 0, ErrorTo}};
  endfor
  fork (0)
    args = Text = Msg = 0;
    this:process_error_que();
  endfork
endif
.

@verb $smtp:"FindMailPath" this none this rx
@program $smtp:FindMailPath
if (!caller_perms().wizard)
  return E_PERM;
endif
Site = args[1];
if (MX = $dns_utils:lookup(Site, "MX"))
  for I in (MX)
    if (I[2] != "MX")
      MX = setremove(MX, I);
    endif
    $command_utils:suspend_if_needed(0);
  endfor
  MX = $list_utils:slice(MX, 5);
  MX = $list_utils:sort_alist(MX, 1);
  MX = $list_utils:slice(MX, 2);
  for I in [1..length(MX)]
    MX[I] = $dns_utils:lookup(MX[I], "A");
    MX[I] = (J = $list_utils:iassoc("A", MX[I], 2)) ? MX[I][J][5] | 0;
    $command_utils:suspend_if_needed(0);
  endfor
  MX = $list_utils:setremove_all(MX, 0);
endif
if (!MX)
  Addr = $dns_utils:lookup(Site, "A");
  for I in (Addr)
    if (I[2] != "A")
      Addr = setremove(Addr, I);
    endif
    $command_utils:suspend_if_needed(0);
  endfor
  Addr = $list_utils:slice(Addr, 5);
  return Addr || E_NONE;
else
  return $list_utils:remove_duplicates(MX);
endif
.

@verb $smtp:"raw_sendmail" this none this rx
@program $smtp:raw_sendmail
"raw_sendmail(Site, SiteRCPT, Maildrops, From, Msg)";
"sends mail without processing. Returns 0 if successful, or else reason why not.";
if (!caller_perms().wizard)
  return E_PERM;
endif
if (!$network.active)
  return E_NACC;
endif
{Site, SiteRCPT, Maildrops, From, Msg} = args;
suspend(0);
this.busy = 1;
for attempts in [1..5]
  for Maildrop in (Maildrops)
    if (typeof(target = $network:open(Maildrop, 25)) != ERR)
      this:debug("Connected to ", Maildrop);
      break attempts;
    else
      this:debug("Failed to connect to ", Maildrop);
    endif
  endfor
  suspend(2);
endfor
if (typeof(target) == ERR)
  this.busy = 0;
  this:debug("Cannot open connection to maildrop for ", Site);
  return tostr("Cannot open connection to maildrop for ", Site);
endif
reply = this:ReadSMTPReply(target);
if (typeof(reply) == ERR)
  notify(target, "QUIT");
  $network:close(target);
  this.busy = 0;
  return reply;
else
  this:debug("RECV:", reply);
  if (!match(reply, "^2.*$"))
    notify(target, "QUIT");
    $network:close(target);
    this.busy = 0;
    return tostr("Incorrect Connection Response: ", reply);
  endif
endif
line = tostr("HELO ", $network.site);
this:debug("SEND:", line);
notify(target, line);
reply = this:ReadSMTPReply(target);
if (typeof(reply) == ERR)
  notify(target, "QUIT");
  $network:close(target);
  this.busy = 0;
  return reply;
else
  this:debug("RECV:", reply);
  if (!match(reply, "^2.*$"))
    notify(target, "QUIT");
    $network:close(target);
    this.busy = 0;
    return tostr("Incorrect HELO Response: ", reply);
  endif
endif
line = tostr("MAIL FROM:<", From, ">");
this:debug("SEND:", line);
notify(target, line);
reply = this:ReadSMTPReply(target);
if (typeof(reply) == ERR)
  notify(target, "QUIT");
  $network:close(target);
  this.busy = 0;
  return reply;
else
  this:debug("RECV:", reply);
  if (!match(reply, "^250.*$"))
    notify(target, "QUIT");
    $network:close(target);
    this.busy = 0;
    return tostr("Incorrect MAIL Response: ", reply);
  endif
endif
goodRCPT = 0;
badRCPT = {};
for address in (SiteRCPT)
  line = tostr("RCPT TO:<", address, ">");
  this:debug("SEND:", line);
  notify(target, line);
  reply = this:ReadSMTPReply(target);
  if (typeof(reply) == ERR)
    notify(target, "QUIT");
    $network:close(target);
    this.busy = 0;
    return reply;
  else
    this:debug("RECV:", reply);
    if (!match(reply, "^250.*$"))
      badRCPT = {@badRCPT, address};
    else
      goodRCPT = 1;
    endif
  endif
endfor
if (!goodRCPT)
  notify(target, "QUIT");
  $network:close(target);
  this.busy = 0;
  return badRCPT;
endif
line = "DATA";
this:debug("SEND:", line);
notify(target, line);
reply = this:ReadSMTPReply(target);
if (typeof(reply) == ERR)
  notify(target, "QUIT");
  $network:close(target);
  this.busy = 0;
  return reply;
else
  this:debug("RECV:", reply);
  if (!match(reply, "^354.*$"))
    notify(target, "QUIT");
    $network:close(target);
    this.busy = 0;
    return tostr("Incorrect DATA Response: ", reply);
  endif
endif
for line in (Msg)
  if (line == ".")
    line = "..";
  endif
  this:debug("SEND:", line);
  while (!notify(target, line, 1))
    suspend(1);
  endwhile
  $command_utils:suspend_if_needed(0);
endfor
line = ".";
this:debug("SEND:", line);
notify(target, line);
reply = this:ReadSMTPReply(target);
if (typeof(reply) == ERR)
  notify(target, "QUIT");
  $network:close(target);
  this.busy = 0;
  return reply;
else
  this:debug("RECV:", reply);
  if (!match(reply, "^250.*$"))
    notify(target, "QUIT");
    $network:close(target);
    this.busy = 0;
    return tostr("Incorrect end-DATA Response: ", reply);
  endif
endif
line = "QUIT";
this:debug("SEND:", line);
notify(target, line);
reply = this:ReadSMTPReply(target);
this:debug("RECV:", reply);
$network:close(target);
this.busy = 0;
return badRCPT || 1;
.

@verb $smtp:"raw_send" this none this rxd
@program $smtp:raw_send
"WIZARDLY";
"raw_send(text,rcpt,from) -- does the actual sending of a message.";
"Assumes that text has already been formatted correctly.";
"Decides who to send it to and who wants to be notified about it and does so.";
"Return {E_PERM} if the caller is not entitled to use this verb.";
"Return 1 if successful.";
"";
"Copied from $mail_agent and modified to let From be a string and use $smtp for perms check.";
"";
{text, rcpt, from} = args;
if (caller != this)
  return E_PERM;
endif
$mail_agent:touch({rcpt});
resolve = $mail_agent:resolve_addr({rcpt}, this);
actual_rcpts = resolve[2];
biffs = resolve[3];
results = {};
for recip in (actual_rcpts)
  if (ticks_left() < 10000 || seconds_left() < 2)
    suspend(1);
  endif
  if (typeof(e = recip:receive_message(text, $smtp)) in {ERR, STR})
    this.owner:notify(tostr(recip, ":receive_message:  ", e));
    e = 0;
  elseif (!is_player(recip) || !e)
    "...not a player or receive_message isn't giving out the message number";
    "...no need to force a notification...";
  elseif (i = $list_utils:iassoc(recip, biffs))
    "...player-recipient was already getting a notification...";
    "...make sure notification includes a mention of him/her/itself.";
    if (!(recip in listdelete(biffs[i], 1)))
      biffs[i][2..1] = {recip};
    endif
  else
    "...player-recipient wasn't originally being notified at all...";
    biffs = {{recip, recip}, @biffs};
  endif
  results = {@results, e};
endfor
fork (0)
  for b in (biffs)
    if (ticks_left() < 10000 || seconds_left() < 2)
      suspend(1);
    endif
    if ($object_utils:has_callable_verb(b[1], "notify_mail"))
      mnums = {};
      for r in (listdelete(b, 1))
        mnums = {@mnums, (rn = r in actual_rcpts) && results[rn]};
      endfor
      this.mail_name = from;
      b[1]:notify_mail(this, listdelete(b, 1), mnums);
      this.mail_name = "";
    endif
  endfor
endfork
return 1;
.

@verb $smtp:"process_que" this none this rxd
@program $smtp:process_que
"Que format: {host, Helohost, returnpath, {Rcpt}, {lines}}";
if (!caller_perms().wizard)
  return E_PERM;
elseif (!this.enabled)
  return E_NONE;
endif
if (!$code_utils:task_valid(this.process_task))
  this.process_task = task_id();
  player = this.owner;
  while (this.data_que)
    this:process_message(1);
    this.data_que = listdelete(this.data_que, 1);
    suspend(0);
  endwhile
  this.process_task = 0;
  return 1;
endif
.

@verb $smtp:"poke prod" this none none rd
@program $smtp:poke
player:announce(player.name, " pokes ", this.name, ".");
player:tell("You poke ", this.name, ".");
this:process_que();
if (this.error_que)
  if ($code_utils:task_valid(this.process_error_task) && task_stack(this.process_error_task)[1][2] == "process_error_que")
    kill_task(this.process_error_task);
    player:announce_all(this.name, " buzzes softly, twice.");
  else
    player:announce_all(this.name, " buzzes softly.");
  endif
  this:process_error_que();
endif
if (this.data_que)
  player:announce_all(this.name, " meeps quietly.");
elseif (!this.error_que)
  player:announce_all(this.name, " chirps quietly.");
endif
.

@verb $smtp:"ReadSMTPReply" this none this rx
@program $smtp:ReadSMTPReply
if (caller != this)
  return E_PERM;
endif
fork waittask (300)
  this:debug("Reply timeout for ", args[1]);
  boot_player(args[1]);
endfork
while (typeof(reply = read(args[1])) == STR && match(reply, "^[0-9][0-9][0-9]-.*$"))
endwhile
kill_task(waittask);
return reply;
.

@verb $smtp:"process_error_que" this none this rxd
@program $smtp:process_error_que
if (!caller_perms().wizard)
  return E_PERM;
endif
if (!$code_utils:task_valid(this.process_error_task))
  this.process_error_task = task_id();
  player = this.owner;
  while (this.error_que)
    for item in (this.error_que)
      {Site, SiteRCPT, Maildrops, ErrMsg, From, Msg, QueuedSince, AlertSent, ErrorTo} = item;
      if (time() > QueuedSince + this.ErrorFailPeriod)
        this:ReturnError(From, {{Site, SiteRCPT, Maildrops, "Unable to deliver message.", 1}}, Msg);
        this.error_que = setremove(this.error_que, item);
      elseif ((result = this:raw_sendmail(Site, SiteRCPT, Maildrops, From, Msg)) == 1)
        this:log(From, SiteRCPT, this:MessageID(Msg), value_bytes(Msg));
        this.error_que = setremove(this.error_que, item);
      elseif (!AlertSent && time() > QueuedSince + this.ErrorAlertPeriod)
        this:ReturnError(From, {{Site, SiteRCPT, Maildrops, ErrMsg, -1}}, Msg);
        this.error_que[item in this.error_que][8] = 1;
      endif
      Site = SiteRCPT = Maildrops = ErrMsg = From = Msg = QueuedSince = AlertSent = ErrorTo = item = 0;
    endfor
    if (this.error_que)
      suspend(this.retry_interval);
    endif
  endwhile
  this.process_error_task = 0;
  return 1;
endif
.

@verb $smtp:"mail_name" this none this rxd Wizard
@program $smtp:mail_name
return this.mail_name || "the Internet.";
.

@verb $smtp:"MessageID" this none this rxd
@program $smtp:MessageID
Msg = args[1];
for line in (Msg)
  if (match(line, "^Message-ID: <.*>$"))
    return line[index(line, "<") + 1..index(line, ">") - 1];
  endif
endfor
return 0;
.

@verb $smtp:"GenerateMsgID" this none this rxd
@program $smtp:GenerateMsgID
return tostr(time(), $string_utils.alphabet[random($)], $string_utils.alphabet[random($)], "@", $network.site);
.

@verb $smtp:"CycleLog" this none this rxd
@program $smtp:CycleLog
if (!caller_perms().wizard)
  return E_PERM;
endif
text = {};
for i in (this.processlog)
  text = {@text, toliteral(i)};
  $command_utils:suspend_if_needed(0);
endfor
this.processlog = {};
suspend(0);
if (text)
  fileappend(@this.logfile, text);
endif
suspend(10);
fork (86400 + $time_utils:seconds_until_time("00:00:00"))
  this:cyclelog();
endfork
.

@verb $smtp:"server_started" this none this rxd
@program $smtp:server_started
this.connections = {};
pass(@args);
.

@verb $smtp:"log" this none this rxd
@program $smtp:log
if (caller != this)
  return E_PERM;
endif
{From, Who, MsgID, Size} = args;
Who = $list_utils:enlist(Who);
if (MsgID != 0 && (i = $list_utils:iassoc(MsgID, this.processlog, 4)))
  this.processlog[i][3] = {@$list_utils:enlist(this.processlog[i][3]), @Who};
else
  this.processlog = {@this.processlog, {time(), From, Who, MsgID, Size}};
endif
.

;"End of Module"