From 8f25b2ecdb7c7faf4d89a52f1beb206aeebc3e71 Mon Sep 17 00:00:00 2001 From: spiralvoice Date: Sun, 19 Dec 2010 10:31:21 +0000 Subject: [PATCH] patch #7418 --- config/Makefile.in | 7 +- distrib/ChangeLog | 3 + src/daemon/common/commonInteractive.ml | 20 ++-- src/daemon/common/commonOptions.ml | 12 ++- src/daemon/driver/driverCommands.ml | 2 + src/utils/net/mailer.ml | 167 +++++++++++++++++++++++---------- tools/tests.ml | 9 ++ 7 files changed, 157 insertions(+), 63 deletions(-) diff --git a/config/Makefile.in b/config/Makefile.in index 3e81b269..5edbf1c3 100644 --- a/config/Makefile.in +++ b/config/Makefile.in @@ -209,7 +209,7 @@ MAGIC_SRCS += $(LIB)/magic.ml NET_SRCS = \ $(NET)/basicSocket.ml \ - $(NET)/ip.ml $(NET)/ip_set.ml $(NET)/geoip.ml $(NET)/mailer.ml $(NET)/base64.ml \ + $(NET)/ip.ml $(NET)/ip_set.ml $(NET)/geoip.ml $(NET)/base64.ml $(NET)/mailer.ml \ $(NET)/anyEndian.ml $(NET)/bigEndian.ml $(NET)/littleEndian.ml \ $(NET)/tcpBufferedSocket.ml \ $(NET)/tcpServerSocket.ml \ @@ -590,7 +590,7 @@ endif MLNET_SRCS+= $(MAIN_SRCS) MLNET_CMXA=extlib.cmxa $(CDK_CMXA) $(BITSTRING_CMXA) magic.cmxa common.cmxa client.cmxa core.cmxa driver.cmxa -TESTS_CMXA=$(CDK_CMXA) magic.cmxa common.cmxa client.cmxa core.cmxa +TESTS_CMXA=extlib.cmxa $(CDK_CMXA) $(BITSTRING_CMXA) magic.cmxa common.cmxa client.cmxa core.cmxa TESTS_SRCS=tools/tests.ml ifeq ("$(GUI)", "newgui2") @@ -1374,7 +1374,7 @@ EXPAND(BTVIEW,btview) EXPAND(CLUSTER,cluster) EXPAND(TESTRSS,testrss) EXPAND(SVG_CONVERTER,svg_converter) -EXPAND(TESTS,tests) +EXPAND(TESTS,tests,NO,MLNET,GD,CRYPTOPP,MAGIC,BITSTRING,UPNP_NATPMP) ####################################################################### @@ -1464,6 +1464,7 @@ clean: rm -f mlfasttrack mlfasttrack+gui mlfasttrack.exe rm -f svg_converter svg_converter.byte mld_hash make_torrent copysources get_range subconv testrss rm -f svg_converter.exe mld_hash.exe make_torrent.exe copysources.exe get_range.exe subconv.exe testrss.exe + rm -f tests tests.exe (for i in $(SUBDIRS); do \ rm -f $$i/*.cm? $$i/*.o $$i/*.annot ; \ done) diff --git a/distrib/ChangeLog b/distrib/ChangeLog index cce86c82..dbfbc35f 100644 --- a/distrib/ChangeLog +++ b/distrib/ChangeLog @@ -15,6 +15,9 @@ ChangeLog ========= 2010/12/19 +7418: SMTP auth implementation (ygrek) +- new options smtp_login and smtp_password +- added socket timeout for mail server communication, fix bug #22713 7412: tar.gzip: fix harmless error message (ygrek) 7388: DC: fix sharing on Windows (ygrek) ------------------------------------------------------------------------------- diff --git a/src/daemon/common/commonInteractive.ml b/src/daemon/common/commonInteractive.ml index 3a148573..64a60dfa 100644 --- a/src/daemon/common/commonInteractive.ml +++ b/src/daemon/common/commonInteractive.ml @@ -107,9 +107,9 @@ let send_dirfull_warning dir full line1 = let send_mail_again = try let last = Hashtbl.find last_sent_dir_warning dir in - last < time_threshold - with Not_found -> true in - + last < time_threshold + with Not_found -> true + in if send_mail_again then begin if full then Hashtbl.replace last_sent_dir_warning dir current_time; CommonEvent.add_event (Console_message_event @@ -118,12 +118,16 @@ let send_dirfull_warning dir full line1 = let module M = Mailer in let subject = Printf.sprintf "[mldonkey@%s] AUTOMATED WARNING: %s %s" (Unix.gethostname ()) dir status in let mail = { - M.mail_to = !!mail; M.mail_from = !!mail; - M.mail_subject = subject; M.mail_body = line1; + M.mail_to = !!mail; + M.mail_from = !!mail; + M.mail_subject = subject; + M.mail_body = line1; + M.smtp_login = !!smtp_login; + M.smtp_password = !!smtp_password; } in - try + try M.sendmail !!smtp_server !!smtp_port !!add_mail_brackets mail - with _ -> () + with _ -> () end end @@ -378,6 +382,8 @@ let mail_for_completed_file file = M.mail_from = address; M.mail_subject = subject; M.mail_body = line1 ^ line2 ^ line3 ^ line4 ^ line5 ^ (if admin then line6 else "") ^ line7; + M.smtp_login = !!smtp_login; + M.smtp_password = !!smtp_password; } in M.sendmail !!smtp_server !!smtp_port !!add_mail_brackets mail in diff --git a/src/daemon/common/commonOptions.ml b/src/daemon/common/commonOptions.ml index 49d4908f..d390ebbc 100644 --- a/src/daemon/common/commonOptions.ml +++ b/src/daemon/common/commonOptions.ml @@ -1161,13 +1161,21 @@ let http_proxy_tcp = define_option current_section ["http_proxy_tcp"] let current_section = mail_section let smtp_server = define_option current_section ["smtp_server"] - "The mail server you want to use (must be SMTP). Use hostname or IP address" + (_s"The mail server you want to use (must be SMTP). Use hostname or IP address") string_option "127.0.0.1" let smtp_port = define_option current_section ["smtp_port"] - "The port to use on the mail server (default 25)" + (_s"The port to use on the mail server (default 25)") port_option 25 +let smtp_login = define_option current_section ["smtp_login"] + (_s"Login to use for SMTP authentication (leave empty to disable). LOGIN, PLAIN and CRAM-MD5 methods are supported") + string_option "" + +let smtp_password = define_option current_section ["smtp_password"] + (_s"Password to use for SMTP authentication") + string_option "" + let mail = define_option current_section ["mail"] "Your e-mail if you want to receive mails when downloads are completed" string_option "" diff --git a/src/daemon/driver/driverCommands.ml b/src/daemon/driver/driverCommands.ml index 03cdeb96..2a31efbd 100644 --- a/src/daemon/driver/driverCommands.ml +++ b/src/daemon/driver/driverCommands.ml @@ -2110,6 +2110,8 @@ action=\\\"javascript:pluginSubmit();\\\"\\>"; strings_of_option mail; strings_of_option smtp_port; strings_of_option smtp_server; + strings_of_option smtp_login; + strings_of_option smtp_password; strings_of_option add_mail_brackets; strings_of_option filename_in_subject; strings_of_option url_in_mail; diff --git a/src/utils/net/mailer.ml b/src/utils/net/mailer.ml index e44f7cab..05e01512 100644 --- a/src/utils/net/mailer.ml +++ b/src/utils/net/mailer.ml @@ -22,12 +22,15 @@ open Printf2 open Options open Unix open Date - +open Md4 + type mail = { mail_to : string; mail_from : string; mail_subject : string; mail_body : string; + smtp_login : string; + smtp_password : string; } let rfc2047_encode h encoding s = @@ -71,7 +74,9 @@ let rfc2047_encode h encoding s = done; copy ending; Buffer.contents buf - + +let send oc s = Printf.fprintf oc "%s\r\n" s; flush oc +let send1 oc s p = Printf.fprintf oc "%s %s\r\n" s p; flush oc let simple_connect hostname port = let s = socket PF_INET SOCK_STREAM 0 in @@ -87,35 +92,33 @@ let last_response = ref "" let bad_response () = failwith (Printf.sprintf "Bad response [%s]" (String.escaped !last_response)) - + +type response = int * bool * string list + +let get_response ic = + last_response := input_line ic; + if String.length !last_response <= 3 then bad_response (); + if !last_response.[String.length !last_response - 1] <> '\r' then bad_response (); + let final = match !last_response.[3] with ' ' -> true | '-' -> false | _ -> bad_response () in + let code = int_of_string (String.sub !last_response 0 3) in + let text = String.sub !last_response 4 (String.length !last_response - 5) in + (code,final,text) + let read_response ic = let rec iter () = - last_response := input_line ic; - if String.length !last_response > 3 then begin - (* Ignore extended text *) - if (String.sub !last_response 3 1) = "-" - then iter () - else int_of_string (String.sub !last_response 0 3) - end - else - bad_response () - in iter () + match get_response ic with + | (n,true,_) -> n + | _ -> iter () + in + iter () + +let mail_address new_style s = if new_style then "<"^s^">" else s let make_mail mail new_style = let mail_date = Date.mail_string (Unix.time ()) in - - if new_style then - Printf.sprintf - "From: mldonkey <%s>\r\nTo: %s\r\n%s\r\nMIME-Version: 1.0\r\nContent-Type: text/plain; charset=utf-8\r\nDate: %s\r\n\r\n%s" - mail.mail_from - mail.mail_to - (rfc2047_encode "Subject: " "utf-8" mail.mail_subject) - mail_date - mail.mail_body - else Printf.sprintf "From: mldonkey %s\r\nTo: %s\r\n%s\r\nMIME-Version: 1.0\r\nContent-Type: text/plain; charset=utf-8\r\nDate: %s\r\n\r\n%s" - mail.mail_from + (mail_address new_style mail.mail_from) mail.mail_to (rfc2047_encode "Subject: " "utf-8" mail.mail_subject) mail_date @@ -127,59 +130,121 @@ let canon_addr s = if pos = -1 then s else if s.[pos] = ' ' then iter_end s (pos-1) else iter_begin s (pos-1) pos - and iter_begin s pos last = if pos = -1 || s.[pos] = ' ' then String.sub s (pos+1) (last - pos) else iter_begin s (pos-1) last - in iter_end s (len - 1) - + +let string_xor s1 s2 = + assert (String.length s1 = String.length s2); + let s = String.create (String.length s1) in + for i = 0 to String.length s - 1 do + s.[i] <- Char.chr (Char.code s1.[i] lxor Char.code s2.[i]); + done; + s + +(* HMAC-MD5, RFC 2104 *) +let hmac_md5 = + let ipad = String.make 64 '\x36' in + let opad = String.make 64 '\x5C' in + let md5 s = Md5.direct_to_string (Md5.string s) in + fun secret challenge -> + let secret = if String.length secret > 64 then md5 secret else secret in + let k = String.make 64 '\x00' in + String.blit secret 0 k 0 (String.length secret); + md5 (string_xor k opad ^ md5 (string_xor k ipad ^ challenge)) + let sendmail smtp_server smtp_port new_style mail = (* a completely synchronous function (BUG) *) try let s = simple_connect smtp_server smtp_port in + Unix.setsockopt_float s Unix.SO_RCVTIMEO 30.; + Unix.setsockopt_float s Unix.SO_SNDTIMEO 30.; let ic = in_channel_of_descr s in let oc = out_channel_of_descr s in - + let auth_login_enabled = ref false in + let auth_plain_enabled = ref false in + let auth_cram_enabled = ref false in + let read_response_auth ic = + let rec loop () = + let (n,final,text) = get_response ic in + begin match String2.split_simplify (String.uppercase text) ' ' with + | ("AUTH"::methods) -> + List.iter (function + | "LOGIN" -> auth_login_enabled := true + | "PLAIN" -> auth_plain_enabled := true + | "CRAM-MD5" -> auth_cram_enabled := true + | _ -> ()) methods + | _ -> () + end; + if final then n else loop () + in + loop () + in + try if read_response ic <> 220 then bad_response (); - - Printf.fprintf oc "HELO %s\r\n" (gethostname ()); flush oc; - if read_response ic <> 250 then bad_response (); - - if new_style then - Printf.fprintf oc "MAIL FROM:<%s>\r\n" (canon_addr mail.mail_from) - else - Printf.fprintf oc "MAIL FROM:%s\r\n" (canon_addr mail.mail_from); - flush oc; + + send1 oc "EHLO" (gethostname ()); + if read_response_auth ic <> 250 then bad_response (); + + if mail.smtp_login <> "" then + begin + if !auth_cram_enabled then (* prefer CRAM-MD5 *) + begin + send oc "AUTH CRAM-MD5"; + match get_response ic with + | (334,true,s) -> + (* RFC 2195 *) + let digest = hmac_md5 mail.smtp_password (Base64.decode s) in + send oc (Base64.encode (Printf.sprintf "%s %s" mail.smtp_login digest)); + if read_response ic <> 235 then bad_response () + | _ -> bad_response () + end + else if !auth_login_enabled then + begin + send oc "AUTH LOGIN"; + if read_response ic <> 334 then bad_response (); + + send oc (Base64.encode mail.smtp_login); + if read_response ic <> 334 then bad_response (); + + send oc (Base64.encode mail.smtp_password); + if read_response ic <> 235 then bad_response () + end + else if !auth_plain_enabled then + begin + let auth = Printf.sprintf "\x00%s\x00%s" mail.smtp_login mail.smtp_password in + send1 oc "AUTH PLAIN" (Base64.encode auth); + if read_response ic <> 235 then bad_response () + end + end; + + send1 oc "MAIL FROM:" (mail_address new_style (canon_addr mail.mail_from)); if read_response ic <> 250 then bad_response (); - - if new_style then - Printf.fprintf oc "RCPT TO:<%s>\r\n" (canon_addr mail.mail_to) - else - Printf.fprintf oc "RCPT TO:%s\r\n" (canon_addr mail.mail_to); - - flush oc; + + send1 oc "RCPT TO:" (mail_address new_style (canon_addr mail.mail_to)); if read_response ic <> 250 then bad_response (); - - Printf.fprintf oc "DATA\r\n"; flush oc; + + send oc "DATA"; if read_response ic <> 354 then bad_response (); let body = make_mail mail new_style in - Printf.fprintf oc "%s\r\n.\r\n" body; flush oc; + send oc body; + send oc "."; if read_response ic <> 250 then bad_response (); - - Printf.fprintf oc "QUIT\r\n"; flush oc; + + send oc "QUIT"; if read_response ic <> 221 then bad_response (); close_out oc; with e -> - Printf.fprintf oc "QUIT\r\n"; flush oc; + send oc "QUIT"; if read_response ic <> 221 then bad_response (); close_out oc; raise e - + with e -> lprintf_nl "Exception %s while sending mail" (Printexc2.to_string e) diff --git a/tools/tests.ml b/tools/tests.ml index bdfed3ca..73ae4c0a 100644 --- a/tools/tests.ml +++ b/tools/tests.ml @@ -54,11 +54,20 @@ let test_dc_parse () = t true "$ADCGET file TTH/ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789012 1332982893 9194387"; t false "$ADCGET tthl q 0 -1" +let test_hmac_md5 () = + test ~s:"HMAC-MD5" begin fun () -> + let t k c s = Mailer.hmac_md5 k c = Md4.Base16.of_string 16 s in + assert (t (String.make 16 '\x0B') "Hi There" "9294727a3638bb1c13f48ef8158bfc9d"); + assert (t "Jefe" "what do ya want for nothing?" "750c783e6ab0b503eaa86e310a5db738"); + assert (t (String.make 16 '\xAA') (String.make 50 '\xDD') "56be34521d144c88dbb8c733f0e8b3f6"); + end + let () = (* let _ = Ip.addr_of_string "dchub://83.102.255.226" in *) (* let _ = Url.of_string "/submit?q=dcn+dchub://example.com+411" in *) test_magnet (); test_shorten (); test_dc_parse (); + test_hmac_md5 (); pr "Tests finished"; () -- 2.11.4.GIT