The I/O-protocol in Erlang specifies a way for a client to communicate with an I/O server and vice versa. The I/O server is a process that handles the requests and performs the requested task on e.g. an IO device. The client is any Erlang process wishing to read or write data from/to the IO device.
The common I/O-protocol has been present in OTP since the beginning, but has been fairly undocumented and has also somewhat evolved over the years. In an addendum to Robert Virdings rationale the original I/O-protocol is described. This document describes the current I/O-protocol.
The original I/O-protocol was simple and flexible. Demands for spacial and execution time efficiency has triggered extensions to the protocol over the years, making the protocol larger and somewhat less easy to implement than the original. It can certainly be argued that the current protocol is too complex, but this text describes how it looks today, not how it should have looked.
The basic ideas from the original protocol still hold. The I/O server and client communicate with one single, rather simplistic protocol and no server state is ever present in the client. Any I/O server can be used together with any client code and client code need not be aware of the actual IO device the I/O server communicates with.
As described in Robert's paper, I/O servers and clients communicate using
{io_request, From, ReplyAs, Request}
{io_reply, ReplyAs, Reply}
The client sends an
When an I/O server receives an
To output characters on an IO device, the following
{put_chars, Encoding, Characters}
{put_chars, Encoding, Module, Function, Args}
The I/O server replies to the client with an
ok
{error, Error}
For backward compatibility the following
{put_chars, Characters}
{put_chars, Module, Function, Args}
These should behave as
To read characters from an IO device, the following
{get_until, Encoding, Prompt, Module, Function, ExtraArgs}
{done, Result, RestChars}
{more, Continuation}
The
The function will be called with the data the I/O server finds on
its IO device, returning
-module(demo).
-export([until_newline/3, get_line/1]).
until_newline(_ThisFar,eof,_MyStopCharacter) ->
{done,eof,[]};
until_newline(ThisFar,CharList,MyStopCharacter) ->
case
lists:splitwith(fun(X) -> X =/= MyStopCharacter end, CharList)
of
{L,[]} ->
{more,ThisFar++L};
{L2,[MyStopCharacter|Rest]} ->
{done,ThisFar++L2++[MyStopCharacter],Rest}
end.
get_line(IoServer) ->
IoServer ! {io_request,
self(),
IoServer,
{get_until, unicode, '', ?MODULE, until_newline, [$\n]}},
receive
{io_reply, IoServer, Data} ->
Data
end.
Note especially that the last element in the
A fixed number of characters is requested using this
{get_chars, Encoding, Prompt, N}
A single line (like in the example above) is requested with this
{get_line, Encoding, Prompt}
Obviously, the
The I/O server replies to the client with an
Data
eof
{error, Error}
For backward compatibility the following
{get_until, Prompt, Module, Function, ExtraArgs}
{get_chars, Prompt, N}
{get_line, Prompt}
These should behave as
Demands for efficiency when reading data from an I/O server has not
only lead to the addition of the
Note that i.e. the
An I/O-server in binary mode will affect the data sent to the client, so that it has to be able to handle binary data. For convenience, it is possible to set and retrieve the modes of an I/O server using the following I/O requests:
{setopts, Opts}
As an example, the I/O server for the interactive shell (in
{binary, boolean()} (or binary/list)
{echo, boolean()}
{expand_fun, fun()}
{encoding, unicode/latin1} (or unicode/latin1)
- of which the
The I/O server should send one of the following as
ok
{error, Error}
An error (preferably
To retrieve options, this request is used:
getopts
The
The I/O server replies:
OptList
{error, Error}
The
{requests, Requests}
The I/O server can for a list of requests send any of the valid results in the reply:
ok
{ok, Data}
{ok, Options}
{error, Error}
- depending on the actual requests in the list.
The following I/O request is optional to implement and a client should be prepared for an error return:
{get_geometry, Geometry}
The I/O server should send the
{ok, N}
{error, Error}
If an I/O server encounters a request it does not recognize (i.e. the
{error, request}
This makes it possible to extend the protocol with optional requests and for the clients to be somewhat backwards compatible.
An I/O server is any process capable of handling the I/O protocol. There is no generic I/O server behavior, but could well be. The framework is simple enough, a process handling incoming requests, usually both I/O-requests and other IO device-specific requests (for i.e. positioning, closing etc.).
Our example I/O server stores characters in an ETS table, making up a fairly crude ram-file (it is probably not useful, but working).
The module begins with the usual directives, a function to start the I/O server and a main loop handling the requests:
-module(ets_io_server).
-export([start_link/0, init/0, loop/1, until_newline/3, until_enough/3]).
-define(CHARS_PER_REC, 10).
-record(state, {
table,
position, % absolute
mode % binary | list
}).
start_link() ->
spawn_link(?MODULE,init,[]).
init() ->
Table = ets:new(noname,[ordered_set]),
?MODULE:loop(#state{table = Table, position = 0, mode=list}).
loop(State) ->
receive
{io_request, From, ReplyAs, Request} ->
case request(Request,State) of
{Tag, Reply, NewState} when Tag =:= ok; Tag =:= error ->
reply(From, ReplyAs, Reply),
?MODULE:loop(NewState);
{stop, Reply, _NewState} ->
reply(From, ReplyAs, Reply),
exit(Reply)
end;
%% Private message
{From, rewind} ->
From ! {self(), ok},
?MODULE:loop(State#state{position = 0});
_Unknown ->
?MODULE:loop(State)
end.
The main loop receives messages from the client (which might be using
the
The "private" message
Let us look at the reply function first...
reply(From, ReplyAs, Reply) ->
From ! {io_reply, ReplyAs, Reply}.
Simple enough, it sends the
Now look at the different requests we need to handle. First the requests for writing characters:
request({put_chars, Encoding, Chars}, State) ->
put_chars(unicode:characters_to_list(Chars,Encoding),State);
request({put_chars, Encoding, Module, Function, Args}, State) ->
try
request({put_chars, Encoding, apply(Module, Function, Args)}, State)
catch
_:_ ->
{error, {error,Function}, State}
end;
The
When
Let us handle the requests for retrieving data too:
request({get_until, Encoding, _Prompt, M, F, As}, State) ->
get_until(Encoding, M, F, As, State);
request({get_chars, Encoding, _Prompt, N}, State) ->
%% To simplify the code, get_chars is implemented using get_until
get_until(Encoding, ?MODULE, until_enough, [N], State);
request({get_line, Encoding, _Prompt}, State) ->
%% To simplify the code, get_line is implemented using get_until
get_until(Encoding, ?MODULE, until_newline, [$\n], State);
Here we have cheated a little by more or less only implementing
request({get_geometry,_}, State) ->
{error, {error,enotsup}, State};
request({setopts, Opts}, State) ->
setopts(Opts, State);
request(getopts, State) ->
getopts(State);
request({requests, Reqs}, State) ->
multi_request(Reqs, {ok, ok, State});
The
The multi-request tag (
What is left is to handle backward compatibility and the
request({put_chars,Chars}, State) ->
request({put_chars,latin1,Chars}, State);
request({put_chars,M,F,As}, State) ->
request({put_chars,latin1,M,F,As}, State);
request({get_chars,Prompt,N}, State) ->
request({get_chars,latin1,Prompt,N}, State);
request({get_line,Prompt}, State) ->
request({get_line,latin1,Prompt}, State);
request({get_until, Prompt,M,F,As}, State) ->
request({get_until,latin1,Prompt,M,F,As}, State);
OK, what is left now is to return
request(_Other, State) ->
{error, {error, request}, State}.
Let us move further and actually handle the different requests, first the fairly generic multi-request type:
multi_request([R|Rs], {ok, _Res, State}) ->
multi_request(Rs, request(R, State));
multi_request([_|_], Error) ->
Error;
multi_request([], Result) ->
Result.
We loop through the requests one at the time, stopping when we either
encounter an error or the list is exhausted. The last return value is
sent back to the client (it is first returned to the main loop and then
sent back by the function
The
setopts(Opts0,State) ->
Opts = proplists:unfold(
proplists:substitute_negations(
[{list,binary}],
Opts0)),
case check_valid_opts(Opts) of
true ->
case proplists:get_value(binary, Opts) of
true ->
{ok,ok,State#state{mode=binary}};
false ->
{ok,ok,State#state{mode=binary}};
_ ->
{ok,ok,State}
end;
false ->
{error,{error,enotsup},State}
end.
check_valid_opts([]) ->
true;
check_valid_opts([{binary,Bool}|T]) when is_boolean(Bool) ->
check_valid_opts(T);
check_valid_opts(_) ->
false.
getopts(#state{mode=M} = S) ->
{ok,[{binary, case M of
binary ->
true;
_ ->
false
end}],S}.
As a convention, all I/O servers handle both
The
So far our I/O server has been fairly generic (except for the
To make the example runnable, we now start implementing the actual
reading and writing of the data to/from the ETS table. First the
put_chars(Chars, #state{table = T, position = P} = State) ->
R = P div ?CHARS_PER_REC,
C = P rem ?CHARS_PER_REC,
[ apply_update(T,U) || U <- split_data(Chars, R, C) ],
{ok, ok, State#state{position = (P + length(Chars))}}.
We already have the data as (Unicode) lists and therefore just split
the list in runs of a predefined size and put each run in the
table at the current position (and forward). The functions
Now we want to read data from the table. The
get_until(Encoding, Mod, Func, As,
#state{position = P, mode = M, table = T} = State) ->
case get_loop(Mod,Func,As,T,P,[]) of
{done,Data,_,NewP} when is_binary(Data); is_list(Data) ->
if
M =:= binary ->
{ok,
unicode:characters_to_binary(Data, unicode, Encoding),
State#state{position = NewP}};
true ->
case check(Encoding,
unicode:characters_to_list(Data, unicode))
of
{error, _} = E ->
{error, E, State};
List ->
{ok, List,
State#state{position = NewP}}
end
end;
{done,Data,_,NewP} ->
{ok, Data, State#state{position = NewP}};
Error ->
{error, Error, State}
end.
get_loop(M,F,A,T,P,C) ->
{NewP,L} = get(P,T),
case catch apply(M,F,[C,L|A]) of
{done, List, Rest} ->
{done, List, [], NewP - length(Rest)};
{more, NewC} ->
get_loop(M,F,A,T,NewP,NewC);
_ ->
{error,F}
end.
Here we also handle the mode (
Now we are more or less done. We implement the utility functions below to actually manipulate the table:
check(unicode, List) ->
List;
check(latin1, List) ->
try
[ throw(not_unicode) || X <- List,
X > 255 ],
List
catch
throw:_ ->
{error,{cannot_convert, unicode, latin1}}
end.
The function check takes care of providing an error tuple if Unicode codepoints above 255 is to be returned if the client requested latin1.
The two functions
until_newline([],eof,_MyStopCharacter) ->
{done,eof,[]};
until_newline(ThisFar,eof,_MyStopCharacter) ->
{done,ThisFar,[]};
until_newline(ThisFar,CharList,MyStopCharacter) ->
case
lists:splitwith(fun(X) -> X =/= MyStopCharacter end, CharList)
of
{L,[]} ->
{more,ThisFar++L};
{L2,[MyStopCharacter|Rest]} ->
{done,ThisFar++L2++[MyStopCharacter],Rest}
end.
until_enough([],eof,_N) ->
{done,eof,[]};
until_enough(ThisFar,eof,_N) ->
{done,ThisFar,[]};
until_enough(ThisFar,CharList,N)
when length(ThisFar) + length(CharList) >= N ->
{Res,Rest} = my_split(N,ThisFar ++ CharList, []),
{done,Res,Rest};
until_enough(ThisFar,CharList,_N) ->
{more,ThisFar++CharList}.
As can be seen, the functions above are just the type of functions
that should be provided in
Now we only need to read and write the table in an appropriate way to complete the I/O server:
get(P,Tab) ->
R = P div ?CHARS_PER_REC,
C = P rem ?CHARS_PER_REC,
case ets:lookup(Tab,R) of
[] ->
{P,eof};
[{R,List}] ->
case my_split(C,List,[]) of
{_,[]} ->
{P+length(List),eof};
{_,Data} ->
{P+length(Data),Data}
end
end.
my_split(0,Left,Acc) ->
{lists:reverse(Acc),Left};
my_split(_,[],Acc) ->
{lists:reverse(Acc),[]};
my_split(N,[H|T],Acc) ->
my_split(N-1,T,[H|Acc]).
split_data([],_,_) ->
[];
split_data(Chars, Row, Col) ->
{This,Left} = my_split(?CHARS_PER_REC - Col, Chars, []),
[ {Row, Col, This} | split_data(Left, Row + 1, 0) ].
apply_update(Table, {Row, Col, List}) ->
case ets:lookup(Table,Row) of
[] ->
ets:insert(Table,{Row, lists:duplicate(Col,0) ++ List});
[{Row, OldData}] ->
{Part1,_} = my_split(Col,OldData,[]),
{_,Part2} = my_split(Col+length(List),OldData,[]),
ets:insert(Table,{Row, Part1 ++ List ++ Part2})
end.
The table is read or written in chunks of
This concludes the example. It is fully runnable and you can read or
write to the I/O server by using i.e. the