/[mldonkey]/mldonkey/src/networks/fileTP/fileTPHTTP.ml
ViewVC logotype

Diff of /mldonkey/src/networks/fileTP/fileTPHTTP.ml

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

revision 1.10 by spiralvoice, Sun Jul 10 23:19:16 2005 UTC revision 1.11 by spiralvoice, Fri Jul 22 14:32:12 2005 UTC
# Line 46  open FileTPProtocol Line 46  open FileTPProtocol
46    
47  open FileTPClients  open FileTPClients
48    
49    (* prints a new logline with date, module and starts newline *)
50    let lprintf_nl () =
51      lprintf "%s[FTP] "
52        (log_time ()); lprintf_nl2
53    
54    (* prints a new logline with date, module and does not start newline *)
55    let lprintf_n () =
56      lprintf "%s[FTP] "
57        (log_time ()); lprintf
58    
59  (*************************************************************************)  (*************************************************************************)
60  (*                                                                       *)  (*                                                                       *)
# Line 76  let http_send_range_request c range sock Line 85  let http_send_range_request c range sock
85    Printf.bprintf buf "\r\n";    Printf.bprintf buf "\r\n";
86    let s = Buffer.contents buf in    let s = Buffer.contents buf in
87    if !verbose_msg_clients then    if !verbose_msg_clients then
88      lprintf "SENDING REQUEST to %s: %s\n"      lprintf_nl () "SENDING REQUEST to %s: %s"
89        c.client_hostname        c.client_hostname
90        (String.escaped s);        (String.escaped s);
91    write_string sock s;    write_string sock s;
# Line 90  let http_send_range_request c range sock Line 99  let http_send_range_request c range sock
99    
100        
101  let rec client_parse_header c gconn sock header =  let rec client_parse_header c gconn sock header =
102    if !verbose_msg_clients then begin    if !verbose_msg_clients then
103        lprintf "CLIENT PARSE HEADER\n";      lprintf_nl () "CLIENT PARSE HEADER";
     end;  
104    try    try
105      set_lifetime sock 3600.;      set_lifetime sock 3600.;
106      let d =      let d =
# Line 105  let rec client_parse_header c gconn sock Line 113  let rec client_parse_header c gconn sock
113      connection_ok c.client_connection_control;      connection_ok c.client_connection_control;
114      set_client_state c Connected_initiating;          set_client_state c Connected_initiating;    
115      if !verbose_msg_clients then begin      if !verbose_msg_clients then begin
116          lprintf "HEADER FROM CLIENT:\n";          lprintf_nl () "HEADER FROM CLIENT:";
117          AnyEndian.dump_ascii header;          AnyEndian.dump_ascii header;
118        end;        end;
119      let file = d.download_file in      let file = d.download_file in
# Line 122  let rec client_parse_header c gconn sock Line 130  let rec client_parse_header c gconn sock
130            http, code            http, code
131        | _ -> failwith "Not a HTTP header line"        | _ -> failwith "Not a HTTP header line"
132      in      in
133      if !verbose_msg_clients then begin      if !verbose_msg_clients then
134          lprintf "GOOD HEADER FROM CONNECTED CLIENT\n";        lprintf_nl () "GOOD HEADER FROM CONNECTED CLIENT\n";
       end;  
