Anubis / Xlib

/*
 * Created by PyramIDE.
 * User: ricard
 * Date: 10/03/2009
 * Time: 18:00
 * 
 */

read tools/basis.anubis   
read tools/connections.anubis
read tools/printable_tree.anubis
read network/tools.anubis
read system/files.anubis
read system/string.anubis
read system/data_io.anubis
read system/logger.anubis

read lexers/enhanced_status.anubis
read smtp_server_extensions.anubis
read authentication.anubis

define ByteArray  crlf_dot_crlf     = to_byte_array(implode([13,10,'.',13,10])). 

public type SmtpClientResult:
  error,
  timeout,
  no_auth_method,
  bad_reply,
  reply(Int code, String enhanced_status, List(String) lines).

public type SmtpClientSession:
  smtp_client_session(
    Bool          enhanced_status,
    Maybe(Int)    supported_size,
    List(String)  ehlo_answer
    ).

public type SmtpAuth:
  none,
  login(  String login,
          String password).

  /**
   *   make_sm_session
   */ 
define SmtpClientSession
  make_smtp_client_session
  (
    List(String)  lines,    //lines given in ehlo stage
    (LogLevel, String) -> One logger
  ) =
  //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  failure,
                success(str_value)  then  
                  if decimal_scan(str_value)  is
                  {
                    failure         then failure,
                    success(value)  then
                      logger(logTrace, "smtp server with SIZE "+value);
                      success(value)
                  }
              },
  smtp_client_session(session_enhanced_status, session_size, lines).


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

define Command_Result
  receive_command
  (
    RStream     conn,
    List(Word8) so_far,
    Int         time_out,
    (LogLevel, String) -> One logger
  ) =
  if read_network_byte(conn, time_out) is 
  {
    failure    then logger(logTrace, "receive_command read_network_byte 0 failure"); failure,
    timeout    then (if time_out = 0 then unique else logger(logWarning, "[send_mail] receive_command timeout")); timeout,
    success(c) then receive_command(conn,[], c, time_out, logger)
  }. 
  
  
define SmtpClientResult
  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 SmtpClientResult
  receive_reply
  (
    RStream      conn,
    List(String)  so_far,
    Bool          enhanced_status,
    Int           time_out,
    (LogLevel, String) -> One logger
  ) =
  if receive_command(conn, [], time_out, logger) is
  {
    failure       then logger(logError, "receive_reply: error receiving command"); error,
    timeout       then (if time_out > 0 then logger(logError, "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 logger(logError, "receive_reply: can't extract reply code from '" + line + "'"); bad_reply,
          success(code) then reply_handling(code, reverse(so_far), enhanced_status)
        }
      else if nth(3, line) is
      {
        failure       then logger(logError, "receive_reply: error getting 4th character from '" + line +"'"); bad_reply,
        success(char) then 
          if char = '-' then  
            receive_reply(conn, [line . so_far], enhanced_status, time_out, logger)
          else
            //decode the code
            if sub_string(line, 0, 3) is
            {
              failure           then logger(logError, "receive_reply: error extracting reply code from '" + line+"'"); bad_reply,  // should never occure
              success(code_str) then 
                if decimal_scan(code_str) is
                {
                  failure       then  logger(logError, "receive_reply: can't extract reply code from '" + code_str + "'"); bad_reply, //unreadable code
                  success(code) then 
                      reply_handling(code , reverse([line . so_far]), enhanced_status)
                }
            }
      }
  }.

public define SmtpClientResult
  receive_reply   
  (
    RWStream  conn,
    Bool      enhanced_status,
    Int       timeout,
    (LogLevel, String) -> One logger
  ) =
  receive_reply(weaken(conn), [], enhanced_status, timeout, logger).
      
      
define Result(SmtpClientResult, $T)
  check_smtp_result
  (
    SmtpClientResult          result, 
    Int                       expected_code,
    (SmtpClientResult) -> $T get_success_value
  ) =
  if result is reply(code, status, lines) then
    if code = expected_code then
      ok(get_success_value(result))
    else
      error(result)
  else
    error(result).
  
   Sending a piece of text (String) from the begining. 
   
public define Maybe(One)
  smtp_send_line
  (
    RWStream  conn,
    String    text,
    (LogLevel, String) -> One logger
  ) =
  if reliable_write(tcp(conn),[text + crlf]) is 
  {
    failure     then logger(logError, "smtp_send_line: error writing '" + text + "'"); failure,
    success(_)  then 
      logger(logTrace, "-C->"+text);success(unique)
  } .

// helper
/**
 * Allows to send a SMTP command very simply.
 * You just need to provide the expected result code, and a function that extract data from reply.
 * This function will be called only in case of success. Else, the answer is returned verbatim.
 */
public define Result(SmtpClientResult, $T)
  smtp_send_command
  (
    RWStream                  conn,
    String                    command,
    Int                       expected_code,
    SmtpClientResult -> $T    get_success_value,
    SmtpClientSession         session,
    Int                       timeout,
    (LogLevel, String) -> One logger
  ) =
  if smtp_send_line(conn, command, logger) is 
  {
    failure     then logger(logError, "error sending '" + command + "'"); error(error), 
    success(_)  then check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), expected_code, get_success_value)
  }. 

