/[mldonkey]/mldonkey/src/daemon/driver/driverControlers.ml
ViewVC logotype

Diff of /mldonkey/src/daemon/driver/driverControlers.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.35 by spiralvoice, Thu Jul 14 15:34:15 2005 UTC revision 1.36 by spiralvoice, Mon Jul 18 00:52:31 2005 UTC
# Line 678  let chat_handler t event = Line 678  let chat_handler t event =
678    
679  **************************************************************)  **************************************************************)
680    
681    open Http_server
682    
683  let buf = Buffer.create 1000  let buf = Buffer.create 1000
684    
685  type http_file =  type http_file =
# Line 687  type http_file = Line 689  type http_file =
689  | TXT  | TXT
690  | UNK  | UNK
691    
692    type file_ext =
693      BINARY
694    | CSS
695    | HTMLS
696    | ICON
697    | JPEG
698    | JAVASCRIPT
699    | MPEG
700    | PNG
701    | TEXTS
702    | UNKN
703    | WML
704    
705  let http_file_type = ref UNK  let http_file_type = ref UNK
706    
707  open Http_server  let extension_to_file_ext extension =
708      match extension with
709      | "bin" -> BINARY
710      | "css" -> CSS
711      | "htm"
712      | "html" -> HTMLS
713      | "ico" -> ICON
714      | "jpeg"
715      | "jpg" -> JPEG
716      | "js" -> JAVASCRIPT
717      | "mpeg"
718      | "mpg" -> MPEG
719      | "png" -> PNG
720      | "txt" -> TEXTS
721      | "wml" -> WML
722      | _ -> UNKN
723    
724    let ext_to_file_type ext =
725      match ext with
726        UNKN -> UNK
727      | BINARY -> BIN
728      | CSS -> TXT
729      | HTMLS -> HTM
730      | ICON -> BIN
731      | JAVASCRIPT -> TXT
732      | JPEG -> BIN
733      | MPEG -> BIN
734      | PNG -> BIN
735      | TEXTS -> TXT
736      | WML -> TXT
737    
738    let ext_to_mime_type ext =
739      match ext with
740        UNKN -> ""
741      | BINARY -> "application/octet-stream"
742      | CSS -> "text/css"
743      | HTMLS -> "text/html"
744      | ICON -> "image/x-icon"
745      | JAVASCRIPT -> "text/javascript"
746      | JPEG -> "image/jpg"
747      | MPEG -> "video/mpeg"
748      | PNG -> "image/png"
749      | TEXTS -> "text/plain"
750      | WML -> "text/vnd.wap.wml"
751    
752    let default_charset = "charset=UTF-8"
753    
754  let get_theme_page page =  let get_theme_page page =
755          let theme = Filename.concat html_themes_dir !!html_mods_theme in          let theme = Filename.concat html_themes_dir !!html_mods_theme in
756          let fname = Filename.concat theme page in fname          let fname = Filename.concat theme page in fname
757    
758  let theme_page_exists page =  let theme_page_exists page =
759          if Sys.file_exists (get_theme_page page) then true else false          if Sys.file_exists (get_theme_page page) then true else false
760    
761  (* if files are small really_input should be okay *)  (* if files are small really_input should be okay *)
762  let read_theme_page page =  let read_theme_page page =
# Line 726  let add_gzip_headers r = Line 786  let add_gzip_headers r =
786    end    end
787    
788  let http_add_html_header r =  let http_add_html_header r =
789    http_file_type := HTM;    let ext = extension_to_file_ext "html" in
790      http_file_type := ext_to_file_type ext;
791    http_add_gen_header r;    http_add_gen_header r;
792    add_reply_header r "Pragma" "no-cache";    add_reply_header r "Pragma" "no-cache";
793    add_reply_header r "Content-Type" "text/html; charset=UTF-8";    add_reply_header r "Content-Type" ((ext_to_mime_type ext) ^ ";" ^ default_charset);
   add_gzip_headers r  
   
 let http_add_css_header r =  
   http_file_type := TXT;  
   http_add_gen_header r;  
   add_reply_header r "Content-Type" "text/css; charset=UTF-8";  
