1% -*- Erlang -*- 2% File: mail.erl (~jb/mail.erl) 3% Author: Johan Bevemyr 4% Created: Sat Oct 25 10:59:24 2003 5% Purpose: 6 7% RFC 822 8% RFC 1939 9% RFC 2048 10 11-module('mail'). 12-author('jb@trut.bluetail.com'). 13 14-export([parse_headers/1, list/2, list/3, ploop/5,pop_request/4, diff/2, 15 session_manager_init/0, check_cookie/1, check_session/1, 16 login/2, display_login/2, stat/3, showmail/2, compose/1, compose/7, 17 send/6, send/2, get_val/3, logout/1, base64_2_str/1, retr/4, 18 delete/2, send_attachment/2, send_attachment_plain/2, 19 wrap_text/2, getopt/3, decode/1]). 20-export([read_config/1]). 21 22-include("../../../include/yaws_api.hrl"). 23-include("defs.hrl"). 24 25-record(info, 26 { 27 nr, 28 size, 29 headers 30 }). 31 32-record(mail, 33 { 34 from="", 35 from_fmt="", 36 from_fmt_lc="", 37 to="", 38 cc="", 39 bcc="", 40 subject="", 41 subject_fmt="", 42 subject_fmt_lc="", 43 date="", 44 date_pst=date(), 45 date_fmt="", 46 content_type, 47 transfer_encoding, 48 content_disposition, 49 other = [] 50 }). 51 52-record(pstate, 53 { 54 port, 55 user, 56 pass, 57 cmd, 58 acc = [], 59 from, 60 lines, 61 reply=[], 62 more=true, 63 remain, 64 dotstate=0 65 }). 66 67-record(satt, { 68 num, 69 filename, 70 ctype, 71 data}). 72 73-record(session, 74 { 75 user, 76 passwd, 77 cookie, 78 listing, 79 sorting=rev_nr, 80 attachments = [] %% list of #satt{} records 81 }). 82 83-define(RETRYTIMEOUT, 300). 84-define(RETRYCOUNT, 5). 85 86%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 87 % 88build_toolbar(Entries) -> 89 {table, [{bgcolor,"c0c0c0"},{cellpadding,0},{cellspacing,0},{border,0}], 90 [{tr,[],{td, [{colspan,20},{height,1},{bgcolor,white}], 91 {img, [{src,"spacer.gif"}, {width,1},{height,1}, 92 {alt,""}, {border,0}],[]}}}, 93 {tr,[], build_toolbar(Entries, -1)}, 94 {tr,[],{td, [{colspan,20},{height,1},{bgcolor,gray}], 95 {img, [{src,"spacer.gif"}, {width,1},{height,1}, 96 {alt,""}, {border,0}],[]}}}, 97 {tr,[],{td, [{colspan,20},{height,1}], 98 {img, [{src,"spacer.gif"}, {width,1},{height,1}, 99 {alt,""}, {border,0}],[]}}}]}. 100 101build_toolbar([], Used) -> 102 Percent = integer_to_list(100-Used)++"%", 103 [{td, [nowrap,{width,Percent},{valign,middle},{align,left}],[]}]; 104build_toolbar([{[],Url,Cmd}|Rest], Used) -> 105 if Used == -1 -> 106 []; 107 true -> 108 [{td, [nowrap,{width,"1%"},{valign,middle},{align,left}], 109 {img, [{src,"tool-div.gif"},{width,2},{height,16}, 110 {alt,""},{border,0},{hspace,2}]}}] 111 end ++ 112 [{td, [nowrap,{width,"2%"},{valign,middle},{align,left}], 113 [{a, [{class,nolink}, {href,Url}], 114 {font, [{size,2},{color,"#000000"},{title,Cmd}],Cmd}}]} | 115 build_toolbar(Rest, Used+3)]; 116build_toolbar([{Gif,Url,Cmd}|Rest], Used) -> 117 (if Used == -1 -> 118 []; 119 true -> 120 [{td, [nowrap,{width,"1%"},{valign,middle},{align,left}], 121 {img, [{src,"tool-div.gif"},{width,2},{height,16}, 122 {alt,""},{border,0},{hspace,2}]}}] 123 end ++ 124 [{td, [nowrap,{width,"2%"},{valign,middle},{align,left}], 125 {a, [{class,nolink}, 126 {href,Url}], 127 [{img, [{src,Gif},{vspace,2},{width,20}, 128 {height,20},{alt,Cmd},{border,0}],[]}]} 129 130 }, 131 {td, [nowrap,{width,"2%"},{valign,middle},{align,left}], 132 [{a, [{class,nolink}, 133 {href,Url}], 134 {font, [{size,2},{color,"#000000"},{title,Cmd}], Cmd}}]} | 135 build_toolbar(Rest, Used+4)]). 136 137 138%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 139 % 140 % 141 142delete(Session, ToDelete) -> 143 tick_session(Session#session.cookie), 144 Req = [del(M) || M <- ToDelete], 145 pop_request(Req, popserver(), 146 Session#session.user, Session#session.passwd), 147 {redirect_local, {rel_path, "mail.yaws?refresh=true"}}. 148 149-record(send, {param, 150 last = false, 151 encoding, 152 estate="", 153 boundary="", 154 from="", 155 to="", 156 cc="", 157 bcc="", 158 subject="", 159 message="", 160 attached="", 161 port, 162 session, 163 line_start=true 164 }). 165 166 167send(Session, A) -> 168 State = prepare_send_state(A#arg.state, Session), 169 case yaws_api:parse_multipart_post(A) of 170 {cont, Cont, Res} -> 171 case catch sendChunk(Res, State) of 172 {done, Result} -> 173 Result; 174 {cont, NewState} -> 175 {get_more, Cont, NewState}; 176 {error, Reason} -> 177 {ehtml, 178 format_error("Failed to send email. Reason: "++ 179 to_string(Reason))} 180 end; 181 {result, Res} -> 182 case catch sendChunk(Res, State#send{last=true}) of 183 {done, Result} -> 184 Result; 185 {cont, _} -> 186 {ehtml,format_error("Failed to send email.")}; 187 {error, Reason} -> 188 {ehtml, 189 format_error("Failed to send email. Reason: "++ 190 to_string(Reason))} 191 end 192 end. 193 194 195prepare_send_state(undefined, Session) -> 196 #send{session=Session}; 197prepare_send_state(State, Session) -> 198 State#send{session=Session}. 199 200sendChunk([{part_body, Data}|Rest], State) -> 201 sendChunk([{body, Data}|Rest], State); 202 203sendChunk([], State) when State#send.last/=true -> 204 {cont, State}; 205 206sendChunk([], S0) when S0#send.last==true, 207 S0#send.boundary/=[] -> 208 if S0#send.estate /= "" -> 209 smtp_send_b64_final(S0); 210 true -> 211 ok 212 end, 213 S = S0#send{estate=""}, 214 smtp_send_part(S, ["\r\n--",S#send.boundary,"--\r\n"]), 215 smtp_close(S), 216 {done, {redirect_local, {rel_path, "mail.yaws"}}}; 217 218sendChunk([], State) when State#send.last==true, 219 State#send.boundary==[] -> 220 smtp_send_part(State, ["\r\n.\r\n"]), 221 {done, {redirect_local, {rel_path, "mail.yaws"}}}; 222 223sendChunk([{head, {"to", _Opts}}|Rest], State) -> 224 sendChunk(Rest, State#send{param=to}); 225 226sendChunk([{head, {"cc", _Opts}}|Rest], State) -> 227 sendChunk(Rest, State#send{param=cc}); 228 229sendChunk([{head, {"bcc", _Opts}}|Rest], State) -> 230 sendChunk(Rest, State#send{param=bcc}); 231 232sendChunk([{head, {"subject", _Opts}}|Rest], State) -> 233 sendChunk(Rest, State#send{param=subject}); 234 235sendChunk([{head, {"html_subject", _Opts}}|Rest], State) -> 236 sendChunk(Rest, State#send{param=ignore}); 237 238sendChunk([{head, {"message", _Opts}}|Rest], S) -> 239 RTo = parse_addr(S#send.to), 240 RCc = parse_addr(S#send.cc), 241 RBcc = parse_addr(S#send.bcc), 242 Recipients = RTo ++ RCc ++ RBcc, 243 {ok, Port} = smtp_init(smtpserver(), S#send.session, Recipients), 244 S2 = S#send{port=Port}, 245 MailDomain = maildomain(), 246 Session = S#send.session, 247 CommonHeaders = 248 [mail_header("To: ", S#send.to), 249 mail_header("From: ", Session#session.user++"@"++MailDomain), 250 mail_header("Cc: ", S#send.cc), 251 mail_header("Bcc: ", S#send.bcc), 252 mail_header("Subject: ", S#send.subject)], 253 {Headers,S3} = 254 case S#send.attached of 255 "no" -> 256 {CommonHeaders ++ 257 [mail_header("Content-Type: ", "text/plain"), 258 mail_header("Content-Transfer-Encoding: ", "8bit")], 259 S2}; 260 "yes" -> 261 Boundary="--Next_Part("++boundary_date()++")--", 262 {CommonHeaders ++ 263 [mail_header("Mime-Version: ", "1.0"), 264 mail_header("Content-Type: ", 265 "Multipart/Mixed;\r\n boundary=\""++ 266 Boundary++"\""), 267 mail_header("Content-Transfer-Encoding: ", "8bit")], 268 S2#send{boundary=Boundary}} 269 end, 270 smtp_send_part(S3, [Headers,"\r\n"]), 271 case S3#send.attached of 272 "yes" -> 273 smtp_send_part(S3, ["--",S3#send.boundary,"\r\n", 274 mail_header("Content-Type: ", 275 "Text/Plain; charset=us-ascii"), 276 mail_header("Content-Transfer-Encoding: ", 277 "8bit"), 278 "\r\n"]); 279 "no" -> 280 ok 281 end, 282 sendChunk(Rest, S3#send{param=message}); 283 284sendChunk([{head, {"attached", _Opts}}|Rest], State) -> 285 sendChunk(Rest, State#send{param=attached}); 286 287sendChunk([{head, {_File, _Opts}}|Rest], S) when S#send.attached=="no" -> 288 sendChunk(Rest, S#send{param=ignore}); 289 290sendChunk([{head, {_File, Opts}}|Rest], S0) when S0#send.attached=="yes" -> 291 % io:format("attachment head\n"), 292 if S0#send.estate /= "" -> 293 smtp_send_b64_final(S0); 294 true -> 295 ok 296 end, 297 S = S0#send{estate=""}, 298 FilePath = getopt(filename, Opts), 299 case FilePath of 300 [_|_] -> 301 FileName = basename(FilePath), 302 ContentType = content_type(FileName), 303 smtp_send_part(S, ["\r\n--",S#send.boundary,"\r\n", 304 mail_header("Content-Type: ", ContentType), 305 mail_header("Content-Transfer-Encoding: ", 306 "base64"), 307 mail_header("Content-Disposition: ", 308 "attachment; filename=\""++ 309 FileName++"\""), 310 "\r\n" 311 ]), 312 sendChunk(Rest, S#send{param=file}); 313 _ -> 314 sendChunk(Rest, S#send{param=ignore}) 315 end; 316 317sendChunk([{body, Data}|Rest], S) -> 318 case S#send.param of 319 to -> 320 sendChunk(Rest, S#send{to=S#send.to++Data}); 321 cc -> 322 sendChunk(Rest, S#send{cc=S#send.cc++Data}); 323 bcc -> 324 sendChunk(Rest, S#send{bcc=S#send.bcc++Data}); 325 subject -> 326 sendChunk(Rest, S#send{subject=S#send.subject++Data}); 327 attached -> 328 sendChunk(Rest, S#send{attached=S#send.attached++Data}); 329 message -> 330 NewS = smtp_send_part_message(S, Data), 331 sendChunk(Rest, NewS); 332 ignore -> 333 sendChunk(Rest, S); 334 file -> 335 %io:format("sending body chunk\n"), 336 NewS = smtp_send_b64(S, Data), 337 sendChunk(Rest, NewS) 338 end. 339 340send(Session, To, Cc, Bcc, Subject, Msg) -> 341 tick_session(Session#session.cookie), 342 RTo = parse_addr(To), 343 RCc = parse_addr(Cc), 344 RBcc = parse_addr(Bcc), 345 Recipients = RTo ++ RCc ++ RBcc, 346 Date = date_and_time_to_string(yaws:date_and_time()), 347 MailDomain = maildomain(), 348 Headers = 349 [mail_header("To: ", To), 350 mail_header("From: ", Session#session.user++"@"++MailDomain), 351 mail_header("Cc: ", Cc), 352 mail_header("Bcc: ", Bcc), 353 mail_header("Subject: ", Subject), 354 mail_header("Content-Type: ", "text/plain"), 355 mail_header("Content-Transfer-Encoding: ", "8bit")], 356 Message = io_lib:format("~sDate: ~s\r\n\r\n~s\r\n.\r\n", 357 [Headers, Date, Msg]), 358 case smtp_send(smtpserver(), Session, Recipients, Message) of 359 ok -> 360 {redirect_local, {rel_path,"mail.yaws"}}; 361 {error, Reason} -> 362 (dynamic_headers() ++ 363 compose(Session, Reason, To, Cc, Bcc, Subject, Msg)) 364 end. 365 366mail_header(_Key, []) -> []; 367mail_header(Key, Val) -> Key++Val++"\r\n". 368 369compose(Session) -> 370 compose(Session, "","","","","",""). 371 372compose(Session, Reason, To, Cc, Bcc, Subject, Msg) -> 373 tick_session(Session#session.cookie), 374 (dynamic_headers()++ 375 [{ehtml, 376 [{script,[{src,"mail.js"}],[]}, 377 {style, [{type,"text/css"}], 378 "A:link { color: 0;text-decoration: none}\n" 379 "A:visited { color: 0;text-decoration: none}\n" 380 "A:active { color: 0;text-decoration: none}\n" 381 "textarea { background-color: #fff; border: 1px solid 00f; }\n" 382 "DIV.tag-body { background: white; }\n"}, 383% {script, [{type,"text/javascript"}], 384% "_editor_url='/htmlarea/';\n" 385% "_editor_lagn='se';\n"}, 386% {script, [{type,"text/javascript"},{src,"/htmlarea/htmlarea.js"}],""}, 387% {script, [{type,"text/javascript"}], 388% "var editor = null;\n" 389% "function initEditor() {\n" 390% "editor = new HTMLArea('html_message');\n" 391% "editor.generate();\n" 392% "return false;\n}"}, 393% {script,[{type,"text/javascript"},{defer,"1"}], 394%% "HTMLArea.replace('html_message');\n"}, 395% "HTMLArea.replaceAll();\n"}, 396 {body,[{bgcolor,silver},{marginheight,0},{link,"#000000"}, 397 {topmargin,0},{leftmargin,0},{rightmargin,0}, 398 {marginwidth,0}, 399% {onload, "initEditor();document.compose.to.focus();"}], 400 {onload, "document.compose.to.focus();"}], 401 [{form, [{name,compose},{action,"send.yaws"},{method,post}, 402 {enctype,"multipart/form-data"} 403 ], 404 [{table, [{border,0},{bgcolor,"c0c0c0"},{cellspacing,0}, 405 {width,"100%"}], 406 {tr,[],{td,[{nowrap,true},{align,left},{valign,middle}], 407 {font, [{size,6},{color,black}], 408 "Yaws WebMail at "++maildomain()}}}}, 409 build_toolbar([{"tool-send.gif", 410 "javascript:setComposeCmd('send');","Send"}, 411 {"", "mail.yaws", "Close"}]), 412 {input,[{type,hidden},{name,attached},{value,"no"}],[]}, 413 {table, [{width,645},{border,0},{bgcolor,silver},{cellspacing,0}, 414 {cellpadding,0}], 415 if 416 Reason == [] -> []; 417 true -> 418 [ 419 {tr,[],[{td,[{colspan,2},{height,35},{align,left}, 420 {valign,top}], 421 {font,[{color,red},{size,2},nowrap], 422 ["Error: ",Reason]}}]} 423 ] 424 end ++ 425 [{tr,[],[{td,[{height,0},{align,left},{valign,top}],[]}, 426 {td,[{height,0},{align,left},{valign,top}],[]}]}, 427 {tr,[],[{td,[{height,35},{align,left},{valign,top}], 428 {font,[{color,"#000000"},{size,2},nowrap], 429 " To: "}}, 430 {td,[{height,35},{align,left},{valign,top}], 431 {input,[{name,to},{type,text},{size,66}, 432 {check,value,quote(To)}]}}]}, 433 {tr,[],[{td,[{height,0},{align,left},{valign,top}],[]}, 434 {td,[{height,0},{align,left},{valign,top}],[]}]}, 435 {tr,[],[{td,[{height,35},{align,left},{valign,top}], 436 {font,[{color,"#000000"},{size,2},nowrap], 437 " Cc: "}}, 438 {td,[{height,35},{align,left},{valign,top}], 439 {input,[{name,cc},{type,text},{size,66}, 440 {check,value,quote(Cc)}]}}]}, 441 {tr,[],[{td,[{height,0},{align,left},{valign,top}],[]}, 442 {td,[{height,0},{align,left},{valign,top}],[]}]}, 443 {tr,[],[{td,[{height,35},{align,left},{valign,top}], 444 {font,[{color,"#000000"},{size,2},nowrap], 445 " Bcc: "}}, 446 {td,[{height,35},{align,left},{valign,top}], 447 {input,[{name,bcc},{type,text},{size,66}, 448 {check,value,quote(Bcc)}]}} 449 ]}, 450 {tr,[],[{td,[{height,35},{align,left},{valign,top},nowrap], 451 {font,[{color,"#000000"},{size,2}], 452 " Subject: "}}, 453 {td,[{colspan,3},{align,left},{valign,top}], 454 {input,[{name,subject},{type,text},{size,66}, 455 {check,value,quote(Subject)}]}}]} 456 ] 457 }, 458 {input,[{type,hidden},{name,message},{value,""}],[]}, 459 {table,[{width,645},{border,0},{cellspacing,0},{cellpadding,0}], 460 {tr,[], 461 [ 462 build_tabs(["Message","Attachments"]), 463 {'div', [{id, "tab-body:0"},{style,"display: block;"}], 464 {table, [{bgcolor,silver},{border,0},{cellspacing,0}, 465 {cellpadding,0}], 466 {tr,[], 467 {td,[{align,left},{valign,top}], 468 [{textarea, [{wrap,virtual}, 469 {name,html_message}, 470 {id,html_message}, 471 {cols,80},{rows,24}], 472 Msg}, 473% {a, [{href,"javascript:alert(editor.getHTML());"}],"html"}, 474% " ", 475% {a, [{href,"javascript:document.compose.foo.innerHTML=editor.getHTML();alert(document.compose.foo.value);"}],"debug"}, 476% " ", 477% {a, [{href,"javascript:filur();"}],"debug"}, 478 "" 479 ] 480 } 481 } 482 } 483 }, 484 {'div', [{id, "tab-body:1"},{style,"display: none;"}], 485 {table, [{bgcolor,silver},{border,0},{cellspacing,0}, 486 {cellpadding,0}], 487 {tr,[], 488 {td,[{align,left},{valign,top}], 489 ["Attached files:", 490 {table,[], 491 file_attachements(10) 492 } 493 ] 494 } 495 } 496 } 497 } 498 ] 499 } 500 }, 501% {textarea, [{wrap,virtual}, 502% {name,foo}, 503% {id,foo}, 504% {cols,80},{rows,24}], 505% ""}, 506 {input,[{type,hidden},{name,cmd},{value,""}],[]} 507 ] 508 } 509 ] 510 } 511 ] 512 }]). 513 514 515file_attachements(0) -> []; 516file_attachements(N) -> 517 [file_attachement(N)|file_attachements(N-1)]. 518 519file_attachement(N) -> 520 I = integer_to_list(N), 521 {tr,[], 522 [{td,[],"File: "}, 523 {td,[], 524 {input, [{type,"file"},{name,"file"++I},{size,"30"}],[]}} 525 ] 526 }. 527 528 529build_tabs(Tabs) -> 530 [{script,[{type,"text/javascript"}], 531 ["tabCount = ",integer_to_list(length(Tabs)),";\n"]}, 532 {'div', 533 [{align,"left"}], 534 {table,[{border,"0"}, 535 {cellspacing,"0"}, 536 {cellpadding,"0"}], 537 {tr,[], 538 build_tab(Tabs,0)}}}, 539 {'div',[{align,"left"}], 540 {table,[{width,645},{border,0},{cellspacing,0},{cellpadding,0}], 541 {tr,[],{td,[{height,8},{background,"tab-hr.gif"}],[]}}}} 542 ]. 543 544build_tab([],_) -> []; 545build_tab([T|Ts], N=0) -> 546 I = integer_to_list(N), 547 [{td,[{width,6}], 548 {img,[{src,"tab-left_active.gif"}, {border,0}, {id,"tab-left:"++I}],[]}}, 549 {td,[{align,"center"}, 550 {style,"cursor: pointer; background: url(tab-bg_active.gif)"}, 551 {onClick,"changeActiveTab("++I++")"}, 552 {id,"tab-bg:"++I}], T}, 553 {td, [{width,6}], 554 {img,[{src,"tab-right_active.gif"}, {border,0}, {id,"tab-right:"++I}],[]}}| 555 build_tab(Ts,N+1)]; 556build_tab([T|Ts], N) -> 557 I = integer_to_list(N), 558 [{td,[{width,6}], 559 {img,[{src,"tab-left_inactive.gif"}, {border,0}, {id,"tab-left:"++I}],[]}}, 560 {td,[{align,"center"}, 561 {style,"cursor: pointer; background: url(tab-bg_inactive.gif)"}, 562 {onClick,"changeActiveTab("++I++")"}, 563 {id,"tab-bg:"++I}], T}, 564 {td, [{width,6}], 565 {img,[{src,"tab-right_inactive.gif"}, {border,0}, {id,"tab-right:"++I}],[]}}| 566 build_tab(Ts,N+1)]. 567 568showmail(Session, MailNr) -> 569 showmail(Session, MailNr, ?RETRYCOUNT). 570 571showmail(_Session, _MailNr, 0) -> 572 {ehtml,format_error("Mailbox locked by other mail session.")} ; 573showmail(Session, MailNr, Count) -> 574 tick_session(Session#session.cookie), 575 576 Formated = 577 case retr(popserver(), Session#session.user, 578 Session#session.passwd, MailNr) of 579 {error, Reason} -> 580 case string:str(lowercase(Reason), "lock") of 581 0 -> 582 format_error(to_string(Reason)); 583 _N -> 584 sleep(?RETRYTIMEOUT), 585 showmail(Session, MailNr, Count-1) 586 end; 587 Message -> 588 format_message(Session, Message, MailNr, "1") 589 end, 590 591 (dynamic_headers() ++ 592 [{ehtml, 593 [{script,[{src,"mail.js"}], []}, 594 {style, [{type,"text/css"}], 595 ".conts { visibility:hidden }\n" 596 "A:link { color: 0;text-decoration: none}\n" 597 "A:visited { color: 0;text-decoration: none}\n" 598 "A:active { color: 0;text-decoration: none}\n" 599 "DIV.msg-body { background: white; }\n" 600 }, 601 {body,[{bgcolor,silver},{marginheight,0},{topmargin,0},{leftmargin,0}, 602 {rightmargin,0},{marginwidth,0}], 603 [{table, [{border,0},{bgcolor,"c0c0c0"},{cellspacing,0}, 604 {width,"100%"}], 605 {tr,[],{td,[{nowrap,true},{align,left},{valign,middle}], 606 {font, [{size,6},{color,black}], 607 "WebMail at "++maildomain()}}}}] ++ 608 Formated 609 } 610 ]}]). 611 612list(Session, {Refresh,Sort}) -> 613 list_msg(Session, Refresh, Sort, ?RETRYCOUNT). 614 615list_msg(_Session, _Refresh, _Sort, 0) -> 616 {ehtml,format_error("Mailbox locked by other mail process.")}; 617list_msg(Session, Refresh, Sort, Count) -> 618 tick_session(Session#session.cookie), 619 OldList = Session#session.listing, 620 Listing = 621 if Refresh == true -> 622 list(popserver(), Session#session.user, Session#session.passwd); 623 OldList == undefined -> 624 list(popserver(), Session#session.user, Session#session.passwd); 625 true -> 626 OldList 627 end, 628 Sorting = 629 case Sort of 630 undefined -> 631 Session#session.sorting; 632 _ -> 633 set_sorting(Session#session.cookie, Sort), 634 Sort 635 end, 636 case Listing of 637 {error, Reason} -> 638 case string:str(lowercase(Reason), "lock") of 639 0 -> 640 {ehtml,format_error(to_string(Reason))}; 641 _N -> 642 sleep(?RETRYTIMEOUT), 643 list_msg(Session, Refresh, Sort, Count-1) 644 end; 645 H when Refresh == true -> 646 set_listing(Session#session.cookie, H), 647 {redirect_local, {rel_path, "mail.yaws"}}; 648 H -> 649 if H /= OldList -> 650 set_listing(Session#session.cookie, H); 651 true -> ok 652 end, 653 (dynamic_headers()++ 654 [{ehtml, 655 [{script,[], 656 "function setCmd(val) { \n" 657 " if (val == 'delete') {\n" 658 " var res = confirm('Are you sure you want" 659 " to delete the selected emails?');\n" 660 " if (!res) { \n" 661 " return;\n" 662 " }\n" 663 " }\n" 664 " document.list.cmd.value=val;\n" 665 " document.list.submit();\n" 666 "}" 667 }, 668 {style,[{type,"text/css"}], 669 "A:link { color: black; text-decoration: none}\n" 670 "A:visited { color: black; text-decoration: none}\n" 671 "A:active { color: black; text-decoration: none}\n" 672 ".AList { color: black; text-decoration: none}\n" 673 ".Head { border-right:1px solid white}"}, 674 {form, [{name,list},{action,"listop.yaws"},{method,post}], 675 [{table, [{border,0},{bgcolor,"c0c0c0"}, 676 {cellspacing,0},{width,"100%"}], 677 {tr,[],{td,[{nowrap,true},{align,left},{valign,middle}], 678 {font, [{size,6},{color,black}], 679 "WebMail at "++maildomain()}}}}, 680 build_toolbar([{"tool-newmail.gif","compose.yaws", 681 "New Message"}, 682 {"tool-delete.gif", 683 "javascript:setCmd('delete')", 684 "Delete"}, 685 {"","mail.yaws?refresh=true","Refresh"}, 686 {"","logout.yaws","Logout"}]), 687 {table, [{border,0},{bgcolor,"666666"},{cellspacing,0}, 688 {width,"100%"}], 689 {tr,[],{td,[{nowrap,true},{align,left},{valign,middle}], 690 {font, [{size,2},{color,"#ffffff"}], 691 "Inbox for "++Session#session.user}}}}, 692 {table, [{border,0},{cellspacing,0},{cellpadding,1}, 693 {width,"100%"}], 694 [{tr, [{bgcolor,"c0c0c0"},{valign,middle}], 695 [{th,[{align,left},{valign,middle},{class,head}], 696 {font,[{size,2},{color,black}], 697 sort_href("nr",Sorting,"Nr")}}, 698 {th,[{class,head}], 699 {img,[{src,"view-mark.gif"},{width,13}, 700 {height,13}],[]}}, 701 {th,[{align,left},{valign,middle},{class,head}], 702 {font,[{size,2},{color,black}], 703 sort_href("from",Sorting,"From")}}, 704 {th,[{align,left},{valign,middle},{class,head}], 705 {font,[{size,2},{color,black}], 706 sort_href("subject",Sorting,"Subject")}}, 707 {th,[{align,left},{valign,middle},{class,head}], 708 {font,[{size,2},{color,black}], 709 sort_href("date",Sorting,"Date")}}, 710 {th,[{align,left},{valign,middle},{class,head}], 711 {font,[{size,2},{color,black}], 712 sort_href("size",Sorting,"Size")}}]}] ++ 713 format_summary(H,Sorting)}, 714 {input,[{type,hidden},{name,cmd},{value,""}],[]} 715 ]}]}]) 716 end. 717 718 719sort_href(Sort, Cur, Text) when is_atom(Cur) -> 720 sort_href(Sort, atom_to_list(Cur), Text); 721sort_href(Sort, Sort, Text) -> 722 [{a, [{href,"mail.yaws?sort=rev_"++Sort}], Text}, 723 {img, [{src,"up.gif"}]}]; 724sort_href(Sort, "rev_"++Sort, Text) -> 725 [{a, [{href,"mail.yaws?sort="++Sort}], Text}, 726 {img, [{src,"down.gif"}]}]; 727sort_href(Sort, _Cur, Text) -> 728 {a, [{href,"mail.yaws?sort="++Sort}], Text}. 729 730 731format_summary(Hs,Sorting) -> 732 SHs = sort_summary(Hs, Sorting), 733 [format_summary_line(H) || H <- SHs]. 734 735sort_summary(Hs, Sorting) -> 736 lists:sort(fun(A,B) -> 737 summary_compare(A,B,Sorting) 738 end, Hs). 739 740summary_compare(A, B, rev_from) -> 741 not(summary_compare(A, B, from)); 742 743summary_compare(A, B, rev_date) -> 744 not(summary_compare(A, B, date)); 745 746summary_compare(A, B, rev_subject) -> 747 not(summary_compare(A, B, subject)); 748 749summary_compare(A, B, rev_nr) -> 750 not(summary_compare(A, B, nr)); 751 752summary_compare(A, B, rev_size) -> 753 not(summary_compare(A, B, size)); 754 755summary_compare(A,B,size) -> 756 Sa = A#info.size, 757 Sb = B#info.size, 758 if Sa < Sb -> true; 759 Sa > Sb -> false; 760 true -> summary_compare(A,B,date) 761 end; 762summary_compare(A,B,from) -> 763 Ha = A#info.headers, 764 Hb = B#info.headers, 765 if Ha#mail.from_fmt_lc < Hb#mail.from_fmt_lc -> 766 true; 767 Ha#mail.from_fmt_lc == Hb#mail.from_fmt_lc -> 768 summary_compare(A,B,date); 769 true -> false 770 end; 771summary_compare(A,B,subject) -> 772 Ha = A#info.headers, 773 Hb = B#info.headers, 774 Sa = Ha#mail.subject_fmt_lc, 775 Sb = Hb#mail.subject_fmt_lc, 776 if Sa < Sb -> true; 777 Sa > Sb -> false; 778 true -> summary_compare(A,B,date) 779 end; 780summary_compare(A,B,date) -> 781 Ha = A#info.headers, 782 Hb = B#info.headers, 783 Ha#mail.date_pst < Hb#mail.date_pst; 784summary_compare(A,B,_Nr) -> 785 A#info.nr < B#info.nr. 786 787strip_re(" "++Subject) -> 788 strip_re(Subject); 789strip_re("re:"++Subject) -> 790 strip_re(Subject); 791strip_re("aw:"++Subject) -> 792 strip_re(Subject); 793strip_re("ang."++Subject) -> 794 strip_re(Subject); 795strip_re(Subject) -> 796 Subject. 797 798format_summary_line(I) -> 799 H = I#info.headers, 800 {tr, [{align,center},{valign,top}], 801 [{td, [{nowrap,true},{align,left},{valign,top},{class,"List"}], 802 {a, [{href,"showmail.yaws?nr="++integer_to_list(I#info.nr)}], 803 {font,[{size,2},{color,black}],{b,[],integer_to_list(I#info.nr)}}}}, 804 {td, [{nowrap,true},{align,center},{valign,top},{class,"List"}], 805 {input, [{type,checkbox},{name,I#info.nr},{value,yes}],[]}}, 806 {td, [{nowrap,true},{align,left},{valign,top},{class,"List"}], 807 {a, [{href,"showmail.yaws?nr="++integer_to_list(I#info.nr)}], 808 {font,[{size,2},{color,black}],{b,[],H#mail.from_fmt}}}}, 809 {td, [{nowrap,true},{align,left},{valign,top},{class,"List"}], 810 {a, [{href,"showmail.yaws?nr="++integer_to_list(I#info.nr)}], 811 {font,[{size,2},{color,black}],{b,[],H#mail.subject_fmt}}}}, 812 {td, [{nowrap,true},{align,left},{valign,top},{class,"List"}], 813 {a, [{href,"showmail.yaws?nr="++integer_to_list(I#info.nr)}], 814 {font,[{size,2},{color,black}], 815 {b,[],H#mail.date_fmt}}}}, 816 {td, [{nowrap,true},{align,left},{valign,top},{class,"List"}], 817 {a, [{href,"showmail.yaws?nr="++integer_to_list(I#info.nr)}], 818 {font,[{size,2},{color,black}],{b,[],integer_to_list(I#info.size)}}}} 819 ]}. 820 821format_from(From0) -> 822 From = lists:flatten(From0), 823 case string:chr(From,$<) of 824 0 -> 825 string:strip(From); 826 N -> 827 NewF=string:strip(unquote(decode(string:substr(From,1,N-1)))), 828 if 829 NewF == [] -> From; 830 true -> NewF 831 end 832 end. 833 834parse_addr(AddrStr) -> 835 Addrs = token_addrs(AddrStr, [], false), 836 Op = 837 fun(From) -> 838 case {string:chr(From,$<),string:chr(From,$>)} of 839 {S,E} when S>0, E>0 -> 840 string:substr(From,S,(E-S)+1); 841 _ -> 842 string:strip(From) 843 end 844 end, 845 [Op(F) || F <- Addrs]. 846 847token_addrs([], [], _) -> 848 []; 849token_addrs([], Acc, _) -> 850 [lists:reverse(Acc)]; 851token_addrs([C=$"|R], Acc, true) -> 852 token_addrs(R, [C|Acc], false); 853token_addrs([C=$"|R], Acc, false) -> 854 token_addrs(R, [C|Acc], true); 855token_addrs([$,|R], Acc, false) -> 856 [lists:reverse(Acc)|token_addrs(R, [], false)]; 857token_addrs([C|R], Acc, InQuote) -> 858 token_addrs(R, [C|Acc], InQuote). 859 860decode(Text) -> 861 decode(Text, []). 862 863decode([], Acc) -> lists:reverse(Acc); 864decode([$=,$?|Rest], Acc) -> 865 decode_scan(Rest, Acc); 866decode([C|Cs], Acc) -> 867 decode(Cs, [C|Acc]). 868 869decode_scan([], Acc) -> lists:reverse(Acc); 870decode_scan([$?,$b,$?|Rest], Acc) -> 871 decode_b64(Rest,Acc); 872decode_scan([$?,$B,$?|Rest], Acc) -> 873 decode_b64(Rest,Acc); 874decode_scan([$?,$q,$?|Rest], Acc) -> 875 decode_q(Rest,Acc); 876decode_scan([$?,$Q,$?|Rest], Acc) -> 877 decode_q(Rest, Acc); 878decode_scan([$?,_,$?|Rest], Acc) -> 879 decode(Rest, Acc); 880decode_scan([_|Rest], Acc) -> 881 decode_scan(Rest, Acc). 882 883decode_q([], Acc) -> 884 lists:reverse(Acc); 885decode_q([$?,$=|Rest], Acc) -> 886 decode(Rest, Acc); 887decode_q([$=,H1,H2|Rest], Acc) -> 888 case catch yaws:hex_to_integer([H1,H2]) of 889 {'EXIT',_} -> 890 decode_q(Rest, [H2,H1,$=|Acc]); 891 C -> 892 decode_q(Rest, [C|Acc]) 893 end; 894decode_q([C|Cs], Acc) -> 895 decode_q(Cs, [C|Acc]). 896 897decode_b64([],Acc) -> 898 Str = lists:reverse(Acc), 899 case catch base64_2_str(Str) of 900 {'EXIT',_} -> Str; 901 Dec -> Dec 902 end; 903decode_b64([$?,$=|Rest],Acc) -> 904 Str = lists:reverse(Acc), 905 case catch base64_2_str(Str) of 906 {'EXIT',_} -> Str++decode(Rest); 907 Dec -> Dec ++ decode(Rest) 908 end; 909decode_b64([C|Rest], Acc) -> 910 decode_b64(Rest,[C|Acc]). 911 912unquote([]) -> []; 913unquote([$"|R]) -> unquote(R); 914unquote([C|R]) -> [C|unquote(R)]. 915 916quote([]) -> 917 []; 918quote([$"|Cs]) -> 919 ["""|quote(Cs)]; 920quote([C|Cs]) -> 921 [C|quote(Cs)]. 922 923display_login(_A, Status) -> 924 (dynamic_headers() ++ 925 [{ehtml, 926 [{body, [{onload,"document.f.user.focus();"}], 927 [{table, [{border,0},{bgcolor,"c0c0c0"},{cellspacing,0}, 928 {width,"100%"}], 929 {tr,[],{td,[{nowrap,true},{align,left},{valign,middle}], 930 {font, [{size,6},{color,black}], 931 "WebMail at "++maildomain()}}}}, 932 io_lib:format("<p>Your login status is: ~s</p>", 933 [Status]), 934 {form, 935 [{method,post}, 936 {name,f}, 937 {action, "login.yaws"}, 938 {autocomplete,"off"}], 939 {table,[{cellspacing, "5"}], 940 [{tr, [], 941 [{td, [], {p, [], "Username:"}}, 942 {td, [], {input, [{name, user}, 943 {type, text}, 944 {size, "20"}]}} 945 ]}, 946 {tr, [], 947 [{td, [], {p, [], "Password:"}}, 948 {td, [], {input, [{name, password}, 949 {type, password}, 950 {size, "20"}]}}]}, 951 {tr, [], 952 {td, [{align, "right"}, {colspan, "2"}], 953 {input, [{type, submit}, 954 {value, "Login"}]}}} 955 ]}}] 956 }] 957 }]). 958 959logout(Session) -> 960 logout_cookie(Session#session.cookie), 961 (dynamic_headers() ++ 962 [{redirect_local, {rel_path,"mail.yaws"}}]). 963 964login(User, Password) -> 965 case stat(popserver(), strip(User), strip(Password)) of 966 {ok, _} -> 967 {ok, new_session(User, Password)}; 968 {error, Reason} -> 969 {error, Reason} 970 end. 971 972check_session(A) -> 973 H = A#arg.headers, 974 case yaws_api:find_cookie_val("mailsession", H#headers.cookie) of 975 [] -> 976 display_login(A, "not logged in"); 977 CVal -> 978 case mail:check_cookie(CVal) of 979 error -> 980 display_login(A, "not logged in"); 981 Session -> 982 {ok, Session} 983 end 984 end. 985 986strip(Str) -> 987 lists:filter(fun(C)->not(lists:member(C,"\r\n"))end,Str). 988 989dynamic_headers() -> 990 [yaws_api:set_content_type("text/html"), 991 {header, {cache_control, "no-store"}}, 992 {header, "Expires: -1"}]. 993 994%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 995%% 996%% session server 997%% 998 999tick_session(Cookie) -> 1000 session_server(), 1001 mail_session_manager ! {tick_session, Cookie}. 1002 1003new_session(User, Password) -> 1004 session_server(), 1005 mail_session_manager ! 1006 {new_session, #session{user=User,passwd=Password}, self()}, 1007 receive 1008 {session_manager, Cookie} -> 1009 Cookie 1010 end. 1011 1012check_cookie(Cookie) -> 1013 session_server(), 1014 mail_session_manager ! {get_session, Cookie, self()}, 1015 receive 1016 {session_manager, {ok, Session}} -> 1017 Session; 1018 {session_manager, error} -> 1019 error 1020 end. 1021 1022set_listing(Cookie, Listing) -> 1023 session_server(), 1024 mail_session_manager ! {set_listing, Cookie, self(), Listing}, 1025 receive 1026 {session_manager, listing_added} -> 1027 ok; 1028 {session_manager, error} -> 1029 error 1030 end. 1031 1032set_sorting(Cookie, Sorting) -> 1033 session_server(), 1034 mail_session_manager ! {set_sorting, Cookie, self(), Sorting}, 1035 receive 1036 {session_manager, sorting_added} -> 1037 ok; 1038 {session_manager, error} -> 1039 error 1040 end. 1041 1042logout_cookie(Cookie) -> 1043 session_server(), 1044 mail_session_manager ! {del_session, Cookie}. 1045 1046session_server() -> 1047 case whereis(mail_session_manager) of 1048 undefined -> 1049 Pid = proc_lib:spawn(?MODULE, session_manager_init, []), 1050 register(mail_session_manager, Pid); 1051 _ -> 1052 done 1053 end. 1054 1055session_manager_init() -> 1056 session_manager([], yaws:get_time_tuple(), read_config()). 1057 1058session_manager(C0, LastGC0, Cfg) -> 1059 %% Check GC first to avoid GC starvation. 1060 GCDiff = diff(LastGC0,yaws:get_time_tuple()), 1061 {LastGC, C} = 1062 if GCDiff > 5000 -> 1063 C2 = session_manager_gc(C0, Cfg), 1064 {yaws:get_time_tuple(), C2}; 1065 true -> 1066 {LastGC0, C0} 1067 end, 1068 1069 receive 1070 {get_session, Cookie, From} -> 1071 case lists:keysearch(Cookie, 1, C) of 1072 {value, {_,Session,_}} -> 1073 From ! {session_manager, {ok, Session}}; 1074 false -> 1075 From ! {session_manager, error} 1076 end, 1077 session_manager(C, LastGC, Cfg); 1078 {new_session, Session, From} -> 1079 Cookie = integer_to_list(bin2int(crypto:strong_rand_bytes(16))), 1080 From ! {session_manager, Cookie}, 1081 session_manager([{Cookie, Session#session{cookie=Cookie}, 1082 yaws:get_time_tuple()}|C], LastGC, Cfg); 1083 {tick_session, Cookie} -> 1084 case lists:keysearch(Cookie, 1, C) of 1085 {value, {Cookie,Session,_}} -> 1086 session_manager( 1087 lists:keyreplace(Cookie,1,C, 1088 {Cookie,Session,yaws:get_time_tuple()}), LastGC, Cfg); 1089 false -> 1090 session_manager(C, LastGC, Cfg) 1091 end; 1092 {del_session, Cookie} -> 1093 C3 = lists:keydelete(Cookie, 1, C), 1094 session_manager(C3, LastGC, Cfg); 1095 {From, cfg , Req} -> 1096 sm_reply(Req, From, Cfg), 1097 session_manager(C, LastGC, Cfg); 1098 {set_listing, Cookie, From, Listing} -> 1099 case lists:keysearch(Cookie, 1, C) of 1100 {value, {_,Session,_}} -> 1101 S2 = Session#session{listing=Listing}, 1102 From ! {session_manager, listing_added}, 1103 session_manager(lists:keyreplace( 1104 Cookie, 1, C, {Cookie, S2, yaws:get_time_tuple()}), 1105 LastGC, Cfg); 1106 false -> 1107 io:format("Error, no session found! ~p\n", [Cookie]), 1108 From ! {session_manager, error}, 1109 session_manager(C, LastGC, Cfg) 1110 end; 1111 {set_sorting, Cookie, From, Sorting} -> 1112 case lists:keysearch(Cookie, 1, C) of 1113 {value, {_,Session,_}} -> 1114 S2 = Session#session{sorting=Sorting}, 1115 From ! {session_manager, sorting_added}, 1116 session_manager(lists:keyreplace( 1117 Cookie, 1, C, {Cookie, S2, yaws:get_time_tuple()}), 1118 LastGC, Cfg); 1119 false -> 1120 io:format("Error, no session found! ~p\n", [Cookie]), 1121 From ! {session_manager, error}, 1122 session_manager(C, LastGC, Cfg) 1123 end; 1124 {session_set_attach_data, From, Cookie, Fname, Ctype, Data} -> 1125 case lists:keysearch(Cookie, 1, C) of 1126 {value, {_,Session,_}} -> 1127 Atts = Session#session.attachments, 1128 [A|As] = add_att(Fname, Ctype, Data, Atts), 1129 From ! {session_manager, A#satt.num}, 1130 S2 = Session#session{attachments = [A|As]}, 1131 session_manager(lists:keyreplace( 1132 Cookie,1,C, 1133 {Cookie,S2,yaws:get_time_tuple()}), LastGC, Cfg); 1134 false -> 1135 session_manager(C, LastGC, Cfg) 1136 end; 1137 {session_get_attach_data, From, Cookie, Num} -> 1138 case lists:keysearch(Cookie, 1, C) of 1139 {value, {_,Session,_}} -> 1140 Atts = Session#session.attachments, 1141 case lists:keysearch(Num, #satt.num, Atts) of 1142 false -> 1143 From ! {session_manager, error}; 1144 {value, A} -> 1145 From ! {session_manager, A} 1146 end; 1147 false -> 1148 ignore 1149 end, 1150 session_manager(C, LastGC, Cfg) 1151 after 1152 5000 -> 1153 %% garbage collect sessions 1154 C3 = session_manager_gc(C, Cfg), 1155 session_manager(C3, yaws:get_time_tuple(), Cfg) 1156 end. 1157 1158add_att(Fname, Ctype, Data, Atts) -> 1159 case lists:keysearch(Fname, #satt.filename, Atts) of 1160 false -> 1161 [#satt{num = length(Atts) + 1, 1162 filename = Fname, 1163 ctype = Ctype, 1164 data = Data} | Atts]; 1165 1166 {value, A} when A#satt.data == Data -> 1167 [A | lists:keydelete(A#satt.num, #satt.num, Atts)]; 1168 {value, _A} -> 1169 [#satt{num = length(Atts) + 1, 1170 filename = Fname, 1171 ctype = Ctype, 1172 data = Data} | Atts] 1173 end. 1174 1175 1176session_manager_gc(C, Cfg) -> 1177 lists:zf(fun(Entry={_Cookie,_Session,Time}) -> 1178 Diff = diff(Time,yaws:get_time_tuple()), 1179 TTL = Cfg#cfg.ttl, 1180 if Diff > TTL -> 1181 false; 1182 true -> 1183 {true, Entry} 1184 end 1185 end, C). 1186 1187sm_reply(ttl, From, Cfg) -> 1188 From ! {session_manager, Cfg#cfg.ttl}; 1189sm_reply(popserver, From, Cfg) -> 1190 From ! {session_manager, Cfg#cfg.popserver}; 1191sm_reply(smtpserver, From, Cfg) -> 1192 From ! {session_manager, Cfg#cfg.smtpserver}; 1193sm_reply(maildomain, From, Cfg) -> 1194 From ! {session_manager, Cfg#cfg.maildomain}; 1195sm_reply(sendtimeout, From, Cfg) -> 1196 From ! {session_manager, Cfg#cfg.sendtimeout}. 1197 1198 1199req(Req) -> 1200 session_server(), 1201 mail_session_manager ! {self(), cfg, Req}, 1202 receive {session_manager, Reply} -> 1203 Reply 1204 after 10000 -> 1205 exit("No reply from session manager") 1206 end. 1207 1208% ttl() -> req(ttl). 1209popserver() -> req(popserver). 1210smtpserver() -> req(smtpserver). 1211maildomain() -> req(maildomain). 1212sendtimeout() -> req(sendtimeout). 1213 1214 1215 1216 1217diff({M1,S1,_}, {M2,S2,_}) -> 1218 (M2-M1)*1000000+(S2-S1). 1219 1220%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1221 1222retr(Server, User, Password, Nr) -> 1223 Req = [ret(Nr)], 1224 case pop_request(Req, Server, User, Password) of 1225 [{ok,Msg}] -> 1226 dot_unescape(Msg); 1227 [{error, Reason}] -> 1228 {error, Reason} 1229 end. 1230 1231parse_message(Msg) -> 1232 split_head_body(Msg, []). 1233 1234split_head_body(Msg, Acc) -> 1235 case get_next_line(Msg) of 1236 {error, Reason} -> 1237 {error, Reason}; 1238 {[], Rest} -> 1239 {lists:reverse(Acc), Rest}; 1240 {Line, Rest} -> 1241 split_head_body(Rest, [Line|Acc]) 1242 end. 1243 1244get_next_line(Data) -> 1245 %% io:format("Data = ~p\n", [Data]), 1246 get_next_line(Data,[]). 1247 1248get_next_line([D|Ds], Acc) -> 1249 case split_reply(D,[]) of 1250 more -> 1251 get_next_line(Ds, [D|Acc]); 1252 {Pre, Rest} when Acc==[] -> 1253 {Pre, [Rest|Ds]}; 1254 {Pre, Rest} -> 1255 {lists:flatten(lists:reverse([Pre|Acc])), [Rest|Ds]} 1256 end. 1257 1258stat(Server, User, Password) -> 1259 case pop_request([{"STAT",sl}], Server, User, Password) of 1260 [{ok, Stat}] -> 1261 {ok, Stat}; 1262 {error, Reason} -> 1263 {error, Reason} 1264 end. 1265 1266list(Server, User, Password) -> 1267 case pop_request([{"LIST",ml}], Server, User, Password) of 1268 [{ok, Stats}] -> 1269 Info = lists:reverse([info(S) || S <- Stats]), 1270 Req = [top(I#info.nr) || I <- Info], 1271 case pop_request(Req, Server, User, Password) of 1272 {error, Reason} -> 1273 {error, Reason}; 1274 Res -> 1275 Hdrs = lists:map(fun({ok,Ls}) -> 1276 parse_headers(Ls) 1277 end, Res), 1278 add_hdrs(Info,Hdrs) 1279 end; 1280 {error, Reason} -> 1281 {error, Reason} 1282 end. 1283 1284 1285add_hdrs([], []) -> []; 1286add_hdrs([I|Is], [H|Hs]) -> 1287 [I#info{headers=H}|add_hdrs(Is,Hs)]. 1288 1289info(Str) -> 1290 [NrStr,SizeStr|_] = string:tokens(Str, " \t"), 1291 #info{nr=to_int(NrStr),size=to_int(SizeStr)}. 1292 1293top(I) -> {"TOP "++integer_to_list(I)++" 0", ml}. 1294ret(I) -> {"RETR "++integer_to_list(I), sized}. 1295 1296del(I) -> {"DELE "++I, sl}. 1297 1298 1299to_int(Str) -> 1300 to_int(Str, 0). 1301 1302to_int([D|Ds], Acc) when D >= $0, D =< $9-> 1303 to_int(Ds, Acc*10+D-$0); 1304to_int(_, Acc) -> Acc. 1305 1306%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1307 1308parse_headers(Lines) -> 1309 parse_headers(Lines, #mail{}). 1310 1311parse_headers([], Headers) -> 1312 Headers; 1313parse_headers([L1,[$\t|L2]|Lines], Headers) -> 1314 parse_headers([L1++" "++L2|Lines], Headers); 1315parse_headers([L1,[$ |L2]|Lines], Headers) -> 1316 parse_headers([L1++" "++L2|Lines], Headers); 1317parse_headers([Line|Lines], Headers) -> 1318 case string:chr(Line, $:) of 1319 0 -> 1320 Headers; 1321 N -> 1322 Key = lowercase(string:strip(string:sub_string(Line, 1, N-1))), 1323 Value = 1324 if length(Line) > N+1 -> 1325 string:strip(string:sub_string(Line, N+2)); 1326 true -> 1327 [] 1328 end, 1329 NewH = add_header(Key, Value, Headers), 1330 parse_headers(Lines, NewH) 1331 end. 1332 1333parse_header_value(Header) -> 1334 [Key|Options] = string:tokens(Header, ";"), 1335 Opts = [parse_key_value(O) || O <- Options], 1336 {Key,Opts}. 1337 1338 1339parse_key_value(O) -> 1340 parse_key_value(O, []). 1341 1342parse_key_value([], Acc) -> 1343 {string:strip(lists:reverse(Acc)), []}; 1344parse_key_value([$=|Rest], Acc) -> 1345 Value = unquote(string:strip(Rest)), 1346 Key = lowercase(string:strip(lists:reverse(Acc))), 1347 {Key, Value}; 1348parse_key_value([C|Cs], Acc) -> 1349 parse_key_value(Cs, [C|Acc]). 1350 1351 1352lowercase(Str) -> 1353 [lowercase_ch(S) || S <- Str]. 1354 1355 1356lowercase_ch(C) when C>=$A, C=<$Z -> C + 32; 1357lowercase_ch(C) -> C. 1358 1359add_header("content-transfer-encoding", Value, H) -> 1360 H#mail{transfer_encoding = lowercase(Value)}; 1361add_header("content-type", Value, H) -> 1362 H#mail{content_type = parse_header_value(Value)}; 1363add_header("content-disposition", Value, H) -> 1364 H#mail{content_disposition = parse_header_value(Value)}; 1365add_header("from", Value, H) -> 1366 FromFmt = format_from(Value), 1367 H#mail{from = Value, 1368 from_fmt = FromFmt, 1369 from_fmt_lc = lowercase(FromFmt)}; 1370add_header("to", Value, H) -> 1371 H#mail{to = Value}; 1372add_header("cc", Value, H) -> 1373 H#mail{cc = Value}; 1374add_header("bcc", Value, H) -> 1375 H#mail{bcc = Value}; 1376add_header("subject", Value, H) -> 1377 SubjectFmt = lists:flatten(decode(Value)), 1378 H#mail{subject = Value, 1379 subject_fmt = SubjectFmt, 1380 subject_fmt_lc = strip_re(lowercase(SubjectFmt))}; 1381add_header("date", Value, H) -> 1382 DatePst = parse_date(Value), 1383 H#mail{date = Value, 1384 date_pst = DatePst, 1385 date_fmt = format_date(DatePst)}; 1386add_header(Other, Value, H) -> 1387 H#mail{other = [{Other,Value}| 1388 H#mail.other]}. 1389 1390%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1391 1392pop_request(Command, Server, User, Password) -> 1393 proc_lib:spawn_link(?MODULE, ploop, 1394 [Command, Server, User, Password, self()]), 1395 receive 1396 {pop_response, Response} -> 1397 Response 1398 end. 1399 1400%% 1401%% first authenticate then run a bunch of commands 1402%% 1403 1404ploop(Command, Server, User, Password, From) -> 1405 case gen_tcp:connect(Server, 110, [{active, false}, 1406 {reuseaddr,true}, 1407 binary]) of 1408 {ok, Port} -> 1409 State = #pstate{port=Port, 1410 user=User, 1411 pass=Password, 1412 cmd=Command, 1413 from=From}, 1414 ploop(init, State); 1415 _ -> 1416 {error, "Failed to contact mail server."} 1417 end. 1418 1419 % 1420 1421 1422 1423ploop(init, State) -> 1424 case receive_reply(State) of 1425 {ok, _Reply, State2} -> 1426 psend("USER " ++ State#pstate.user, State#pstate.port), 1427 ploop(user, State2); 1428 {error, Reason, _State2} -> 1429 State#pstate.from ! {pop_response, {error, Reason}}, 1430 pop_close(State#pstate.port); 1431 {more, State2} -> 1432 ploop(init, State2) 1433 end; 1434 1435ploop(user, State) -> 1436 case receive_reply(State) of 1437 {ok, _Reply, State2} -> 1438 psend("PASS " ++ State#pstate.pass, State#pstate.port), 1439 ploop(pass, State2); 1440 {error, Reason, _State2} -> 1441 State#pstate.from ! {pop_response, {error, Reason}}, 1442 pop_close(State#pstate.port); 1443 {more, State2} -> 1444 ploop(user, State2) 1445 end; 1446ploop(pass, State) -> 1447 case receive_reply(State) of 1448 {ok, _Reply, _State2} -> 1449 next_cmd(State); 1450 {error, Reason, _State2} -> 1451 State#pstate.from ! {pop_response, {error, Reason}}, 1452 pop_close(State#pstate.port); 1453 {more, State2} -> 1454 ploop(pass, State2) 1455 end; 1456ploop(sl, State) -> 1457 case receive_reply(State) of 1458 {ok, Reply, State2} -> 1459 next_cmd(State2#pstate{reply=[{ok,Reply}|State2#pstate.reply]}); 1460 {error, Reason, State2} -> 1461 next_cmd(State2#pstate{reply=[{error,Reason}| 1462 State2#pstate.reply]}); 1463 {more, State2} -> 1464 ploop(sl, State2) 1465 end; 1466ploop(close, State) -> 1467 case receive_reply(State) of 1468 {ok, _Reply, State2} -> 1469 ploop(close, State2); 1470 {error, _, State2} -> 1471 next_cmd(State2); 1472 {more, State2} -> 1473 ploop(close, State2) 1474 end; 1475ploop(sized, State) -> 1476 case receive_reply(State) of 1477 {ok, Reply, State2} -> 1478 case to_int(Reply) of 1479 0 -> 1480 ploop(sized_cont, State2#pstate{remain=dot,dotstate=0, 1481 lines=[]}); 1482 Size -> 1483 ploop(sized_cont, State2#pstate{remain=Size,lines=[]}) 1484 end; 1485 {error, Reason, State2} -> 1486 next_cmd(State2#pstate{reply=[{error,Reason}| 1487 State2#pstate.reply]}); 1488 {more, State2} -> 1489 ploop(ml, State2) 1490 end; 1491ploop(sized_cont, State) -> 1492 case receive_data(State) of 1493 {error, Reason, State2} -> 1494 next_cmd(State2#pstate{reply=[{error,Reason}| 1495 State2#pstate.reply]}); 1496 {more, State2} -> 1497 ploop(sized_cont, State2); 1498 {done, State2} -> 1499 Data = lists:reverse(State2#pstate.lines), 1500 next_cmd(State2#pstate{reply=[{ok, Data}|State2#pstate.reply]}) 1501 end; 1502ploop(ml, State) -> 1503 case receive_reply(State) of 1504 {ok, _Reply, State2} -> 1505 ploop(ml_cont, State2#pstate{lines=[]}); 1506 {error, Reason, State2} -> 1507 next_cmd(State2#pstate{reply=[{error,Reason}| 1508 State2#pstate.reply]}); 1509 {more, State2} -> 1510 ploop(ml, State2) 1511 end; 1512ploop(ml_cont, State) -> 1513 case receive_reply(State) of 1514 {line, Line, State2} -> 1515 Lines = State2#pstate.lines, 1516 ploop(ml_cont, State2#pstate{lines=[Line|Lines]}); 1517 {error, Reason, State2} -> 1518 next_cmd(State2#pstate{reply=[{error,Reason}| 1519 State2#pstate.reply]}); 1520 {more, State2} -> 1521 ploop(ml_cont, State2); 1522 {done, State2} -> 1523 Lines = lists:reverse(State2#pstate.lines), 1524 next_cmd(State2#pstate{reply=[{ok, Lines}|State2#pstate.reply]}) 1525 end. 1526 1527%% 1528 1529next_cmd(State=#pstate{cmd=Cmd,reply=Reply}) when Cmd==quit -> 1530 State#pstate.from ! {pop_response, lists:reverse(Reply)}, 1531 gen_tcp:close(State#pstate.port); 1532next_cmd(State=#pstate{cmd=Cmd}) when Cmd==[]-> 1533 psend("QUIT", State#pstate.port), 1534 ploop(close, State#pstate{cmd=quit}); 1535next_cmd(State=#pstate{cmd=[Cmd|Cmds]}) -> 1536 {C,S} = Cmd, 1537 psend(C, State#pstate.port), 1538 ploop(S, State#pstate{cmd=Cmds}). 1539 1540%% 1541 1542pop_close(Port) -> 1543 psend("quit", Port), 1544 gen_tcp:close(Port). 1545 1546%% 1547 1548psend(Str, Port) -> 1549 gen_tcp:send(Port, Str++"\r\n"). 1550 1551%% 1552 1553receive_reply(State=#pstate{acc=Acc,more=false}) -> 1554 check_reply(Acc, State); 1555receive_reply(State=#pstate{port=Port,acc=Acc,more=true}) -> 1556 Res = gen_tcp:recv(Port, 0), 1557 case Res of 1558 {ok, Bin} -> 1559 NAcc = Acc++binary_to_list(Bin), 1560 check_reply(NAcc, State); 1561 {error, closed} -> 1562 {error, "closed", State}; 1563 Err -> 1564 {error, Err, State} 1565 end. 1566 1567 1568%% 1569 1570receive_data(State=#pstate{acc=Acc,more=false,remain=Remain}) -> 1571 if 1572 Remain == dot -> 1573 %% look for .\r\n 1574 case find_dot(Acc, State#pstate.dotstate) of 1575 {more, DotState} -> 1576 State2 = State#pstate{acc=[], 1577 dotstate=DotState, 1578 lines=[Acc|State#pstate.lines], 1579 more=true}, 1580 {more, State2}; 1581 {ok, DotState, Lines, NAcc} -> 1582 State2 = State#pstate{acc=NAcc, 1583 dotstate=DotState, 1584 lines=[Lines|State#pstate.lines], 1585 more=false}, 1586 {done, State2} 1587 end; 1588 Remain =< length(Acc) -> 1589 {Lines, NAcc} = split_at(Acc, Remain), 1590 State2 = State#pstate{acc=NAcc,lines=[Lines|State#pstate.lines], 1591 remain=0,more=false}, 1592 {done, State2}; 1593 true -> 1594 Rem = Remain - length(Acc), 1595 State2 = State#pstate{acc=[],lines=[Acc|State#pstate.lines], 1596 remain=Rem, more=true}, 1597 {more, State2} 1598 end; 1599receive_data(State=#pstate{acc=Acc,more=true}) when length(Acc)>0 -> 1600 receive_data(State#pstate{more=false}); 1601receive_data(State=#pstate{port=Port,acc=[],more=true,remain=Remain}) -> 1602 Res = gen_tcp:recv(Port, 0), 1603 case Res of 1604 {ok, Bin} -> 1605 Acc = binary_to_list(Bin), 1606 if 1607 Remain == dot -> 1608 case find_dot(Acc, State#pstate.dotstate) of 1609 {more, DotState} -> 1610 State2 = State#pstate{acc=[], 1611 dotstate=DotState, 1612 lines=[Acc|State#pstate.lines], 1613 more=true}, 1614 {more, State2}; 1615 {ok, DotState, Lines, NAcc} -> 1616 1617 State2 = State#pstate{acc=NAcc, 1618 dotstate=DotState, 1619 lines=[Lines|State#pstate.lines], 1620 more=false}, 1621 {done, State2} 1622 end; 1623 Remain =< length(Acc) -> 1624 {Lines, NAcc} = split_at(Acc, Remain), 1625 State2 = State#pstate{acc=NAcc, 1626 lines=[Lines|State#pstate.lines], 1627 remain=0,more=false}, 1628 {done, State2}; 1629 true -> 1630 Rem = Remain - length(Acc), 1631 State2 = State#pstate{acc=[], 1632 lines=[Acc|State#pstate.lines], 1633 remain=Rem, more=true}, 1634 {more, State2} 1635 end; 1636 Err -> 1637 {error, Err, State} 1638 end. 1639 1640%% 1641 1642check_reply(Str, State) -> 1643 case split_reply(Str, []) of 1644 {"+OK" ++ Res, Rest} -> 1645 NewS = State#pstate{acc=Rest,more=false}, 1646 {ok, Res, NewS}; 1647 {"-ERR" ++ Res, Rest} -> 1648 NewS = State#pstate{acc=Rest,more=false}, 1649 {error, Res, NewS}; 1650 {".", Rest} -> 1651 NewS = State#pstate{acc=Rest,more=false}, 1652 {done, NewS}; 1653 {"."++Line, Rest} -> 1654 NewS = State#pstate{acc=Rest,more=false}, 1655 {line, Line, NewS}; 1656 {Line, Rest} -> 1657 NewS = State#pstate{acc=Rest,more=false}, 1658 {line, Line, NewS}; 1659 more -> 1660 {more, State#pstate{acc=Str, more=true}} 1661 end. 1662 1663%% 1664 1665split_reply("\r\n"++Rest, Pre) -> 1666 {lists:reverse(Pre), Rest}; 1667split_reply([H|T], Pre) -> 1668 split_reply(T, [H|Pre]); 1669split_reply("", _Pre) -> 1670 more. 1671 1672%% 1673 1674split_at(L,N) -> 1675 split_at(L,N,[]). 1676 1677split_at(L,0,Acc) -> 1678 {lists:reverse(Acc),L}; 1679split_at([C|Cs], N, Acc) -> 1680 split_at(Cs, N-1, [C|Acc]). 1681 1682%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1683 1684get_val(Key, L, Default) -> 1685 case lists:keysearch(Key, 1, L) of 1686 {value, {_, undefined}} -> Default; 1687 {value, {_, Val}} -> Val; 1688 _ -> Default 1689 end. 1690 1691 1692 1693%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1694 1695smtp_init(Server, Session, Recipients) -> 1696 {ok, Port} = gen_tcp:connect(Server, 25, [{active, false}, 1697 {reuseaddr,true}, 1698 binary]), 1699 smtp_expect(220, Port, "SMTP server does not respond"), 1700 smtp_put("MAIL FROM: " ++ Session#session.user++"@"++maildomain(), Port), 1701 smtp_expect(250, Port, "Sender not accepted by mail server"), 1702 send_recipients(Recipients,Port), 1703 smtp_put("DATA", Port), 1704 smtp_expect(354, Port, "Message not accepted by mail server."), 1705 {ok, Port}. 1706 1707smtp_close(State) -> 1708 smtp_put(".", State#send.port), 1709 smtp_expect(250, State#send.port, "Message not accepted by mail server."), 1710 gen_tcp:close(State#send.port), 1711 ok. 1712 1713smtp_send_part(State, Data) -> 1714 gen_tcp:send(State#send.port, Data). 1715 1716smtp_send_part_message(State, Data) -> 1717 {LastNL, Escaped} = dot_escape(Data, State#send.line_start), 1718 gen_tcp:send(State#send.port, Escaped), 1719 State#send{line_start=LastNL}. 1720 1721 1722%% Add an . at all lines starting with a dot. 1723 1724dot_escape(Data, NL) -> 1725 dot_escape(Data, NL, []). 1726 1727dot_escape([], NL, Acc) -> 1728 {NL, lists:reverse(Acc)}; 1729dot_escape([$.|Rest], true, Acc) -> 1730 dot_escape(Rest, false, [$.,$.|Acc]); 1731dot_escape([$\n|Rest], _, Acc) -> 1732 dot_escape(Rest, true, [$\n|Acc]); 1733dot_escape([C|Rest], _, Acc) -> 1734 dot_escape(Rest, false, [C|Acc]). 1735 1736%% 1737 1738dot_unescape(Data) -> 1739 {_,Dt} = dot_unescape(Data, true, []), 1740 Dt. 1741 1742dot_unescape([], NL, Acc) -> 1743 {NL, lists:reverse(Acc)}; 1744dot_unescape([$.|Rest], true, Acc) -> 1745 dot_unescape(Rest, false, Acc); 1746dot_unescape([$\n|Rest], _, Acc) -> 1747 dot_unescape(Rest, true, [$\n|Acc]); 1748dot_unescape([L|Rest], NL, Acc) when is_list(L) -> 1749 {NL2, L2} = dot_unescape(L, NL, []), 1750 dot_unescape(Rest, NL2, [L2|Acc]); 1751dot_unescape([C|Rest], _, Acc) -> 1752 dot_unescape(Rest, false, [C|Acc]). 1753 1754%% 1755 1756smtp_send_b64(State, Data0) -> 1757 Data = State#send.estate++Data0, 1758 {Rest,B64} = str2b64(Data), 1759 gen_tcp:send(State#send.port, B64), 1760 State#send{estate=Rest}. 1761 1762smtp_send_b64_final(State) -> 1763 Data = State#send.estate, 1764 B64 = str2b64_final(Data), 1765 gen_tcp:send(State#send.port, B64). 1766 1767smtp_send(Server, Session, Recipients, Message) -> 1768 case catch smtp_send2(Server, Session, Recipients, Message) of 1769 ok -> 1770 ok; 1771 {error, Reason} -> 1772 {error, Reason}; 1773 _ -> 1774 {error, "Failed to send message."} 1775 end. 1776 1777smtp_send2(Server, Session, Recipients, Message) -> 1778 {ok, Port} = gen_tcp:connect(Server, 25, [{active, false}, 1779 {reuseaddr,true}, 1780 binary]), 1781 smtp_expect(220, Port, "SMTP server does not respond"), 1782 smtp_put("MAIL FROM: " ++ Session#session.user++"@"++maildomain(), Port), 1783 smtp_expect(250, Port, "Sender not accepted by mail server"), 1784 send_recipients(Recipients,Port), 1785 smtp_put("DATA", Port), 1786 smtp_expect(354, Port, "Message not accepted by mail server."), 1787 smtp_put(Message, Port), 1788 smtp_put(".", Port), 1789 smtp_expect(250, Port, "Message not accepted by mail server."), 1790 smtp_put("QUIT", Port), 1791 ok. 1792 1793send_recipients([], _Port) -> 1794 ok; 1795send_recipients([R|Rs], Port) -> 1796 smtp_put("RCPT TO: " ++ R, Port), 1797 smtp_expect(250, Port, io_lib:format("Recipient ~s not accepted.",[R])), 1798 send_recipients(Rs, Port). 1799 1800smtp_put(Message, Port) -> 1801 gen_tcp:send(Port, [Message,"\r\n"]). 1802 1803smtp_expect(Code, Port, ErrorMsg) -> 1804 smtp_expect(Code, Port, [], ErrorMsg). 1805 1806smtp_expect(Code, Port, Acc, ErrorMsg) -> 1807 Res = gen_tcp:recv(Port, 0, sendtimeout()), 1808 case Res of 1809 {ok, Bin} -> 1810 NAcc = Acc++binary_to_list(Bin), 1811 case string:chr(NAcc, $\n) of 1812 0 -> 1813 smtp_expect(Code, Port, NAcc, ErrorMsg); 1814 _N -> 1815 ResponseCode = to_int(NAcc), 1816 if 1817 ResponseCode == Code -> ok; 1818 true -> throw({error, ErrorMsg}) 1819 end 1820 end; 1821 Err -> 1822 throw({error, Err}) 1823 end. 1824 1825 1826%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1827 1828str2b64(String) -> 1829 str2b64(String, []). 1830 1831str2b64([], Acc) -> 1832 {[], lists:reverse(Acc)}; 1833str2b64(String, Acc) -> 1834 case str2b64_line(String, []) of 1835 {ok, Line, Rest} -> 1836 str2b64(Rest, ["\n",Line|Acc]); 1837 {more, _} -> 1838 {String, lists:reverse(Acc)} 1839 end. 1840 1841 1842% 1843 1844str2b64_final(String) -> 1845 str2b64_final(String, []). 1846 1847 1848str2b64_final([], Acc) -> 1849 lists:reverse(Acc); 1850str2b64_final(String, Acc) -> 1851 case str2b64_line(String, []) of 1852 {ok, Line, Rest} -> 1853 str2b64_final(Rest, ["\n",Line|Acc]); 1854 {more, Cont} -> 1855 lists:reverse(["\n",str2b64_end(Cont)|Acc]) 1856 end. 1857 1858% 1859 1860str2b64_line(S, []) -> str2b64_line(S, [], 0); 1861str2b64_line(S, {Rest,Acc,N}) -> str2b64_line(Rest ++ S, Acc, N). 1862 1863str2b64_line(S, Out, 76) -> {ok,lists:reverse(Out),S}; 1864str2b64_line([C1,C2,C3|S], Out, N) -> 1865 O1 = e(C1 bsr 2), 1866 O2 = e(((C1 band 16#03) bsl 4) bor (C2 bsr 4)), 1867 O3 = e(((C2 band 16#0f) bsl 2) bor (C3 bsr 6)), 1868 O4 = e(C3 band 16#3f), 1869 str2b64_line(S, [O4,O3,O2,O1|Out], N+4); 1870str2b64_line(S, Out, N) -> 1871 {more,{S,Out,N}}. 1872 1873% 1874 1875str2b64_end({[C1,C2],Out,_N}) -> 1876 O1 = e(C1 bsr 2), 1877 O2 = e(((C1 band 16#03) bsl 4) bor (C2 bsr 4)), 1878 O3 = e((C2 band 16#0f) bsl 2), 1879 lists:reverse(Out, [O1,O2,O3,$=]); 1880str2b64_end({[C1],Out,_N}) -> 1881 O1 = e(C1 bsr 2), 1882 O2 = e((C1 band 16#03) bsl 4), 1883 lists:reverse(Out, [O1,O2,$=,$=]); 1884str2b64_end({[],Out,_N}) -> lists:reverse(Out); 1885str2b64_end([]) -> []. 1886 1887% 1888 1889 1890base64_2_str(Str) -> 1891 b642str(Str, 0, 0, []). 1892 1893b642str([$=|_], Acc, N, Out) -> 1894 case N of 1895 2 -> 1896 %% If I have seen two characters before the = 1897 %% Them I'm encoding one byte 1898 lists:reverse([(Acc bsr 4)|Out]); 1899 3 -> 1900 %% If I have seen three characters before the = 1901 %% Them I'm encoding two bytes 1902 B1 = Acc bsr 10, 1903 B2 = (Acc bsr 2) band 16#ff, 1904 lists:reverse([B2,B1|Out]); 1905 _ -> 1906 exit({bad,b64,N}) 1907 end; 1908b642str([H|T], Acc, N, Out) -> 1909 case d(H) of 1910 no -> 1911 b642str(T, Acc, N, Out); 1912 I -> 1913 Acc1 = (Acc bsl 6) bor I, 1914 case N of 1915 3 -> 1916 B1 = Acc1 bsr 16, 1917 B2 = (Acc1 band 16#ffff) bsr 8, 1918 B3 = (Acc1 band 16#ff), 1919 b642str(T, 0, 0, [B3,B2,B1|Out]); 1920 _ -> 1921 b642str(T, Acc1, N+1, Out) 1922 end 1923 end; 1924b642str([], 0, 0, Out) -> 1925 lists:reverse(Out). 1926 1927d(X) when X >= $A, X =<$Z -> X - $A; 1928d(X) when X >= $a, X =<$z -> X - $a + 26; 1929d(X) when X >= $0, X =<$9 -> X - $0 + 52; 1930d($+) -> 62; 1931d($/) -> 63; 1932d(_) -> no. 1933 1934e(X) when X >= 0, X < 26 -> X + $A; 1935e(X) when X >= 26, X < 52 -> X + $a - 26; 1936e(X) when X >= 52, X < 62 -> X + $0 - 52; 1937e(62) -> $+; 1938e(63) -> $/; 1939e(X) -> erlang:error({badchar,X}). 1940 1941%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1942 1943 1944boundary_date() -> 1945 dat2str_boundary(yaws:date_and_time()). 1946 1947dat2str_boundary([Y1,Y2, Mo, D, H, M, S | _Diff]) -> 1948 lists:flatten( 1949 io_lib:format("~s_~2.2.0w_~s_~w_~2.2.0w:~2.2.0w:~2.2.0w_~w", 1950 [weekday(Y1,Y2,Mo,D), D, int_to_mt(Mo), 1951 y(Y1,Y2),H,M,S,bin2int(crypto:strong_rand_bytes(4))])). 1952 1953bin2int(Bin) -> 1954 lists:foldl(fun(N, Acc) -> Acc * 256 + N end, 0, binary_to_list(Bin)). 1955 1956date_and_time_to_string(DAT) -> 1957 case validate_date_and_time(DAT) of 1958 true -> 1959 dat2str(DAT); 1960 false -> 1961 exit({badarg, {?MODULE, date_and_time_to_string, [DAT]}}) 1962 end. 1963 1964dat2str([Y1,Y2, Mo, D, H, M, S | Diff]) -> 1965 lists:flatten( 1966 io_lib:format("~s, ~2.2.0w ~s ~w ~2.2.0w:~2.2.0w:~2.2.0w", 1967 [weekday(Y1,Y2,Mo,D), D, int_to_mt(Mo), 1968 y(Y1,Y2),H,M,S]) ++ 1969 case Diff of 1970 [Sign,Hd,Md] -> 1971 io_lib:format("~c~2.2.0w~2.2.0w", 1972 [Sign,Hd,Md]); 1973 _ -> [] 1974 end). 1975 1976y(Y1, Y2) -> 256 * Y1 + Y2. 1977 1978weekday(Y1,Y2,Mo,D) -> 1979 int_to_wd(calendar:day_of_the_week(Y1*256+Y2,Mo,D)). 1980 1981int_to_wd(1) -> "Mon"; 1982int_to_wd(2) -> "Tue"; 1983int_to_wd(3) -> "Wed"; 1984int_to_wd(4) -> "Thu"; 1985int_to_wd(5) -> "Fri"; 1986int_to_wd(6) -> "Sat"; 1987int_to_wd(7) -> "Sun". 1988 1989int_to_mt(1) -> "Jan"; 1990int_to_mt(2) -> "Feb"; 1991int_to_mt(3) -> "Mar"; 1992int_to_mt(4) -> "Apr"; 1993int_to_mt(5) -> "May"; 1994int_to_mt(6) -> "Jun"; 1995int_to_mt(7) -> "Jul"; 1996int_to_mt(8) -> "Aug"; 1997int_to_mt(9) -> "Sep"; 1998int_to_mt(10) -> "Oct"; 1999int_to_mt(11) -> "Nov"; 2000int_to_mt(12) -> "Dec". 2001 2002validate_date_and_time([Y1,Y2, Mo, D, H, M, S | Diff]) 2003 when 0 =< Y1, 0 =< Y2, 0 < Mo, Mo < 13, 0 < D, D < 32, 0 =< H, 2004 H < 24, 0 =< M, M < 60, 0 =< S, S < 61 -> 2005 case check_diff(Diff) of 2006 true -> 2007 calendar:valid_date(y(Y1,Y2), Mo, D); 2008 false -> 2009 false 2010 end; 2011validate_date_and_time(_) -> false. 2012 2013check_diff([]) -> true; 2014check_diff([$+, H, M]) when 0 =< H, H < 12, 0 =< M, M < 60 -> true; 2015check_diff([$-, H, M]) when 0 =< H, H < 12, 0 =< M, M < 60 -> true; 2016check_diff(_) -> false. 2017 2018 2019%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2020 2021to_string(Atom) when is_atom(Atom) -> 2022 atom_to_list(Atom); 2023to_string(Integer) when is_integer(Integer) -> 2024 integer_to_list(Integer); 2025to_string(List) -> List. 2026 2027format_error(Reason) -> 2028 [build_toolbar([{"","mail.yaws","Close"}]), 2029 {p, [], {font, [{size,4},{color,red}],["Error: ", Reason]}}]. 2030 2031format_message(Session, Message, MailNr, Depth) -> 2032 {HeadersList,Msg} = parse_message(Message), 2033 H = parse_headers(HeadersList), 2034 Headers = [[Head,$\n] || Head <- HeadersList], 2035 Formated = format_body(Session, H, Msg, Depth), 2036 Quoted = quote_format(Session, H, Msg), 2037 To = lists:flatten(decode(H#mail.to)), 2038 From = lists:flatten(decode(H#mail.from)), 2039 Subject = lists:flatten(decode(H#mail.subject)), 2040 CC = lists:flatten(decode(H#mail.cc)), 2041 ToolBar = 2042 if 2043 MailNr == -1 -> 2044 [{"tool-newmail.gif", "javascript:setCmd('reply');", "Reply"}]; 2045 MailNr == attachment -> 2046 [{"../tool-newmail.gif", "javascript:setCmd('reply');", 2047 "Reply"}]; 2048 true -> 2049 [{"tool-newmail.gif","compose.yaws","New"}, 2050 {"tool-newmail.gif", "javascript:setCmd('reply');", "Reply"}, 2051 {"","javascript:changeActive("++Depth++");", 2052 "<div id='msg-button:"++Depth++ 2053 "' style='display: block;'>Headers</div>" 2054 "<div id='hdr-button:"++Depth++ 2055 "' style='display: none;' >Message</div>" 2056 }, 2057 {"tool-delete.gif","javascript:setCmd('delete');", "Delete"}, 2058 {"","mail.yaws","Close"}] 2059 end, 2060 Action = 2061 if 2062 MailNr == attachment -> 2063 "../reply.yaws"; 2064 true -> 2065 "reply.yaws" 2066 end, 2067 2068 [{form, [{name,compose},{action,Action},{method,post}], 2069 [build_toolbar(ToolBar), 2070 {table,[{width,645},{height,"100%"},{border,0},{bgcolor,silver}, 2071 {cellspacing,0},{callpadding,0}], 2072 {tr,[],{td,[{valign,top},{height,"1%"}], 2073 [{table, 2074 [{border,0},{cellspacing,0},{cellpadding,0},{width,"100%"}, 2075 {bgcolor,silver}], 2076 [{tr,[], 2077 [{td,[{valign,middle},{align,left},{width,"15%"}, 2078 {height,25}], 2079 {font, [{color,"#000000"},{size,2}], 2080 {nobr,[]," From: "}}}, 2081 {td, [{valign,middle},{align,left}], 2082 {font, [{color,"#000000"},{size,2}], 2083 [" ", 2084 unquote(From)]}}, 2085 {td,[{valign,middle},{align,right},{height,"25"}], 2086 {font, [{color,"#000000"},{size,2}], 2087 {nobr,[]," Sent: "}}}, 2088 {td, [nowrap,{valign,middle},{align,right}, 2089 {width,"30%"}], 2090 {font, [{color,"#000000"},{size,2}], 2091 " "++H#mail.date}}]}, 2092 {tr,[], 2093 [{td,[{valign,top},{align,left},{width,"15%"}, 2094 {height,25}], 2095 {font, [{color,"#000000"},{size,2}], 2096 {nobr,[]," To: "}}}, 2097 {td, [{valign,top},{align,left},{width,"100%"}], 2098 {font, [{color,"#000000"},{size,2}], 2099 [" ", 2100 unquote(To)]}}]}, 2101 {tr,[], 2102 [{td,[{valign,middle},{align,left},{width,"15%"}, 2103 {height,25}], 2104 {font, [{color,"#000000"},{size,2}], 2105 {nobr,[]," Cc: "}}}, 2106 {td, [{valign,middle},{align,left},{width,"100%"}], 2107 {font, [{color,"#000000"},{size,2}], 2108 [" ",CC]}}]}, 2109 {tr,[], 2110 [{td,[{valign,middle},{align,left},{width,"15%"}, 2111 {height,25}], 2112 {font, [{color,"#000000"},{size,2}], 2113 {nobr,[]," Subject: "}}}, 2114 {td, [{valign,middle},{align,left},{width,"100%"}], 2115 {font, [{color,"#000000"},{size,2}], 2116 [" ",Subject]}}]} 2117 ]}, 2118 {table, [{width,"100%"},{border,1},{cellpadding,6}, 2119 {class,msgbody}], 2120 [{tr,[], 2121 {td,[{width,"100%"},{height,300},{valign,top}, 2122 {bgcolor,white}], 2123 {p,[],{font,[{size,3},{id, contents}], 2124 [ 2125 {'div', [{id,"msg-body:msg"++Depth}, 2126 {class,"msg-body"}, 2127 {style,"display: block;"}], 2128 Formated 2129 }, 2130 {'div', [{id,"msg-body:hdr"++Depth}, 2131 {class,"msg-body"}, 2132 {style, "display: none;"}], 2133 {pre, [], Headers} 2134 } 2135 ] 2136 } 2137 } 2138 } 2139 } 2140 ] 2141 } 2142 ] 2143 } 2144 } 2145 }] ++ 2146 if 2147 MailNr == -1 -> []; 2148 true -> 2149 [{input,[{type,hidden},{name,nr}, {value,MailNr}],[]}] 2150 end++ 2151 [{input,[{type,hidden},{name,from}, 2152 {check,value,yaws_api:url_encode(From)}],[]}, 2153 {input,[{type,hidden},{name,to}, 2154 {check,value,yaws_api:url_encode(To)}],[]}, 2155 {input,[{type,hidden},{name,cc}, 2156 {check,value,yaws_api:url_encode(CC)}],[]}, 2157 {input,[{type,hidden},{name,bcc}, 2158 {check,value,yaws_api:url_encode(decode(H#mail.bcc))}],[]}, 2159 {input,[{type,hidden},{name,subject}, 2160 {check,value,yaws_api:url_encode(Subject)}],[]}, 2161 {input,[{type,hidden},{name,quote}, 2162 {check,value,yaws_api:url_encode(Quoted)}],[]}, 2163 {input,[{type,hidden},{name,cmd},{value,""}],[]} 2164 ] 2165 }]. 2166 2167select_alt_body([], [First|_]) -> First; 2168select_alt_body([Prefered|Rest], Bodies) -> 2169 case [Body || Body <- Bodies, has_body_type(Prefered,Body)] of 2170 [] -> 2171 select_alt_body(Rest, Bodies); 2172 [First|_] -> 2173 First 2174 end. 2175 2176has_body_type(Type, {H,_B}) -> 2177 case H#mail.content_type of 2178 {CT, _Ops} -> 2179 CTL = lowercase(CT), 2180 CTL == Type; 2181 _ -> false 2182 end. 2183 2184format_body(Session, H, Msg, Depth) -> 2185 ContentType = 2186 case H#mail.content_type of 2187 {CT,Ops} -> {lowercase(CT), Ops}; 2188 Other -> Other 2189 end, 2190 case {ContentType,H#mail.transfer_encoding} of 2191 {{"text/html",_}, Encoding} -> 2192 Decoded = decode_message(Encoding, Msg), 2193 Decoded; 2194 {{"text/plain",_}, Encoding} -> 2195 Decoded = decode_message(Encoding, Msg), 2196 {pre, [], yaws_api:htmlize(wrap_text(Decoded, 80))}; 2197 {{"multipart/mixed",Opts}, _Encoding} -> 2198 {value, {_,Boundary}} = lists:keysearch("boundary",1,Opts), 2199 [{Headers,Body}|Parts] = parse_multipart(Msg, Boundary), 2200 PartHeaders = 2201 lists:foldl(fun({K,V},MH) -> 2202 add_header(K,V,MH) 2203 end, #mail{}, Headers), 2204 [format_body(Session, PartHeaders, Body, Depth++".1"), 2205 format_attachments(Session, Parts, Depth)]; 2206 {{"multipart/alternative",Opts}, _Encoding} -> 2207 {value, {_,Boundary}} = lists:keysearch("boundary",1,Opts), 2208 Parts = parse_multipart(Msg, Boundary), 2209 HParts = 2210 lists:map( 2211 fun({Head,Body}) -> 2212 NewHead = 2213 lists:foldl(fun({K,V},MH) -> 2214 add_header(K,V,MH) 2215 end, #mail{}, Head), 2216 {NewHead, Body} 2217 end, Parts), 2218 {H1,B1} = select_alt_body(["text/html","text/plain"],HParts), 2219 format_body(Session, H1,B1,Depth++".1"); 2220 {{"multipart/signed",Opts}, _Encoding} -> 2221 {value, {_,Boundary}} = lists:keysearch("boundary",1,Opts), 2222 [{Headers,Body}|_Parts] = parse_multipart(Msg, Boundary), 2223 PartHeaders = 2224 lists:foldl(fun({K,V},MH) -> 2225 add_header(K,V,MH) 2226 end, #mail{}, Headers), 2227 format_body(Session, PartHeaders, Body, Depth++".1"); 2228 {{"message/rfc822",_Opts}, Encoding} -> 2229 Decoded = decode_message(Encoding, Msg), 2230 format_message(Session, Decoded, -1, Depth); 2231 {{ContT="application/"++_,_Opts},Encoding} -> 2232 B1 = decode_message(Encoding, Msg), 2233 B = list_to_binary(B1), 2234 FileName = decode(extraxt_h_info(H)), 2235 Cookie = Session#session.cookie, 2236 mail_session_manager ! {session_set_attach_data, 2237 self(), Cookie, FileName, ContT, B}, 2238 2239 receive 2240 {session_manager, Num} -> 2241 [{table,[{bgcolor, "lightgrey"}], 2242 [ 2243 {tr,[], {td, [], {h5,[], "Attachments:"}}}, 2244 {tr, [], 2245 {td, [], 2246 {table, [], 2247 [{tr,[], 2248 {td,[], 2249 {a, [{href,io_lib:format( 2250 "attachment/~s?nr=~w", 2251 [yaws_api:url_encode(FileName), 2252 Num])}], 2253 FileName}}}]}}}]}] 2254 after 10000 -> 2255 [] 2256 end; 2257 {_,_} -> 2258 {pre, [], yaws_api:htmlize(wrap_text(Msg, 80))} 2259 end. 2260 2261quote_format(Session, H, Msg) -> 2262 Text = quote_format_body(Session, H, Msg), 2263 From = lists:flatten(decode(H#mail.from)), 2264 include_quote(Text, From). 2265 2266quote_format_body(Session, H,Msg) -> 2267 ContentType = 2268 case H#mail.content_type of 2269 {CT,Ops} -> {lowercase(CT), Ops}; 2270 Other -> Other 2271 end, 2272 case {ContentType,H#mail.transfer_encoding} of 2273 {{"text/html",_}, Encoding} -> 2274 Decoded = decode_message(Encoding, Msg), 2275 wrap_text(mail_html:html_to_text(Decoded), 78); 2276 {{"text/plain",_}, Encoding} -> 2277 Decoded = decode_message(Encoding, Msg), 2278 wrap_text(Decoded, 78); 2279 {{"multipart/mixed",Opts}, _Encoding} -> 2280 {value, {_,Boundary}} = lists:keysearch("boundary",1,Opts), 2281 [{Headers,Body}|_Parts] = parse_multipart(Msg, Boundary), 2282 PartHeaders = 2283 lists:foldl(fun({K,V},MH) -> 2284 add_header(K,V,MH) 2285 end, #mail{}, Headers), 2286 quote_format_body(Session, PartHeaders, Body); 2287 {{"multipart/alternative",Opts}, _Encoding} -> 2288 {value, {_,Boundary}} = lists:keysearch("boundary",1,Opts), 2289 Parts = parse_multipart(Msg, Boundary), 2290 HParts = 2291 lists:map( 2292 fun({Head,Body}) -> 2293 NewHead = 2294 lists:foldl(fun({K,V},MH) -> 2295 add_header(K,V,MH) 2296 end, #mail{}, Head), 2297 {NewHead, Body} 2298 end, Parts), 2299 {H1,B1} = select_alt_body(["text/plain","text/html"], HParts), 2300 quote_format_body(Session, H1,B1); 2301 {{"multipart/signed",Opts}, _Encoding} -> 2302 {value, {_,Boundary}} = lists:keysearch("boundary",1,Opts), 2303 [{Headers,Body}|_Parts] = parse_multipart(Msg, Boundary), 2304 PartHeaders = 2305 lists:foldl(fun({K,V},MH) -> 2306 add_header(K,V,MH) 2307 end, #mail{}, Headers), 2308 quote_format_body(Session, PartHeaders, Body); 2309 {{"message/rfc822",_},_} -> 2310 ""; 2311 {{"application/"++_,_},_} -> 2312 ""; 2313 {_,_} -> 2314 wrap_text(Msg, 78) 2315 end. 2316 2317include_quote(Text, From) -> 2318 {Quoted, _} = include_quote(Text, [], ">", nl), 2319 From++" wrote: \n"++lists:reverse(Quoted). 2320 2321include_quote([], Acc, _Prefix, State) -> 2322 {Acc, State}; 2323include_quote([L|Text], Acc, Prefix, State) when is_list(L) -> 2324 {Acc1, State1} = include_quote(L, Acc, Prefix, State), 2325 include_quote(Text, Acc1, Prefix, State1); 2326include_quote(Text, Acc, Prefix, nl) -> 2327 case lists:prefix(Prefix, Text) of 2328 true -> 2329 include_quote(Text, Prefix++Acc, Prefix, body); 2330 false -> 2331 include_quote(Text, [$ |Prefix++Acc], Prefix, body) 2332 end; 2333include_quote([$\n|Text], Acc, Prefix, body) -> 2334 include_quote(Text, [$\n|Acc], Prefix, nl); 2335include_quote([C|Text], Acc, Prefix, body) -> 2336 include_quote(Text, [C|Acc], Prefix, body). 2337 2338format_attachments(_S, [], _Depth) -> []; 2339format_attachments(S, Bs, Depth) -> 2340 [{table,[{bgcolor, "lightgrey"}], 2341 [ 2342 {tr,[], {td, [], {h5,[], "Attachments:"}}}, 2343 {tr, [], {td, [], {table, [], format_attach(S, Bs, Depth)}}}]}]. 2344 2345format_attach(_S, [], _Depth) -> 2346 []; 2347format_attach(S, [{Headers,B0}|Bs], Depth) -> 2348 H = lists:foldl(fun({K,V},MH) -> add_header(K,V,MH) end, #mail{}, Headers), 2349 Cookie = S#session.cookie, 2350 FileName = decode(extraxt_h_info(H)), 2351 HttpCtype = 2352 case H#mail.content_type of 2353 undefined -> 2354 yaws_api:mime_type(FileName); 2355 {ContType,_Opts} -> 2356 case lowercase(ContType) of 2357 "text/"++_ -> 2358 yaws_api:mime_type(FileName); 2359 "application/octet-stream" -> 2360 yaws_api:mime_type(FileName); 2361 CT -> 2362 CT 2363 end; 2364 _ -> 2365 yaws_api:mime_type(FileName) 2366 end, 2367 B1 = decode_message(H#mail.transfer_encoding, B0), 2368 B = list_to_binary(B1), 2369 mail_session_manager ! {session_set_attach_data, self(), Cookie, 2370 FileName, HttpCtype, B}, 2371 receive 2372 {session_manager, Num} -> 2373 [{tr,[],{td,[], 2374 [{a, [{href,io_lib:format("attachment/~s?nr=~w", 2375 [yaws_api:url_encode(FileName), 2376 Num])}], 2377 FileName}, 2378 " (", 2379 {a, [{href,io_lib:format("attachment/~s?form=text&" 2380 "nr=~w", 2381 [yaws_api:url_encode(FileName), 2382 Num])}],"text"}, 2383 ")"]}} | 2384 format_attach(S, Bs, Depth)] 2385 after 10000 -> 2386 format_attach(S, Bs, Depth) 2387 end. 2388 2389extraxt_h_info(H) -> 2390 L = case {H#mail.content_type, H#mail.content_disposition} of 2391 {undefined, undefined} -> 2392 []; 2393 {undefined, {_, LL}} -> 2394 LL; 2395 {{_,LL}, undefined} -> 2396 LL; 2397 {{_,L1}, {_,L2}} -> 2398 L1 ++ L2 2399 end, 2400 case lists:keysearch("filename", 1, L) of 2401 false -> 2402 "attachment.txt"; 2403 {value, {_, FN}} -> 2404 FN 2405 end. 2406 2407 2408decode_message("7bit"++_, Msg) -> Msg; 2409decode_message("8bit"++_, Msg) -> Msg; 2410decode_message("base64"++_, Msg) -> 2411 case catch base64_2_str(lists:flatten(Msg)) of 2412 {'EXIT', _} -> Msg; 2413 Decoded -> Decoded 2414 end; 2415decode_message("quoted-printable"++_, Msg) -> 2416 case catch quoted_2_str(lists:flatten(Msg)) of 2417 {'EXIT', Reason} -> 2418 io:format("failed to decode quoted-printable ~p\n", [Reason]), 2419 Msg; 2420 Decoded -> Decoded 2421 end; 2422decode_message(_, Msg) -> Msg. 2423 2424 2425quoted_2_str(Msg) -> 2426 quoted_2_str(Msg, []). 2427 2428quoted_2_str([], Acc) -> 2429 lists:reverse(Acc); 2430quoted_2_str([$=,$\r,$\n|Rest], Acc) -> 2431 quoted_2_str_scan(Rest,Acc); 2432quoted_2_str([$=,H1,H2|Rest], Acc) -> 2433 case catch yaws:hex_to_integer([H1,H2]) of 2434 {'EXIT', _} -> 2435 quoted_2_str(Rest, [H2,H1,$=|Acc]); 2436 C -> 2437 quoted_2_str(Rest, [C|Acc]) 2438 end; 2439quoted_2_str([$\r,$\n|Rest], Acc) -> 2440 quoted_2_str_scan(Rest, [$\n|Acc]); 2441quoted_2_str([C|Cs], Acc) -> 2442 quoted_2_str(Cs, [C|Acc]). 2443 2444quoted_2_str_scan([$ |Rest], Acc) -> 2445 quoted_2_str_scan(Rest, Acc); 2446quoted_2_str_scan([$\t|Rest], Acc) -> 2447 quoted_2_str_scan(Rest, Acc); 2448quoted_2_str_scan([$\v|Rest], Acc) -> 2449 quoted_2_str_scan(Rest, Acc); 2450quoted_2_str_scan(Rest, Acc) -> 2451 quoted_2_str(Rest, Acc). 2452 2453%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2454% 2455 2456 2457parse_multipart(Data, Boundary) -> 2458 Res = parse_multipart(Data, Boundary, []), 2459 process_parts(Res, [], [], []). 2460 2461parse_multipart([], _State, Res) -> 2462 Res; 2463parse_multipart([D|Ds], State, Res) -> 2464 case yaws_api:parse_multipart(D, State) of 2465 {cont, Cont, NewRes} -> 2466 parse_multipart(Ds, Cont, Res++NewRes); 2467 {result, NewRes} -> 2468 Res++NewRes 2469 end. 2470 2471process_parts([], [], [], Res) -> 2472 lists:reverse(Res); 2473process_parts([{head,{Headers}}|Ps], [], [], Res) -> 2474 process_parts(Ps, Headers, [], Res); 2475process_parts([{body,_B}|Ps], [], _Body, Res) -> % ignore headless body 2476 process_parts(Ps, [], [], Res); 2477process_parts([{body,B}|Ps], Head, Body, Res) -> 2478 process_parts(Ps, [], [], [{Head, lists:reverse([B|Body])}|Res]); 2479process_parts([{part_body,B}|Ps], Head, Body, Res) -> 2480 process_parts(Ps, Head, [B|Body], Res). 2481 2482%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2483% 2484% The text to wrap may be arbitrarily nested. We deal with this 2485% without flattening the whole thing. 2486% 2487 2488wrap_text(Text, Max) -> 2489 wrap_text(Text, [], [], [], 0, Max, []). 2490 2491%% wrap_text(Text, ContText, PendingWord, PendingSpace, CurrentCol, WrapCol, Acc) 2492 2493wrap_text([], [], Unwrapped, Space, Col, Max, Acc) -> 2494 if 2495 Col < Max -> 2496 lists:reverse(Acc,add_space(Space,lists:reverse(Unwrapped))); 2497 true -> 2498 lists:reverse(Acc, [$\n|lists:reverse(Unwrapped)]) 2499 end; 2500 2501wrap_text([], Cont, Unwrapped, Space, Col, Max, Acc) -> 2502 wrap_text(Cont, [], Unwrapped, Space, Col, Max, Acc); 2503 2504wrap_text([L|Rest], [], Unwrapped, Space, Col, Max, Acc) when is_list(L) -> 2505 wrap_text(L, Rest, Unwrapped, Space, Col, Max, Acc); 2506 2507wrap_text([L|Rest], Cont, Unwrapped, Space, Col, Max, Acc) when is_list(L) -> 2508 wrap_text(L, [Rest|Cont], Unwrapped, Space, Col, Max, Acc); 2509 2510wrap_text([C|Rest], Cont, Unwrapped, Space, Col, Max, Acc) when Col < Max -> 2511 case char_class(C) of 2512 space -> 2513 wrap_text(Rest, Cont, [], C, Col+1, Max, 2514 Unwrapped++add_space(Space,Acc)); 2515 tab -> 2516 wrap_text(Rest, Cont, [], C, Col+8, Max, 2517 Unwrapped++add_space(Space,Acc)); 2518 nl -> 2519 wrap_text(Rest, Cont, [], [], 0, Max, 2520 [C|Unwrapped++add_space(Space,Acc)]); 2521 text -> 2522 wrap_text(Rest, Cont, [C|Unwrapped], Space, Col+1, Max, Acc) 2523 end; 2524 2525wrap_text([C|Rest], Cont, Unwrapped, Space, Col, Max, Acc) when Col >= Max -> 2526 case char_class(C) of 2527 space -> 2528 wrap_text(Rest, Cont, [], C, length(Unwrapped), Max, 2529 Unwrapped++[$\n|Acc]); 2530 tab -> 2531 wrap_text(Rest, Cont, [], C, length(Unwrapped), Max, 2532 Unwrapped++[$\n|Acc]); 2533 nl -> 2534 wrap_text(Rest, Cont, [], [], length(Unwrapped), Max, 2535 Unwrapped++[$\n|Acc]); 2536 text -> 2537 wrap_text(Rest, Cont, [C|Unwrapped], Space, Col+1, Max, Acc) 2538 end. 2539 2540add_space([], Text) -> 2541 Text; 2542add_space(C, Text) -> 2543 [C|Text]. 2544 2545char_class($\n) -> nl; 2546char_class($\r) -> nl; 2547char_class($ ) -> space; 2548char_class($\t) -> tab; 2549char_class(_O) -> text. 2550 2551%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2552 2553sleep(X) -> 2554 receive 2555 xxxxxxx -> ok 2556 after 2557 X -> ok 2558 end. 2559 2560 2561%%%%%%%%%%%%%%%%%%%%%% read cfg file %%%%%%%%%%%%%%%%%% 2562%% def for root is: /etc/mail/yaws-webmail.conf 2563 2564-ifndef(ETCDIR). 2565-define(ETCDIR, "/etc"). 2566-endif. 2567 2568read_config() -> 2569 Paths = case yaws:getuid() of 2570 {ok, "0"} -> 2571 [?ETCDIR++"/mail/yaws-webmail.conf"]; 2572 _ -> 2573 [filename:join([os:getenv("HOME"),"yaws-webmail.conf"]), 2574 "./yaws-webmail.conf", 2575 ?ETCDIR++"/mail/yaws-webmail.conf"] 2576 end, 2577 case yaws:first(fun(F) -> yaws:exists(F) end, Paths) of 2578 false -> 2579 error_logger:info_msg("yaws webmail: Can't find no config file .. " 2580 "using defaults",[]), 2581 #cfg{}; 2582 {ok, _, File} -> 2583 read_config(File) 2584 end. 2585 2586read_config(File) -> 2587 error_logger:info_msg("Yaws webmail: Using config file ~s~n", [File]), 2588 case file:open(File, [read]) of 2589 {ok, FD} -> 2590 read_config(FD, #cfg{}, 1, io:get_line(FD, '')); 2591 _Err -> 2592 error_logger:info_msg("Yaws webmail: Can't open config file ... " 2593 "using defaults",[]), 2594 #cfg{} 2595 end. 2596 2597read_config(FD, Cfg, _Lno, eof) -> 2598 file:close(FD), 2599 Cfg; 2600read_config(FD, Cfg, Lno, Chars) -> 2601 Next = io:get_line(FD, ''), 2602 case yaws_config:toks(Lno, Chars) of 2603 [] -> 2604 read_config(FD, Cfg, Lno+1, Next); 2605 ["ttl", '=', IntList] -> 2606 case (catch list_to_integer(IntList)) of 2607 {'EXIT', _} -> 2608 error_logger:info_msg("Yaws webmail: expect integer at " 2609 "line ~p", [Lno]), 2610 read_config(FD, Cfg, Lno+1, Next); 2611 Int -> 2612 read_config(FD, Cfg#cfg{ttl = Int}, Lno+1, Next) 2613 end; 2614 ["popserver", '=', Server] -> 2615 read_config(FD, Cfg#cfg{popserver = Server}, Lno+1, Next); 2616 2617 ["smtpserver", '=', Domain] -> 2618 read_config(FD, Cfg#cfg{smtpserver = Domain}, Lno+1, Next); 2619 ["maildomain", '=', Domain] -> 2620 read_config(FD, Cfg#cfg{maildomain = Domain}, Lno+1, Next); 2621 ["sendtimeout", '=', IntList] -> 2622 case (catch list_to_integer(IntList)) of 2623 {'EXIT', _} -> 2624 error_logger:info_msg("Yaws webmail: expect integer at " 2625 "line ~p", [Lno]), 2626 read_config(FD, Cfg, Lno+1, Next); 2627 Int -> 2628 read_config(FD, Cfg#cfg{sendtimeout = Int}, Lno+1, Next) 2629 end; 2630 [H|_] -> 2631 error_logger:info_msg("Yaws webmail: Unexpected tokens ~p at " 2632 "line ~w", [H, Lno]), 2633 read_config(FD, Cfg, Lno+1, Next) 2634 end. 2635 2636%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2637 2638-record(date, {year, month, day, hours, minutes, seconds}). 2639 2640parse_date([]) -> []; 2641parse_date(Date) -> 2642 D = parse_date(Date, #date{}), 2643 if 2644 is_integer(D#date.year),is_integer(D#date.month), 2645 is_integer(D#date.day),is_integer(D#date.hours), 2646 is_integer(D#date.minutes),is_integer(D#date.seconds) -> 2647 {{D#date.year, D#date.month, D#date.day}, 2648 {D#date.hours, D#date.minutes, D#date.seconds}}; 2649 true -> error 2650 end. 2651 2652parse_date([], D) -> D; 2653parse_date([D|Ds], Date) -> 2654 case char_type(D) of 2655 space -> parse_date(Ds, Date); 2656 alpha when Date#date.month == undefined -> 2657 case is_month(lowercase([D|Ds])) of 2658 false -> 2659 parse_date(Ds, Date); 2660 {true, M, Rest} -> 2661 parse_date(Rest, Date#date{month=M}) 2662 end; 2663 alpha -> 2664 parse_date(Ds, Date); 2665 digit -> 2666 case parse_time([D|Ds]) of 2667 error -> 2668 {Number,Rest} = get_number([D|Ds], 0), 2669 if 2670 Number < 32, Date#date.day == undefined -> 2671 parse_date(Rest, Date#date{day=Number}); 2672 Number < 50, Date#date.year == undefined -> 2673 parse_date(Rest, Date#date{year=Number+2000}); 2674 Number < 100, Date#date.year == undefined -> 2675 parse_date(Rest, Date#date{year=Number+1900}); 2676 Number > 1900, Date#date.year == undefined -> 2677 parse_date(Rest, Date#date{year=Number}); 2678 true -> 2679 parse_date(Rest, Date) 2680 end; 2681 {Hours, Minutes, Seconds, Rest} -> 2682 parse_date(Rest, Date#date{hours=Hours, 2683 minutes=Minutes, 2684 seconds=Seconds}) 2685 end; 2686 _ -> 2687 parse_date(Ds, Date) 2688 end. 2689 2690is_month("jan"++Rest) -> {true, 1, Rest}; 2691is_month("feb"++Rest) -> {true, 2, Rest}; 2692is_month("mar"++Rest) -> {true, 3, Rest}; 2693is_month("apr"++Rest) -> {true, 4, Rest}; 2694is_month("may"++Rest) -> {true, 5, Rest}; 2695is_month("jun"++Rest) -> {true, 6, Rest}; 2696is_month("jul"++Rest) -> {true, 7, Rest}; 2697is_month("aug"++Rest) -> {true, 8, Rest}; 2698is_month("sep"++Rest) -> {true, 9, Rest}; 2699is_month("oct"++Rest) -> {true, 10, Rest}; 2700is_month("nov"++Rest) -> {true, 11, Rest}; 2701is_month("dec"++Rest) -> {true, 12, Rest}; 2702is_month(_) -> false. 2703 2704enc_month(1) -> "Jan"; 2705enc_month(2) -> "Feb"; 2706enc_month(3) -> "Mar"; 2707enc_month(4) -> "Apr"; 2708enc_month(5) -> "May"; 2709enc_month(6) -> "Jun"; 2710enc_month(7) -> "Jul"; 2711enc_month(8) -> "Aug"; 2712enc_month(9) -> "Sep"; 2713enc_month(10) -> "Oct"; 2714enc_month(11) -> "Nov"; 2715enc_month(12) -> "Dec". 2716 2717char_type(D) when D>=$a, D=<$z -> alpha; 2718char_type(D) when D>=$A, D=<$Z -> alpha; 2719char_type(D) when D>=$0, D=<$9 -> digit; 2720char_type($\ ) -> space; 2721char_type($\n) -> space; 2722char_type($\t) -> space; 2723char_type($\v) -> space; 2724char_type(_) -> unknown. 2725 2726get_number([D|Ds], N) when D>=$0, D=<$9 -> 2727 get_number(Ds, N*10+(D-$0)); 2728get_number(Rest, N) -> {N, Rest}. 2729 2730parse_time(Time) -> 2731 F = fun() -> 2732 {Hour,[$:|R1]} = get_number(Time, 0), 2733 {Minutes,[$:|R2]} = get_number(R1, 0), 2734 {Seconds,R3} = get_number(R2, 0), 2735 {Hour, Minutes, Seconds, R3} 2736 end, 2737 case catch F() of 2738 {Hour, Minutes, Seconds, Rest} when is_integer(Hour), 2739 is_integer(Minutes), 2740 is_integer(Seconds) -> 2741 {Hour, Minutes, Seconds, Rest}; 2742 _ -> error 2743 end. 2744 2745format_date({{Year,Month,Day},{Hour,Minutes,Seconds}}) -> 2746 M = enc_month(Month), 2747 io_lib:format("~2..0w ~s ~4..0w ~2..0w:~2..0w:~2..0w", 2748 [Day, M, Year, Hour, Minutes, Seconds]); 2749format_date(Seconds) when is_integer(Seconds) -> 2750 Zero = calendar:datetime_to_gregorian_seconds({{1970,1,1},{0,0,0}}), 2751 Time = Zero + Seconds, 2752 Date = calendar:gregorian_seconds_to_datetime(Time), 2753 format_date(Date); 2754format_date([]) -> []; 2755format_date(error) -> []. 2756 2757send_attachment(Session, Number) -> 2758 mail_session_manager ! {session_get_attach_data, self(), 2759 Session#session.cookie, Number}, 2760 receive 2761 {session_manager, error} -> 2762 none; 2763 {session_manager, A} -> 2764 case A#satt.ctype of 2765 "message/rfc822" -> 2766 Message = binary_to_list(A#satt.data), 2767 Formated = format_message(Session, [Message], 2768 attachment, "1"), 2769 (dynamic_headers() ++ 2770 [{ehtml, 2771 [{script,[{src,"../mail.js"}], []}, 2772 {style, [{type,"text/css"}], 2773 ".conts { visibility:hidden }\n" 2774 "A:link { color: 0;text-decoration: none}\n" 2775 "A:visited { color: 0;text-decoration: none}\n" 2776 "A:active { color: 0;text-decoration: none}\n" 2777 "DIV.msg-body { background: white; }\n" 2778 }, 2779 {body,[{bgcolor,silver}, 2780 {marginheight,0},{topmargin,0},{leftmargin,0}, 2781 {rightmargin,0},{marginwidth,0}], 2782 [{table, [{border,0},{bgcolor,"c0c000"}, 2783 {cellspacing,0}, 2784 {width,"100%"}], 2785 {tr,[],{td,[{nowrap,true},{align,left}, 2786 {valign,middle}], 2787 {font, [{size,6},{color,black}], 2788 "Attachment"}}}}] ++ 2789 Formated 2790 } 2791 ]}]); 2792 _ -> 2793 {content, A#satt.ctype, A#satt.data} 2794 end 2795 after 15000 -> 2796 exit(normal) 2797 end. 2798 2799% 2800 2801send_attachment_plain(Session, Number) -> 2802 mail_session_manager ! {session_get_attach_data, self(), 2803 Session#session.cookie, Number}, 2804 receive 2805 {session_manager, error} -> 2806 none; 2807 {session_manager, A} -> 2808 {content, "text/plain", A#satt.data} 2809 after 15000 -> 2810 exit(normal) 2811 end. 2812 2813% 2814 2815basename(FilePath) -> 2816 case string:rchr(FilePath, $\\) of 2817 0 -> 2818 %% probably not a DOS name 2819 filename:basename(FilePath); 2820 N -> 2821 %% probably a DOS name, remove everything after last \ 2822 basename(string:substr(FilePath, N+1)) 2823 end. 2824 2825 2826%% 2827 2828getopt(Key, KeyList) -> 2829 getopt(Key, KeyList, undefined). 2830 2831getopt(Key, KeyList, Default) -> 2832 case lists:keysearch(Key, 1, KeyList) of 2833 false -> 2834 Default; 2835 {value, Tuple} -> 2836 Val = element(2,Tuple), 2837 if 2838 Val == undefined -> Default; 2839 true -> Val 2840 end 2841 end. 2842 2843%% 2844 2845content_type(FileName) -> 2846 case yaws_api:mime_type(FileName) of 2847 "text/plain" -> 2848 "application/octet-stream"; 2849 Type -> 2850 Type 2851 end. 2852 2853%% 2854 2855%% State = 2856 2857find_dot(Data, State) -> 2858 find_dot(State, Data, []). 2859 2860find_dot(State, [], _Acc) -> 2861 {more, State}; 2862 2863find_dot(0, [$\r|R], Acc) -> 2864 find_dot(1, R, [$\r|Acc]); 2865find_dot(0, [C|R], Acc) -> 2866 find_dot(1, R, [C|Acc]); 2867 2868find_dot(1, [$\n|R], Acc) -> 2869 find_dot(2, R, [$\n|Acc]); 2870find_dot(1, R, Acc) -> 2871 find_dot(0, R, Acc); 2872 2873find_dot(2, [$.|R], Acc) -> 2874 find_dot(3, R, [$\.|Acc]); 2875find_dot(2, R, Acc) -> 2876 find_dot(0, R, Acc); 2877 2878find_dot(3, [$\r|R], Acc) -> 2879 find_dot(4, R, [$\r|Acc]); 2880find_dot(3, R, Acc) -> 2881 find_dot(0, R, Acc); 2882 2883find_dot(4, [$\n|R], Acc) -> 2884 {ok, 0, lists:reverse(Acc), R}; 2885find_dot(4, R, Acc) -> 2886 find_dot(0, R, Acc). 2887 2888