Patch title: Release 93 bulk changes
Abstract:
File: /protocol/smtp/client.pli
Key:
    Removed line
    Added line
   
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


function conforming_name n -> c
  arg Str n c
  if not (n parse any "<" any:(var Str m) ">" any)
    n parse any:m
  c := "<"+m+">"

method fs open name options flags stream support -> status
  arg_rw SmtpFileSystem fs ; arg Str name options ; arg Int 
  var DateTime dt := datetime
  if (flags .and. in_out)<>out
    return failure
  var Link:Stream tcp :> new Stream
  var Str servers := options option "server" Str
  if servers="" and ( (name parse any "@" any:(var Str domai
    var Str servers := dns_query domain 15
    if servers=""
      servers := dns_query domain 1
  if servers="" 
    servers := this_computer:env:"pliant":"mail":"smtp_provi
  part connect
    while tcp=failure and servers<>""
      if not (servers parse any:(var Str server) _ any:(var 
        server := servers ; remain := ""
      tcp open "tcp:"+(shunt server<>"" "//"+server "")+"/cl
      servers := remain
  if tcp=failure
    smtp_trace trace "Failed to open channel " tcp:name
    return failure
  tcp configure "timeout "+string:(options option "timeout" 
  var Link:TraceSession log :> new TraceSession
  log bind smtp_trace
  if (command tcp "" log)>=300
    return failure
  var Str myname := options option "myname" Str
  if myname="" and computer_name<>"" and computer_domain<>""
    myname := computer_name+"."+computer_domain
  if myname=""
    myname := tcp query "local_ip_address"
  if extended
    var Str capabilities
    if (command tcp "EHLO "+myname capabilities log)>=300
      if (command tcp "HELO "+myname log)>=300
        return failure
  else
    if (command tcp "HELO "+myname log)>=300
      return failure
  var Str from := options option "from" Str
  if from<>""
method fs open name options flags stream support -> status
  arg_rw SmtpFileSystem fs ; arg Str name options ; arg Int 
  var DateTime dt := datetime
  if (flags .and. in_out)<>out
    return failure
  var Link:Stream tcp :> new Stream
  var Str servers := options option "server" Str
  if servers="" and ( (name parse any "@" any:(var Str domai
    var Str servers := dns_query domain 15
    if servers=""
      servers := dns_query domain 1
  if servers="" 
    servers := this_computer:env:"pliant":"mail":"smtp_provi
  part connect
    while tcp=failure and servers<>""
      if not (servers parse any:(var Str server) _ any:(var 
        server := servers ; remain := ""
      tcp open "tcp:"+(shunt server<>"" "//"+server "")+"/cl
      servers := remain
  if tcp=failure
    smtp_trace trace "Failed to open channel " tcp:name
    return failure
  tcp configure "timeout "+string:(options option "timeout" 
  var Link:TraceSession log :> new TraceSession
  log bind smtp_trace
  if (command tcp "" log)>=300
    return failure
  var Str myname := options option "myname" Str
  if myname="" and computer_name<>"" and computer_domain<>""
    myname := computer_name+"."+computer_domain
  if myname=""
    myname := tcp query "local_ip_address"
  if extended
    var Str capabilities
    if (command tcp "EHLO "+myname capabilities log)>=300
      if (command tcp "HELO "+myname log)>=300
        return failure
  else
    if (command tcp "HELO "+myname log)>=300
      return failure
  var Str from := options option "from" Str
  if from<>""
    if (command tcp "MAIL FROM:"+(shunt (from search "<" -1)
    if (command tcp "MAIL FROM:"+conforming_name:from log)>=300
      return failure
  var Str to := name
  if to<>""
      return failure
  var Str to := name
  if to<>""
    if (command tcp "RCPT TO:"+(shunt (to search "<" -1)=(-1
    if (command tcp "RCPT TO:"+conforming_name:to log)>=300
      return failure
  var Int i := 0
  while { var Str to2 := options option "to" i Str ; to2<>""
      return failure
  var Int i := 0
  while { var Str to2 := options option "to" i Str ; to2<>""
    if (command tcp "RCPT TO:"+(shunt (to search "<" -1)=(-1
    if (command tcp "RCPT TO:"+conforming_name:to2 log)>=300
      return failure
    i += 1
  var Int i := 0
  while { var Str to2 := options option "cc" i Str ; to2<>""
      return failure
    i += 1
  var Int i := 0
  while { var Str to2 := options option "cc" i Str ; to2<>""
    if (command tcp "RCPT TO:"+(shunt (to search "<" -1)=(-1
    if (command tcp "RCPT TO:"+conforming_name:to2 log)>=300
      return failure
    i += 1
  status := success
  var Int i := 0
  while { var Str file := options option "mailing" i Str ; f
    (var Stream mailing) open file in+safe
    while not mailing:atend
      var Str l := mailing readline
      if not l:parse
      return failure
    i += 1
  status := success
  var Int i := 0
  while { var Str file := options option "mailing" i Str ; f
    (var Stream mailing) open file in+safe
    while not mailing:atend
      var Str l := mailing readline
      if not l:parse
        if (command tcp "RCPT TO:"+(shunt (l search "<" -1)=
        if (command tcp "RCPT TO:"+conforming_name:l log)>=300
          status := failure
    mailing close
    i += 1
  if (command tcp "DATA" log)>=400
    return failure
  if not (options option "noheader")
    tcp writeline "Date: "+("SunMonTueWedThuFriSat" dt:day_o
    if from<>""
      tcp writeline "From: "+from
    if to<>""
      tcp writeline "To: "+to
    var Int i := 0
    while { var Str to2 := options option "to" i Str ; to2<>
      tcp writeline "To: "+to2
      i += 1
    var Int i := 0
    while { var Str to2 := options option "cc" i Str ; to2<>
      tcp writeline "CC: "+to2
      i += 1
    var Str subject := options option "subject" Str
    if subject<>""
      tcp writeline "Subject: "+subject
    var Str references := options option "references" Str
    if references<>""
      tcp writeline "References: "+references
    var Str mime := options option "mime" Str
    if mime<>""
      tcp writeline "Content-Type: "+mime
    tcp writeline ""
  tcp flush anytime
  var Link:SmtpStreamDriver smtp :> new SmtpStreamDriver
  smtp tcp :> tcp
  smtp log :> log
  stream stream_driver :> smtp
  stream stream_flags := stream:stream_flags .or. cr+lf



          status := failure
    mailing close
    i += 1
  if (command tcp "DATA" log)>=400
    return failure
  if not (options option "noheader")
    tcp writeline "Date: "+("SunMonTueWedThuFriSat" dt:day_o
    if from<>""
      tcp writeline "From: "+from
    if to<>""
      tcp writeline "To: "+to
    var Int i := 0
    while { var Str to2 := options option "to" i Str ; to2<>
      tcp writeline "To: "+to2
      i += 1
    var Int i := 0
    while { var Str to2 := options option "cc" i Str ; to2<>
      tcp writeline "CC: "+to2
      i += 1
    var Str subject := options option "subject" Str
    if subject<>""
      tcp writeline "Subject: "+subject
    var Str references := options option "references" Str
    if references<>""
      tcp writeline "References: "+references
    var Str mime := options option "mime" Str
    if mime<>""
      tcp writeline "Content-Type: "+mime
    tcp writeline ""
  tcp flush anytime
  var Link:SmtpStreamDriver smtp :> new SmtpStreamDriver
  smtp tcp :> tcp
  smtp log :> log
  stream stream_driver :> smtp
  stream stream_flags := stream:stream_flags .or. cr+lf