794    add_gzip_headers r    add_gzip_headers r
795    
796  let http_add_js_header r =  let http_add_text_header r ext =
797    http_file_type := TXT;    http_file_type := ext_to_file_type ext;
798    http_add_gen_header r;    http_add_gen_header r;
799    add_reply_header  r "Content-Type" "text/javascript; charset=UTF-8";    add_reply_header  r "Content-Type" ((ext_to_mime_type ext) ^ ";" ^ default_charset);
800    add_gzip_headers r    add_gzip_headers r
801    
802  let http_add_png_header r clen =  let http_add_bin_info_header r clen =
   http_file_type := BIN;  
   http_add_gen_header r;  
   add_reply_header r "Content-Type" "image/png;";  
803    add_reply_header r "Accept-Ranges" "bytes";    add_reply_header r "Accept-Ranges" "bytes";
804    add_reply_header r "Content-Length" (Printf.sprintf "%d" clen);    add_reply_header r "Content-Length" (Printf.sprintf "%d" clen)
   add_gzip_headers r  
805    
806  let http_add_jpg_header r clen =  let http_add_bin_header r ext clen =
807    http_file_type := BIN;    http_file_type := ext_to_file_type ext;
808    http_add_gen_header r;    http_add_gen_header r;
809    add_reply_header r "Content-Type" "image/jpg;";    add_reply_header r "Content-Type" (ext_to_mime_type ext);
810    add_reply_header r "Accept-Ranges" "bytes";    http_add_bin_info_header r clen;
   add_reply_header r "Content-Length" (Printf.sprintf "%d" clen);  
811    add_gzip_headers r    add_gzip_headers r
812    
813    let http_send_bin r buf filename =
814      let file_to_send = File.to_string filename in
815      let clen = String.length file_to_send in
816      let ext_pos = (String.rindex filename '.') + 1 in
817      let exten = (String.sub filename ext_pos ((String.length filename) - ext_pos)) in
818      if !verbose_msg_servers then
819        lprintf_nl "[HTTP]: Extension found [%s] for file: [%s]" exten filename;
820      let ext = extension_to_file_ext exten in
821      http_add_bin_header r ext clen;
822      Buffer.add_string buf file_to_send
823    
824    let http_error_no_gd img_type =
825      match img_type with
826        "jpg" ->
827          (match Autoconf.has_gd_jpg with
828            true -> false
829          | false -> lprintf_nl "[HTTP] : Warning: GD jpg support disabled"; true)
830      | "png" ->
831          (match Autoconf.has_gd_png with
832            true -> false
833          | false -> lprintf_nl "[HTTP] : Warning: GD png support disabled"; true)
834      | _ ->
835          (match Autoconf.has_gd with
836            true -> false
837          | false -> lprintf_nl "[HTTP] : Warning: GD support disabled"; true)
838  let any_ip = Ip.of_inet_addr Unix.inet_addr_any  let any_ip = Ip.of_inet_addr Unix.inet_addr_any
839    
840  let html_open_page buf t r open_body =  let html_open_page buf t r open_body =
# Line 797  let html_open_page buf t r open_body = Line 872  let html_open_page buf t r open_body =
872    
873  let html_close_page buf =  let html_close_page buf =
874    Buffer.add_string buf "</body>\n";    Buffer.add_string buf "</body>\n";
875    Buffer.add_string buf "</html>\n";    Buffer.add_string buf "</html>\n"
   ()  
876    
877  let clear_page buf =  let clear_page buf =
878    Buffer.clear buf;    Buffer.clear buf;
# Line 826  let http_handler o t r = Line 900  let http_handler o t r =
900          | "/wap.wml" ->          | "/wap.wml" ->
901              begin              begin
902                clear_page buf;                clear_page buf;
903                add_reply_header r "Server" "MLdonkey";                http_add_text_header r WML;
               add_reply_header r "Connection" "close";  
               add_reply_header r "Content-Type" "text/vnd.wap.wml";  
904                let dlkbs =                let dlkbs =
905                  (( (float_of_int !udp_download_rate) +. (float_of_int !control_download_rate)) /. 1024.0) in                  (( (float_of_int !udp_download_rate) +. (float_of_int !control_download_rate)) /. 1024.0) in
906                let ulkbs =                let ulkbs =
# Line 874  let http_handler o t r = Line 946  let http_handler o t r =
946                ) mfiles;                ) mfiles;
947                Printf.bprintf buf "<br />Downloaded %d/%d files " (List.length !!done_files) (List.length !!files);                Printf.bprintf buf "<br />Downloaded %d/%d files " (List.length !!done_files) (List.length !!files);
948                Printf.bprintf buf "</small></p>";                Printf.bprintf buf "</small></p>";
   
