Commit 3db9f7fe3f2fcff5c7d1ccb89c2a1c03b5a49701

Authored by totoro
1 parent 8d5565b8

add generic send_mail to calexium lib. This is based on MailFountain source code

mail/compose_email.anubis 0 → 100644
  1 +/*
  2 + * Created by PyramIDE.
  3 + * User: フランスのトトロ aka (David RENÉ)
  4 + * Date: 12/07/2017
  5 + * Time: 01:28
  6 + * © Calexium
  7 + */
  8 +
  9 +read cipher/base64.anubis
  10 +read tools/basis.anubis
  11 +read tools/findstring.anubis
  12 +read tools/streams.anubis
  13 +read system/string.anubis
  14 +read system/logger.anubis
  15 +read system/data_io.anubis
  16 +read web/mime.anubis
  17 +read calexium_lib/net_services_protocols/logger_service.anubis
  18 +read calexium_lib/mail/decode_mail.anubis
  19 +read calexium_lib/mail/encode_mail.anubis
  20 +read calexium_lib/mail/lexers/fqa.anubis
  21 +
  22 +
  23 +public type Mail_Structure:
  24 + mail_header_content(String header, String content).
  25 +
  26 +public define Mail_Structure
  27 + no_data_mail =
  28 + mail_header_content("","").
  29 +
  30 +public type Email_Address:
  31 + email_address(Maybe(String) name, String address).
  32 +
  33 +public type File_Attached :
  34 + attached_file(String filename, RStream filestream).
  35 +
  36 +public type Email_to_send :
  37 + data_to_send(
  38 + Email_Address from,
  39 + List(Email_Address) to,
  40 + Maybe(List(Email_Address)) cc,
  41 + Maybe(List(Email_Address)) bcc,
  42 + Maybe(String) subject,
  43 + String content,
  44 + List(File_Attached) files,
  45 + Bool send_copy, //send copy to sender by bcc (useful when the email is sent by an automat)
  46 +// String from,
  47 + Maybe(String) reply_to
  48 + ).
  49 +
  50 +define Bool
  51 + is_element
  52 + (
  53 + String element,
  54 + List(String) list
  55 + )=
  56 + if list is
  57 + {
  58 + [] then false,
  59 + [h . t] then
  60 + if h = element then
  61 + true
  62 + else
  63 + is_element(element, t)
  64 + }.
  65 +
  66 +define Maybe(List($T2))
  67 + _do_to_list
  68 + (
  69 + List($T1) list,
  70 + $T1 -> Maybe($T2) to_do,
  71 + List($T2) new_list
  72 + )=
  73 + if list is
  74 + {
  75 + [] then success(new_list),
  76 + [h . t] then
  77 + with is_done = to_do(h),
  78 + if is_done is
  79 + {
  80 + failure then failure,
  81 + success(done) then
  82 + _do_to_list(t, to_do, [done . new_list])
  83 + }
  84 + }.
  85 +
  86 +public define Maybe(List($T2))
  87 + do_to_list
  88 + (
  89 + List($T1) list,
  90 + $T1 -> Maybe($T2) to_do,
  91 + )=
  92 + with result = _do_to_list(list, to_do, []),
  93 + if result is
  94 + {
  95 + failure then failure,
  96 + success(new_list) then success(reverse(new_list))
  97 + }.
  98 +
  99 +
  100 +define Maybe($T)
  101 + last_element
  102 + (
  103 + List($T) list
  104 + )=
  105 + if list is
  106 + {
  107 + [] then failure,
  108 + [h . t] then
  109 + if t is
  110 + {
  111 + [] then success(h),
  112 + [h1 . t1] then last_element(t)
  113 + }
  114 + }.
  115 +
  116 +define Maybe(String)
  117 + day_name
  118 + (
  119 + Int day_num
  120 + )=
  121 + if day_num = 1 then success("Mon")
  122 + else if day_num = 2 then success("Tue")
  123 + else if day_num = 3 then success("Wed")
  124 + else if day_num = 4 then success("Thu")
  125 + else if day_num = 5 then success("Fri")
  126 + else if day_num = 6 then success("Sat")
  127 + else if day_num = 7 then success("Sun")
  128 + else failure
  129 + .
  130 +
  131 +define Maybe(String)
  132 + month_name
  133 + (
  134 + Int month_num
  135 + )=
  136 + if month_num = 1 then success("Jan")
  137 + else if month_num = 2 then success("Feb")
  138 + else if month_num = 3 then success("Mar")
  139 + else if month_num = 4 then success("Apr")
  140 + else if month_num = 5 then success("May")
  141 + else if month_num = 6 then success("Jun")
  142 + else if month_num = 7 then success("Jul")
  143 + else if month_num = 8 then success("Aug")
  144 + else if month_num = 9 then success("Sep")
  145 + else if month_num = 10 then success("Oct")
  146 + else if month_num = 11 then success("Nov")
  147 + else if month_num = 12 then success("Dec")
  148 + else failure
  149 + .
  150 +
  151 +public define String
  152 + address_to_string
  153 + (
  154 + Email_Address mail
  155 + )=
  156 + with string_name =
  157 + if mail.name is
  158 + {
  159 + failure then "",
  160 + success(add_name) then to_MIME_text("UTF-8", add_name) + " "
  161 + },
  162 + string_name + "<" + mail.address + ">".
  163 +
  164 +define String
  165 + get_mime_of_extensions
  166 + (
  167 + String ext,
  168 + List(MIME) mime_list
  169 + )=
  170 + if mime_list is
  171 + {
  172 + [] then "application/octet-stream",
  173 + [h . t] then
  174 + if h is mime(_,_, exts) then
  175 + if is_element(ext, exts) then
  176 + to_String(h)
  177 + else
  178 + get_mime_of_extensions(ext, t)
  179 + }.
  180 +
  181 +define String
  182 + get_mime
  183 + (
  184 + String filename
  185 + )=
  186 + if last_element(split_by_token(filename, '.')) is
  187 + {
  188 + failure then "application/octet-stream",
  189 + success(ext)then get_mime_of_extensions("." + ext, known_mime_types)
  190 + }.
  191 +
  192 +
  193 +define String
  194 + limit_line_length
  195 + (
  196 + String source,
  197 + Int limit,
  198 + String so_far
  199 + ) =
  200 + with l = length(source),
  201 + if l > limit then
  202 + if sub_string(source, 0, limit) is
  203 + {
  204 + failure then so_far, // impossible
  205 + success(s) then
  206 + if sub_string(source, limit, l - limit) is
  207 + {
  208 + failure then so_far + s, // impossible
  209 + success(new_source) then
  210 + limit_line_length(new_source, limit, so_far + s + crlf)
  211 + }
  212 + }
  213 + else
  214 + so_far + source.
  215 +
  216 +public define String
  217 + limit_line_length
  218 + (
  219 + String source,
  220 + Int limit
  221 + ) =
  222 + limit_line_length(source, limit, "").
  223 +
  224 +public define String
  225 + data_file_multipart
  226 + (
  227 + String filename,
  228 + ByteArray data,
  229 + ) =
  230 + with data_file = limit_line_length(fast_base64_encode(data, false), 76),
  231 + "Content-Type: " + get_mime(filename) + ";" + crlf +
  232 + " name=\"" + filename + "\"" + crlf +
  233 + //"Content-ID :" + crlf +
  234 + "Content-Transfer-Encoding: base64" + crlf +
  235 + "Content-Disposition: attachment;" + crlf +
  236 + " filename=\"" + filename + "\"" + crlf +
  237 + crlf +
  238 + data_file + crlf
  239 + .
  240 +
  241 +define String
  242 + data_file_multipart
  243 + (
  244 + File_Attached file,
  245 + )=
  246 + with data_file = if reliable_read(file.filestream, file_size(file.filestream), 100) is
  247 + {
  248 + failure then constant_byte_array(0,0),
  249 + success(data) then data
  250 + },
  251 + data_file_multipart(file.filename, data_file).
  252 +
  253 +define String
  254 + data_files_multipart
  255 + (
  256 + List(File_Attached) files,
  257 + String boundary
  258 + )=
  259 + if files is
  260 + {
  261 + [] then "",
  262 + [file_j . t] then
  263 + "--" + boundary + crlf +
  264 + data_file_multipart(file_j) + data_files_multipart(t, boundary)
  265 + }.
  266 +
  267 +
  268 +public define String
  269 + str_utime_send_mail
  270 + (
  271 + UTime t
  272 + ) =
  273 + with date_send = convert_time(t.seconds),
  274 + if day_name(date_send.week_day) is
  275 + {
  276 + failure then "",
  277 + success(the_day_name) then the_day_name + ", "
  278 + }+
  279 + date_send.day + " " +
  280 + if month_name(date_send.month) is
  281 + {
  282 + failure then to_decimal(date_send.month),
  283 + success(the_month_name) then the_month_name
  284 + }+ " " +
  285 + date_send.year + " " +
  286 + zero_pad_n(2, date_send.hour) + ":" + zero_pad_n(2, date_send.minute) + ":" + zero_pad_n(2, date_send.second)
  287 + //+ " +0000"
  288 + .
  289 +
  290 +public define String
  291 + get_rfc822_date_format
  292 + =
  293 + str_utime_send_mail(unow).
  294 +
  295 + if capture_shell_command("date", ["-R"]) is
  296 + {
  297 + failure then str_utime_send_mail(unow),
  298 + success(s) then
  299 + if split_lines(s) is [h . t] then h else str_utime_send_mail(unow)
  300 + }.
  301 +
  302 +define Int
  303 + _next_ws_pos
  304 + (
  305 + List(Word8) line,
  306 + Int pos
  307 + ) =
  308 + if line is
  309 + {
  310 + [] then pos,
  311 + [h . t] then
  312 + if h = 32 | h = 9 then pos
  313 + else _next_ws_pos(t, pos + 1)
  314 + }.
  315 +
  316 +define String
  317 + encode_plain_text_content
  318 + (
  319 + List(String) lines,
  320 + List(String) output,
  321 + ) =
  322 + if lines is
  323 + {
  324 + [] then join(crlf, reverse(output)),
  325 + [line . t] then
  326 + with l = length(line),
  327 + pos = 75 - _next_ws_pos(reverse(explode(force(sub_string(line, 0, 75), line))), 1),
  328 + if l > 76 then
  329 + if sub_string(line, 0, pos) is
  330 + {
  331 + failure then
  332 + (if pos < 0 then unique else println("sub_string 1 failure into encode_plain_text_content()"));
  333 + encode_plain_text_content(t, [line . output]),
  334 + success(l1) then
  335 + if sub_string(line, pos + 1, l - pos - 1) is
  336 + {
  337 + failure then
  338 + println("sub_string 2 failure into encode_plain_text_content()");
  339 + encode_plain_text_content(t, [line . output]),
  340 + success(l2) then
  341 + encode_plain_text_content([l2 . t], [l1 + " " . output])
  342 + }
  343 + }
  344 + else
  345 + encode_plain_text_content(t, [line . output])
  346 + }.
  347 +
  348 +
  349 +public define String
  350 + encode_content
  351 + (
  352 + String content,
  353 + Bool is_html,
  354 + ) =
  355 + if is_html then
  356 + join(crlf, split_lines(content)) + crlf
  357 + else
  358 + encode_plain_text_content(split_lines(content), []) + crlf.
  359 +
  360 +
  361 +public define String
  362 + compose_mail
  363 + (
  364 + Email_to_send send
  365 + ) =
  366 + //with header_to_name = "To: ",
  367 + if send is data_to_send(from, to, cc, bcc, subject, content, files, send_copy, reply_to) then
  368 + with send_date = get_rfc822_date_format,
  369 + text_type = if find("<html",content,0) is
  370 + {
  371 + failure then "plain",
  372 + success(_) then "html"
  373 + },
  374 + data_text = "Content-Type: text/" + text_type + "; charset=UTF-8" + crlf +
  375 + "Content-Transfer-Encoding: 8bit" + crlf +
  376 + crlf +
  377 + encode_content(content, text_type = "html"),
  378 + is_multipart = if files is
  379 + {
  380 + [] then false,
  381 + [h . t] then true
  382 + },
  383 +
  384 + "Message-ID: " + to_ascii(sha1((from, send_date))) + crlf +
  385 + "Date: " + send_date + crlf +
  386 + // "From: " + user.login + "<" + user.login + "@" + domain + ">" + crlf +
  387 + "User-Agent: Calexium lib email sender" + crlf +
  388 + "From: " + "<" + from.address + ">" + crlf +
  389 + if reply_to is
  390 + {
  391 + failure then "",
  392 + success(reply_t) then "Reply-To: <" + reply_t +">" + crlf
  393 + }+
  394 + "MIME-Version: 1.0" + crlf +
  395 + //header_to_name + folding(to, 68 - length(header_to_name)) + crlf +
  396 + "To: " + folding(to, address_to_string) + crlf +
  397 + if cc is
  398 + {
  399 + failure then "",
  400 + success(cc_list) then
  401 + // with header_cc_name = "Cc: ",
  402 + // header_cc_name + folding(cc_list, 68 - length(header_cc_name)) + crlf
  403 + if cc_list is [] then ""
  404 + else "Cc: " + folding(cc_list, address_to_string) + crlf
  405 + } +
  406 + if subject is
  407 + {
  408 + failure then "",
  409 + success(subj) then
  410 + "Subject: " + to_folded_base64_text("UTF-8", subj) + crlf
  411 + } +
  412 + if is_multipart then
  413 + with boundary = to_ascii(sha1((from, send_date))),
  414 + "Content-Type: multipart/mixed;" + crlf +
  415 + " boundary=\"" + boundary + "\"" + crlf +
  416 + crlf +
  417 + "This is a multi-part message in MIME format." + crlf +
  418 + "--" + boundary + crlf +
  419 + data_text + crlf +
  420 +
  421 + data_files_multipart(files, boundary) +
  422 +
  423 + "--" + boundary + "--"
  424 + else
  425 + data_text
  426 + .
  427 +
  428 +
  429 +define String
  430 + message_header
  431 + (
  432 + Data_IO d_io
  433 + ) =
  434 + if (Maybe(String))read_line(d_io) is
  435 + {
  436 + failure then "",
  437 + success(line) then
  438 + if length(line) = 0 then
  439 + ""
  440 + else
  441 + line + message_header(d_io)
  442 + }.
  443 +
  444 +public define String
  445 + get_message_header
  446 + (
  447 + String file_name
  448 + )=
  449 + //open the message file from the drive
  450 + if (Maybe(RStream))file(file_name, read) is
  451 + {
  452 + failure then println("get_message_header: can't open mail ["+file_name+"] from disk."); "", //logError(debug_log, "get_message_header: can't open mail ["+file_name+"] from disk."); "",
  453 + success(source) then message_header(make_data_io(source))
  454 + }.
  455 +
  456 +
  457 +public define String
  458 + get_message_header
  459 + (
  460 + List(Data_IO) mail_parts
  461 + )=
  462 + //open the message file from the drive
  463 + if rewind(mail_parts) then
  464 + "get_message_header NOT YET Implemented. Please report that error to Calexium"
  465 + else
  466 + "".
  467 +
  468 + public define Mail_Structure
  469 + separate_data_mail
  470 + (
  471 + String mail
  472 + )=
  473 + if find(crlfcrlf, mail, 0) is
  474 + {
  475 + failure then mail_header_content("", mail),
  476 + success(position) then mail_header_content(
  477 + if sub_string(mmake_directoriesail, 0, position) is
  478 + {
  479 + failure then "",
  480 + success(substring) then substring
  481 + },
  482 + if sub_string(mail, position + 4 , length(mail) - (position + 4)) is
  483 + {
  484 + failure then mail,
  485 + success(substring) then substring
  486 + }
  487 + )
  488 +
  489 + }.
  490 +
  491 +
  492 +public define List(String)
  493 + list_of_mails
  494 + (
  495 + String string_list,
  496 + List(String) mails_list
  497 + )=
  498 + if find(",", string_list, 0) is
  499 + {
  500 + failure then [string_list . mails_list],
  501 + success(separator) then
  502 + if sub_string(string_list, 0, separator) is
  503 + {
  504 + failure then [],
  505 + success(mail) then
  506 + if sub_string(string_list, separator + 1, length(string_list) - (separator + 1)) is
  507 + {
  508 + failure then [],
  509 + success(rest) then list_of_mails(rest, [mail . mails_list])
  510 + }
  511 + }
  512 + }
  513 + .
  514 +
  515 +public define Maybe(Email_Address)
  516 + parse_address
  517 + (
  518 + String mail,
  519 + )=
  520 + if find("<", mail, 0) is
  521 + {
  522 + failure then
  523 + with result_mail = trim(mail),
  524 + if test_fqa(result_mail) then
  525 + success(email_address(failure, result_mail))
  526 + else
  527 + failure,
  528 + success(separator_b) then
  529 + if find(">", mail, separator_b + 1) is
  530 + {
  531 + failure then
  532 + failure,
  533 + success(separator_e) then
  534 + with name_string = sub_string(mail, 0, separator_b),
  535 + address_string = sub_string(mail, separator_b + 1, separator_e - separator_b - 1),
  536 + if address_string is
  537 + {
  538 + failure then failure,
  539 + success(add_str) then
  540 + with name = if name_string is
  541 + {
  542 + failure then failure,
  543 + success(name_str) then success(trim(name_str))
  544 + },
  545 + if test_fqa(add_str) then
  546 + success(email_address(name, add_str))
  547 + else
  548 + failure
  549 + }
  550 + }
  551 + }.
  552 +
  553 +
