Author: dylan
Date: 2005-12-21 10:34:48 -0500 (Wed, 21 Dec 2005)
New Revision: 959
Added:
trunk/ocaml/server/main.ml
trunk/ocaml/server/util.ml
Modified:
trunk/
trunk/ocaml/server/Makefile
trunk/ocaml/server/client.ml
trunk/ocaml/server/entity.ml
trunk/ocaml/server/entity.mli
trunk/ocaml/server/listener.ml
trunk/ocaml/server/reader.ml
Log:
More fixages.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/winch/trunk:43192
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1708
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/winch/trunk:43192
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1710
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Modified: trunk/ocaml/server/Makefile
===================================================================
--- trunk/ocaml/server/Makefile 2005-12-19 02:02:05 UTC (rev 958)
+++ trunk/ocaml/server/Makefile 2005-12-21 15:34:48 UTC (rev 959)
@@ -3,7 +3,8 @@
INTERFACES = entity.mli
SOURCES = $(INTERFACES) \
- net.ml protocol.ml client.ml entity.ml reader.ml listener.ml
+ util.ml \
+ net.ml protocol.ml client.ml entity.ml reader.ml listener.ml
main.ml
#TESTS = t/test_Util.ml t/test_Path.ml \
t/test_Graph.ml t/test_Recipe.ml \
Modified: trunk/ocaml/server/client.ml
===================================================================
--- trunk/ocaml/server/client.ml 2005-12-19 02:02:05 UTC (rev 958)
+++ trunk/ocaml/server/client.ml 2005-12-21 15:34:48 UTC (rev 959)
@@ -29,13 +29,13 @@
let read c =
let line = chomp (input_line c.input) in
- Printf.printf "READ: %s\n" line;
+ Printf.printf "READ(%d): %s\n" (id c) line;
flush stdout;
decode line
let write c msg =
let line = ((encode msg) ^ "\r\n") in
- Printf.printf "WRITE: %s" line;
+ Printf.printf "WRITE(%d): %s" (id c) line;
flush stdout;
output_string c.output line;
flush c.output
Modified: trunk/ocaml/server/entity.ml
===================================================================
--- trunk/ocaml/server/entity.ml 2005-12-19 02:02:05 UTC (rev 958)
+++ trunk/ocaml/server/entity.ml 2005-12-21 15:34:48 UTC (rev 959)
@@ -17,23 +17,17 @@
module IntMap = Map.Make(Int)
-exception Exists
-exception Missing of string
-
-let atomic mutex f =
- Mutex.lock mutex;
- let rv = try
- f ()
- with e ->
- Mutex.unlock mutex;
- raise e
- in
- Mutex.unlock mutex;
- rv
-
+(* Joined (cid, uid) *)
+exception Joined of string * string
+(* Parted (cid, uid) *)
+exception Parted of string * string
+exception Exists of [`User | `Channel ] * string
+exception Unknown of [`User | `Channel ] * string
+
+
+
module User =
struct
-
type t = {
name: string;
version: string;
@@ -66,12 +60,15 @@
let add_channel name user =
if StrSet.mem name user.channels then
- raise Exists
+ raise (Joined (name, user.name))
else
replace_channel name user
let remove_channel name user =
- { user with channels = StrSet.remove name user.channels }
+ if StrSet.mem name user.channels then
+ { user with channels = StrSet.remove name user.channels }
+ else
+ raise (Parted (name, user.name))
let channels user = StrSet.elements user.channels
@@ -82,7 +79,6 @@
module Channel =
struct
-
type t = {
name: string;
owner: string;
@@ -102,12 +98,15 @@
let add_user name chan =
if StrSet.mem name chan.users then
- raise Exists
+ raise (Joined (chan.name, name))
else
replace_user name chan
let remove_user name chan =
- { chan with users = StrSet.remove name chan.users }
+ if StrSet.mem name chan.users then
+ { chan with users = StrSet.remove name chan.users }
+ else
+ raise (Parted (chan.name, name))
let users chan = StrSet.elements chan.users
end
@@ -130,7 +129,7 @@
let find_user name lobby =
try
StrMap.find name lobby.users
- with Not_found -> raise (Missing name)
+ with Not_found -> raise (Unknown (`User, name))
let find_user_by_id id lobby =
find_user (IntMap.find id lobby.clients) lobby
@@ -152,7 +151,7 @@
let add_user user lobby =
if StrMap.mem (User.name user) lobby.users then
- raise Exists
+ raise (Exists (`User, User.name user))
else
replace_user user lobby
@@ -167,7 +166,7 @@
let find_channel name lobby =
try
StrMap.find name lobby.channels
- with Not_found -> raise (Missing name)
+ with Not_found -> raise (Unknown (`Channel, name))
let remove_channel name lobby =
{ lobby with channels = StrMap.remove name lobby.channels }
@@ -177,7 +176,7 @@
let add_channel channel lobby =
if StrMap.mem (Channel.name channel) lobby.channels then
- raise Exists
+ raise (Exists (`Channel, Channel.name channel))
else
replace_channel channel lobby
@@ -245,7 +244,7 @@
sendin cid ["QUIT"; cid; uid] lobby';
lobby'
- let close_channel cid lobby =
+ let close_channel cid uid lobby =
let chan = find_channel cid lobby in
let uids = Channel.users chan in
let lobby' =
Modified: trunk/ocaml/server/entity.mli
===================================================================
--- trunk/ocaml/server/entity.mli 2005-12-19 02:02:05 UTC (rev 958)
+++ trunk/ocaml/server/entity.mli 2005-12-21 15:34:48 UTC (rev 959)
@@ -1,39 +1,47 @@
+exception Joined of string * string
+exception Parted of string * string
+exception Exists of [ `User | `Channel ] * string
+exception Unknown of [ `User | `Channel ] * string
-exception Exists
-exception Missing of string
-
-val atomic : Mutex.t -> (unit -> 'a) -> 'a
-
module User :
-sig
- type t
- val create : ?features:string -> version:string -> client:Client.t -> string
-> t
- val name : t -> string
- val send : string list -> t -> unit
- val channels : t -> string list
-end
-
+ sig
+ type t
+ val id : t -> int
+ val create :
+ ?features:string -> version:string -> client:Client.t -> string -> t
+ val name : t -> string
+ val channels : t -> string list
+ val send : string list -> t -> unit
+ val shutdown : t -> unit
+ end
module Channel :
sig
type t
val create : ?owner:string -> string -> t
val name : t -> string
+ val users : t -> string list
end
-
module Lobby :
-sig
- type t
- val create : unit -> t
- val login : version:string -> name:string -> features:string ->
client:Client.t -> t -> t
- val sendto : string -> string list -> t -> unit
- val sendin : string -> string list -> t -> unit
- val find_user : string -> t -> User.t
- val open_channel : string -> string -> t -> t
- val join_channel : string -> string -> t -> t
- val part_channel : string -> string -> t -> t
- val close_channel : string -> t -> t
- val quit : string -> string list -> t -> t
- val quit_after_eof : string -> string list -> t -> t
- val lookup_client : Client.t -> t -> string
- val shutdown : string -> t -> t
-end
+ sig
+ type t
+ val create : unit -> t
+ val find_user : string -> t -> User.t
+ val find_user_by_id : int -> t -> User.t
+ val users : t -> User.t list
+ val find_channel : string -> t -> Channel.t
+ val channels : t -> Channel.t list
+ val login :
+ version:string ->
+ name:string -> features:string -> client:Client.t -> t -> t
+ val sendto : string -> string list -> t -> unit
+ val sendin : string -> string list -> t -> unit
+ val open_channel : string -> string -> t -> t
+ val close_channel : string -> 'a -> t -> t
+ val join_channel : string -> string -> t -> t
+ val part_channel : string -> string -> t -> t
+ val quit_channel : string -> string -> t -> t
+ val quit : string -> string list -> t -> t
+ val quit_after_eof : string -> string list -> t -> t
+ val lookup_client : Client.t -> t -> string
+ val shutdown : string -> t -> t
+ end
Modified: trunk/ocaml/server/listener.ml
===================================================================
--- trunk/ocaml/server/listener.ml 2005-12-19 02:02:05 UTC (rev 958)
+++ trunk/ocaml/server/listener.ml 2005-12-21 15:34:48 UTC (rev 959)
@@ -3,7 +3,7 @@
let rec main sock =
let info = Net.accept sock in
let client = Client.create info in
- Reader.start client;
+ ignore (Reader.start client);
main sock
let start port =
@@ -11,4 +11,3 @@
flush stdout;
Thread.create main (Net.listen port)
-let _ = Thread.join (start 7000)
Added: trunk/ocaml/server/main.ml
===================================================================
--- trunk/ocaml/server/main.ml 2005-12-19 02:02:05 UTC (rev 958)
+++ trunk/ocaml/server/main.ml 2005-12-21 15:34:48 UTC (rev 959)
@@ -0,0 +1,7 @@
+
+
+
+let _ =
+ Thread.join (
+ Listener.start 7575
+ )
Modified: trunk/ocaml/server/reader.ml
===================================================================
--- trunk/ocaml/server/reader.ml 2005-12-19 02:02:05 UTC (rev 958)
+++ trunk/ocaml/server/reader.ml 2005-12-21 15:34:48 UTC (rev 959)
@@ -13,9 +13,9 @@
let mutex = Mutex.create ()
let lobby_do f = f !lobby
-
+
let lobby_update f =
- atomic mutex begin
+ Util.atomic mutex begin
fun () ->
lobby := f !lobby
end
@@ -48,7 +48,7 @@
);
Normal name
with
- Exists ->
+ Exists (`Channel, name) ->
Client.write client ["FAIL"; "IDENT"; "exists.user"; name];
Login (ver, sup, client)
end
@@ -63,21 +63,21 @@
| "TO" :: uid :: msg ->
begin try
lobby_do (Lobby.sendto uid ("FROM" :: self :: msg));
- with Missing uid ->
+ with Unknown (`User, uid) ->
fail self ["unknown.user"; uid]
end;
norm
| "IN" :: cid :: msg ->
begin try
lobby_do (Lobby.sendin cid ("IN" :: cid :: self :: msg))
- with Missing cid ->
+ with Unknown (`Channel, cid) ->
fail self ["IN"; "unknown.channel"; cid]
end;
norm
| "OPEN" :: cid :: _ ->
begin try
lobby_update (Lobby.open_channel cid self);
- with Exists ->
+ with Exists (`Channel, cid) ->
fail self ["OPEN"; "exists.channel"; cid]
end;
norm
@@ -85,16 +85,32 @@
begin try
lobby_update (Lobby.join_channel cid self);
with
- Exists ->
+ Joined (c, u) when u = self && c = cid ->
fail self ["JOIN"; "already.joined"; cid]
- | Missing cid ->
+ | Unknown (`Channel, c) when c = cid ->
fail self ["JOIN"; "unknown.channel"; cid]
end;
norm
- | "BYE" :: msg :: [] ->
- shutdown ["active"; msg]
- | "BYE" :: [] ->
- shutdown ["active"]
+ | "PART" :: cid :: _ ->
+ begin try
+ lobby_update (Lobby.part_channel cid self)
+ with
+ Unknown (`Channel, c) when c = cid ->
+ fail self ["PART"; "unknown.channel"; cid]
+ | Parted (c, u) when c = cid && u = self ->
+ fail self ["PART"; "already.parted"; cid]
+ end;
+ norm
+ | "CLOSE" :: cid :: _ ->
+ begin try
+ lobby_update (Lobby.close_channel cid self)
+ with
+ Unknown (`Channel, c) when c = cid ->
+ fail self ["CLOSE"; "unknown.channel"; cid]
+ end;
+ norm
+ | "BYE" :: msg when (List.length msg) <= 1 ->
+ shutdown ("active" :: msg)
| "CHANS" :: l ->
let cids = User.channels (lobby_do (Lobby.find_user self)) in
lobby_do (Lobby.sendto self ("CHANS" :: cids));
@@ -172,5 +188,5 @@
let start client =
- ignore (Thread.create main client)
+ Thread.create main client
Added: trunk/ocaml/server/util.ml
===================================================================
--- trunk/ocaml/server/util.ml 2005-12-19 02:02:05 UTC (rev 958)
+++ trunk/ocaml/server/util.ml 2005-12-21 15:34:48 UTC (rev 959)
@@ -0,0 +1,12 @@
+
+let atomic mutex f =
+ Mutex.lock mutex;
+ let rv = try
+ f ()
+ with e ->
+ Mutex.unlock mutex;
+ raise e
+ in
+ Mutex.unlock mutex;
+ rv
+
