Anubis / Xlib

Commit 90524aaa7f223f9be6524c43fe03d18a3817fc0e

Authored by Cédric RICARD
1 parent 5b8d2d40

Added send_mail() function

Showing 3 changed files with 982 additions and 0 deletions   Show diff stats
Inline Side-by-side
calexium_lib/mail/lexers/enhanced_status.anubis 0 → 100644
  Show/Hide comments   View file @90524aa
  1 +/*
  2 + *
  3 + * User: David RENE
  4 + * Date: 30/05/2008
  5 + * Time: 03:30
  6 + * (c) Calexium
  7 + *
  8 + */
  9 +
  10 +
  11 +
  12 +
  13 +read tools/basis.anubis
  14 +
  15 +
  16 + We want to test email addresses. Below is a regular expression for that
  17 + purpose. Actually, this expression is too nave. A real one would be more complicated.
  18 +
  19 +
  20 +read tools/streams.anubis
  21 +read system/string.anubis
  22 +
  23 +type LM_TokenOrError_EnhancedStatus:
  24 + end_of_file,
  25 + token(List(Word8)),
  26 + error.
  27 +
  28 +type LM_LexerState_EnhancedStatus: ...
  29 +
  30 +type LM_Match_EnhancedStatus:
  31 + match(List(Word8) characters,
  32 + (LM_LexerState_EnhancedStatus,List(Word8)) -> (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) action,
  33 + Bool aeol,
  34 + Bool abol).
  35 +
  36 +type LM_LexerState_EnhancedStatus:
  37 + lexer_state(Stream input,
  38 + List(Word8) unput, // in natural order
  39 + List(Word8) more, // in reverse order
  40 + LM_LexerState_EnhancedStatus -> (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) lexer,
  41 + Bool at_end_of_line,
  42 + Bool at_beginning_of_line,
  43 + Maybe(LM_Match_EnhancedStatus) match).
  44 +
  45 +define LM_LexerState_EnhancedStatus
  46 + lm_initial_state
  47 + (
  48 + Stream input,
  49 + LM_LexerState_EnhancedStatus -> (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) lexer
  50 + ) =
  51 + lexer_state(input,[],[],lexer,false,true,failure).
  52 +
  53 +define (LM_LexerState_EnhancedStatus,Word8)
  54 + lm_next_char
  55 + (
  56 + LM_LexerState_EnhancedStatus ls
  57 + ) =
  58 + if ls is lexer_state(input,unput,more,lex,aeol,abol,match) then
  59 + if unput is
  60 + {
  61 + [ ] then
  62 + if read_byte(input) is
  63 + {
  64 + failure then
  65 + (lexer_state(input,
  66 + [],
  67 + more,
  68 + lex,
  69 + true,
  70 + aeol,
  71 + match),
  72 + -1),
  73 +
  74 + success(c) then
  75 + (lexer_state(input,
  76 + [],
  77 + [c . more],
  78 + lex,
  79 + c = '\n',
  80 + aeol,
  81 + match),
  82 + c),
  83 + },
  84 +
  85 + [h . t] then
  86 + (lexer_state(input,
  87 + t,
  88 + [h . more],
  89 + lex,
  90 + h = '\n',
  91 + aeol,
  92 + match),
  93 + h)
  94 + }.
  95 +
  96 +define LM_LexerState_EnhancedStatus
  97 + lm_remember_match
  98 + (
  99 + (LM_LexerState_EnhancedStatus,List(Word8)) -> (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) action,
  100 + LM_LexerState_EnhancedStatus ls
  101 + ) =
  102 + if ls is lexer_state(input,unput,more,lex,aeol,abol,m) then
  103 + with chars = if m is
  104 + {
  105 + failure then [],
  106 + success(match) then
  107 + if match is match(chars,_,_,_) then chars
  108 + },
  109 + lexer_state(input,
  110 + unput,
  111 + [],
  112 + lex,
  113 + aeol,
  114 + abol,
  115 + success(match(append(more,chars),action,aeol,abol))).
  116 +
  117 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  118 + lm_find_match
  119 + (
  120 + LM_LexerState_EnhancedStatus ls
  121 + ) =
  122 + if ls is lexer_state(input,unput,more,lex,_,_,mb_m) then
  123 + if mb_m is
  124 + {
  125 + failure then (ls,error),
  126 + success(m) then
  127 + if m is match(chars,action,aeol,abol) then
  128 + action(lexer_state(input,
  129 + append(more,unput),
  130 + [],
  131 + lex,
  132 + aeol,
  133 + abol,
  134 + failure),
  135 + reverse(chars))
  136 + }.
  137 +
  138 +define LM_LexerState_EnhancedStatus
  139 + change_lexer
  140 + (
  141 + LM_LexerState_EnhancedStatus ls,
  142 + LM_LexerState_EnhancedStatus -> (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) lex
  143 + ) =
  144 + if ls is lexer_state(input,unput,more,_,aeol,abol,mb_m) then
  145 + lexer_state(input,unput,more,lex,aeol,abol,mb_m).
  146 +
  147 +define LM_LexerState_EnhancedStatus
  148 + clear_abol
  149 + (
  150 + LM_LexerState_EnhancedStatus ls
  151 + ) =
  152 + if ls is lexer_state(input,unput,more,lex,aeol,_,mb_m) then
  153 + lexer_state(input,unput,more,lex,aeol,false,mb_m).
  154 +
  155 + Declarations of all lexer states.
  156 +
  157 +
  158 +public define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester(LM_LexerState_EnhancedStatus ls).
  159 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_1(LM_LexerState_EnhancedStatus ls).
  160 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_2(LM_LexerState_EnhancedStatus ls).
  161 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_3(LM_LexerState_EnhancedStatus ls).
  162 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_4(LM_LexerState_EnhancedStatus ls).
  163 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_5(LM_LexerState_EnhancedStatus ls).
  164 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_6(LM_LexerState_EnhancedStatus ls).
  165 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_7(LM_LexerState_EnhancedStatus ls).
  166 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_8(LM_LexerState_EnhancedStatus ls).
  167 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_action_0
  168 + (LM_LexerState_EnhancedStatus ls, List(Word8) text).
  169 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_action_1
  170 + (LM_LexerState_EnhancedStatus ls, List(Word8) text).
  171 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_action_2
  172 + (LM_LexerState_EnhancedStatus ls, List(Word8) text).
  173 +
  174 +
  175 + Lexer states.
  176 +
  177 +
  178 +public define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  179 + enhanced_status_tester
  180 + (
  181 + LM_LexerState_EnhancedStatus ls,
  182 + ) =
  183 + if at_beginning_of_line(ls)
  184 + then enhanced_status_tester_state_3(clear_abol(ls)) else
  185 + if lm_next_char(ls) is (ls,c) then
  186 + if c = -1 then enhanced_status_tester_state_1(ls) else
  187 + if c = 50 then enhanced_status_tester_state_4(ls) else
  188 + if (52 +=< c & c +=< 53) then enhanced_status_tester_state_4(ls) else
  189 + lm_find_match(ls).
  190 +
  191 +
  192 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  193 + enhanced_status_tester_state_1
  194 + (
  195 + LM_LexerState_EnhancedStatus ls,
  196 + ) =
  197 + with ls = lm_remember_match(enhanced_status_tester_action_2,ls),
  198 + if lm_next_char(ls) is (ls,c) then
  199 + lm_find_match(ls).
  200 +
  201 +
  202 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  203 + enhanced_status_tester_state_2
  204 + (
  205 + LM_LexerState_EnhancedStatus ls,
  206 + ) =
  207 + if lm_next_char(ls) is (ls,c) then
  208 + lm_find_match(ls).
  209 +
  210 +
  211 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  212 + enhanced_status_tester_state_3
  213 + (
  214 + LM_LexerState_EnhancedStatus ls,
  215 + ) =
  216 + with ls = lm_remember_match(enhanced_status_tester_action_1,ls),
  217 + if lm_next_char(ls) is (ls,c) then
  218 + lm_find_match(ls).
  219 +
  220 +
  221 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  222 + enhanced_status_tester_state_4
  223 + (
  224 + LM_LexerState_EnhancedStatus ls,
  225 + ) =
  226 + if lm_next_char(ls) is (ls,c) then
  227 + if c = 46 then enhanced_status_tester_state_5(ls) else
  228 + if c = 50 then enhanced_status_tester_state_4(ls) else
  229 + if (52 +=< c & c +=< 53) then enhanced_status_tester_state_4(ls) else
  230 + lm_find_match(ls).
  231 +
  232 +
  233 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  234 + enhanced_status_tester_state_5
  235 + (
  236 + LM_LexerState_EnhancedStatus ls,
  237 + ) =
  238 + if lm_next_char(ls) is (ls,c) then
  239 + if c = 46 then enhanced_status_tester_state_5(ls) else
  240 + if (48 +=< c & c +=< 57) then enhanced_status_tester_state_6(ls) else
  241 + lm_find_match(ls).
  242 +
  243 +
  244 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  245 + enhanced_status_tester_state_6
  246 + (
  247 + LM_LexerState_EnhancedStatus ls,
  248 + ) =
  249 + if lm_next_char(ls) is (ls,c) then
  250 + if c = 46 then enhanced_status_tester_state_7(ls) else
  251 + if (48 +=< c & c +=< 57) then enhanced_status_tester_state_6(ls) else
  252 + lm_find_match(ls).
  253 +
  254 +
  255 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  256 + enhanced_status_tester_state_7
  257 + (
  258 + LM_LexerState_EnhancedStatus ls,
  259 + ) =
  260 + if lm_next_char(ls) is (ls,c) then
  261 + if c = 46 then enhanced_status_tester_state_7(ls) else
  262 + if (48 +=< c & c +=< 57) then enhanced_status_tester_state_8(ls) else
  263 + lm_find_match(ls).
  264 +
  265 +
  266 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  267 + enhanced_status_tester_state_8
  268 + (
  269 + LM_LexerState_EnhancedStatus ls,
  270 + ) =
  271 + with ls = lm_remember_match(enhanced_status_tester_action_0,ls),
  272 + if lm_next_char(ls) is (ls,c) then
  273 + if (48 +=< c & c +=< 57) then enhanced_status_tester_state_8(ls) else
  274 + lm_find_match(ls).
  275 +
  276 +
  277 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  278 + enhanced_status_tester_action_0
  279 + (
  280 + LM_LexerState_EnhancedStatus ls,
  281 + List(Word8) text
  282 + ) =
  283 + (ls,token(text)).
  284 +
  285 +
  286 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  287 + enhanced_status_tester_action_1
  288 + (
  289 + LM_LexerState_EnhancedStatus ls,
  290 + List(Word8) text
  291 + ) =
  292 + /* default action */ enhanced_status_tester(ls) .
  293 +
  294 +
  295 +define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
  296 + enhanced_status_tester_action_2
  297 + (
  298 + LM_LexerState_EnhancedStatus ls,
  299 + List(Word8) text
  300 + ) =
  301 + /* default action */ (ls,end_of_file) .
  302 +
  303 +
  304 + Since '@' is a normal character, a string needs to contain exactly one '@' for being
  305 + accepted. What is accepted before and after this '@' is described by:
  306 +
  307 + [a-zA-Z]+(\.[a-zA-Z]+)*
  308 +
  309 + The first part: [a-zA-Z]+ means ``at least one letter''. The last part: (\.[a-zA-Z]+)*
  310 + means: ``a dot followed by at least one letter, and this may be repeated any number of
  311 + times (including zero)''.
  312 +
  313 +
  314 + This part of the source file is the 'postambule' (just Anubis text, which is copied 'as
  315 + is' to the lexer_maker output file).
  316 +
  317 + The above stuff produces a function named 'email_tester' into the lexer_maker output
  318 + file. This function is used below:
  319 +
  320 +define Maybe(String)
  321 + _extract_enhanced_status
  322 + (
  323 + List(String) lines
  324 + ) =
  325 + if lines is
  326 + {
  327 + [ ] then failure,
  328 + [h . t] then
  329 + with ls = lexer_state(make_stream(h),[],[],enhanced_status_tester,true,false,failure),
  330 + if enhanced_status_tester(ls) is (_,result) then
  331 + if result is
  332 + {
  333 + end_of_file then _extract_enhanced_status(t),
  334 + token(tok) then success(implode(tok))
  335 + error then _extract_enhanced_status(t)
  336 + }
  337 + }.
  338 +
  339 +public define Maybe(String)
  340 + extract_enhanced_status
  341 + (
  342 + List(String) lines
  343 + ) =
  344 + if lines is
  345 + {
  346 + [ ] then failure,
  347 + [h . t] then
  348 + if _extract_enhanced_status(split_by_token(h, ' ')) is
  349 + {
  350 + failure then extract_enhanced_status(t),
  351 + success(r) then success(r)
  352 + }
  353 + }.
  354 +
  355 +
calexium_lib/mail/send_mail.anubis 0 → 100644
  Show/Hide comments   View file @90524aa
  1 +/*
  2 + * Created by PyramIDE.
  3 + * User: ricard
  4 + * Date: 22/12/2008
  5 + * Time: 17:49
  6 + *
  7 + */
  8 +
  9 +
  10 +read tools/basis.anubis
  11 +read tools/connections.anubis
  12 +read tools/findstring.anubis
  13 +read tools/printable_tree.anubis
  14 +read data_base/sqlite.anubis
  15 +read network/tools.anubis
  16 +read system/files.anubis
  17 +read system/string.anubis
  18 +read system/data_io.anubis
  19 +read system/logger.anubis
  20 +
  21 +read calexium_lib/net_services_protocols/logger_service.anubis
  22 +
  23 +read lexers/enhanced_status.anubis
  24 +read smtp_server_extensions.anubis
  25 +
  26 +public define String send_mail_log = "SendMail".
  27 +public define LogMask send_mail_mask = logMask("send_mail").
  28 +
  29 +define Int smtp_time_out = 300. //5 minutes of timeout
  30 +define ByteArray crlf_dot_crlf = to_byte_array(implode([13,10,'.',13,10])).
  31 +
  32 +public type SendMailResult:
  33 + ok,
  34 + error,
  35 + reply(Int code, String enhanced_status, List(String) lines).
  36 +
  37 +public type Send_Status:
  38 + ready, //ready to send
  39 + finished, //the mail is delivered correctly
  40 + timeout, //the mail was not sent in enough time, this is a permanent error
  41 + general_error,
  42 + error(Int code, String enhanced_status, String text), //this is SMTP permanent error 5xx, we can't deliver the mail
  43 + warning(Int code, String enhanced_status, String text), //this is SMTP temporary error 4xx, we can retry with same mail later
  44 + in_progress. //We are in sending process, it's like a lock
  45 +
  46 +public type Str_HostName:
  47 + str_host_name(String str).
  48 +
  49 +public type Str_Sender:
  50 + str_sender(String str).
  51 +
  52 +public type Str_Recipient:
  53 + str_recipient(String str).
  54 +
  55 +public type Str_UID:
  56 + str_UID(String str).
  57 +
  58 +public type Send_Auth:
  59 + none,
  60 + login( String login,
  61 + String password).
  62 +
  63 +public type Send_Param:
  64 + send_param( Str_HostName host_name,
  65 + Str_Sender sender,
  66 + Str_Recipient recipient,
  67 + List(Data_IO) mail_parts,
  68 + Send_Auth auth,
  69 + Str_UID mail_uid
  70 + ).
  71 +
  72 +public type Send_Timeout:
  73 + send_timeout(Int when).
  74 +
  75 +public type Send_Tries:
  76 + send_tries(Int number).
  77 +
  78 +
  79 +
  80 +
  81 +public type Send_Mail_Session:
  82 + send_mail_session(
  83 + Bool enhanced_status,
  84 + Int size
  85 + ).
  86 +
  87 +define Maybe(String)
  88 + receive_command
  89 + (
  90 + RWStream conn,
  91 + List(Word8) so_far,
  92 + Word8 previous
  93 + ) =
  94 + if read_network_byte(weaken(conn), smtp_time_out) is
  95 + {
  96 + failure then logTrace(send_mail_log, send_mail_mask, "receive_command read_network_byte 0 failure");failure,
  97 + timeout then logWarning(send_mail_log, "[send_mail] receive_command timeout"); failure,
  98 + success(c) then
  99 + if c = 10 & previous = 13 then // <LF>
  100 + with result = implode(reverse(so_far)),
  101 + logTrace(send_mail_log, send_mail_mask,"<-S-"+result);
  102 + success(result)
  103 + else
  104 + if previous = 13 then
  105 + receive_command(conn, so_far, c)
  106 + else
  107 + receive_command(conn, [previous . so_far], c)
  108 + }.
  109 +
  110 +define Maybe(String)
  111 + receive_command
  112 + (
  113 + RWStream conn,
  114 + List(Word8) so_far,
  115 + ) =
  116 + if read_network_byte(weaken(conn), smtp_time_out) is
  117 + {
  118 + failure then logTrace(send_mail_log, send_mail_mask, "receive_command read_network_byte 0 failure"); failure,
  119 + timeout then logWarning(send_mail_log, "[send_mail] receive_command timeout"); failure,
  120 + success(c) then receive_command(conn,[], c)
  121 + }.
  122 +
  123 +
  124 +type Reply_Result:
  125 + error,
  126 + reply(Int code, List(String) lines).
  127 +
  128 +define SendMailResult
  129 + reply_handling
  130 + (
  131 + Int code,
  132 + List(String) lines,
  133 + Bool enhanced_status
  134 + ) =
  135 + with result =
  136 + if enhanced_status then
  137 + if extract_enhanced_status(lines) is
  138 + {
  139 + failure then "",
  140 + success(enh) then enh
  141 + }
  142 + else
  143 + "",
  144 + reply(code, result, lines).
  145 +
  146 +
  147 +define Reply_Result
  148 + receive_reply
  149 + (
  150 + RWStream conn,
  151 + List(String) so_far
  152 + ) =
  153 + if receive_command(conn, []) is
  154 + {
  155 + failure then logError(send_mail_log, "receive_reply: error receiving command"); error,
  156 + success(line) then
  157 + //check if we must read another line by presence of hyphen after the reply code
  158 + //220-bla bla bla
  159 + //220 end of bla bla
  160 + if length(line) =< 3 then
  161 + if decimal_scan(line) is
  162 + {
  163 + failure then logError(send_mail_log, "receive_reply: can't extract reply code from '" + line + "'"); error,
  164 + success(code) then reply(code, reverse(so_far))
  165 + }
  166 + else if nth(3, line) is
  167 + {
  168 + failure then logError(send_mail_log, "receive_reply: error getting 4th character from '" + line +"'"); error,
  169 + success(char) then
  170 + if char = '-' then
  171 + receive_reply(conn, [line . so_far])
  172 + else
  173 + //decode the code
  174 + if sub_string(line, 0, 3) is
  175 + {
  176 + failure then logError(send_mail_log, "receive_reply: error extracting reply code from '" + line+"'"); error, // should never occure
  177 + success(code_str) then
  178 + if decimal_scan(code_str) is
  179 + {
  180 + failure then logError(send_mail_log, "receive_reply: can't extract reply code from '" + code_str + "'"); error, //unreadable code
  181 + success(code) then reply(code , reverse([line . so_far]))
  182 + }
  183 + }
  184 + }
  185 + }.
  186 +
  187 +define Reply_Result
  188 + receive_reply
  189 + (
  190 + RWStream conn,
  191 + ) =
  192 + receive_reply(conn, []).
  193 +
  194 +
  195 + Sending a piece of text (String) from the begining.
  196 +
  197 +define Maybe(One)
  198 + smtp_send_line
  199 + (
  200 + RWStream conn,
  201 + String text
  202 + ) =
  203 + if reliable_write(tcp(conn),[text + crlf]) is
  204 + {
  205 + failure then logError(send_mail_log, "smtp_send_line: error writing '" + text + "'"); failure,
  206 + success(_) then
  207 + logTrace(send_mail_log,send_mail_mask, "-C->"+text);success(unique)
  208 + } .
  209 +
  210 + Because of attachements, we may have to manipulate very big pieces of text. It would be
  211 + unreasonable to concatenate all pieces into a single String. Hence, we use the
  212 + following type:
  213 +
  214 +type StringTree:
  215 + [ ],
  216 + str_tree(String,StringTree),
  217 + ba_tree(ByteArray,StringTree),
  218 + tree_tree(StringTree,StringTree).
  219 +
  220 +define StringTree [String s . StringTree t] = str_tree(s,t).
  221 +define StringTree [ByteArray s . StringTree t] = ba_tree(s,t).
  222 +define StringTree [StringTree s . StringTree t] = tree_tree(s,t).
  223 +
  224 + Try to send the 'HELO' command and get the reply. Return 'true' if you cannot.
  225 +
  226 +define Reply_Result
  227 + send_ehlo
  228 + (
  229 + RWStream conn,
  230 + String our_host_name
  231 + ) =
  232 + if smtp_send_line(conn,"EHLO "+our_host_name) is
  233 + {
  234 + failure then logError(send_mail_log, "send_ehlo: error sending EHLO"); error,
  235 + success(_) then
  236 + with rep = receive_reply(conn),
  237 + if rep is
  238 + {
  239 + error then logError(send_mail_log, "send_ehlo: can't get reply"); error,
  240 + reply(code, lines) then
  241 + //we manage the 500 error, that mean the remote server is not ESMTP
  242 + //hence we try we with HELO, the old manner RFC 821
  243 + if code = 500 | code = 502 then
  244 + if smtp_send_line(conn,"HELO "+our_host_name) is
  245 + {
  246 + failure then logError(send_mail_log, "send_ehlo: error sending HELO"); error,
  247 + success(_) then receive_reply(conn)
  248 + }
  249 + else
  250 + rep
  251 + }
  252 + }.
  253 +
  254 + The same one for 'MAIL FROM':
  255 +
  256 +define Reply_Result
  257 + send_mail_from
  258 + (
  259 + RWStream conn,
  260 + String sender
  261 + ) =
  262 + if smtp_send_line(conn,"MAIL FROM:"+sender) is
  263 + {
  264 + failure then logError(send_mail_log, "error sending 'MAIL FROM:" + sender + "'"); error,
  265 + success(_) then receive_reply(conn)
  266 + }.
  267 +
  268 + The same one for 'RCPT TO':
  269 +
  270 +define Reply_Result
  271 + send_recipient
  272 + (
  273 + RWStream conn,
  274 + String recipient,
  275 + ) =
  276 + if smtp_send_line(conn,"RCPT TO:<"+recipient+">") is
  277 + {
  278 + failure then logError(send_mail_log, "error sending 'RCPT TO:<"+recipient+">'"); error,
  279 + success(_) then receive_reply(conn)
  280 + }.
  281 +
  282 +
  283 + Try to send 'DATA' and get the reply. Answer 'true' if you cannot.
  284 +
  285 +define Reply_Result
  286 + send_data
  287 + (
  288 + RWStream conn
  289 + ) =
  290 + if smtp_send_line(conn,"DATA") is
  291 + {
  292 + failure then logError(send_mail_log, "error sending DATA"); error,
  293 + success(_) then receive_reply(conn)
  294 + }.
  295 +
  296 +
  297 +
  298 + The same for the content of the message. We need base64 encoding.
  299 +
  300 +read tools/base64.anubis
  301 +
  302 +define Reply_Result
  303 + send_content
  304 + (
  305 + RWStream conn,
  306 + List(Data_IO) mail_part
  307 + ) =
  308 + //open the message file from the drive
  309 + if copy_Data_IO_List_to_Stream(mail_part, weaken(conn)) is copy_ok(_) then
  310 + if reliable_write(tcp(conn), [crlf_dot_crlf]) is
  311 + {
  312 + failure then logError(send_mail_log, "send_content: error writing CRLF.CRLF"); error,
  313 + success(_) then receive_reply(conn)
  314 + }
  315 + else
  316 + logError(send_mail_log, "send_content: error sending data"); error.
  317 +
  318 +
  319 + Almost the same for 'QUIT':
  320 +
  321 +define One
  322 + send_quit
  323 + (
  324 + RWStream conn
  325 + ) =
  326 + if smtp_send_line(conn,"QUIT") is
  327 + {
  328 + failure then logWarning(send_mail_log, "error sending QUIT"),
  329 + success(_) then forget(receive_reply(conn))
  330 + }.
  331 +
  332 +define SendMailResult
  333 + sm_MAIL_FROM
  334 + (
  335 + RWStream conn,
  336 + Send_Param param,
  337 + Send_Mail_Session sm_session
  338 + ) =
  339 + with enhanced_status = sm_session.enhanced_status,
  340 + //send MAIL FROM
  341 + if send_mail_from(conn, param.sender.str) is
  342 + {
  343 + error then error, // already logged
  344 + reply(code, lines) then
  345 + if code = 250 then
  346 + //send RCPT TO
  347 + if send_recipient(conn,param.recipient.str) is
  348 + {
  349 + error then error, // already logged
  350 + reply(code, lines) then
  351 + if code = 250 then
  352 + //send DATA
  353 + if send_data(conn) is
  354 + {
  355 + error then error, // already logged
  356 + reply(code, lines) then
  357 + if code = 354 then
  358 + if send_content(conn, param.mail_parts) is
  359 + {
  360 + error then error, // already logged
  361 + reply(code, lines) then
  362 + if code = 250 then
  363 + send_quit(conn);
  364 + logInfo(send_mail_log,"SENT Mail FROM "+param.sender.str+" TO "+param.recipient.str);
  365 + ok
  366 + else
  367 + reply_handling(code, lines, enhanced_status)
  368 + }
  369 + else
  370 + reply_handling(code, lines, enhanced_status)
  371 + }
  372 + else
  373 + reply_handling(code, lines, enhanced_status)
  374 + }
  375 + else
  376 + reply_handling(code, lines, enhanced_status)
  377 + }
  378 +.
  379 +
  380 +define List(String)
  381 + get_auth_method
  382 + (
  383 + List(String) lines,
  384 + List(String) so_far
  385 + )=
  386 + if lines is
  387 + {
  388 + [] then so_far,
  389 + [h . t] then
  390 + if sub_string(h, 4, 4) is
  391 + {
  392 + failure then get_auth_method(t, so_far),
  393 + success(s) then
  394 + with current = if insensitive_equal(s, "AUTH") then
  395 + force_Type(list_word(h,9),[])
  396 + else
  397 + [],
  398 + get_auth_method(t, current + so_far)
  399 + }
  400 + }.
  401 +
  402 +define SendMailResult
  403 + do_auth_plain
  404 + (
  405 + RWStream conn,
  406 + String login,
  407 + String password,
  408 + Bool enhanced_status
  409 + )=
  410 +
  411 + with plain_str = "AUTH PLAIN "+ to_string(base64_encode(to_byte_array(login)+
  412 + constant_byte_array(1,0)+
  413 + to_byte_array(login)+
  414 + constant_byte_array(1,0)+
  415 + to_byte_array(password))),
  416 + if smtp_send_line(conn, plain_str) is
  417 + {
  418 + failure then error, // already logged
  419 + success(_) then
  420 + if receive_reply(conn) is
  421 + {
  422 + error then error // already logged
  423 + reply(code, lines) then
  424 + if code = 235 then
  425 + ok
  426 + else
  427 + reply_handling(code,lines,enhanced_status)
  428 + }
  429 + }.
  430 +
  431 +define SendMailResult
  432 + do_login
  433 + (
  434 + RWStream conn, //tcp connection
  435 + List(String) auth_list, //list of available authentication method
  436 + String login,
  437 + String password,
  438 + Bool enhanced_status
  439 + )=
  440 +
  441 + if member(auth_list, "PLAIN", insensitive_equal) then
  442 + do_auth_plain(conn, login, password, enhanced_status)
  443 + else
  444 + logError(send_mail_log, "do_login no PLAIN method available"); error.
  445 +
  446 +define SendMailResult
  447 + do_auth
  448 + (
  449 + RWStream conn, //tcp connection
  450 + List(String) lines, //this is the reply lines provided in response to EHLO command
  451 + Send_Auth auth, //authentication method to use for that session
  452 + Bool enhanced_status
  453 + )=
  454 + if auth is
  455 + {
  456 + none then ok, //no need to authenticate, this is a "panties festival"
  457 + login(user, password) then
  458 + with auth_list = get_auth_method(lines,[]),
  459 + if auth_list is
  460 + {
  461 + [] then logError(send_mail_log, "do_auth error");error,
  462 + [_ . _] then do_login(conn, auth_list, user, password, enhanced_status)
  463 + }
  464 + }.
  465 +
  466 + /**
  467 + * make_sm_session
  468 + */
  469 +define Send_Mail_Session
  470 + make_sm_session
  471 + (
  472 + List(String) lines, //lines given in ehlo stage
  473 + Send_Param param
  474 + )=
  475 + //looking for ENHANCEDSTATUSCODES
  476 + with session_enhanced_status = has_smtp_extension(lines, enhanced_status_codes),
  477 + //looking for SIZE
  478 + with session_size = if get_smtp_extension_value(lines, size) is
  479 + {
  480 + failure then 0,
  481 + success(str_value) then
  482 + if decimal_scan(str_value) is
  483 + {
  484 + failure then 0,
  485 + success(value) then
  486 + logDebug(send_mail_log, "smtp server with SIZE "+value);
  487 + value
  488 + }
  489 + },
  490 + send_mail_session(session_enhanced_status, session_size).
  491 +
  492 + Apply the whole protocol:
  493 +
  494 + //TODO we can have a list of part file in param type. This can be very useful when we want
  495 + //to send file as mailing. For the mailing, in each mail, only the header is different of the
  496 + //other mails. The body part is the same. Then, the mailing sender can generate the header in one
  497 + //file and keep the body in other file wich can be given to send_mail function as last file in the list
  498 +public define SendMailResult
  499 + send_mail
  500 + (
  501 + RWStream conn,
  502 + Send_Param param,
  503 + (Send_Mail_Session, Send_Param) -> Result(SendMailResult, Send_Param) prepare_mail_callback,
  504 + ) =
  505 + //
  506 + // Our connection to the SMTP server is opened. We just have to apply the protocol.
  507 + //
  508 + if receive_reply(conn) is
  509 + {
  510 + error then error,// already logged
  511 + reply(code, lines) then
  512 + if code = 220 then
  513 + //send EHLO
  514 + if send_ehlo(conn, param.host_name.str) is //"mail."+force_Type(get_main_domain(db), "mailfountain.net")) is
  515 + {
  516 + error then error, // already logged
  517 + reply(code, lines) then
  518 + if code = 250 then
  519 + // parse all available options here, and build a smtp context
  520 + with sm_session = make_sm_session(lines, param),
  521 + with auth_result = do_auth(conn, lines, param.auth, sm_session.enhanced_status),
  522 + if auth_result = ok then
  523 + if prepare_mail_callback(sm_session, param) is
  524 + {
  525 + error(result) then result,
  526 + ok(new_param) then sm_MAIL_FROM(conn, new_param, sm_session)
  527 + }
  528 + else
  529 + auth_result
  530 + else
  531 + reply_handling(code,lines,true)
  532 + }
  533 + else
  534 + //some server answer "550 5.7.1 Client host rejected: cannot find your reverse hostname, [88.181.64.17]"
  535 + //before anything, then we try to extract the enhanced status if exists for relaying the mail with the ISP
  536 + reply_handling(code,lines,true)
  537 + }.
calexium_lib/mail/smtp_server_extensions.anubis 0 → 100644
  Show/Hide comments   View file @90524aa
  1 +/*
  2 + *
  3 + * User: David RENE
  4 + * Date: 30/05/2008
  5 + * Time: 01:18
  6 + * (c) Calexium
  7 + *
  8 + */
  9 +
  10 +read tools/basis.anubis
  11 +read system/string.anubis
  12 +
  13 +public type SMTP_Extension_verb:
  14 + smtp_extension_verb
  15 + (
  16 + String verb
  17 + ).
  18 +
  19 +public define SMTP_Extension_verb enhanced_status_codes = smtp_extension_verb("ENHANCEDSTATUSCODES").
  20 +public define SMTP_Extension_verb size = smtp_extension_verb("SIZE").
  21 +
  22 +define Bool
  23 + has_smtp_extension
  24 + (
  25 + List(String) lines, //left lines given in ehlo stage
  26 + Int length,
  27 + String search_ext
  28 + )=
  29 + if lines is
  30 + {
  31 + [] then false,
  32 + [h . t] then
  33 + if sub_string(h, 4, length) is
  34 + {
  35 + failure then has_smtp_extension(t, length, search_ext),
  36 + success(s) then
  37 + if insensitive_equal(s, search_ext) then
  38 + true
  39 + else
  40 + has_smtp_extension(t, length, search_ext),
  41 + }
  42 + }.
  43 +
  44 +public define Bool
  45 + has_smtp_extension
  46 + (
  47 + List(String) lines, //left lines given in ehlo stage
  48 + SMTP_Extension_verb search_ext
  49 + )=
  50 + has_smtp_extension(lines, length(search_ext.verb), search_ext.verb).
  51 +
  52 +define Maybe(String)
  53 + get_smtp_extension_value
  54 + (
  55 + List(String) lines, //left lines given in ehlo stage
  56 + Int len,
  57 + String search_ext
  58 + )=
  59 + if lines is
  60 + {
  61 + [] then failure,
  62 + [h . t] then
  63 + if sub_string(h, 4, len) is
  64 + {
  65 + failure then get_smtp_extension_value(t, len, search_ext),
  66 + success(s) then
  67 + if insensitive_equal(s, search_ext) then
  68 + sub_string(h, 5+len, length(h)-(5+len))
  69 + else
  70 + get_smtp_extension_value(t, len, search_ext),
  71 + }
  72 + }.
  73 +
  74 + /**
  75 + * return the value of wanted smtp extension name
  76 + * for "SIZE 10000" it return 10000.
  77 + * if the smtp verb doesn't exist, it return failure
  78 + */
  79 +
  80 +public define Maybe(String)
  81 + get_smtp_extension_value
  82 + (
  83 + List(String) lines, //left lines given in ehlo stage
  84 + SMTP_Extension_verb search_ext
  85 + )=
  86 + if has_smtp_extension(lines, length(search_ext.verb), search_ext.verb) then
  87 + get_smtp_extension_value(lines, length(search_ext.verb), search_ext.verb)
  88 + else
  89 + failure.
  90 +