Anubis / Xlib

/*
 * Created by PyramIDE.
 * User: ricard
 * Date: 22/12/2008
 * Time: 17:49
 * 
 */


read tools/basis.anubis   
read tools/connections.anubis
read tools/findstring.anubis   
read tools/printable_tree.anubis
read data_base/sqlite.anubis
read network/dns.anubis
read network/tools.anubis
read system/files.anubis
read system/string.anubis
read system/data_io.anubis
read system/logger.anubis

read calexium_lib/net_services_protocols/logger_service.anubis

read lexers/enhanced_status.anubis
read smtp_server_extensions.anubis

public define String send_mail_log    = "SendMail".
public define LogMask send_mail_mask  = logMask("send_mail").

define Int        smtp_time_out     = 300.  //5 minutes of timeout
define ByteArray  crlf_dot_crlf     = to_byte_array(implode([13,10,'.',13,10])). 

public type SendMailResult:
  ok,
  error,
  reply(Int code, String enhanced_status, List(String) lines).
  
public type Str_HostName: 
  str_host_name(String str).

public type Str_Sender: 
  str_sender(String str).
  
public type Str_Recipient:
  str_recipient(String str).

public type Str_UID:
  str_UID(String str).
  
public type Send_Auth:
  none,
  login(  String login,
          String password).
      
public type Send_Param:
  send_param( Str_HostName  host_name,
              Str_Sender    sender,
              Str_Recipient recipient,
              List(Data_IO) mail_parts,
              Send_Auth     auth,
              Str_UID       mail_uid,
              Int           last_smtp_code  //0 means it's the first time
              ).
            
public type Send_Timeout:
  send_timeout(Int when).
  
public type Send_Tries:
  send_tries(Int number).
  


  
public type Send_Mail_Session:
  send_mail_session(
    Bool enhanced_status,
    Int size
    ).

type Command_Result:
  failure,
  timeout,
  success(String).
  
define Command_Result
  receive_command
  (
    RStream     conn,
    List(Word8) so_far,
    Word8       previous,
    Int         time_out
  ) =
  if read_network_byte(conn, time_out) is 
  {
    failure    then logTrace(send_mail_log, send_mail_mask, "receive_command read_network_byte 0 failure");failure,
    timeout    then logWarning(send_mail_log, "[send_mail] receive_command timeout"); timeout,
    success(c) then 
    if c = 10 & previous = 13 then  // <LF>
      with result = implode(reverse(so_far)),
          logTrace(send_mail_log, send_mail_mask,"<-S-"+result); 
      success(result)
    else 
      if previous = 13 then
        receive_command(conn, so_far, c, time_out)
      else
        receive_command(conn, [previous . so_far], c, time_out)
 }.   

define Command_Result
  receive_command
  (
    RStream     conn,
    List(Word8) so_far,
    Int         time_out
  ) =
  if read_network_byte(conn, time_out) is 
  {
    failure    then logTrace(send_mail_log, send_mail_mask, "receive_command read_network_byte 0 failure"); failure,
    timeout    then (if time_out = 0 then unique else logWarning(send_mail_log, "[send_mail] receive_command timeout")); timeout,
    success(c) then receive_command(conn,[], c, time_out)
  }. 
  
  
type Reply_Result:
  error,
  timeout,
  reply(Int code, List(String) lines).

define SendMailResult
  reply_handling
  (
    Int         code,
    List(String)  lines,
    Bool          enhanced_status
  ) =
    with result = 
    if enhanced_status then
      if extract_enhanced_status(lines) is
      {
        failure then "",
        success(enh) then enh
      }
    else
      "",
    reply(code, result, lines).

  