949                Printf.bprintf buf "</card></wml>";                Printf.bprintf buf "</card></wml>";
950              end              end
951          | "/commands.html" ->          | "/commands.html" ->
# Line 920  let http_handler o t r = Line 991  let http_handler o t r =
991              Buffer.add_string buf !!motd_html              Buffer.add_string buf !!motd_html
992    
993          | "/bw_updown.png" ->          | "/bw_updown.png" ->
994              do_draw_pic "Traffic" "s(kb)" "t(h:m:s)" download_history upload_history;              (match http_error_no_gd "png" with
995              (* Buffer.clear buf; *)                false ->
996              let showgraph = File.to_string "bw_updown.png" in                  do_draw_pic "Traffic" "s(kb)" "t(h:m:s)" download_history upload_history;
997              let size = String.length showgraph in                  http_send_bin r buf "bw_updown.png"
998              http_add_png_header r size;              | true -> raise Not_found)
             Buffer.add_string buf showgraph  
999    
1000          | "/bw_updown.jpg" ->          | "/bw_updown.jpg" ->
1001              do_draw_pic "Traffic" "s(kb)" "t(h:m:s)" download_history upload_history;              (match http_error_no_gd "jpg" with
1002              (* Buffer.clear buf;*)                false ->
1003              let showgraph = File.to_string_alt "bw_updown.jpg" in                  do_draw_pic "Traffic" "s(kb)" "t(h:m:s)" download_history upload_history;
1004              let size = Buffer.length showgraph in                  http_send_bin r buf "bw_updown.jpg"
1005              http_add_jpg_header r size;              | true -> raise Not_found)
             Buffer.add_buffer buf showgraph  
1006    
1007          | "/bw_download.png" ->          | "/bw_download.png" ->
1008              do_draw_down_pic "Traffic" "download" "s(kb)" "t(h:m:s)" download_history;              (match http_error_no_gd "png" with
1009              let showgraph = File.to_string "bw_download.png" in                false ->
1010              let size = String.length showgraph in                  do_draw_down_pic "Traffic" "download" "s(kb)" "t(h:m:s)" download_history;
1011              http_add_png_header r size;                  http_send_bin r buf "bw_download.png"
1012              Buffer.add_string buf showgraph              | true -> raise Not_found)
1013    
1014          | "/bw_download.jpg" ->          | "/bw_download.jpg" ->
1015              do_draw_down_pic "Traffic" "download" "s(kb)" "t(h:m:s)" download_history;              (match http_error_no_gd "jpg" with
1016              Buffer.clear buf;                false ->
1017              let showgraph = File.to_string "bw_download.jpg" in                  do_draw_down_pic "Traffic" "download" "s(kb)" "t(h:m:s)" download_history;
1018              let size = String.length showgraph in                  http_send_bin r buf "bw_download.jpg"
1019              http_add_jpg_header r size;              | true -> raise Not_found)
             Buffer.add_string buf showgraph  
1020    
1021          | "/bw_upload.png" ->          | "/bw_upload.png" ->
1022              do_draw_up_pic "Traffic" "upload" "s(kb)" "t(h:m:s)" upload_history;              (match http_error_no_gd "png" with
1023              let showgraph = File.to_string "bw_upload.png" in                false ->
1024              let size = String.length showgraph in                  do_draw_up_pic "Traffic" "upload" "s(kb)" "t(h:m:s)" upload_history;
1025              http_add_png_header r size;                  http_send_bin r buf "bw_upload.png"
1026              Buffer.add_string buf showgraph              | true -> raise Not_found)
1027    
1028          | "/bw_upload.jpg" ->          | "/bw_upload.jpg" ->
1029              do_draw_up_pic "Traffic" "upload" "s(kb)" "t(h:m:s)" upload_history;              (match http_error_no_gd "jpg" with
1030              Buffer.clear buf;              | false ->
1031              let showgraph = File.to_string "bw_upload.jpg" in                  do_draw_up_pic "Traffic" "upload" "s(kb)" "t(h:m:s)" upload_history;
1032              let size = String.length showgraph in                  http_send_bin r buf "bw_upload.jpg"
1033              http_add_jpg_header r size;              | true -> raise Not_found)
             Buffer.add_string buf showgraph  
