TCL中的FIFO文件

FIFO file in TCL

我需要在命名管道中解压文件 return 它:

proc unzip_file_if_needed { fileName } {
    if { [file extension $fileName] != ".gz" } {
        return $fileName;
    }
    set tmpDir [fileutil::tempdir]
    set tmpFileName [ file join $tmpDir [ pid ] ]
    if { [file exists $tmpFileName ] } {
        file delete $tmpFileName
    }
    exec mkfifo $tmpFileName
    exec gunzip -c $fileName > $tmpFileName &
    return $tmpFileName
}

挂起 exec gunzip -c $fileName > $tmpFileName &

问题是内核将阻塞在 open() 系统调用中,直到 fifo 为相反方向打开,并且 Tcl 在分叉之前在父进程中创建重定向(因为这允许很多在正常情况下更可靠的错误处理)。您 需要 的是将 O_NONBLOCK 标志传递到 open() 系统调用中,但是 exec 命令不能让您控制它。所以需要一些技巧!

set fd [open $tmpFileName {WRONLY NONBLOCK}]
exec gunzip -c $fileName >@$fd &
close $fd

这是通过使用我们想要的标志手动执行 open(Tcl 将它们映射到没有 O_ 前缀)然后将该描述符传递给子进程来工作的。请注意,由于这是我们正在设置的管道的写入端,我们必须以 WRONLY 模式打开(这是 open … w 在幕后所做的,减去一些标志这里不用申请,加上NONBLOCK就是我们要的魔法)。

我是这样解决这个问题的:

proc unzip_file_if_needed { fileName } {
    if { [file extension $fileName] != ".gz" } {
        return $fileName;
    }
    set tmpDir [fileutil::tempdir]
    set pId [pid]
    set tmpFileName [ file join $tmpDir pId ]
    set unzipCmd [ file join $tmpDir [ append pId "cmd.sh" ] ]
    if { [file exists $tmpFileName ] } {
        file delete $tmpFileName
    }

    if { [file exists $unzipCmd ] } {
        file delete $unzipCmd
    }

    set cmdDesc [open $unzipCmd { CREAT EXCL RDWR} 0777]
    puts $cmdDesc "\#!\/bin\/bash\n gunzip -c $1 > $2"
    close $cmdDesc

    exec mkfifo $tmpFileName
    exec $unzipCmd $fileName $tmpFileName >&@1 &

    return $tmpFileName
}