/**
 * Allows to send a SMTP command very simply.
 * You just need to provide the expected result code. No data is returned in cas of success.
 * Else, the answer is returned verbatim.
 */
public define Result(SmtpClientResult, One)
  smtp_send_command
  (
    RWStream                  conn,
    String                    command,
    Int                       expected_code,
    SmtpClientSession         session,
    Int                       time_out,
    (LogLevel, String) -> One logger
  ) =
  if smtp_send_line(conn, command, logger) is 
  {
    failure     then logger(logError, "error sending '" + command + "'"); error(error), 
    success(_)  then check_smtp_result(receive_reply(conn, session.enhanced_status, time_out, logger), expected_code, (SmtpClientResult _) |-> unique)
  }. 


  // Try to send the 'HELO' command and get the reply. Return 'true' if you cannot. 
   
public define Result(SmtpClientResult, SmtpClientSession)
  send_ehlo
  (
    RWStream            conn, 
    String              our_host_name,
    Int                 time_out,
    (LogLevel, String) -> One 
                        logger
  ) =
  if smtp_send_line(conn,"EHLO "+our_host_name, logger) is 
  {
    failure     then logger(logError, "send_ehlo: error sending EHLO"); error(error), 
    success(_)  then 
      with rep =  with result = receive_reply(conn, false, time_out, logger),
                  if result is reply(code, status, lines) then
                    if code = 250 then
                      ok(make_smtp_client_session(lines, logger))

                    //we manage the 500 error, that mean the remote server is not ESMTP
                    //hence we try we with HELO, the old manner RFC 821
                    else if code = 500 | code = 502 then
                      if smtp_send_line(conn,"HELO "+our_host_name, logger) is 
                      {
                        failure     then logger(logError, "send_ehlo: error sending HELO"); error(error), 
                        success(_)  then 
                          with result2 = receive_reply(conn, false, time_out, logger),
                          if result2 is reply(code, status, lines) then
                            if code = 250 then ok(make_smtp_client_session(lines, logger))
                                          else error(result2)
                          else
                            error(result2)
                      }
                    else
                      error(result)
                  else
                    error(result),
      if rep is error(result) then
        if result is reply(code, status, lines) then
          if code = 550 then    // some server simply refuse us because it's temporary overloaded (especially try when sending mailings)
            logger(logDebug, "Converting a 550 error for EHLO to a 432 error as distant server may be temporary overloaded.");
            error(reply(432, status, lines))
          else
            rep
        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 + ">"
  }.

   
public define Result(SmtpClientResult, One)
  send_mail_from
  (
    RWStream            conn, 
    String              sender,
    SmtpClientSession   session,
    Int                 timeout,
    (LogLevel, String) -> One logger
  ) =
  with rfc_sender = check_email_syntax(sender),
  smtp_send_command(conn, "MAIL FROM:"+rfc_sender, 250, session, timeout, logger).
