/* ADDRS is a list of socket addresses; if 'from' address type matches one of them, it is used to store the information so that we can avoid allocation. If no addresses match the incoming type, and ADDRS is a complete list, the information of 'from' is discarded. If no addresses match the incoming type, and the last cdr of ADDRS is #t (this case includes ADDRS == #t), a new sockaddr is allocated and returned. */ ScmObj Scm_SocketRecvFromX(ScmSocket *sock, ScmUVector *buf, ScmObj addrs, int flags) { int r; u_int size; struct sockaddr_storage from; socklen_t fromlen = sizeof(from); ScmObj addr = SCM_FALSE; CLOSE_CHECK(sock->fd, "recv from", sock); char *z = get_message_buffer(buf, &size); SCM_SYSCALL(r, recvfrom(sock->fd, z, size, flags, (struct sockaddr*)&from, &fromlen)); if (r < 0) { Scm_SysError("recvfrom(2) failed"); } ScmObj cp; SCM_FOR_EACH(cp, addrs) { ScmObj a = SCM_CAR(cp); if (Scm_SockAddrP(a)) { if (SCM_SOCKADDR_FAMILY(a) == from.ss_family) { memcpy(&SCM_SOCKADDR(a)->addr, &from, SCM_SOCKADDR(a)->addrlen); addr = a; break; } } }
ScmObj Scm_SocketAccept(ScmSocket *sock) { Socket newfd; struct sockaddr_storage addrbuf; socklen_t addrlen = sizeof(addrbuf); ScmSocket *newsock; ScmClass *addrClass = Scm_ClassOf(SCM_OBJ(sock->address)); CLOSE_CHECK(sock->fd, "accept from", sock); SCM_SYSCALL(newfd, accept(sock->fd, (struct sockaddr*)&addrbuf, &addrlen)); if (SOCKET_INVALID(newfd)) { if (errno == EAGAIN) { return SCM_FALSE; } else { Scm_SysError("accept(2) failed"); } } newsock = make_socket(newfd, sock->type); newsock->address = SCM_SOCKADDR(Scm_MakeSockAddr(addrClass, (struct sockaddr*)&addrbuf, addrlen)); newsock->status = SCM_SOCKET_STATUS_CONNECTED; return SCM_OBJ(newsock); }
int scm_file_exists(ScmObj path, bool *rslt) { char path_cstr[PATH_MAX]; struct stat st; ssize_t s; int r; scm_assert(scm_string_p(path)); s = scm_string_to_path_cstr(path, path_cstr, sizeof(path_cstr)); if (s < 0) return -1; SCM_SYSCALL(r, stat(path_cstr, &st)); if (r < 0 && errno != ENOENT) { /* TODO; change error message */ scm_error("system call error: stat", 0); return -1; } if (rslt != NULL) *rslt = (r == 0); return 0; }
ScmObj Scm_MakeSocket(int domain, int type, int protocol) { intptr_t sock; #if GAUCHE_WINDOWS /* On Windows, sockets created by socket() call sets WSA_FLAG_OVERLAPPED flag. When used in threads other than primordial thread, I/O to/from such socket fails, since it requires extra OVERLAPPED struct in win32 call (which can't be done with POSIX calls). Directly using WSASocket allows us to not set WSA_FLAG_OVERLAPPED flag. */ SCM_SYSCALL(sock, WSASocket(domain, type, protocol, NULL, 0, 0)); #else /*!GAUCHE_WINDOWS*/ SCM_SYSCALL(sock, socket(domain, type, protocol)); #endif /*!GAUCHE_WINDOWS*/ if (SOCKET_INVALID(sock)) Scm_SysError("couldn't create socket"); return SCM_OBJ(make_socket((Socket)sock, type)); }
ScmObj Scm_SocketSend(ScmSocket *sock, ScmObj msg, int flags) { int r; u_int size; CLOSE_CHECK(sock->fd, "send to", sock); const char *cmsg = get_message_body(msg, &size); SCM_SYSCALL(r, send(sock->fd, cmsg, size, flags)); if (r < 0) Scm_SysError("send(2) failed"); return SCM_MAKE_INT(r); }
ScmObj Scm_SocketRecv(ScmSocket *sock, int bytes, int flags) { int r; CLOSE_CHECK(sock->fd, "recv from", sock); char *buf = SCM_NEW_ATOMIC2(char*, bytes); SCM_SYSCALL(r, recv(sock->fd, buf, bytes, flags)); if (r < 0) { Scm_SysError("recv(2) failed"); } return Scm_MakeString(buf, r, r, SCM_STRING_INCOMPLETE); }
ScmObj Scm_SocketListen(ScmSocket *sock, int backlog) { int r; CLOSE_CHECK(sock->fd, "listen to", sock); SCM_SYSCALL(r, listen(sock->fd, backlog)); if (r < 0) { Scm_SysError("listen(2) failed"); } sock->status = SCM_SOCKET_STATUS_LISTENING; return SCM_OBJ(sock); }
ScmObj Scm_SocketBind(ScmSocket *sock, ScmSockAddr *addr) { int r; CLOSE_CHECK(sock->fd, "bind", sock); SCM_SYSCALL(r, bind(sock->fd, &addr->addr, addr->addrlen)); if (r < 0) { Scm_SysError("bind failed to %S", addr); } /* The system may assign different address than <addr>, especially when <addr> contains some 'wild card' (e.g. port=0). We call getsockname to obtain the exact address. Patch provided by ODA Hideo */ ScmSockAddr *naddr = SCM_SOCKADDR( Scm_MakeSockAddr(SCM_CLASS_OF(addr), &addr->addr, addr->addrlen)); SCM_SYSCALL(r, getsockname(sock->fd, &naddr->addr, &naddr->addrlen)); if (r < 0) { Scm_SysError("getsockname failed to %S", addr); } sock->address = naddr; sock->status = SCM_SOCKET_STATUS_BOUND; return SCM_OBJ(sock); }
ScmObj Scm_SocketConnect(ScmSocket *sock, ScmSockAddr *addr) { int r; CLOSE_CHECK(sock->fd, "connect to", sock); SCM_SYSCALL(r, connect(sock->fd, &addr->addr, addr->addrlen)); if (r < 0) { Scm_SysError("connect failed to %S", addr); } sock->address = addr; sock->status = SCM_SOCKET_STATUS_CONNECTED; return SCM_OBJ(sock); }
ScmObj Scm_SocketRecvX(ScmSocket *sock, ScmUVector *buf, int flags) { int r; u_int size; CLOSE_CHECK(sock->fd, "recv from", sock); char *z = get_message_buffer(buf, &size); SCM_SYSCALL(r, recv(sock->fd, z, size, flags)); if (r < 0) { Scm_SysError("recv(2) failed"); } return Scm_MakeInteger(r); }
ScmObj Scm_SocketSendTo(ScmSocket *sock, ScmObj msg, ScmSockAddr *to, int flags) { int r; u_int size; CLOSE_CHECK(sock->fd, "send to", sock); const char *cmsg = get_message_body(msg, &size); SCM_SYSCALL(r, sendto(sock->fd, cmsg, size, flags, &SCM_SOCKADDR(to)->addr, SCM_SOCKADDR(to)->addrlen)); if (r < 0) Scm_SysError("sendto(2) failed"); return SCM_MAKE_INT(r); }
ScmObj Scm_SocketGetPeerName(ScmSocket *sock) { int r; struct sockaddr_storage addrbuf; socklen_t addrlen = sizeof(addrbuf); CLOSE_CHECK(sock->fd, "get the name of", sock); SCM_SYSCALL(r, getpeername(sock->fd, (struct sockaddr*)&addrbuf, &addrlen)); if (r < 0) { Scm_SysError("getpeername(2) failed"); } return SCM_OBJ(Scm_MakeSockAddr(NULL, (struct sockaddr*)&addrbuf, addrlen)); }
ScmObj Scm_SocketShutdown(ScmSocket *s, int how) { int r; if (s->status != SCM_SOCKET_STATUS_CONNECTED) { return SCM_FALSE; } SCM_SYSCALL(r, shutdown(s->fd, how)); if (r < 0) { Scm_SysError("socket shutdown failed for %S", SCM_OBJ(s)); } s->status = SCM_SOCKET_STATUS_SHUTDOWN; return SCM_TRUE; }
ScmObj Scm_SocketRecvFrom(ScmSocket *sock, int bytes, int flags) { int r; struct sockaddr_storage from; socklen_t fromlen = sizeof(from); CLOSE_CHECK(sock->fd, "recv from", sock); char *buf = SCM_NEW_ATOMIC2(char*, bytes); SCM_SYSCALL(r, recvfrom(sock->fd, buf, bytes, flags, (struct sockaddr*)&from, &fromlen)); if (r < 0) { Scm_SysError("recvfrom(2) failed"); } return Scm_Values2(Scm_MakeString(buf, r, r, SCM_STRING_INCOMPLETE), Scm_MakeSockAddr(NULL, (struct sockaddr*)&from, fromlen)); }
ScmObj Scm_SocketSendMsg(ScmSocket *sock, ScmObj msg, int flags) { #if !GAUCHE_WINDOWS int r; u_int size; CLOSE_CHECK(sock->fd, "send to", sock); const char *cmsg = get_message_body(msg, &size); SCM_SYSCALL(r, sendmsg(sock->fd, (struct msghdr*)cmsg, flags)); if (r < 0) Scm_SysError("sendmsg(2) failed"); return SCM_MAKE_INT(r); #else /*GAUCHE_WINDOWS*/ Scm_Error("sendmsg is not implemented on this platform."); return SCM_UNDEFINED; /* dummy */ #endif /*GAUCHE_WINDOWS*/ }
/* Returns the statHash */ ScmObj Scm_ProfilerRawResult(void) { ScmVM *vm = Scm_VM(); if (vm->prof == NULL) return SCM_FALSE; if (vm->prof->state == SCM_PROFILER_INACTIVE) return SCM_FALSE; if (vm->prof->state == SCM_PROFILER_RUNNING) Scm_ProfilerStop(); if (vm->prof->errorOccurred > 0) { Scm_Warn("profiler: An error has been occurred during saving profiling samples. The result may not be accurate"); } Scm_ProfilerCountBufferFlush(vm); /* collect samples in the current buffer */ collect_samples(vm->prof); /* collect samples in the saved file */ off_t off; SCM_SYSCALL(off, lseek(vm->prof->samplerFd, 0, SEEK_SET)); if (off == (off_t)-1) { Scm_ProfilerReset(); Scm_Error("profiler: seek failed in retrieving sample data"); } for (;;) { ssize_t r = read(vm->prof->samplerFd, vm->prof->samples, sizeof(ScmProfSample[1]) * SCM_PROF_SAMPLES_IN_BUFFER); if (r <= 0) break; vm->prof->currentSample = r / sizeof(ScmProfSample[1]); collect_samples(vm->prof); } vm->prof->currentSample = 0; #if defined(GAUCHE_WINDOWS) if (vm->prof->samplerFd >= 0) { close(vm->prof->samplerFd); vm->prof->samplerFd = -1; unlink(vm->prof->samplerFileName); } #else /* !GAUCHE_WINDOWS */ if (ftruncate(vm->prof->samplerFd, 0) < 0) { Scm_SysError("profiler: failed to truncate temporary file"); } #endif /* !GAUCHE_WINDOWS */ return SCM_OBJ(vm->prof->statHash); }
/* Returns the statHash */ ScmObj Scm_ProfilerRawResult(void) { ScmVM *vm = Scm_VM(); if (vm->prof == NULL) return SCM_FALSE; if (vm->prof->state == SCM_PROFILER_INACTIVE) return SCM_FALSE; if (vm->prof->state == SCM_PROFILER_RUNNING) Scm_ProfilerStop(); if (vm->prof->errorOccurred > 0) { Scm_Warn("profiler: An error has been occurred during saving profiling samples. The result may not be accurate"); } Scm_ProfilerCountBufferFlush(vm); /* collect samples in the current buffer */ collect_samples(vm->prof); /* collect samples in the saved file */ off_t off; SCM_SYSCALL(off, lseek(vm->prof->samplerFd, 0, SEEK_SET)); if (off == (off_t)-1) { Scm_ProfilerReset(); Scm_Error("profiler: seek failed in retrieving sample data"); } ScmObj sampler_port = Scm_MakePortWithFd(SCM_FALSE, SCM_PORT_INPUT, vm->prof->samplerFd, SCM_PORT_BUFFER_FULL, FALSE); for (;;) { ssize_t r = read(vm->prof->samplerFd, vm->prof->samples, sizeof(ScmProfSample[1]) * SCM_PROF_SAMPLES_IN_BUFFER); if (r <= 0) break; vm->prof->currentSample = r / sizeof(ScmProfSample[1]); collect_samples(vm->prof); } vm->prof->currentSample = 0; if (ftruncate(vm->prof->samplerFd, 0) < 0) { Scm_SysError("profiler: failed to truncate temporary file"); } return SCM_OBJ(vm->prof->statHash); }
int scm_delete_file(ScmObj path) { char path_cstr[PATH_MAX]; ssize_t s; int r; scm_assert(scm_string_p(path)); s = scm_string_to_path_cstr(path, path_cstr, sizeof(path_cstr)); if (s < 0) return -1; SCM_SYSCALL(r, unlink(path_cstr)); if (r < 0) { /* TODO; change error message */ scm_file_error("system call error: unlink", 0); return -1; } return 0; }
ScmObj Scm_SysFcntl(ScmObj port_or_fd, int op, ScmObj arg) { #if !defined(GAUCHE_WINDOWS) int fd = Scm_GetPortFd(port_or_fd, TRUE), r; switch (op) { case F_GETFD:; case F_GETFL:; #if defined(F_GETOWN) /* BSD and Linux specific */ case F_GETOWN:; #endif /*F_GETOWN*/ #if defined(F_GETSIG) /* Linux specific */ case F_GETSIG:; #endif /*F_GETSIG */ #if defined(F_GETLEASE) /* Linux specific */ case F_GETLEASE:; #endif /*F_GETLEASE */ SCM_SYSCALL(r, fcntl(fd, op)); if (r == -1) { /*NB: F_GETOWN may return a negative value on success*/ Scm_SysError("fcntl(%s) failed", flag_name(op)); } return Scm_MakeInteger(r); case F_SETFD:; case F_SETFL:; case F_DUPFD:; #if defined(F_SETOWN) /* BSD and Linux specific */ case F_SETOWN:; #endif /*F_SETOWN*/ #if defined(F_SETSIG) /* Linux specific */ case F_SETSIG:; #endif /*F_SETSIG */ #if defined(F_SETLEASE) /* Linux specific */ case F_SETLEASE:; #endif /*F_SETLEASE */ #if defined(F_NOTIFY) /* Linux specific */ case F_NOTIFY:; #endif /*F_NOTIFY */ if (!SCM_EXACTP(arg)) { Scm_Error("exact integer required for fcntl(%s), but got %S", flag_name(op), arg); } SCM_SYSCALL(r, fcntl(fd, op, Scm_GetInteger(arg))); if (r < 0) { Scm_SysError("fcntl(%s) failed", flag_name(op)); } return Scm_MakeInteger(r); case F_GETLK:; case F_SETLK:; case F_SETLKW:; if (!SCM_SYS_FLOCK_P(arg)) { Scm_Error("flock object required for fcntl(%s), but got %S", flag_name(op), arg); } ScmSysFlock *fl = SCM_SYS_FLOCK(arg); SCM_SYSCALL(r, fcntl(fd, op, &fl->lock)); if (op == F_SETLK) { if (r >= 0) return SCM_TRUE; if (errno == EAGAIN) return SCM_FALSE; } if (r < 0) Scm_SysError("fcntl(%s) failed", flag_name(op)); return SCM_TRUE; default: Scm_Error("unknown operation code (%d) for fcntl", op); return SCM_UNDEFINED; /* dummy */ } #else /*GAUCHE_WINDOWS*/ Scm_Error("fcntl not supported on MinGW port"); return SCM_UNDEFINED; /*dummy*/ #endif /*GAUCHE_WINDOWS*/ }