define Reply_Result
  receive_reply
  (
    RStream      conn,
    List(String)  so_far,
    Int           time_out
  ) =
  if receive_command(conn, [], time_out) is
  {
    failure       then logError(send_mail_log, "receive_reply: error receiving command"); error,
    timeout       then (if time_out > 0 then logError(send_mail_log, "receive_reply: timeout receiving command") else unique); timeout,
    success(line) then  
      //check if we must read another line by presence of hyphen after the reply code
      //220-bla bla bla
      //220 end of bla bla
      if length(line) =< 3 then
        if decimal_scan(line) is
        {
          failure       then logError(send_mail_log, "receive_reply: can't extract reply code from '" + line + "'"); error,
          success(code) then reply(code, reverse(so_far))
        }
      else if nth(3, line) is
      {
        failure       then logError(send_mail_log, "receive_reply: error getting 4th character from '" + line +"'"); error,
        success(char) then 
          if char = '-' then  
            receive_reply(conn, [line . so_far], time_out)
          else
            //decode the code
            if sub_string(line, 0, 3) is
            {
              failure           then logError(send_mail_log, "receive_reply: error extracting reply code from '" + line+"'"); error,  // should never occure
              success(code_str) then 
                if decimal_scan(code_str) is
                {
                  failure       then  logError(send_mail_log, "receive_reply: can't extract reply code from '" + code_str + "'"); error, //unreadable code
                  success(code) then reply(code , reverse([line . so_far]))
                }
            }
      }
  }.

define Reply_Result
  receive_reply   
  (
    RWStream conn,
  ) =
  receive_reply(weaken(conn), [], smtp_time_out).
      
   
   Sending a piece of text (String) from the begining. 
   
define Maybe(One)
  smtp_send_line
    (
      RWStream conn,
      String text
    ) =
  if reliable_write(tcp(conn),[text + crlf]) is 
  {
    failure     then logError(send_mail_log, "smtp_send_line: error writing '" + text + "'"); failure,
    success(_)  then 
      logTrace(send_mail_log,send_mail_mask, "-C->"+text);success(unique)
  } .
  
   Because of attachements, we may have to manipulate very big pieces of text. It would be
   unreasonable  to  concatenate all  pieces  into  a single  String.  Hence,  we use  the
   following type:
   
type StringTree:
  [ ], 
  str_tree(String,StringTree),
  ba_tree(ByteArray,StringTree),
  tree_tree(StringTree,StringTree). 

define StringTree [String     s . StringTree t] = str_tree(s,t). 
define StringTree [ByteArray  s . StringTree t] = ba_tree(s,t). 
define StringTree [StringTree s . StringTree t] = tree_tree(s,t). 
   
   Try to send the 'HELO' command and get the reply. Return 'true' if you cannot. 
   
define Reply_Result
  send_ehlo
  (
    RWStream conn, 
    String our_host_name
  ) =
  if smtp_send_line(conn,"EHLO "+our_host_name) is 
  {
    failure     then logError(send_mail_log, "send_ehlo: error sending EHLO"); error, 
    success(_)  then 
      with rep = if receive_reply(conn) is
                  {
                    error              then logError(send_mail_log, "send_ehlo: can't get reply"); error,
                    timeout            then logError(send_mail_log, "send_ehlo: timeout getting reply"); timeout,
                    reply(code, lines) then
                      //we manage the 500 error, that mean the remote server is not ESMTP
                      //hence we try we with HELO, the old manner RFC 821
                      if code = 500 | code = 502 then
                        if smtp_send_line(conn,"HELO "+our_host_name) is 
                        {
                          failure     then logError(send_mail_log, "send_ehlo: error sending HELO"); error, 
                          success(_)  then receive_reply(conn)
                        }
                      else
                        reply(code, lines)
                  },
      if rep is reply(code, lines) then
        if code = 550 then    // some server simply refuse us because it's temporary overloaded (especially try when sending mailings)
          logDebug(send_mail_log, "Converting a 550 error for EHLO to a 432 error as distant server may be temporary overloaded.");
          reply(432, lines)
        else
          rep
      else 
        rep
  }. 
   
   The same one for 'MAIL FROM':

define String
  check_email_syntax
  (
    String email
  ) =
  if nth(0, email) is
  {
    failure then "<>",
    success(b) then 
      if b = '<' then email
                 else "<" + email + ">"
  }.

   