//  if smtp_send_line(conn,"MAIL FROM:"+rfc_sender, logger) is 
//  {
//    failure     then logger(logError, "error sending 'MAIL FROM:" + rfc_sender + "'"); error(error), 
//    success(_)  then check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), 250, unique)
//  }. 
   
   The same one for 'RCPT TO':
   
public define Result(SmtpClientResult, One)
  send_recipient
  (
    RWStream            conn, 
    String              recipient, 
    SmtpClientSession   session,
    Int                 timeout,
    (LogLevel, String) -> One logger
  ) =
  with rfc_recipient = check_email_syntax(recipient),
  smtp_send_command(conn, "RCPT TO:"+rfc_recipient, 250, session, timeout, logger).
//  if smtp_send_line(conn,"RCPT TO:"+rfc_recipient, logger) is 
//  {
//    failure     then logger(logError, "error sending 'RCPT TO:"+rfc_recipient+"'"); error,
//    success(_)  then check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), 250, unique)
//  }.
   
   Try to send 'DATA' and get the reply. Answer 'true' if you cannot. 
   
public define Result(SmtpClientResult, One)
  send_data
  (
    RWStream            conn,
    SmtpClientSession   session,
    Int                 timeout,
    (LogLevel, String) -> One logger
  ) =
  smtp_send_command(conn, "DATA", 354, session, timeout, logger).
//  if smtp_send_line(conn,"DATA", logger) is 
//  {
//    failure     then logger(logError, "error sending DATA"); error, 
//    success(_)  then check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), 250, unique)
//  }. 


   
   
   The same for the content of the message. We need base64 encoding.
   
read tools/base64.anubis          
type SendContentResult:
  smtp_reply(SmtpClientResult),
  copy_error(Int written),
  copy_ok(Int written).
  
define Maybe(One)
  sm_flush
  (
    ByteArray buffer,
    WStream   target,
    Int       buffer_start_time,
    (LogLevel, String) -> One logger
  )=
  if write( target , buffer) is
  {
    failure           then failure,
    success(nb_write) then
      if now - buffer_start_time > 120 then
        // security to avoid queue blocking
        logger(logError, "sm_flush: TIMEOUT sending a " + length(buffer) + " byte-length buffer (taking more than 2 minutes). SendMail canceled.");
        failure
      else
        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, buffer_start_time, logger)
  }.
  
define SendContentResult
  sm_copy_Data_IO_to_Stream
  (
    Data_IO   source, 
    RWStream  target,
    SmtpClientSession   session,
    Int       start_time,
    Int       so_far,
    Int       last_reply_check,
    (Int) -> One  progress_report,
    (LogLevel, String) -> One logger
  ) =
  if last_reply_check + 60 < now then
    if receive_reply(weaken(target), [], session.enhanced_status, 0, logger) is
    {
      error then copy_error(so_far),
      timeout then
        sm_copy_Data_IO_to_Stream(source, target, session, start_time, so_far, now, progress_report, logger)
      no_auth_method then copy_error(so_far), // impossible
      bad_reply then copy_error(so_far),
      reply(code, status, lines) then
        smtp_reply(reply(code, status, lines))
    }
  else
      if read_line(source, 1024) is
      {
        error           then logger(logError, "send_content: failed to read input data_io"); copy_error(so_far),
        timeout         then logger(logError, "send_content: timeout reading input data_io"); copy_error(so_far), 
        eof             then copy_ok(so_far),
        ok(line)        then 
          with buffer = to_byte_array((if nth(0, line) is success(char) then if char = '.' then "." + line else line else line)),
          if sm_flush( buffer, weaken(target), now, logger ) is
          {
            failure     then copy_error(so_far),
            success(_)  then 
              with len = length(line) + 2, // 2 is for the CRLF
              progress_report(so_far + len);
              sm_copy_Data_IO_to_Stream(source, target, session, start_time, so_far + len, last_reply_check, progress_report, logger)
          },
      }.