1034    
1035          | "/bw_h_updown.png" ->          | "/bw_h_updown.png" ->
1036              do_draw_h_pic "Traffic" "s(kb)" "t(h:m:s)" download_h_history upload_h_history;              (match http_error_no_gd "png" with
1037              (* Buffer.clear buf; *)              | false ->
1038              let showgraph = File.to_string "bw_h_updown.png" in                  do_draw_h_pic "Traffic" "s(kb)" "t(h:m:s)" download_h_history upload_h_history;
1039              let size = String.length showgraph in                  http_send_bin r buf "bw_h_updown.png"
1040              http_add_png_header r size;              | true -> raise Not_found)
             Buffer.add_string buf showgraph  
1041    
1042          | "/bw_h_updown.jpg" ->          | "/bw_h_updown.jpg" ->
1043              do_draw_h_pic "Traffic" "s(kb)" "t(h:m:s)" download_h_history upload_h_history;              (match http_error_no_gd "jpg" with
1044              (* Buffer.clear buf;*)              | false ->
1045              let showgraph = File.to_string "bw_h_updown.jpg" in                  do_draw_h_pic "Traffic" "s(kb)" "t(h:m:s)" download_h_history upload_h_history;
1046              let size = String.length showgraph in                  http_send_bin r buf "bw_h_updown.jpg"
1047              http_add_jpg_header r size;              | true -> raise Not_found)
             Buffer.add_string buf showgraph  
1048    
1049          | "/bw_h_download.png" ->          | "/bw_h_download.png" ->
1050              do_draw_down_h_pic "Traffic" "download" "s(kb)" "t(h:m:s)" download_h_history;              (match http_error_no_gd "png" with
1051              let showgraph = File.to_string "bw_h_download.png" in              | false ->
1052              let size = String.length showgraph in                  do_draw_down_h_pic "Traffic" "download" "s(kb)" "t(h:m:s)" download_h_history;
1053              http_add_png_header r size;                  http_send_bin r buf "bw_h_download.png"
1054              Buffer.add_string buf showgraph              | true -> raise Not_found)
1055    
1056          | "/bw_h_download.jpg" ->          | "/bw_h_download.jpg" ->
1057              do_draw_down_h_pic "Traffic" "download" "s(kb)" "t(h:m:s)" download_h_history;              (match http_error_no_gd "jpg" with
1058              Buffer.clear buf;              | false ->
1059              let showgraph = File.to_string "bw_h_download.jpg" in                  do_draw_down_h_pic "Traffic" "download" "s(kb)" "t(h:m:s)" download_h_history;
1060              let size = String.length showgraph in                  http_send_bin r buf "bw_h_download.jpg"
1061              http_add_jpg_header r size;              | true -> raise Not_found)
             Buffer.add_string buf showgraph  
1062    
1063          | "/bw_h_upload.png" ->          | "/bw_h_upload.png" ->
1064              do_draw_up_h_pic "Traffic" "upload" "s(kb)" "t(h:m:s)" upload_h_history;              (match http_error_no_gd "png" with
1065              let showgraph = File.to_string "bw_h_upload.png" in              | false ->
1066              let size = String.length showgraph in                  do_draw_up_h_pic "Traffic" "upload" "s(kb)" "t(h:m:s)" upload_h_history;
1067              http_add_png_header r size;                  http_send_bin r buf "bw_h_upload.png"
1068              Buffer.add_string buf showgraph              | true -> raise Not_found)
1069    
1070          | "/bw_h_upload.jpg" ->          | "/bw_h_upload.jpg" ->
1071              do_draw_up_h_pic "Traffic" "upload" "s(kb)" "t(h:m:s)" upload_h_history;              (match http_error_no_gd "jpg" with
1072              Buffer.clear buf;              | false ->
1073              let showgraph = File.to_string "bw_h_upload.jpg" in                  do_draw_up_h_pic "Traffic" "upload" "s(kb)" "t(h:m:s)" upload_h_history;
1074              let size = String.length showgraph in                  http_send_bin r buf "bw_h_upload.jpg"
1075              http_add_jpg_header r size;              | true -> raise Not_found)
             Buffer.add_string buf showgraph  
   
