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 = |
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 = |
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 = |
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; |
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 = |
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" -> |
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; |
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 |
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 |
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 |
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 |
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; |