Anubis / Xlib

Commit baaacc6235d4d0ef4c9f7df25f48fc838dac563c

Authored by Cédric RICARD
1 parent b01dd67e

send_mail() refactoring

Showing 2 changed files with 758 additions and 720 deletions   Show diff stats
Inline Side-by-side
calexium_lib/mail/send_mail.anubis
  Show/Hide comments   View file @baaacc6
@@ -9,9 +9,7 @@ @@ -9,9 +9,7 @@
9 9
10 read tools/basis.anubis 10 read tools/basis.anubis
11 read tools/connections.anubis 11 read tools/connections.anubis
12 -read tools/findstring.anubis  
13 read tools/printable_tree.anubis 12 read tools/printable_tree.anubis
14 -read data_base/sqlite.anubis  
15 read network/dns.anubis 13 read network/dns.anubis
16 read network/tools.anubis 14 read network/tools.anubis
17 read system/files.anubis 15 read system/files.anubis
@@ -24,17 +22,17 @@ read calexium_lib/net_services_protocols/logger_service.anubis @@ -24,17 +22,17 @@ read calexium_lib/net_services_protocols/logger_service.anubis
24 read lexers/enhanced_status.anubis 22 read lexers/enhanced_status.anubis
25 read smtp_server_extensions.anubis 23 read smtp_server_extensions.anubis
26 read authentication.anubis 24 read authentication.anubis
  25 +read smtp_client.anubis
27 26
28 public define String send_mail_log = "SendMail". 27 public define String send_mail_log = "SendMail".
29 public define LogMask send_mail_mask = logMask("send_mail"). 28 public define LogMask send_mail_mask = logMask("send_mail").
30 29
31 define Int smtp_time_out = 300. //5 minutes of timeout 30 define Int smtp_time_out = 300. //5 minutes of timeout
32 -define ByteArray crlf_dot_crlf = to_byte_array(implode([13,10,'.',13,10])).  
33 31
34 -public type SendMailResult:  
35 - ok,  
36 - error,  
37 - reply(Int code, String enhanced_status, List(String) lines). 32 + public type SendMailResult:
  33 + ok,
  34 + error,
  35 + reply(Int code, String enhanced_status, List(String) lines).
