[m-rev.] diff: clean up sockets module

Julien Fischer juliensf at csse.unimelb.edu.au
Fri Feb 23 16:46:10 AEDT 2007


Estimated hours taken: 0.2
Branches: main

Fix some dodgy usage of the foreign language interface with the sockets
library.

Cleanups and formatting fixes for the same.

extras/net/sockets.m:
 	Convert this module to 4-space indentation.

 	s/__/./

 	Use the new foreign language interface exclusively.

 	Change the linkage of the global variable socket_errno to extern
 	so that is visible in cases foreign_procs in this module are
 	inlined in other modules.

 	s/MR_TRUE/MR_YES/ and s/MR_FALSE/MR_NO/ in foreign code where
 	the (Mercury) types of the values were bool.bool/0.

 	Other minor formatting fixes.

Julien.

Index: sockets.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/net/sockets.m,v
retrieving revision 1.1
diff -u -r1.1 sockets.m
--- sockets.m	16 Nov 2006 04:01:49 -0000	1.1
+++ sockets.m	23 Feb 2007 05:40:38 -0000
@@ -1,13 +1,15 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
  %---------------------------------------------------------------------------%
  % Copyright (C) 2000 The University of Melbourne.
  % This file may only be copied under the terms of the GNU Library General
  % Public License - see the file COPYING.LIB
  %-----------------------------------------------------------------------------%
  %
-% Module:	sockets
-% Main Author:	pro at missioncriticalit.com
+% Module: sockets
+% Main Author:  pro at missioncriticalit.com
  %               (based on code written by pma at missioncriticalit.com)
-% Stability:	low
+% Stability:    low
  %
  % Provide a low-level interface to sockets.
  % The more declarative interface is provided by the module tcp.
@@ -21,43 +23,54 @@
  :- import_module bool.
  :- import_module io.

-:- type sockets__res(Type)
-	--->	ok(Type)
-	;	error(string).
-
-:- pred sockets__gethostbyname(string::in, string::out, io::di, io::uo)
- 	is det.
-:- pred sockets__getservbyname(string::in, string::in, int::out,
- 	io::di, io::uo) is det.
-
-:- pred sockets__socket(int::in, int::in, int::in, int::out, bool::out,
-	io::di, io::uo) is det.
-:- pred sockets__port_address(string::in, int::in, c_pointer::out,
- 	bool::out, io::di, io::uo) is det.
-:- pred sockets__service_address(string::in, string::in, c_pointer::out, 
- 	bool::out, io::di, io::uo) is det.
-:- pred sockets__connect(int::in, c_pointer::in, int::in, bool::out,
-	io::di, io::uo) is det.
-:- pred sockets__bind(int::in, c_pointer::in, int::in, bool::out,
-	io::di, io::uo) is det.
-:- pred sockets__listen(int::in, int::in, bool::out, io::di, io::uo) is det.
-:- pred sockets__accept(int::in, c_pointer::in, int::out, bool::out,
- 	io::di, io::uo) is det.
-:- pred sockets__close(int::in, io::di, io::uo) is det.
+%-----------------------------------------------------------------------------%
+
+:- type sockets.res(Type)
+    --->    ok(Type)
+    ;       error(string).
+
+:- pred sockets.gethostbyname(string::in, string::out,
+    io::di, io::uo) is det.
+
+:- pred sockets.getservbyname(string::in, string::in, int::out,
+    io::di, io::uo) is det.
+
+:- pred sockets.socket(int::in, int::in, int::in, int::out, bool::out,
+    io::di, io::uo) is det.
+
+:- pred sockets.port_address(string::in, int::in, c_pointer::out, bool::out,
+    io::di, io::uo) is det.
+
+:- pred sockets.service_address(string::in, string::in, c_pointer::out, 
+    bool::out, io::di, io::uo) is det.
+
+:- pred sockets.connect(int::in, c_pointer::in, int::in, bool::out,
+    io::di, io::uo) is det.
+
+:- pred sockets.bind(int::in, c_pointer::in, int::in, bool::out,
+    io::di, io::uo) is det.

-	% Why did the socket operation fail?
-:- pred sockets__error_message(string::out, io::di, io::uo) is det.
+:- pred sockets.listen(int::in, int::in, bool::out, io::di, io::uo) is det.
+
+:- pred sockets.accept(int::in, c_pointer::in, int::out, bool::out,
+    io::di, io::uo) is det.
+
+:- pred sockets.close(int::in, io::di, io::uo) is det.
+
+    % Why did the socket operation fail?
+    %
+:- pred sockets.error_message(string::out, io::di, io::uo) is det.

  %-----------------------------------------------------------------------------%
  %-----------------------------------------------------------------------------%

  :- implementation.

