23 |
|
|
24 |
let verbose = ref false |
let verbose = ref false |
25 |
|
|
26 |
|
let lprintf_nl () = |
27 |
|
lprintf "%s[HTTPsv]: " |
28 |
|
(log_time ()); lprintf_nl2 |
29 |
|
|
30 |
let html_escaped s = |
let html_escaped s = |
31 |
String2.convert false (fun b escaped c -> |
String2.convert false (fun b escaped c -> |
32 |
if escaped then |
if escaped then |
226 |
|
|
227 |
let parse_head sock s = |
let parse_head sock s = |
228 |
let h = split_head s in |
let h = split_head s in |
229 |
(* List.iter (fun s -> lprintf "LINE: [%s]\n" (escaped s)) h; *) |
(* List.iter (fun s -> lprintf_nl () "LINE: [%s]" (escaped s)) h; *) |
230 |
match h with |
match h with |
231 |
[] -> failwith "Http_server: Empty head" |
[] -> failwith "Http_server: Empty head" |
232 |
| ans :: headers -> |
| ans :: headers -> |
264 |
| _ -> options |
| _ -> options |
265 |
with e -> |
with e -> |
266 |
if !debug then begin |
if !debug then begin |
267 |
lprintf_nl "[HTTPSRV]: Exception %s in header %s" |
lprintf_nl () "Exception %s in header %s" |
268 |
(Printexc2.to_string e) name; |
(Printexc2.to_string e) name; |
269 |
end; |
end; |
270 |
options |
options |
360 |
| _ -> |
| _ -> |
361 |
let tmpfile = Filename.temp_file "http_" "" in |
let tmpfile = Filename.temp_file "http_" "" in |
362 |
if !debug then begin |
if !debug then begin |
363 |
lprintf "WARNING: saving to file %s\n" tmpfile; |
lprintf_nl () "WARNING: saving to file %s" tmpfile; |
364 |
end; |
end; |
365 |
let oc = open_out tmpfile in |
let oc = open_out tmpfile in |
366 |
let rec iter n empty_line = |
let rec iter n empty_line = |
402 |
end |
end |
403 |
| (name, (_,value, args)) :: lines -> |
| (name, (_,value, args)) :: lines -> |
404 |
if !debug then begin |
if !debug then begin |
405 |
lprintf "ILL FORMED LINE: [%s]" name; |
lprintf_nl () "ILL FORMED LINE: [%s]" name; |
406 |
List.iter (fun (name, v) -> |
List.iter (fun (name, v) -> |
407 |
lprintf " (%s,%s)" name v) args; |
lprintf " (%s,%s)" name v) args; |
408 |
lprint_nl ""; |
lprint_newline (); |
409 |
end; |
end; |
410 |
raise Exit |
raise Exit |
411 |
| [] -> |
| [] -> |
412 |
if !debug then lprintf_nl "NO LINES"; |
if !debug then lprintf_nl () "NO LINES"; |
413 |
raise Exit |
raise Exit |
414 |
in |
in |
415 |
if !end_boundary_found then field :: previous else |
if !end_boundary_found then field :: previous else |
421 |
|
|
422 |
let parse_post_args f len req b = |
let parse_post_args f len req b = |
423 |
(* parse post args *) |
(* parse post args *) |
424 |
lprintf_nl "CALL HANDLER"; |
lprintf_nl () "CALL HANDLER"; |
425 |
let s = String.sub b.rbuf b.rpos len in |
let s = String.sub b.rbuf b.rpos len in |
426 |
Select.buf_used b len; |
Select.buf_used b len; |
427 |
let args = Url.cut_args s in |
let args = Url.cut_args s in |
430 |
f b req |
f b req |
431 |
|
|
432 |
let check_len f len b pos2 = |
let check_len f len b pos2 = |
433 |
lprintf_nl "check_len: len %d rlen %d" len b.rlen; |
lprintf_nl () "check_len: len %d rlen %d" len b.rlen; |
434 |
if b.rlen >= len then f b |
if b.rlen >= len then f b |
435 |
|
|
436 |
let complete_post_request ( f : handler ) buf request = |
let complete_post_request ( f : handler ) buf request = |
437 |
let len = request.options.content_length in |
let len = request.options.content_length in |
438 |
lprintf_nl "check_len: len %d rlen %d" len buf.rlen; |
lprintf_nl () "check_len: len %d rlen %d" len buf.rlen; |
439 |
if buf.rlen >= len then |
if buf.rlen >= len then |
440 |
parse_post_args f len request buf |
parse_post_args f len request buf |
441 |
else |
else |
650 |
stream_out_string buf ans; |
stream_out_string buf ans; |
651 |
at_write_end buf.fd_task shutdown; |
at_write_end buf.fd_task shutdown; |
652 |
with e -> |
with e -> |
653 |
lprintf_nl "[HTTPSRV]: No such file: %s (%s)" file (Printexc2.to_string e); |
lprintf_nl () "No such file: %s (%s)" file (Printexc2.to_string e); |
654 |
simple_error_404 buf; |
simple_error_404 buf; |
655 |
at_write_end buf.fd_task shutdown |
at_write_end buf.fd_task shutdown |
656 |
*) |
*) |
791 |
try |
try |
792 |
iter new_pos |
iter new_pos |
793 |
with e -> |
with e -> |
794 |
lprintf "[HTTPSRV]: Exception %s in request_handler\n" |
lprintf_nl () "Exception %s in request_handler" |
795 |
(Printexc2.to_string e); |
(Printexc2.to_string e); |
796 |
close sock (Closed_for_exception e) |
close sock (Closed_for_exception e) |
797 |
|
|
812 |
TcpBufferedSocket.set_closer sock request_closer; |
TcpBufferedSocket.set_closer sock request_closer; |
813 |
TcpBufferedSocket.set_handler sock TcpBufferedSocket.BUFFER_OVERFLOW |
TcpBufferedSocket.set_handler sock TcpBufferedSocket.BUFFER_OVERFLOW |
814 |
(fun _ -> TcpBufferedSocket.close sock Closed_for_overflow; |
(fun _ -> TcpBufferedSocket.close sock Closed_for_overflow; |
815 |
lprintf_nl "[HTTPSRV]: BUFFER OVERFLOW" ); () |
lprintf_nl () "BUFFER OVERFLOW" ); () |
816 |
else |
else |
817 |
Unix.close s |
Unix.close s |
818 |
| _ -> () |
| _ -> () |
869 |
x, Some y, Some z |
x, Some y, Some z |
870 |
with |
with |
871 |
| e -> |
| e -> |
872 |
lprintf_nl "[HTTPSRV]: Exception %s for range [%s]" |
lprintf_nl () "Exception %s for range [%s]" |
873 |
(Printexc2.to_string e) range; |
(Printexc2.to_string e) range; |
874 |
raise e |
raise e |
875 |
|
|
887 |
(* Range: bytes=31371876- *) |
(* Range: bytes=31371876- *) |
888 |
let request_range r = |
let request_range r = |
889 |
List.iter (fun (h, v1) -> |
List.iter (fun (h, v1) -> |
890 |
lprintf_nl "[HTTPSRV]: HEADER [%s] = [%s]" h v1 |
lprintf_nl () "HEADER [%s] = [%s]" h v1 |
891 |
) r.headers; |
) r.headers; |
892 |
let range = List.assoc "Range" r.headers in |
let range = List.assoc "Range" r.headers in |
893 |
match parse_range range with |
match parse_range range with |