#include "haskell2c.h" #include #include #include #include #include #include #include #if 0 #include #include #include #endif #include #include #ifdef MAXHOSTNAMELEN #define HOSTNAME_LEN MAXHOSTNAMELEN #else #define HOSTNAME_LEN 64 #endif #define SOCKET_OPEN_ERROR -1 #define SOCKET_CONNECT_ERROR -2 #define SOCKET_RESOLVER_ERROR -3 int inet_address(char *host, u_short port, struct sockaddr_in *address) { char hostname[HOSTNAME_LEN]; char *the_host; struct hostent *hp; memset(address, 0, sizeof(*address)); if (host == NULL) { (void) gethostname(hostname, HOSTNAME_LEN); the_host = hostname; } else the_host = host; if (host != NULL && host[0] >= '0' && host[0] <= '9') address->sin_addr.s_addr = inet_addr(host); else { if ((hp = gethostbyname(the_host)) == NULL) return(SOCKET_RESOLVER_ERROR); memcpy(&address->sin_addr, hp->h_addr, hp->h_length); } address->sin_family = AF_INET; address->sin_port = htons(port); return 0; } static int host_connect(int sd, char *host, short port) { struct sockaddr_in sin; int errno_save; if (inet_address(host, port, &sin) == SOCKET_RESOLVER_ERROR) { errno_save = errno; close(sd); errno= errno_save; return(SOCKET_RESOLVER_ERROR); } if (connect(sd, (struct sockaddr *) &sin, sizeof(sin)) == -1) { errno_save = errno; close(sd); errno= errno_save; return(SOCKET_CONNECT_ERROR); } return(sd); } int sockopen(char *host, short port, int type) { int sd ; if ((sd = socket(AF_INET, type, 0)) == -1) return(SOCKET_OPEN_ERROR); return(host_connect(sd, host, port)); } /* cOpenSocket primitive 3 :: CString -> Int -> SocketType -> (Either IOError Handle) */ C_HEADER(cOpenSocket) { NodePtr hostptr,portptr,typeptr,nodeptr; char *host; int type; short port; int fdesc; FILE *fp; C_CHECK(nhc_sizeLeft+nhc_sizeIOErrorOpen + nhc_sizeRight+nhc_sizeInt); hostptr = C_GETARG1(1); IND_REMOVE(hostptr); host = (char*)&hostptr[1+EXTRA]; portptr = C_GETARG1(2); IND_REMOVE(portptr); port = (short)GET_INT_VALUE(portptr); typeptr = C_GETARG1(3); IND_REMOVE(typeptr); switch(GET_CONSTR(typeptr)) { case SocketStream: type = SOCK_STREAM; break; case SocketDatagram: type = SOCK_DGRAM; break; case SocketRaw: type = SOCK_RAW; break; } #ifdef PROFILE if(replay) { REPLAY(fp); if(fp == 0) REPLAY(errno); } else { #endif fdesc = sockopen(host, port, type); if(fdesc<0) fp = 0; else fp = fdopen(fdesc,"rb+"); #ifdef PROFILE } if(record) { RECORD(fp); if(fp == 0) RECORD(errno); } #endif if(fp) { FileDesc *a; ForeignObj *fo; a = (FileDesc*)malloc(sizeof(FileDesc)); a->fp = fp; a->bm = _IOFBF; a->size = -1; a->path = ""; fo = allocForeignObj(a,gcFile,gcNow); nodeptr = nhc_mkRight(nhc_mkCInt((int)fo)); } else { nodeptr = nhc_mkLeft(nhc_mkIOErrorOpen(hostptr,typeptr,nhc_mkInt(errno))); } C_RETURN(nodeptr); }