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

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

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

revision 1.5 by mldonkey, Wed Aug 4 16:59:27 2004 UTC revision 1.6 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 59  let shell_command hostname = Line 59  let shell_command hostname =
59          cmd, Array.of_list args          cmd, Array.of_list args
60      | _ -> raise Not_found      | _ -> raise Not_found
61    with    with
62    | _ ->    | _ ->
63        "ssh",  [|  "ssh"; hostname |]          "ssh",  [|  "ssh"; hostname |]
64          
65  (*************************************************************************)  (*************************************************************************)
66  (*                                                                       *)  (*                                                                       *)
67  (*                         MAIN                                          *)  (*                         MAIN                                          *)
68  (*                                                                       *)  (*                                                                       *)
69  (*************************************************************************)  (*************************************************************************)
70    
71  let segment_received c num s pos =  let segment_received c num s pos =
72    if String.length s > 0 then    if String.length s > 0 then
73      let d =      let d =
74        match c.client_downloads with        match c.client_downloads with
# Line 80  let segment_received c num s pos = Line 80  let segment_received c num s pos =
80                raise Exit;                raise Exit;
81              end;              end;
82            d            d
83      in        in
84      let file = d.download_file in      let file = d.download_file in
85  (*  (*
86    lprintf "CHUNK: %s\n"    lprintf "CHUNK: %s\n"
87            (String.escaped (String.sub b.buf b.pos to_read_int)); *)            (String.escaped (String.sub b.buf b.pos to_read_int)); *)
88        
89      begin      begin
90        try        try
91          match d.download_uploader with          match d.download_uploader with
92            None -> assert false            None -> assert false
93          | Some up ->          | Some up ->
94                
95              let swarmer = Int64Swarmer.uploader_swarmer up in              let swarmer = Int64Swarmer.uploader_swarmer up in
96              let old_downloaded =              let old_downloaded =
97                Int64Swarmer.downloaded swarmer in                Int64Swarmer.downloaded swarmer in
98              Int64Swarmer.received up              Int64Swarmer.received up
99                pos s 0 (String.length s);                pos s 0 (String.length s);
100                
101              let new_downloaded =              let new_downloaded =
102                Int64Swarmer.downloaded swarmer in                Int64Swarmer.downloaded swarmer in
103                
104              if new_downloaded = file_size file then              if new_downloaded = file_size file then
105                download_finished file;                download_finished file;
106                
107                      with e ->
       with e ->  
