Index: src/daemon/common/commonClient.ml
===================================================================
RCS file: /cvsroot/mldonkey/mldonkey/src/daemon/common/commonClient.ml,v
retrieving revision 1.19
diff -u -r1.19 commonClient.ml
--- src/daemon/common/commonClient.ml	10 Oct 2005 16:22:24 -0000	1.19
+++ src/daemon/common/commonClient.ml	29 Oct 2005 08:50:03 -0000
@@ -29,6 +29,7 @@
     mutable impl_client_state : host_state;
     mutable impl_client_update : int;
     mutable impl_client_has_slot : bool;
+    mutable impl_client_has_friend_slot : bool;
     mutable impl_client_upload : shared option;
     mutable impl_client_num : int;
     mutable impl_client_val : 'a;
@@ -97,6 +98,7 @@
     impl_client_state = NewHost;
     impl_client_update = 1;
     impl_client_has_slot = false;
+    impl_client_has_friend_slot = false;
     impl_client_upload = None;
     impl_client_num = 0;
     impl_client_val = 0;
@@ -267,9 +269,53 @@
 
 let uploaders = ref Intmap.empty
 
+let client_type c =
+  let impl = as_client_impl c in
+  impl.impl_client_type
+
+let set_client_type c t =
+  let impl = as_client_impl c in
+  if impl.impl_client_type <> t then begin
+      impl.impl_client_type <- t;
+      client_must_update c
+    end
+
+let is_friend c =
+  (client_type c) land client_friend_tag <> 0
+
+let is_contact c =
+  (client_type c) land client_contact_tag <> 0
+
+let set_friend c =
+  set_client_type c (client_type c lor client_friend_tag)
+
+let set_contact c =
+  set_client_type c (client_type c lor client_contact_tag)
+
+let set_not_friend c =
+  set_client_type c (client_type c land (lnot client_friend_tag))
+
+let set_not_contact c =
+  set_client_type c (client_type c land (lnot client_contact_tag))
+
+let is_nolimit c =
+  (client_type c) land client_nolimit_tag <> 0
+
+let set_nolimit c =
+  set_client_type c (client_type c lor client_nolimit_tag)
+
+let is_initialized c =
+  client_type c land client_initialized_tag <> 0
+
+let set_initialized c =
+  set_client_type c (client_type c lor client_initialized_tag)
+
 let client_has_a_slot c =
   (as_client_impl c).impl_client_has_slot
 
+let client_has_a_friend_slot c =
+  (as_client_impl c).impl_client_has_friend_slot
+
 let client_upload c =
   (as_client_impl c).impl_client_upload
 
@@ -281,6 +327,7 @@
   let impl = as_client_impl c in
   if not b && impl.impl_client_has_slot then begin
       impl.impl_client_has_slot <- false;
