I am creating a chat server in the Ocaml language using lwt. What I want it to be able to do is prompt the user to enter a nickname, store the nickname, and then output that the user has joined the chat.
I have already tried implementing my own code, as shown below.
let sessions = ref [("",Lwt_io.null)]
(* + obtain initial nick(name),
+ add (nick,outp) to !sessions, and
+ announce join to other users *)
let handle_login nr (inp,outp) =
Lwt_io.printl "Enter initial nick:" >>= (* Print a welcome message to outp *)
fun () -> Lwt_io.read_line inp >>= (* Read the user's nick from inp *)
fun s -> Lwt.return (nr := s); (* Assign the new value to nr *)
sessions := List.concat nr (* Adds nr to sessions *)
send_all nr "<joined>" >>= (* Inform the other users that the user joined *)
fun () -> Lwt.return ()
let rec send_all sender msg = Lwt.return ()
let chat_server _ (inp,outp) =
let nick = ref "" in
let _ = handle_login nick in (* Calls handle_login with nick *)
let rec main_loop () =
Lwt_io.read_line inp >>= handle_input nick outp >>= main_loop in
Lwt.catch main_loop (fun e -> handle_error e !nick inp outp)
open Lwt.Infix
let port = if Array.length Sys.argv > 1 then int_of_string (Sys.argv.(1)) else 16384
let s = Lwt_io.establish_server_with_client_address (Unix.ADDR_INET(Unix.inet_addr_any, port)) ChatServer.chat_server
let _ = Lwt_main.run (fst (Lwt.wait ()))
let _ = s >>= Lwt_io.shutdown_server (* never executes; you might want to use it in utop, though *)
The result should be that when running the program, it will:
print a welcome message to outp,
read the nick from inp,
assign the new value to nr
Add nr to sessions
Announce that the user has joined.
Right now, it compiles, but does not output anything.
Related
can you help me out, i made this program to get an output from some .txt file like this :
john:3:uk
paul:18:us
#load "str.cma"
let f_test = "/home/test.txt" ;;
(*
Recursive Reading function
*)
let read_lines f_test : string list =
if Sys.file_exists (f_test) then
begin
let ic = open_in f_test in
try
let try_read () =
try Some (input_line ic) with End_of_file -> None in
let rec loop acc = match try_read () with
| Some s -> loop (s :: acc)
| None -> close_in_noerr ic; List.rev acc in
loop []
with e ->
close_in_noerr ic;
[]
end
else
[]
;;
(*Using Records*)
type user =
{
name : string;
age : int;
country : string;
};;
(*
Function to separated info in list
*)
let rec splitinfo ?(sep=":") l = match l with
| [] -> []
| x::xs -> (Str.split (Str.regexp ":") x)::splitinfo xs;;
(*
Function to get users position
*)
let get_user l:user =
let age = int_of_string (List.nth l 1) in
let user_name = List.nth l 0 in
{
name = user_name;
age = age ;
country = List.nth l 2;
};;
(*
Function to check some parameter is valid
*)
let par1 u: int =
if (u.age = 3) then
1
else
0;;
(*
Reporting function
*)
let report_statistics list_users =
let child = ref 0 in
let teenager = ref 0 in
let adult = ref 0 in print_string (" ----- -- Stats -- ----- \n" ) ;
List.iter (
fun user_l -> (
match user_l with
| [] -> print_string("> no user <\n")
| _ ->
let user = get_user user_l in
if (par1 user = 1) then (
print_string (" "^ user.name ^" --> Child \n" ) ;
child := !child + 1;
)
else
print_string (" "^ user.name ^" --> Other \n" );
)
) list_users;
print_string ("------- List ---- ");
print_newline();
print_string ("Child " );
print_int(!child);
print_newline();
print_string ("Teenager ") ;
print_int(!teenager);
print_newline();
print_string ("Adult ");
print_int(!adult);
print_newline();
;;
The program compile but doesn't output any result ...
What am i missing ?
I kept the function to check parameters simple so i can understand it better but can't figure it out why it isn't outputing any result
Can you help me out here ?
Thanks in advance :)
The code as given defines some functions such as read_lines and report_statistics. But there are no calls to these functions.
If there is no other OCaml source involved, this is probably your problem. You need to call the functions.
It is fairly customary to have a "main" function that does the work of an OCaml program, and then (this is key) you have to actually call the main function:
let main () =
(* Call the functions that do the work of the program *)
let () = main ()
I have many times forgotten this last line and then nothing happens when I run the program.
I have been trying to gain a better understanding of the Eliom functionality for communication lately and to do so I tried to build a simple web page that allows users to send messages to each other.
The web page works fine if I log in as one user via Firefox and a second user via Chrome. But when I log in two different users in the same browser and try to send a message from one user to the other (i.e. from one tab to another tab), any message sent is displayed on all tabs, not the intended recipient's tab only.
I believe that I may have some issues with the chosen scope for erefs or where I am setting/getting the scope and erefs (toplevel vs. service definition).
I am trying to correct my mistake so that two users can be logged into two different tabs of the same browser and send messages back and forth to each other and the messages are only displayed on the correct users tabs.
Note: Some of this code is taken from the Eliom site tutorial at:
http://ocsigen.org/tuto/4.2/manual/how-to-implement-a-notification-system
My .eliom file:
(* Example website login: localhost:8080/?user_num=1 *)
{shared{
open Eliom_lib
open Eliom_content
open Html5
open Html5.F
open Eliom_registration
open Eliom_parameter
}}
module Channel_example_app =
Eliom_registration.App (
struct
let application_name = "channel_example"
end)
let main_service =
Eliom_service.App.service ~path:[] ~get_params:(string "user_num") ()
let new_message_action =
Eliom_service.Http.post_coservice'
~post_params:(string "from_user_id" ** string "to_user_id" ** string "msg") ()
(* Set the scope used by all erefs *)
let eref_scope = Eliom_common.default_process_scope
(* Create a channel eref *)
let channel_ref =
Eliom_reference.Volatile.eref_from_fun
~scope:eref_scope
(fun () ->
let (s, notify) = Lwt_stream.create () in
let c = Eliom_comet.Channel.create s in
(c, notify)
)
(* Reactive string eref *)
let react_string_ref =
Eliom_reference.Volatile.eref_from_fun
~scope:eref_scope
(fun () ->
let (client_string, send_client_string) :
(string React.E.t * (?step:React.step -> string -> unit) ) =
React.E.create ()
in
(client_string, send_client_string)
)
(* Reactive string to display the users session group *)
let react_session_group_ref =
Eliom_reference.Volatile.eref_from_fun
~scope:eref_scope
(fun () ->
let (session_group_string, send_session_group_string) :
(string React.E.t * (?step:React.step -> string -> unit) ) =
React.E.create ()
in
(session_group_string, send_session_group_string)
)
(* Reactive string to display the users session group size *)
let react_session_group_size_ref =
Eliom_reference.Volatile.eref_from_fun
~scope:eref_scope
(fun () ->
let (session_group_size_string, send_session_group_size_string) :
(string React.E.t * (?step:React.step -> string -> unit) ) =
React.E.create ()
in
(session_group_size_string, send_session_group_size_string)
)
(* Send a message from one client to another *)
let notify from_user_id to_user_id s =
(* Get the session group state for the user *)
let state =
Eliom_state.Ext.volatile_data_group_state ~scope:Eliom_common.default_group_scope to_user_id in
(* Iterate on all sessions from the group *)
Eliom_state.Ext.iter_volatile_sub_states ~state
(fun state ->
(* Iterate on all client process states in the session *)
Eliom_state.Ext.iter_volatile_sub_states ~state
(fun state ->
let (_, notify) = Eliom_reference.Volatile.Ext.get state channel_ref in
notify (Some ("Hello from " ^ from_user_id ^ "! You are user " ^ to_user_id ^ "\n\n" ^ s))
)
)
(* Action for a client to send a message *)
let () =
Eliom_registration.Action.register
~options:`NoReload
~service:new_message_action
(fun () (from_user_id, (to_user_id, msg)) ->
Lwt.return ## notify from_user_id to_user_id msg
)
(* Post form for one user to send a message to another user *)
let client_message_form =
Eliom_content.Html5.F.post_form ~service:new_message_action ~port:8080
(
fun (from_user_id, (to_user_id, msg)) ->
[p [pcdata "To:"];
string_input ~input_type:`Text ~name:to_user_id ();
p [pcdata "From:"];
string_input ~input_type:`Text ~name:from_user_id ();
p [pcdata "Send a message here:"];
string_input ~input_type:`Text ~name:msg ();
button ~button_type:`Submit [pcdata "Send Message"]
]
)
let () =
Channel_example_app.register
~service:main_service
(fun user_num () ->
(* Set the session group to which the erefs belong *)
Eliom_state.set_volatile_data_session_group
~set_max:1
~scope:Eliom_common.default_session_scope
~secure:true
user_num;
let (channel, _) = Eliom_reference.Volatile.get channel_ref in
let my_client_string, my_send_client_string = Eliom_reference.Volatile.get react_string_ref in
let my_send_client_string' =
server_function Json.t<string> (fun s -> Lwt.return ## my_send_client_string s)
in
let c_down = Eliom_react.Down.of_react my_client_string in
(* When a message is received on the channel, push it as a reactive event *)
let _ =
{unit{
Lwt.async
(fun () ->
Lwt_stream.iter (fun (s : string) -> ignore ## %my_send_client_string' s) %channel
)
}}
in
let my_session_group =
match
Eliom_state.get_volatile_data_session_group
~scope:Eliom_common.default_session_scope
~secure:true ()
with
| None -> "No session group"
| Some sg -> sg
in
let my_session_group_size =
match
Eliom_state.get_volatile_data_session_group_size
~scope:Eliom_common.default_session_scope
~secure:true ()
with
| None -> "0"
| Some gs -> string_of_int gs
in
Lwt.return
(Eliom_tools.F.html
~title:"channel_example"
~css:[["css";"channel_example.css"]]
Eliom_content.Html5.F.(body [
h2 [pcdata ("Your are logged in as user " ^ user_num)];
client_message_form ();
p [pcdata "Your message is:"];
C.node {{R.pcdata (React.S.hold "No message yet" %c_down)}};
p [pcdata ("I am a part of the session group named " ^ my_session_group)];
p [pcdata ("My session group size is " ^ my_session_group_size)]
])))
The problem came from using the notify function which loops through all tabs. I used the Hashtable / Weak Hashtable structure from Eliom Base App and it corrected all the communication issues. The key was altering the notify function as follows:
let notify ?(notforme = false) ~id ~to_user ~msg =
Lwt.async (fun () ->
I.fold
(fun (userid_o, ((_, _, send_e) as nn)) (beg : unit Lwt.t) ->
if notforme && nn == Eliom_reference.Volatile.get notif_e
then Lwt.return ()
else
lwt () = beg in
let content = if Some to_user = userid_o then Some msg else None in
match content with
| Some content -> send_e (id, content); Lwt.return ()
| None -> Lwt.return ()
)
id (Lwt.return ()))
I have some tests on infinite lazy structures that might run indefinitely if the tested function is not correctly implemented, but I can’t find in the OUnit docs how to set a timeout on tests.
If you're using OUnit2, the following should work:
let tests =
"suite" >::: [OUnitTest.TestCase (
OUnitTest.Short,
(fun _ -> assert_equal 2 (1+1))
);
OUnitTest.TestCase (
OUnitTest.Long,
(fun _ -> assert_equal 4 (2+2))
)]
The type test_length is defined as:
type test_length =
| Immediate
| Short
| Long
| Huge
| Custom_length of float
I don't think that oUnit provides this functionality. I remember having to do this a while back and this is the quick hack I've come up with:
let race seconds ~f =
let ch = Event.new_channel () in
let timeout = Thread.create (fun () ->
Thread.delay seconds;
`Time_out |> Event.send ch |> Event.sync
) () in
let tf = Thread.create (fun () ->
`Result (f ()) |> Event.send ch |> Event.sync) () in
let res = ch |> Event.receive |> Event.sync in
try
Thread.kill timeout;
Thread.kill tf;
res
with _ -> res
let () =
let big_sum () =
let arr = Array.init 1_000_000 (fun x -> x) in
Array.fold_left (+) 0 arr in
match race 0.0001 ~f:big_sum with
| `Time_out -> print_endline "time to upgrade";
| `Result x -> Printf.printf "sum is: %d\n" x
This worked well enough for my use case but I'd definitely would not recommend using this if only because race will not work as you'd expect if ~f does no allocations or calls Thread.yield manually.
I have a homework where i need to write 2 communication servers, one which generates natural numbers and the other which prints them. the generating server will be sending to the printing server. The servers should communicate over the shared channel chan.The main function should spawn a thread for each server.
`
val sender = fn : int -> unit
val receiver = fn : unit -> 'a
val main = fn : unit -> unit
`
And so far this is code i have written:
`
datatype 'a inflist = NIL
| CONS of 'a * (unit -> 'a inflist);
fun HD (CONS(a,b)) = a
| HD NIL = raise Subscript;
fun TL (CONS(a,b)) = b()
| TL NIL = raise Subscript;
fun NULL NIL = true
| NULL _ = false;
fun TAKE(xs, 0) = []
| TAKE(NIL, n) = raise Subscript
| TAKE(CONS(x,xf), n) = x::TAKE(xf(), n-1);
fun FROMN n = CONS (n,fn () => FROMN (n+1));
val natnumber = FROMN 0;
fun printGenList f (h::t) = (f h; printGenList f t);
fun printList l = printGenList (fn(e) => print(Int.toString(e)^" ")) l;
fun printPairList l = printGenList (fn(e,f) => print("("^Int.toString(e)^", "^Int.toString(f)^") ")) l;
CM.make "$cml/cml.cm";
open CML;
val chan: int chan = channel();
fun gen ch () = send (ch, printList(TAKE(natnumber,101)));
fun printnat ch () = recv (ch);
fun main () =
let
val ch = channel() :int chan ;
val _ = spawn (gen ch);
val _ = spawn (printnat ch);
in
()
end;
`
But i am not getting the output. Am i going wrong in my syntax or the logic?
I am new to SML and Concurrent ML. Please help me.
Why are you using a infinite list? There are simpler ways to implement this.
I'm trying to write a small Lwt (and batteries) port scanner to better
understand Lwt however I'm getting a strange exception whenever I try to scan
too many ports at a time with scan_ports_range. I'm suspecting my mechanism
for keeping a maximum number of connections open is not working...
Exception: Unix.Unix_error (Batteries.Unix.EMFILE, "socket","").
Fatal error: exception Sys_error("/home/(censored)/.opam/4.00.1/lib/utop: Too many open files")
(Which also crashes utop btw)
Code is below. To trigger the error evaluate:
scan_ports_range ~host:"127.0.0.1" (1000,2000)
Any critique/suggestions for my lwt style is also welcome since I've
only started learning it.
open Lwt
let addr_parts addr =
let (host, port) = String.split addr ":" in (host, int_of_string port)
let addr ~host ~port =
lwt entry = Lwt_unix.gethostbyname host in
if Array.length entry.Unix.h_addr_list = 0 then begin
failwith (Printf.sprintf "no address found for host %S\n" host)
end;
return (Unix.ADDR_INET (entry.Unix.h_addr_list.(0), port))
let test_connection ?(timeout=1.0) addr =
let fd = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
let connect_close =
(Lwt_unix.connect fd addr) >>= (fun () -> Lwt_unix.close fd) in
try_lwt
(pick [connect_close ; Lwt_unix.timeout timeout])
>>= (fun () -> return true)
with _ -> return false
let scan_ports ~host ~ports =
ports |> Lwt_list.map_p (fun port ->
lwt adr = addr ~host ~port in
test_connection adr >>= (fun res -> return (res,port)) )
>>= (fun l -> return ( l |> List.filter_map ( function
| false, _ -> None | true, port -> Some(port) ) ) )
let scan_ports_range ?(max_open=20) ~host (a, b) =
let rec loop acc enum =
match Enum.peek enum with
| None -> acc |> List.concat |> List.rev |> return
| Some _ ->
let ports = enum |> Enum.take max_open |> List.of_enum in
let open_ports = scan_ports ~host ~ports in
open_ports >>= (fun l -> loop (l::acc) enum )
in loop [] (a--b)
As a wild guess, I think you need to force the closing of the socket in case of timeout, so the cullprint might be:
pick [connect_close ; Lwt_unix.timeout timeout]
Here is the corrected code according to Thomas.
let test_connection ?(timeout=1.0) addr =
let fd = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
let connect_close =
(Lwt_unix.connect fd addr) >>= (fun () -> Lwt_unix.close fd) in
try_lwt
(pick [connect_close ; Lwt_unix.timeout timeout])
>>= (fun () -> return true)
with _ -> (Lwt_unix.close fd) >>= (fun () -> return false)