108            lprintf "FT: Exception %s in Int64Swarmer.received\n"            lprintf "FT: Exception %s in Int64Swarmer.received\n"
109              (Printexc2.to_string e)              (Printexc2.to_string e)
110      end;      end;
# Line 116  let segment_received c num s pos = Line 115  let segment_received c num s pos =
115  lprintf "READ %Ld\n" (new_downloaded -- old_downloaded);  lprintf "READ %Ld\n" (new_downloaded -- old_downloaded);
116  lprintf "READ: buf_used %d\n" to_read_int;  lprintf "READ: buf_used %d\n" to_read_int;
117    *)    *)
118        
119      (match d.download_ranges with      (match d.download_ranges with
120        | (xx,yy,r) :: tail when  pos >= xx && pos <= yy ->        | (xx,yy,r) :: tail when  pos >= xx && pos <= yy ->
121            let (x,y) = Int64Swarmer.range_range r in            let (x,y) = Int64Swarmer.range_range r in
122            lprintf "Remaining: %Ld-%Ld/%Ld-%Ld\n"            lprintf "Remaining: %Ld-%Ld/%Ld-%Ld\n"
123              x y xx yy;              x y xx yy;
124            if x = y then begin            if x = y then begin
125                d.download_ranges <- tail;                d.download_ranges <- tail;
126                (match c.client_sock with                (match c.client_sock with
127                    Connection sock ->                    Connection sock ->
128                      for i = 1 to max_queued_ranges do                      for i = 1 to max_queued_ranges do
129                        if List.length d.download_ranges <= max_queued_ranges then                        if List.length d.download_ranges <= max_queued_ranges then
130                          (try get_from_client sock c with _ -> ());                          (try get_from_client sock c with _ -> ());
131                      done;                      done;
132                  | _ -> ());                  | _ -> ());
133  (* If we have no more range to receive, disconnect *)  (* If we have no more range to receive, disconnect *)
134                lprintf "\n ********** RANGE DOWNLOADED  ********** \n";                lprintf "\n ********** RANGE DOWNLOADED  ********** \n";
                 
135              end              end
136        | (xx,yy,r) :: tail ->        | (xx,yy,r) :: tail ->
137            let (x,y) = Int64Swarmer.range_range r in            let (x,y) = Int64Swarmer.range_range r in
138            lprintf "Bad range (%Ld): %Ld-%Ld/%Ld-%Ld\n"  pos            lprintf "Bad range (%Ld): %Ld-%Ld/%Ld-%Ld\n"  pos
139              x y xx yy;              x y xx yy;
140        | [] ->        | [] ->
141            lprintf "***** outside of ranges !!!\n"            lprintf "***** outside of ranges !!!\n"
142      )      )
143    
# Line 148  lprintf "READ: buf_used %d\n" to_read_in Line 146  lprintf "READ: buf_used %d\n" to_read_in
146  (*                         MAIN                                          *)  (*                         MAIN                                          *)
147  (*                                                                       *)  (*                                                                       *)
148  (*************************************************************************)  (*************************************************************************)
149      
150  let ssh_send_range_request c (x,y) sock d =    let ssh_send_range_request c (x,y) sock d =
151    let file = d.download_url.Url.full_file in    let file = d.download_url.Url.full_file in
152    TcpBufferedSocket.write_string sock    TcpBufferedSocket.write_string sock
153      (Printf.sprintf "%s %s %Ld %Ld %d '.%s'\n"  !!get_range !!range_arg x y      (Printf.sprintf "%s %s %Ld %Ld %d '.%s'\n"  !!get_range !!range_arg x y
154      (file_num d.download_file) file);      (file_num d.download_file) file);
155    ()    ()
156      
157  (*************************************************************************)  (*************************************************************************)
158  (*                                                                       *)  (*                                                                       *)
159  (*                         MAIN                                          *)  (*                         MAIN                                          *)
160  (*                                                                       *)  (*                                                                       *)
161  (*************************************************************************)  (*************************************************************************)
162            
163  let ssh_set_sock_handler c sock =  let ssh_set_sock_handler c sock =
164    ()    ()
165    
166  (*************************************************************************)  (*************************************************************************)
# Line 170  let ssh_set_sock_handler c sock = Line 168  let ssh_set_sock_handler c sock =
168  (*                         MAIN                                          *)  (*                         MAIN                                          *)
169  (*                                                                       *)  (*                                                                       *)
170  (*************************************************************************)  (*************************************************************************)
171      
172  let ssh_check_size url start_download_file =  let ssh_check_size url start_download_file =
173    let token = create_token unlimited_connection_manager in    let token = create_token unlimited_connection_manager in
174    let shell, args = shell_command url.Url.server in    let shell, args = shell_command url.Url.server in
175    lprintf "SHELL: ";    lprintf "SHELL: ";
# Line 180  let ssh_check_size url start_download_fi Line 178  let ssh_check_size url start_download_fi
178    lprintf "\n";    lprintf "\n";
179    let sock, pid = exec_command token  shell args (fun _ _ -> ());    let sock, pid = exec_command token  shell args (fun _ _ -> ());
180    in    in
181      
182    set_rtimer sock (fun _ ->    set_rtimer sock (fun _ ->
183        lprintf "SSH TIMER\n";        lprintf "SSH TIMER\n";
184        (try Unix.kill Sys.sigkill pid with _ -> ());        (try Unix.kill Sys.sigkill pid with _ -> ());
# Line 214  let ssh_check_size url start_download_fi Line 212  let ssh_check_size url start_download_fi
212              iter (i+1)              iter (i+1)
213        in        in
214        iter 0        iter 0
215    );      );
216    let command =    (Printf.sprintf "%s size '.%s' ; exit\n" !!get_range    let command =    (Printf.sprintf "%s size '.%s' ; exit\n" !!get_range
217        url.Url.full_file) in        url.Url.full_file) in
218    lprintf "SSH send [%s]\n" command;    lprintf "SSH send [%s]\n" command;
219    TcpBufferedSocket.write_string sock command;    TcpBufferedSocket.write_string sock command;
# Line 227  let ssh_check_size url start_download_fi Line 225  let ssh_check_size url start_download_fi
225  (*                                                                       *)  (*                                                                       *)
226  (*************************************************************************)  (*************************************************************************)
227    
     
     
228  type segment =  type segment =
229    Nothing    Nothing
230  | SegmentPos of int * int64 * int * int  | SegmentPos of int * int64 * int * int
231  | SegmentXPos of int * int64 * int * int  | SegmentXPos of int * int64 * int * int
232  | Segment of int * int64 * int * int * string  | Segment of int * int64 * int * int * string
233  | SegmentX of int * int64 * int * int * string  | SegmentX of int * int64 * int * int * string
234      
235  let ssh_connect token c f =  let ssh_connect token c f =
236    let ip = c.client_hostname in    let ip = c.client_hostname in
237    let shell, args = shell_command c.client_hostname in    let shell, args = shell_command c.client_hostname in
# Line 251  let ssh_connect token c f = Line 247  let ssh_connect token c f =
247    TcpBufferedSocket.set_reader sock (fun sock nread ->    TcpBufferedSocket.set_reader sock (fun sock nread ->
248        let b = TcpBufferedSocket.buf sock in        let b = TcpBufferedSocket.buf sock in
249        let rec iter () =        let rec iter () =
250            
251          match !segment with          match !segment with
252            SegmentXPos (file_num, pos, len, elen) ->            SegmentXPos (file_num, pos, len, elen) ->
253                
254              if b.len >= elen then begin              if b.len >= elen then begin
255                  segment := SegmentX (file_num, pos, len, elen,                  segment := SegmentX (file_num, pos, len, elen,
256                    String.sub b.buf b.pos elen);                    String.sub b.buf b.pos elen);
257                  buf_used b elen;                  buf_used b elen;
258                  iter0 0                  iter0 0
259                end                end
260                
261          | _ ->          | _ ->
262              iter0 0              iter0 0
263                
264        and iter0 i =        and iter0 i =
265          if i < b.len then          if i < b.len then
266            if b.buf.[b.pos + i] = '\n' then begin            if b.buf.[b.pos + i] = '\n' then begin
# Line 274  let ssh_connect token c f = Line 270  let ssh_connect token c f =
270                let line = String.sub b.buf b.pos slen in                let line = String.sub b.buf b.pos slen in
271  (*              lprintf "SSH LINE [%s]\n" line; *)  (*              lprintf "SSH LINE [%s]\n" line; *)
272                buf_used b (i+1);                buf_used b (i+1);
273                  
274                if String2.starts_with line "[SEGMENT " && !segment = Nothing then                if String2.starts_with line "[SEGMENT " && !segment = Nothing then
275                  let line = String.sub line 9 (String.length line - 10) in                  let line = String.sub line 9 (String.length line - 10) in
276                  lprintf "segmented [%s]\n" line;                  lprintf "segmented [%s]\n" line;
# Line 287  let ssh_connect token c f = Line 283  let ssh_connect token c f =
283                      segment := SegmentPos (file_num, pos,len,elen);                      segment := SegmentPos (file_num, pos,len,elen);
284                      lprintf "Waiting for segment...\n";                      lprintf "Waiting for segment...\n";
285                      iter0 0                      iter0 0
286                        
287                  | ["8bits"; file_num; pos; len; elen] ->                  | ["8bits"; file_num; pos; len; elen] ->
288                      let file_num = int_of_string file_num in                      let file_num = int_of_string file_num in
289                      let pos = Int64.of_string pos in                      let pos = Int64.of_string pos in
# Line 296  let ssh_connect token c f = Line 292  let ssh_connect token c f =
292                      segment := SegmentXPos (file_num, pos,len,elen);                      segment := SegmentXPos (file_num, pos,len,elen);
293                      lprintf "Waiting for segment X...\n";                      lprintf "Waiting for segment X...\n";
294                      iter ()                      iter ()
295                        
296                  | _ ->                  | _ ->
297                      lprintf "SSH: unexpected segment\n";                      lprintf "SSH: unexpected segment\n";
298                      disconnect_client c (Closed_for_error "unexpected reply")                      disconnect_client c (Closed_for_error "unexpected reply")
# Line 315  let ssh_connect token c f = Line 311  let ssh_connect token c f =
311                      segment_received c file_num ss pos;                      segment_received c file_num ss pos;
312                      segment := Nothing;                      segment := Nothing;
313                      iter0 0                      iter0 0
314                        
315                  | SegmentX (file_num, pos, len, elen, ss) ->                  | SegmentX (file_num, pos, len, elen, ss) ->
316                      lprintf "******* SEGMENT RECEIVED *******\n";                      lprintf "******* SEGMENT RECEIVED *******\n";
317                      segment_received c file_num ss pos;                      segment_received c file_num ss pos;
# Line 324  let ssh_connect token c f = Line 320  let ssh_connect token c f =
320                  | _ ->                  | _ ->
321                      lprintf "SSH: unexpected end of segment\n";                      lprintf "SSH: unexpected end of segment\n";
322                      disconnect_client c (Closed_for_error "unexpected reply")                      disconnect_client c (Closed_for_error "unexpected reply")
323                        
324                else                else
325                match !segment with                match !segment with
326                  Nothing -> iter0 0                  Nothing -> iter0 0
# Line 338  let ssh_connect token c f = Line 334  let ssh_connect token c f =
334                    end                    end
335              end else              end else
336              iter0 (i+1)              iter0 (i+1)
337                
338        in        in
339        iter ()        iter ()
340    );      );
341    f sock;    f sock;
342    sock    sock
343      
344  let proto =  let proto =
345    {    {
346      proto_send_range_request = ssh_send_range_request;      proto_send_range_request = ssh_send_range_request;
# Line 353  let proto = Line 349  let proto =
349      proto_string = "ssh";      proto_string = "ssh";
350      proto_connect = ssh_connect;      proto_connect = ssh_connect;
351    }    }
     
     

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

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