+      impl.impl_client_has_friend_slot <- false;
       uploaders := Intmap.remove (client_num c) !uploaders;
       client_must_update c;
 (*
@@ -297,7 +344,8 @@
   else
   if b && not impl.impl_client_has_slot then  begin
       uploaders := Intmap.add (client_num c) c !uploaders;
-      impl.impl_client_has_slot <- b;
+      impl.impl_client_has_slot <- true;
+      impl.impl_client_has_friend_slot <- is_friend c;
       client_must_update c
     end
 
@@ -333,17 +381,6 @@
   H.remove clients_by_num c;
   set_client_state c RemovedHost
 
-let client_type c =
-  let impl = as_client_impl c in
-  impl.impl_client_type
-
-let set_client_type c t =
-  let impl = as_client_impl c in
-  if impl.impl_client_type <> t then begin
-      impl.impl_client_type <- t;
-      client_must_update c
-    end
-
 let _ =
   Heap.add_memstat "CommonClient" (fun level buf ->
       let counter = ref 0 in
@@ -409,36 +446,6 @@
             Printf.sprintf "%s:%d" (Ip.to_string ip) port)
     end
 
-
-let is_friend c =
-  (client_type c) land client_friend_tag <> 0
-
-let is_contact c =
-  (client_type c) land client_contact_tag <> 0
-
-let set_friend c =
-  set_client_type c (client_type c lor client_friend_tag)
-
-let set_contact c =
-  set_client_type c (client_type c lor client_contact_tag)
-
-let set_not_friend c =
-  set_client_type c (client_type c land (lnot client_friend_tag))
-
-let set_not_contact c =
-  set_client_type c (client_type c land (lnot client_contact_tag))
-
-let is_nolimit c =
-  (client_type c) land client_nolimit_tag <> 0
-
-let set_nolimit c =
-  set_client_type c (client_type c lor client_nolimit_tag)
-
-let is_initialized c =
-  client_type c land client_initialized_tag <> 0
-
-let set_initialized c =
-  set_client_type c (client_type c lor client_initialized_tag)
 
 let client_has_bitmap (client : client) (file : file) bitmap =
   CommonEvent.add_event (File_update_availability (file, client, bitmap))
Index: src/daemon/common/commonClient.mli
===================================================================
RCS file: /cvsroot/mldonkey/mldonkey/src/daemon/common/commonClient.mli,v
retrieving revision 1.8
diff -u -r1.8 commonClient.mli
--- src/daemon/common/commonClient.mli	1 Aug 2005 20:15:28 -0000	1.8
+++ src/daemon/common/commonClient.mli	29 Oct 2005 08:50:03 -0000
@@ -3,6 +3,7 @@
     mutable impl_client_state : CommonTypes.host_state;
     mutable impl_client_update : int;
     mutable impl_client_has_slot : bool;
+    mutable impl_client_has_friend_slot : bool;
     mutable impl_client_upload : CommonTypes.shared option;
     mutable impl_client_num : int;
     mutable impl_client_val : 'a;
@@ -72,6 +73,7 @@
 val client_upload : CommonTypes.client -> CommonTypes.shared option
 val set_client_upload : CommonTypes.client -> CommonTypes.shared option -> unit
 val client_has_a_slot : CommonTypes.client -> bool
+val client_has_a_friend_slot : CommonTypes.client -> bool
 val set_client_has_a_slot : CommonTypes.client -> bool -> unit
   
 val uploaders : CommonTypes.client Intmap.t ref
Index: src/daemon/common/commonOptions.ml
===================================================================
RCS file: /cvsroot/mldonkey/mldonkey/src/daemon/common/commonOptions.ml,v
retrieving revision 1.98
diff -u -r1.98 commonOptions.ml
--- src/daemon/common/commonOptions.ml	27 Oct 2005 09:41:06 -0000	1.98
+++ src/daemon/common/commonOptions.ml	29 Oct 2005 08:50:07 -0000
@@ -443,6 +443,10 @@
     "How many slots can be used for upload"
     int_option 5
 
+let friends_upload_slot = define_option current_section ["friends_upload_slot"]
+    "Set aside a single reserved slot to upload to friends"
+    bool_option true
+
 let dynamic_slots = define_option current_section ["dynamic_slots"]
     "Set this to true if you want to have dynamic upload slot allocation (experimental)" bool_option false
 
Index: src/daemon/common/commonUploads.ml
===================================================================
RCS file: /cvsroot/mldonkey/mldonkey/src/daemon/common/commonUploads.ml,v
retrieving revision 1.34
diff -u -r1.34 commonUploads.ml
--- src/daemon/common/commonUploads.ml	16 Oct 2005 20:42:50 -0000	1.34
+++ src/daemon/common/commonUploads.ml	29 Oct 2005 08:50:08 -0000
@@ -862,15 +862,18 @@
   let csh = client_upload c in
   let cdir = shared_dir csh in
   let cprio = ref (shared_prio csh) in
+  let cfriend = ref (if !!friends_upload_slot then 1 else 0) in
   (* if cdir <> "" then
     lprintf "Testing cdir %s\n" cdir; *)
   Intmap.iter (fun _ c ->
     let sh = client_upload c in
-    if shared_dir sh = cdir then decr cprio
+    if shared_dir sh = cdir then decr cprio;
+    if client_has_a_friend_slot c then decr cfriend;
   ) !CommonClient.uploaders;
   (* if cdir <> "" then
-    lprintf "Testing cprio %d\n" !cprio; *)
-  if !cprio > 0 then begin
+    lprintf "Testing cprio %d cfriend %d\n" !cprio !cfriend; *)
+  if !cprio > 0 || 
+     (is_friend c && !cfriend > 0) then begin
     remove_pending_slot c;
     if client_is_connected c then begin
       set_client_has_a_slot c true;
