You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
103 lines
3.4 KiB
103 lines
3.4 KiB
# |
|
# Copyright (c) 2010-2011, Ashok P. Nadkarni |
|
# All rights reserved. |
|
# |
|
# See the file LICENSE for license |
|
|
|
# Implementation of named pipes |
|
|
|
proc twapi::namedpipe_server {name args} { |
|
set name [file nativename $name] |
|
|
|
# Only byte mode currently supported. Message mode does |
|
# not mesh well with Tcl channel infrastructure. |
|
# readmode.arg |
|
# writemode.arg |
|
|
|
array set opts [twapi::parseargs args { |
|
{access.arg {read write}} |
|
{writedacl 0 0x00040000} |
|
{writeowner 0 0x00080000} |
|
{writesacl 0 0x01000000} |
|
{writethrough 0 0x80000000} |
|
denyremote |
|
{timeout.int 50} |
|
{maxinstances.int 255} |
|
{secd.arg {}} |
|
{inherit.bool 0} |
|
} -maxleftover 0] |
|
|
|
# 0x40000000 -> OVERLAPPED I/O |
|
set open_mode [expr { |
|
[twapi::_parse_symbolic_bitmask $opts(access) {read 1 write 2}] | |
|
$opts(writedacl) | $opts(writeowner) | |
|
$opts(writesacl) | $opts(writethrough) | |
|
0x40000000 |
|
}] |
|
|
|
set pipe_mode 0 |
|
if {$opts(denyremote)} { |
|
if {! [twapi::min_os_version 6]} { |
|
error "Option -denyremote not supported on this operating system." |
|
} |
|
set pipe_mode [expr {$pipe_mode | 8}] |
|
} |
|
|
|
return [twapi::Twapi_NPipeServer $name $open_mode $pipe_mode \ |
|
$opts(maxinstances) 4000 4000 $opts(timeout) \ |
|
[_make_secattr $opts(secd) $opts(inherit)]] |
|
} |
|
|
|
proc twapi::namedpipe_client {name args} { |
|
set name [file nativename $name] |
|
|
|
# Only byte mode currently supported. Message mode does |
|
# not mesh well with Tcl channel infrastructure. |
|
# readmode.arg |
|
# writemode.arg |
|
|
|
array set opts [twapi::parseargs args { |
|
{access.arg {read write}} |
|
impersonationlevel.arg |
|
{impersonateeffectiveonly.bool false 0x00080000} |
|
{impersonatecontexttracking.bool false 0x00040000} |
|
} -maxleftover 0] |
|
|
|
# FILE_READ_DATA 0x00000001 |
|
# FILE_WRITE_DATA 0x00000002 |
|
# Note - use _parse_symbolic_bitmask because we allow user to specify |
|
# numeric masks as well |
|
set desired_access [twapi::_parse_symbolic_bitmask $opts(access) { |
|
read 1 |
|
write 2 |
|
}] |
|
|
|
set flags 0 |
|
if {[info exists opts(impersonationlevel)]} { |
|
switch -exact -- $opts(impersonationlevel) { |
|
anonymous { set flags 0x00100000 } |
|
identification { set flags 0x00110000 } |
|
impersonation { set flags 0x00120000 } |
|
delegation { set flags 0x00130000 } |
|
default { |
|
# ERROR_BAD_IMPERSONATION_LEVEL |
|
win32_error 1346 "Invalid impersonation level '$opts(impersonationlevel)'." |
|
} |
|
} |
|
set flags [expr {$flags | $opts(impersonateeffectiveonly) | |
|
$opts(impersonatecontexttracking)}] |
|
} |
|
|
|
set share_mode 0; # Share none |
|
set secattr {}; # At some point use this for "inherit" flag |
|
set create_disposition 3; # OPEN_EXISTING |
|
return [twapi::Twapi_NPipeClient $name $desired_access $share_mode \ |
|
$secattr $create_disposition $flags] |
|
} |
|
|
|
# Impersonate a named pipe client |
|
proc twapi::impersonate_namedpipe_client {chan} { |
|
set h [get_tcl_channel_handle $chan read] |
|
ImpersonateNamedPipeClient $h |
|
} |
|
|
|
|