ScmObj Scm_TLSConnect(ScmTLS* t, int fd) { #if defined(GAUCHE_USE_AXTLS) context_check(t, "connect"); if (t->conn) Scm_SysError("attempt to connect already-connected TLS %S", t); t->conn = ssl_client_new(t->ctx, fd, 0, 0); if (SSL_OK != ssl_handshake_status(t->conn)) { Scm_SysError("TLS handshake failed"); } #endif /*GAUCHE_USE_AXTLS*/ return SCM_OBJ(t); }
static void ITIMER_START(void) { ScmVM *vm = Scm_VM(); vm->prof->hTimerEvent = CreateEvent(NULL, FALSE, FALSE, NULL); if (vm->prof->hTimerEvent == NULL) { Scm_SysError("CreateEvent failed"); } vm->prof->hObserverThread = (HANDLE)_beginthreadex(NULL, 0, observer_thread, (void*)vm, 0, NULL); if (vm->prof->hObserverThread == NULL) { Scm_SysError("_beginthreadex failed"); } }
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); }
/* 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_TLSAccept(ScmTLS* t, int fd) { #if defined(GAUCHE_USE_AXTLS) context_check(t, "accept"); if (t->conn) Scm_SysError("attempt to connect already-connected TLS %S", t); t->conn = ssl_server_new(t->ctx, fd); #endif /*GAUCHE_USE_AXTLS*/ return SCM_OBJ(t); }
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_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_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_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_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_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_TLSRead(ScmTLS* t) { #if defined(GAUCHE_USE_AXTLS) context_check(t, "read"); close_check(t, "read"); int r; uint8_t* buf; while ((r = ssl_read(t->conn, &buf)) == SSL_OK); if (r < 0) Scm_SysError("ssl_read() failed"); return Scm_MakeString((char*) buf, r, r, SCM_STRING_INCOMPLETE); #else /*!GAUCHE_USE_AXTLS*/ return SCM_FALSE; #endif /*!GAUCHE_USE_AXTLS*/ }
ScmObj Scm_Forkpty(ScmObj slaveterm) { int master; pid_t pid; struct termios *term = NULL; if (SCM_SYS_TERMIOS_P(slaveterm)) { term = &SCM_SYS_TERMIOS(slaveterm)->term; } if ((pid = forkpty(&master, NULL, term, NULL)) < 0) { Scm_SysError("forkpty failed"); } return Scm_Values2(Scm_MakeInteger(pid), SCM_MAKE_INT(master)); }
ScmObj Scm_Openpty(ScmObj slaveterm) { int master, slave; struct termios *term = NULL; if (SCM_SYS_TERMIOS_P(slaveterm)) { term = &SCM_SYS_TERMIOS(slaveterm)->term; } if (openpty(&master, &slave, NULL, term, NULL) < 0) { Scm_SysError("openpty failed"); } return Scm_Values2(SCM_MAKE_INT(master), SCM_MAKE_INT(slave)); }
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*/ }
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_TLSWrite(ScmTLS* t, ScmObj msg) { #if defined(GAUCHE_USE_AXTLS) context_check(t, "write"); close_check(t, "write"); int r; u_int size; const uint8_t* cmsg = get_message_body(msg, &size); if ((r = ssl_write(t->conn, cmsg, size)) < 0) { Scm_SysError("ssl_write() failed"); } return SCM_MAKE_INT(r); #else /*!GAUCHE_USE_AXTLS*/ return SCM_FALSE; #endif /*!GAUCHE_USE_AXTLS*/ }
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)); }
/* 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); }
ScmObj Scm_ForkptyAndExec(ScmString *file, ScmObj args, ScmObj iomap, ScmObj slaveterm, ScmSysSigset *mask) { int argc = Scm_Length(args); char **argv; const char *program; int *fds; int master; pid_t pid; struct termios *term = NULL; if (argc < 1) { Scm_Error("argument list must have at least one element: %S", args); } argv = Scm_ListToCStringArray(args, TRUE, NULL); program = Scm_GetStringConst(file); if (SCM_SYS_TERMIOS_P(slaveterm)) { term = &SCM_SYS_TERMIOS(slaveterm)->term; } fds = Scm_SysPrepareFdMap(iomap); if ((pid = forkpty(&master, NULL, term, NULL)) < 0) { Scm_SysError("forkpty failed"); } if (pid == 0) { Scm_SysSwapFds(fds); if (mask) { Scm_ResetSignalHandlers(&mask->set); Scm_SysSigmask(SIG_SETMASK, mask); } execvp(program, (char *const*)argv); /* here, we failed */ Scm_Panic("exec failed: %s: %s", program, strerror(errno)); } return Scm_Values2(Scm_MakeInteger(pid), SCM_MAKE_INT(master)); }
/*============================================================= * External API */ void Scm_ProfilerStart(void) { ScmVM *vm = Scm_VM(); ScmObj templat = Scm_StringAppendC(SCM_STRING(Scm_TmpDir()), "/gauche-profXXXXXX", -1, -1); char *templat_buf = Scm_GetString(SCM_STRING(templat)); /*mutable copy*/ if (!vm->prof) { vm->prof = SCM_NEW(ScmVMProfiler); vm->prof->state = SCM_PROFILER_INACTIVE; vm->prof->samplerFd = Scm_Mkstemp(templat_buf); vm->prof->currentSample = 0; vm->prof->totalSamples = 0; vm->prof->errorOccurred = 0; vm->prof->currentCount = 0; vm->prof->statHash = SCM_HASH_TABLE(Scm_MakeHashTableSimple(SCM_HASH_EQ, 0)); unlink(templat_buf); /* keep anonymous tmpfile */ } else if (vm->prof->samplerFd < 0) { vm->prof->samplerFd = Scm_Mkstemp(templat_buf); unlink(templat_buf); } if (vm->prof->state == SCM_PROFILER_RUNNING) return; vm->prof->state = SCM_PROFILER_RUNNING; vm->profilerRunning = TRUE; /* NB: this should be done globally!!! */ struct sigaction act; act.sa_handler = sampler_sample; sigfillset(&act.sa_mask); act.sa_flags = SA_RESTART; if (sigaction(SIGPROF, &act, NULL) < 0) { Scm_SysError("sigaction failed"); } ITIMER_START(); }
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*/ }