I'm trying to implement a long live TCP connection with ninnenine ranch
erlang library .
But looking at the documentation i cannot see a way of doing that.
Also i have written my own ranch protocol as shown below
start_link(Ref, _Socket, Transport, Opts) ->
Pid = spawn_link(?MODULE, init, [Ref, Transport, Opts]),
{ok, Pid}.
init(Ref, Transport, _Opts = []) ->
{ok, Socket} = ranch:handshake(Ref),
loop(Socket, Transport).
loop(Socket, Transport) ->
case Transport:recv(Socket, 0, 5000) of
{ok, Data} when Data =/= <<4>> ->
%% Transport:send(Socket, Data),
io:format("~w Connction accpted~n", [Data]);
_ -> ok
%%, Transport:close(Socket)
end.
as you can see i have commented the Transport:close(Socket) and i'm not sending any response to the client since Transsport:send(socket,Data) is also commented thinking that is was going to solve the problem but still, my connections where closing immediately as opened . i have a golang client shown below
package main
import (
"fmt"
"log"
"net"
)
func main(){
conn, err := net.Dial("tcp", "localhost:5555")
if err != nil {
fmt.Println(err)
}
fmt.Println(conn /*, i*/)
conn.Write(XMLData)
buffer := make([]byte, 10024)
n, err := conn.Read(buffer)
fmt.Println(buffer[:n])
//conn.Close()
}
i though it was a time out in ranch causing that. I searched and i found that in the ranch, in the the file src/ranch_tcp.erl , we have the function listen implemented as below
listen(Opts) ->
Opts2 = ranch:set_option_default(Opts, backlog, 1024),
Opts3 = ranch:set_option_default(Opts2, nodelay, true),
Opts4 = ranch:set_option_default(Opts3, send_timeout, 30000),
Opts5 = ranch:set_option_default(Opts4, send_timeout_close, true),
%% We set the port to 0 because it is given in the Opts directly.
%% The port in the options takes precedence over the one in the
%% first argument.
gen_tcp:listen(0, ranch:filter_options(Opts5, disallowed_listen_options(),
[binary, {active, false}, {packet, raw}, {reuseaddr, true}])).
As you can see there is a timeout option specifically Opts5 Opts5 = ranch:set_option_default(Opts4, send_timeout_close, true) and Opts4 Opts4 = ranch:set_option_default(Opts3, send_timeout, 30000),.I disabled them but still not working . So what am i supposed to do to have a long live tcp connection using ranch.
Your protocol implementation has a flaw
loop(Socket, Transport) ->
case Transport:recv(Socket, 0, 5000) of
{ok, Data} when Data =/= <<4>> ->
%% Transport:send(Socket, Data),
io:format("~w Connction accpted~n", [Data]);
_ -> ok
%%, Transport:close(Socket)
end.
You do not call the loop/2 recursively in any of your case clause branch, thus the your protocol process dies when loop/2 returns bringing tcp connection down.
Related
I just do a testing with gen_tcp. One simple echo server, and one client.
But client started and closed, server accept two connection, and one is ok, the other is bad.
Any issue of my demo script, and how to explain it?
server
-module(echo).
-export([listen/1]).
-define(TCP_OPTIONS, [binary, {packet, 0}, {active, false}, {reuseaddr, true}]).
listen(Port) ->
{ok, LSocket} = gen_tcp:listen(Port, ?TCP_OPTIONS),
accept(LSocket).
accept(LSocket) ->
{ok, Socket} = gen_tcp:accept(LSocket),
spawn(fun() -> loop(Socket) end),
accept(LSocket).
loop(Socket) ->
timer:sleep(10000),
P = inet:peername(Socket),
io:format("ok ~p~n", [P]),
case gen_tcp:recv(Socket, 0) of
{ok, Data} ->
gen_tcp:send(Socket, Data),
loop(Socket);
{error, closed} ->
ok;
E ->
io:format("bad ~p~n", [E])
end.
Demo Server
1> c(echo).
{ok,echo}
2> echo:listen(1111).
ok {ok,{{192,168,2,184},51608}}
ok {error,enotconn}
Client
> spawn(fun() -> {ok, P} = gen_tcp:connect("192.168.2.173", 1111, []), gen_tcp:send(P, "aa"), gen_tcp:close(P) end).
<0.64.0>
```
But client started and closed, server accept two connection, and one is ok, the other is bad.
Actually, your server only accepted one connection:
Enter loop/1 upon accepting the connection from the client
inet:peername/1 returns {ok,{{192,168,2,184},51608}} because the socket is still open
gen_tcp:recv/2 returns <<"aa">> which was sent by the client
gen_tcp:send/2 sends the data from 3 to the client
Enter loop/1 again
inet:peername/1 returns {error,enotconn} because the socket was closed by the client
gen_tcp:recv/2 returns {error,closed}
The process exits normally
So in reality, your echo server is functioning just fine, however there are some improvements that can be made that are mentioned in the comment made by #zxq9.
Improvement 1
Hand off control of the accepted socket to the newly spawned process.
-module(echo).
-export([listen/1]).
-define(TCP_OPTIONS, [binary, {packet, 0}, {active, false}, {reuseaddr, true}]).
listen(Port) ->
{ok, LSocket} = gen_tcp:listen(Port, ?TCP_OPTIONS),
accept(LSocket).
accept(LSocket) ->
{ok, CSocket} = gen_tcp:accept(LSocket),
Ref = make_ref(),
To = spawn(fun() -> init(Ref, CSocket) end),
gen_tcp:controlling_process(CSocket, To),
To ! {handoff, Ref, CSocket},
accept(LSocket).
init(Ref, Socket) ->
receive
{handoff, Ref, Socket} ->
{ok, Peername} = inet:peername(Socket),
io:format("[S] peername ~p~n", [Peername]),
loop(Socket)
end.
loop(Socket) ->
case gen_tcp:recv(Socket, 0) of
{ok, Data} ->
io:format("[S] got ~p~n", [Data]),
gen_tcp:send(Socket, Data),
loop(Socket);
{error, closed} ->
io:format("[S] closed~n", []);
E ->
io:format("[S] error ~p~n", [E])
end.
Improvement 2
Wait on the client side for the echo server to send back the data before closing the socket.
spawn(fun () ->
{ok, Socket} = gen_tcp:connect("127.0.0.1", 1111, [binary, {packet, 0}, {active, false}]),
{ok, Peername} = inet:peername(Socket),
io:format("[C] peername ~p~n", [Peername]),
gen_tcp:send(Socket, <<"aa">>),
case gen_tcp:recv(Socket, 0) of
{ok, Data} ->
io:format("[C] got ~p~n", [Data]),
gen_tcp:close(Socket);
{error, closed} ->
io:format("[C] closed~n", []);
E ->
io:format("[C] error ~p~n", [E])
end
end).
Example
The server should look something like this:
1> c(echo).
{ok,echo}
2> echo:listen(1111).
[S] peername {{127,0,0,1},57586}
[S] got <<"aa">>
[S] closed
The client should look something like this:
1> % paste in the code from Improvement 2
<0.34.0>
[C] peername {{127,0,0,1},1111}
[C] got <<"aa">>
Recommendations
As #zxq9 mentioned, this is not OTP style code and probably shouldn't be used for anything beyond educational purposes.
A better approach might be to use something like ranch or gen_listener_tcp for the server side listening and accepting of connections. Both projects have examples of echo servers: tcp_echo (ranch) and echo_server.erl (gen_listener_tcp).
I am using the following code to create a TCP listener on elixir :
defmodule KVServer do
use Application
#doc false
def start(_type, _args) do
import Supervisor.Spec
children = [
supervisor(Task.Supervisor, [[name: KVServer.TaskSupervisor]]),
worker(Task, [KVServer, :accept, [4040]])
]
opts = [strategy: :one_for_one, name: KVServer.Supervisor]
Supervisor.start_link(children, opts)
end
#doc """
Starts accepting connections on the given `port`.
"""
def accept(port) do
{:ok, socket} = :gen_tcp.listen(port,
[:binary, packet: :line, active: false, reuseaddr: true])
IO.puts "Accepting connections on port #{port}"
loop_acceptor(socket)
end
defp loop_acceptor(socket) do
{:ok, client} = :gen_tcp.accept(socket)
{:ok, pid} = Task.Supervisor.start_child(KVServer.TaskSupervisor, fn -> serve(client) end)
:ok = :gen_tcp.controlling_process(client, pid)
loop_acceptor(socket)
end
defp serve(socket) do
socket
|> read_line()
|> write_line(socket)
serve(socket)
end
defp read_line(socket) do
{:ok, data} = :gen_tcp.recv(socket, 0)
data
end
defp write_line(line, socket) do
:gen_tcp.send(socket, line)
end
end
It is taken from the following link: http://elixir-lang.org/getting-started/mix-otp/task-and-gen-tcp.html
When I try to get data from my gps deveice (for which I am writing this piece of code) using :gen_tcp.recv(socket,0), I get an error:
{:error, reason} = :gen_tcp.recv(socket, 0) and the reason it showed is just "closed".
However, the device is sending data, which I confirmed using a tcp packet sniffer (tcpflow).
Also, when I try to send data using telnet as described in the tutorial above, it works fine.
Any help would be highly appreciated.
I was finally able to figure it out. Actually the device was sending raw stream of data not lines of data. So I had to change "packet: :line" parameter in :gen_tcp.listen function to "packet: :raw".
It was working on telnet because telnet sends lines of data (with line breaks).
Consider the following (based on sockserv from LYSE)
%%% The supervisor in charge of all the socket acceptors.
-module(tcpsocket_sup).
-behaviour(supervisor).
-export([start_link/0, start_socket/0]).
-export([init/1]).
start_link() ->
supervisor:start_link({local, ?MODULE}, ?MODULE, []).
init([]) ->
{ok, Port} = application:get_env(my_app,tcpPort),
{ok, ListenSocket} = gen_tcp:listen(
Port,
[binary, {packet, 0}, {reuseaddr, true}, {active, true} ]),
lager:info(io_lib:format("Listening for TCP on port ~p", [Port])),
spawn_link(fun empty_listeners/0),
{ok, {{simple_one_for_one, 60, 3600},
[{socket,
{tcpserver, start_link, [ListenSocket]},
temporary, 1000, worker, [tcpserver]}
]}}.
start_socket() ->
supervisor:start_child(?MODULE, []).%,
empty_listeners() ->
[start_socket() || _ <- lists:seq(1,20)],
ok.
%%%-------------------------------------------------------------------
%%% #author mylesmcdonnell
%%% #copyright (C) 2015, <COMPANY>
%%% #doc
%%%
%%% #end
%%% Created : 06. Feb 2015 07:49
%%%-------------------------------------------------------------------
-module(tcpserver).
-author("mylesmcdonnell").
-behaviour(gen_server).
-record(state, {
next,
socket}).
-export([start_link/1]).
-export([init/1, handle_call/3, handle_cast/2, handle_info/2, code_change/3, terminate/2]).
-define(SOCK(Msg), {tcp, _Port, Msg}).
-define(TIME, 800).
-define(EXP, 50).
start_link(Socket) ->
gen_server:start_link(?MODULE, Socket, []).
init(Socket) ->
gen_server:cast(self(), accept),
{ok, #state{socket=Socket}}.
handle_call(_E, _From, State) ->
{noreply, State}.
handle_cast(accept, S = #state{socket=ListenSocket}) ->
{ok, AcceptSocket} = gen_tcp:accept(ListenSocket),
kvstore_tcpsocket_sup:start_socket(),
receive
{tcp, Socket, <<"store",Value/binary>>} ->
Uid = kvstore:store(Value),
send(Socket,Uid);
{tcp, Socket, <<"retrieve",Key/binary>>} ->
case kvstore:retrieve(binary_to_list(Key)) of
[{_, Value}|_] ->
send(Socket,Value);
_ ->
send(Socket,<<>>)
end;
{tcp, Socket, _} ->
send(Socket, "INVALID_MSG")
end,
{noreply, S#state{socket=AcceptSocket, next=name}}.
handle_info(_, S) ->
{noreply, S}.
code_change(_OldVsn, State, _Extra) ->
{ok, State}.
terminate(normal, _State) ->
ok;
terminate(_Reason, _State) ->
lager:info("terminate reason: ~p~n", [_Reason]).
send(Socket, Bin) ->
ok = gen_tcp:send(Socket, Bin),
ok = gen_tcp:close(Socket),
ok.
I'm unclear on how each tcpserver process is terminated? Is this leaking processes?
I don't see any place that you are terminating the owning process.
I think what you are looking for are four cases:
The client terminates the connection (you receive tcp_closed)
The connection goes wonky (you receive tcp_error)
The server receives a system message to terminate (this could, of course, just be the supervisor killing it, or a kill message)
The client sends a message telling the server its done and you want to do some clean up other than just reacting to tcp_closed.
The most common case is usually the client just closes the connection, and for that you want something like:
handle_info({tcp_closed, _}, State) ->
{stop, normal, State};
The connection getting weird is always a possibility. I can't think of any time I want to have the owning process or the socket stick around, so:
%% You might want to log something here.
handle_info({tcp_error, _}, State) ->
{stop, normal, State};
And any case where the client tells the server its done and you need to do cleanup based on the client having done something successful (maybe you have resources open that should be written to first, or a pending DB transaction open, or whatever) you would want to expect a success message from the client that closes the connection the way your send/2 does, and returns {stop, normal, State} to halt the process.
The key here is making sure you identify the cases where you want to end the connection and either have the server process killed or (better) return {stop, Reason, State}.
As written above, if you intend send/2 to be a single response and a clean exit (or really, that every accept cast should result in a single send/2 and then termination), then you want:
handle_cast(accept, S = #state{socket=ListenSocket}) ->
{ok, AcceptSocket} = gen_tcp:accept(ListenSocket),
kvstore_tcpsocket_sup:start_socket(),
receive
%% stuff that results in a call to send/2 in any case.
end,
{stop, normal, S}.
The case LYSE demonstrates is one where the connection is persistent and there is ongoing back-and-forth between a client and server. In the case above you are handling a single request, spawning a new listener to re-fill the listener pool, and should be exiting because you have no plan of this gen_server doing any further work.
I'm currently trying to create a simple chat server with socket.io-erlang. I just started learning Erlang so I have a few problems adapting their demo so it works with modules. Hope you can help me, here's what I have so far. It shouldn't have any features yet, this time I only want to make it work (I get a few crash reports after starting it, you can read them if you want).
App
-module(echat_app).
-behaviour(application).
-export([start/2, stop/1]).
start(_StartType, _StartArgs) ->
echat_sup:start_link().
stop(_State) ->
ok.
Supervisor
-module(echat_sup).
-behaviour(supervisor).
-export([start_link/0]).
-export([init/1]).
-define(CHILD(I, Type), {I, {I, start_link, []}, permanent, 5000, Type, [I]}).
start_link() ->
supervisor:start_link({local, ?MODULE}, ?MODULE, []).
init([]) ->
application:start(sasl),
application:start(gproc),
application:start(misultin),
application:start(socketio),
{ok, Pid} = socketio_listener:start([{http_port, 7878}, {default_http_handler,echat_http_handler}]),
EventManager = socketio_listener:event_manager(Pid),
ok = gen_event:add_handler(EventManager, echat_socketio_handler,[]),
receive _ ->
io:format("sub received something"),
{ok, {
{one_for_one, 5, 10},
[]
}}
end.
Socket.IO Event Handler
-module(echat_socketio_handler).
-behaviour(gen_event).
-include_lib("socketio/include/socketio.hrl").
-export([init/1, handle_event/2, handle_call/2, handle_info/2, terminate/2, code_change/3]).
init([]) ->
{ok, undefined}.
handle_event({client, Pid}, State) ->
io:format("Connected: ~p~n",[Pid]),
EventManager = socketio_client:event_manager(Pid),
ok = gen_event:add_handler(EventManager, ?MODULE,[]),
{ok, State};
handle_event({disconnect, Pid}, State) ->
io:format("Disconnected: ~p~n",[Pid]),
{ok, State};
handle_event({message, Client, Msg=#msg{content=Content}}, State) ->
io:format("Got a message: ~p from ~p~n",[Msg, Client]),
socketio_client:send(Client, #msg{ content = "hello!" }),
socketio_client:send(Client, #msg{ content = [{<<"echo">>, Content}], json = true}),
{ok, State};
handle_event(_E, State) ->
{ok, State}.
handle_call(_, State) ->
{reply, ok, State}.
handle_info(_, State) ->
{ok, State}.
terminate(_Reason, _State) ->
ok.
code_change(_OldVsn, State, _Extra) ->
{ok, State}.
HTTP Request Handler
-module(echat_http_handler).
-export([handle_request/3]).
handle_request(_Method, _Path, Req) ->
Req:respond(200).
just a few things, no a specific answer to your question.
First, in general you start the dependencies before starting your app, rather than on the init of some supervisor.
Regarding the errors:
{error,{{noproc,{gen_server,call,
[socketio_listener_sup_sup,
{start_child,[[{http_port,7878},
{default_http_handler,echat_http_handler}]]},
infinity]}},
{echat_app,start,[normal,[]]}}}
This is the first one, it means that the code tried to call a gen_server named 'socketio_listener_sup_sup' , but that process did not exist. Given the name of it, I guess that is something that should be started by the socket.io-erlang application itself, so maybe it is not starting correctly for some reason. You can check that easily by checking the results:
ok = application:start(sasl),
ok = application:start(gproc),
ok = application:start(misultin),
ok = application:start(socketio),
Is there some Erlang http proxy?
Which is the best Erlang http client?
httpc seems lake of document, for example, How to send the cookie header in httpc?
Any example of Erlang http proxy, or proxy in mochiweb?
I once built a proxy that did something like upside-down-ternet with a combination of webmachine and imagemagick. It was based on this resource example.
I concur with Alexander that lhttpc and ibrowse are the best http clients. I've used both in production with great success.
I can not recall name of any relatively famous http proxy written in erlang. Quick google search reveals this: http://www.duomark.com/erlang/tutorials/proxy.html
As for http client, I would recommend to try lhttpc or ibrowse
If an http client does not have a built-in method to specify a cookie in a request, usually you can construct an http Cookie header and pass it to the http requests handler function as a part of the request http headers.
An HTTP proxy implemented in Erlang is now available on GitHub: https://github.com/Wavenet/http_proxy
I understand this question has been answered but i`m going to leave this here, just in case someone is looking for something simple, straight forward and readable.
-module(proxy).
-define(HTTP_PORT, 80).
-define(DEFAULT_PROXY_PORT, 8000).
-export([start/0,start/1,worker/1]).
start()->
start (?DEFAULT_PROXY_PORT).
start(Port)->
{ok, Listen} = gen_tcp:listen (Port, [binary,
{packet, 0},
{reuseaddr, true},
{active, false},
{delay_send, false},
{nodelay, true}]),
server_loop (Listen).
server_loop (Listen)->
{ok, Socket} = gen_tcp:accept (Listen),
spawn (?MODULE, worker, [Socket]),
server_loop (Listen).
worker (Socket)->
{ok, Request} = gen_tcp:recv (Socket, 0),
ListRequest = binary_to_list (Request),
io:format ("~p ~n", [ListRequest]),
[Head, URL | RequestTail] = string:tokens (ListRequest, " "),
["http:", Host | URLTail] = string:tokens (URL, "/"),
Document = "/" ++ string:join (URLTail, "/"),
NewRequest = string:join ([Head, Document | RequestTail], " "),
io:format ("~p ~p ~p~n", [self(), Host, Document]),
{ok, SecondSocket} = gen_tcp:connect (Host, ?HTTP_PORT, [binary,
{packet, 0},
{active, false},
{delay_send, false},
{nodelay, true}]),
ok = gen_tcp:send (SecondSocket, NewRequest),
io:format ("~p waiting...~n", [self()]),
Response = read_tcp (SecondSocket),
io:format ("~p done!~n", [self()]),
ok = gen_tcp:send (Socket, Response),
gen_tcp:close (SecondSocket),
gen_tcp:close (Socket).
read_tcp (Socket)->
read_tcp (Socket, []).
read_tcp (Socket, SoFar)->
case gen_tcp:recv (Socket, 0, 500) of
{ok, Response} ->
read_tcp (Socket, [Response | SoFar]);
{error, timeout} ->
lists:reverse (SoFar);
{error, closed} ->
lists:reverse (SoFar)
end.