define SendContentResult
  sm_copy_Data_IO_List_to_Stream
  (
    List(Data_IO) io_list,
    RWStream      target,
    SmtpClientSession   session,
    Int           start_time,
    Int           so_far,
    (Int) -> One  progress_report,
    (LogLevel, String) -> One logger
  )=
  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, session, start_time, 0, now, progress_report, logger),
        if result is copy_ok(written) then 
          sm_copy_Data_IO_List_to_Stream(t, target, session, start_time, so_far + written, progress_report, logger)
        else
          result
      else
        copy_error(so_far)
  }.

//public define Result(SmtpClientResult, One)
//  send_content
//  (
//    RWStream            conn,
//    List(Data_IO)       mail_part,
//    SmtpClientSession   session,
//    Int                 timeout,
//    (Int) -> One  progress_report,
//    (LogLevel, String) -> One logger
//  ) =
//  with start_time = now,
//  if sm_copy_Data_IO_List_to_Stream(mail_part, conn, session, now, 0, progress_report, logger) is
//  {
//    smtp_reply(reply)   then error(reply)
//    copy_error(written) then 
//      with finish_time = now,
//      logger(logError, "send_content: error sending data");
//      logger(logTrace, "send_content: "+written+" bytes sent in "+finish_time - start_time+" second(s)"); 
//      if written > 1024000 then 
//        logger(logInfo, "send_content: may be due to over sized mail. Convert it to 452 error.");
//        error(reply(452, "", ["Error sending big email (more than 1 Mb)"]))
//      else
//        error(error),
//    copy_ok(size)          then
//      if reliable_write(tcp(conn), [crlf_dot_crlf]) is
//      {
//        failure     then logger(logError, "send_content: error writing CRLF.CRLF"); error(error),
//        success(_)  then 
//          with finish_time = (Int)now,
//          logger(logTrace, "mail sent "+size+" bytes in "+finish_time - start_time+" second(s)"); 
//          check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), 250, (SmtpClientResult _) |-> unique)
//      }
//  }.


public define Result(SmtpClientResult, One)
  send_content
  (
    RWStream            conn,
    List(Data_IO)       mail_part,
    SmtpClientSession   session,
    Int                 timeout,
    (Int) -> One  progress_report,
    (LogLevel, String) -> One logger
  ) =
  with start_time = now,
  if copy_Data_IO_List_to_Stream(mail_part, weaken(conn)) is copy_ok(size) then
    if reliable_write(tcp(conn), [crlf_dot_crlf]) is
    {
      failure     then logger(logError, "send_content: error writing CRLF.CRLF"); error(error),
      success(_)  then 
        with finish_time = (Int)now,
        logger(logTrace, "mail sent "+size+" bytes in "+finish_time - start_time+" second(s)"); 
        check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), 250, (SmtpClientResult _) |-> unique)
    }
  else
    with finish_time = now,
    logger(logError, "send_content: error sending data");
    logger(logTrace, "send_content: during "+finish_time - start_time+" second(s)"); 
//      if written > 1024000 then 
//        logger(logInfo, "send_content: may be due to over sized mail. Convert it to 452 error.");
//        error(reply(452, "", ["Error sending big email (more than 1 Mb)"]))
//      else
      error(error)
  .
  
   Almost the same for 'QUIT':
   
public define One
  send_quit
  (
    RWStream            conn,
    SmtpClientSession   session,
    Int                 timeout,
    (LogLevel, String) -> One logger
  ) =
  forget(smtp_send_command(conn, "QUIT", 221, session, timeout, logger)).

public define One
  send_rset
  (
    RWStream            conn,
    SmtpClientSession   session,
    Int                 timeout,
    (LogLevel, String) -> One logger
  ) =
  forget(smtp_send_command(conn, "RSET", 250, session, timeout, logger)).
  
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)
      } 
  }.
  
