1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
3 This file is part of mldonkey.
5 mldonkey is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 mldonkey is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with mldonkey; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19 (* The function handling the cooperation between two clients. Most used
20 functions are defined in downloadOneFile.ml *)
34 open CommonComplexOptions
45 open TcpBufferedSocket
48 open DonkeyComplexOptions
52 open DonkeyReliability
55 module VB
= VerificationBitmap
57 let log_prefix = "[EDK]"
60 lprintf_nl2
log_prefix fmt
62 module Udp
= DonkeyProtoUdp
64 (* Lifetime of a socket after sending interesting messages *)
65 let active_lifetime = 1200.
68 (*************************************************************************)
69 (* adding a source to the source-management *)
70 (*************************************************************************)
71 let add_source file ip tcp_port serverIP serverPort
=
72 (* man, we are receiving sources from some clients even when we release *)
73 if (file_state file
) = FileDownloading
then
80 (* without server, we can't request a callback *)
81 let s = Hashtbl.find servers_by_key serverIP
in
82 if serverPort
= s.server_port
then
83 Indirect_address
(serverIP
, serverPort
, id_of_ip ip
, 0, Ip.null
)
87 if !!update_server_list_client
then
89 ignore
(check_add_server serverIP serverPort
);
90 Indirect_address
(serverIP
, serverPort
, id_of_ip ip
, 0, Ip.null
)
95 if Ip.usable ip
then begin
96 let uid = Direct_address
(ip
, tcp_port
) in
98 cc := (DonkeySources.find_source_by_uid
uid).DonkeySources.source_country_code
;
100 cc := Geoip.get_country_code_option ip
);
101 if not
(is_black_address ip tcp_port
!cc) then
102 if not
( Hashtbl.mem banned_ips ip
) then
112 let s = DonkeySources.create_source_by_uid
uid !cc in
113 DonkeySources.set_request_result
s file
.file_sources File_new_source
;
116 let is_banned c sock
=
117 c
.client_banned
<- Hashtbl.mem banned_ips
(fst
(peer_addr sock
))
120 (* Supports Emule Extended Protocol *)
121 let supports_eep cb
=
123 Brand_lmule
| Brand_newemule
| Brand_cdonkey
|
124 Brand_emuleplus
| Brand_hydranode
| Brand_mldonkey3
|
125 Brand_shareaza
| Brand_amule
| Brand_lphant
| Brand_verycd
| Brand_imp
-> true
128 let ban_client c sock msg
=
129 let ip = fst
(peer_addr sock
) in
130 if not
(Hashtbl.mem banned_ips
ip) then
131 let module M
= DonkeyProtoClient
in
134 lprintf_nl "banned: %s %s" msg
(full_client_identifier c
);
137 c
.client_banned
<- true;
138 Hashtbl.add banned_ips
ip (last_time
());
140 if !!send_warning_messages
then
141 client_send c
( M.SayReq
(
143 "[AUTOMATED ERROR] Your client %s has been banned" msg
))
145 let corruption_warning c
=
146 if !!send_warning_messages
then
147 let module M
= DonkeyProtoClient
in
150 [AUTOMATED WARNING] It has been detected that your client
151 is sending corrupted data. Please double-check your hardware
152 (disk, memory, cpu) and software (latest version ?)")
154 let request_for c file sock
=
155 if !!ban_queue_jumpers
then
157 let record = Hashtbl.find old_requests
(client_num c
, file_num file
) in
158 if record.last_request
+ 540 > last_time
() then begin
159 let old_time = last_time
() - record.last_request
in
160 record.nwarnings
<- record.nwarnings
+ 1;
161 record.last_request
<- last_time
();
162 if record.nwarnings
> 3 then raise Exit
;
163 let module M
= DonkeyProtoClient
in
164 if record.nwarnings
= 3 then begin
165 ban_client c sock
"is connecting too fast";
169 lprintf_nl "warning no. %d, connecting too fast (last connect %d sec. ago): %s"
170 record.nwarnings
old_time (full_client_identifier c
);
171 if !!send_warning_messages
then
172 client_send c
( M.SayReq
(
173 "[AUTOMATED WARNING] Your client is connecting too fast, it will get banned"))
175 record.last_request
<- last_time
();
178 Hashtbl.add old_requests
(client_num c
, file_num file
)
179 { last_request
= last_time
(); nwarnings
= 0; }
182 let clean_requests () = (* to be called every hour *)
183 Hashtbl.clear old_requests
;
184 let remove_ips = ref [] in
185 Hashtbl.iter
(fun ip time
->
186 if time
+ 3600 * !!ban_period
< last_time
() then
187 remove_ips := ip :: !remove_ips
190 Hashtbl.remove banned_ips
ip;
195 let client_enter_upload_queue c
=
196 do_if_connected c
.client_source
.DonkeySources.source_sock
(fun sock
->
197 set_rtimeout sock
!!upload_timeout
;
198 c
.client_connect_time
<- last_time
();
200 let module M
= DonkeyProtoClient
in
201 let module Q
= M.AvailableSlot
in
202 M.AvailableSlotReq
Q.t
);
205 lprintf_nl "New uploader %s%s%s"
206 (full_client_identifier c
)
207 (let slot_text = string_of_slot_kind
(client_slot
(as_client c
)) true in
208 if slot_text = "" then "" else Printf.sprintf
"(%s)" slot_text)
209 (match client_upload
(as_client c
) with
211 | Some f
-> Printf.sprintf
" for file %s" (CommonFile.file_best_name f
))
214 client_ops
.op_client_enter_upload_queue
<- client_enter_upload_queue
217 let log_client_info c sock
=
218 let buf = Buffer.create
100 in
219 let date = BasicSocket.date_of_int
(last_time
()) in
220 Printf.bprintf
buf "%-12s(%d):%d -> %-30s[%-14s %-20s] connected for %5d secs %-10s bw %5d/%-5d %-6s %2d/%-2d reqs "
225 let s = c
.client_name
in
226 let len = String.length
s in
227 if len > 30 then String.sub
s 0 30 else s)
229 (brand_to_string c
.client_brand
)
230 (match c
.client_kind
with Indirect_address
_ | Invalid_address
_ -> "LowID"
231 | Direct_address
(ip,port
) -> Printf.sprintf
"%s:%d"
232 (Ip.to_string
ip) port
)
233 (last_time
() - c
.client_connect_time
)
234 (if c
.client_rank
> 0 then
235 Printf.sprintf
"rank %d" c
.client_rank
237 (nwritten sock
) (nread sock
)
238 (if c
.client_banned
then "banned" else "")
239 c
.client_requests_received
240 c
.client_requests_sent
244 Printf.bprintf
buf "(%d)" r
.DonkeySources.request_score
;
245 ) c
.client_source
.DonkeySources.source_files
;
246 Buffer.add_char
buf '
\n'
;
247 let m = Buffer.contents
buf in
248 CommonEvent.add_event
(Console_message_event
m)
250 let disconnect_client c reason
=
251 match c
.client_source
.DonkeySources.source_sock
with
253 | ConnectionWaiting token
->
255 c
.client_source
.DonkeySources.source_sock
<- NoConnection
258 DonkeyOneFile.remove_client_slot c
;
259 c
.client_comp
<- None
;
260 (try if c
.client_checked
then count_seen c
with _ -> ());
261 (try if !!log_clients_on_console
&& c
.client_name
<> "" then
262 log_client_info c sock
with _ -> ());
263 c
.client_connect_time
<- 0;
264 (try Hashtbl.remove connected_clients c
.client_md4
with _ -> ());
265 (try CommonUploads.remove_pending_slot
(as_client c
) with _ -> ());
266 (try TcpBufferedSocket.close sock reason
with _ -> ());
268 (* Remove the Connected and NoLimit tags *)
269 set_client_type c
(client_type c
270 land (lnot
(client_initialized_tag
lor client_nolimit_tag
)));
271 c
.client_source
.DonkeySources.source_sock
<- NoConnection
;
273 c
.client_slot
<- SlotNotAsked
;
275 (* clean_client_zones: clean all structures related to downloads when
276 a client disconnects *)
278 match c
.client_download
with
281 CommonSwarming.unregister_uploader up
;
282 c
.client_download
<- None
285 List.iter
(fun (file
, chunks
, up
) ->
286 try CommonSwarming.unregister_uploader up
with _ -> ()
287 ) c
.client_file_queue
;
289 c
.client_file_queue
<- [];
290 c
.client_session_downloaded
<- 0L;
292 with e
-> lprintf_nl "Exception %s in disconnect_client"
293 (Printexc2.to_string e
));
294 set_client_disconnected c reason
;
295 DonkeySources.source_disconnected c
.client_source
297 let client_send_if_possible c sock msg
=
298 if can_write_len sock
(!!client_buffer_size
/2) then
301 let tag_udp_client = 203
303 let client_can_receive c
=
304 match c
.client_brand
with
305 | Brand_mldonkey2
-> true
306 | Brand_mldonkey3
-> true
309 let new_udp_client c group
=
310 match c
.client_kind
with
311 Indirect_address
_ | Invalid_address
_ -> ()
312 | Direct_address
(ip, port
) ->
314 udp_client_last_conn
= last_time
();
316 udp_client_port
= port
;
317 udp_client_can_receive
= client_can_receive c
322 let uc = UdpClientWHashtbl.find udp_clients
uc in
323 uc.udp_client_last_conn
<- last_time
();
326 Heap.set_tag
uc tag_udp_client;
327 UdpClientWHashtbl.add udp_clients
uc;
330 group
.group
<- UdpClientMap.add c
.client_kind
uc group
.group
333 let udp_client_send uc t
=
334 if not
(is_black_address
uc.udp_client_ip
(uc.udp_client_port
+4) None
) then
336 DonkeyProtoCom.udp_send
(get_udp_sock
())
337 uc.udp_client_ip
(uc.udp_client_port
+4)
341 let client_udp_send ip port t
=
342 if not
(is_black_address
ip (port
+4) None
) then
344 DonkeyProtoCom.udp_send
(get_udp_sock
())
349 let find_sources_in_groups c md4
=
350 if !!propagate_sources
&&
351 (match c
.client_brand
with
352 Brand_mldonkey1
| Brand_overnet
-> false
355 let group = Hashtbl.find file_groups md4
in
357 let uc = UdpClientMap.find c
.client_kind
group.group in
358 uc.udp_client_last_conn
<- last_time
()
359 (* the client is already known *)
361 (* a new client for this group *)
362 if client_can_receive c
then begin
363 do_if_connected c
.client_source
.DonkeySources.source_sock
(fun sock
->
364 (* send the list of members of the group to the client *)
366 UdpClientMap.iter
(fun _ uc ->
367 match ip_reliability
uc.udp_client_ip
with
368 Reliability_reliable
| Reliability_neutral
->
369 list := (uc.udp_client_ip
, uc.udp_client_port
, uc.udp_client_ip
) :: !list
370 | Reliability_suspicious
_ -> ()
372 if !list <> [] then begin
373 if !verbose_sources
> 2 then
374 lprintf_nl "Send %d sources from file groups to mldonkey peer" (List.length
!list);
376 let module Q
= DonkeyProtoClient.Sources
in
377 DonkeyProtoClient.SourcesReq
{
382 client_send_if_possible c sock
msg
387 match c
.client_kind
with
388 Indirect_address
_ | Invalid_address
_ -> ()
389 | Direct_address
(ip, port
) ->
390 (* send this client as a source for the file to all mldonkey clients in the group. add client to group *)
392 UdpClientMap.iter
(fun _ uc ->
393 if uc.udp_client_can_receive
then begin
394 if !verbose_sources
> 2 then
395 lprintf_nl "Send new source to file groups UDP peers";
397 Udp.QueryLocationReplyUdpReq
(
398 let module Q
= DonkeyProtoServer.QueryLocationReply
in
401 Q.locs
= [{ Q.ip = ip; Q.port
= port
}];
405 new_udp_client c
group
407 if Fifo.length
DonkeyGlobals.file_groups_fifo
>= max_file_groups
then
408 Hashtbl.remove file_groups
(Fifo.take file_groups_fifo
);
409 let group = { group = UdpClientMap.empty
} in
410 Hashtbl.add file_groups md4
group;
411 Fifo.put
DonkeyGlobals.file_groups_fifo md4
;
412 new_udp_client c
group
414 let clean_groups () =
415 let one_day_before = last_time
() - Date.day_in_secs
in
416 Hashtbl.iter
(fun file
group ->
417 let map = group.group in
418 group.group <- UdpClientMap.empty
;
419 UdpClientMap.iter
(fun v
uc ->
420 if uc.udp_client_last_conn
> one_day_before then
421 group.group <- UdpClientMap.add v
uc group.group
425 let client_wants_file c md4
=
426 if md4
<> Md4.null
&& md4
<> Md4.one
&& md4
<> Md4.two
then begin
427 find_sources_in_groups c md4
;
431 let new_chunk up begin_pos end_pos
=
432 let req_size = end_pos
-- begin_pos
in
433 let req_location = (begin_pos
++ end_pos
) // (2L ** block_size
) in
434 if !verbose_upload
then
435 lprintf_nl "new block: (%Ld,%Ld) size %Ld chunk #%Ld" begin_pos end_pos
req_size req_location;
436 if (req_size < Int64.zero
) || (req_size > zone_size
) || ((up
.up_current
<> req_location) && (req_size <> Int64.zero
)) then
437 up
.up_finish
<- true;
438 if ((not up
.up_finish
) || (not
!!upload_complete_chunks
)) && (req_size > Int64.zero
) && (req_size <= zone_size
) then
439 let chunk = (begin_pos
, end_pos
) in
440 (* the zone requested is already "in the pipe" *)
441 if not
(List.mem
chunk up
.up_flying_chunks
) then
442 match up
.up_chunks
with
444 up
.up_pos
<- begin_pos
;
445 up
.up_end_chunk
<- end_pos
;
446 up
.up_chunks
<- [chunk];
448 if not
(List.mem
chunk up_chunks
) then
449 up
.up_chunks
<- up_chunks
@ [chunk]
451 let identify_client_brand c
=
452 if c
.client_brand
= Brand_unknown
then
453 let md4 = Md4.direct_to_string c
.client_md4
in
455 if md4.[5] = Char.chr
14 && md4.[14] = Char.chr
111 then
457 else if md4.[5] = 'M'
&& md4.[14] = 'L'
then
460 if DonkeySources.source_brand c
.client_source
then
461 Brand_overnet
else Brand_edonkey
)
465 ("extasy", Brand_mod_extasy
);
466 ("hunter", Brand_mod_hunter
);
467 ("mortimer", Brand_mod_mortimer
);
468 ("sivka", Brand_mod_sivka
);
469 ("plus", Brand_mod_plus
);
470 ("lsd", Brand_mod_lsd
);
471 ("maella", Brand_mod_maella
);
472 ("pille", Brand_mod_pille
);
473 ("morphkad", Brand_mod_morphkad
);
474 ("ef-mod", Brand_mod_efmod
);
475 ("efmod", Brand_mod_efmod
);
476 ("xtreme", Brand_mod_xtreme
);
477 ("bionic", Brand_mod_bionic
);
478 ("pawcio", Brand_mod_pawcio
);
479 ("gammaoh", Brand_mod_gammaoh
);
480 ("zzul", Brand_mod_zzul
);
481 ("black hand", Brand_mod_blackhand
);
482 ("lovelace", Brand_mod_lovelace
);
483 ("morphnext", Brand_mod_morphnext
);
484 ("fincan", Brand_mod_fincan
);
485 ("ewombat", Brand_mod_ewombat
);
486 ("mortillo", Brand_mod_mortillo
);
487 ("emulespa\241a", Brand_mod_emulespana
);
488 ("blackrat", Brand_mod_blackrat
);
489 ("enkeydev", Brand_mod_enkeydev
);
490 ("gnaddelwarz", Brand_mod_gnaddelwarz
);
491 ("phoenix-kad", Brand_mod_phoenixkad
);
492 ("phoenix", Brand_mod_phoenix
);
493 ("koizo", Brand_mod_koizo
);
494 ("ed2kfiles", Brand_mod_ed2kfiles
);
495 ("athlazan", Brand_mod_athlazan
);
496 ("goldi cryptum", Brand_mod_goldicryptum
);
497 ("cryptum", Brand_mod_cryptum
);
498 ("lamerzchoice", Brand_mod_lamerzchoice
);
499 ("notdead", Brand_mod_notdead
);
500 ("peace", Brand_mod_peace
);
501 ("eastshare", Brand_mod_eastshare
);
502 ("[mfck]", Brand_mod_mfck
);
503 ("echanblard", Brand_mod_echanblard
);
504 ("sp4rk", Brand_mod_sp4rk
);
505 ("bloodymad", Brand_mod_bloodymad
);
506 ("roman2k", Brand_mod_roman2k
);
507 ("elfenwombat", Brand_mod_elfenwombat
);
508 ("o\178", Brand_mod_o2
);
509 ("sf-iom", Brand_mod_sfiom
);
510 ("magic-elseve", Brand_mod_magic_elseve
);
511 ("schlumpmule", Brand_mod_schlumpmule
);
512 ("noamson", Brand_mod_noamson
);
513 ("stormit", Brand_mod_stormit
);
514 ("omax", Brand_mod_omax
);
515 ("spiders", Brand_mod_spiders
);
516 ("ib\233ricaxt", Brand_mod_ibericaxt
);
517 ("ib\233rica", Brand_mod_iberica
);
518 ("stonehenge", Brand_mod_stonehenge
);
519 ("mison", Brand_mod_mison
);
520 ("xlillo", Brand_mod_xlillo
);
521 ("imperator", Brand_mod_imperator
);
522 ("raziboom", Brand_mod_raziboom
);
523 ("khaos", Brand_mod_khaos
);
524 ("hardmule", Brand_mod_hardmule
);
525 ("sc", Brand_mod_sc
);
526 ("cy4n1d", Brand_mod_cy4n1d
);
527 ("dmx", Brand_mod_dmx
);
528 ("ketamine", Brand_mod_ketamine
);
529 ("blackmule", Brand_mod_blackmule
);
530 ("morphxt", Brand_mod_morphxt
);
531 ("ngdonkey", Brand_mod_ngdonkey
);
532 ("morph", Brand_mod_morph
);
533 ("emule.de", Brand_mod_emulede
);
534 ("aldo", Brand_mod_aldo
);
535 ("dm", Brand_mod_dm
);
536 ("lc", Brand_mod_lc
);
537 ("lh", Brand_mod_lh
);
538 ("l!onetwork", Brand_mod_lh
);
539 ("lionetwork", Brand_mod_lh
);
540 ("hawkstar", Brand_mod_hawkstar
);
541 ("neo mule", Brand_mod_neomule
);
542 ("cyrex", Brand_mod_cyrex
);
543 ("zx", Brand_mod_zx
);
544 ("ackronic", Brand_mod_ackronic
);
545 ("rappis", Brand_mod_rappis
);
546 ("overdose", Brand_mod_overdose
);
547 ("hebmule", Brand_mod_hebmule
);
548 ("senfei", Brand_mod_senfei
);
549 ("spoofmod", Brand_mod_spoofmod
);
550 ("fusspilz", Brand_mod_fusspilz
);
551 ("rocket", Brand_mod_rocket
);
552 ("warezfaw", Brand_mod_warezfaw
);
553 ("emusicmule", Brand_mod_emusicmule
);
554 ("aideadsl", Brand_mod_aideadsl
);
555 ("a i d e a d s l", Brand_mod_aideadsl
);
556 ("epo", Brand_mod_epo
);
557 ("kalitsch", Brand_mod_kalitsch
);
558 ("raynz", Brand_mod_raynz
);
559 ("serverclient", Brand_mod_serverclient
);
560 ("bl4ckbird", Brand_mod_bl4ckbird
);
561 ("bl4ckf0x", Brand_mod_bl4ckf0x
);
562 ("candy-mule", Brand_mod_candymule
);
563 ("rt", Brand_mod_rt
);
564 ("ice", Brand_mod_ice
);
565 ("air-ionix", Brand_mod_airionix
);
566 ("ionix", Brand_mod_ionix
);
567 ("tornado", Brand_mod_tornado
);
568 ("anti-faker", Brand_mod_antifaker
);
569 ("netf", Brand_mod_netf
);
570 ("nextemf", Brand_mod_nextemf
);
571 ("proemule", Brand_mod_proemule
);
572 ("szemule", Brand_mod_szemule
);
573 ("darkmule", Brand_mod_darkmule
);
574 ("miragemod", Brand_mod_miragemod
);
575 ("nextevolution", Brand_mod_nextevolution
);
576 ("pootzgrila", Brand_mod_pootzgrila
);
577 ("freeangel", Brand_mod_freeangel
);
578 ("enos", Brand_mod_enos
);
579 ("webys", Brand_mod_webys
)
582 let to_lowercase s = String.lowercase
s
584 let string_of_tags_list tags
=
586 List.iter
(fun tag
->
587 let st = to_lowercase (string_of_tag_value tag
.tag_value
) in
588 let str = (escaped_string_of_field tag
) ^
" : " ^
st ^
" ; " in
593 let identify_client_brand_mod c tags
=
594 if c
.client_brand_mod
= Brand_mod_unknown
then begin
595 List.iter
(fun tag
->
596 let s = to_lowercase (string_of_tag_value tag
.tag_value
) in
597 match tag
.tag_name
with
598 Field_KNOWN
"mod_version" ->
602 let sub = fst
mod_array.(i
) in
603 if (String2.subcontains
s sub) then
604 c
.client_brand_mod
<- snd
mod_array.(i
)
607 iter 0 (Array.length
mod_array)
612 if String2.subcontains c
.client_name
"@PowerMule" then begin
613 c
.client_brand_mod
<- Brand_mod_powermule
617 let update_emule_release c
=
618 let client_version = c
.client_emule_proto
.emule_version
land 0x00ffffff in
619 let brand = c
.client_brand
in
621 let maj = (client_version lsr 17) land 0x7f in
622 let min = (client_version lsr 10) land 0x7f in
623 let up = (client_version lsr 7) land 0x07 in
625 c
.client_emule_proto
.emule_release
<- (
626 if maj = 0 && min = 0 && up = 0 then
628 else if brand = Brand_newemule
|| brand = Brand_emuleplus
then
629 Printf.sprintf
"%d.%d%c" maj min (Char.chr
((int_of_char 'a'
) + up))
631 Printf.sprintf
"%d.%d.%d" maj min up
634 let parse_compatible_client num old_brand
=
641 | 40 -> Brand_shareaza
642 | 5 -> Brand_emuleplus
643 | 6 -> Brand_hydranode
644 | 10 -> Brand_mldonkey3
647 | 240 -> Brand_verycd
650 let parse_mod_version s c
=
653 let sub = fst
mod_array.(i
) in
654 if (String2.subcontains
s sub) then
655 c
.client_brand_mod
<- snd
mod_array.(i
)
658 iter 0 (Array.length
mod_array)
660 let update_client_from_tags c tags
=
661 let module M
= DonkeyProtoClient
in
662 List.iter (fun tag
->
663 match tag
.tag_name
with
664 | Field_KNOWN
"emule_udpports" ->
665 for_two_int16_tag tag
(fun ed2k_port kad_port
->
666 (* Kademlia: we should use this client to bootstrap Kademlia *)
667 if kad_port
<> 0 && !!enable_kademlia
then
668 DonkeyProtoKademlia.Kademlia.bootstrap
671 | Field_KNOWN
"emule_miscoptions1" ->
672 c
.client_emule_proto
.received_miscoptions1
<- true;
673 for_int64_tag tag
(fun i
->
674 M.update_emule_proto_from_miscoptions1
675 c
.client_emule_proto i
;
676 if !verbose_msg_clients
|| c
.client_debug
then
677 lprintf_nl "miscoptions1 from client %s\n%s"
678 (full_client_identifier c
)
679 (M.print_emule_proto_miscoptions1 c
.client_emule_proto
)
681 | Field_KNOWN
"emule_miscoptions2" ->
682 c
.client_emule_proto
.received_miscoptions2
<- true;
683 for_int64_tag tag
(fun i
->
684 M.update_emule_proto_from_miscoptions2
685 c
.client_emule_proto i
;
686 if !verbose_msg_clients
|| c
.client_debug
then
687 lprintf_nl "miscoptions2 from client %s\n%s"
688 (full_client_identifier c
)
689 (M.print_emule_proto_miscoptions2 c
.client_emule_proto
)
691 | Field_KNOWN
"emule_compatoptions" ->
692 for_int_tag tag
(fun i
->
693 M.update_emule_proto_from_compatoptions
694 c
.client_emule_proto i
696 | Field_KNOWN
"emule_version" ->
697 for_int_tag tag
(fun i
->
698 c
.client_emule_proto
.emule_version
<- i
;
699 let compatibleclient = (i
lsr 24) in
700 c
.client_brand
<- parse_compatible_client compatibleclient c
.client_brand
;
701 update_emule_release c
;
703 if c
.client_brand
= Brand_unknown
then
704 lprintf_nl "[emule_version] Brand_unknown %s" (full_client_identifier c
);
706 | Field_KNOWN
"mod_version" ->
707 let s = to_lowercase (string_of_tag_value tag
.tag_value
) in
708 parse_mod_version s c
709 | Field_KNOWN
_ -> if !verbose_unknown_messages
then
710 lprintf_nl "update_client_from_tags, known tag: [%s] (%s)" (string_of_tag tag
) (full_client_identifier c
)
711 | _ -> if not
(DonkeySources.source_brand c
.client_source
) && !verbose_unknown_messages
then
712 lprintf_nl "update_client_from_tags, unknown tag: [%s] (%s) %s"
713 (hexstring_of_tag tag
) (full_client_identifier c
) (string_of_tags_list tags
)
716 let update_emule_proto_from_tags c tags
=
717 List.iter (fun tag
->
718 match tag
.tag_name
with
719 Field_KNOWN
"compatibleclient" ->
720 for_int_tag tag
(fun i
->
721 c
.client_brand
<- parse_compatible_client i c
.client_brand
;
722 if c
.client_brand
= Brand_unknown
then
723 lprintf_nl "unknown compatibleclient %d (%s) (please report to dev team)" i
(full_client_identifier c
)
725 | Field_KNOWN
"compression" ->
726 for_int_tag tag
(fun i
->
727 c
.client_emule_proto
.emule_compression
<- i
729 | Field_KNOWN
"udpver" ->
730 for_int_tag tag
(fun i
->
731 c
.client_emule_proto
.emule_udpver
<- i
733 | Field_KNOWN
"sourceexchange" ->
734 for_int_tag tag
(fun i
->
735 c
.client_emule_proto
.emule_sourceexchange
<- i
737 | Field_KNOWN
"comments" ->
738 for_int_tag tag
(fun i
->
739 c
.client_emule_proto
.emule_comments
<- i
741 | Field_KNOWN
"extendedrequest" ->
742 for_int_tag tag
(fun i
->
743 c
.client_emule_proto
.emule_extendedrequest
<- i
745 | Field_KNOWN
"features" ->
746 for_int_tag tag
(fun i
->
747 c
.client_emule_proto
.emule_secident
<- i
land 0x3
749 | Field_KNOWN
"mod_version" ->
750 parse_mod_version (to_lowercase (string_of_tag_value tag
.tag_value
)) c
;
752 | Field_KNOWN
"os_info" ->
753 let s = to_lowercase (string_of_tag_value tag
.tag_value
) in
754 (match c
.client_osinfo
with
756 | _ -> if s <> "" then c
.client_osinfo
<- Some
s)
757 | Field_KNOWN
_ -> if !verbose_unknown_messages
then
758 lprintf_nl "update_emule_proto_from_tags, known tag: [%s] (%s)" (string_of_tag tag
) (full_client_identifier c
)
759 | _ -> if not
(DonkeySources.source_brand c
.client_source
) && !verbose_unknown_messages
then
760 lprintf_nl "update_emule_proto_from_tags, unknown tag: [%s] (%s) %s"
761 (hexstring_of_tag tag
) (full_client_identifier c
) (string_of_tags_list tags
)
764 let fight_disguised_mods c
=
765 if (c
.client_brand
= Brand_mldonkey2
|| c
.client_brand
= Brand_mldonkey3
)
766 && (c
.client_brand_mod
= Brand_mod_morphxt
|| c
.client_brand_mod
= Brand_mod_ionix
) then
767 c
.client_brand
<- Brand_newemule
;
768 if c
.client_emule_proto
.emule_release
<> "" && c
.client_brand
= Brand_mldonkey2
then
769 c
.client_brand
<- Brand_newemule
;
770 if c
.client_brand
= Brand_edonkey
&& c
.client_brand_mod
= Brand_mod_plus
then
771 c
.client_brand
<- Brand_emuleplus
;
772 if c
.client_brand
= Brand_emuleplus
&& c
.client_brand_mod
= Brand_mod_plus
then
773 c
.client_brand_mod
<- Brand_mod_unknown
775 let request_osinfo c
=
776 if c
.client_emule_proto
.emule_osinfosupport
= 1 && not c
.client_osinfo_sent
then
780 DonkeyProtoClient.EmuleClientInfo.protversion
= 255;
781 DonkeyProtoClient.EmuleClientInfo.tags
= [
782 string_tag
(Field_KNOWN
"os_info") (String2.upp_initial
Autoconf.system
);
784 client_send c
(DonkeyProtoClient.EmuleClientInfoReq
emule_osinfo);
785 c
.client_osinfo_sent
<- true
788 let rec query_id ip port id
=
789 let client_ip = client_ip None
in
791 (* TODO: check if we are connected to this server. If yes, issue a
792 query_id instead of a UDP packet *)
793 if Ip.reachable
client_ip then
794 let module Q
= DonkeyProtoUdp.QueryCallUdp
in
795 (* lprintf "Ask connection from indirect client\n"; *)
798 let s = DonkeyGlobals.find_server
ip port
in
799 match s.server_sock
with
800 NoConnection
| ConnectionWaiting
_ -> ()
802 (* OK, this fixes the problem with Lugdunum servers, but there should be
803 another better way, since this functionnality is still useful...
805 DonkeyProtoCom.udp_send (get_udp_sock ())
807 (DonkeyProtoUdp.QueryCallUdpReq {
809 Q.port = !!donkey_port;
814 let module M
= DonkeyProtoServer
in
815 let module C
= M.QueryID
in
820 if !!update_server_list_client
then
822 ignore
(check_add_server
ip port
);
827 external hash_param
: int -> int -> 'a
-> int = "caml_hash_univ_param" "noalloc"
828 let hash x
= hash_param
10 100 x
830 let shared_of_file file
=
831 match file
.file_shared
with
833 | Some sh
-> Some
(as_shared sh
)
835 let query_view_files c
=
836 if CommonClient.is_must_browse
(as_client c
) then begin
837 CommonClient.set_not_must_browse
(as_client c
);
838 if c
.client_emule_proto
.emule_noviewshared
<> 1 then client_send c
(
839 let module M
= DonkeyProtoClient
in
840 let module C
= M.ViewFiles
in
844 (* client is valid if it's not us or if it's not yet connected *)
845 let is_valid_client md4 =
846 md4 <> !!client_md4
&&
847 md4 <> overnet_md4
&&
848 not
(Hashtbl.mem connected_clients
md4)
850 (*Do what's need to be done when client has a file we want:
851 - register it in sources
852 - do *not* ask for sources, we can't be sure, the client is still downloading the file!
854 let client_has_file c file
=
855 DonkeySources.set_request_result c
.client_source file
.file_sources File_found
858 Do what's need to be done when client asked for a file we want:
859 - register it in sources
860 - ask for sources if necessary
861 - do not ask sources from mldonkey-clients, they are supposed to automatically send sources after an QueryFileReq
863 let client_queried_file c file
=
864 client_has_file c file
;
865 let module M
= DonkeyProtoClient
in
866 if file_state file
= FileDownloading
867 && M.sourceexchange c
.client_emule_proto
> 0
868 && DonkeySources.need_new_sources file
.file_sources
869 && not
(client_can_receive c
)
871 (* ask for more sources *)
873 if !verbose_location
then
874 lprintf_nl "donkeyClient: Requesting sources from client %s that queried file %s"
875 (full_client_identifier c
) (file_best_name file
);
876 let module E
= M.EmuleRequestSources
in
877 client_send c
(M.EmuleRequestSourcesReq file
.file_md4
)
880 (*Do what's need to be done when client has file chunks we want:
881 - register it in sources
882 - ask for sources if necessary Edit: errr, where is this done?
884 let client_is_useful c file chunks
=
885 DonkeySources.set_request_result c
.client_source file
.file_sources File_chunk
;
886 DonkeyOneFile.add_client_chunks c file chunks
;
887 if file_state file
= FileDownloading
then
888 DonkeyOneFile.request_slot c
891 Check if the bitmap returned by a client contains a chunk that has not
894 let is_useful_client file chunks
=
895 match file
.file_swarmer
with
898 let bitmap = CommonSwarming.chunks_verified_bitmap swarmer
in
899 VB.existsi
(fun i
s ->
902 | VB.State_missing
| VB.State_partial
-> true
903 | VB.State_complete
| VB.State_verified
-> false)
906 let received_client_bitmap c file chunks
=
908 let module M
= DonkeyProtoClient
in
910 if !verbose_msg_clients
then begin
911 match file
.file_swarmer
with
914 lprintf_nl "Compared to: %s" (VB.to_string
(CommonSwarming.chunks_verified_bitmap swarmer
));
918 if file_size file
<= block_size
919 then Bitv.create
1 true
921 if Bitv.length
chunks = 0
922 then Bitv.create file
.file_nchunks
true
924 if Bitv.length
chunks <> file
.file_nchunks
then begin
926 lprintf_nl "number of chunks is different %d/%d for %s(%s), size %Ld on %s"
929 (file_best_name file
)
930 (Md4.to_string file
.file_md4
)
932 (full_client_identifier c
);
933 Bitv.create file
.file_nchunks
false
934 (* What should we do ?
936 1) Try to recover the correct size of the file: we can use
937 ViewFilesReq on all clients having the file to test what is
938 the most widely used size for this file. Maybe create
939 different instances of the file for each proposed size ?
946 if is_useful_client file
chunks then client_is_useful c file
chunks
948 let send_pending_messages c sock
=
949 let module M
= DonkeyProtoClient
in
952 client_send c
(M.SayReq
m)
953 ) c
.client_pending_messages
;
954 c
.client_pending_messages
<- []
956 let init_client_after_first_message sock c
=
957 (* we read something on socket so ip is now known for socket *)
958 let old_ip = c
.client_ip in
959 c
.client_ip <- peer_ip sock
;
960 if old_ip <> Ip.null
&& old_ip <> c
.client_ip &&
961 c
.client_country_code
= None
then
962 check_client_country_code c
;
963 (* Add the Connected tag and when needed the NoLimit tag *)
964 let t = client_type c
lor client_initialized_tag
in
966 if Ip.matches c
.client_ip !!nolimit_ips
then t lor client_nolimit_tag
973 let finish_client_handshake c sock
=
974 c
.client_connect_time
<- last_time
();
975 send_pending_messages c sock
;
976 set_client_state c
(Connected
(-1));
977 (* query_files c sock; see comment at implementation*)
978 DonkeySources.source_connected c
.client_source
;
980 client_must_update c
;
981 c
.client_checked
<- true;
985 (* reverse ip bytes? *)
986 let int64_of_rip ip =
987 Ip.to_int64
(Ip.rev
ip)
989 let get_high_id_int64 () =
990 let result = ref Int64.zero
in
992 if !result = Int64.zero
then
993 (match s.server_cid
with
995 | Some i
-> if not
(low_id i
) then
996 result := int64_of_rip i
;
998 ) (connected_servers
());
1001 (* If we know our own IP (donkey high id), use type 20 and our ip
1002 If we do not know our IP (could be NAT'd), use type 10 and their ip *)
1003 let get_ip_and_type sock
=
1004 let ip = ref (get_high_id_int64 ()) in
1005 let ip_type = ref (if !ip == Int64.zero
then 0 else 20) in
1007 if (!ip_type == 0) then begin
1011 ip := int64_of_rip (peer_ip
s);
1017 match c
.client_public_key
with
1022 match c
.client_public_key
with
1026 let send_signature c
=
1027 if has_pubkey c
then
1030 let ip = ref Int64.zero
in
1031 let ip_type = ref 0 in
1033 if (c
.client_emule_proto
.emule_secident
== 2) then begin (* Use v1 as default, except if only v2 is supported (same as emule) *)
1034 let (x
,y
) = get_ip_and_type c
.client_source
.DonkeySources.source_sock
in
1039 let pubkey = get_pubkey c
in
1040 let signature = DonkeySui.SUI.create_signature
pubkey (String.length
pubkey) c
.client_req_challenge
!ip_type !ip in
1042 if !verbose_msg_clients
then begin
1043 lprintf_nl "%s [send_signature] [sigLen: %d] [keyLen: %d] [reqChall: %Ld] [ipType: %d] [ip: %Ld]" (full_client_identifier c
) (String.length
signature) (String.length
pubkey) c
.client_req_challenge
!ip_type !ip;
1046 let module M
= DonkeyProtoClient
in
1047 let module E
= M.EmuleSignatureReq
in
1048 client_send c
(M.EmuleSignatureReq
{
1049 E.signature = signature;
1050 E.ip_type = !ip_type;
1054 if !verbose_msg_clients
then begin
1055 lprintf_nl "%s [send_signature] Can't send without a key" (full_client_identifier c
)
1058 let verify_ident c
=
1059 let challenge = Random.int64
(Int64.of_int32
Int32.max_int
) in
1060 let state, state_string
= if has_pubkey c
then (1,"SIGNEEDED") else (2,"KEYANDSIGNEEDED") in
1061 c
.client_sent_challenge
<- challenge;
1063 if !verbose_msg_clients
then begin
1064 lprintf_nl "%s [verify_ident] [state: %d (%s)] [sentChall: %Ld]" (full_client_identifier c
) state state_string
challenge;
1067 let module M
= DonkeyProtoClient
in
1068 let module E
= M.EmuleSecIdentStateReq
in
1069 client_send c
(M.EmuleSecIdentStateReq
{
1071 E.challenge = challenge;
1074 let send_public_key c
=
1075 if !verbose_msg_clients
then begin
1076 lprintf_nl "%s [send_public_key] [keyLen: %d]" (full_client_identifier c
) (String.length
!client_public_key
);
1079 let module M
= DonkeyProtoClient
in
1080 client_send c
(M.EmulePublicKeyReq
!client_public_key
)
1082 let get_server_ip_port () =
1083 match !DonkeyGlobals.master_server
with
1088 match s.server_realport
with
1089 None
-> (*lprintf "%d\n" s.server_port;*) s.server_port
1090 | Some p
-> (*lprintf "%d\n" p;*) p
1094 let process_mule_info c
t =
1095 update_emule_proto_from_tags c
t;
1096 update_emule_release c
;
1097 client_must_update c
;
1098 if sec_ident_enabled
()
1099 && (c
.client_md4
<> Md4.null
)
1100 && (c
.client_sent_challenge
== Int64.zero
)
1101 && (c
.client_emule_proto
.emule_secident
> 0)
1103 if !verbose_msg_clients
then
1104 lprintf_nl "%s [process_mule_info] [verify_ident]" (full_client_identifier c
);
1109 let incr_activity_successful_connections c
=
1110 if DonkeySources.source_brand c
.client_source
then
1111 !activity
.activity_client_overnet_successful_connections
<-
1112 !activity
.activity_client_overnet_successful_connections
+1
1114 !activity
.activity_client_edonkey_successful_connections
<-
1115 !activity
.activity_client_edonkey_successful_connections
+1
1117 let incr_activity_indirect_connections c
=
1118 if DonkeySources.source_brand c
.client_source
then
1119 !activity
.activity_client_overnet_indirect_connections
<-
1120 !activity
.activity_client_overnet_indirect_connections
+1
1122 !activity
.activity_client_edonkey_indirect_connections
<-
1123 !activity
.activity_client_edonkey_indirect_connections
+1
1125 let incr_activity_connections c
=
1126 if DonkeySources.source_brand c
.client_source
then
1127 !activity
.activity_client_overnet_connections
<-
1128 !activity
.activity_client_overnet_connections
+1
1130 !activity
.activity_client_edonkey_connections
<-
1131 !activity
.activity_client_edonkey_connections
+1
1133 let check_stolen_hash c sock
md4 =
1134 if not
(register_client_hash
(peer_ip sock
) md4) then
1135 if !!ban_identity_thieves
then
1136 ban_client c sock
"is probably using stolen client hashes"
1138 let client_to_client for_files c
t sock
=
1139 let module M
= DonkeyProtoClient
in
1141 if !verbose_msg_clients
|| c
.client_debug
then begin
1142 lprintf_nl "Message from %s" (full_client_identifier c
);
1147 M.ConnectReplyReq
t ->
1148 if !verbose_msg_clients
then begin
1149 lprintf_nl "[HELLOANSWER] %s" (full_client_identifier c
);
1152 incr_activity_successful_connections c
;
1154 init_client_after_first_message sock c
;
1156 set_client_has_a_slot
(as_client c
) NoSlot
;
1158 let module CR
= M.Connect
in
1160 if not
(is_valid_client t.CR.md4) then
1162 TcpBufferedSocket.close sock
(Closed_for_error
"Reply of Invalid Client");
1166 if (is_black_address
t.CR.ip t.CR.port c
.client_country_code
) then raise Exit
;
1168 check_stolen_hash c sock
t.CR.md4;
1170 c
.client_tags
<- t.CR.tags
;
1172 List.iter (fun tag
->
1174 { tag_name
= Field_KNOWN
"name"; tag_value
= String
s } ->
1175 set_client_name c
s t.CR.md4
1179 identify_client_brand c
;
1180 update_client_from_tags c
t.CR.tags
;
1181 fight_disguised_mods c
;
1182 update_emule_release c
;
1183 Hashtbl.add connected_clients
t.CR.md4 c
;
1185 (* connection_ok c.client_connection_control; *)
1187 if c
.client_debug
|| !verbose_msg_clients
|| !verbose_msg_clienttags
then begin
1192 match t.CR.server_info
with
1193 Some
(ip, port) -> if !!update_server_list_client
then safe_add_server
ip port
1197 check_stolen_hash c sock
t.CR.md4;
1199 finish_client_handshake c sock
;
1200 (* We initiated the connection so we know which files to ask *)
1201 DonkeySources.query_files c
.client_source
1203 | M.EmuleQueueRankingReq rank
1204 | M.QueueRankReq rank
->
1205 c
.client_rank
<- rank
;
1206 set_client_state c
(Connected rank
);
1207 if rank
> !!good_client_rank
then
1208 List.iter (fun (file
, _, _) ->
1209 let s = c
.client_source
in
1210 let m = file
.file_sources
in
1211 match DonkeySources.find_request_result
s m with
1213 DonkeySources.set_request_result
s m File_found
;
1215 ) c
.client_file_queue
1217 | M.EmuleClientInfoReq
t ->
1219 let old_ip = c
.client_ip in
1220 c
.client_ip <- peer_ip sock
;
1221 if old_ip <> Ip.null
&& old_ip <> c
.client_ip &&
1222 c
.client_country_code
= None
then
1223 check_client_country_code c
;
1224 (* lprintf "Emule Extended Protocol asked\n"; *)
1225 let module CI
= M.EmuleClientInfo
in
1226 process_mule_info c
t.CI.tags
;
1227 if !!emule_mods_count
then
1228 identify_client_brand_mod c
t.CI.tags
;
1230 let module E
= M.EmuleClientInfo
in
1231 client_send c
(M.EmuleClientInfoReplyReq emule_info
);
1235 | M.EmuleClientInfoReplyReq
t ->
1237 let module CI
= M.EmuleClientInfo
in
1239 process_mule_info c
t.CI.tags
;
1241 if !verbose_msg_clienttags
then
1242 lprintf_nl "Message from client[%d] %s %s tags: %s"
1244 (match c
.client_kind
with
1245 Indirect_address
_ | Invalid_address
_ -> ""
1246 | Direct_address
(ip,port) ->
1247 Printf.sprintf
" [%s:%d]" (Ip.to_string
ip) port;
1249 (full_client_identifier c
)
1250 (string_of_tags_list t.CI.tags
)
1252 (* lprintf "Emule Extended Protocol activated\n"; *)
1255 | M.EmuleRequestSourcesReq
t ->
1256 let module E
= M.EmuleRequestSourcesReply
in
1258 (* lprintf "Emule requested sources\n"; *)
1259 let file = find_file
t in
1260 let sources = ref [] in
1261 DonkeySources.iter_qualified_sources
(fun s ->
1262 match s.DonkeySources.source_uid
with
1263 Indirect_address
_ | Invalid_address
_ -> () (* not yet supported *)
1264 | Direct_address
(ip, port) ->
1265 if s.DonkeySources.source_age
> last_time
() - 600 &&
1266 (match ip_reliability
ip with
1267 Reliability_reliable
| Reliability_neutral
-> true
1268 | Reliability_suspicious
_ -> false) &&
1269 List.exists
(fun r
->
1270 r
.DonkeySources.request_score
>= CommonSources.possible_score
1271 ) s.DonkeySources.source_files
then
1276 E.src_server_ip
= Ip.null
;
1277 E.src_server_port
= 0;
1278 (* this is not very good, but what can we do ? we don't keep sources UIDs *)
1279 E.src_md4
= Md4.null
;
1281 ) file.file_sources
;
1282 if !sources <> [] then
1284 if !verbose_location
then
1285 lprintf_nl "donkeyClient: EmuleRequestSourcesReq: Sending %d Sources to %s for file %s"
1286 (List.length
!sources) (full_client_identifier c
) (file_best_name
file);
1288 M.EmuleRequestSourcesReplyReq
{
1290 E.sources = Array.of_list
!sources;
1294 | M.ViewFilesReplyReq
t ->
1296 lprintf "****************************************\n";
1297 lprintf " VIEW FILES REPLY \n";
1299 let module Q
= M.ViewFilesReply
in
1301 if !verbose_msg_clients
then
1302 lprintf_nl "Received ViewFilesReply";
1304 let list = ref [] in
1306 match result_of_file f
.f_md4 f
.f_tags
with
1309 (* TODO let r = DonkeyIndexer.index_result_no_filter r in *)
1310 client_new_file c
r;
1313 c
.client_all_files
<- Some
!list;
1314 client_must_update c
1317 lprintf_nl "Exception in ViewFilesReply %s"
1318 (Printexc2.to_string e
);
1321 | M.AvailableSlotReq
_ ->
1322 set_lifetime sock
active_lifetime;
1323 set_rtimeout sock
!!queued_timeout
;
1324 (* how long should we wait for a block ? *)
1326 match c.client_block with
1329 lprintf "[QUEUED WITH BLOCK]\n";
1330 DonkeyOneFile.clean_client_zones c;
1333 match c
.client_download
with
1335 if !verbose_download
then
1336 lprintf_nl "Clear download";
1337 CommonSwarming.clear_uploader_ranges
up;
1338 c
.client_download
<- None
1340 match c
.client_file_queue
with
1343 if c
.client_slot
= SlotNotAsked
then
1346 let v = Hashtbl.find join_queue_by_md4 c
.client_md4
in
1347 if c
.client_debug
then
1348 lprintf_nl "Recovered file queue by md4";
1351 let id = client_id c
in
1352 let v = Hashtbl.find join_queue_by_id
id in
1353 if c
.client_debug
then
1354 lprintf_nl "Recovered file queue by md4";
1357 List.iter (fun (file, chunks) ->
1358 let chunks = Bitv.copy
chunks in
1359 DonkeyOneFile.add_client_chunks c
file chunks) files;
1360 (* DonkeyOneFile.restart_download c *)
1362 if c
.client_debug
then
1363 lprintf_nl "AvailableSlot received, but not file to download!";
1364 (* TODO: ask for the files now *)
1366 (* now, we can forget we have asked for a slot *)
1367 c
.client_slot
<- SlotReceived
;
1368 DonkeyOneFile.get_from_client c
1370 | M.JoinQueueReq
_ when not
(!!ban_queue_jumpers
&& c
.client_banned
) ->
1373 if !!ban_queue_jumpers && c.client_banned then
1374 direct_client_send sock (M.EmuleQueueRankingReq
1375 (900 + Random.int 100))
1380 match c
.client_brand
with
1381 | Brand_mldonkey3
->
1382 if Fifo.length upload_clients
>= !!max_upload_slots
then
1384 if c
.client_source
.source_sock
<> None
&&
1385 c
.client_brand
= Brand_mldonkey3
then raise Exit
)
1388 if Fifo.length upload_clients
>= !!max_upload_slots
then
1392 (* set_rtimeout sock !!upload_timeout; *)
1393 set_lifetime sock
(float_of_int
Date.day_in_secs
);
1398 (* If the client is in the nolimit_ips list, he doesn't need a slot, so put
1399 it immediatly in the upload queue... but what will happen in the queue
1400 since the client upload should not be taken into account !
1402 What we need: put the upload and download engines inside the bandwidth
1403 controler, and use two bandwidth controlers, one for limited sockets, the
1404 other one for unlimited sockets. *)
1406 (* NOT IMPLEMENTED YET
1407 if is_nolimit cc then begin
1408 set_client_has_a_slot cc true;
1409 client_enter_upload_queue cc
1411 CommonUploads.add_pending_slot
(as_client c
);
1412 if !verbose_upload
then
1413 lprintf_nl "added to pending slots: %s %s"
1414 (full_client_identifier c
)
1415 (match client_upload
(as_client c
) with
1417 | Some f
-> CommonFile.file_best_name f
);
1420 | M.OutOfPartsReq
_ ->
1421 set_client_state c
(Connected
0);
1423 match c
.client_download
with
1426 if !verbose_download
then
1427 lprintf_nl "Slot closed during download";
1428 CommonSwarming.clear_uploader_ranges
up
1430 c
.client_session_downloaded
<- 0L;
1431 c
.client_slot
<- SlotNotAsked
;
1432 (* OK, the slot is closed, but what should we do now ????? *)
1434 match c
.client_file_queue
with
1437 if !verbose_download
then
1438 lprintf_nl "OutOfPartsReq";
1439 DonkeyOneFile.request_slot c
;
1440 set_rtimeout sock
!!queued_timeout
;
1443 | M.ReleaseSlotReq
_ ->
1444 DonkeyOneFile.remove_client_slot c
;
1445 if c
.client_file_queue
= [] then set_rtimeout sock
120.;
1446 CommonUploads.refill_upload_slots
()
1448 | M.QueryFileReplyReq
t ->
1449 let module Q
= M.QueryFileReply
in
1453 let file = find_file
t.Q.md4 in
1454 c
.client_rating
<- c
.client_rating
+ 1;
1456 client_has_file c
file;
1457 add_file_filenames
(as_file
file) t.Q.name
;
1459 update_best_name
file;
1460 if file_size
file <= block_size
then begin
1461 client_is_useful c
file (Bitv.create
1 true)
1464 if file.file_computed_md4s
= [||] then begin
1466 let module M
= DonkeyProtoClient
in
1467 let module C
= M.QueryChunkMd4
in
1468 M.QueryChunkMd4Req
file.file_md4
);
1474 | M.EmuleFileDescReq
t ->
1476 match c
.client_last_file_req_md4
with
1480 let file = find_file
md4 in
1481 let module Q
= M.EmuleFileDesc
in
1482 let slen = String.length
t.Q.comment
in
1483 if slen > 0 && slen <= !!max_comment_length
&& (!is_not_comment_spam
) t.Q.comment
then begin
1484 (* Disallow dups from single IP, but allow comment updates *)
1485 file.file_comments
<- List.filter
(fun (i
,_,_,_) -> i
<> c
.client_ip) file.file_comments
;
1486 if List.length
file.file_comments
< !!max_comments_per_file
then begin
1487 file.file_comments
<- (c
.client_ip, c
.client_name
, t.Q.rating
, (intern
t.Q.comment
)) :: file.file_comments
;
1488 file_must_update
file;
1496 | M.QueryChunksReplyReq
t ->
1497 let module Q
= M.QueryChunksReply
in
1500 let file = find_file
t.Q.md4 in
1501 received_client_bitmap c
file t.Q.chunks
1503 client_send c
(M.NoSuchFileReq
t.Q.md4);
1504 if !verbose
then lprintf_nl
1505 "QueryChunksReply: Client (%s) asked for file_md4 %s, Exception %s"
1506 (full_client_identifier c
)
1507 (Md4.to_string
t.Q.md4)
1508 (Printexc2.to_string e
)
1511 | M.QueryChunkMd4ReplyReq
t ->
1513 let module Q
= M.QueryChunkMd4Reply
in
1514 let file = find_file
t.Q.md4 in
1516 let module Q
= M.QueryChunkMd4Reply
in
1518 lprintf_nl "Received chunks md4 for %s from %s"
1519 (file_best_name
file) (full_client_identifier c
);
1521 if file.file_computed_md4s
= [||] then begin
1522 if file.file_nchunk_hashes
= 0 then begin
1523 lprintf_nl "[ERROR] file %s has only one chunk, ignoring QueryChunkMd4ReplyReq"
1524 (file_best_name
file);
1525 file.file_computed_md4s
<- [|file.file_md4
|];
1526 match file.file_swarmer
with
1529 CommonSwarming.set_verifier swarmer
1530 (Verification
[| Ed2k
file.file_md4
|])
1532 if t.Q.chunks = [||] then
1533 lprintf_nl "[ERROR] received empty chunks md4 message for %s from %s"
1534 (file_best_name
file) (full_client_identifier c
)
1536 if Array.length
t.Q.chunks <> file.file_nchunk_hashes
then begin
1538 lprintf_nl "[ERROR] number of chunks does not match, received md4s %d/should be %d, for %s(%s):%Ld bytes from %s"
1539 (Array.length
t.Q.chunks)
1541 (file_best_name
file)
1542 (Md4.to_string
file.file_md4
)
1544 (full_client_identifier c
)
1545 (* What should we do ?
1547 1) Try to recover the correct size of the file: we can use
1548 ViewFilesReq on all clients having the file to test what is
1549 the most widely used size for this file. Maybe create
1550 different instances of the file for each proposed size ?
1552 Maybe we should allow a degraded mode of download, where each client
1553 is checked for the file.
1558 (* We should check the correctness of the Md4 array *)
1559 let md4s = t.Q.chunks in
1560 let md4 = md4_of_array
md4s in
1561 if md4 <> file.file_md4
then begin
1562 lprintf_nl "[ERROR] Chunks md4s do not match file_md4 for %s(%s) from %s"
1563 (file_best_name
file)
1564 (Md4.to_string
file.file_md4
)
1565 (full_client_identifier c
);
1567 file.file_computed_md4s
<- md4s;
1568 match file.file_swarmer
with
1571 CommonSwarming.set_verifier swarmer
1572 (Verification
(Array.map (fun m -> Ed2k
m) md4s))
1577 (* if file.file_exists then verify_chunks file *)
1580 | M.EmuleCompressedPart
t ->
1582 set_lifetime sock
active_lifetime;
1583 if !!reliable_sources
&&
1584 client_reliability c
= Reliability_suspicious
0 then begin
1585 lprintf_nl "Receiving data from unreliable client, disconnect";
1586 corruption_warning c
;
1587 disconnect_client c
(Closed_for_error
"Unreliable Source");
1591 let module Q
= M.EmuleCompressedPart
in
1592 let comp = match c
.client_comp
with
1596 comp_pos
= t.Q.statpos
;
1597 comp_total
= Int64.to_int
t.Q.newsize
;
1601 c
.client_comp
<- Some
comp;
1605 comp.comp_blocs
<- t.Q.bloc
:: comp.comp_blocs
;
1606 comp.comp_len
<- comp.comp_len
+ String.length
t.Q.bloc
;
1608 (* lprintf "Comp bloc: %d/%d\n" comp.comp_len comp.comp_total; *)
1609 if comp.comp_len
= comp.comp_total
then begin
1610 if !verbose_download
then
1611 lprintf_nl "Complete compressed block received!";
1613 let s = String.create
comp.comp_len
in
1618 let pos = iter tail
in
1619 let len = String.length b
in
1620 String.blit b
0 s pos len;
1623 let pos = iter comp.comp_blocs
in
1624 assert (pos = comp.comp_len
);
1625 let s = Zlib.uncompress_string2
s in
1626 if !verbose_download
then
1627 lprintf_nl "Decompressed: %d/%d" (String.length
s) comp.comp_len
;
1629 DonkeyOneFile.block_received c
comp.comp_md4
1630 comp.comp_pos
s 0 (String.length
s);
1632 c
.client_comp
<- None
;
1634 if comp.comp_len
> comp.comp_total
then begin
1635 if !verbose_unknown_messages
then
1636 lprintf_nl "eMule compressed data, ignoring, more data (%d) than compressed (%d) from %s for %s"
1637 comp.comp_len
comp.comp_total
(full_client_identifier c
) (Md4.to_string
comp.comp_md4
);
1638 c
.client_comp
<- None
;
1643 set_lifetime sock
active_lifetime;
1644 if !!reliable_sources
&&
1645 client_reliability c
= Reliability_suspicious
0 then begin
1646 lprintf_nl "Receiving data from unreliable client, disconnect";
1647 corruption_warning c
;
1648 disconnect_client c
(Closed_for_error
"Unreliable Source");
1652 let module M
= DonkeyProtoClient
in
1653 let module Q
= M.Bloc
in
1655 let begin_pos = t.Q.start_pos
in
1656 let end_pos = t.Q.end_pos in
1657 let len = end_pos -- begin_pos in
1658 if Int64.to_int
len <> t.Q.bloc_len
then begin
1659 lprintf_nl "%d: inconsistent packet sizes" (client_num c
);
1663 DonkeyOneFile.block_received c
t.Q.md4
1664 t.Q.start_pos
t.Q.bloc_str
t.Q.bloc_begin
t.Q.bloc_len
1666 (* Upload requests *)
1667 | M.ViewFilesReq
t when !CommonGlobals.has_upload
= 0 &&
1668 (match !!allow_browse_share
with
1669 1 -> client_friend_tag
land client_type c
<> 0
1672 let files = DonkeyShare.all_shared
() in
1673 let published_files = ref [] in
1675 let filename = file_best_name f
in
1676 if not
(String2.starts_with
filename "hidden.") then
1677 published_files := f
:: !published_files
1680 lprintf "ASK VIEW FILES\n";
1682 if !verbose_msg_clients
then
1683 lprintf_nl "Sending %d Files in ViewFilesReqReply" (List.length
!published_files);
1684 client_send_files sock
!published_files
1686 (*TODO: real directory support*)
1687 | M.ViewDirsReq
t when !CommonGlobals.has_upload
= 0 &&
1688 (match !!allow_browse_share
with
1689 1 -> client_friend_tag
land client_type c
<> 0
1692 let published_dirs = ["FIXME"] in
1693 if !verbose_msg_clients
then
1694 lprintf_nl "Sending %d Dirs in ViewDirsReplyReq" (List.length
published_dirs);
1695 client_send c
(M.ViewDirsReplyReq
published_dirs)
1697 (*TODO: real directory support*)
1698 (*TODO: "!Incomplete Files" support*)
1699 | M.ViewFilesDirReq
t when !CommonGlobals.has_upload
= 0 &&
1700 (match !!allow_browse_share
with
1701 1 -> client_friend_tag
land client_type c
<> 0
1704 let files = DonkeyShare.all_shared
() in
1705 let published_files = ref [] in
1707 let filename = file_best_name f
in
1708 if not
(String2.starts_with
filename "hidden.") then
1709 published_files := f
:: !published_files
1712 lprintf "ASK VIEW FILES\n";
1714 if !verbose_msg_clients
then
1715 lprintf_nl "Sending %d Files in ViewFilesReqReply" (List.length
!published_files);
1716 client_send_dir sock
t !published_files
1718 | M.QueryFileReq
t ->
1719 let md4 = t.M.QueryFile.md4 in
1720 c
.client_requests_received
<- c
.client_requests_received
+ 1;
1722 if !CommonGlobals.has_upload
= 0 &&
1723 not
(!!ban_queue_jumpers
&& c
.client_banned
) then
1725 (try client_wants_file c
md4 with _ -> ());
1727 if md4 = Md4.null
&& c
.client_brand
= Brand_edonkey
then
1728 c
.client_brand
<- Brand_mldonkey1
;
1729 if c
.client_brand
= Brand_mldonkey1
|| c
.client_brand
= Brand_mldonkey2
then begin
1731 lprintf_nl "donkeyClient:QueryFileReq: Client %s is really old mldonkey1/2 and queried file %s"
1732 (full_client_identifier c
) (Md4.to_string
md4);
1733 if Random.int 100 < 3 && !!send_warning_messages
then
1735 M.SayReq
"[AUTOMATED WARNING] Please, update your MLdonkey client to at least version 2.7.0!");
1739 count_filerequest c
;
1740 let file = find_file
md4 in
1741 (match file.file_shared
with
1742 None
-> raise Not_found
1744 shared_must_update_downloaded
(as_shared impl
);
1745 impl
.impl_shared_requests
<- impl
.impl_shared_requests
+ 1);
1746 request_for c
file sock
;
1747 set_client_upload
(as_client c
) (as_file
file);
1749 let module Q
= M.QueryFileReply
in
1750 let filename = file_best_name
file in
1751 let published_filename = if String.length
filename < 7 ||
1752 String.sub filename 0 7 <> "hidden." then filename
1753 else String.sub filename 7 (String.length
filename - 7) in
1754 M.QueryFileReplyReq
{
1755 Q.md4 = file.file_md4
;
1756 Q.name
= published_filename
1758 client_queried_file c
file;
1759 (* Here's the correct place to check for emule_extension *)
1761 match t.M.QueryFile.emule_extension
with
1763 | Some
(chunks, _) ->
1764 received_client_bitmap c
file chunks
1766 if file_state
file = FileDownloading
then
1767 DonkeySources.query_files c
.client_source
1770 client_send c
(M.NoSuchFileReq
md4);
1771 if !verbose_unexpected_messages
then
1772 lprintf_nl "donkeyClient: QueryFileReq: Client %s queried unpublished file %s"
1773 (full_client_identifier c
) (Md4.to_string
md4)
1775 lprintf_nl "Exception %s in QueryFileReq"
1776 (Printexc.to_string e
)
1779 | M.EmuleSignatureReq
t ->
1780 if sec_ident_enabled
() then
1782 let module Q
= M.EmuleSignatureReq
in
1784 if !verbose_msg_clients
then begin
1785 let lipType,lipTypeString
=
1786 (match t.Q.ip_type with
1787 10 -> (10, "IpLocal")
1788 | 20 -> (20, "IpRemote")
1789 | e
-> (e
, "Unknown")) in
1790 let lkeyString = if (has_pubkey c
) then "" else "[NO KEY!!]" in
1791 lprintf_nl "%s [ESigReq] [sentChall: %Ld] [ipType: %d (%s)] %s" (full_client_identifier c
) c
.client_sent_challenge
lipType lipTypeString
lkeyString;
1794 let ip_type = ref 0 in
1795 let id = ref Int64.zero
in
1797 if (c
.client_emule_proto
.emule_secident
> 1 && t.Q.ip_type <> 0) then
1799 ip_type := t.Q.ip_type;
1800 if (!ip_type == 20) (* || isLowid *) then
1801 id := int64_of_rip (peer_ip sock
)
1804 id := get_high_id_int64 ();
1805 if !id = Int64.zero
then begin
1806 id := int64_of_rip (my_ip sock
);
1807 if !verbose_msg_clients
then begin
1808 lprintf_nl "%s [ESigReq] Warning: Local IP unknown (signature might fail)" (full_client_identifier c
);
1814 let pubKey = get_pubkey c
in
1816 if !verbose_msg_clients
then begin
1817 lprintf_nl "%s [ESigReq] [verify_signature] [keyLen: %d] [sigLen: %d] [sentChall: %Ld] [ipType %d] [ip: %Ld]" (full_client_identifier c
) (String.length
pubKey) (String.length
t.Q.signature) c
.client_sent_challenge
!ip_type !id;
1820 let verified = DonkeySui.SUI.verify_signature
pubKey (String.length
pubKey) t.Q.signature (String.length
t.Q.signature) c
.client_sent_challenge
!ip_type !id in
1821 c
.client_sui_verified
<- Some
verified;
1822 c
.client_sent_challenge
<- Int64.zero
;
1823 client_must_update c
;
1825 if !verbose_msg_clients
then begin
1826 lprintf_nl "%s [ESigReq] [verify_signature: %s]" (full_client_identifier c
) (if verified then "passed" else "failed");
1830 if !verbose_msg_clients
then begin
1831 lprintf_nl "%s [ESigReq] [DISABLED]" (full_client_identifier c
) ;
1834 | M.EmulePublicKeyReq
t ->
1835 if sec_ident_enabled
() then
1837 let module Q
= M.EmulePublicKeyReq
in
1838 (match c
.client_public_key
with
1839 Some
s -> if s <> t then
1841 if !verbose_msg_clients
then begin
1842 lprintf_nl "%s [EPubKeyReq] [Key is different!]" (full_client_identifier c
);
1844 c
.client_public_key
<- None
;
1847 if !verbose_msg_clients
then begin
1848 lprintf_nl "%s [EPubKeyReq] [Key matches]" (full_client_identifier c
);
1851 c
.client_public_key
<- Some
t;
1852 if !verbose_msg_clients
then begin
1853 lprintf_nl "%s [EPubKeyReq] [New Key] [keyLen: %d] [reqChall: %Ld]" (full_client_identifier c
) (String.length
t) c
.client_req_challenge
;
1856 if (c
.client_req_challenge
<> Int64.zero
) then send_signature c
;
1860 if !verbose_msg_clients
then
1861 lprintf_nl "%s [EPubKeyReq] [DISABLED]" (full_client_identifier c
);
1863 | M.EmuleSecIdentStateReq
t ->
1864 if sec_ident_enabled
() then
1866 let module Q
= M.EmuleSecIdentStateReq
in
1868 if !verbose_msg_clients
then begin
1869 let lstate,lstateString
=
1870 (match t.Q.state with
1871 1 -> (1,"SIGNNEEDED")
1872 | 2 -> (2,"KEYANDSIGNNEEDED")
1873 | e
-> (e
,"UNKNOWN")) in
1874 lprintf_nl "%s [ESecIdentStateReq] [type: %d (%s)] [reqChall: %Ld] [sendChall: %Ld] [hasKey: %b]"
1875 (full_client_identifier c
) lstate lstateString
t.Q.challenge c
.client_sent_challenge
(has_pubkey c
);
1878 c
.client_req_challenge
<- t.Q.challenge;
1879 if (not
(has_pubkey c
)) && (c
.client_sent_challenge
= Int64.zero
)
1880 then verify_ident c
;
1882 then send_public_key c
;
1884 then send_signature c
;
1887 if !verbose_msg_clients
then
1888 lprintf_nl "%s [ESecIdentStateReq] [DISABLED]" (full_client_identifier c
);
1890 | M.EmuleRequestSourcesReplyReq
t ->
1891 (* lprintf "Emule sent sources\n"; *)
1892 let module Q
= M.EmuleRequestSourcesReply
in
1895 let file = find_file
t.Q.md4 in
1896 (* Always accept sources when already received !
1898 if file.file_enough_sources then begin
1899 lprintf "** Dropped %d sources for %s **\n" (List.length t.Q.sources) (file_best_name file);
1902 if !verbose_location
then
1903 lprintf_nl "donkeyClient: EmuleRequestSourcesReply: Received %d sources from %s for %s"
1904 (Array.length
t.Q.sources) (full_client_identifier c
) (file_best_name
file);
1906 Array.iter (fun s ->
1907 add_source file s.Q.src_ip
s.Q.src_port
s.Q.src_server_ip
s.Q.src_server_port
1915 let module Q
= M.Sources
in
1918 let file = find_file
t.Q.md4 in
1919 (* Always accept sources when already received !
1921 if file.file_enough_sources then begin
1922 lprintf "** Dropped %d sources for %s **\n" (List.length t.Q.sources) (file_best_name file);
1925 if !verbose_location
then
1926 lprintf_nl "donkeyClient: SourcesReq: Received %d sources from %s for %s"
1927 (List.length
t.Q.sources) (full_client_identifier c
) (file_best_name
file);
1928 List.iter (fun (ip1
, port, ip2
) ->
1929 add_source file ip1
port Ip.null
0
1934 | M.SayReq
s when (!is_not_spam
) s ->
1935 (* FIXME: add logging *)
1937 private_message_from
(as_client c
) s;
1943 match c
.client_source
.DonkeySources.source_sock
with
1945 (Ip.to_string
(peer_ip sock
) ^
":" ^ string_of_int
(peer_port sock
))
1946 | _ -> (match c
.client_kind
with
1947 Direct_address
(ip,port) ->
1948 ((Ip.to_string
ip) ^
":" ^ string_of_int
port)
1949 | Indirect_address
_ | Invalid_address
_ -> "Indirect"
1955 match c
.client_kind
with
1956 Direct_address
(ip,port) ->
1957 ((Ip.to_string
ip) ^
":" ^ string_of_int
port)
1958 | Indirect_address
_ | Invalid_address
_ -> "Indirect"
1962 log_chat_message
cip (client_num c
) c
.client_name
s;
1965 | M.EmuleCaptchaReq
t ->
1966 let buf = Buffer.create
4096 in
1967 let len = String.length
t in
1969 'A'
; 'B'
; 'C'
; 'D'
; 'E'
; 'F'
; 'G'
; 'H'
; 'I'
; 'J'
; 'K'
; 'L'
; 'M'
; 'N'
; 'O'
; 'P'
;
1970 'Q'
; 'R'
; 'S'
; 'T'
; 'U'
; 'V'
; 'W'
; 'X'
; 'Y'
; 'Z'
; 'a'
; 'b'
; 'c'
; 'd'
; 'e'
; 'f'
;
1971 'g'
; 'h'
; 'i'
; 'j'
; 'k'
; 'l'
; '
m'
; 'n'
; 'o'
; 'p'
; 'q'
; '
r'
; '
s'
; '
t'
; 'u'
; '
v'
;
1972 'w'
; 'x'
; 'y'
; 'z'
; '
0'
; '
1'
; '
2'
; '
3'
; '
4'
; '
5'
; '
6'
; '
7'
; '
8'
; '
9'
; '
+'
; '
/'
|] in
1974 for i
= 0 to (len / 3) - 1 do
1975 let c1 = int_of_char
t.[i
*3] in
1976 let c2 = int_of_char
t.[i
*3+1] in
1977 let c3 = int_of_char
t.[i
*3+2] in
1978 let n1 = c1 lsr 2 in
1979 let n2 = ((c1 land 3) lsl 4) lor (c2 lsr 4) in
1980 let n3 = ((c2 land 0xf) lsl 2) lor (c3 lsr 6) in
1981 let n4 = c3 land 63 in
1982 Printf.bprintf
buf "%c%c%c%c" b64_map.(n1) b64_map.(n2) b64_map.(n3) b64_map.(n4);
1984 if (len mod 3) = 1 then (
1986 let c1 = int_of_char
t.[i] in
1987 let c2 = int_of_char
t.[i+1] in
1988 let n1 = ((c1 land 0xf) lsl 2) lor (c2 lsr 6) in
1989 let n2 = c2 land 63 in
1990 Printf.bprintf
buf "%c%c==" b64_map.(n1) b64_map.(n2)
1992 else if (len mod 3) = 2 then (
1994 let c1 = int_of_char
t.[i] in
1995 let c2 = int_of_char
t.[i+1] in
1996 let c3 = int_of_char
t.[i+2] in
1997 let n1 = ((c1 land 3) lsl 4) lor (c2 lsr 4) in
1998 let n2 = ((c2 land 0xf) lsl 2) lor (c3 lsr 6) in
1999 let n3 = c3 land 63 in
2000 Printf.bprintf
buf "%c%c%c=" b64_map.(n1) b64_map.(n2) b64_map.(n3)
2003 let b64data = Buffer.contents
buf in
2008 match c
.client_source
.DonkeySources.source_sock
with
2010 (Ip.to_string
(peer_ip sock
) ^
":" ^ string_of_int
(peer_port sock
))
2011 | _ -> (match c
.client_kind
with
2012 Direct_address
(ip,port) ->
2013 ((Ip.to_string
ip) ^
":" ^ string_of_int
port)
2014 | Indirect_address
_ | Invalid_address
_ -> "Indirect"
2020 match c
.client_kind
with
2021 Direct_address
(ip,port) ->
2022 ((Ip.to_string
ip) ^
":" ^ string_of_int
port)
2023 | Indirect_address
_ | Invalid_address
_ -> "Indirect"
2027 log_chat_message
cip (client_num c
) c
.client_name
("data:image/bmp;base64," ^
b64data)
2030 | M.EmuleCaptchaRes
t ->
2035 match c
.client_source
.DonkeySources.source_sock
with
2037 (Ip.to_string
(peer_ip sock
) ^
":" ^ string_of_int
(peer_port sock
))
2038 | _ -> (match c
.client_kind
with
2039 Direct_address
(ip,port) ->
2040 ((Ip.to_string
ip) ^
":" ^ string_of_int
port)
2041 | Indirect_address
_ | Invalid_address
_ -> "Indirect"
2047 match c
.client_kind
with
2048 Direct_address
(ip,port) ->
2049 ((Ip.to_string
ip) ^
":" ^ string_of_int
port)
2050 | Indirect_address
_ | Invalid_address
_ -> "Indirect"
2054 log_chat_message
cip (client_num c
) c
.client_name
(
2056 "You have correctly solved the captcha and your message was sent."
2058 "Wrong answer to the captcha, so your message was not sent. You will only be sent 3 captchas. Try sending another message to receive another captcha challenge."
2060 "3 captchas have already been sent to you. Fail."
2062 "Unknown captcha state!?"
2066 | M.QueryChunkMd4Req
t when !CommonGlobals.has_upload
= 0 ->
2068 let file = find_file
t in
2070 match file.file_computed_md4s
with
2071 [||] -> () (* should not happen *)
2074 let module Q
= M.QueryChunkMd4Reply
in
2075 M.QueryChunkMd4ReplyReq
{
2076 Q.md4 = file.file_md4
;
2082 | M.QueryChunksReq
t ->
2083 c
.client_requests_received
<- c
.client_requests_received
+ 1;
2085 (* All clients query chunks during download! This is legitimate!
2086 !CommonGlobals.has_upload = 0 && *)
2087 (* banned is banned, do we need to check ban_queue_jumpers
2088 here? besides that ... we shouldn't be connected with
2089 a banned client! Waste of resources! Or? *)
2090 if not
(!!ban_queue_jumpers
&& c
.client_banned
) then
2093 let file = find_file
t in
2095 match file.file_swarmer
with
2097 (* file was found, if we have no swarmer, we have
2098 the file complete and share it! it's safe to
2099 assume that we have all chunks! *)
2100 Bitv.create
file.file_nchunks
true
2102 let bitmap = CommonSwarming.chunks_verified_bitmap swarmer
in
2103 Bitv.init
(VB.length
bitmap)
2104 (fun i -> VB.get
bitmap i = VB.State_verified
)
2105 (* This is not very smart, as we might get banned for this request.
2106 TODO We should probably check if we don't know already this source...
2108 NONSENSE! We don't need to query_file! A peer requesting
2109 chunks will always have (part of) that file!
2110 We would just have to add it as source ... but I think it was already done!
2112 DonkeySources.query_file c.client_source file.file_sources;
2117 let module Q
= M.QueryChunksReply
in
2118 M.QueryChunksReplyReq
{
2119 Q.md4 = file.file_md4
;
2124 if !verbose_unexpected_messages
then
2125 lprintf_nl "donkeyClient:QueryChunksReq: chunks of unpublished file %s queried from %s"
2126 (Md4.to_string
t) (full_client_identifier c
);
2127 client_send c
( M.NoSuchFileReq
t );
2130 | M.QueryBlocReq
t when !CommonGlobals.has_upload
= 0 &&
2131 client_has_a_slot
(as_client c
) ->
2133 let module Q
= M.QueryBloc
in
2134 let file = find_file
t.Q.md4 in
2136 let check_file_size size
=
2137 if size
> file_size
file && size
<> 0L then
2139 lprintf_nl "client requested filesize %Ld > real filesize %Ld, %s %s, upload slot revoked"
2140 size
(file_size
file) (file_best_name
file) (full_client_identifier c
);
2141 DonkeyOneFile.remove_client_slot c
;
2146 (* ignore block requests outside file boundaries *)
2147 check_file_size t.Q.start_pos1
;
2148 check_file_size t.Q.start_pos2
;
2149 check_file_size t.Q.start_pos3
;
2151 if !verbose_upload
then lprintf_nl "donkeyClient: uploader %s asks for %s"
2152 (full_client_identifier c
) (file_best_name
file);
2154 let prio = (file_priority
file) in
2155 let client_upload_lifetime = ref ((max
0 !!upload_lifetime
) * Date.minute_in_secs
) in
2157 if !!dynamic_upload_lifetime
&& not
!!upload_complete_chunks
2158 && c
.client_session_uploaded
> c
.client_session_downloaded
2159 && c
.client_session_uploaded
> Int64.of_int
!!dynamic_upload_threshold
** zone_size
2161 client_upload_lifetime :=
2163 (Int64.of_int
!client_upload_lifetime
2164 ** c
.client_session_downloaded
// c
.client_session_uploaded
);
2166 let client_received_enough c
=
2167 if !!upload_full_chunks
&& not
!!upload_complete_chunks
then
2168 c
.client_session_uploaded
> (block_size
++ 20L ** 1024L)
2170 last_time
() > c
.client_connect_time
+ !client_upload_lifetime + 5 * prio
2174 if client_received_enough c
then
2175 if Intmap.length
!CommonUploads.pending_slots_map
= 0 then
2177 if !verbose_upload
then lprintf_nl
2178 "donkeyClient: not closing upload slot of %s (%s), pending slots empty, sending next block..."
2179 (full_client_identifier c
) (file_best_name
file)
2182 DonkeyOneFile.remove_client_slot c
;
2186 set_lifetime sock
active_lifetime;
2187 set_rtimeout sock
!!upload_timeout
;
2189 let up, waiting
= match c
.client_upload
with
2190 | Some
({ up_file
= f
} as up) when f
== file ->
2191 (* zones are received in the order they're sent, so we
2192 know that the oldest of the zones "in fly" must have
2193 been received when this QueryBlockReq was sent *)
2194 (match up.up_flying_chunks
with
2196 | _ :: q
-> up.up_flying_chunks
<- q
);
2201 up_pos
= Int64.zero
;
2202 up_end_chunk
= Int64.zero
;
2204 up_flying_chunks
= [];
2205 up_current
= Int64.zero
;
2207 up_waiting
= old_up
.up_waiting
;
2208 }, old_up
.up_waiting
2212 up_pos
= Int64.zero
;
2213 up_end_chunk
= Int64.zero
;
2215 up_flying_chunks
= [];
2216 up_current
= ((t.Q.start_pos1
++ t.Q.end_pos1
) // (2L ** block_size
));
2221 new_chunk up t.Q.start_pos1
t.Q.end_pos1
;
2222 new_chunk up t.Q.start_pos2
t.Q.end_pos2
;
2223 new_chunk up t.Q.start_pos3
t.Q.end_pos3
;
2224 (match up.up_chunks
with
2226 (* it should never happen here, that a client with up.up_finish = false
2227 has an empty block queue *)
2228 if up.up_finish
&& !!upload_complete_chunks
then
2230 DonkeyOneFile.remove_client_slot c
;
2234 c
.client_upload
<- Some
up;
2235 set_client_upload
(as_client c
) (as_file
file);
2236 if not waiting
&& !CommonGlobals.has_upload
= 0 then begin
2237 CommonUploads.ready_for_upload
(as_client c
);
2238 up.up_waiting
<- true
2241 if !verbose_upload
then lprintf_nl "QueryBloc treated"
2243 | M.NoSuchFileReq
t ->
2246 let file = find_file
t in
2247 if !verbose_location
then
2248 lprintf_nl "donkeyClient: NoSuchFileReq: from %s for file %s"
2249 (full_client_identifier c
) (file_best_name
file);
2250 DonkeySources.set_request_result c
.client_source
2251 file.file_sources File_not_found
;
2256 if !verbose_unknown_messages
then begin
2257 lprintf_nl "Unused client message %s:" (full_client_identifier c
);
2261 let client_handler c sock event
=
2263 BASIC_EVENT
(CLOSED
s) ->
2264 disconnect_client c
s;
2266 | BASIC_EVENT
(LTIMEOUT
| RTIMEOUT
) ->
2267 close sock Closed_for_timeout
;
2270 if c.client_name <> "" then begin
2271 lprintf "client %s(%s) disconnected: reason %s\n"
2272 c.client_name (brand_to_string c.client_brand) s;
2278 let client_handler2 c sock event
=
2280 BASIC_EVENT
(CLOSED
s) -> decr
DonkeySources.indirect_connections
2283 Some c
-> client_handler c sock event
2286 BASIC_EVENT
(LTIMEOUT
| RTIMEOUT
) ->
2287 close sock Closed_for_timeout
2291 let init_connection sock
ip =
2292 TcpBufferedSocket.setsock_iptos_throughput sock
;
2295 Ip.matches
ip !!nolimit_ips
2297 if not
nolimit then begin
2298 TcpBufferedSocket.set_read_controler sock download_control
;
2299 TcpBufferedSocket.set_write_controler sock upload_control
;
2301 set_rtimeout sock
!!client_timeout
;
2303 (* Fix a lifetime for the connection. If we are not able to connect and
2304 query file within this delay, the connection is aborted.
2306 With 150 connections of 1 minute, it means we can at most make
2307 make 1500 connections/10 minutes. *)
2309 (* set_lifetime sock 60.; *)
2312 let init_client sock c
=
2313 set_handler sock WRITE_DONE
(fun s ->
2314 match c
.client_upload
with
2315 | Some
({ up_chunks
= _ :: _ } as up) ->
2316 if not
up.up_waiting
&& !CommonGlobals.has_upload
= 0 then begin
2317 up.up_waiting
<- true;
2318 CommonUploads.ready_for_upload
(as_client c
)
2323 set_handler sock (BASIC_EVENT RTIMEOUT) (fun s ->
2324 connection_delay c.client_connection_control;
2325 printf_string "-!C";
2328 (* c.client_block <- None; *)
2329 (* c.client_zones <- []; *)
2330 c
.client_file_queue
<- [];
2331 set_client_has_a_slot
(as_client c
) NoSlot
;
2332 c
.client_upload
<- None
;
2334 c
.client_requests_received
<- 0;
2335 c
.client_requests_sent
<- 0;
2336 c
.client_slot
<- SlotNotAsked
2338 let read_first_message overnet server
cc m sock
=
2339 let module M
= DonkeyProtoClient
in
2340 let real_ip = peer_ip sock
in
2341 if (not server
&& !verbose_msg_clients
) || (server
&& !verbose_msg_servers
) then begin
2342 lprintf_nl "Message from incoming %s %s:%d%s"
2343 (if server
then "server" else "client")
2344 (Ip.to_string
real_ip)
2346 (match cc with | None
-> "" | Some
cc -> Printf.sprintf
"(%d)" cc);
2353 if !verbose_msg_clients
then begin
2354 lprintf_nl "[HELLO] %s" (Ip.to_string
real_ip);
2357 let module CR
= M.Connect
in
2359 if not
(is_valid_client t.CR.md4 ) then
2361 TcpBufferedSocket.close sock
(Closed_for_error
"Connect of Invalid Client");
2365 if (is_black_address
t.CR.ip t.CR.port cc) then raise Exit
;
2367 let name = ref "" in
2368 List.iter (fun tag
->
2370 { tag_name
= Field_KNOWN
"name"; tag_value
= String
s } -> name := s
2375 if low_id
t.CR.ip then
2376 match t.CR.server_info
with
2378 Invalid_address
(!name, Md4.to_string
t.CR.md4)
2380 if Ip.usable
ip then
2381 Indirect_address
(ip, port, id_of_ip
t.CR.ip, t.CR.port, real_ip)
2383 Invalid_address
(!name, Md4.to_string
t.CR.md4)
2385 if Ip.usable
t.CR.ip then
2386 Direct_address
(t.CR.ip, t.CR.port)
2388 Invalid_address
(!name, Md4.to_string
t.CR.md4)
2391 let c = new_client
kind cc in
2392 if c.client_debug
|| !verbose_msg_clients
|| !verbose_msg_clienttags
then begin
2396 Hashtbl.add connected_clients
t.CR.md4 c;
2398 set_client_name
c !name t.CR.md4;
2399 c.client_tags
<- t.CR.tags
;
2400 identify_client_brand c;
2401 update_client_from_tags c t.CR.tags
;
2402 fight_disguised_mods c;
2403 update_emule_release c;
2405 match c.client_source
.DonkeySources.source_sock
with
2407 c.client_source
.DonkeySources.source_sock
<- Connection sock
;
2408 c.client_connected
<- true;
2410 init_client_after_first_message sock
c
2412 | ConnectionWaiting token
->
2414 c.client_source
.DonkeySources.source_sock
<- Connection sock
;
2415 c.client_connected
<- true;
2417 init_client_after_first_message sock
c
2420 close sock
(Closed_for_error
"already connected");
2421 c.client_connected
<- false;
2425 check_stolen_hash c sock
t.CR.md4;
2427 if !!reliable_sources
&&
2428 ip_reliability
real_ip = Reliability_suspicious
0 then begin
2429 set_client_state
c BlackListedHost
;
2434 match t.CR.server_info
with
2435 Some
(ip, port) -> if !!update_server_list_client
then safe_add_server
ip port
2437 if overnet
then begin
2438 lprintf_nl "incoming Overnet client";
2439 DonkeySources.set_source_brand
c.client_source overnet
;
2443 (* Lugdunum servers are not interested in our EmuleClientInfo *)
2444 if supports_eep c.client_brand
&& not server
then
2446 (* lprintf "Emule Extended Protocol query\n"; *)
2447 let module M
= DonkeyProtoClient
in
2448 let module E
= M.EmuleClientInfo
in
2449 client_send
c (M.EmuleClientInfoReq emule_info
)
2454 let module M
= DonkeyProtoClient
in
2455 let module C
= M.Connect
in
2456 if DonkeySources.source_brand
c.client_source
then
2458 C.md4 = overnet_md4
;
2459 C.ip = client_ip (Some sock
);
2460 C.port = !!overnet_port
;
2461 C.tags
= !overnet_connectreply_tags
;
2462 C.server_info
= Some
(!overnet_server_ip
, !overnet_server_port
);
2463 C.left_bytes
= left_bytes
;
2469 C.md4 = !!client_md4
;
2470 C.ip = client_ip (Some sock
);
2471 C.port = !!donkey_port
;
2472 (* Lugdunum servers need fewer infos than clients *)
2473 C.tags
= if server
then !client_to_server_reply_tags
else !client_to_client_tags
;
2474 C.server_info
= Some
(get_server_ip_port ());
2475 C.left_bytes
= left_bytes
;
2481 incr_activity_indirect_connections c;
2483 check_stolen_hash c sock
t.CR.md4;
2485 finish_client_handshake c sock
;
2488 | M.NewUserIDReq
_ ->
2489 lprintf_nl "NewUserIDReq: "; M.print
m;
2492 | M.EmulePortTestReq
t ->
2493 porttest_sock
:= Some sock
;
2494 set_closer sock
(fun _ _ -> porttest_sock
:= None
);
2495 set_lifetime sock
30.;
2496 write_string sock
(client_msg_to_string
(emule_proto
()) m);
2500 if !verbose_unknown_messages
then
2502 lprintf_nl "BAD MESSAGE FROM CONNECTING CLIENT with ip:%s port:%i overnet:%b"
2503 (Ip.to_string
real_ip) (peer_port sock
) overnet
;
2504 M.print
m; lprint_newline
();
2506 close sock
(Closed_for_error
"bad connecting message");
2510 let reconnect_client c =
2511 if can_open_connection connection_manager
then
2512 match c.client_kind
with
2513 Indirect_address
_ | Invalid_address
_ -> ()
2514 | Direct_address
(ip, port) ->
2515 if client_state
c <> BlackListedHost
then
2516 if !!black_list
&& is_black_address
ip port c.client_country_code
||
2517 (!!reliable_sources
&& ip_reliability
ip = Reliability_suspicious
0) then
2518 set_client_state
c BlackListedHost
2520 match c.client_source
.DonkeySources.source_sock
with
2521 ConnectionWaiting
_ | Connection
_ ->
2522 (* Already connected ! *)
2526 add_pending_connection connection_manager
(fun token ->
2528 set_client_state
c Connecting
;
2529 (* connection_try c.client_connection_control; *)
2531 let sock = TcpBufferedSocket.connect
token "donkey to client"
2532 (Ip.to_inet_addr
ip)
2534 (client_handler c) (*client_msg_to_string*) in
2537 incr_activity_connections c;
2539 init_connection sock ip;
2541 (* The lifetime of the client socket is now half an hour, and
2542 can be increased by AvailableSlotReq, BlocReq, QueryBlocReq
2544 set_lifetime
sock active_lifetime;
2546 c.client_checked
<- false;
2549 DonkeyProtoCom.cut_messages
2550 (DonkeyProtoClient.parse
c.client_emule_proto
)
2551 (client_to_client files c));
2553 c.client_source
.DonkeySources.source_sock
<- Connection
sock;
2555 let old_ip = c.client_ip in
2557 if old_ip <> Ip.null
&& old_ip <> c.client_ip &&
2558 c.client_country_code
= None
then
2559 check_client_country_code
c;
2560 c.client_connected
<- true;
2561 let server_ip, server_port
, server_cid
=
2563 let s = DonkeyGlobals.last_connected_master
() in
2564 match s.server_cid
with
2565 None
-> s.server_ip, s.server_port
, Ip.any
2566 | Some cid
-> s.server_ip, s.server_port
, cid
2567 with _ -> Ip.localhost
, 4665, Ip.any
2570 if not
(!!force_high_id
|| !!force_client_high_id
)
2571 && low_id server_cid
2572 && Ip.any
!= server_cid
2579 let module M
= DonkeyProtoClient
in
2580 let module C
= M.Connect
in
2581 if DonkeySources.source_brand
c.client_source
then
2583 C.md4 = overnet_md4
;
2584 C.ip = client_ip None
;
2585 C.port = !!overnet_port
;
2586 C.tags
= !overnet_connect_tags
;
2588 C.server_info
= Some
(!overnet_server_ip
,
2589 !overnet_server_port
);
2590 C.left_bytes
= left_bytes
;
2594 C.md4 = !!client_md4
;
2595 C.ip = send_this_id;
2596 C.port = !!donkey_port
;
2597 C.tags
= !client_to_client_tags
;
2599 C.server_info
= Some
(server_ip, server_port
);
2600 C.left_bytes
= left_bytes
;
2605 Unix.Unix_error
(Unix.ENETUNREACH
,_,_) ->
2606 if !verbose
then lprintf_nl "Network unreachable for IP %s:%d"
2607 (Ip.to_string
ip) port;
2608 set_client_disconnected
c (Closed_connect_failed
);
2609 DonkeySources.source_disconnected
c.client_source
2611 lprintf_nl "Exception %s in client connection to IP %s:%d"
2612 (Printexc2.to_string e
) (Ip.to_string
ip) port;
2613 (* connection_failed c.client_connection_control; *)
2614 set_client_disconnected
c (Closed_for_exception e
);
2615 DonkeySources.source_disconnected
c.client_source
2618 c.client_source
.DonkeySources.source_sock
<- ConnectionWaiting
token
2621 let query_locations_reply s t =
2622 let module M
= DonkeyProtoServer
in
2623 let module Q
= M.QueryLocationReply
in
2626 let file = find_file
t.Q.md4 in
2627 let nlocs = List.length
t.Q.locs
in
2629 if !verbose_location
then
2630 lprintf_nl "Received %d sources from server %s:%s for %s"
2631 nlocs (Ip.to_string
s.server_ip) (string_of_int
s.server_port
) (file_best_name
file);
2633 s.server_score
<- s.server_score
+ 3;
2635 (* TODO: verify that new sources are queried as soon as
2636 possible. Maybe we should check how many new sources
2637 this client has, and query a connection immediatly if
2638 they are too many. No need to care about in this
2639 place ... make need_new_sources based on ready
2640 sources, then the next refill_file will query them,
2645 add_source file l
.Q.ip l
.Q.port s.server_ip s.server_port
2647 with Not_found
-> ()
2649 let rec matches_3 l
ip =
2650 let rec iter l
(a
,b
,c,d
) =
2654 let (w
,x
,y
,z
) = Ip.to_ints
ip in
2655 w
=a
&& x
=b
&& y
=c -> ip
2656 | _ :: t -> iter t (a
,b
,c,d
)
2658 iter l
(Ip.to_ints
ip)
2660 let client_connection_handler overnet
t event
=
2662 TcpServerSocket.CONNECTION
(s, Unix.ADDR_INET
(from_ip
, from_port
)) ->
2663 let from_ip = Ip.of_inet_addr
from_ip in
2664 let s_from_ip = Ip.to_string
from_ip in
2665 let cc = Geoip.get_country_code_option
from_ip in
2666 let is_ip_blocked = !Ip.banned
(from_ip, cc) <> None
in
2667 let too_many_indirect_connections =
2668 !DonkeySources.indirect_connections
>
2669 !real_max_indirect_connections
2672 let connecting_server = matches_3 (connecting_server_ips
()) from_ip in
2673 let is_connecting_server = connecting_server <> Ip.null
in
2675 let accept_connection = not
is_ip_blocked
2676 && (not
too_many_indirect_connections || is_connecting_server)
2679 if !verbose_connect
|| (!verbose
&& (too_many_indirect_connections || is_connecting_server)) then
2680 lprintf_nl "incoming connection from %s:%d %s: (%d/%d)%s"
2682 (if accept_connection then "accepted" else
2683 if is_ip_blocked then "blocked" else "denied")
2684 !DonkeySources.indirect_connections
2685 !real_max_indirect_connections
2686 (if is_connecting_server then
2688 let s = Hashtbl.find servers_by_key
from_ip in
2689 set_server_state
s Connected_initiating
;
2690 Printf.sprintf
" %s (%s)" s.server_name
(string_of_server
s)
2693 let s = Hashtbl.find servers_by_key
connecting_server in
2694 set_server_state
s Connected_initiating
;
2695 Printf.sprintf
" %s (%s)" s.server_name
(string_of_server
s)
2696 with _ -> "Unknown server"
2701 if accept_connection then
2706 incr
DonkeySources.indirect_connections
;
2707 let token = create_token connection_manager
in
2709 TcpBufferedSocket.create
token "donkey client connection" s
2712 init_connection sock from_ip;
2713 accept_connection_bandwidth
sock;
2715 (* Normal connections have 20 minutes to live (AvailableSlot, QueryBloc
2716 and Bloc messages extend this lifetime), whereas exceeding connections
2717 have only 1 minute 30 seconds to live. *)
2719 if can_open_connection connection_manager
then
2726 (DonkeyProtoCom.client_handler2 c (read_first_message overnet
is_connecting_server cc)
2727 (client_to_client []));
2729 with e
-> lprintf_nl "Exception %s in init_connection"
2730 (Printexc2.to_string e
);
2733 lprintf_nl "Exception %s in client_connection_handler"
2734 (Printexc2.to_string e
);
2743 (*************************************************************************)
2745 (* Stubs for CommonSources *)
2747 (*************************************************************************)
2750 DonkeySources.functions
.DonkeySources.function_query
<-
2751 (fun s_uid file_uid
->
2753 let c = find_client_by_key s_uid
in
2754 let file = find_file
(Md4.of_string file_uid
) in
2755 c.client_requests_sent
<- c.client_requests_sent
+ 1;
2756 let module M
= DonkeyProtoClient
in
2758 let emule_extension =
2759 let extendedrequest = M.extendedrequest c.client_emule_proto
in
2760 if extendedrequest > 0 then
2761 match file.file_swarmer
with
2764 let bitmap = CommonSwarming.chunks_verified_bitmap swarmer
in
2766 Bitv.init
(VB.length
bitmap)
2767 (fun i -> VB.get
bitmap i = VB.State_verified
)
2769 let ncompletesources = if extendedrequest > 1 then
2771 Some
(chunks, ncompletesources)
2775 DonkeyProtoCom.client_send
c (
2777 M.QueryFile.md4 = file.file_md4
;
2779 (* TODO build the extension if needed *)
2780 M.QueryFile.emule_extension = emule_extension;
2782 c.client_last_file_req_md4
<- Some
file.file_md4
;
2783 let know_file_chunks = List.exists
(fun (f
,_,_) -> f
== file) c.client_file_queue
in
2784 if not
know_file_chunks then
2785 DonkeyProtoCom.client_send
c (
2786 let module M
= DonkeyProtoClient
in
2787 M.QueryChunksReq
file.file_md4
);
2788 ignore
(DonkeySources.add_request
c.client_source
2789 file.file_sources
(last_time
()))
2792 lprintf_nl "query_source: exception %s" (Printexc2.to_string e
)
2795 DonkeySources.functions
.DonkeySources.function_connect
<-
2800 let c = new_client s_uid s_cc
in
2802 | Invalid_address
_ -> ()
2803 | Indirect_address
(server_ip, server_port
, id, port, real_ip) ->
2805 if Ip.reachable
server_ip then
2806 query_id server_ip server_port
id;
2809 if !verbose
then begin
2810 lprintf_nl "connect_source: exception %s" (Printexc2.to_string e
);
2815 DonkeySources.functions
.DonkeySources.function_max_connections_per_second
<-
2816 (fun () -> !!max_connections_per_second
);
2818 DonkeySources.functions
.DonkeySources.function_max_sources_per_file
<-
2819 (fun () -> !!max_sources_per_file
);
2821 DonkeySources.functions
.DonkeySources.function_string_to_manager
<-
2823 let file = find_file
(Md4.of_string file_uid
) in
2828 (* TODO: verify that the client is destroyed very early. We should also find
2829 a way to keep the client allocated after the first successful connection,
2830 for a given time. For example, we could put successful clients in
2831 a FIFO from where they are removed after 30 minutes. What about using
2832 file.file_clients for this purpose !! *)
2833 DonkeySources.functions
.DonkeySources.function_add_location
<- (fun
2834 s_uid file_uid s_cc
->
2836 let file = find_file
(Md4.of_string file_uid
) in
2837 let c = new_client s_uid s_cc
in
2839 CommonFile.file_add_source
(CommonFile.as_file
file.file_file
)
2840 (CommonClient.as_client
c.client_client
);
2846 lprintf_nl "add_location: exception %s" (Printexc2.to_string e
)
2849 DonkeySources.functions
.DonkeySources.function_remove_location
<- (fun
2852 let file = find_file
(Md4.of_string file_uid
) in
2853 let c = new_client s_uid None
in
2854 CommonFile.file_remove_source
(CommonFile.as_file
file.file_file
)
2855 (CommonClient.as_client
c.client_client
);
2861 lprintf_nl "remove_location for file_md4 %s: exception %s"
2862 file_uid
(Printexc2.to_string e
)