define Reply_Result
  send_mail_from
  (
      RWStream conn, 
      String sender
  ) =
  with rfc_sender = check_email_syntax(sender),
  if smtp_send_line(conn,"MAIL FROM:"+rfc_sender) is 
  {
    failure     then logError(send_mail_log, "error sending 'MAIL FROM:" + rfc_sender + "'"); error, 
    success(_)  then receive_reply(conn)
  }. 
   
   The same one for 'RCPT TO':
   
define Reply_Result
  send_recipient
  (
    RWStream            conn, 
    String              recipient, 
  ) =
  with rfc_recipient = check_email_syntax(recipient),
  if smtp_send_line(conn,"RCPT TO:"+rfc_recipient) is 
  {
    failure     then logError(send_mail_log, "error sending 'RCPT TO:"+rfc_recipient+"'"); error,
    success(_)  then receive_reply(conn)
  }.
   
  
   Try to send 'DATA' and get the reply. Answer 'true' if you cannot. 
   
define Reply_Result
  send_data
    (
      RWStream conn
    ) =
  if smtp_send_line(conn,"DATA") is 
  {
    failure     then logError(send_mail_log, "error sending DATA"); error, 
    success(_)  then receive_reply(conn)
  }. 

   
   
   The same for the content of the message. We need base64 encoding.
   
read tools/base64.anubis          
type SendContentResult:
  smtp_reply(Reply_Result),
  copy_error(Int written),
  copy_ok(Int written).
  
define Maybe(One)
  sm_flush
  (
    ByteArray buffer,
    WStream   target
  )=
  if write( target , buffer) is
  {
    failure           then failure,
    success(nb_write) then
      with buffer_size = length(buffer),      
      if nb_write = buffer_size then
        success(unique)
      else
        with new_buffer = extract(buffer, nb_write, buffer_size),
        sm_flush(new_buffer, target)
  }.
  
public define SendContentResult
  sm_copy_Data_IO_to_Stream
  (
    Data_IO source, 
    RWStream target,
    Int   so_far
  ) =
  if receive_reply(weaken(target), [], 0) is
  {
    error then copy_error(so_far),
    timeout then
      if read_bytes(source, 65536) is
      {
        failure         then copy_error(so_far),
        time_out        then copy_error(so_far), 
        success(buffer) then 
          if sm_flush( buffer, weaken(target) ) is
          {
            failure     then copy_error(so_far),
            success(_)  then sm_copy_Data_IO_to_Stream(source, target, so_far + 65536)
          },
          
        truncated(buffer)       then
          with len = length(buffer),
          if len = 0 then
            copy_ok(so_far)
          else 
            if sm_flush( buffer, weaken(target) ) is
            {
              failure     then copy_error(so_far),
              success(_)  then copy_ok(so_far + len)
            }
      },
    reply(code, lines) then
      smtp_reply(reply(code, lines))
  }.

define SendContentResult
  sm_copy_Data_IO_List_to_Stream
  (
    List(Data_IO) io_list,
    RWStream    target,
    Int         so_far
  )=
  if io_list is
  {
    []        then copy_ok(so_far),
    [ h . t ]  then
      if rewind(h)(unique) then
        with result = sm_copy_Data_IO_to_Stream(h, target, 0),
        if result is copy_ok(written) then 
          sm_copy_Data_IO_List_to_Stream(t, target, so_far + written)
        else
          result
      else
        copy_error(so_far)
  }.

define Reply_Result
  send_content
  (
    RWStream      conn,
    List(Data_IO)  mail_part
  ) =
  //open the message file from the drive
  if sm_copy_Data_IO_List_to_Stream(mail_part, conn, 0) is
  {
    smtp_reply(reply)   then reply
    copy_error(written) then 
      logError(send_mail_log, "send_content: error sending data");
      if written > 1024000 then 
        logInfo(send_mail_log, "send_content: may be due to over sized mail. Convert it to 452 error.");
        reply(452, ["Error sending big email (more than 1 Mb)"])
      else
        error,
    copy_ok(_)          then
      if reliable_write(tcp(conn), [crlf_dot_crlf]) is
      {
        failure     then logError(send_mail_log, "send_content: error writing CRLF.CRLF"); error,
        success(_)  then receive_reply(conn)
      }
  }.

   
   Almost the same for 'QUIT':
   
