/* 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*/
}
