1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
+
-
+
+
+
+
|
#include <tcl.h>
#include <windows.h>
int Tcl_WinLockObjCmd(
ClientData cdata,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Tcl_Channel channel;
ClientData *hread, *hwrite;
ClientData hread, hwrite;
DWORD flags;
DWORD nb_low, nb_high;
LPOVERLAPPED ovl;
OVERLAPPED ovl;
BY_HANDLE_FILE_INFORMATION fileinfo;
int f_exclusive = 0;
/* ?-exclusive? */
if(objc < 2) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not enough arguments! Expected \"%s ?-exclusive? chan\"", objv[0]));
Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not enough arguments! Expected \"%s ?-exclusive? chan\"", Tcl_GetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
if(objc > 3) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("Too many arguments! Expected \"%s ?-exclusive? chan\"", objv[0]));
Tcl_SetObjResult(interp, Tcl_ObjPrintf("Too many arguments! Expected \"%s ?-exclusive? chan\"", Tcl_GetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
if(objc == 3) {
const char* name = Tcl_GetString(objv[1]);
if(strcmp(name, "-exclusive", strlen(name)) == 0) {
if(strncmp(name, "-exclusive", strlen(name)) == 0) {
f_exclusive = 1;
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid option \"%s\"! Expected ?-exclusive?", name));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
}
/* obtain channel from last argument */
channel = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[objc-1], NULL), NULL);
channel = Tcl_GetChannel(interp, Tcl_GetString(objv[objc-1]), NULL);
if(channel == (Tcl_Channel) NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not a channel: \"%s\"!", Tcl_GetStringFromObj(objv[objc-1])));
Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not a channel: \"%s\"!", Tcl_GetString(objv[objc-1])));
return TCL_ERROR;
}
/* get the underlying file handles */
if(TCL_ERR == Tcl_GetChannelHandle(channel, TCL_READABLE, &hread)) {
if(TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_READABLE, &hread)) {
hread = NULL;
}
if(TCL_ERR == Tcl_GetChannelHandle(channel, TCL_WRITABLE, &hwrite)) {
if(TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_WRITABLE, &hwrite)) {
hwrite = NULL;
}
if(hread == NULL) { hread = hwrite; }
if(hwrite == hread) { hwrite = NULL; }
if(hwrite != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("Two handles! Unable to lock (%p, %p)", hread, hwrite));
return TCL_ERROR;
}
/* populate the lock region */
if(GetFileInformationByHandle(hread, &fileinfo) != TRUE) {
Tcl_SetResult(interp, "unable to get file information: ", TCL_STATIC);
goto getLastError;
} else {
nb_high = fileinfo.nFileSizeHigh;
nb_low = fileinfo.nFileSizeLow;
}
/* prepare for LockFileEx() */
memset(ovl, 0, sizeof(ovl));
ovl->hEvent = 0;
memset(&ovl, 0, sizeof(ovl));
ovl.hEvent = 0;
flags = LOCKFILE_FAIL_IMMEDIATELY;
if(f_exclusive) {
flags |= LOCKFILE_EXCLUSIVE_LOCK;
}
/* call LockFileEx */
if(LockFileEx(hread, flags, 0, nb_low, nb_high, ovl)) {
if(LockFileEx(hread, flags, 0, nb_low, nb_high, &ovl)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("Locked %p", hread));
/* we don't care about the overlay structure; it would be needed for unlocking if we did */
return TCL_OK;
}
getLastError:
{
/* handle Windows error - cribbed from AppendSystemError in tclWinReg.c */
DWORD error;
TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr;
char *msgPtr;
char *msgPtr;
char id[16];
char msgBuf[1024];
char *msg;
Tcl_DString ds;
DWORD length;
error = GetLastError();
length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER,
NULL, error,
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr,
|