[m-rev.] diff: Update networking library
Paul Bone
paul at bone.id.au
Thu Jan 8 12:48:06 AEDT 2015
Branches: master
---
Update networking library
extras/net/sockets.m:
Add read and write predicates.
extras/net/streams.m:
New file containing implementations of stream typeclasses.
extras/net/net.m:
Include the new streams module.
extras/net/echo.m:
Use the new streams typeclass instances to complete the implementation
of the echo server. It works one byte at a time (making it slow) and
will not handle simultanious connections.
extras/net/Makefile:
Add clean target
---
extras/net/Makefile | 5 ++
extras/net/echo.m | 31 +++++++++--
extras/net/net.m | 1 +
extras/net/sockets.m | 92 +++++++++++++++++++++++++++++++
extras/net/streams.m | 150 +++++++++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 274 insertions(+), 5 deletions(-)
create mode 100644 extras/net/streams.m
diff --git a/extras/net/Makefile b/extras/net/Makefile
index f9d3f67..b0e5878 100644
--- a/extras/net/Makefile
+++ b/extras/net/Makefile
@@ -22,3 +22,8 @@ echo : $(MERCURY_FILES)
tags : $(MERCURY_FILES)
$(MTAGS) $(MERCURY_FILES)
+
+.PHONY : clean
+clean :
+ rm -rf Mercury *.mh *.err echo libnet.so libnet.a net.init tags
+
diff --git a/extras/net/echo.m b/extras/net/echo.m
index e1a5866..bd1b9d1 100644
--- a/extras/net/echo.m
+++ b/extras/net/echo.m
@@ -6,7 +6,7 @@
% Public License - see the file COPYING.LIB
%-----------------------------------------------------------------------------%
%
-% Module: echo
+% Module: echo
% Main Author: Paul Bone <paul at bone.id.au>
%
% A simple echo server.
@@ -31,10 +31,12 @@
:- import_module list.
:- import_module maybe.
:- import_module require.
+:- import_module stream.
:- import_module string.
:- import_module net.
:- import_module net.sockets.
+:- import_module net.streams.
:- import_module net.types.
main(!IO) :-
@@ -75,12 +77,13 @@ run(Socket, !IO) :-
(
Result = ok(accept_result(NewSocket, Address)),
( ipv4_sockaddr(InAddr, Port, Address) ->
- io.format("Connection from %s port %d\n",
- [s(to_string(InAddr)), i(Port)], !IO)
+ AddrStr = format("%s:%d", [s(to_string(InAddr)), i(Port)])
;
- io.format("Connection from unknown peer family: %s\n",
- [s(string(family(Address)))], !IO)
+ AddrStr = format("Unknown peer (family %s)",
+ [s(string(family(Address)))])
),
+ io.format("Connection from %s\n", [s(AddrStr)], !IO),
+ run_connection(stream(NewSocket), AddrStr, !IO),
close(NewSocket, CloseRes, !IO),
(
CloseRes = ok
@@ -94,3 +97,21 @@ run(Socket, !IO) :-
),
run(Socket, !IO).
+:- pred run_connection(socket_stream::in, string::in, io::di, io::uo) is det.
+
+run_connection(Stream, AddrStr, !IO) :-
+ get(Stream, MaybeByte, !IO),
+ (
+ MaybeByte = ok(Byte `with_type` streams.byte),
+ put(Stream, Byte, !IO),
+ run_connection(Stream, AddrStr, !IO)
+ ;
+ MaybeByte = eof,
+ write_string(io.stderr_stream, "EOF", !IO)
+ ;
+ MaybeByte = error(Error),
+ io.format(io.stderr_stream, "%s; %s\n",
+ [s(AddrStr), s(error_message(Error))], !IO)
+ ).
+
+
diff --git a/extras/net/net.m b/extras/net/net.m
index 0392876..5bc7806 100644
--- a/extras/net/net.m
+++ b/extras/net/net.m
@@ -9,6 +9,7 @@
:- include_module netdb.
:- include_module sockets.
+:- include_module streams.
:- include_module tcp.
:- include_module types.
diff --git a/extras/net/sockets.m b/extras/net/sockets.m
index 490b51a..c7a654c 100644
--- a/extras/net/sockets.m
+++ b/extras/net/sockets.m
@@ -20,6 +20,7 @@
:- module net.sockets.
:- interface.
+:- import_module bitmap.
:- import_module io.
:- import_module maybe.
@@ -101,11 +102,32 @@
:- pred close(socket::in, maybe_error::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
+
+:- type read_result(T)
+ ---> ok(T)
+ ; eof
+ ; error(string).
+
+ % The returned buffer may be smaller than the amount of requested data
+ % if either 1) the end of file/stream was reached or 2) a smaller amount
+ % of data is available. If the OS has no data then this call will
+ % block.
+ %
+:- pred read(socket::in, int::in, sockets.read_result(bitmap)::out,
+ io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- pred write(socket::in, bitmap::in, maybe_error::out, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module bool.
+:- import_module int.
+:- import_module require.
:- import_module net.errno.
@@ -386,5 +408,75 @@ close(Socket, Result, !IO) :-
").
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+read(Socket, Len0, Result, !IO) :-
+ read(Socket, Len0, Bitmap0, BytesRead, Errno, !IO),
+ ( BytesRead > 0 ->
+ Bitmap = shrink_without_copying(Bitmap0, BytesRead*8),
+ Result = ok(Bitmap)
+ ; BytesRead = 0 ->
+ Result = eof
+ ;
+ Result = error(strerror(Errno))
+ ).
+
+:- pred read(socket::in, int::in, bitmap::bitmap_uo, int::out, errno::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ read(Socket::in, Len::in, Bitmap::bitmap_uo, BytesRead::out, Errno::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+ "
+ MR_allocate_bitmap_msg(Bitmap, Len*8, MR_ALLOC_ID);
+ BytesRead = read(Socket, Bitmap->elements, Len);
+ if (BytesRead == -1) {
+ Errno = error();
+ }
+ ").
+
+%-----------------------------------------------------------------------------%
+
+write(Socket, Bitmap, Result, !IO) :-
+ write(Socket, Bitmap, 0, Result, !IO).
+
+:- pred write(socket::in, bitmap::in, int::in, maybe_error::out,
+ io::di, io::uo) is det.
+
+write(Socket, Bitmap, Offset, Result, !IO) :-
+ ( LenPrime = num_bytes(Bitmap) - Offset ->
+ Len = LenPrime
+ ;
+ unexpected($file, $pred,
+ "Bitmap must have an integral number of bytes")
+ ),
+ write_c(Socket, Bitmap, Offset, Len, BytesWritten, Errno, !IO),
+ ( BytesWritten = Len ->
+ Result = ok
+ ; BytesWritten = -1 ->
+ Result = error(strerror(Errno))
+ ; BytesWritten < Len ->
+ % Not all the bytes were written. Try again.
+ write(Socket, Bitmap, Offset + BytesWritten, Result, !IO)
+ ;
+ unexpected($file, $pred, "BytesWritten > Len")
+ ).
+
+:- pred write_c(socket::in, bitmap::in, int::in, int::in, int::out,
+ errno::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ write_c(Socket::in, Bitmap::in, Offset::in, Len::in,
+ BytesWritten::out, Errno::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+ "
+ BytesWritten = write(Socket, &Bitmap->elements[Offset], Len);
+ if (BytesWritten == -1) {
+ Errno = error();
+ }
+ ").
+
+%-----------------------------------------------------------------------------%
:- end_module sockets.
%-----------------------------------------------------------------------------%
diff --git a/extras/net/streams.m b/extras/net/streams.m
new file mode 100644
index 0000000..164d31d
--- /dev/null
+++ b/extras/net/streams.m
@@ -0,0 +1,150 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2014 The Mercury Team.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB
+%-----------------------------------------------------------------------------%
+%
+% Module: net.streams.
+% Main Author: Paul Bone
+% Stability: low
+%
+% Provide a streams interface for sockets.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- module net.streams.
+:- interface.
+
+:- import_module int.
+:- import_module io.
+:- import_module stream.
+
+:- import_module net.sockets.
+
+%-----------------------------------------------------------------------------%
+
+:- type socket_stream.
+
+:- func stream(socket) = socket_stream.
+
+:- type byte
+ ---> byte(int).
+
+:- type error.
+
+:- instance error(streams.error).
+
+:- instance stream(socket_stream, io).
+
+%-----------------------------------------------------------------------------%
+
+:- instance input(socket_stream, io).
+
+ % XXX: This does not buffer reads, it is slow.
+ %
+:- instance reader(socket_stream, streams.byte, io, streams.error).
+
+%-----------------------------------------------------------------------------%
+
+:- instance output(socket_stream, io).
+
+ % XXX: This does not buffer writes, it is slow.
+ %
+:- instance writer(socket_stream, streams.byte, io).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module exception.
+:- import_module bitmap.
+:- import_module maybe.
+:- import_module require.
+
+:- type socket_stream
+ ---> socket_stream(socket).
+
+:- type error
+ ---> error(string).
+
+stream(Socket) = socket_stream(Socket).
+
+%-----------------------------------------------------------------------------%
+
+:- instance error(streams.error) where [
+ error_message(error(Str)) = Str
+ ].
+
+:- instance stream(socket_stream, io) where [
+ pred(name/4) is stream_name
+].
+
+:- pred stream_name(socket_stream::in, name::out, io::di, io::uo) is det.
+
+stream_name(socket_stream(_Socket), Name, !IO) :-
+ Name = "a socket".
+
+%-----------------------------------------------------------------------------%
+
+:- instance input(socket_stream, io) where [].
+
+:- instance reader(socket_stream, streams.byte, io, streams.error) where [
+ pred(get/4) is get_byte
+ ].
+
+:- pred get_byte(socket_stream::in, result(streams.byte, streams.error)::out,
+ io::di, io::uo) is det.
+
+get_byte(socket_stream(Socket), Result, !IO) :-
+ read(Socket, 1, ReadResult, !IO),
+ (
+ ReadResult = ok(Bitmap),
+ ( num_bytes(Bitmap) = 1 ->
+ Byte = Bitmap ^ byte(0),
+ Result = ok(byte(Byte))
+ ; num_bytes(Bitmap) = 0 ->
+ Result = eof
+ ;
+ unexpected($file, $pred,
+ "Read returned unexpected number of bytes")
+ )
+ ;
+ ReadResult = eof,
+ Result = eof
+ ;
+ ReadResult = error(String),
+ Result = error(error(String))
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- instance output(socket_stream, io) where [
+ pred(flush/3) is flush_noop
+ ].
+
+:- pred flush_noop(socket_stream::in, io::di, io::uo) is det.
+
+flush_noop(_, !IO).
+
+ % XXX: This does not buffer writes, it is slow.
+ %
+:- instance writer(socket_stream, streams.byte, io) where [
+ pred(put/4) is put_byte
+ ].
+
+:- pred put_byte(socket_stream::in, streams.byte::in, io::di, io::uo)
+ is det.
+
+put_byte(socket_stream(Socket), byte(Byte), !IO) :-
+ Bitmap = init(bits_per_byte) ^ byte(0) := Byte,
+ write(Socket, Bitmap, Result, !IO),
+ (
+ Result = ok
+ ;
+ Result = error(Error),
+ throw(streams.error(Error))
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--
2.1.3
More information about the reviews
mailing list