ALGOBIT

scheme で TCP のサーバを書く際の雛形としてエコーサーバとしてコードをまとめてみた.
ほとんど処理系依存, UNIX系OS + Gauche じゃないと動きません.
daemon のところは Gauche クックブック / デーモンプロセスを作成する をほぼそのまま使わせていただきました.
Gauche ユーザリファレンス の C と Scheme の関数の対応 あたりを激しく参照しました.
chmod +x して実行すると, 制御端末を切り離し, 1111 番ポートの TCP 接続を待ちます.
telnet localhost 1111 などで接続すると, 改行の入力を待って, 改行までに入力されたテキストに改行を付けてそのまま返します.
止めるときは ps などで親の（一番若い） pid を調べて kill します.

#!/usr/bin/env gosh
(use gauche.net)
(set-signal-handler! SIGCHLD (lambda _
                               (guard (e ((<system-error> e)))
                                      (while (< 0 (sys-waitpid -1))))))
(set-signal-handler! SIGTERM (lambda _ (sys-kill 0 SIGTERM)))

(define (daemon)
  (when (positive? (sys-fork))
        (sys-exit 0))
  (sys-setsid)
  (sys-chdir "/")
  (sys-umask 0)
  (call-with-input-file "/dev/null"
                        (cut port-fd-dup! (standard-input-port) <> ))
  (call-with-output-file "/dev/null"
                         (lambda (out)
                           (port-fd-dup! (standard-output-port) out)
                           (port-fd-dup! (standard-error-port) out))))

(define (prog cs)
  (let ((iport (socket-input-port cs))
        (oport (socket-output-port cs)))
    (let loop ((line (read-line iport)))
      (cond
        ((eof-object? line) (socket-close cs))
        (else
          (display (string-append line "\r\n") oport)
          (loop (read-line iport)))))))

(define (main args)
  (daemon)
  (let1 s (make-server-socket 'inet 1111 :reuse-addr? #t)
        (let loop ((cs (socket-accept s)))
          (let ((pid (sys-fork)))
            (cond
              ((= pid 0)	; child
			   (set-signal-handler! SIGTERM #t) ; reset
               (prog cs)
               (sys-exit 0))
              (else			; parent
                (socket-close cs)
                (loop (socket-accept s))))))))

以下はほぼ等価な C のプログラムです.
というか, 過去に C で書いた TCP サーバから最低限のコードをエコーサーバとして下のように整理し, これを Gauche に置き換えたのが上のプログラムです.
UNIX 系の OS でないと動きません.
syslog は省いてます.

#include <sys/types.h>	/* read */
#include <sys/socket.h>	/* accept, bind, getsockname, listen, socket */
#include <sys/uio.h>	/* read */
#include <sys/wait.h>	/* waitpid */
#include <arpa/inet.h>	/* htons */
#include <errno.h>		/* errno */
#include <fcntl.h>		/* open */
#include <signal.h>		/* kill, sigaction */
#include <stdio.h>		/* BUFSIZ */
#include <stdlib.h>		/* daemon, exit */
#include <unistd.h>		/* _exit, close, dup, fork, read, write */

static void
reapchild(int signo)
{
	while (waitpid(-1, NULL, WNOHANG) > 0)
		;
}

static void
parent_exit(int signo)
{
	kill(0, SIGTERM);
	exit(0);
}

static int
prog(int s)
{
	int n;
	char buf[BUFSIZ];

	while (0 < (n = read(s, buf, BUFSIZ)))
		write(s, buf, n);
}

int
main(int argc, char *argv[])
{
	int addrlen, cs, pid, s;
	struct sockaddr_in addr;
	int port = 1111;
	struct sigaction sa;

	daemon(1, 1);
	chdir("/");
	close(0);
	close(1);
	close(2);
	open("/dev/null", O_RDWR);
	dup(0);
	dup(0);

	sa.sa_handler = reapchild;
	sigaction(SIGCHLD, &sa, NULL);
	sa.sa_handler = parent_exit;
	sigaction(SIGTERM, &sa, NULL);

	if ((s = socket(AF_INET, SOCK_STREAM, 0)) < 0)
		exit(1);

	addr.sin_family = AF_INET;
	addr.sin_addr.s_addr = INADDR_ANY;
	addr.sin_port = htons((unsigned short)port);
	addrlen = sizeof(addr);
	if (bind(s, (struct sockaddr *)&addr, addrlen) < 0)
		exit(1);

	if (getsockname(s, (struct sockaddr *)&addr, &addrlen))
		exit(1);

	listen(s, 5);
	for (; ; ) {
		if ((cs = accept(s, (struct sockaddr *)&addr, &addrlen)) < 0) {
			if (errno == EINTR)
				continue;
			exit(1);
		}
		switch (fork()) {
		case -1:
			exit(1);
		case 0:
			sa.sa_handler = SIG_DFL;
			sigaction(SIGTERM, &sa, NULL);
			close(s);
			prog(cs);
			_exit(0);
		}
		close(cs);
	}
}

プログラミングGauche

Kahuaプロジェクト

オライリージャパン

発売日：2008-03-14

ブクログでレビューを見る»

UNIX Cプログラミング (NUTSSHELL HANDBOOKS)

デビッド・A. クリ

アスキー

発売日：1991-07

ブクログでレビューを見る»