-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
  #ifdef MR_WIN32
    #include <winsock.h>

-  #define  error()		WSAGetLastError
+  #define  error()      WSAGetLastError
  #else
    #include <errno.h>
    #include <netdb.h>
@@ -67,227 +80,234 @@
    #include <sys/types.h>
    #include <sys/socket.h>

-  #define  error()		errno
+  #define  error()      errno

-  #define  INVALID_SOCKET	-1
+  #define  INVALID_SOCKET   -1
  #endif
    #include \"mercury_string.h\"
+
+  extern int socket_errno;
+
  ").

  :- pragma foreign_decl("C", "
-	/* Save the errno into this variable if a function fails */
-static int socket_errno;
+ 
+    /*
+    ** Save the errno into this variable if a function fails.
+    */
+
+    int socket_errno;
  ").

+%-----------------------------------------------------------------------------%
+
  :- initialise sockets.init/2.

-:- pred sockets__init(io::di, io::uo) is det.
+:- pred sockets.init(io::di, io::uo) is det.

  :- pragma foreign_proc(c,
-	sockets__init(_IO0::di, _IO::uo),
-	[will_not_call_mercury, thread_safe, promise_pure, tabled_for_io],
-"{
+    sockets.init(_IO0::di, _IO::uo),
+    [will_not_call_mercury, thread_safe, promise_pure, tabled_for_io],
+"
  #ifdef MR_WIN32
-	WORD 	wVersionRequested;
-	WSADATA wsaData;
-	int	err; 
-
-	if (!initialiased) {
-		wVersionRequested = MAKEWORD( 2, 2 ); 
-		err = WSAStartup(wVersionRequested, &wsaData);
-
-		if ( err != 0 ) {
-			MR_fatal_error(""Unable to find a ""
-					""usable winsock.dll\\n"");
-		}
-
-		if ( LOBYTE( wsaData.wVersion ) != 2 ||
-				HIBYTE( wsaData.wVersion ) != 2 ) {
-			WSACleanup();
-			MR_fatal_error(""Unable to find a ""
-					""usable winsock.dll\\n"");
-		}
-		initialiased = MR_TRUE;
-	}
+    WORD    wVersionRequested;
+    WSADATA wsaData;
+    int err; 
+
+    if (!initialiased) {
+        wVersionRequested = MAKEWORD( 2, 2 ); 
+        err = WSAStartup(wVersionRequested, &wsaData);
+
+        if ( err != 0 ) {
+            MR_fatal_error(""Unable to find a ""
+                    ""usable winsock.dll\\n"");
+        }
+
+        if ( LOBYTE( wsaData.wVersion ) != 2 ||
+                HIBYTE( wsaData.wVersion ) != 2 ) {
+            WSACleanup();
+            MR_fatal_error(""Unable to find a ""
+                    ""usable winsock.dll\\n"");
+        }
+        initialiased = MR_TRUE;
+    }
  #endif
-}").
+").

-	% XXX thread safe?
+    % XXX thread safe?
  :- pragma foreign_proc(c,
-	gethostbyname(Name::in, Host::out, _IO0::di, _IO::uo),
-	 [will_not_call_mercury, promise_pure, tabled_for_io],
-"{
-	struct hostent	*host;
-	host = gethostbyname(Name);
-	Host = (MR_String) host->h_name;
-}").
+    gethostbyname(Name::in, Host::out, _IO0::di, _IO::uo),
+     [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    struct hostent  *host;
+    host = gethostbyname(Name);
+    Host = (MR_String) host->h_name;
+").

-	% XXX thread safe?
+    % XXX thread safe?
  :- pragma foreign_proc(c,
-	getservbyname(Name::in, Protocol::in, Port::out, _IO0::di, _IO::uo),
-	 [will_not_call_mercury, promise_pure, tabled_for_io],
-"{
-	struct servent *service;
-	service = getservbyname(Name, Protocol);
+    getservbyname(Name::in, Protocol::in, Port::out, _IO0::di, _IO::uo),
+     [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    struct servent *service;
+    service = getservbyname(Name, Protocol);
          if (service != NULL) {
             Port = (MR_Integer) ntohs(service->s_port);
          } else {
             Port = -1;
          };

-}").
+").

-	% XXX thread safe?
+    % XXX thread safe?
  :- pragma foreign_proc(c,
-	socket(Domain::in, Type::in, Protocol::in, Socket::out, Success::out,
-		_IO0::di, _IO::uo),
-	[will_not_call_mercury, promise_pure, tabled_for_io], 
-"{
-	Socket = socket(Domain, Type, Protocol);
-	if (Socket == INVALID_SOCKET) {
-		socket_errno = error();
-		Success = MR_FALSE;
-	} else {
-		Success = MR_TRUE;
-	}
-}").
+    socket(Domain::in, Type::in, Protocol::in, Socket::out, Success::out,
+        _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io], 
+"
+    Socket = socket(Domain, Type, Protocol);
+    if (Socket == INVALID_SOCKET) {
+        socket_errno = error();
+        Success = MR_NO;
+    } else {
+        Success = MR_YES;
+    }
+").

-	% XXX thread safe?
-:- pragma foreign_proc(c,
-	port_address(Host::in, Port::in, SA::out, Success::out,
-		_IO0::di, _IO::uo),
-	[will_not_call_mercury, promise_pure, tabled_for_io],
-"{
-	struct hostent *host;
-	struct sockaddr_in *addr;
-
-	host = gethostbyname(Host);
-	if (host == NULL) {
-		socket_errno = error();
-		Success = MR_FALSE;
-	} else {
-		addr = MR_GC_NEW(struct sockaddr_in);
-
-		memcpy(&(addr->sin_addr), host->h_addr, host->h_length);
-		addr->sin_family = host->h_addrtype;
-		addr->sin_port = htons(Port);
-
-		SA = (MR_Word) addr;
-		Success = MR_TRUE;
-	}
-}").
+    % XXX thread safe?
+:- pragma foreign_proc("C",
+    port_address(Host::in, Port::in, SA::out, Success::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    struct hostent *host;
+    struct sockaddr_in *addr;
+
+    host = gethostbyname(Host);
+    if (host == NULL) {
+        socket_errno = error();
+        Success = MR_NO;
+    } else {
+        addr = MR_GC_NEW(struct sockaddr_in);
+
+        MR_memcpy(&(addr->sin_addr), host->h_addr, host->h_length);
+        addr->sin_family = host->h_addrtype;
+        addr->sin_port = htons(Port);
+
+        SA = (MR_Word) addr;
+        Success = MR_YES;
+    }
+").

-	% XXX thread safe?
-:- pragma foreign_proc(c,
-	service_address(Service::in, Host::in, SA::out, Success::out,
-		_IO0::di, _IO::uo),
-	[will_not_call_mercury, promise_pure, tabled_for_io],
-"{
-	struct hostent *host;
-	struct servent *service;
-	struct sockaddr_in *addr;
-
-	host = gethostbyname(Host);
-	if (host == NULL) {
-		socket_errno = error();
-		Success = MR_FALSE;
-	} else {
-		service = getservbyname(Service,""tcp"");
-
-		if (service == NULL) {
-			socket_errno = error();
-			Success = MR_FALSE;
-		} else {
-			addr = MR_GC_NEW(struct sockaddr_in);
-
-			memcpy(&(addr->sin_addr), host->h_addr, host->h_length);
-			addr->sin_family = host->h_addrtype;
-			addr->sin_port = service->s_port;
-
-			SA = (MR_Word) addr;
-			Success = MR_TRUE;
-		}
-	}
-}").
+    % XXX thread safe?
+:- pragma foreign_proc("C",
+    service_address(Service::in, Host::in, SA::out, Success::out,
+        _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    struct hostent *host;
+    struct servent *service;
+    struct sockaddr_in *addr;
+
+    host = gethostbyname(Host);
+    if (host == NULL) {
+        socket_errno = error();
+        Success = MR_NO;
+    } else {
+        service = getservbyname(Service,""tcp"");
+
+        if (service == NULL) {
+            socket_errno = error();
+            Success = MR_NO;
+        } else {
+            addr = MR_GC_NEW(struct sockaddr_in);

-	% XXX thread safe?
-:- pragma foreign_proc(c,
-	connect(Fd::in, Addr::in, AddrLen::in, Success::out,
-		_IO0::di, _IO::uo), 
-	[will_not_call_mercury, promise_pure, tabled_for_io],
-"{
-	struct sockaddr *addr = (struct sockaddr *) Addr;
-	if (connect(Fd, addr, AddrLen) == INVALID_SOCKET) {
-		socket_errno = error();
-		Success = MR_FALSE;
-	} else {
-		Success = MR_TRUE;
-	}
-}").
+            memcpy(&(addr->sin_addr), host->h_addr, host->h_length);
+            addr->sin_family = host->h_addrtype;
+            addr->sin_port = service->s_port;
+
+            SA = (MR_Word) addr;
+            Success = MR_YES;
+        }
+    }
+").

-	% XXX thread safe?
-:- pragma foreign_proc(c,
-	bind(Fd::in, Addr::in, AddrLen::in, Success::out, _IO0::di, _IO::uo), 
-	[will_not_call_mercury, promise_pure, tabled_for_io],
-"{
-	struct sockaddr *addr = (struct sockaddr *) Addr;
-	if (bind(Fd, addr, AddrLen) == INVALID_SOCKET) {
-		socket_errno = error();
-		Success = MR_FALSE;
-	} else {
-		Success = MR_TRUE;
-	}
-}").
+    % XXX thread safe?
+:- pragma foreign_proc("C",
+    connect(Fd::in, Addr::in, AddrLen::in, Success::out, _IO0::di, _IO::uo), 
+    [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    struct sockaddr *addr = (struct sockaddr *) Addr;
+    if (connect(Fd, addr, AddrLen) == INVALID_SOCKET) {
+        socket_errno = error();
+        Success = MR_NO;
+    } else {
+        Success = MR_YES;
+    }
+").

-	% XXX thread safe?
-:- pragma foreign_proc(c,
-	listen(Fd::in, BackLog::in, Success::out, _IO0::di, _IO::uo), 
-	[will_not_call_mercury, promise_pure, tabled_for_io],
-"{
-	if (listen(Fd, BackLog) == INVALID_SOCKET) {
-		socket_errno = error();
-		Success = MR_FALSE;
-	} else {
-		Success = MR_TRUE;
-	}
-}").
+    % XXX thread safe?
+:- pragma foreign_proc("C",
+    bind(Fd::in, Addr::in, AddrLen::in, Success::out, _IO0::di, _IO::uo), 
+    [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    struct sockaddr *addr = (struct sockaddr *) Addr;
+    if (bind(Fd, addr, AddrLen) == INVALID_SOCKET) {
+        socket_errno = error();
+        Success = MR_NO;
+    } else {
+        Success = MR_YES;
+    }
+").

-	% This code can block, so we make it thread_safe
-	% so as to avoid other code blocking on the global mutex.
-:- pragma foreign_proc(c,
-	accept(Fd::in, Addr::in, NewSocket::out, Success::out,
-		_IO0::di, _IO::uo), 
-	[thread_safe, will_not_call_mercury, promise_pure, tabled_for_io],
-"{
-	struct sockaddr *addr = (struct sockaddr *) Addr;
-	NewSocket = accept(Fd, addr, NULL);
-	if (NewSocket == INVALID_SOCKET) {
-		socket_errno = error();
-		Success = MR_FALSE;
-	} else {
-		Success = MR_TRUE;
-	}
-}").
+    % XXX thread safe?
+:- pragma foreign_proc("C",
+    listen(Fd::in, BackLog::in, Success::out, _IO0::di, _IO::uo), 
+    [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    if (listen(Fd, BackLog) == INVALID_SOCKET) {
+        socket_errno = error();
+        Success = MR_NO;
+    } else {
+        Success = MR_YES;
+    }
+").

-	% XXX thread safe?
-:- pragma foreign_proc(c,
-	sockets__close(Fd::in, _IO0::di, _IO::uo),
-	[will_not_call_mercury, promise_pure, tabled_for_io],
-"{
-	struct linger sockets_linger = { MR_TRUE, 2 };
-	setsockopt(Fd, SOL_SOCKET, SO_LINGER,
-			&sockets_linger, sizeof(sockets_linger));
-	shutdown(Fd, 2);
-}").
+    % This code can block, so we make it thread_safe
+    % so as to avoid other code blocking on the global mutex.
+:- pragma foreign_proc("C",
+    accept(Fd::in, Addr::in, NewSocket::out, Success::out,
+        _IO0::di, _IO::uo), 
+    [thread_safe, will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    struct sockaddr *addr = (struct sockaddr *) Addr;
+    NewSocket = accept(Fd, addr, NULL);
+    if (NewSocket == INVALID_SOCKET) {
+        socket_errno = error();
+        Success = MR_NO;
+    } else {
+        Success = MR_YES;
+    }
+").

-	% XXX thread safe?
-:- pragma foreign_proc(c,
-	error_message(Err::out, _IO0::di, _IO::uo),
-	[will_not_call_mercury, promise_pure, tabled_for_io],
-"{
-	MR_make_aligned_string_copy(Err, strerror(socket_errno));
-}").
+    % XXX thread safe?
+:- pragma foreign_proc("C",
+    sockets.close(Fd::in, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    struct linger sockets_linger = { MR_TRUE, 2 };
+    setsockopt(Fd, SOL_SOCKET, SO_LINGER,
+        &sockets_linger, sizeof(sockets_linger));
+    shutdown(Fd, 2);
+").

+    % XXX thread safe?
+:- pragma foreign_proc("C",
+    error_message(Err::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    MR_make_aligned_string_copy(Err, strerror(socket_errno));
+").

  %-----------------------------------------------------------------------------%
+:- end_module sockets.
  %-----------------------------------------------------------------------------%

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list