Commit baaacc6235d4d0ef4c9f7df25f48fc838dac563c

Authored by Cédric RICARD
1 parent b01dd67e

send_mail() refactoring

calexium_lib/mail/send_mail.anubis
... ... @@ -9,9 +9,7 @@
9 9  
10 10 read tools/basis.anubis
11 11 read tools/connections.anubis
12   -read tools/findstring.anubis
13 12 read tools/printable_tree.anubis
14   -read data_base/sqlite.anubis
15 13 read network/dns.anubis
16 14 read network/tools.anubis
17 15 read system/files.anubis
... ... @@ -24,17 +22,17 @@ read calexium_lib/net_services_protocols/logger_service.anubis
24 22 read lexers/enhanced_status.anubis
25 23 read smtp_server_extensions.anubis
26 24 read authentication.anubis
  25 +read smtp_client.anubis
27 26  
28 27 public define String send_mail_log = "SendMail".
29 28 public define LogMask send_mail_mask = logMask("send_mail").
30 29  
31 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 37 public type Str_HostName:
40 38 str_host_name(String str).
... ... @@ -48,706 +46,56 @@ public type Str_Recipient:
48 46 public type Str_UID:
49 47 str_UID(String str).
50 48  
51   -public type Send_Auth:
52   - none,
53   - login( String login,
54   - String password).
55   -
56 49 public type Send_Param:
57 50 send_param( Str_HostName host_name,
58 51 Str_Sender sender,
59 52 Str_Recipient recipient,
60 53 List(Data_IO) mail_parts,
61   - Send_Auth auth,
  54 + SmtpAuth auth,
62 55 Str_UID mail_uid,
63 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 63 sm_MAIL_FROM
485 64 (
486 65 RWStream conn,
487 66 Send_Param param,
488   - Send_Mail_Session sm_session,
  67 + SmtpClientSession sm_session,
489 68 (Int) -> One progress_report,
490 69 (LogLevel, String) -> One logger
491 70 ) =
492 71 with enhanced_status = sm_session.enhanced_status,
493 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 100 Apply the whole protocol:
753 101  
... ... @@ -755,60 +103,55 @@ define Send_Mail_Session
755 103 // to send file as mailing. For the mailing, in each mail, only the header is different of the
756 104 // other mails. The body part is the same. Then, the mailing sender can generate the header in one
757 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 107 send_mail
760 108 (
761 109 RWStream conn,
762 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 112 (Int) -> One progress_report,
765 113 (LogLevel, String) -> One logger
766 114 ) =
767 115 //
768 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 140 else if code = 550 then
798 141 //some server answer "550 5.7.1 Client host rejected: cannot find your reverse hostname, [88.181.64.17]"
799 142 //before anything, then we try to extract the enhanced status if exists for relaying the mail with the ISP
800 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 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 150 send_mail
808 151 (
809 152 RWStream conn,
810 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 156 send_mail(conn,
814 157 param,
... ... @@ -818,7 +161,7 @@ public define SendMailResult
818 161 else log(level, send_mail_log, txt)
819 162 ).
820 163  
821   -public define SendMailResult
  164 +public define Result(SmtpClientResult, One)
822 165 send_mail
823 166 (
824 167 RWStream conn,
... ... @@ -826,10 +169,10 @@ public define SendMailResult
826 169 ) =
827 170 send_mail(conn,
828 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 176 send_mail
834 177 (
835 178 String server,
... ... @@ -840,7 +183,7 @@ public define SendMailResult
840 183 {
841 184 failure then
842 185 logWarning(send_mail_log,"IP address NOT found for Mail server ["+server+"]");
843   - error,
  186 + error(error),
844 187  
845 188 success(ip_addr) then
846 189 with ip_txt = ip_addr_to_string(ip_addr),
... ... @@ -849,12 +192,10 @@ public define SendMailResult
849 192 if (Result(NetworkConnectError,RWStream))connect(ip_addr, port) is
850 193 {
851 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 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 199 send_mail(server_conn, param),
859 200 }
860 201 }.
... ...
calexium_lib/mail/smtp_client.anubis 0 → 100644
  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 +
... ...