Patch title: Release 94 bulk changes
Abstract:
File: /pliant/protocol/smtp/server.pli
Key:
    Removed line
    Added line
   
abstract
  [This is Pliant SMTP server implementation (RFC 821)]


abstract
  [This is Pliant SMTP server implementation (RFC 821)]



module "/pliant/install/minimal.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
module "/pliant/language/os/socket.pli"
module "/pliant/protocol/common/tcp_server.pli"
module "/pliant/protocol/common/misc.pli"
module "/pliant/protocol/dns/client.pli"
module "/pliant/fullpliant/this_computer.pli"
module "/pliant/util/encoding/html.pli"
module "/pliant/util/encoding/date.pli"
module "meta.pli"
module "mail.pli"
module "forward.pli"
module "client.pli"
module "/pliant/language/schedule/resourcesem.pli"


type SmtpSession
  field Str local_name
  field Str remote_name
  field Str remote_ip
  field CBool remote_magic <- false
  field Str id
  field CBool welcome <- false
  field CBool accepted <- false
  field CBool rejected <- false
  field CBool magic <- false
  field Str from  ; field Str outmail
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
module "/pliant/language/os/socket.pli"
module "/pliant/protocol/common/tcp_server.pli"
module "/pliant/protocol/common/misc.pli"
module "/pliant/protocol/dns/client.pli"
module "/pliant/fullpliant/this_computer.pli"
module "/pliant/util/encoding/html.pli"
module "/pliant/util/encoding/date.pli"
module "meta.pli"
module "mail.pli"
module "forward.pli"
module "client.pli"
module "/pliant/language/schedule/resourcesem.pli"


type SmtpSession
  field Str local_name
  field Str remote_name
  field Str remote_ip
  field CBool remote_magic <- false
  field Str id
  field CBool welcome <- false
  field CBool accepted <- false
  field CBool rejected <- false
  field CBool magic <- false
  field Str from  ; field Str outmail
  field List:Str to
  field (Dictionary Str SmtpFile) files
  field (Dictionary Str CBool) to_confirmed
  field CBool check_ip check_from check_to <- false
  field TraceSession log
  if use_spam_filter
    field List:Str spam_filters
    field Int spam_level <- -1
  field Str auto_from auto_to auto_subject auto_messageid au


method session reset
  arg_rw SmtpSession session
  session id := generate_id
  session rejected := false
  session accepted := false
  session magic := session remote_magic
  session from := "" ; session outmail := ""
  field (Dictionary Str SmtpFile) files
  field (Dictionary Str CBool) to_confirmed
  field CBool check_ip check_from check_to <- false
  field TraceSession log
  if use_spam_filter
    field List:Str spam_filters
    field Int spam_level <- -1
  field Str auto_from auto_to auto_subject auto_messageid au


method session reset
  arg_rw SmtpSession session
  session id := generate_id
  session rejected := false
  session accepted := false
  session magic := session remote_magic
  session from := "" ; session outmail := ""
  session to := var List:Str empty_to
  session files := var (Dictionary Str SmtpFile) empty_files
  session check_ip := false
  session check_from := false
  session check_to := false
  session auto_from := "" ; session auto_to := "" ; session 
  if use_spam_filter
    session spam_level := -1



