76 lines
1.9 KiB
Factor
Executable File
76 lines
1.9 KiB
Factor
Executable File
! Copyright (C) 2007 Doug Coleman, Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: alien alien.c-types arrays destructors io io.windows libc
|
|
windows.types math windows.kernel32 windows namespaces kernel
|
|
sequences windows.errors assocs math.parser system random ;
|
|
IN: io.windows.nt.pipes
|
|
|
|
! This code is based on
|
|
! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py
|
|
|
|
: default-security-attributes ( -- obj )
|
|
"SECURITY_ATTRIBUTES" <c-object>
|
|
"SECURITY_ATTRIBUTES" heap-size over set-SECURITY_ATTRIBUTES-nLength ;
|
|
|
|
: security-attributes-inherit ( -- obj )
|
|
default-security-attributes
|
|
TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ; foldable
|
|
|
|
: create-named-pipe ( name mode -- handle )
|
|
FILE_FLAG_OVERLAPPED bitor
|
|
PIPE_TYPE_BYTE
|
|
1
|
|
4096
|
|
4096
|
|
0
|
|
security-attributes-inherit
|
|
CreateNamedPipe
|
|
dup win32-error=0/f
|
|
dup add-completion ;
|
|
|
|
: open-other-end ( name mode -- handle )
|
|
FILE_SHARE_READ FILE_SHARE_WRITE bitor
|
|
security-attributes-inherit
|
|
OPEN_EXISTING
|
|
FILE_FLAG_OVERLAPPED
|
|
f
|
|
CreateFile
|
|
dup win32-error=0/f
|
|
dup add-completion ;
|
|
|
|
TUPLE: pipe in out ;
|
|
|
|
: <pipe> ( name in-mode out-mode -- pipe )
|
|
[
|
|
>r over >r create-named-pipe dup close-later
|
|
r> r> open-other-end dup close-later
|
|
pipe construct-boa
|
|
] with-destructors ;
|
|
|
|
: close-pipe ( pipe -- )
|
|
dup
|
|
pipe-in CloseHandle drop
|
|
pipe-out CloseHandle drop ;
|
|
|
|
: <incoming-pipe> ( name -- pipe )
|
|
PIPE_ACCESS_INBOUND GENERIC_WRITE <pipe> ;
|
|
|
|
: <outgoing-pipe> ( name -- pipe )
|
|
PIPE_ACCESS_DUPLEX GENERIC_READ <pipe> ;
|
|
|
|
: unique-pipe-name ( -- string )
|
|
[
|
|
"\\\\.\\pipe\\factor-" %
|
|
pipe counter #
|
|
"-" %
|
|
(random) #
|
|
"-" %
|
|
millis #
|
|
] "" make ;
|
|
|
|
: <unique-incoming-pipe> ( -- pipe )
|
|
unique-pipe-name <incoming-pipe> ;
|
|
|
|
: <unique-outgoing-pipe> ( -- pipe )
|
|
unique-pipe-name <outgoing-pipe> ;
|