define One
  send_quit
    (
      RWStream conn
    ) =
  if smtp_send_line(conn,"QUIT") is 
    {
      failure     then logWarning(send_mail_log, "error sending QUIT"), 
      success(_)  then forget(receive_reply(conn))
    }.

define SendMailResult
  sm_MAIL_FROM
  (                                            
    RWStream    conn,     
    Send_Param  param,
    Send_Mail_Session  sm_session
  ) =
  with enhanced_status = sm_session.enhanced_status,
  //send MAIL FROM
  if send_mail_from(conn, param.sender.str) is
  {
    error               then error, // already logged
    timeout             then error, 
    reply(code, lines)  then
      if code = 250 then
        //send RCPT TO
        if send_recipient(conn,param.recipient.str) is
        {
          error               then error, // already logged
          timeout             then error, 
          reply(code, lines)  then
          if code = 250 then
            //send DATA
            if send_data(conn) is
            {
              error               then  error,  // already logged
              timeout             then error, 
              reply(code, lines)  then
              if code = 354 then 
                if send_content(conn, param.mail_parts) is
                {
                  error               then error, // already logged
                  timeout             then error, 
                  reply(code, lines)  then
                    if code = 250 then
                      send_quit(conn);
                      logTrace(send_mail_log,send_mail_mask,"SENT Mail FROM "+param.sender.str+" TO "+param.recipient.str);
                      ok
                    else
                      reply_handling(code, lines, enhanced_status)
                }
              else
                reply_handling(code, lines, enhanced_status)
            }
          else
            reply_handling(code, lines, enhanced_status)
        }
      else
        reply_handling(code, lines, enhanced_status)
  }
.

define List(String)
  get_auth_method
  (
    List(String)  lines,
    List(String)  so_far
  )=
  if lines is
  {
    []    then  so_far,
    [h . t] then  
      if sub_string(h, 4, 4) is
      {
        failure     then get_auth_method(t, so_far),
        success(s)  then 
          with current =  if insensitive_equal(s, "AUTH") then
                            force_Type(list_word(h,9),[])
                          else
                            [],
         get_auth_method(t, current + so_far)
      } 
  }.
  
define SendMailResult
  do_auth_plain
  (
    RWStream  conn,
    String    login,
    String    password,
    Bool      enhanced_status
  )=
  
  with plain_str = "AUTH PLAIN "+ to_string(base64_encode(to_byte_array("")+
                                                constant_byte_array(1,0)+
                                                to_byte_array(login)+
                                                constant_byte_array(1,0)+
                                                to_byte_array(password))),
  if smtp_send_line(conn, plain_str) is 
  {
    failure     then error, // already logged
    success(_)  then 
      if receive_reply(conn) is 
      {
        error               then error // already logged
        timeout             then error, 
        reply(code, lines)  then
          if code = 235 then
            ok
          else
            reply_handling(code,lines,enhanced_status)
      }
  }.
  
define SendMailResult
  do_login
  (
    RWStream      conn,   //tcp connection
    List(String)  auth_list,  //list of available authentication method
    String        login,
    String        password,
    Bool          enhanced_status
  )=
  
  if member(auth_list, "PLAIN", insensitive_equal) then
    do_auth_plain(conn, login, password, enhanced_status)
  else
    logError(send_mail_log, "do_login no PLAIN method available"); error.

define SendMailResult
  do_auth
  (
    RWStream      conn,   //tcp connection
    List(String)  lines,  //this is the reply lines provided in response to EHLO command
    Send_Auth     auth,   //authentication method to use for that session
    Bool          enhanced_status
  )=
  if auth is
  {
    none                  then ok,  //no need to authenticate, this is a "panties festival"
    login(user, password) then 
      with auth_list = get_auth_method(lines,[]), 
      if auth_list is
      {
        []     then logError(send_mail_log, "do_auth error");error,
        [_ . _]  then do_login(conn, auth_list, user, password, enhanced_status)
      }
  }.

  /**
   *   make_sm_session
   */ 