135            
136      set_rtimeout sock 120.;      set_rtimeout sock 120.;
137  (*              lprintf "SPLIT HEADER...\n"; *)  (*              lprintf "SPLIT HEADER...\n"; *)
# Line 145  let rec client_parse_header c gconn sock Line 152  let rec client_parse_header c gconn sock
152              unknown_header := !unknown_header || not (List.mem header known_download_headers)              unknown_header := !unknown_header || not (List.mem header known_download_headers)
153          ) headers;          ) headers;
154          if !unknown_header then begin          if !unknown_header then begin
155              lprintf_nl "FileTP DEVEL: Download Header contains unknown fields";              lprintf_n () "Download Header contains unknown fields";
156              lprintf "    %s\n" first_line;              lprintf_nl2 "    %s" first_line;
157              List.iter (fun (header, (value,header2)) ->              List.iter (fun (header, (value,header2)) ->
158                  lprintf "    [%s] = [%s](%s)\n" header value header2;                  lprintf_nl () "    [%s] = [%s](%s)" header value header2;
159              ) headers;              ) headers;
160              lprintf_nl "FileTP DEVEL: end of header";              lprintf_nl () "end of header";
161            end;            end;
162        end;        end;
163            
# Line 170  let rec client_parse_header c gconn sock Line 177  let rec client_parse_header c gconn sock
177    
178        let file = new_file (Md4.random ()) u.Url.full_file zero in        let file = new_file (Md4.random ()) u.Url.full_file zero in
179                
180        lprintf "DOWNLOAD FILE %s\n" (file_best_name  file);        lprintf_nl () "DOWNLOAD FILE %s" (file_best_name  file);
181        if not (List.memq file !current_files) then begin        if not (List.memq file !current_files) then begin
182      current_files := file :: !current_files;      current_files := file :: !current_files;
183        end;        end;
# Line 212  let rec client_parse_header c gconn sock Line 219  let rec client_parse_header c gconn sock
219              x,y ++ Int64.one              x,y ++ Int64.one
220          with          with
221          | e ->          | e ->
222              lprintf "Exception %s for range [%s]\n"              lprintf_nl () "Exception %s for range [%s]"
223                (Printexc2.to_string e) range;                (Printexc2.to_string e) range;
224              raise e              raise e
225        with e ->        with e ->
# Line 220  let rec client_parse_header c gconn sock Line 227  let rec client_parse_header c gconn sock
227              if code <> 206 && code <> 200 then raise Not_found;              if code <> 206 && code <> 200 then raise Not_found;
228              let (len,_) = List.assoc "content-length" headers in              let (len,_) = List.assoc "content-length" headers in
229              let len = Int64.of_string len in              let len = Int64.of_string len in
230              if !verbose then lprintf_nl "Specified length: %Ld" len;              if !verbose then lprintf_nl () "Specified length: %Ld" len;
231              match d.download_ranges with              match d.download_ranges with
232                [] -> raise Not_found                [] -> raise Not_found
233              | (start_pos,end_pos,r) :: _ ->              | (start_pos,end_pos,r) :: _ ->
234                  lprintf "WARNING: Assuming client is replying to range\n";                  lprintf_nl () "WARNING: Assuming client is replying to range";
235                  if len <> end_pos -- start_pos then                  if len <> end_pos -- start_pos then
236                    begin                    begin
237                      lprintf "\n\nERROR: bad computed range: %Ld-%Ld/%Ld \n%s\n"                      lprintf_nl () "ERROR: bad computed range: %Ld-%Ld/%Ld \n%s"
238                        start_pos end_pos len                        start_pos end_pos len
239                        (String.escaped header);                        (String.escaped header);
240                      raise Not_found                      raise Not_found
# Line 236  let rec client_parse_header c gconn sock Line 243  let rec client_parse_header c gconn sock
243            with _ ->            with _ ->
244  (* A bit dangerous, no ??? *)  (* A bit dangerous, no ??? *)
245                if !verbose_hidden_errors then                if !verbose_hidden_errors then
246                  lprintf "ERROR: Could not find/parse range header (exception %s), disconnect\nHEADER: %s\n"                  lprintf_nl () "ERROR: Could not find/parse range header (exception %s), disconnect\nHEADER: %s"
247                      (Printexc2.to_string e)                      (Printexc2.to_string e)
248                      (String.escaped header);                      (String.escaped header);
249                disconnect_client c (Closed_for_error "Bad HTTP Range");                disconnect_client c (Closed_for_error "Bad HTTP Range");
# Line 245  let rec client_parse_header c gconn sock Line 252  let rec client_parse_header c gconn sock
252      (try      (try
253          let (len,_) = List.assoc "content-length" headers in          let (len,_) = List.assoc "content-length" headers in
254          let len = Int64.of_string len in          let len = Int64.of_string len in
255          if !verbose then lprintf_nl "Specified length: %Ld" len;          if !verbose then lprintf_nl () "Specified length: %Ld" len;
256          if len <> end_pos -- start_pos then          if len <> end_pos -- start_pos then
257            begin            begin
258              failwith "\n\nERROR: bad computed range: %Ld-%Ld/%Ld \n%s\n"              failwith "\n\nERROR: bad computed range: %Ld-%Ld/%Ld \n%s\n"
# Line 253  let rec client_parse_header c gconn sock Line 260  let rec client_parse_header c gconn sock
260                (String.escaped header);                (String.escaped header);
261            end            end
262        with _ ->        with _ ->
263            lprintf "[WARNING]: no Content-Length field\n%s\n"            lprintf_nl () "[WARNING]: no Content-Length field\n%s\n"
264              (String.escaped header)              (String.escaped header)
265      );      );
266            
267      if !verbose then lprintf_nl "Receiving range: %Ld-%Ld (len = %Ld)\n%s"      if !verbose then lprintf_nl () "Receiving range: %Ld-%Ld (len = %Ld)\n%s"
268        start_pos end_pos (end_pos -- start_pos)        start_pos end_pos (end_pos -- start_pos)
269      (String.escaped header)      (String.escaped header)
270      ;      ;
# Line 278  let rec client_parse_header c gconn sock Line 285  let rec client_parse_header c gconn sock
285          let to_read = (*min (end_pos -- !counter_pos) *)          let to_read = (*min (end_pos -- !counter_pos) *)
286            (Int64.of_int b.len) in            (Int64.of_int b.len) in
287    
288          if !verbose then lprintf "Reading: end_pos %Ld counter_pos %Ld len %d = to_read %Ld\n"          if !verbose then lprintf_nl () "Reading: end_pos %Ld counter_pos %Ld len %d = to_read %Ld"
289  end_pos !counter_pos b.len to_read;  end_pos !counter_pos b.len to_read;
290        
291          let to_read_int = Int64.to_int to_read in          let to_read_int = Int64.to_int to_read in
# Line 301  end_pos !counter_pos b.len to_read; Line 308  end_pos !counter_pos b.len to_read;
308                  Int64Swarmer.received up                  Int64Swarmer.received up
309                    !counter_pos b.buf b.pos to_read_int;                    !counter_pos b.buf b.pos to_read_int;
310            with e ->            with e ->
311                lprintf_nl "FileTP: Exception %s in Int64Swarmer.received"                lprintf_nl () "Exception %s in Int64Swarmer.received"
312                  (Printexc2.to_string e)                  (Printexc2.to_string e)
313          end;          end;
314          c.client_reconnect <- true;          c.client_reconnect <- true;
# Line 311  end_pos !counter_pos b.len to_read; Line 318  end_pos !counter_pos b.len to_read;
318            Int64Swarmer.downloaded swarmer in            Int64Swarmer.downloaded swarmer in
319                    
320          (match d.download_ranges with          (match d.download_ranges with
321              [] -> lprintf "EMPTY Ranges !!!\n"              [] -> lprintf_nl () "EMPTY Ranges!"
322            | r :: _ ->            | r :: _ ->
323  (*  (*
324                let (x,y) = Int64Swarmer.range_range r in                let (x,y) = Int64Swarmer.range_range r in
# Line 349  lprintf "READ: buf_used %d\n" to_read_in Line 356  lprintf "READ: buf_used %d\n" to_read_in
356    with e ->    with e ->
357        if !verbose_hidden_errors then        if !verbose_hidden_errors then
358          begin          begin
359            lprintf "Exception %s in client_parse_header\n" (Printexc2.to_string e);            lprintf_nl () "Exception %s in client_parse_header" (Printexc2.to_string e);
360            AnyEndian.dump header            AnyEndian.dump header
361          end;          end;
362        disconnect_client c (Closed_for_exception e);        disconnect_client c (Closed_for_exception e);
# Line 382  let http_check_size url start_download_f Line 389  let http_check_size url start_download_f
389      } in      } in
390        
391    H.whead r (fun headers ->          H.whead r (fun headers ->      
392        if !verbose then lprintf_nl "RECEIVED HEADERS";        if !verbose then lprintf_nl () "RECEIVED HEADERS";
393        let content_length = ref None in        let content_length = ref None in
394        List.iter (fun (name, content) ->        List.iter (fun (name, content) ->
395            if String.lowercase name = "content-length" then            if String.lowercase name = "content-length" then
396              try                        try          
397                content_length := Some (Int64.of_string content)                content_length := Some (Int64.of_string content)
398              with _ ->              with _ ->
399                  lprintf "bad content length [%s]\n" content;                  lprintf_nl () "bad content length [%s]" content;
400        ) headers;        ) headers;
401        match !content_length with        match !content_length with
402          None -> failwith "Unable to start download (HEAD failed)"          None -> failwith "Unable to start download (HEAD failed)"
# Line 418  by the bandwidth manager... 2004/02/03: Line 425  by the bandwidth manager... 2004/02/03:
425    even in this case... *)    even in this case... *)
426                    
427          | CONNECTED ->          | CONNECTED ->
428            if !verbose then lprintf_nl "CONNECTED !!! Asking for range...";            if !verbose then lprintf_nl () "CONNECTED !!! Asking for range...";
429            f sock            f sock
430          | _ -> ()          | _ -> ()
431      )      )

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

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