Rui Ueyama
rui31****@gmail*****
2007年 8月 12日 (日) 17:08:29 JST
dup2(2)のインターフェイスを作成してみました。どういうインターフェイス を用意するのが良いか迷ったのですが、次のようにしてみました。 (port-fd-dup! toport fromport) アトミックにtoportのファイルディスクリプタをクローズし、fromportの ファイルディスクリプタ番号を複製したものをtoportに設定します。 toport、fromportはいずれもファイルポートでなければなりません。 前にLingrで議論したときには、toportのfdを閉じてからfromportのfd をdup2()する間に別スレッドがファイルをオープンすると、toportのfdが そちらに使われてしまって問題が起こるよね、という話をしたような 気がしますが、このパッチではtoportのfdをクローズせずにdup2()を 呼んでいるのでそういう競合状態はありません。 (manページでは、クローズせずにdup2()を呼ぶとクローズの際のエラー が失われてしまう旨の記述があるのですが、いまのGaucheはclose() のエラーを調べていないようなのでそれは問題ないかなと。) ちなみにdup2()がほしい理由は、Gaucheで書かれたプロセスを デーモン化するときに、標準入出力を/dev/nullにリダイレクトしたいから です。たとえば現在の出力を/dev/nullにリダイレクトするコードは、 port-fd-dup!を使うと次のようにかけます。 (call-with-output-file "/dev/null" (cut port-fd-dup! (current-output-port) <>)) -- 植山 類 -------------- next part -------------- Index: doc/corelib.texi =================================================================== RCS file: /cvsroot/gauche/Gauche/doc/corelib.texi,v retrieving revision 1.147 diff -u -r1.147 corelib.texi --- doc/corelib.texi 10 Aug 2007 02:05:50 -0000 1.147 +++ doc/corelib.texi 12 Aug 2007 08:05:45 -0000 @@ -9295,6 +9295,16 @@ @c COMMON @end defun + ＠ defun port-fd-dup! toport fromport + ＠ c EN + ＠ c JP +??????????@code{dup2(2)}?????????????????????? +????????????@var{toport}??????????????????????????????????????@var{fromport}?? +??????????????????????????????????????????@var{toport}?????????????? + ＠ var{toport}??@var{fromport}?????????????????????????????????????????????? + ＠ c COMMON + ＠ end defun + @node String ports, Coding-aware ports, File ports, Input and output @subsection String ports @c NODE ???????????? Index: doc/mapping.texi =================================================================== RCS file: /cvsroot/gauche/Gauche/doc/mapping.texi,v retrieving revision 1.13 diff -u -r1.13 mapping.texi --- doc/mapping.texi 17 Jan 2007 08:26:26 -0000 1.13 +++ doc/mapping.texi 12 Aug 2007 08:05:45 -0000 @@ -452,13 +452,9 @@ @item dup @itemx dup2 @c EN -No equivalent function. If you want to use this function to -set up I/Os for the child process, you can use `iomap' argument -of @code{sys-exec}. @xref{Unix process management}. - ＠ c JP -?????????????????????????????????????? I/O ???????????????????????? - ＠ code{sys-exec} ?? `iomap' ????????????????@ref{Unix process management} -?????? +Not directly supported, but you can use @code{port-fd-dup!}. + ＠ c JP +????????????????????????????????@code{port-fd-dup!} ???????????? @c COMMON @item execl @itemx execle Index: src/extlib.stub =================================================================== RCS file: /cvsroot/gauche/Gauche/src/extlib.stub,v retrieving revision 1.297 diff -u -r1.297 extlib.stub --- src/extlib.stub 12 Aug 2007 03:16:55 -0000 1.297 +++ src/extlib.stub 12 Aug 2007 08:05:45 -0000 @@ -953,6 +953,9 @@ " int i = Scm_PortFileNo(port); SCM_RETURN((i < 0)? SCM_FALSE : Scm_MakeInteger(i));") +(define-cproc port-fd-dup! (dst::<port> src::<port>) + (call <void> "Scm_PortFdDup")) + (define-enum SEEK_SET) (define-enum SEEK_CUR) (define-enum SEEK_END) Index: src/port.c =================================================================== RCS file: /cvsroot/gauche/Gauche/src/port.c,v retrieving revision 1.141 diff -u -r1.141 port.c --- src/port.c 9 Aug 2007 21:53:48 -0000 1.141 +++ src/port.c 12 Aug 2007 08:05:45 -0000 @@ -238,6 +238,40 @@ } } +/* Duplicates the file descriptor of the source port, and set it to + the destination port. Both source and destination port must be + file port. */ +void Scm_PortFdDup(ScmPort *dst, ScmPort *src) +{ + int r, srcfd, dstfd; + + if (SCM_PORT_TYPE(dst) != SCM_PORT_FILE) + Scm_Error("file port required, but got %S", dst); + if (SCM_PORT_TYPE(src) != SCM_PORT_FILE) + Scm_Error("file port required, but got %S", src); + if (src->direction != dst->direction) + Scm_Error("port direction mismatch: got %S and %S", + src, dst); + + srcfd = (intptr_t)src->src.buf.data; + dstfd = (intptr_t)dst->src.buf.data; + + if (dst->direction == SCM_PORT_INPUT) { + /* discard the current buffer */ + ScmVM *vm = Scm_VM(); + PORT_LOCK(dst, vm); + dst->src.buf.current = dst->src.buf.buffer; + dst->src.buf.end = dst->src.buf.buffer; + PORT_UNLOCK(dst); + } else { + /* flush the current buffer */ + Scm_Flush(dst); + } + SCM_SYSCALL(r, dup2(srcfd, dstfd)); + if (r < 0) Scm_SysError("dup2 failed"); + dst->src.buf.data = (void*)(intptr_t)r; +} + /* Low-level function to find if the file descriptor is ready or not. DIR specifies SCM_PORT_INPUT or SCM_PORT_OUTPUT. If the system doesn't have select(), this function returns Index: src/gauche/port.h =================================================================== RCS file: /cvsroot/gauche/Gauche/src/gauche/port.h,v retrieving revision 1.24 diff -u -r1.24 port.h --- src/gauche/port.h 27 Apr 2007 03:37:08 -0000 1.24 +++ src/gauche/port.h 12 Aug 2007 08:05:45 -0000 @@ -272,6 +272,7 @@ SCM_EXTERN ScmObj Scm_PortSeek(ScmPort *port, ScmObj off, int whence); SCM_EXTERN ScmObj Scm_PortSeekUnsafe(ScmPort *port, ScmObj off, int whence); SCM_EXTERN int Scm_PortFileNo(ScmPort *port); +SCM_EXTERN void Scm_PortFdDup(ScmPort *dst, ScmPort *src); SCM_EXTERN int Scm_FdReady(int fd, int dir); SCM_EXTERN int Scm_ByteReady(ScmPort *port); SCM_EXTERN int Scm_ByteReadyUnsafe(ScmPort *port); Index: test/io.scm =================================================================== RCS file: /cvsroot/gauche/Gauche/test/io.scm,v retrieving revision 1.28 diff -u -r1.28 io.scm --- test/io.scm 16 Apr 2007 03:47:13 -0000 1.28 +++ test/io.scm 12 Aug 2007 08:05:45 -0000 @@ -105,6 +105,35 @@ (call-with-input-file "tmp2.o" read))) ;;------------------------------------------------------------------- +(test-section "port-fd-dup!") + +(test* "port-fd-dup!" '("foo" "bar") + (let* ((p1 (open-output-file "tmp1.o")) + (p2 (open-output-file "tmp2.o"))) + (display "foo\n" p1) + (port-fd-dup! p1 p2) + (display "bar\n" p1) + (close-output-port p1) + (close-output-port p2) + (list (call-with-input-file "tmp1.o" read-line) + (call-with-input-file "tmp2.o" read-line)))) + +(test* "port-fd-dup!" '("foo" "bar") + (let* ((p1 (open-input-file "tmp1.o")) + (p2 (open-input-file "tmp2.o")) + (s1 (read-line p1))) + (port-fd-dup! p1 p2) + (list s1 (read-line p1)))) + +(test* "port-fd-dup!" *test-error* + (port-fd-dup! (open-output-file "tmp1.o") + (open-input-file "tmp2.o"))) + +(test* "port-fd-dup!" *test-error* + (port-fd-dup! (open-input-string "") + (open-input-file "tmp2.o"))) + +;;------------------------------------------------------------------- (test-section "input ports") (sys-unlink "tmp1.o")