method session receive_mail_content s filename -> a
  arg_rw SmtpSession session ; arg_rw Stream s ; arg Str fil
  a := ""
  (var Stream mail) open filename out+mkdir+safe
  mail writeline "Received: from "+session:remote_name+"("+s
  var CBool from_provided := false
  var Int loop := 0
  var Str suspicious := "" ; var List:Str comments
  var CBool empty_line := false
  if session:check_ip and session:outmail="" and (dns_query 
    suspicious += " server" ; comments += "Sending server is
  part receive_header
    while not s:atend and { var Str l := s readline ; l<>"."
      if l=""
        empty_line := true
        leave receive_header
      while not s:atend and { var Char ch := s:stream_read_c
        l += s readline
      if (l parse acpattern:"From:" any:(var Str from))
        if ac_real_email:from<>(ac_real_email session:from) 
          suspicious += " from" ; comments += "Sender config
        from_provided := true
        var Str from2 := ac_real_email from
        if exists:(mail_database:data:magic_from from2)
          session magic := true
        eif exists:(mail_database:data:black_from from2)
  session files := var (Dictionary Str SmtpFile) empty_files
  session check_ip := false
  session check_from := false
  session check_to := false
  session auto_from := "" ; session auto_to := "" ; session 
  if use_spam_filter
    session spam_level := -1



method session receive_mail_content s filename -> a
  arg_rw SmtpSession session ; arg_rw Stream s ; arg Str fil
  a := ""
  (var Stream mail) open filename out+mkdir+safe
  mail writeline "Received: from "+session:remote_name+"("+s
  var CBool from_provided := false
  var Int loop := 0
  var Str suspicious := "" ; var List:Str comments
  var CBool empty_line := false
  if session:check_ip and session:outmail="" and (dns_query 
    suspicious += " server" ; comments += "Sending server is
  part receive_header
    while not s:atend and { var Str l := s readline ; l<>"."
      if l=""
        empty_line := true
        leave receive_header
      while not s:atend and { var Char ch := s:stream_read_c
        l += s readline
      if (l parse acpattern:"From:" any:(var Str from))
        if ac_real_email:from<>(ac_real_email session:from) 
          suspicious += " from" ; comments += "Sender config
        from_provided := true
        var Str from2 := ac_real_email from
        if exists:(mail_database:data:magic_from from2)
          session magic := true
        eif exists:(mail_database:data:black_from from2)
          comments += "Sender is blacklisted."
          session spam_level := 1 ; comments += "Sender mailbox is blacklisted."
        from2 := from2 (from2 search "@" from2:len)+1 from2:
        if exists:(mail_database:data:magic_from from2)
          session magic := true
        eif exists:(mail_database:data:black_from from2)
        from2 := from2 (from2 search "@" from2:len)+1 from2:
        if exists:(mail_database:data:magic_from from2)
          session magic := true
        eif exists:(mail_database:data:black_from from2)
          comments += "Sender is blacklisted."
          session spam_level := 1 ; comments += "Sender domain is blacklisted."
        if session:check_ip and (dns_query from2 15)="" and 
          suspicious += " domain" ; comments += "Sender doma
        session auto_from := from
      eif (l parse acpattern:"To:" any:(var Str tos)) or (l 
        while tos<>""
          if not (tos parse any:(var Str to) "," any:(var St
            to := tos ; remain := ""
          if exists:(session:to_confirmed first ac_real_emai
            session:to_confirmed ac_real_email:to := true
          tos := remain
      eif (l parse acpattern:"Received:" any "(" any ")" wor
        if srv=session:local_name
          loop += 1
          if loop>1
            a := "559 The mail is looping between SMTP serve
      eif (l parse acpattern:"Subject:" any:(var Str subject
        session auto_subject := subject
      eif (l parse acpattern:"Message-ID:" any:(var Str mess
        session auto_messageid := messageid
      if (l 0 2)=".."
        l := l 1 l:len
      mail writeline l
      session:log trace "header " l
      plugin mail_header_line
  if session:check_to
    var Pointer:CBool c :> session:to_confirmed first
    while exists:c
      if not c
        suspicious += " to" ; comments += "Recipients list i
      c :> session:to_confirmed next c
  if session:check_from
    if session:from<>"" and not from_provided
      suspicious += " from" ; comments += "This mail might c
  if suspicious<>""
    mail writeline "Suspicious:"+suspicious
  if empty_line
    mail writeline l
  if (exists comments:first) and not session:magic
    if session:outmail<>""
      if a=""
        a := "553 "+comments:first
    else
      mail writeline "Mail agent comments:"
      var Pointer:Str comment :> comments first
      while exists:comment
        mail writeline "  "+comment
        comment :> comments next comment
      mail writeline ""
        if session:check_ip and (dns_query from2 15)="" and 
          suspicious += " domain" ; comments += "Sender doma
        session auto_from := from
      eif (l parse acpattern:"To:" any:(var Str tos)) or (l 
        while tos<>""
          if not (tos parse any:(var Str to) "," any:(var St
            to := tos ; remain := ""
          if exists:(session:to_confirmed first ac_real_emai
            session:to_confirmed ac_real_email:to := true
          tos := remain
      eif (l parse acpattern:"Received:" any "(" any ")" wor
        if srv=session:local_name
          loop += 1
          if loop>1
            a := "559 The mail is looping between SMTP serve
      eif (l parse acpattern:"Subject:" any:(var Str subject
        session auto_subject := subject
      eif (l parse acpattern:"Message-ID:" any:(var Str mess
        session auto_messageid := messageid
      if (l 0 2)=".."
        l := l 1 l:len
      mail writeline l
      session:log trace "header " l
      plugin mail_header_line
  if session:check_to
    var Pointer:CBool c :> session:to_confirmed first
    while exists:c
      if not c
        suspicious += " to" ; comments += "Recipients list i
      c :> session:to_confirmed next c
  if session:check_from
    if session:from<>"" and not from_provided
      suspicious += " from" ; comments += "This mail might c
  if suspicious<>""
    mail writeline "Suspicious:"+suspicious
  if empty_line
    mail writeline l
  if (exists comments:first) and not session:magic
    if session:outmail<>""
      if a=""
        a := "553 "+comments:first
    else
      mail writeline "Mail agent comments:"
      var Pointer:Str comment :> comments first
      while exists:comment
        mail writeline "  "+comment
        comment :> comments next comment
      mail writeline ""
  var CBool empty := true
  if l<>"."
    while not s:atend and { var Str l := s readline ; l<>"."
      if (l 0 2)=".."
        l := l 1 l:len
      mail writeline l
  if l<>"."
    while not s:atend and { var Str l := s readline ; l<>"."
      if (l 0 2)=".."
        l := l 1 l:len
      mail writeline l
      if l<>""
        empty := false
  if session:auto_subject="" and empty
    session spam_level := 1
  if s=failure
    a := "458 Broken TCP connection"
  if mail:close=failure and a=""
    a := "452 Requested action not taken: insufficient syste
  if use_spam_filter and not session:magic
    var Pointer:Str sf :> session:spam_filters first
    while exists:sf and session:spam_level<1
      session spam_level := max session:spam_level (spam_fil
      sf :> session:spam_filters next sf



method smtp service s
  arg_rw SmtpServer smtp ; arg_rw Stream s
  var SmtpSession session
  session:log bind smtp_trace
  session remote_ip := s query "remote_ip_address"
  var DateTime timestamp := datetime
  timestamp split (var Int year) (var Int month) (var Int da
  session:log trace "SMTP connection start at " timestamp " 
  part dialog "SMTP connection from "+session:remote_ip+" (s
    each ip mail_database:data:magic_ip
      if (session:remote_ip is_inside_ip_domain keyof:ip)
        session remote_magic := true
    if not session:remote_magic
      each ip mail_database:data:black_ip
        if (session:remote_ip is_inside_ip_domain keyof:ip)
          s writeline "559 you are blacklisted on this site.
          session:log trace "remote IP is blacklisted on thi
          leave dialog
      if (session:remote_ip parse (var Int ip1) "." (var Int
        each dns mail_database:data:black_dns
          if (dns_query string:ip4+"."+string:ip3+"."+string
            s writeline "559 you are blacklisted on "+keyof:
            session:log trace "remote IP is blacklisted on "
            leave dialog
    session local_name := this_computer:env:"pliant":"mail":
    if session:local_name=""
      session local_name := computer_fullname
    s writeline "220 "+session:local_name+" Simple Mail Tran
    session:log trace "welcome 220 "+session:local_name+" Si
    while not s:atend
      var Str l := s readline
      session:log trace "query " l
      if (l parse any:(var Str first) _ any:(var Str second2
        l := upper:first+" "+upper:second2+":"+remain
      eif (l parse any:(var Str first) _ any:(var Str remain
        l := upper:first+" "+remain
      else
        l := upper l
      var Str a
      if (l parse word:"HELO" (any session:remote_name))
        if exists:(mail_database:data:magic_name session:rem
          session remote_magic := true
          session welcome := true
        eif exists:(mail_database:data:black_name session:re
          session welcome := false
        else
          session welcome := true
        a := shunt session:welcome "250 "+session:local_name
        session reset
        plugin command_helo
      eif (l parse word:"MAIL" word:"FROM" ":" any:(var Str 
        var Str from2 := ac_real_email from
        if exists:(mail_database:data:magic_from from2)
          session magic := true
        eif exists:(mail_database:data:black_from from2)
          session rejected := true
        from2 := from2 (from2 search "@" from2:len)+1 from2:
        if exists:(mail_database:data:magic_from from2)
          session magic := true
        eif exists:(mail_database:data:black_from from2)
          session rejected := true
        var Data:MailBox b :> mailbox real_email:from
        if not exists:b
          b :> mailbox ac_real_email:from
        if not session:welcome or session:rejected
          a := "550 No mail will be accepted here"
        eif session:from<>""
          session rejected := true
          a := "503 Bad sequence of commands"
        eif computer_fullname=b:computer and b:smtp_ip<>"" a
          # out mail from the mailbox owner
          session from := from
          session outmail := b out_path
          var Pointer:SmtpFile file :> session add_file b:ou
          file forward := true
          if b:archive and session:remote_name<>computer_ful
            session add_file b:archive_path+string:year+(rig
          session check_from_to b
          a := "250 OK"
        eif computer_fullname=b:relay_computer and session:r
          # out mail in the relay computer from the mailbox 
          session from := from
          session outmail := b relay_path
          var Pointer:SmtpFile file :> session add_file b:re
          file forward := true
          if b:relay_archive and session:remote_name<>comput
            session add_file b:archive_path+string:year+(rig
          session check_from_to b
          a := "250 OK"
        else
          session from := from
          a := "250 OK"
        plugin command_from
      eif (l parse word:"RCPT" word:"TO" ":" any:(var Str to
  if s=failure
    a := "458 Broken TCP connection"
  if mail:close=failure and a=""
    a := "452 Requested action not taken: insufficient syste
  if use_spam_filter and not session:magic
    var Pointer:Str sf :> session:spam_filters first
    while exists:sf and session:spam_level<1
      session spam_level := max session:spam_level (spam_fil
      sf :> session:spam_filters next sf



method smtp service s
  arg_rw SmtpServer smtp ; arg_rw Stream s
  var SmtpSession session
  session:log bind smtp_trace
  session remote_ip := s query "remote_ip_address"
  var DateTime timestamp := datetime
  timestamp split (var Int year) (var Int month) (var Int da
  session:log trace "SMTP connection start at " timestamp " 
  part dialog "SMTP connection from "+session:remote_ip+" (s
    each ip mail_database:data:magic_ip
      if (session:remote_ip is_inside_ip_domain keyof:ip)
        session remote_magic := true
    if not session:remote_magic
      each ip mail_database:data:black_ip
        if (session:remote_ip is_inside_ip_domain keyof:ip)
          s writeline "559 you are blacklisted on this site.
          session:log trace "remote IP is blacklisted on thi
          leave dialog
      if (session:remote_ip parse (var Int ip1) "." (var Int
        each dns mail_database:data:black_dns
          if (dns_query string:ip4+"."+string:ip3+"."+string
            s writeline "559 you are blacklisted on "+keyof:
            session:log trace "remote IP is blacklisted on "
            leave dialog
    session local_name := this_computer:env:"pliant":"mail":
    if session:local_name=""
      session local_name := computer_fullname
    s writeline "220 "+session:local_name+" Simple Mail Tran
    session:log trace "welcome 220 "+session:local_name+" Si
    while not s:atend
      var Str l := s readline
      session:log trace "query " l
      if (l parse any:(var Str first) _ any:(var Str second2
        l := upper:first+" "+upper:second2+":"+remain
      eif (l parse any:(var Str first) _ any:(var Str remain
        l := upper:first+" "+remain
      else
        l := upper l
      var Str a
      if (l parse word:"HELO" (any session:remote_name))
        if exists:(mail_database:data:magic_name session:rem
          session remote_magic := true
          session welcome := true
        eif exists:(mail_database:data:black_name session:re
          session welcome := false
        else
          session welcome := true
        a := shunt session:welcome "250 "+session:local_name
        session reset
        plugin command_helo
      eif (l parse word:"MAIL" word:"FROM" ":" any:(var Str 
        var Str from2 := ac_real_email from
        if exists:(mail_database:data:magic_from from2)
          session magic := true
        eif exists:(mail_database:data:black_from from2)
          session rejected := true
        from2 := from2 (from2 search "@" from2:len)+1 from2:
        if exists:(mail_database:data:magic_from from2)
          session magic := true
        eif exists:(mail_database:data:black_from from2)
          session rejected := true
        var Data:MailBox b :> mailbox real_email:from
        if not exists:b
          b :> mailbox ac_real_email:from
        if not session:welcome or session:rejected
          a := "550 No mail will be accepted here"
        eif session:from<>""
          session rejected := true
          a := "503 Bad sequence of commands"
        eif computer_fullname=b:computer and b:smtp_ip<>"" a
          # out mail from the mailbox owner
          session from := from
          session outmail := b out_path
          var Pointer:SmtpFile file :> session add_file b:ou
          file forward := true
          if b:archive and session:remote_name<>computer_ful
            session add_file b:archive_path+string:year+(rig
          session check_from_to b
          a := "250 OK"
        eif computer_fullname=b:relay_computer and session:r
          # out mail in the relay computer from the mailbox 
          session from := from
          session outmail := b relay_path
          var Pointer:SmtpFile file :> session add_file b:re
          file forward := true
          if b:relay_archive and session:remote_name<>comput
            session add_file b:archive_path+string:year+(rig
          session check_from_to b
          a := "250 OK"
        else
          session from := from
          a := "250 OK"
        plugin command_from
      eif (l parse word:"RCPT" word:"TO" ":" any:(var Str to
        var Data:MailBox b :> mailbox real_email:to
        var Str real_to := real_email to
        var Data:MailBox b :> mailbox real_to
        if not exists:b
        if not exists:b
          b :> mailbox ac_real_email:to
          real_to := ac_real_email to
          b :> mailbox real_to
        if not session:welcome or session:rejected
          a := "550 No mail will be accepted here"
        eif computer_fullname=b:computer
          if b:list
            # mailing list
            session accepted := true
            if b:subscriber:size>0
              var Pointer:SmtpFile file :> session add_file 
              each ms b:subscriber
                file to += ms
              file forward := true
              file push := true
            if b:archive
              session add_file b:archive_path+string:year+(r
            session check_from_to b
            a := "250 OK"
          else
            # in mail
            session accepted := true
            session add_file b:in_path+session:id to
            if b:archive
              session add_file b:archive_path+string:year+(r
            session check_from_to b
            if use_spam_filter and (file_query (b smart_path
              session spam_filters += (b smart_path "")+"spa
            a := "250 OK"
            if b:auto_answer<>""
              session auto_to += " "+b:name+" <"+keyof:b+">"
        eif computer_fullname=b:relay_computer
          # in mail in the relay computer
          session accepted := true
          var Pointer:SmtpFile file :> session add_file b:re
          file to += to
          file forward := true
          if b:relay_archive
            session add_file b:archive_path+string:year+(rig
          session check_from_to b
          a := "250 OK"
          if b:auto_answer<>""
            session auto_to += " "+b:name+" <"+keyof:b+">" ;
        eif session:outmail<>""
          if session:remote_name<>computer_fullname
            session accepted := true
            var Pointer:SmtpFile file :> session add_file se
            file to += to
            a := "250 OK"
          else
            a := "550 the target mailbox is probably wrong (
        else
          a := "550 Mails to "+to+" are not accepted here"
        plugin command_to
        if not session:welcome or session:rejected
          a := "550 No mail will be accepted here"
        eif computer_fullname=b:computer
          if b:list
            # mailing list
            session accepted := true
            if b:subscriber:size>0
              var Pointer:SmtpFile file :> session add_file 
              each ms b:subscriber
                file to += ms
              file forward := true
              file push := true
            if b:archive
              session add_file b:archive_path+string:year+(r
            session check_from_to b
            a := "250 OK"
          else
            # in mail
            session accepted := true
            session add_file b:in_path+session:id to
            if b:archive
              session add_file b:archive_path+string:year+(r
            session check_from_to b
            if use_spam_filter and (file_query (b smart_path
              session spam_filters += (b smart_path "")+"spa
            a := "250 OK"
            if b:auto_answer<>""
              session auto_to += " "+b:name+" <"+keyof:b+">"
        eif computer_fullname=b:relay_computer
          # in mail in the relay computer
          session accepted := true
          var Pointer:SmtpFile file :> session add_file b:re
          file to += to
          file forward := true
          if b:relay_archive
            session add_file b:archive_path+string:year+(rig
          session check_from_to b
          a := "250 OK"
          if b:auto_answer<>""
            session auto_to += " "+b:name+" <"+keyof:b+">" ;
        eif session:outmail<>""
          if session:remote_name<>computer_fullname
            session accepted := true
            var Pointer:SmtpFile file :> session add_file se
            file to += to
            a := "250 OK"
          else
            a := "550 the target mailbox is probably wrong (
        else
          a := "550 Mails to "+to+" are not accepted here"
        plugin command_to
        if a="250 OK"
          session to += real_to
      eif l="DATA"
        if not session:welcome or session:rejected
          a := "550 No mail will be accepted here"
        eif not session:accepted
          a := "503 Bad sequence of commands"
        else
      eif l="DATA"
        if not session:welcome or session:rejected
          a := "550 No mail will be accepted here"
        eif not session:accepted
          a := "503 Bad sequence of commands"
        else
          a := ""
          plugin command_data
        if a=""
          a := session receive_mail s
          if a="250 OK" and session:auto_answer<>"" and sess
            (var Stream answer) open "smtp:"+session:auto_fr
            answer writeline "Here is an automatic answer re
            answer writeline ""
            answer writechars session:auto_answer
            answer close  
          session reset
      eif pattern_matching and (l parse word:"VRFY" any:(var
        var Data:MailBox b :> mailbox real_email:pattern
        if exists:b
          a := "250 "+b:name+" <"+keyof:b+">"
        else
          var Int count := 0
          each b mailbox
            if ((lower b:name+" <"+keyof:b+">") search lower
              count += 1
              a := "250 "+b:name+" <"+keyof:b+">"
          if count=0
            a := "550 String does not match anything"
          eif count>1
            a := "553 User ambiguous"
        plugin command_vrfy
      eif l="RSET"
        session reset
        a := "250 OK"
      eif l="NOOP"
        a := "250 OK"
      eif l="QUIT"
        a := "221 "+session:local_name+" Service closing tra
      else
        a := "502 Command not implemented"
        plugin not_implemented
      s writeline a
      session:log trace "answer " a
      if l="QUIT"
        leave dialog
  session:log trace "SMTP connection stop at " datetime " fr
  


          a := session receive_mail s
          if a="250 OK" and session:auto_answer<>"" and sess
            (var Stream answer) open "smtp:"+session:auto_fr
            answer writeline "Here is an automatic answer re
            answer writeline ""
            answer writechars session:auto_answer
            answer close  
          session reset
      eif pattern_matching and (l parse word:"VRFY" any:(var
        var Data:MailBox b :> mailbox real_email:pattern
        if exists:b
          a := "250 "+b:name+" <"+keyof:b+">"
        else
          var Int count := 0
          each b mailbox
            if ((lower b:name+" <"+keyof:b+">") search lower
              count += 1
              a := "250 "+b:name+" <"+keyof:b+">"
          if count=0
            a := "550 String does not match anything"
          eif count>1
            a := "553 User ambiguous"
        plugin command_vrfy
      eif l="RSET"
        session reset
        a := "250 OK"
      eif l="NOOP"
        a := "250 OK"
      eif l="QUIT"
        a := "221 "+session:local_name+" Service closing tra
      else
        a := "502 Command not implemented"
        plugin not_implemented
      s writeline a
      session:log trace "answer " a
      if l="QUIT"
        leave dialog
  session:log trace "SMTP connection stop at " datetime " fr