1076    
1077          | "/tag.png" ->          | "/tag.png" ->
1078              do_draw_tag !!html_mods_vd_gfx_tag_title download_history upload_history;              (match http_error_no_gd "png" with
1079              let showgraph = File.to_string "tag.png" in              | false ->
1080              let size = String.length showgraph in                  do_draw_tag !!html_mods_vd_gfx_tag_title download_history upload_history;
1081              http_add_png_header r size;                  http_send_bin r buf "tag.png"
1082              Buffer.add_string buf showgraph              | true -> raise Not_found)
1083    
1084          | "/tag.jpg" ->          | "/tag.jpg" ->
1085              do_draw_tag !!html_mods_vd_gfx_tag_title download_history upload_history;              (match http_error_no_gd "jpg" with
1086              (* Buffer.clear buf;*)              | false ->
1087              let showgraph = File.to_string "tag.jpg" in                  do_draw_tag !!html_mods_vd_gfx_tag_title download_history upload_history;
1088              let size = String.length showgraph in                  http_send_bin r buf "tag.jpg"
1089              http_add_jpg_header r size;              | true -> raise Not_found)
1090              Buffer.add_string buf showgraph  
1091            | "/favicon.ico" ->
1092                if !verbose_msg_servers then
1093                  lprintf_nl "[BT]: favicon.ico request received by tracker";
1094                http_send_bin r buf "favicon.ico"
1095    
1096          | "/filter" ->          | "/filter" ->
1097              html_open_page buf t r true;              html_open_page buf t r true;
# Line 1277  let http_handler o t r = Line 1343  let http_handler o t r =
1343    
1344          | "/h.css" ->          | "/h.css" ->
1345              clear_page buf;              clear_page buf;
1346              http_add_css_header r;              http_add_text_header r CSS;
1347              let this_page = "h.css" in              let this_page = "h.css" in
1348              Buffer.add_string buf (              Buffer.add_string buf (
1349                if !!html_mods_theme != "" && theme_page_exists this_page then                if !!html_mods_theme != "" && theme_page_exists this_page then
# Line 1287  let http_handler o t r = Line 1353  let http_handler o t r =
1353    
1354          | "/dh.css" ->          | "/dh.css" ->
1355              clear_page buf;              clear_page buf;
1356              http_add_css_header r;              http_add_text_header r CSS;
1357              let this_page = "dh.css" in              let this_page = "dh.css" in
1358              Buffer.add_string buf (              Buffer.add_string buf (
1359                if !!html_mods_theme != "" && theme_page_exists this_page then                if !!html_mods_theme != "" && theme_page_exists this_page then
# Line 1297  let http_handler o t r = Line 1363  let http_handler o t r =
1363    
1364          | "/i.js" ->          | "/i.js" ->
1365              clear_page buf;              clear_page buf;
1366              http_add_js_header r;              http_add_text_header r JAVASCRIPT;
1367              let this_page = "i.js" in              let this_page = "i.js" in
1368              Buffer.add_string buf (              Buffer.add_string buf (
1369                if !!html_mods_theme != "" && theme_page_exists this_page then                if !!html_mods_theme != "" && theme_page_exists this_page then
# Line 1307  let http_handler o t r = Line 1373  let http_handler o t r =
1373    
1374          | "/di.js" ->          | "/di.js" ->
1375              clear_page buf;              clear_page buf;
1376              http_add_js_header r;              http_add_text_header r JAVASCRIPT;
1377              let this_page = "di.js" in              let this_page = "di.js" in
1378              Buffer.add_string buf (              Buffer.add_string buf (
1379                if !!html_mods_theme != "" && theme_page_exists this_page then                if !!html_mods_theme != "" && theme_page_exists this_page then
# Line 1317  let http_handler o t r = Line 1383  let http_handler o t r =
1383          | cmd ->          | cmd ->
1384              html_open_page buf t r true;              html_open_page buf t r true;
1385              Printf.bprintf buf "No page named %s" (html_escaped cmd)              Printf.bprintf buf "No page named %s" (html_escaped cmd)
1386        with e ->        with
1387          | Not_found -> Printf.bprintf buf "404 Not found"
1388          | e ->
1389            Printf.bprintf buf "\nException %s\n" (Printexc2.to_string e);            Printf.bprintf buf "\nException %s\n" (Printexc2.to_string e);
1390            r.reply_stream <- None            r.reply_stream <- None
1391      end;      end;

Legend:
Removed from v.1.35  
changed lines
  Added in v.1.36

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26