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
              ).
            
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
    ).

define Maybe(String)   
  receive_command
  (
    RWStream    conn,
    List(Word8) so_far,
    Word8       previous
  ) =
  if read_network_byte(weaken(conn), smtp_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"); failure,
    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)
      else
        receive_command(conn, [previous . so_far], c)
 }.   

define Maybe(String)   
  receive_command
  (
    RWStream    conn,
    List(Word8) so_far,
  ) =
  if read_network_byte(weaken(conn), smtp_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"); failure,
    success(c) then receive_command(conn,[], c)
  }. 
  
  
type Reply_Result:
  error,
  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
  (
    RWStream  conn,
    List(String)  so_far
  ) =
  if receive_command(conn, []) is
  {
    failure       then logError(send_mail_log, "receive_reply: error receiving command"); error,
    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])
          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(conn, []).
      
   
   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 = receive_reply(conn),
      if rep is
      {
        error              then logError(send_mail_log, "send_ehlo: can't get reply"); error,
        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
            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          

define Reply_Result
  send_content
  (
    RWStream      conn,
    List(Data_IO)  mail_part
  ) =
  //open the message file from the drive
  if copy_Data_IO_List_to_Stream(mail_part, weaken(conn)) is 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)
    }
  else
   logError(send_mail_log, "send_content: error sending data"); error.

   
   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
          reply(code, lines)  then
          if code = 250 then
            //send RCPT TO
            if send_recipient(conn,param.recipient.str) is
            {
              error then error, // already logged
              reply(code, lines)  then
              if code = 250 then
                //send DATA
                if send_data(conn) is
                {
                  error then  error,  // already logged
                  reply(code, lines)  then
                  if code = 354 then 
                    if send_content(conn, param.mail_parts) is
                    {
                      error               then error, // already logged
                      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
        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
    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
        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
        //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
        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),
      }
  }.