define Send_Mail_Session
  make_sm_session
  (
    List(String)  lines,    //lines given in ehlo stage
    Send_Param    param    
  )=
  //looking for ENHANCEDSTATUSCODES
  with session_enhanced_status = has_smtp_extension(lines, enhanced_status_codes),
  //looking for SIZE 
  with session_size = if get_smtp_extension_value(lines, size) is
              {
                failure             then  0,
                success(str_value)  then  
                  if decimal_scan(str_value)  is
                  {
                    failure         then 0,
                    success(value)  then
                      logTrace(send_mail_log, send_mail_mask, "smtp server with SIZE "+value);
                      value
                  }
              },
  send_mail_session(session_enhanced_status, session_size).
  
   Apply the whole protocol:
   
   //TODO we can have a list of part file in param type. This can be very useful when we want
   //to send file as mailing. For the mailing, in each mail, only the header is different of the 
   //other mails. The body part is the same. Then, the mailing sender can generate the header in one 
   //file and keep the body in other file wich can be given to send_mail function as last file in the list
public define SendMailResult
  send_mail
  (
    RWStream        conn,     
    Send_Param      param,
    (Send_Mail_Session, Send_Param) -> Result(SendMailResult, Send_Param)   prepare_mail_callback,
  ) =
   //
   // Our connection to the SMTP server is opened. We just have to apply the protocol.
   //
  if receive_reply(conn) is
  {
    error               then  error,// already logged
    timeout             then  error,
    reply(code, lines)  then
    if code = 220 then
      //send EHLO
      if send_ehlo(conn, param.host_name.str) is   //"mail."+force_Type(get_main_domain(db), "mailfountain.net")) is
      {
        error               then error, // already logged
        timeout             then error, 
        reply(code, lines)  then
          if code = 250 then
            // parse all available options here, and build a smtp context
            with sm_session = make_sm_session(lines, param),
            with auth_result = do_auth(conn, lines, param.auth, sm_session.enhanced_status),
            if auth_result = ok then
              if prepare_mail_callback(sm_session, param) is
              {
                error(result) then result,
                ok(new_param) then sm_MAIL_FROM(conn, new_param, sm_session)
              }
            else
              auth_result
          else
            reply_handling(code,lines,true)
      }
      else if code = 550 then
        //some server answer "550 5.7.1 Client host rejected: cannot find your reverse hostname, [88.181.64.17]"
        //before anything, then we try to extract the enhanced status if exists for relaying the mail with the ISP
        logDebug(send_mail_log, "Converting a 550 error for connection to a 432 error as distant server may be temporary overloaded.");
        reply_handling(432,lines,true)
      else 
        reply_handling(code,lines,true)
  }.

public define SendMailResult
  send_mail
  (
    RWStream        conn,     
    Send_Param      param,
  ) =
  send_mail(conn, param, (Send_Mail_Session sm_session, Send_Param param) |-> ok(param)).

public define SendMailResult
  send_mail
  (
    String          server,
    Word32          port,
    Send_Param      param,
  )=
  if resolve_address(server) is
  {
    failure           then  
      logWarning(send_mail_log,"IP address NOT found for Mail server ["+server+"]");
      error,

    success(ip_addr)  then
      with ip_txt = ip_addr_to_string(ip_addr),
      logTrace(send_mail_log, send_mail_mask, "send_mail: Trying to connect to "+ip_txt);

      if (Result(NetworkConnectError,RWStream))connect(ip_addr, port) is 
      {
        error(e)               then 
          logTrace(send_mail_log,send_mail_mask,"send_mail: Can't connect to "+ip_txt); 
          error,
      
        ok(server_conn)        then 
          //
          //with status = to_Send_Status(send_mail(db, server_conn, send_param(str_sender(sender), str_recipient(recipient), [make_data_io(source)],auth, str_UID(file_uid) ))),
          send_mail(server_conn, param),
      }
  }.