/[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.11 by spiralvoice, Fri Jul 22 14:32:12 2005 UTC revision 1.12 by spiralvoice, Tue Jul 26 23:16:48 2005 UTC
# Line 25  open Options Line 25  open Options
25    
26  open BasicSocket  open BasicSocket
27  open TcpBufferedSocket  open TcpBufferedSocket
28      
29  open CommonShared  open CommonShared
30  open CommonUploads  open CommonUploads
31  open CommonOptions  open CommonOptions
# Line 36  open CommonComplexOptions Line 36  open CommonComplexOptions
36  open CommonTypes  open CommonTypes
37  open CommonFile  open CommonFile
38  open CommonGlobals  open CommonGlobals
39  open CommonDownloads    open CommonDownloads
40      
41  open FileTPTypes  open FileTPTypes
42  open FileTPOptions  open FileTPOptions
43  open FileTPGlobals  open FileTPGlobals
# Line 61  let lprintf_n () = Line 61  let lprintf_n () =
61  (*                         MAIN                                          *)  (*                         MAIN                                          *)
62  (*                                                                       *)  (*                                                                       *)
63  (*************************************************************************)  (*************************************************************************)
64      
65  let http_send_range_request c range sock d =  let http_send_range_request c range sock d =
66    let url = d.download_url in    let url = d.download_url in
67      
68    let (x,y) = range in    let (x,y) = range in
69    let range = Printf.sprintf "%Ld-%Ld" x (y -- (Int64.one)) in    let range = Printf.sprintf "%Ld-%Ld" x (y -- (Int64.one)) in
70    
71    let buf = Buffer.create 100 in    let buf = Buffer.create 100 in
72      
73    Printf.bprintf buf "GET %s HTTP/1.0\r\n" url.Url.full_file;    Printf.bprintf buf "GET %s HTTP/1.0\r\n" url.Url.full_file;
74    
75  (*  (*
76              (match d.download_uri with              (match d.download_uri with
77                  FileByUrl url -> Printf.bprintf buf "GET %s HTTP/1.0\r\n" url                  FileByUrl url -> Printf.bprintf buf "GET %s HTTP/1.0\r\n" url
78                | FileByIndex (index, name) ->                | FileByIndex (index, name) ->
79                    Printf.bprintf buf "GET /get/%d/%s HTTP/1.1\r\n" index                    Printf.bprintf buf "GET /get/%d/%s HTTP/1.1\r\n" index
80                      name); *)                      name); *)
81    Printf.bprintf buf "Host: %s\r\n" c.client_hostname;    Printf.bprintf buf "Host: %s\r\n" c.client_hostname;
82    Printf.bprintf buf "User-Agent: %s\r\n" user_agent;    Printf.bprintf buf "User-Agent: %s\r\n" user_agent;
83    Printf.bprintf buf "Range: bytes=%s\r\n" range;    Printf.bprintf buf "Range: bytes=%s\r\n" range;
84    Printf.bprintf buf "Connection: Keep-Alive\r\n";    Printf.bprintf buf "Connection: Keep-Alive\r\n";
85    Printf.bprintf buf "\r\n";    Printf.bprintf buf "\r\n";
# Line 97  let http_send_range_request c range sock Line 97  let http_send_range_request c range sock
97  (*                                                                       *)  (*                                                                       *)
98  (*************************************************************************)  (*************************************************************************)
99    
100      let rec client_parse_header c gconn sock header =
 let rec client_parse_header c gconn sock header =  
101    if !verbose_msg_clients then    if !verbose_msg_clients then
102      lprintf_nl () "CLIENT PARSE HEADER";      lprintf_nl () "CLIENT PARSE HEADER";
103    try    try
104      set_lifetime sock 3600.;      set_lifetime sock 3600.;
105      let d =      let d =
106        match c.client_requests with        match c.client_requests with
107          [] -> failwith "No download request !!!"          [] -> failwith "No download request !!!"
108        | d :: tail ->        | d :: tail ->
109            c.client_requests <- tail;            c.client_requests <- tail;
110            d            d
111      in      in
112      connection_ok c.client_connection_control;      connection_ok c.client_connection_control;
113      set_client_state c Connected_initiating;          set_client_state c Connected_initiating;
114      if !verbose_msg_clients then begin      if !verbose_msg_clients then begin
115          lprintf_nl () "HEADER FROM CLIENT:";          lprintf_nl () "HEADER FROM CLIENT:";
116          AnyEndian.dump_ascii header;          AnyEndian.dump_ascii header;
117        end;        end;
118      let file = d.download_file in      let file = d.download_file in
119      let size = file_size file in      let size = file_size file in
120        
121      let endline_pos = String.index header '\n' in      let endline_pos = String.index header '\n' in
122      let http, code =      let http, code =
123        match String2.split (String.sub header 0 endline_pos        match String2.split (String.sub header 0 endline_pos
124          ) ' ' with          ) ' ' with
125        | http :: code :: ok :: _ ->        | http :: code :: ok :: _ ->
126            let code = int_of_string code in            let code = int_of_string code in
127            if not (String2.starts_with (String.lowercase http) "http") then            if not (String2.starts_with (String.lowercase http) "http") then
128              failwith "Not in http protocol";              failwith "Not in http protocol";
# Line 132  let rec client_parse_header c gconn sock Line 131  let rec client_parse_header c gconn sock
131      in      in
132      if !verbose_msg_clients then      if !verbose_msg_clients then
133        lprintf_nl () "GOOD HEADER FROM CONNECTED CLIENT\n";        lprintf_nl () "GOOD HEADER FROM CONNECTED CLIENT\n";
134        
135      set_rtimeout sock 120.;      set_rtimeout sock 120.;
136  (*              lprintf "SPLIT HEADER...\n"; *)  (*              lprintf "SPLIT HEADER...\n"; *)
137      let lines = Http_client.split_header header in      let lines = Http_client.split_header header in
138  (*              lprintf "REMOVE HEADLINE...\n"; *)  (*              lprintf "REMOVE HEADLINE...\n"; *)
139      let first_line, headers = match lines with      let first_line, headers = match lines with
140          [] -> raise Not_found                  [] -> raise Not_found
141        | line :: headers -> line, headers        | line :: headers -> line, headers
142      in      in
143  (*                  lprintf "CUT HEADERS...\n"; *)  (*                  lprintf "CUT HEADERS...\n"; *)
144      let headers = Http_client.cut_headers headers in      let headers = Http_client.cut_headers headers in
145  (*                  lprintf "START POS...\n"; *)  (*                  lprintf "START POS...\n"; *)
146        
       
147      if !verbose_unknown_messages then begin      if !verbose_unknown_messages then begin
148          let unknown_header = ref false in          let unknown_header = ref false in
149          List.iter (fun (header, _) ->          List.iter (fun (header, _) ->
# Line 160  let rec client_parse_header c gconn sock Line 158  let rec client_parse_header c gconn sock
158              lprintf_nl () "end of header";              lprintf_nl () "end of header";
159            end;            end;
160        end;        end;
       
161    
162      (* I think this is already handeled with the new headder check before      (* I think this is already handeled with the new headder check before
163         download start code         download start code
# Line 176  let rec client_parse_header c gconn sock Line 173  let rec client_parse_header c gconn sock
173        c.client_port <- u.Url.port;        c.client_port <- u.Url.port;
174    
175        let file = new_file (Md4.random ()) u.Url.full_file zero in        let file = new_file (Md4.random ()) u.Url.full_file zero in
176          
177        lprintf_nl () "DOWNLOAD FILE %s" (file_best_name  file);        lprintf_nl () "DOWNLOAD FILE %s" (file_best_name  file);
178        if not (List.memq file !current_files) then begin        if not (List.memq file !current_files) then begin
179      current_files := file :: !current_files;      current_files := file :: !current_files;
180        end;        end;
181        add_download file c u;        add_download file c u;
182        FileTPClients.get_file_from_source c file;        FileTPClients.get_file_from_source c file;
183          
184       end;       end;
185      *)      *)
186    
187      if  code < 200 || code > 299 then      if  code < 200 || code > 299 then
188        failwith "Bad HTTP code";        failwith "Bad HTTP code";
189        
190            let start_pos, end_pos =
     let start_pos, end_pos =  
191        try        try
192          let (range,_) = List.assoc "content-range" headers in          let (range,_) = List.assoc "content-range" headers in
193          try          try
# Line 209  let rec client_parse_header c gconn sock Line 205  let rec client_parse_header c gconn sock
205            let y = Int64.of_string (            let y = Int64.of_string (
206                String.sub range (dash_pos+1) (slash_pos - dash_pos - 1))                String.sub range (dash_pos+1) (slash_pos - dash_pos - 1))
207            in            in
208            if slash_pos = star_pos - 1 then            if slash_pos = star_pos - 1 then
209              x,y ++ Int64.one (* "bytes x-y/*" *)              x,y ++ Int64.one (* "bytes x-y/*" *)
210            else            else
211            let z = Int64.of_string (            let z = Int64.of_string (
212                String.sub range (slash_pos+1) (len - slash_pos -1) )                String.sub range (slash_pos+1) (len - slash_pos -1) )
213            in            in
214            if y = z then x -- Int64.one, size else            if y = z then x -- Int64.one, size else
215              x,y ++ Int64.one              x,y ++ Int64.one
216          with          with
217          | e ->          | e ->
218              lprintf_nl () "Exception %s for range [%s]"              lprintf_nl () "Exception %s for range [%s]"
219                (Printexc2.to_string e) range;                (Printexc2.to_string e) range;
220              raise e              raise e
221        with e ->        with e ->
222            try            try
223              if code <> 206 && code <> 200 then raise Not_found;              if code <> 206 && code <> 200 then raise Not_found;
224              let (len,_) = List.assoc "content-length" headers in              let (len,_) = List.assoc "content-length" headers in
# Line 230  let rec client_parse_header c gconn sock Line 226  let rec client_parse_header c gconn sock
226              if !verbose then lprintf_nl () "Specified length: %Ld" len;              if !verbose then lprintf_nl () "Specified length: %Ld" len;
227              match d.download_ranges with              match d.download_ranges with
228                [] -> raise Not_found                [] -> raise Not_found
229              | (start_pos,end_pos,r) :: _ ->              | (start_pos,end_pos,r) :: _ ->
230                  lprintf_nl () "WARNING: Assuming client is replying to range";                  lprintf_nl () "WARNING: Assuming client is replying to range";
231                  if len <> end_pos -- start_pos then                  if len <> end_pos -- start_pos then
232                    begin                    begin
# Line 240  let rec client_parse_header c gconn sock Line 236  let rec client_parse_header c gconn sock
236                      raise Not_found                      raise Not_found
237                    end;                    end;
238                  (start_pos, end_pos)                  (start_pos, end_pos)
239            with _ ->            with _ ->
240  (* A bit dangerous, no ??? *)  (* A bit dangerous, no ??? *)
241                if !verbose_hidden_errors then                if !verbose_hidden_errors then
242                  lprintf_nl () "ERROR: Could not find/parse range header (exception %s), disconnect\nHEADER: %s"                  lprintf_nl () "ERROR: Could not find/parse range header (exception %s), disconnect\nHEADER: %s"
# Line 248  let rec client_parse_header c gconn sock Line 244  let rec client_parse_header c gconn sock
244                      (String.escaped header);                      (String.escaped header);
245                disconnect_client c (Closed_for_error "Bad HTTP Range");                disconnect_client c (Closed_for_error "Bad HTTP Range");
246                raise Exit                raise Exit
247      in      in
248      (try      (try
249          let (len,_) = List.assoc "content-length" headers in          let (len,_) = List.assoc "content-length" headers in
250          let len = Int64.of_string len in          let len = Int64.of_string len in
# Line 259  let rec client_parse_header c gconn sock Line 255  let rec client_parse_header c gconn sock
255                start_pos end_pos len                start_pos end_pos len
256                (String.escaped header);                (String.escaped header);
257            end            end
258        with _ ->        with _ ->
259            lprintf_nl () "[WARNING]: no Content-Length field\n%s\n"            lprintf_nl () "[WARNING]: no Content-Length field\n%s\n"
260              (String.escaped header)              (String.escaped header)
261      );      );
262        
263      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"
264        start_pos end_pos (end_pos -- start_pos)        start_pos end_pos (end_pos -- start_pos)
265      (String.escaped header)      (String.escaped header)
# Line 274  let rec client_parse_header c gconn sock Line 270  let rec client_parse_header c gconn sock
270      for i = 1 to max_queued_ranges do      for i = 1 to max_queued_ranges do
271        if List.length d.download_ranges <= max_queued_ranges then        if List.length d.download_ranges <= max_queued_ranges then
272          (try get_from_client sock c with _ -> ());          (try get_from_client sock c with _ -> ());
273      done;      done;
274      gconn.gconn_handler <- Reader (fun gconn sock ->      gconn.gconn_handler <- Reader (fun gconn sock ->
275          if file_state file <> FileDownloading then begin          if file_state file <> FileDownloading then begin
276              disconnect_client c Closed_by_user;              disconnect_client c Closed_by_user;
277              raise Exit;              raise Exit;
278            end;            end;
279            
280          let b = TcpBufferedSocket.buf sock in          let b = TcpBufferedSocket.buf sock in
281          let to_read = (*min (end_pos -- !counter_pos) *)          let to_read = (*min (end_pos -- !counter_pos) *)
282            (Int64.of_int b.len) in            (Int64.of_int b.len) in
283    
284          if !verbose then lprintf_nl () "Reading: end_pos %Ld counter_pos %Ld len %d = to_read %Ld"          if !verbose then lprintf_nl () "Reading: end_pos %Ld counter_pos %Ld len %d = to_read %Ld"
285  end_pos !counter_pos b.len to_read;  end_pos !counter_pos b.len to_read;
286      
287          let to_read_int = Int64.to_int to_read in          let to_read_int = Int64.to_int to_read in
288  (*  (*
289          if !verbose then lprintf "CHUNK: %s\n"          if !verbose then lprintf "CHUNK: %s\n"
290            (String.escaped (String.sub b.buf b.pos to_read_int)); *)            (String.escaped (String.sub b.buf b.pos to_read_int)); *)
291          let swarmer = match file.file_swarmer with          let swarmer = match file.file_swarmer with
292              None -> assert false | Some sw -> sw              None -> assert false | Some sw -> sw
293          in          in
294          let old_downloaded =          let old_downloaded =
295            Int64Swarmer.downloaded swarmer in            Int64Swarmer.downloaded swarmer in
296  (*        List.iter (fun (_,_,r) -> Int64Swarmer.free_range r)    (*        List.iter (fun (_,_,r) -> Int64Swarmer.free_range r)
297          d.download_ranges; *)          d.download_ranges; *)
298            
299          begin          begin
300            try            try
301              match d.download_uploader with              match d.download_uploader with
# Line 307  end_pos !counter_pos b.len to_read; Line 303  end_pos !counter_pos b.len to_read;
303              | Some up ->              | Some up ->
304                  Int64Swarmer.received up                  Int64Swarmer.received up
305                    !counter_pos b.buf b.pos to_read_int;                    !counter_pos b.buf b.pos to_read_int;
306            with e ->            with e ->
307                lprintf_nl () "Exception %s in Int64Swarmer.received"                lprintf_nl () "Exception %s in Int64Swarmer.received"
308                  (Printexc2.to_string e)                  (Printexc2.to_string e)
309          end;          end;
310          c.client_reconnect <- true;          c.client_reconnect <- true;
311  (*          List.iter (fun (_,_,r) ->  (*          List.iter (fun (_,_,r) ->
312                Int64Swarmer.alloc_range r) d.download_ranges; *)                Int64Swarmer.alloc_range r) d.download_ranges; *)
313          let new_downloaded =          let new_downloaded =
314            Int64Swarmer.downloaded swarmer in            Int64Swarmer.downloaded swarmer in
315            
316          (match d.download_ranges with          (match d.download_ranges with
317              [] -> lprintf_nl () "EMPTY Ranges!"              [] -> lprintf_nl () "EMPTY Ranges!"
318            | r :: _ ->            | r :: _ ->
319  (*  (*
320                let (x,y) = Int64Swarmer.range_range r in                let (x,y) = Int64Swarmer.range_range r in
321                if !verbose then lprintf_nl "Received %Ld [%Ld] (%Ld-%Ld) -> %Ld"                if !verbose then lprintf_nl "Received %Ld [%Ld] (%Ld-%Ld) -> %Ld"
322                  !counter_pos to_read                  !counter_pos to_read
323                  x y                  x y
324                  (new_downloaded -- old_downloaded)                  (new_downloaded -- old_downloaded)
325  *)          *)
326                ()                ()
327          );          );
328            
329          if new_downloaded = file_size file then          if new_downloaded = file_size file then
330            download_finished file;            download_finished file;
331  (*  (*
# Line 352  lprintf "READ: buf_used %d\n" to_read_in Line 348  lprintf "READ: buf_used %d\n" to_read_in
348                  if d.download_ranges = [] then raise Exit;                  if d.download_ranges = [] then raise Exit;
349                  gconn.gconn_handler <- HttpHeader (client_parse_header c);                  gconn.gconn_handler <- HttpHeader (client_parse_header c);
350            end)            end)
351      
352    with e ->    with e ->
353        if !verbose_hidden_errors then        if !verbose_hidden_errors then
354          begin          begin
# Line 361  lprintf "READ: buf_used %d\n" to_read_in Line 357  lprintf "READ: buf_used %d\n" to_read_in
357          end;          end;
358        disconnect_client c (Closed_for_exception e);        disconnect_client c (Closed_for_exception e);
359        raise e        raise e
         
360    
361  (*************************************************************************)  (*************************************************************************)
362  (*                                                                       *)  (*                                                                       *)
363  (*                         MAIN                                          *)  (*                         MAIN                                          *)
364  (*                                                                       *)  (*                                                                       *)
365  (*************************************************************************)  (*************************************************************************)
366            
367  let http_set_sock_handler c sock =  let http_set_sock_handler c sock =
368    set_fileTP_sock sock (HttpHeader (client_parse_header c))    set_fileTP_sock sock (HttpHeader (client_parse_header c))
369    
# Line 377  let http_set_sock_handler c sock = Line 372  let http_set_sock_handler c sock =
372  (*                         MAIN                                          *)  (*                         MAIN                                          *)
373  (*                                                                       *)  (*                                                                       *)
374  (*************************************************************************)  (*************************************************************************)
375      
376  let http_check_size url start_download_file =  let http_check_size url start_download_file =
377    let module H = Http_client in    let module H = Http_client in
378    let r = {    let r = {
# Line 387  let http_check_size url start_download_f Line 382  let http_check_size url start_download_f
382        H.req_request = H.HEAD;        H.req_request = H.HEAD;
383        H.req_user_agent = user_agent;        H.req_user_agent = user_agent;
384      } in      } in
385      
386    H.whead r (fun headers ->          H.whead r (fun headers ->
387        if !verbose then lprintf_nl () "RECEIVED HEADERS";        if !verbose then lprintf_nl () "RECEIVED HEADERS";
388        let content_length = ref None in        let content_length = ref None in
389        List.iter (fun (name, content) ->        List.iter (fun (name, content) ->
390            if String.lowercase name = "content-length" then            if String.lowercase name = "content-length" then
391              try                        try
392                content_length := Some (Int64.of_string content)                content_length := Some (Int64.of_string content)
393              with _ ->              with _ ->
394                  lprintf_nl () "bad content length [%s]" content;                  lprintf_nl () "bad content length [%s]" content;
395        ) headers;        ) headers;
396        match !content_length with        match !content_length with
# Line 411  let http_check_size url start_download_f Line 406  let http_check_size url start_download_f
406    
407  let http_connect token c f =  let http_connect token c f =
408    let ip = Ip.from_name c.client_hostname in    let ip = Ip.from_name c.client_hostname in
409    connect token "fileTP download"    connect token "fileTP download"
410        (Ip.to_inet_addr ip) c.client_port        (Ip.to_inet_addr ip) c.client_port
411        (fun sock event ->        (fun sock event ->
412          match event with          match event with
# Line 423  let http_connect token c f = Line 418  let http_connect token c f =
418  (* You can only use the CONNECTED signal if the socket is not yet controlled  (* You can only use the CONNECTED signal if the socket is not yet controlled
419  by the bandwidth manager... 2004/02/03: Normally, not true anymore, it should now work  by the bandwidth manager... 2004/02/03: Normally, not true anymore, it should now work
420    even in this case... *)    even in this case... *)
421            
422          | CONNECTED ->          | CONNECTED ->
423            if !verbose then lprintf_nl () "CONNECTED !!! Asking for range...";            if !verbose then lprintf_nl () "CONNECTED !!! Asking for range...";
424            f sock            f sock
# Line 438  let proto = Line 433  let proto =
433      proto_string = "http";      proto_string = "http";
434      proto_connect = http_connect;      proto_connect = http_connect;
435    }    }
   

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

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