[Mldonkey-commits] mldonkey config/Makefile.in distrib/ChangeLog s...

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       10/12/19 10:31:22

Modified files:
        config         : Makefile.in 
        distrib        : ChangeLog 
        src/daemon/common: commonInteractive.ml commonOptions.ml 
        src/daemon/driver: driverCommands.ml 
        src/utils/net  : mailer.ml 
        tools          : tests.ml 

Log message:
        patch #7418

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/config/Makefile.in?cvsroot=mldonkey&r1=1.198&r2=1.199
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1506&r2=1.1507
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonInteractive.ml?cvsroot=mldonkey&r1=1.110&r2=1.111
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonOptions.ml?cvsroot=mldonkey&r1=1.236&r2=1.237
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverCommands.ml?cvsroot=mldonkey&r1=1.260&r2=1.261
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/net/mailer.ml?cvsroot=mldonkey&r1=1.13&r2=1.14
http://cvs.savannah.gnu.org/viewcvs/mldonkey/tools/tests.ml?cvsroot=mldonkey&r1=1.1&r2=1.2

Patches:
Index: config/Makefile.in
===================================================================
RCS file: /sources/mldonkey/mldonkey/config/Makefile.in,v
retrieving revision 1.198
retrieving revision 1.199
diff -u -b -r1.198 -r1.199
--- config/Makefile.in  13 Nov 2010 17:31:02 -0000      1.198
+++ config/Makefile.in  19 Dec 2010 10:31:21 -0000      1.199
@@ -209,7 +209,7 @@
 
 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 @@
 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(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 @@
        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)

Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1506
retrieving revision 1.1507
diff -u -b -r1.1506 -r1.1507
--- distrib/ChangeLog   19 Dec 2010 10:10:24 -0000      1.1506
+++ distrib/ChangeLog   19 Dec 2010 10:31:21 -0000      1.1507
@@ -15,6 +15,9 @@
 =========
 
 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)
 -------------------------------------------------------------------------------

Index: src/daemon/common/commonInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonInteractive.ml,v
retrieving revision 1.110
retrieving revision 1.111
diff -u -b -r1.110 -r1.111
--- src/daemon/common/commonInteractive.ml      19 Dec 2010 10:04:58 -0000      
1.110
+++ src/daemon/common/commonInteractive.ml      19 Dec 2010 10:31:21 -0000      
1.111
@@ -108,8 +108,8 @@
       try
         let last = Hashtbl.find last_sent_dir_warning dir in
        last < time_threshold
-      with Not_found -> true in
-
+      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,8 +118,12 @@
         let module M = Mailer in
         let subject = Printf.sprintf "address@hidden 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
           M.sendmail !!smtp_server !!smtp_port !!add_mail_brackets mail
@@ -378,6 +382,8 @@
         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

Index: src/daemon/common/commonOptions.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonOptions.ml,v
retrieving revision 1.236
retrieving revision 1.237
diff -u -b -r1.236 -r1.237
--- src/daemon/common/commonOptions.ml  1 Nov 2010 17:19:23 -0000       1.236
+++ src/daemon/common/commonOptions.ml  19 Dec 2010 10:31:21 -0000      1.237
@@ -1161,13 +1161,21 @@
 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 ""

Index: src/daemon/driver/driverCommands.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverCommands.ml,v
retrieving revision 1.260
retrieving revision 1.261
diff -u -b -r1.260 -r1.261
--- src/daemon/driver/driverCommands.ml 7 Nov 2010 15:10:59 -0000       1.260
+++ src/daemon/driver/driverCommands.ml 19 Dec 2010 10:31:21 -0000      1.261
@@ -2110,6 +2110,8 @@
                        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;

Index: src/utils/net/mailer.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/net/mailer.ml,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -b -r1.13 -r1.14
--- src/utils/net/mailer.ml     6 Feb 2008 20:21:35 -0000       1.13
+++ src/utils/net/mailer.ml     19 Dec 2010 10:31:22 -0000      1.14
@@ -22,12 +22,15 @@
 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 =
@@ -72,6 +75,8 @@
   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
@@ -88,34 +93,32 @@
   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,56 +130,118 @@
     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 ();
+      send1 oc "EHLO" (gethostname ());
+      if read_response_auth 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;
-      if read_response 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 (); 
       
-      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); 
+          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 ();
       
-      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

Index: tools/tests.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/tools/tests.ml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- tools/tests.ml      8 Sep 2010 16:29:23 -0000       1.1
+++ tools/tests.ml      19 Dec 2010 10:31:22 -0000      1.2
@@ -54,11 +54,20 @@
   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";
   ()