/[mldonkey]/mldonkey/src/utils/net/http_server.ml
ViewVC logotype

Diff of /mldonkey/src/utils/net/http_server.ml

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

revision 1.18 by spiralvoice, Sun Jul 17 23:15:04 2005 UTC revision 1.19 by spiralvoice, Fri Jul 22 10:58:55 2005 UTC
# Line 23  open TcpBufferedSocket Line 23  open TcpBufferedSocket
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
# Line 222  let split_head s = Line 226  let split_head s =
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 ->
# Line 260  let parse_head sock s = Line 264  let parse_head sock s =
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
# Line 356  let complete_multipart_data request ic t Line 360  let complete_multipart_data request ic t
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 =
# Line 398  let complete_multipart_data request ic t Line 402  let complete_multipart_data request ic t
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
# Line 417  let complete_multipart_data request ic t Line 421  let complete_multipart_data request ic t
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
# Line 426  let parse_post_args f len req b = Line 430  let parse_post_args f len req b =
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
# Line 646  let give_doc buf request = Line 650  let give_doc buf request =
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  *)  *)
# Line 787  let request_handler config sock nread = Line 791  let request_handler config sock nread =
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    
# Line 808  let handler config t event = Line 812  let handler config t event =
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    | _ -> ()    | _ -> ()
# Line 865  let parse_range range = Line 869  let parse_range range =
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    
# Line 883  open Int64ops Line 887  open Int64ops
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

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.19

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