38 36
39 public type Str_HostName: 37 public type Str_HostName:
40 str_host_name(String str). 38 str_host_name(String str).
@@ -48,706 +46,56 @@ public type Str_Recipient: @@ -48,706 +46,56 @@ public type Str_Recipient:
48 public type Str_UID: 46 public type Str_UID:
49 str_UID(String str). 47 str_UID(String str).
50 48
51 -public type Send_Auth:  
52 - none,  
53 - login( String login,  
54 - String password).  
55 -  
56 public type Send_Param: 49 public type Send_Param:
57 send_param( Str_HostName host_name, 50 send_param( Str_HostName host_name,
58 Str_Sender sender, 51 Str_Sender sender,
59 Str_Recipient recipient, 52 Str_Recipient recipient,
60 List(Data_IO) mail_parts, 53 List(Data_IO) mail_parts,
61 - Send_Auth auth, 54 + SmtpAuth auth,
62 Str_UID mail_uid, 55 Str_UID mail_uid,
63 Int last_smtp_code //0 means it's the first time 56 Int last_smtp_code //0 means it's the first time
64 ). 57 ).
65 58
66 -public type Send_Timeout:  
67 - send_timeout(Int when).  
68 -  
69 -public type Send_Tries:  
70 - send_tries(Int number).  
71 -  
72 -  
73 -  
74 -  
75 -public type Send_Mail_Session:  
76 - send_mail_session(  
77 - Bool enhanced_status,  
78 - Int size  
79 - ).  
80 -  
81 -type Command_Result:  
82 - failure,  
83 - timeout,  
84 - success(String).  
85 -  
86 -define Command_Result  
87 - receive_command  
88 - (  
89 - RStream conn,  
90 - List(Word8) so_far,  
91 - Word8 previous,  
92 - Int time_out,  
93 - (LogLevel, String) -> One logger  
94 - ) =  
95 - if read_network_byte(conn, time_out) is  
96 - {  
97 - failure then logger(logTrace, "receive_command read_network_byte 0 failure");failure,  
98 - timeout then logger(logWarning, "[send_mail] receive_command timeout"); timeout,  
99 - success(c) then  
100 - if c = 10 & previous = 13 then // <LF>  
101 - with result = implode(reverse(so_far)),  
102 - logger(logTrace, "<-S-"+result);  
103 - success(result)  
104 - else  
105 - if previous = 13 then  
106 - receive_command(conn, so_far, c, time_out, logger)  
107 - else  
108 - receive_command(conn, [previous . so_far], c, time_out, logger)  
109 - }.  
110 -  
111 -define Command_Result  
112 - receive_command  
113 - (  
114 - RStream conn,  
115 - List(Word8) so_far,  
116 - Int time_out,  
117 - (LogLevel, String) -> One logger  
118 - ) =  
119 - if read_network_byte(conn, time_out) is  
120 - {  
121 - failure then logger(logTrace, "receive_command read_network_byte 0 failure"); failure,  
122 - timeout then (if time_out = 0 then unique else logger(logWarning, "[send_mail] receive_command timeout")); timeout,  
123 - success(c) then receive_command(conn,[], c, time_out, logger)  
124 - }.  
125 -  
126 -  
127 -type Reply_Result:  
128 - error,  
129 - timeout,  
130 - reply(Int code, List(String) lines).  
131 -  
132 -define SendMailResult  
133 - reply_handling  
134 - (  
135 - Int code,  
136 - List(String) lines,  
137 - Bool enhanced_status  
138 - ) =  
139 - with result =  
140 - if enhanced_status then  
141 - if extract_enhanced_status(lines) is  
142 - {  
143 - failure then "",  
144 - success(enh) then enh  
145 - }  
146 - else  
147 - "",  
148 - reply(code, result, lines).  
149 -  
150 -  
151 -define Reply_Result  
152 - receive_reply  
153 - (  
154 - RStream conn,  
155 - List(String) so_far,  
156 - Int time_out,  
157 - (LogLevel, String) -> One logger  
158 - ) =  
159 - if receive_command(conn, [], time_out, logger) is  
160 - {  
161 - failure then logger(logError, "receive_reply: error receiving command"); error,  
162 - timeout then (if time_out > 0 then logger(logError, "receive_reply: timeout receiving command") else unique); timeout,  
163 - success(line) then  
164 - //check if we must read another line by presence of hyphen after the reply code  
165 - //220-bla bla bla  
166 - //220 end of bla bla  
167 - if length(line) =< 3 then  
168 - if decimal_scan(line) is  
169 - {  
170 - failure then logger(logError, "receive_reply: can't extract reply code from '" + line + "'"); error,  
171 - success(code) then reply(code, reverse(so_far))  
172 - }  
173 - else if nth(3, line) is  
174 - {  
175 - failure then logger(logError, "receive_reply: error getting 4th character from '" + line +"'"); error,  
176 - success(char) then  
177 - if char = '-' then  
178 - receive_reply(conn, [line . so_far], time_out, logger)  
179 - else  
180 - //decode the code  
181 - if sub_string(line, 0, 3) is  
182 - {  
183 - failure then logger(logError, "receive_reply: error extracting reply code from '" + line+"'"); error, // should never occure  
184 - success(code_str) then  
185 - if decimal_scan(code_str) is  
186 - {  
187 - failure then logger(logError, "receive_reply: can't extract reply code from '" + code_str + "'"); error, //unreadable code  
188 - success(code) then reply(code , reverse([line . so_far]))  
189 - }  
190 - }  
191 - }  
192 - }.  
193 -  
194 -define Reply_Result  
195 - receive_reply  
196 - (  
197 - RWStream conn,  
198 - (LogLevel, String) -> One logger  
199 - ) =  
200 - receive_reply(weaken(conn), [], smtp_time_out, logger).  
201 -  
202 -  
203 - Sending a piece of text (String) from the begining.  
204 -  
205 -define Maybe(One)  
206 - smtp_send_line  
207 - (  
208 - RWStream conn,  
209 - String text,  
210 - (LogLevel, String) -> One logger  
211 - ) =  
212 - if reliable_write(tcp(conn),[text + crlf]) is  
213 - {  
214 - failure then logger(logError, "smtp_send_line: error writing '" + text + "'"); failure,  
215 - success(_) then  
216 - logger(logTrace, "-C->"+text);success(unique)  
217 - } .  
218 -  
219 - Because of attachements, we may have to manipulate very big pieces of text. It would be  
220 - unreasonable to concatenate all pieces into a single String. Hence, we use the  
221 - following type:  
222 -  
223 -type StringTree:  
224 - [ ],  
225 - str_tree(String,StringTree),  
226 - ba_tree(ByteArray,StringTree),  
227 - tree_tree(StringTree,StringTree).  
228 -  
229 -define StringTree [String s . StringTree t] = str_tree(s,t).  
230 -define StringTree [ByteArray s . StringTree t] = ba_tree(s,t).  
231 -define StringTree [StringTree s . StringTree t] = tree_tree(s,t).  
232 -  
233 - Try to send the 'HELO' command and get the reply. Return 'true' if you cannot.  
234 -  
235 -define Reply_Result  
236 - send_ehlo  
237 - (  
238 - RWStream conn,  
239 - String our_host_name,  
240 - (LogLevel, String) -> One logger  
241 - ) =  
242 - if smtp_send_line(conn,"EHLO "+our_host_name, logger) is  
243 - {  
244 - failure then logger(logError, "send_ehlo: error sending EHLO"); error,  
245 - success(_) then  
246 - with rep = if receive_reply(conn, logger) is  
247 - {  
248 - error then logger(logError, "send_ehlo: can't get reply"); error,  
249 - timeout then logger(logError, "send_ehlo: timeout getting reply"); timeout,  
250 - reply(code, lines) then  
251 - //we manage the 500 error, that mean the remote server is not ESMTP  
252 - //hence we try we with HELO, the old manner RFC 821  
253 - if code = 500 | code = 502 then  
254 - if smtp_send_line(conn,"HELO "+our_host_name, logger) is  
255 - {  
256 - failure then logger(logError, "send_ehlo: error sending HELO"); error,  
257 - success(_) then receive_reply(conn, logger)  
258 - }  
259 - else  
260 - reply(code, lines)  
261 - },  
262 - if rep is reply(code, lines) then  
263 - if code = 550 then // some server simply refuse us because it's temporary overloaded (especially try when sending mailings)  
264 - logger(logDebug, "Converting a 550 error for EHLO to a 432 error as distant server may be temporary overloaded.");  
265 - reply(432, lines)  
266 - else  
267 - rep  
268 - else  
269 - rep  
270 - }.  
271 -  
272 - The same one for 'MAIL FROM':  
273 -  
274 -define String  
275 - check_email_syntax  
276 - (  
277 - String email  
278 - ) =  
279 - if nth(0, email) is  
280 - {  
281 - failure then "<>",  
282 - success(b) then  
283 - if b = '<' then email  
284 - else "<" + email + ">"  
285 - }.  
286 -  
287 -  
288 -define Reply_Result  
289 - send_mail_from  
290 - (  
291 - RWStream conn,  
292 - String sender,  
293 - (LogLevel, String) -> One logger  
294 - ) =  
295 - with rfc_sender = check_email_syntax(sender),  
296 - if smtp_send_line(conn,"MAIL FROM:"+rfc_sender, logger) is  
297 - {  
298 - failure then logger(logError, "error sending 'MAIL FROM:" + rfc_sender + "'"); error,  
299 - success(_) then receive_reply(conn, logger)  
300 - }.  
301 -  
302 - The same one for 'RCPT TO':  
303 -  
304 -define Reply_Result  
305 - send_recipient  
306 - (  
307 - RWStream conn,  
308 - String recipient,  
309 - (LogLevel, String) -> One logger  
310 - ) =  
311 - with rfc_recipient = check_email_syntax(recipient),  
312 - if smtp_send_line(conn,"RCPT TO:"+rfc_recipient, logger) is  
313 - {  
314 - failure then logger(logError, "error sending 'RCPT TO:"+rfc_recipient+"'"); error,  
315 - success(_) then receive_reply(conn, logger)  
316 - }.  
317 -  
318 -  
319 - Try to send 'DATA' and get the reply. Answer 'true' if you cannot.  
320 -  
321 -define Reply_Result  
322 - send_data  
323 - (  
324 - RWStream conn,  
325 - (LogLevel, String) -> One logger  
326 - ) =  
327 - if smtp_send_line(conn,"DATA", logger) is  
328 - {  
329 - failure then logger(logError, "error sending DATA"); error,  
330 - success(_) then receive_reply(conn, logger)  
331 - }.  
332 -  
333 -  
334 -  
335 - The same for the content of the message. We need base64 encoding.  
336 -  
337 -read tools/base64.anubis  
338 -type SendContentResult:  
339 - smtp_reply(Reply_Result),  
340 - copy_error(Int written),  
341 - copy_ok(Int written).  
342 -  
343 -define Maybe(One)  
344 - sm_flush  
345 - (  
346 - ByteArray buffer,  
347 - WStream target,  
348 - Int buffer_start_time,  
349 - (LogLevel, String) -> One logger  
350 - )=  
351 - if write( target , buffer) is  
352 - {  
353 - failure then failure,  
354 - success(nb_write) then  
355 - if now - buffer_start_time > 3600 then  
356 - // security to avoid queue blocking  
357 - logger(logError, "sm_flush: TIMEOUT sending a 64kb buffer (taking more than 1 hour). SendMail canceled.");  
358 - failure  
359 - else  
360 - with buffer_size = length(buffer),  
361 - if nb_write = buffer_size then  
362 - success(unique)  
363 - else  
364 - with new_buffer = extract(buffer, nb_write, buffer_size),  
365 - sm_flush(new_buffer, target, buffer_start_time, logger)  
366 - }.  
367 -  
368 -public define SendContentResult  
369 - sm_copy_Data_IO_to_Stream  
370 - (  
371 - Data_IO source,  
372 - RWStream target,  
373 - Int start_time,  
374 - Int so_far,  
375 - (Int) -> One progress_report,  
376 - (LogLevel, String) -> One logger  
377 - ) =  
378 - if receive_reply(weaken(target), [], 0, logger) is  
379 - {  
380 - error then copy_error(so_far),  
381 - timeout then  
382 - if read_bytes(source, 65536) is  
383 - {  
384 - failure then logger(logError, "send_content: failed to read input data_io"); copy_error(so_far),  
385 - time_out then logger(logError, "send_content: timeout reading input data_io"); copy_error(so_far),  
386 - success(buffer) then  
387 - if sm_flush( buffer, weaken(target), now, logger ) is  
388 - {  
389 - failure then copy_error(so_far),  
390 - success(_) then  
391 - progress_report(so_far + 65536);  
392 - sm_copy_Data_IO_to_Stream(source, target, start_time, so_far + 65536, progress_report, logger)  
393 - },  
394 -  
395 - truncated(buffer) then  
396 - with len = length(buffer),  
397 - if len = 0 then  
398 - copy_ok(so_far)  
399 - else  
400 - if sm_flush( buffer, weaken(target), now, logger ) is  
401 - {  
402 - failure then copy_error(so_far),  
403 - success(_) then  
404 - progress_report(so_far + len);  
405 - copy_ok(so_far + len)  
406 - }  
407 - },  
408 - reply(code, lines) then  
409 - smtp_reply(reply(code, lines))  
410 - }.  
411 59
412 -define SendContentResult  
413 - sm_copy_Data_IO_List_to_Stream  
414 - (  
415 - List(Data_IO) io_list,  
416 - RWStream target,  
417 - Int start_time,  
418 - Int so_far,  
419 - (Int) -> One progress_report,  
420 - (LogLevel, String) -> One logger  
421 - )=  
422 - if io_list is  
423 - {  
424 - [] then copy_ok(so_far),  
425 - [ h . t ] then  
426 - if rewind(h)(unique) then  
427 - with result = sm_copy_Data_IO_to_Stream(h, target, start_time, 0, progress_report, logger),  
428 - if result is copy_ok(written) then  
429 - sm_copy_Data_IO_List_to_Stream(t, target, start_time, so_far + written, progress_report, logger)  
430 - else  
431 - result  
432 - else  
433 - copy_error(so_far)  
434 - }.  
435 60
436 -define Reply_Result  
437 - send_content  
438 - (  
439 - RWStream conn,  
440 - List(Data_IO) mail_part,  
441 - (Int) -> One progress_report,  
442 - (LogLevel, String) -> One logger  
443 - ) =  
444 - with start_time = now,  
445 - if sm_copy_Data_IO_List_to_Stream(mail_part, conn, now, 0, progress_report, logger) is  
446 - {  
447 - smtp_reply(reply) then reply  
448 - copy_error(written) then  
449 - with finish_time = now,  
450 - logger(logError, "send_content: error sending data");  
451 - logger(logTrace, "send_content: "+written+" bytes sent in "+finish_time - start_time+" second(s)");  
452 - if written > 1024000 then  
453 - logger(logInfo, "send_content: may be due to over sized mail. Convert it to 452 error.");  
454 - reply(452, ["Error sending big email (more than 1 Mb)"])  
455 - else  
456 - error,  
457 - copy_ok(size) then  
458 - if reliable_write(tcp(conn), [crlf_dot_crlf]) is  
459 - {  
460 - failure then logger(logError, "send_content: error writing CRLF.CRLF"); error,  
461 - success(_) then  
462 - with finish_time = (Int)now,  
463 - logger(logTrace, "mail sent "+size+" bytes in "+finish_time - start_time+" second(s)");  
464 - receive_reply(conn, logger)  
465 - }  
466 - }.  
467 61
468 -  
469 - Almost the same for 'QUIT':  
470 -  
471 -define One  
472 - send_quit  
473 - (  
474 - RWStream conn,  
475 - (LogLevel, String) -> One logger  
476 - ) =  
477 - if smtp_send_line(conn,"QUIT", logger) is  
478 - {  
479 - failure then logger(logWarning, "error sending QUIT"),  
480 - success(_) then forget(receive_reply(conn, logger))  
481 - }.  
482 -  
483 -define SendMailResult 62 +define Result(SmtpClientResult, One)
484 sm_MAIL_FROM 63 sm_MAIL_FROM
485 ( 64 (
486 RWStream conn, 65 RWStream conn,
487 Send_Param param, 66 Send_Param param,
488 - Send_Mail_Session sm_session, 67 + SmtpClientSession sm_session,
489 (Int) -> One progress_report, 68 (Int) -> One progress_report,
490 (LogLevel, String) -> One logger 69 (LogLevel, String) -> One logger
491 ) = 70 ) =
492 with enhanced_status = sm_session.enhanced_status, 71 with enhanced_status = sm_session.enhanced_status,
493 //send MAIL FROM 72 //send MAIL FROM
494 - if send_mail_from(conn, param.sender.str, logger) is  
495 - {  
496 - error then error, // already logged  
497 - timeout then error,  
498 - reply(code, lines) then  
499 - if code = 250 then  
500 - //send RCPT TO  
501 - if send_recipient(conn,param.recipient.str, logger) is  
502 - {  
503 - error then error, // already logged  
504 - timeout then error,  
505 - reply(code, lines) then  
506 - if code = 250 then  
507 - //send DATA  
508 - if send_data(conn, logger) is  
509 - {  
510 - error then error, // already logged  
511 - timeout then error,  
512 - reply(code, lines) then  
513 - if code = 354 then  
514 - if send_content(conn, param.mail_parts, progress_report, logger) is  
515 - {  
516 - error then error, // already logged  
517 - timeout then error,  
518 - reply(code, lines) then  
519 - if code = 250 then  
520 - send_quit(conn, logger);  
521 - logger(logTrace, "SENT Mail FROM "+param.sender.str+" TO "+param.recipient.str);  
522 - ok  
523 - else  
524 - reply_handling(code, lines, enhanced_status)  
525 - }  
526 - else  
527 - reply_handling(code, lines, enhanced_status)  
528 - }  
529 - else  
530 - reply_handling(code, lines, enhanced_status)  
531 - }  
532 - else  
533 - reply_handling(code, lines, enhanced_status)  
534 - }  
535 -.  
536 -  
537 -define List(String)  
538 - get_auth_method  
539 - (  
540 - List(String) lines,  
541 - List(String) so_far  
542 - )=  
543 - if lines is 73 + if send_mail_from(conn, param.sender.str, sm_session, smtp_time_out, logger) is
544 { 74 {
545 - [] then so_far,  
546 - [h . t] then  
547 - if sub_string(h, 4, 4) is 75 + error(result) then error(result),
  76 + ok(_) then
  77 + //send RCPT TO
  78 + if send_recipient(conn, param.recipient.str, sm_session, smtp_time_out, logger) is
548 { 79 {
549 - failure then get_auth_method(t, so_far),  
550 - success(s) then  
551 - with current = if insensitive_equal(s, "AUTH") then  
552 - force_Type(list_word(h,9),[])  
553 - else  
554 - [],  
555 - get_auth_method(t, current + so_far)  
556 - }  
557 - }.  
558 -  
559 -define SendMailResult  
560 - do_auth_plain  
561 - (  
562 - RWStream conn,  
563 - String login,  
564 - String password,  
565 - Bool enhanced_status,  
566 - (LogLevel, String) -> One logger  
567 - )=  
568 -  
569 - with plain_str = "AUTH PLAIN "+ to_string(base64_encode(to_byte_array("")+  
570 - constant_byte_array(1,0)+  
571 - to_byte_array(login)+  
572 - constant_byte_array(1,0)+  
573 - to_byte_array(password))),  
574 - if smtp_send_line(conn, plain_str, logger) is  
575 - {  
576 - failure then error, // already logged  
577 - success(_) then  
578 - if receive_reply(conn, logger) is  
579 - {  
580 - error then error // already logged  
581 - timeout then error,  
582 - reply(code, lines) then  
583 - if code = 235 then  
584 - ok  
585 - else  
586 - reply_handling(code,lines,enhanced_status)  
587 - }  
588 - }.  
589 -  
590 -define SendMailResult  
591 - do_auth_login  
592 - (  
593 - RWStream conn,  
594 - String login,  
595 - String password,  
596 - Bool enhanced_status,  
597 - (LogLevel, String) -> One logger  
598 - )=  
599 - if smtp_send_line(conn, "AUTH LOGIN", logger) is  
600 - {  
601 - failure then error, // already logged  
602 - success(_) then  
603 - if receive_reply(conn, logger) is  
604 - {  
605 - error then error // already logged  
606 - timeout then error,  
607 - reply(code, lines) then  
608 - if code = 334 then  
609 - if smtp_send_line(conn, to_string(base64_encode(to_byte_array(login))), logger) is  
610 - {  
611 - failure then error, // already logged  
612 - success(_) then  
613 - if receive_reply(conn, logger) is  
614 - {  
615 - error then error // already logged  
616 - timeout then error,  
617 - reply(code_login, lines_login) then  
618 - if code = 334 then  
619 - if smtp_send_line(conn, to_string(base64_encode(to_byte_array(password))), logger) is  
620 - {  
621 - failure then error, // already logged  
622 - success(_) then  
623 - if receive_reply(conn, logger) is  
624 - {  
625 - error then error // already logged  
626 - timeout then error,  
627 - reply(code_pwd, lines_pwd) then  
628 - if code = 235 then  
629 - ok  
630 - else  
631 - reply_handling(code_pwd, lines_pwd, enhanced_status)  
632 - }  
633 - }  
634 - else  
635 - reply_handling(code_login, lines_login, enhanced_status)  
636 - }  
637 - }  
638 - else  
639 - reply_handling(code, lines, enhanced_status)  
640 - }  
641 - }.  
642 -  
643 -define SendMailResult  
644 - do_auth_cram_md5  
645 - (  
646 - RWStream conn,  
647 - String login,  
648 - String password,  
649 - Bool enhanced_status,  
650 - (LogLevel, String) -> One logger  
651 - )=  
652 - if smtp_send_line(conn, "AUTH CRAM-MD5", logger) is  
653 - {  
654 - failure then error, // already logged  
655 - success(_) then  
656 - if receive_reply(conn, logger) is  
657 - {  
658 - error then error // already logged  
659 - timeout then error,  
660 - reply(code, lines) then  
661 - if code = 334 then  
662 - with challenge = if lines is [h . t] then base64_decode(h) else "",  
663 - digest = hmac_md5_compute(challenge, password),  
664 - if smtp_send_line(conn, base64_encode(login + " " + digest, false), logger) is  
665 - {  
666 - failure then error, // already logged  
667 - success(_) then  
668 - if receive_reply(conn, logger) is  
669 - {  
670 - error then error // already logged  
671 - timeout then error,  
672 - reply(code_login, lines_login) then  
673 - if code = 235 then  
674 - ok  
675 - else  
676 - reply_handling(code_login, lines_login, enhanced_status)  
677 - }  
678 - }  
679 - else  
680 - reply_handling(code, lines, enhanced_status)  
681 - }  
682 - }.  
683 -  
684 -define SendMailResult  
685 - do_login  
686 - (  
687 - RWStream conn, //tcp connection  
688 - List(String) auth_list, //list of available authentication method  
689 - String login,  
690 - String password,  
691 - Bool enhanced_status,  
692 - (LogLevel, String) -> One logger  
693 - )=  
694 - if member(auth_list, "CRAM-MD5", insensitive_equal) then  
695 - do_auth_cram_md5(conn, login, password, enhanced_status, logger)  
696 - else if member(auth_list, "PLAIN", insensitive_equal) then  
697 - do_auth_plain(conn, login, password, enhanced_status, logger)  
698 - else if member(auth_list, "LOGIN", insensitive_equal) then  
699 - do_auth_login(conn, login, password, enhanced_status, logger)  
700 -  
701 - else  
702 - logger(logError, "do_login: none of CRAM-MD5, LOGIN or PLAIN method available"); error.  
703 -  
704 -define SendMailResult  
705 - do_auth  
706 - (  
707 - RWStream conn, //tcp connection  
708 - List(String) lines, //this is the reply lines provided in response to EHLO command  
709 - Send_Auth auth, //authentication method to use for that session  
710 - Bool enhanced_status,  
711 - (LogLevel, String) -> One logger  
712 - )=  
713 - if auth is  
714 - {  
715 - none then ok, //no need to authenticate, this is a "panties festival"  
716 - login(user, password) then  
717 - with auth_list = get_auth_method(lines,[]),  
718 - if auth_list is  
719 - {  
720 - [] then logger(logError, "do_auth error");error,  
721 - [_ . _] then do_login(conn, auth_list, user, password, enhanced_status, logger) 80 + error(result) then error(result),
  81 + ok(_) then
  82 + //send DATA
  83 + if send_data(conn, sm_session, smtp_time_out, logger) is
  84 + {
  85 + error(result) then error(result),
  86 + ok(_) then
  87 + if send_content(conn, param.mail_parts, sm_session, smtp_time_out, progress_report, logger) is
  88 + {
  89 + error(result) then error(result),
  90 + ok(_) then
  91 + send_quit(conn, sm_session, smtp_time_out, logger);
  92 + logger(logTrace, "SENT Mail FROM "+param.sender.str+" TO "+param.recipient.str);
  93 + ok(unique)
  94 + }
  95 + }
722 } 96 }
723 }. 97 }.
724 98
725 - /**  
726 - * make_sm_session  
727 - */  
728 -define Send_Mail_Session  
729 - make_sm_session  
730 - (  
731 - List(String) lines, //lines given in ehlo stage  
732 - Send_Param param,  
733 - (LogLevel, String) -> One logger  
734 - )=  
735 - //looking for ENHANCEDSTATUSCODES  
736 - with session_enhanced_status = has_smtp_extension(lines, enhanced_status_codes),  
737 - //looking for SIZE  
738 - with session_size = if get_smtp_extension_value(lines, size) is  
739 - {  
740 - failure then 0,  
741 - success(str_value) then  
742 - if decimal_scan(str_value) is  
743 - {  
744 - failure then 0,  
745 - success(value) then  
746 - logger(logTrace, "smtp server with SIZE "+value);  
747 - value  
748 - }  
749 - },  
750 - send_mail_session(session_enhanced_status, session_size).  
751 99
752 Apply the whole protocol: 100 Apply the whole protocol:
753 101
@@ -755,60 +103,55 @@ define Send_Mail_Session @@ -755,60 +103,55 @@ define Send_Mail_Session
755 // to send file as mailing. For the mailing, in each mail, only the header is different of the 103 // to send file as mailing. For the mailing, in each mail, only the header is different of the
756 // other mails. The body part is the same. Then, the mailing sender can generate the header in one 104 // other mails. The body part is the same. Then, the mailing sender can generate the header in one
757 // file and keep the body in other file wich can be given to send_mail function as last file in the list 105 // file and keep the body in other file wich can be given to send_mail function as last file in the list
758 -public define SendMailResult 106 +public define Result(SmtpClientResult, One)
759 send_mail 107 send_mail
760 ( 108 (
761 RWStream conn, 109 RWStream conn,
762 Send_Param param, 110 Send_Param param,
763 - (Send_Mail_Session, Send_Param) -> Result(SendMailResult, Send_Param) prepare_mail_callback, 111 + (SmtpClientSession, Send_Param) -> Result(SmtpClientResult, Send_Param) prepare_mail_callback,
764 (Int) -> One progress_report, 112 (Int) -> One progress_report,
765 (LogLevel, String) -> One logger 113 (LogLevel, String) -> One logger
766 ) = 114 ) =
767 // 115 //
768 // Our connection to the SMTP server is opened. We just have to apply the protocol. 116 // Our connection to the SMTP server is opened. We just have to apply the protocol.
769 // 117 //
770 - if receive_reply(conn, logger) is  
771 - {  
772 - error then error,// already logged  
773 - timeout then error,  
774 - reply(code, lines) then  
775 - if code = 220 then  
776 - //send EHLO  
777 - if send_ehlo(conn, param.host_name.str, logger) is //"mail."+force_Type(get_main_domain(db), "mailfountain.net")) is  
778 - {  
779 - error then error, // already logged  
780 - timeout then error,  
781 - reply(code, lines) then  
782 - if code = 250 then  
783 - // parse all available options here, and build a smtp context  
784 - with sm_session = make_sm_session(lines, param, logger),  
785 - with auth_result = do_auth(conn, lines, param.auth, sm_session.enhanced_status, logger),  
786 - if auth_result = ok then  
787 - if prepare_mail_callback(sm_session, param) is 118 + if receive_reply(conn, false, smtp_time_out, logger) is
  119 + {
  120 + error then error(error),
  121 + timeout then error(timeout),
  122 + reply(code, status, lines) then
  123 + if code = 220 then
  124 + //send EHLO
  125 + if send_ehlo(conn, param.host_name.str, smtp_time_out, logger) is
  126 + {
  127 + error(result) then error(result),
  128 + ok(sm_session) then
  129 + if do_auth(conn, param.auth, sm_session, smtp_time_out, logger) is
788 { 130 {
789 - error(result) then result,  
790 - ok(new_param) then sm_MAIL_FROM(conn, new_param, sm_session, progress_report, logger) 131 + error(auth_result) then error(auth_result),
  132 + ok(_) then
  133 + if prepare_mail_callback(sm_session, param) is
  134 + {
  135 + error(prepare_result) then error(prepare_result),
  136 + ok(new_param) then sm_MAIL_FROM(conn, new_param, sm_session, progress_report, logger)
  137 + }
791 } 138 }
792 - else  
793 - auth_result  
794 - else  
795 - reply_handling(code,lines,true)  
796 - } 139 + }
797 else if code = 550 then 140 else if code = 550 then
798 //some server answer "550 5.7.1 Client host rejected: cannot find your reverse hostname, [88.181.64.17]" 141 //some server answer "550 5.7.1 Client host rejected: cannot find your reverse hostname, [88.181.64.17]"
799 //before anything, then we try to extract the enhanced status if exists for relaying the mail with the ISP 142 //before anything, then we try to extract the enhanced status if exists for relaying the mail with the ISP
800 logger(logDebug, "Converting a 550 error for connection to a 432 error as distant server may be temporary overloaded."); 143 logger(logDebug, "Converting a 550 error for connection to a 432 error as distant server may be temporary overloaded.");
801 - reply_handling(432,lines,true) 144 + error(reply(432, status, lines))
802 else 145 else
803 - reply_handling(code,lines,true) 146 + error(reply(code, status, lines))
804 }. 147 }.
805 148
806 -public define SendMailResult 149 +public define Result(SmtpClientResult, One)
807 send_mail 150 send_mail
808 ( 151 (
809 RWStream conn, 152 RWStream conn,
810 Send_Param param, 153 Send_Param param,
811 - (Send_Mail_Session, Send_Param) -> Result(SendMailResult, Send_Param) prepare_mail_callback, 154 + (SmtpClientSession, Send_Param) -> Result(SmtpClientResult, Send_Param) prepare_mail_callback,
812 ) = 155 ) =
813 send_mail(conn, 156 send_mail(conn,
814 param, 157 param,
@@ -818,7 +161,7 @@ public define SendMailResult @@ -818,7 +161,7 @@ public define SendMailResult
818 else log(level, send_mail_log, txt) 161 else log(level, send_mail_log, txt)
819 ). 162 ).
820 163
821 -public define SendMailResult 164 +public define Result(SmtpClientResult, One)
822 send_mail 165 send_mail
823 ( 166 (
824 RWStream conn, 167 RWStream conn,
@@ -826,10 +169,10 @@ public define SendMailResult @@ -826,10 +169,10 @@ public define SendMailResult
826 ) = 169 ) =
827 send_mail(conn, 170 send_mail(conn,
828 param, 171 param,
829 - (Send_Mail_Session sm_session, Send_Param param) |-> ok(param) 172 + (SmtpClientSession sm_session, Send_Param param) |-> ok(param)
830 ). 173 ).
831 174
832 -public define SendMailResult 175 +public define Result(SmtpClientResult, One)
833 send_mail 176 send_mail
834 ( 177 (
835 String server, 178 String server,
@@ -840,7 +183,7 @@ public define SendMailResult @@ -840,7 +183,7 @@ public define SendMailResult
840 { 183 {
841 failure then 184 failure then
842 logWarning(send_mail_log,"IP address NOT found for Mail server ["+server+"]"); 185 logWarning(send_mail_log,"IP address NOT found for Mail server ["+server+"]");
843 - error, 186 + error(error),
844 187
845 success(ip_addr) then 188 success(ip_addr) then
846 with ip_txt = ip_addr_to_string(ip_addr), 189 with ip_txt = ip_addr_to_string(ip_addr),
@@ -849,12 +192,10 @@ public define SendMailResult @@ -849,12 +192,10 @@ public define SendMailResult
849 if (Result(NetworkConnectError,RWStream))connect(ip_addr, port) is 192 if (Result(NetworkConnectError,RWStream))connect(ip_addr, port) is
850 { 193 {
851 error(e) then 194 error(e) then
852 - logTrace(send_mail_log,send_mail_mask,"send_mail: Can't connect to "+ip_txt);  
853 - error, 195 + logTrace(send_mail_log, send_mail_mask, "send_mail: Can't connect to "+ip_txt);
  196 + error(error),
854 197
855 ok(server_conn) then 198 ok(server_conn) then
856 - //  
857 - //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) ))),  
858 send_mail(server_conn, param), 199 send_mail(server_conn, param),
859 } 200 }
860 }. 201 }.
calexium_lib/mail/smtp_client.anubis 0 → 100644
  Show/Hide comments   View file @baaacc6
  1 +/*
  2 + * Created by PyramIDE.
  3 + * User: ricard
  4 + * Date: 10/03/2009
  5 + * Time: 18:00
  6 + *
  7 + */
  8 +
  9 +read tools/basis.anubis
  10 +read tools/connections.anubis
  11 +read tools/printable_tree.anubis
  12 +read network/tools.anubis
  13 +read system/files.anubis
  14 +read system/string.anubis
  15 +read system/data_io.anubis
  16 +read system/logger.anubis
  17 +
  18 +read lexers/enhanced_status.anubis
  19 +read smtp_server_extensions.anubis
  20 +read authentication.anubis
  21 +
  22 +define ByteArray crlf_dot_crlf = to_byte_array(implode([13,10,'.',13,10])).
  23 +
  24 +public type SmtpClientResult:
  25 + error,
  26 + timeout,
  27 + reply(Int code, String enhanced_status, List(String) lines).
  28 +
  29 +public type SmtpClientSession:
  30 + smtp_client_session(
  31 + Bool enhanced_status,
  32 + Maybe(Int) supported_size,
  33 + List(String) ehlo_answer
  34 + ).
  35 +
  36 +public type SmtpAuth:
  37 + none,
  38 + login( String login,
  39 + String password).
  40 +
  41 + /**
  42 + * make_sm_session
  43 + */
  44 +define SmtpClientSession
  45 + make_smtp_client_session
  46 + (
  47 + List(String) lines, //lines given in ehlo stage
  48 + (LogLevel, String) -> One logger
  49 + ) =
  50 + //looking for ENHANCEDSTATUSCODES
  51 + with session_enhanced_status = has_smtp_extension(lines, enhanced_status_codes),
  52 + //looking for SIZE
  53 + with session_size = if get_smtp_extension_value(lines, size) is
  54 + {
  55 + failure then failure,
  56 + success(str_value) then
  57 + if decimal_scan(str_value) is
  58 + {
  59 + failure then failure,
  60 + success(value) then
  61 + logger(logTrace, "smtp server with SIZE "+value);
  62 + success(value)
  63 + }
  64 + },
  65 + smtp_client_session(session_enhanced_status, session_size, lines).
  66 +
  67 +
  68 +type Command_Result:
  69 + failure,
  70 + timeout,
  71 + success(String).
  72 +
  73 +define Command_Result
  74 + receive_command
  75 + (
  76 + RStream conn,
  77 + List(Word8) so_far,
  78 + Word8 previous,
  79 + Int time_out,
  80 + (LogLevel, String) -> One logger
  81 + ) =
  82 + if read_network_byte(conn, time_out) is
  83 + {
  84 + failure then logger(logTrace, "receive_command read_network_byte 0 failure");failure,
  85 + timeout then logger(logWarning, "[send_mail] receive_command timeout"); timeout,
  86 + success(c) then
  87 + if c = 10 & previous = 13 then // <LF>
  88 + with result = implode(reverse(so_far)),
  89 + logger(logTrace, "<-S-"+result);
  90 + success(result)
  91 + else
  92 + if previous = 13 then
  93 + receive_command(conn, so_far, c, time_out, logger)
  94 + else
  95 + receive_command(conn, [previous . so_far], c, time_out, logger)
  96 + }.
  97 +
  98 +define Command_Result
  99 + receive_command
  100 + (
  101 + RStream conn,
  102 + List(Word8) so_far,
  103 + Int time_out,
  104 + (LogLevel, String) -> One logger
  105 + ) =
  106 + if read_network_byte(conn, time_out) is
  107 + {
  108 + failure then logger(logTrace, "receive_command read_network_byte 0 failure"); failure,
  109 + timeout then (if time_out = 0 then unique else logger(logWarning, "[send_mail] receive_command timeout")); timeout,
  110 + success(c) then receive_command(conn,[], c, time_out, logger)
  111 + }.
  112 +
  113 +
  114 +define SmtpClientResult
  115 + reply_handling
  116 + (
  117 + Int code,
  118 + List(String) lines,
  119 + Bool enhanced_status
  120 + ) =
  121 + with result = if enhanced_status then
  122 + if extract_enhanced_status(lines) is
  123 + {
  124 + failure then "",
  125 + success(enh) then enh
  126 + }
  127 + else
  128 + "",
  129 + reply(code, result, lines).
  130 +
  131 +
  132 +define SmtpClientResult
  133 + receive_reply
  134 + (
  135 + RStream conn,
  136 + List(String) so_far,
  137 + Bool enhanced_status,
  138 + Int time_out,
  139 + (LogLevel, String) -> One logger
  140 + ) =
  141 + if receive_command(conn, [], time_out, logger) is
  142 + {
  143 + failure then logger(logError, "receive_reply: error receiving command"); error,
  144 + timeout then (if time_out > 0 then logger(logError, "receive_reply: timeout receiving command") else unique); timeout,
  145 + success(line) then
  146 + //check if we must read another line by presence of hyphen after the reply code
  147 + //220-bla bla bla
  148 + //220 end of bla bla
  149 + if length(line) =< 3 then
  150 + if decimal_scan(line) is
  151 + {
  152 + failure then logger(logError, "receive_reply: can't extract reply code from '" + line + "'"); error,
  153 + success(code) then reply_handling(code, reverse(so_far), enhanced_status)
  154 + }
  155 + else if nth(3, line) is
  156 + {
  157 + failure then logger(logError, "receive_reply: error getting 4th character from '" + line +"'"); error,
  158 + success(char) then
  159 + if char = '-' then
  160 + receive_reply(conn, [line . so_far], enhanced_status, time_out, logger)
  161 + else
  162 + //decode the code
  163 + if sub_string(line, 0, 3) is
  164 + {
  165 + failure then logger(logError, "receive_reply: error extracting reply code from '" + line+"'"); error, // should never occure
  166 + success(code_str) then
  167 + if decimal_scan(code_str) is
  168 + {
  169 + failure then logger(logError, "receive_reply: can't extract reply code from '" + code_str + "'"); error, //unreadable code
  170 + success(code) then
  171 + reply_handling(code , reverse([line . so_far]), enhanced_status)
  172 + }
  173 + }
  174 + }
  175 + }.
  176 +
  177 +public define SmtpClientResult
  178 + receive_reply
  179 + (
  180 + RWStream conn,
  181 + Bool enhanced_status,
  182 + Int timeout,
  183 + (LogLevel, String) -> One logger
  184 + ) =
  185 + receive_reply(weaken(conn), [], enhanced_status, timeout, logger).
  186 +
  187 +
  188 +define Result(SmtpClientResult, $T)
  189 + check_smtp_result
  190 + (
  191 + SmtpClientResult result,
  192 + Int expected_code,
  193 + (SmtpClientResult) -> $T get_success_value
  194 + ) =
  195 + if result is reply(code, status, lines) then
  196 + if code = expected_code then
  197 + ok(get_success_value(result))
  198 + else
  199 + error(result)
  200 + else
  201 + error(result).
  202 +
  203 + Sending a piece of text (String) from the begining.
  204 +
  205 +define Maybe(One)
  206 + smtp_send_line
  207 + (
  208 + RWStream conn,
  209 + String text,
  210 + (LogLevel, String) -> One logger
  211 + ) =
  212 + if reliable_write(tcp(conn),[text + crlf]) is
  213 + {
  214 + failure then logger(logError, "smtp_send_line: error writing '" + text + "'"); failure,
  215 + success(_) then
  216 + logger(logTrace, "-C->"+text);success(unique)
  217 + } .
  218 +
  219 +// helper
  220 +/**
  221 + * Allows to send a SMTP command very simply.
  222 + * You just need to provide the expected result code, and a function that extract data from reply.
  223 + * This function will be called only in case of success. Else, the answer is returned verbatim.
  224 + */
  225 +public define Result(SmtpClientResult, $T)
  226 + smtp_send_command
  227 + (
  228 + RWStream conn,
  229 + String command,
  230 + Int expected_code,
  231 + SmtpClientResult -> $T get_success_value,
  232 + SmtpClientSession session,
  233 + Int timeout,
  234 + (LogLevel, String) -> One logger
  235 + ) =
  236 + if smtp_send_line(conn, command, logger) is
  237 + {
  238 + failure then logger(logError, "error sending '" + command + "'"); error(error),
  239 + success(_) then check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), expected_code, get_success_value)
  240 + }.
  241 +
  242 +/**
  243 + * Allows to send a SMTP command very simply.
  244 + * You just need to provide the expected result code. No data is returned in cas of success.
  245 + * Else, the answer is returned verbatim.
  246 + */
  247 +public define Result(SmtpClientResult, One)
  248 + smtp_send_command
  249 + (
  250 + RWStream conn,
  251 + String command,
  252 + Int expected_code,
  253 + SmtpClientSession session,
  254 + Int time_out,
  255 + (LogLevel, String) -> One logger
  256 + ) =
  257 + if smtp_send_line(conn, command, logger) is
  258 + {
  259 + failure then logger(logError, "error sending '" + command + "'"); error(error),
  260 + success(_) then check_smtp_result(receive_reply(conn, session.enhanced_status, time_out, logger), expected_code, (SmtpClientResult _) |-> unique)
  261 + }.
  262 +
  263 +
  264 + // Try to send the 'HELO' command and get the reply. Return 'true' if you cannot.
  265 +
  266 +public define Result(SmtpClientResult, SmtpClientSession)
  267 + send_ehlo
  268 + (
  269 + RWStream conn,
  270 + String our_host_name,
  271 + Int time_out,
  272 + (LogLevel, String) -> One
  273 + logger
  274 + ) =
  275 + if smtp_send_line(conn,"EHLO "+our_host_name, logger) is
  276 + {
  277 + failure then logger(logError, "send_ehlo: error sending EHLO"); error(error),
  278 + success(_) then
  279 + with rep = with result = receive_reply(conn, false, time_out, logger),
  280 + if result is reply(code, status, lines) then
  281 + if code = 250 then
  282 + ok(make_smtp_client_session(lines, logger))
  283 +
  284 + //we manage the 500 error, that mean the remote server is not ESMTP
  285 + //hence we try we with HELO, the old manner RFC 821
  286 + else if code = 500 | code = 502 then
  287 + if smtp_send_line(conn,"HELO "+our_host_name, logger) is
  288 + {
  289 + failure then logger(logError, "send_ehlo: error sending HELO"); error(error),
  290 + success(_) then
  291 + with result2 = receive_reply(conn, false, time_out, logger),
  292 + if result2 is reply(code, status, lines) then
  293 + if code = 250 then ok(make_smtp_client_session(lines, logger))
  294 + else error(result2)
  295 + else
  296 + error(result2)
  297 + }
  298 + else
  299 + error(result)
  300 + else
  301 + error(result),
  302 + if rep is error(result) then
  303 + if result is reply(code, status, lines) then
  304 + if code = 550 then // some server simply refuse us because it's temporary overloaded (especially try when sending mailings)
  305 + logger(logDebug, "Converting a 550 error for EHLO to a 432 error as distant server may be temporary overloaded.");
  306 + error(reply(432, status, lines))
  307 + else
  308 + rep
  309 + else
  310 + rep
  311 + else
  312 + rep
  313 + }.
  314 +
  315 + The same one for 'MAIL FROM':
  316 +
  317 +define String
  318 + check_email_syntax
  319 + (
  320 + String email
  321 + ) =
  322 + if nth(0, email) is
  323 + {
  324 + failure then "<>",
  325 + success(b) then
  326 + if b = '<' then email
  327 + else "<" + email + ">"
  328 + }.
  329 +
  330 +
  331 +public define Result(SmtpClientResult, One)
  332 + send_mail_from
  333 + (
  334 + RWStream conn,
  335 + String sender,
  336 + SmtpClientSession session,
  337 + Int timeout,
  338 + (LogLevel, String) -> One logger
  339 + ) =
  340 + with rfc_sender = check_email_syntax(sender),
  341 + smtp_send_command(conn, "MAIL FROM:"+rfc_sender, 250, session, timeout, logger).
  342 +// if smtp_send_line(conn,"MAIL FROM:"+rfc_sender, logger) is
  343 +// {
  344 +// failure then logger(logError, "error sending 'MAIL FROM:" + rfc_sender + "'"); error(error),
  345 +// success(_) then check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), 250, unique)
  346 +// }.
  347 +
  348 + The same one for 'RCPT TO':
  349 +
  350 +public define Result(SmtpClientResult, One)
  351 + send_recipient
  352 + (
  353 + RWStream conn,
  354 + String recipient,
  355 + SmtpClientSession session,
  356 + Int timeout,
  357 + (LogLevel, String) -> One logger
  358 + ) =
  359 + with rfc_recipient = check_email_syntax(recipient),
  360 + smtp_send_command(conn, "RCPT TO:"+rfc_recipient, 250, session, timeout, logger).
  361 +// if smtp_send_line(conn,"RCPT TO:"+rfc_recipient, logger) is
  362 +// {
  363 +// failure then logger(logError, "error sending 'RCPT TO:"+rfc_recipient+"'"); error,
  364 +// success(_) then check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), 250, unique)
  365 +// }.
  366 +
  367 + Try to send 'DATA' and get the reply. Answer 'true' if you cannot.
  368 +
  369 +public define Result(SmtpClientResult, One)
  370 + send_data
  371 + (
  372 + RWStream conn,
  373 + SmtpClientSession session,
  374 + Int timeout,
  375 + (LogLevel, String) -> One logger
  376 + ) =
  377 + smtp_send_command(conn, "DATA", 354, session, timeout, logger).
  378 +// if smtp_send_line(conn,"DATA", logger) is
  379 +// {
  380 +// failure then logger(logError, "error sending DATA"); error,
  381 +// success(_) then check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), 250, unique)
  382 +// }.
  383 +
  384 +
  385 +
  386 +
  387 + The same for the content of the message. We need base64 encoding.
  388 +
  389 +read tools/base64.anubis
  390 +type SendContentResult:
  391 + smtp_reply(SmtpClientResult),
  392 + copy_error(Int written),
  393 + copy_ok(Int written).
  394 +
  395 +define Maybe(One)
  396 + sm_flush
  397 + (
  398 + ByteArray buffer,
  399 + WStream target,
  400 + Int buffer_start_time,
  401 + (LogLevel, String) -> One logger
  402 + )=
  403 + if write( target , buffer) is
  404 + {
  405 + failure then failure,
  406 + success(nb_write) then
  407 + if now - buffer_start_time > 3600 then
  408 + // security to avoid queue blocking
  409 + logger(logError, "sm_flush: TIMEOUT sending a 64kb buffer (taking more than 1 hour). SendMail canceled.");
  410 + failure
  411 + else
  412 + with buffer_size = length(buffer),
  413 + if nb_write = buffer_size then
  414 + success(unique)
  415 + else
  416 + with new_buffer = extract(buffer, nb_write, buffer_size),
  417 + sm_flush(new_buffer, target, buffer_start_time, logger)
  418 + }.
  419 +
  420 +define SendContentResult
  421 + sm_copy_Data_IO_to_Stream
  422 + (
  423 + Data_IO source,
  424 + RWStream target,
  425 + SmtpClientSession session,
  426 + Int start_time,
  427 + Int so_far,
  428 + (Int) -> One progress_report,
  429 + (LogLevel, String) -> One logger
  430 + ) =
  431 + if receive_reply(weaken(target), [], session.enhanced_status, 0, logger) is
  432 + {
  433 + error then copy_error(so_far),
  434 + timeout then
  435 + if read_bytes(source, 65536) is
  436 + {
  437 + failure then logger(logError, "send_content: failed to read input data_io"); copy_error(so_far),
  438 + time_out then logger(logError, "send_content: timeout reading input data_io"); copy_error(so_far),
  439 + success(buffer) then
  440 + if sm_flush( buffer, weaken(target), now, logger ) is
  441 + {
  442 + failure then copy_error(so_far),
  443 + success(_) then
  444 + progress_report(so_far + 65536);
  445 + sm_copy_Data_IO_to_Stream(source, target, session, start_time, so_far + 65536, progress_report, logger)
  446 + },
  447 +
  448 + truncated(buffer) then
  449 + with len = length(buffer),
  450 + if len = 0 then
  451 + copy_ok(so_far)
  452 + else
  453 + if sm_flush( buffer, weaken(target), now, logger ) is
  454 + {
  455 + failure then copy_error(so_far),
  456 + success(_) then
  457 + progress_report(so_far + len);
  458 + copy_ok(so_far + len)
  459 + }
  460 + },
  461 + reply(code, status, lines) then
  462 + smtp_reply(reply(code, status, lines))
  463 + }.
  464 +
  465 +define SendContentResult
  466 + sm_copy_Data_IO_List_to_Stream
  467 + (
  468 + List(Data_IO) io_list,
  469 + RWStream target,
  470 + SmtpClientSession session,
  471 + Int start_time,
  472 + Int so_far,
  473 + (Int) -> One progress_report,
  474 + (LogLevel, String) -> One logger
  475 + )=
  476 + if io_list is
  477 + {
  478 + [] then copy_ok(so_far),
  479 + [ h . t ] then
  480 + if rewind(h)(unique) then
  481 + with result = sm_copy_Data_IO_to_Stream(h, target, session, start_time, 0, progress_report, logger),
  482 + if result is copy_ok(written) then
  483 + sm_copy_Data_IO_List_to_Stream(t, target, session, start_time, so_far + written, progress_report, logger)
  484 + else
  485 + result
  486 + else
  487 + copy_error(so_far)
  488 + }.
  489 +
  490 +public define Result(SmtpClientResult, One)
  491 + send_content
  492 + (
  493 + RWStream conn,
  494 + List(Data_IO) mail_part,
  495 + SmtpClientSession session,
  496 + Int timeout,
  497 + (Int) -> One progress_report,
  498 + (LogLevel, String) -> One logger
  499 + ) =
  500 + with start_time = now,
  501 + if sm_copy_Data_IO_List_to_Stream(mail_part, conn, session, now, 0, progress_report, logger) is
  502 + {
  503 + smtp_reply(reply) then error(reply)
  504 + copy_error(written) then
  505 + with finish_time = now,
  506 + logger(logError, "send_content: error sending data");
  507 + logger(logTrace, "send_content: "+written+" bytes sent in "+finish_time - start_time+" second(s)");
  508 + if written > 1024000 then
  509 + logger(logInfo, "send_content: may be due to over sized mail. Convert it to 452 error.");
  510 + error(reply(452, "", ["Error sending big email (more than 1 Mb)"]))
  511 + else
  512 + error(error),
  513 + copy_ok(size) then
  514 + if reliable_write(tcp(conn), [crlf_dot_crlf]) is
  515 + {
  516 + failure then logger(logError, "send_content: error writing CRLF.CRLF"); error(error),
  517 + success(_) then
  518 + with finish_time = (Int)now,
  519 + logger(logTrace, "mail sent "+size+" bytes in "+finish_time - start_time+" second(s)");
  520 + check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), 250, (SmtpClientResult _) |-> unique)
  521 + }
  522 + }.
  523 +
  524 +
  525 + Almost the same for 'QUIT':
  526 +
  527 +public define One
  528 + send_quit
  529 + (
  530 + RWStream conn,
  531 + SmtpClientSession session,
  532 + Int timeout,
  533 + (LogLevel, String) -> One logger
  534 + ) =
  535 + forget(smtp_send_command(conn, "QUIT", 221, session, timeout, logger)).
  536 +
  537 +// if smtp_send_line(conn,"QUIT", logger) is
  538 +// {
  539 +// failure then logger(logWarning, "error sending QUIT"),
  540 +// success(_) then forget(receive_reply(conn, session.enhanced_status, timeout, logger))
  541 +// }.
  542 +
  543 +define List(String)
  544 + get_auth_method
  545 + (
  546 + List(String) lines,
  547 + List(String) so_far
  548 + )=
  549 + if lines is
  550 + {
  551 + [] then so_far,
  552 + [h . t] then
  553 + if sub_string(h, 4, 4) is
  554 + {
  555 + failure then get_auth_method(t, so_far),
  556 + success(s) then
  557 + with current = if insensitive_equal(s, "AUTH") then
  558 + force_Type(list_word(h,9),[])
  559 + else
  560 + [],
  561 + get_auth_method(t, current + so_far)
  562 + }
  563 + }.
  564 +
  565 +public define Result(SmtpClientResult, One)
  566 + do_auth_plain
  567 + (
  568 + RWStream conn,
  569 + String login,
  570 + String password,
  571 + SmtpClientSession session,
  572 + Int timeout,
  573 + (LogLevel, String) -> One logger
  574 + )=
  575 +
  576 + with plain_str = "AUTH PLAIN "+ to_string(base64_encode(to_byte_array("")
  577 + + constant_byte_array(1,0)
  578 + + to_byte_array(login)
  579 + + constant_byte_array(1,0)
  580 + + to_byte_array(password),
  581 + false)),
  582 + smtp_send_command(conn, plain_str, 235, session, timeout, logger).
  583 +// if smtp_send_line(conn, plain_str, logger) is
  584 +// {
  585 +// failure then error,
  586 +// success(_) then check_smtp_result(receive_reply(conn, session.enhanced_status, timeout, logger), 235, unique)
  587 +//// {
  588 +//// error then error
  589 +//// timeout then timeout,
  590 +//// reply(code, status, lines) then
  591 +//// if code = 235 then
  592 +//// ok(235, lines)
  593 +//// else
  594 +//// reply_handling(code,lines,enhanced_status),
  595 +//// ok(code, lines) then ok(code, lines)
  596 +//// }
  597 +// }.
  598 +
  599 +public define Result(SmtpClientResult, One)
  600 + do_auth_login
  601 + (
  602 + RWStream conn,
  603 + String login,
  604 + String password,
  605 + SmtpClientSession session,
  606 + Int timeout,
  607 + (LogLevel, String) -> One logger
  608 + )=
  609 + if smtp_send_command(conn, "AUTH LOGIN", 334, session, timeout, logger) is
  610 + {
  611 + error(result) then error(result),
  612 + ok(_) then
  613 + if smtp_send_command(conn, base64_encode(login, false), 334, session, timeout, logger) is
  614 + {
  615 + error(result) then error(result),
  616 + ok(_) then
  617 + smtp_send_command(conn, base64_encode(password, false), 235, session, timeout, logger)
  618 + }
  619 + }.
  620 +
  621 +public define Result(SmtpClientResult, One)
  622 + do_auth_cram_md5
  623 + (
  624 + RWStream conn,
  625 + String login,
  626 + String password,
  627 + SmtpClientSession session,
  628 + Int timeout,
  629 + (LogLevel, String) -> One logger
  630 + )=
  631 + with get_challenge = (SmtpClientResult result) |->
  632 + if result is
  633 + {
  634 + error then "",
  635 + timeout then "",
  636 + reply(code, status, lines) then
  637 + if lines is [h . _] then
  638 + if split(h, ' ') is [_ . t] then
  639 + if t is [challenge . _] then
  640 + //println("challenge : " + challenge);
  641 + base64_decode(challenge)
  642 + else ""
  643 + else ""
  644 + else "",
  645 + },
  646 + if smtp_send_command(conn, "AUTH CRAM-MD5", 334, get_challenge, session, timeout, logger) is
  647 + {
  648 + error(result) then error(result),
  649 + ok(challenge) then
  650 + with digest = hmac_md5_compute(challenge, password),
  651 +// println("challenge: " + challenge);
  652 +// println("decoded : " + login + " " + digest);
  653 + smtp_send_command(conn, base64_encode(login + " " + digest, false), 334, session, timeout, logger)
  654 + }.
  655 +
  656 +public define Result(SmtpClientResult, One)
  657 + do_login
  658 + (
  659 + RWStream conn, //tcp connection
  660 + List(String) auth_list, //list of available authentication method
  661 + String login,
  662 + String password,
  663 + SmtpClientSession session,
  664 + Int timeout,
  665 + (LogLevel, String) -> One logger
  666 + )=
  667 + if member(auth_list, "CRAM-MD5", insensitive_equal) then
  668 + do_auth_cram_md5(conn, login, password, session, timeout, logger)
  669 + else if member(auth_list, "PLAIN", insensitive_equal) then
  670 + do_auth_plain(conn, login, password, session, timeout, logger)
  671 + else if member(auth_list, "LOGIN", insensitive_equal) then
  672 + do_auth_login(conn, login, password, session, timeout, logger)
  673 +
  674 + else
  675 + logger(logError, "do_login: none of CRAM-MD5, LOGIN or PLAIN method available"); error(error).
  676 +
  677 +public define Result(SmtpClientResult, One)
  678 + do_auth
  679 + (
  680 + RWStream conn, //tcp connection
  681 + SmtpAuth auth, //authentication method to use for that session
  682 + SmtpClientSession session,
  683 + Int timeout,
  684 + (LogLevel, String) -> One logger
  685 + )=
  686 + if auth is
  687 + {
  688 + none then ok(unique), //no need to authenticate, this is a "panties festival"
  689 + login(user, password) then
  690 + with auth_list = get_auth_method(session.ehlo_answer, []),
  691 + if auth_list is
  692 + {
  693 + [] then logger(logError, "do_auth error"); error(error),
  694 + [_ . _] then do_login(conn, auth_list, user, password, session, timeout, logger)
  695 + }
  696 + }.
  697 +