public define Result(SmtpClientResult, One)
  do_auth_plain
  (
    RWStream            conn,
    String              login,
    String              password,
    SmtpClientSession   session,
    Int                 timeout,
    (LogLevel, String) -> One logger
  )=
  
  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),
                                                          false)),
  smtp_send_command(conn, plain_str, 235, session, timeout, logger).
//  if smtp_send_line(conn, plain_str, logger) is 
//  {
//    failure     then error, 
//    success(_)  then check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), 235, unique)
////      {
////        error               then error 
////        timeout             then timeout, 
////        reply(code, status, lines)  then
////          if code = 235 then
////            ok(235, lines)
////          else
////            reply_handling(code,lines,enhanced_status),
////        ok(code, lines) then ok(code, lines)
////      }
//  }.

public define Result(SmtpClientResult, One)
  do_auth_login
  (
    RWStream            conn,
    String              login,
    String              password,
    SmtpClientSession   session,
    Int                 timeout,
    (LogLevel, String) -> One logger
  )=
  if smtp_send_command(conn, "AUTH LOGIN", 334, session, timeout, logger) is
  {
    error(result) then error(result),
    ok(_)         then 
      if smtp_send_command(conn, base64_encode(login, false), 334, session, timeout, logger) is
      {
        error(result) then error(result),
        ok(_)         then 
          smtp_send_command(conn, base64_encode(password, false), 235, session, timeout, logger)
      }
  }.
  
public define Result(SmtpClientResult, One)
  do_auth_cram_md5
  (
    RWStream            conn,
    String              login,
    String              password,
    SmtpClientSession   session,
    Int                 timeout,
    (LogLevel, String) -> One logger
  )=
  with get_challenge = (SmtpClientResult result) |-> 
                        if result is
                        {
                          error then "",
                          timeout then "",
                          no_auth_method then "",
                          bad_reply then "",
                          reply(code, status, lines) then
                            if lines is [h . _] then 
                              if split(h, ' ') is [_ . t] then
                                if t is [challenge . _] then
                                  //println("challenge : " + challenge); 
                                  base64_decode(challenge)
                                else ""
                              else ""
                            else "",
                        },
  if smtp_send_command(conn, "AUTH CRAM-MD5", 334, get_challenge, session, timeout, logger) is
  {
    error(result)       then error(result),
    ok(challenge)  then 
      with digest = hmac_md5_compute(challenge, password),
//      println("challenge: " + challenge);
//      println("decoded  : " + login + " " + digest);
      smtp_send_command(conn, base64_encode(login + " " + digest, false), 235, session, timeout, logger)
  }.
  
public define Result(SmtpClientResult, One)
  do_login
  (
    RWStream            conn,   //tcp connection
    List(String)        auth_list,  //list of available authentication method
    String              login,
    String              password,
    SmtpClientSession   session,
    Int                 timeout,
    (LogLevel, String) -> One logger
  )=
  if member(auth_list, "CRAM-MD5", insensitive_equal) then
    do_auth_cram_md5(conn, login, password, session, timeout, logger)
  else if member(auth_list, "PLAIN", insensitive_equal) then
    do_auth_plain(conn, login, password, session, timeout, logger)
  else if member(auth_list, "LOGIN", insensitive_equal) then
    do_auth_login(conn, login, password, session, timeout, logger)

  else
    logger(logError, "do_login: none of CRAM-MD5, LOGIN or PLAIN method available"); error(no_auth_method).

public define Result(SmtpClientResult, One)
  do_auth
  (
    RWStream            conn,   //tcp connection
    SmtpAuth            auth,   //authentication method to use for that session
    SmtpClientSession   session,
    Int                 timeout,
    (LogLevel, String) -> One logger
  )=
  if auth is
  {
    none                  then ok(unique),  //no need to authenticate, this is a "panties festival"
    login(user, password) then 
      with auth_list = get_auth_method(session.ehlo_answer, []), 
      if auth_list is
      {
        []     then logger(logError, "do_auth error"); error(no_auth_method),
        [_ . _]  then do_login(conn, auth_list, user, password, session, timeout, logger)
      }
  }.