[Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/driver/dr...

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       13/07/07 11:01:43

Modified files:
        distrib        : ChangeLog 
        src/daemon/driver: driverControlers.ml 
        src/utils/net  : http_server.ml http_server.mli 

Log message:
        patch #8110

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1574&r2=1.1575
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverControlers.ml?cvsroot=mldonkey&r1=1.121&r2=1.122
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/net/http_server.ml?cvsroot=mldonkey&r1=1.41&r2=1.42
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/net/http_server.mli?cvsroot=mldonkey&r1=1.11&r2=1.12

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1574
retrieving revision 1.1575
diff -u -b -r1.1574 -r1.1575
--- distrib/ChangeLog   7 Jul 2013 11:00:52 -0000       1.1574
+++ distrib/ChangeLog   7 Jul 2013 11:01:42 -0000       1.1575
@@ -15,6 +15,7 @@
 =========
 
 2013/07/07:
+8110: http_server: refactor error_page (ygrek)
 8109: FTP: fix CWD (ygrek)
 8108: FTP: fix authentication (ygrek)
 8107: HTML: fix "Request URI too large" errors (ygrek)

Index: src/daemon/driver/driverControlers.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverControlers.ml,v
retrieving revision 1.121
retrieving revision 1.122
diff -u -b -r1.121 -r1.122
--- src/daemon/driver/driverControlers.ml       24 Jun 2012 08:06:11 -0000      
1.121
+++ src/daemon/driver/driverControlers.ml       7 Jul 2013 11:01:42 -0000       
1.122
@@ -964,9 +964,7 @@
   if not (valid_password user r.options.passwd) || (r.get_url.Url.short_file = 
"logout") then begin
       clear_page buf;
       http_file_type := HTM;
-      let _, error_text_long, head = Http_server.error_page "401" "" ""
-       (Ip.to_string (TcpBufferedSocket.my_ip r.sock))
-       (string_of_int !!http_port) None in
+      let _, error_text_long, head = Http_server.error_page Unauthorized 
(TcpBufferedSocket.my_ip r.sock) !!http_port in
       Buffer.add_string buf error_text_long;
       r.reply_head <- head;
       http_add_html_header r;
@@ -1519,10 +1517,9 @@
         | s ->  http_send_bin_pictures r buf (String.lowercase s)
       with
       | Not_found ->
-         let _, error_text_long, head = Http_server.error_page "404" "" ""
-                       (Ip.to_string (TcpBufferedSocket.my_ip r.sock))
-                       (string_of_int !!http_port)
-                       (Some (Url_not_found r.get_url.Url.full_file)) in
+         let _, error_text_long, head = Http_server.error_page (Not_Found 
r.get_url.Url.full_file)
+                       (TcpBufferedSocket.my_ip r.sock) !!http_port
+    in
          r.reply_head <- head;
           http_add_html_header r;
          Buffer.add_string buf error_text_long

Index: src/utils/net/http_server.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/net/http_server.ml,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -b -r1.41 -r1.42
--- src/utils/net/http_server.ml        28 Mar 2011 18:19:22 -0000      1.41
+++ src/utils/net/http_server.ml        7 Jul 2013 11:01:42 -0000       1.42
@@ -93,9 +93,11 @@
 | Write_auth
 
 type error_reason =
-| Blocked
-| Not_allowed
-| Url_not_found of string
+| Blocked of Ip.t
+| Not_allowed of Ip.t
+| Not_Found of string
+| Unauthorized
+| Moved of string
 
 type header =
   Unknown of string * string
@@ -228,33 +230,35 @@
   in
   iter 0 []
 
-let error_page code from_ip from_port my_ip my_port reason =
-  let error_text, error_text_long =
-    match code with
-    | "401" -> "Unauthorized", "<p>Please login using a valid username and 
password</p>"
-    | "403" -> "Forbidden", 
-               (match reason with
-                  Some Not_allowed -> Printf.sprintf
-"<p>Connection from %s rejected (see downloads.ini, <a 
href=\"http://mldonkey.sourceforge.net/Allowed_ips\";>allowed_ips</a>)</p>"
-                                   from_ip
-                | Some Blocked -> Printf.sprintf "IP %s is blocked, its part 
of the used IP blocklist " from_ip
-                | _ -> "")
-    | "404" -> "Not found", Printf.sprintf "The requested URL %swas not found 
on this server."
-                             (match reason with Some (Url_not_found url) -> 
html_escaped url ^ " " | _ -> "")
-    | _ -> Printf.sprintf "Unknown error %s" (html_escaped code), ""
+let error_page reason my_ip my_port =
+  let http_code, headers, error_text, error_text_long =
+    match reason with
+    | Moved url -> 301, ["Location",url], "Moved Permanently", Printf.sprintf 
"Redirecting to %s" (html_escaped url)
+    | Unauthorized -> 401, [], "Unauthorized", "<p>Please login using a valid 
username and password</p>"
+    | Not_allowed from_ip ->
+      403, [], "Forbidden",
+      Printf.sprintf "<p>Connection from %s rejected " (Ip.to_string from_ip) ^
+      "(see downloads.ini, <a 
href=\"http://mldonkey.sourceforge.net/Allowed_ips\";>allowed_ips</a>)</p>"
+    | Blocked from_ip ->
+      403, [], "Forbidden",
+      Printf.sprintf "IP %s is blocked, its part of the used IP blocklist " 
(Ip.to_string from_ip)
+    | Not_Found url ->
+      404, [], "Not Found",
+      Printf.sprintf "The requested URL %s was not found on this server." 
(html_escaped url)
   in
   let reject_message = Printf.sprintf
 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n<html>
-<head><title>%s %s</title></head>\n<h1>%s %s</h1>\n%s
-<hr><address>MLDonkey/%s at %s Port %s</address></html>"
-    code error_text code error_text error_text_long
-    Autoconf.current_version my_ip my_port
+<head><title>%d %s</title></head>\n<h1>%d %s</h1>\n%s
+<hr><address>MLDonkey/%s at %s Port %d</address></html>"
+    http_code error_text http_code error_text error_text_long
+    Autoconf.current_version (Ip.to_string my_ip) my_port
   in
+  let headers = String.concat "\n" (List.map (fun (k,v) -> k ^ ": " ^ v) 
headers) in
   Printf.sprintf
-"HTTP/1.1 %s %s\nServer: MLDonkey/%s\nConnection: close
-Content-Type: text/html; charset=iso-8859-1\nContent-length: %d\r\n"
-    code error_text Autoconf.current_version (String.length reject_message), 
reject_message,
-  Printf.sprintf "%s %s" code error_text
+"HTTP/1.1 %d %s\nServer: MLDonkey/%s\nConnection: close
+Content-Type: text/html; charset=iso-8859-1\n%sContent-length: %d\r\n"
+    http_code error_text Autoconf.current_version headers (String.length 
reject_message), reject_message,
+  Printf.sprintf "%d %s" http_code error_text
 
 let parse_head sock s =
   let h = split_head s in
@@ -855,12 +859,10 @@
          (if ip_is_blocked from_ip then "IP is blocked" else "see allowed_ips 
setting");
         let token = create_token unlimited_connection_manager in
         let sock = TcpBufferedSocket.create_simple token "http connection" s in
-       let s1,s2,_ = error_page "403"
-           (Ip.to_string from_ip)
-           (string_of_int from_port)
-           (Ip.to_string (TcpBufferedSocket.my_ip sock))
-           (string_of_int config.port)
-           (if not (ip_is_allowed from_ip) then Some Not_allowed else Some 
Blocked)
+       let s1,s2,_ = error_page
+      (if not (ip_is_allowed from_ip) then Not_allowed from_ip else Blocked 
from_ip)
+           (TcpBufferedSocket.my_ip sock)
+           config.port
        in
        TcpBufferedSocket.write_string sock (Printf.sprintf "%s\n%s" s1 s2);
         shutdown sock Closed_connect_failed;

Index: src/utils/net/http_server.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/net/http_server.mli,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- src/utils/net/http_server.mli       8 May 2007 16:33:32 -0000       1.11
+++ src/utils/net/http_server.mli       7 Jul 2013 11:01:42 -0000       1.12
@@ -17,7 +17,12 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 type auth = No_auth | Read_auth | Write_auth
-type error_reason = Blocked | Not_allowed | Url_not_found of string
+type error_reason =
+  | Blocked of Ip.t
+  | Not_allowed of Ip.t
+  | Not_Found of string
+  | Unauthorized
+  | Moved of string
 and header =
     Unknown of string * string
   | Referer of Url.url
@@ -78,4 +83,4 @@
   
 val request_range : request -> int64 * (int64 option)
 val parse_range : string -> int64 * int64 option * int64 option
-val error_page : string -> string -> string -> string -> string -> 
error_reason option -> string * string * string
+val error_page : error_reason -> Ip.t -> int -> string * string * string