mail/decode_mail.anubis 0 → 100644
  1 +/*
  2 + * Created by PyramIDE.
  3 + * User: フランスのトトロ aka (David RENÉ)
  4 + * Date: 12/07/2017
  5 + * Time: 21:53
  6 + * © Calexium
  7 + */
  8 +
  9 +read system/string.anubis
  10 +
  11 +public define String
  12 + folding
  13 + (
  14 + List($T) mails_list,
  15 + $T -> String to_str,
  16 + )=
  17 + if mails_list is
  18 + {
  19 + [] then "",
  20 + [h . t] then
  21 + if t is
  22 + {
  23 + [] then " " + to_str(h),
  24 + [h1 . t1] then " " + to_str(h) + "," + crlf + folding(t, to_str)
  25 + }
  26 + }
  27 + .
mail/encode_mail.anubis 0 → 100644
  1 +/*
  2 + * Created by PyramIDE.
  3 + * User: フランスのトトロ aka (David RENÉ)
  4 + * Date: 12/07/2017
  5 + * Time: 22:02
  6 + * © Calexium
  7 + */
  8 +
  9 +read tools/base64.anubis
  10 +read tools/basis.anubis
  11 +read system/string.anubis
  12 +
  13 +public define String
  14 + to_folded_base64_text
  15 + (
  16 + String charset,
  17 + String text,
  18 + ) =
  19 + with l = length(text),
  20 + max_length = (Int)48,
  21 + if l > max_length then
  22 + if sub_string(text, 0, max_length) is
  23 + {
  24 + failure then "", // can't occures
  25 + success(left_text) then
  26 + with text2 = "=?"+charset+"?B?"+to_string(base64_encode(to_byte_array(left_text)))+"?=",
  27 + if sub_string(text, max_length, l - max_length) is
  28 + {
  29 + failure then "", // can't occures
  30 + success(rigth_text) then
  31 + text2 + crlf + " " + to_folded_base64_text(charset, rigth_text)
  32 + }
  33 + }
  34 + else if l > 0 then
  35 + "=?"+charset+"?B?"+to_string(base64_encode(to_byte_array(text)))+"?="
  36 + //find_and_replace(text2, implode([13,10]), implode([13,10,32]))
  37 + else
  38 + "".
