Anubis / Xlib | GitLab

Browse Code »

Commit 90524aaa7f223f9be6524c43fe03d18a3817fc0e

Authored by Cédric RICARD 2008-12-22 23:24:07 +0000

1 parent 5b8d2d40

Added send_mail() function

Showing 3 changed files with 982 additions and 0 deletions Show diff stats

Inline Side-by-side

calexium_lib/mail/lexers/enhanced_status.anubis 0 → 100644

Wrap text Show/Hide comments View file @90524aa

	1	+/*
	2	+ *
	3	+ * User: David RENE
	4	+ * Date: 30/05/2008
	5	+ * Time: 03:30
	6	+ * (c) Calexium
	7	+ *
	8	+ */
	9	+
	10	+
	11	+
	12	+
	13	+read tools/basis.anubis
	14	+
	15	+
	16	+ We want to test email addresses. Below is a regular expression for that
	17	+ purpose. Actually, this expression is too nave. A real one would be more complicated.
	18	+
	19	+
	20	+read tools/streams.anubis
	21	+read system/string.anubis
	22	+
	23	+type LM_TokenOrError_EnhancedStatus:
	24	+ end_of_file,
	25	+ token(List(Word8)),
	26	+ error.
	27	+
	28	+type LM_LexerState_EnhancedStatus: ...
	29	+
	30	+type LM_Match_EnhancedStatus:
	31	+ match(List(Word8) characters,
	32	+ (LM_LexerState_EnhancedStatus,List(Word8)) -> (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) action,
	33	+ Bool aeol,
	34	+ Bool abol).
	35	+
	36	+type LM_LexerState_EnhancedStatus:
	37	+ lexer_state(Stream input,
	38	+ List(Word8) unput, // in natural order
	39	+ List(Word8) more, // in reverse order
	40	+ LM_LexerState_EnhancedStatus -> (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) lexer,
	41	+ Bool at_end_of_line,
	42	+ Bool at_beginning_of_line,
	43	+ Maybe(LM_Match_EnhancedStatus) match).
	44	+
	45	+define LM_LexerState_EnhancedStatus
	46	+ lm_initial_state
	47	+ (
	48	+ Stream input,
	49	+ LM_LexerState_EnhancedStatus -> (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) lexer
	50	+ ) =
	51	+ lexer_state(input,[],[],lexer,false,true,failure).
	52	+
	53	+define (LM_LexerState_EnhancedStatus,Word8)
	54	+ lm_next_char
	55	+ (
	56	+ LM_LexerState_EnhancedStatus ls
	57	+ ) =
	58	+ if ls is lexer_state(input,unput,more,lex,aeol,abol,match) then
	59	+ if unput is
	60	+ {
	61	+ [ ] then
	62	+ if read_byte(input) is
	63	+ {
	64	+ failure then
	65	+ (lexer_state(input,
	66	+ [],
	67	+ more,
	68	+ lex,
	69	+ true,
	70	+ aeol,
	71	+ match),
	72	+ -1),
	73	+
	74	+ success(c) then
	75	+ (lexer_state(input,
	76	+ [],
	77	+ [c . more],
	78	+ lex,
	79	+ c = '\n',
	80	+ aeol,
	81	+ match),
	82	+ c),
	83	+ },
	84	+
	85	+ [h . t] then
	86	+ (lexer_state(input,
	87	+ t,
	88	+ [h . more],
	89	+ lex,
	90	+ h = '\n',
	91	+ aeol,
	92	+ match),
	93	+ h)
	94	+ }.
	95	+
	96	+define LM_LexerState_EnhancedStatus
	97	+ lm_remember_match
	98	+ (
	99	+ (LM_LexerState_EnhancedStatus,List(Word8)) -> (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) action,
	100	+ LM_LexerState_EnhancedStatus ls
	101	+ ) =
	102	+ if ls is lexer_state(input,unput,more,lex,aeol,abol,m) then
	103	+ with chars = if m is
	104	+ {
	105	+ failure then [],
	106	+ success(match) then
	107	+ if match is match(chars,_,_,_) then chars
	108	+ },
	109	+ lexer_state(input,
	110	+ unput,
	111	+ [],
	112	+ lex,
	113	+ aeol,
	114	+ abol,
	115	+ success(match(append(more,chars),action,aeol,abol))).
	116	+
	117	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	118	+ lm_find_match
	119	+ (
	120	+ LM_LexerState_EnhancedStatus ls
	121	+ ) =
	122	+ if ls is lexer_state(input,unput,more,lex,_,_,mb_m) then
	123	+ if mb_m is
	124	+ {
	125	+ failure then (ls,error),
	126	+ success(m) then
	127	+ if m is match(chars,action,aeol,abol) then
	128	+ action(lexer_state(input,
	129	+ append(more,unput),
	130	+ [],
	131	+ lex,
	132	+ aeol,
	133	+ abol,
	134	+ failure),
	135	+ reverse(chars))
	136	+ }.
	137	+
	138	+define LM_LexerState_EnhancedStatus
	139	+ change_lexer
	140	+ (
	141	+ LM_LexerState_EnhancedStatus ls,
	142	+ LM_LexerState_EnhancedStatus -> (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) lex
	143	+ ) =
	144	+ if ls is lexer_state(input,unput,more,_,aeol,abol,mb_m) then
	145	+ lexer_state(input,unput,more,lex,aeol,abol,mb_m).
	146	+
	147	+define LM_LexerState_EnhancedStatus
	148	+ clear_abol
	149	+ (
	150	+ LM_LexerState_EnhancedStatus ls
	151	+ ) =
	152	+ if ls is lexer_state(input,unput,more,lex,aeol,_,mb_m) then
	153	+ lexer_state(input,unput,more,lex,aeol,false,mb_m).
	154	+
	155	+ Declarations of all lexer states.
	156	+
	157	+
	158	+public define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester(LM_LexerState_EnhancedStatus ls).
	159	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_1(LM_LexerState_EnhancedStatus ls).
	160	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_2(LM_LexerState_EnhancedStatus ls).
	161	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_3(LM_LexerState_EnhancedStatus ls).
	162	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_4(LM_LexerState_EnhancedStatus ls).
	163	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_5(LM_LexerState_EnhancedStatus ls).
	164	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_6(LM_LexerState_EnhancedStatus ls).
	165	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_7(LM_LexerState_EnhancedStatus ls).
	166	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_state_8(LM_LexerState_EnhancedStatus ls).
	167	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_action_0
	168	+ (LM_LexerState_EnhancedStatus ls, List(Word8) text).
	169	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_action_1
	170	+ (LM_LexerState_EnhancedStatus ls, List(Word8) text).
	171	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus) enhanced_status_tester_action_2
	172	+ (LM_LexerState_EnhancedStatus ls, List(Word8) text).
	173	+
	174	+
	175	+ Lexer states.
	176	+
	177	+
	178	+public define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	179	+ enhanced_status_tester
	180	+ (
	181	+ LM_LexerState_EnhancedStatus ls,
	182	+ ) =
	183	+ if at_beginning_of_line(ls)
	184	+ then enhanced_status_tester_state_3(clear_abol(ls)) else
	185	+ if lm_next_char(ls) is (ls,c) then
	186	+ if c = -1 then enhanced_status_tester_state_1(ls) else
	187	+ if c = 50 then enhanced_status_tester_state_4(ls) else
	188	+ if (52 +=< c & c +=< 53) then enhanced_status_tester_state_4(ls) else
	189	+ lm_find_match(ls).
	190	+
	191	+
	192	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	193	+ enhanced_status_tester_state_1
	194	+ (
	195	+ LM_LexerState_EnhancedStatus ls,
	196	+ ) =
	197	+ with ls = lm_remember_match(enhanced_status_tester_action_2,ls),
	198	+ if lm_next_char(ls) is (ls,c) then
	199	+ lm_find_match(ls).
	200	+
	201	+
	202	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	203	+ enhanced_status_tester_state_2
	204	+ (
	205	+ LM_LexerState_EnhancedStatus ls,
	206	+ ) =
	207	+ if lm_next_char(ls) is (ls,c) then
	208	+ lm_find_match(ls).
	209	+
	210	+
	211	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	212	+ enhanced_status_tester_state_3
	213	+ (
	214	+ LM_LexerState_EnhancedStatus ls,
	215	+ ) =
	216	+ with ls = lm_remember_match(enhanced_status_tester_action_1,ls),
	217	+ if lm_next_char(ls) is (ls,c) then
	218	+ lm_find_match(ls).
	219	+
	220	+
	221	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	222	+ enhanced_status_tester_state_4
	223	+ (
	224	+ LM_LexerState_EnhancedStatus ls,
	225	+ ) =
	226	+ if lm_next_char(ls) is (ls,c) then
	227	+ if c = 46 then enhanced_status_tester_state_5(ls) else
	228	+ if c = 50 then enhanced_status_tester_state_4(ls) else
	229	+ if (52 +=< c & c +=< 53) then enhanced_status_tester_state_4(ls) else
	230	+ lm_find_match(ls).
	231	+
	232	+
	233	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	234	+ enhanced_status_tester_state_5
	235	+ (
	236	+ LM_LexerState_EnhancedStatus ls,
	237	+ ) =
	238	+ if lm_next_char(ls) is (ls,c) then
	239	+ if c = 46 then enhanced_status_tester_state_5(ls) else
	240	+ if (48 +=< c & c +=< 57) then enhanced_status_tester_state_6(ls) else
	241	+ lm_find_match(ls).
	242	+
	243	+
	244	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	245	+ enhanced_status_tester_state_6
	246	+ (
	247	+ LM_LexerState_EnhancedStatus ls,
	248	+ ) =
	249	+ if lm_next_char(ls) is (ls,c) then
	250	+ if c = 46 then enhanced_status_tester_state_7(ls) else
	251	+ if (48 +=< c & c +=< 57) then enhanced_status_tester_state_6(ls) else
	252	+ lm_find_match(ls).
	253	+
	254	+
	255	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	256	+ enhanced_status_tester_state_7
	257	+ (
	258	+ LM_LexerState_EnhancedStatus ls,
	259	+ ) =
	260	+ if lm_next_char(ls) is (ls,c) then
	261	+ if c = 46 then enhanced_status_tester_state_7(ls) else
	262	+ if (48 +=< c & c +=< 57) then enhanced_status_tester_state_8(ls) else
	263	+ lm_find_match(ls).
	264	+
	265	+
	266	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	267	+ enhanced_status_tester_state_8
	268	+ (
	269	+ LM_LexerState_EnhancedStatus ls,
	270	+ ) =
	271	+ with ls = lm_remember_match(enhanced_status_tester_action_0,ls),
	272	+ if lm_next_char(ls) is (ls,c) then
	273	+ if (48 +=< c & c +=< 57) then enhanced_status_tester_state_8(ls) else
	274	+ lm_find_match(ls).
	275	+
	276	+
	277	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	278	+ enhanced_status_tester_action_0
	279	+ (
	280	+ LM_LexerState_EnhancedStatus ls,
	281	+ List(Word8) text
	282	+ ) =
	283	+ (ls,token(text)).
	284	+
	285	+
	286	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	287	+ enhanced_status_tester_action_1
	288	+ (
	289	+ LM_LexerState_EnhancedStatus ls,
	290	+ List(Word8) text
	291	+ ) =
	292	+ /* default action */ enhanced_status_tester(ls) .
	293	+
	294	+
	295	+define (LM_LexerState_EnhancedStatus,LM_TokenOrError_EnhancedStatus)
	296	+ enhanced_status_tester_action_2
	297	+ (
	298	+ LM_LexerState_EnhancedStatus ls,
	299	+ List(Word8) text
	300	+ ) =
	301	+ /* default action */ (ls,end_of_file) .
	302	+
	303	+
	304	+ Since '@' is a normal character, a string needs to contain exactly one '@' for being
	305	+ accepted. What is accepted before and after this '@' is described by:
	306	+
	307	+ [a-zA-Z]+(\.[a-zA-Z]+)*
	308	+
	309	+ The first part: [a-zA-Z]+ means ``at least one letter''. The last part: (\.[a-zA-Z]+)*
	310	+ means: ``a dot followed by at least one letter, and this may be repeated any number of
	311	+ times (including zero)''.
	312	+
	313	+
	314	+ This part of the source file is the 'postambule' (just Anubis text, which is copied 'as
	315	+ is' to the lexer_maker output file).
	316	+
	317	+ The above stuff produces a function named 'email_tester' into the lexer_maker output
	318	+ file. This function is used below:
	319	+
	320	+define Maybe(String)
	321	+ _extract_enhanced_status
	322	+ (
	323	+ List(String) lines
	324	+ ) =
	325	+ if lines is
	326	+ {
	327	+ [ ] then failure,
	328	+ [h . t] then
	329	+ with ls = lexer_state(make_stream(h),[],[],enhanced_status_tester,true,false,failure),
	330	+ if enhanced_status_tester(ls) is (_,result) then
	331	+ if result is
	332	+ {
	333	+ end_of_file then _extract_enhanced_status(t),
	334	+ token(tok) then success(implode(tok))
	335	+ error then _extract_enhanced_status(t)
	336	+ }
	337	+ }.
	338	+
	339	+public define Maybe(String)
	340	+ extract_enhanced_status
	341	+ (
	342	+ List(String) lines
	343	+ ) =
	344	+ if lines is
	345	+ {
	346	+ [ ] then failure,
	347	+ [h . t] then
	348	+ if _extract_enhanced_status(split_by_token(h, ' ')) is
	349	+ {
	350	+ failure then extract_enhanced_status(t),
	351	+ success(r) then success(r)
	352	+ }
	353	+ }.
	354	+
	355	+
...	...

calexium_lib/mail/send_mail.anubis 0 → 100644

Wrap text Show/Hide comments View file @90524aa

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

calexium_lib/mail/smtp_server_extensions.anubis 0 → 100644

Wrap text Show/Hide comments View file @90524aa

	1	+/*
	2	+ *
	3	+ * User: David RENE
	4	+ * Date: 30/05/2008
	5	+ * Time: 01:18
	6	+ * (c) Calexium
	7	+ *
	8	+ */
	9	+
	10	+read tools/basis.anubis
	11	+read system/string.anubis
	12	+
	13	+public type SMTP_Extension_verb:
	14	+ smtp_extension_verb
	15	+ (
	16	+ String verb
	17	+ ).
	18	+
	19	+public define SMTP_Extension_verb enhanced_status_codes = smtp_extension_verb("ENHANCEDSTATUSCODES").
	20	+public define SMTP_Extension_verb size = smtp_extension_verb("SIZE").
	21	+
	22	+define Bool
	23	+ has_smtp_extension
	24	+ (
	25	+ List(String) lines, //left lines given in ehlo stage
	26	+ Int length,
	27	+ String search_ext
	28	+ )=
	29	+ if lines is
	30	+ {
	31	+ [] then false,
	32	+ [h . t] then
	33	+ if sub_string(h, 4, length) is
	34	+ {
	35	+ failure then has_smtp_extension(t, length, search_ext),
	36	+ success(s) then
	37	+ if insensitive_equal(s, search_ext) then
	38	+ true
	39	+ else
	40	+ has_smtp_extension(t, length, search_ext),
	41	+ }
	42	+ }.
	43	+
	44	+public define Bool
	45	+ has_smtp_extension
	46	+ (
	47	+ List(String) lines, //left lines given in ehlo stage
	48	+ SMTP_Extension_verb search_ext
	49	+ )=
	50	+ has_smtp_extension(lines, length(search_ext.verb), search_ext.verb).
	51	+
	52	+define Maybe(String)
	53	+ get_smtp_extension_value
	54	+ (
	55	+ List(String) lines, //left lines given in ehlo stage
	56	+ Int len,
	57	+ String search_ext
	58	+ )=
	59	+ if lines is
	60	+ {
	61	+ [] then failure,
	62	+ [h . t] then
	63	+ if sub_string(h, 4, len) is
	64	+ {
	65	+ failure then get_smtp_extension_value(t, len, search_ext),
	66	+ success(s) then
	67	+ if insensitive_equal(s, search_ext) then
	68	+ sub_string(h, 5+len, length(h)-(5+len))
	69	+ else
	70	+ get_smtp_extension_value(t, len, search_ext),
	71	+ }
	72	+ }.
	73	+
	74	+ /**
	75	+ * return the value of wanted smtp extension name
	76	+ * for "SIZE 10000" it return 10000.
	77	+ * if the smtp verb doesn't exist, it return failure
	78	+ */
	79	+
	80	+public define Maybe(String)
	81	+ get_smtp_extension_value
	82	+ (
	83	+ List(String) lines, //left lines given in ehlo stage
	84	+ SMTP_Extension_verb search_ext
	85	+ )=
	86	+ if has_smtp_extension(lines, length(search_ext.verb), search_ext.verb) then
	87	+ get_smtp_extension_value(lines, length(search_ext.verb), search_ext.verb)
	88	+ else
	89	+ failure.
	90	+
...	...