mail/lexers/fqa.anubis 0 → 100644
  1 +/*
  2 + * Created by PyramIDE.
  3 + * User: フランスのトトロ aka (David RENÉ)
  4 + * Date: 12/07/2017
  5 + * Time: 22:28
  6 + * © Calexium
  7 + */
  8 +
  9 +
  10 +
  11 +
  12 + This is an example of use of 'lexer_maker'.
  13 +
  14 +read tools/basis.anubis
  15 +
  16 +
  17 + We want to test email addresses. Below is a regular expression for that
  18 + purpose. Actually, this expression is too naïve. A real one would be more complicated.
  19 +
  20 +
  21 +read tools/streams.anubis
  22 +
  23 +type LM_TokenOrError_FQA:
  24 + end_of_file,
  25 + token(List(Word8)),
  26 + error.
  27 +
  28 +type LM_LexerState_FQA: ...
  29 +
  30 +type LM_Match_FQA:
  31 + match(List(Word8) characters,
  32 + (LM_LexerState_FQA,List(Word8)) -> (LM_LexerState_FQA,LM_TokenOrError_FQA) action,
  33 + Bool aeol,
  34 + Bool abol).
  35 +
  36 +type LM_LexerState_FQA:
  37 + lexer_state(Stream input,
  38 + List(Word8) unput, // in natural order
  39 + List(Word8) more, // in reverse order
  40 + LM_LexerState_FQA -> (LM_LexerState_FQA,LM_TokenOrError_FQA) lexer,
  41 + Bool at_end_of_line,
  42 + Bool at_beginning_of_line,
  43 + Maybe(LM_Match_FQA) match).
  44 +
  45 +define LM_LexerState_FQA
  46 + lm_initial_state
  47 + (
  48 + Stream input,
  49 + LM_LexerState_FQA -> (LM_LexerState_FQA,LM_TokenOrError_FQA) lexer
  50 + ) =
  51 + lexer_state(input,[],[],lexer,false,true,failure).
  52 +
  53 +define (LM_LexerState_FQA,Word8)
  54 + lm_next_char
  55 + (
  56 + LM_LexerState_FQA 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_FQA
  97 + lm_remember_match
  98 + (
  99 + (LM_LexerState_FQA,List(Word8)) -> (LM_LexerState_FQA,LM_TokenOrError_FQA) action,
  100 + LM_LexerState_FQA 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_FQA,LM_TokenOrError_FQA)
  118 + lm_find_match
  119 + (
  120 + LM_LexerState_FQA 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_FQA
  139 + change_lexer
  140 + (
  141 + LM_LexerState_FQA ls,
  142 + LM_LexerState_FQA -> (LM_LexerState_FQA,LM_TokenOrError_FQA) 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_FQA
  148 + clear_abol
  149 + (
  150 + LM_LexerState_FQA 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_FQA,LM_TokenOrError_FQA) email_tester(LM_LexerState_FQA ls).
  159 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_1(LM_LexerState_FQA ls).
  160 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_2(LM_LexerState_FQA ls).
  161 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_3(LM_LexerState_FQA ls).
  162 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_4(LM_LexerState_FQA ls).
  163 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_5(LM_LexerState_FQA ls).
  164 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_6(LM_LexerState_FQA ls).
  165 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_7(LM_LexerState_FQA ls).
  166 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_8(LM_LexerState_FQA ls).
  167 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_9(LM_LexerState_FQA ls).
  168 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_10(LM_LexerState_FQA ls).
  169 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_11(LM_LexerState_FQA ls).
  170 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_12(LM_LexerState_FQA ls).
  171 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_state_13(LM_LexerState_FQA ls).
  172 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_action_0
  173 + (LM_LexerState_FQA ls, List(Word8) text).
  174 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_action_1
  175 + (LM_LexerState_FQA ls, List(Word8) text).
  176 +define (LM_LexerState_FQA,LM_TokenOrError_FQA) email_tester_action_2
  177 + (LM_LexerState_FQA ls, List(Word8) text).
  178 +
  179 +
  180 + Lexer states.
  181 +
  182 +
  183 +public define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  184 + email_tester
  185 + (
  186 + LM_LexerState_FQA ls,
  187 + ) =
  188 + if at_beginning_of_line(ls)
  189 + then email_tester_state_3(clear_abol(ls)) else
  190 + if lm_next_char(ls) is (ls,c) then
  191 + if c = -1 then email_tester_state_1(ls) else
  192 + if c = 45 then email_tester_state_4(ls) else
  193 + if (48 +=< c & c +=< 57) then email_tester_state_4(ls) else
  194 + if (65 +=< c & c +=< 90) then email_tester_state_4(ls) else
  195 + if c = 95 then email_tester_state_4(ls) else
  196 + if (97 +=< c & c +=< 122) then email_tester_state_4(ls) else
  197 + lm_find_match(ls).
  198 +
  199 +
  200 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  201 + email_tester_state_1
  202 + (
  203 + LM_LexerState_FQA ls,
  204 + ) =
  205 + with ls = lm_remember_match(email_tester_action_2,ls),
  206 + if lm_next_char(ls) is (ls,c) then
  207 + lm_find_match(ls).
  208 +
  209 +
  210 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  211 + email_tester_state_2
  212 + (
  213 + LM_LexerState_FQA ls,
  214 + ) =
  215 + if lm_next_char(ls) is (ls,c) then
  216 + lm_find_match(ls).
  217 +
  218 +
  219 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  220 + email_tester_state_3
  221 + (
  222 + LM_LexerState_FQA ls,
  223 + ) =
  224 + with ls = lm_remember_match(email_tester_action_1,ls),
  225 + if lm_next_char(ls) is (ls,c) then
  226 + lm_find_match(ls).
  227 +
  228 +
  229 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  230 + email_tester_state_4
  231 + (
  232 + LM_LexerState_FQA ls,
  233 + ) =
  234 + if lm_next_char(ls) is (ls,c) then
  235 + if c = 45 then email_tester_state_4(ls) else
  236 + if c = 46 then email_tester_state_5(ls) else
  237 + if (48 +=< c & c +=< 57) then email_tester_state_4(ls) else
  238 + if c = 64 then email_tester_state_7(ls) else
  239 + if (65 +=< c & c +=< 90) then email_tester_state_4(ls) else
  240 + if c = 95 then email_tester_state_4(ls) else
  241 + if (97 +=< c & c +=< 122) then email_tester_state_4(ls) else
  242 + lm_find_match(ls).
  243 +
  244 +
  245 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  246 + email_tester_state_5
  247 + (
  248 + LM_LexerState_FQA ls,
  249 + ) =
  250 + if lm_next_char(ls) is (ls,c) then
  251 + if c = 45 then email_tester_state_6(ls) else
  252 + if (48 +=< c & c +=< 57) then email_tester_state_6(ls) else
  253 + if (65 +=< c & c +=< 90) then email_tester_state_6(ls) else
  254 + if c = 95 then email_tester_state_6(ls) else
  255 + if (97 +=< c & c +=< 122) then email_tester_state_6(ls) else
  256 + lm_find_match(ls).
  257 +
  258 +
  259 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  260 + email_tester_state_6
  261 + (
  262 + LM_LexerState_FQA ls,
  263 + ) =
  264 + if lm_next_char(ls) is (ls,c) then
  265 + if c = 45 then email_tester_state_6(ls) else
  266 + if c = 46 then email_tester_state_5(ls) else
  267 + if (48 +=< c & c +=< 57) then email_tester_state_6(ls) else
  268 + if c = 64 then email_tester_state_7(ls) else
  269 + if (65 +=< c & c +=< 90) then email_tester_state_6(ls) else
  270 + if c = 95 then email_tester_state_6(ls) else
  271 + if (97 +=< c & c +=< 122) then email_tester_state_6(ls) else
  272 + lm_find_match(ls).
  273 +
  274 +
  275 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  276 + email_tester_state_7
  277 + (
  278 + LM_LexerState_FQA ls,
  279 + ) =
  280 + if lm_next_char(ls) is (ls,c) then
  281 + if c = 45 then email_tester_state_8(ls) else
  282 + if (48 +=< c & c +=< 57) then email_tester_state_8(ls) else
  283 + if (65 +=< c & c +=< 90) then email_tester_state_8(ls) else
  284 + if (97 +=< c & c +=< 122) then email_tester_state_8(ls) else
  285 + lm_find_match(ls).
  286 +
  287 +
  288 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  289 + email_tester_state_8
  290 + (
  291 + LM_LexerState_FQA ls,
  292 + ) =
  293 + if lm_next_char(ls) is (ls,c) then
  294 + if c = 45 then email_tester_state_8(ls) else
  295 + if c = 46 then email_tester_state_9(ls) else
  296 + if (48 +=< c & c +=< 57) then email_tester_state_8(ls) else
  297 + if (65 +=< c & c +=< 90) then email_tester_state_8(ls) else
  298 + if (97 +=< c & c +=< 122) then email_tester_state_8(ls) else
  299 + lm_find_match(ls).
  300 +
  301 +
  302 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  303 + email_tester_state_9
  304 + (
  305 + LM_LexerState_FQA ls,
  306 + ) =
  307 + if lm_next_char(ls) is (ls,c) then
  308 + if c = 45 then email_tester_state_10(ls) else
  309 + if (48 +=< c & c +=< 57) then email_tester_state_11(ls) else
  310 + if (65 +=< c & c +=< 90) then email_tester_state_11(ls) else
  311 + if (97 +=< c & c +=< 122) then email_tester_state_11(ls) else
  312 + lm_find_match(ls).
  313 +
  314 +
  315 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  316 + email_tester_state_10
  317 + (
  318 + LM_LexerState_FQA ls,
  319 + ) =
  320 + if lm_next_char(ls) is (ls,c) then
  321 + if c = 45 then email_tester_state_10(ls) else
  322 + if c = 46 then email_tester_state_9(ls) else
  323 + if (48 +=< c & c +=< 57) then email_tester_state_10(ls) else
  324 + if (65 +=< c & c +=< 90) then email_tester_state_10(ls) else
  325 + if (97 +=< c & c +=< 122) then email_tester_state_10(ls) else
  326 + lm_find_match(ls).
  327 +
  328 +
  329 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  330 + email_tester_state_11
  331 + (
  332 + LM_LexerState_FQA ls,
  333 + ) =
  334 + with ls = lm_remember_match(email_tester_action_0,ls),
  335 + if lm_next_char(ls) is (ls,c) then
  336 + if c = 45 then email_tester_state_10(ls) else
  337 + if c = 46 then email_tester_state_12(ls) else
  338 + if (48 +=< c & c +=< 57) then email_tester_state_11(ls) else
  339 + if (65 +=< c & c +=< 90) then email_tester_state_11(ls) else
  340 + if (97 +=< c & c +=< 122) then email_tester_state_11(ls) else
  341 + lm_find_match(ls).
  342 +
  343 +
  344 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  345 + email_tester_state_12
  346 + (
  347 + LM_LexerState_FQA ls,
  348 + ) =
  349 + if lm_next_char(ls) is (ls,c) then
  350 + if c = 45 then email_tester_state_10(ls) else
  351 + if (48 +=< c & c +=< 57) then email_tester_state_13(ls) else
  352 + if (65 +=< c & c +=< 90) then email_tester_state_13(ls) else
  353 + if (97 +=< c & c +=< 122) then email_tester_state_13(ls) else
  354 + lm_find_match(ls).
  355 +
  356 +
  357 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  358 + email_tester_state_13
  359 + (
  360 + LM_LexerState_FQA ls,
  361 + ) =
  362 + with ls = lm_remember_match(email_tester_action_0,ls),
  363 + if lm_next_char(ls) is (ls,c) then
  364 + if c = 45 then email_tester_state_10(ls) else
  365 + if c = 46 then email_tester_state_12(ls) else
  366 + if (48 +=< c & c +=< 57) then email_tester_state_13(ls) else
  367 + if (65 +=< c & c +=< 90) then email_tester_state_13(ls) else
  368 + if (97 +=< c & c +=< 122) then email_tester_state_13(ls) else
  369 + lm_find_match(ls).
  370 +
  371 +
  372 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  373 + email_tester_action_0
  374 + (
  375 + LM_LexerState_FQA ls,
  376 + List(Word8) text
  377 + ) =
  378 + (ls,token(text)).
  379 +
  380 +
  381 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  382 + email_tester_action_1
  383 + (
  384 + LM_LexerState_FQA ls,
  385 + List(Word8) text
  386 + ) =
  387 + /* default action */ email_tester(ls) .
  388 +
  389 +
  390 +define (LM_LexerState_FQA,LM_TokenOrError_FQA)
  391 + email_tester_action_2
  392 + (
  393 + LM_LexerState_FQA ls,
  394 + List(Word8) text
  395 + ) =
  396 + /* default action */ (ls,end_of_file) .
  397 +
  398 +
  399 + Since '@' is a normal character, a string needs to contain exactly one '@' for being
  400 + accepted. What is accepted before and after this '@' is described by:
  401 +
  402 + [a-zA-Z]+(\.[a-zA-Z]+)*
  403 +
  404 + The first part: [a-zA-Z]+ means ``at least one letter''. The last part: (\.[a-zA-Z]+)*
  405 + means: ``a dot followed by at least one letter, and this may be repeated any number of
  406 + times (including zero)''.
  407 +
  408 +
  409 + This part of the source file is the 'postambule' (just Anubis text, which is copied 'as
  410 + is' to the lexer_maker output file).
  411 +
  412 + The above stuff produces a function named 'email_tester' into the lexer_maker output
  413 + file. This function is used below:
  414 +
  415 +public define Bool
  416 + test_fqa
  417 + (
  418 + String account
  419 + ) =
  420 + with ls = lexer_state(make_stream(account),[],[],email_tester,true,false,failure),
  421 + if email_tester(ls) is (_,result) then if result is
  422 + {
  423 + end_of_file then false,
  424 + token(t) then
  425 + (
  426 + with result = implode(t),
  427 + if length(result) = length(account) then
  428 + //logDebug(debug_log,"["+account +"] is FQA valid");
  429 + true
  430 + else
  431 + println("["+account+"] is valid FQA but different than ["+result+"]");
  432 + false
  433 + ),
  434 + error then
  435 + //logWarning(debug_log,"["+account+"] isn't valid FQA ");
  436 + false
  437 + }.
  438 +