1/*
2 * tclUnixTest.c --
3 *
4 *	Contains platform specific test commands for the Unix platform.
5 *
6 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
7 * Copyright (c) 1998 by Scriptics Corporation.
8 *
9 * See the file "license.terms" for information on usage and redistribution of
10 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 *
12 * RCS: @(#) $Id: tclUnixTest.c,v 1.26 2007/04/20 06:11:00 kennykb Exp $
13 */
14
15#include "tclInt.h"
16
17/*
18 * The headers are needed for the testalarm command that verifies the use of
19 * SA_RESTART in signal handlers.
20 */
21
22#include <signal.h>
23#include <sys/resource.h>
24
25/*
26 * The following macros convert between TclFile's and fd's. The conversion
27 * simple involves shifting fd's up by one to ensure that no valid fd is ever
28 * the same as NULL. Note that this code is duplicated from tclUnixPipe.c
29 */
30
31#define MakeFile(fd)	((TclFile)INT2PTR(((int)(fd))+1))
32#define GetFd(file)	(PTR2INT(file)-1)
33
34/*
35 * The stuff below is used to keep track of file handlers created and
36 * exercised by the "testfilehandler" command.
37 */
38
39typedef struct Pipe {
40    TclFile readFile;		/* File handle for reading from the pipe.
41				 * NULL means pipe doesn't exist yet. */
42    TclFile writeFile;		/* File handle for writing from the pipe. */
43    int readCount;		/* Number of times the file handler for this
44				 * file has triggered and the file was
45				 * readable. */
46    int writeCount;		/* Number of times the file handler for this
47				 * file has triggered and the file was
48				 * writable. */
49} Pipe;
50
51#define MAX_PIPES 10
52static Pipe testPipes[MAX_PIPES];
53
54/*
55 * The stuff below is used by the testalarm and testgotsig ommands.
56 */
57
58static char *gotsig = "0";
59
60/*
61 * Forward declarations of functions defined later in this file:
62 */
63
64static void		TestFileHandlerProc(ClientData clientData, int mask);
65static int		TestfilehandlerCmd(ClientData dummy,
66			    Tcl_Interp *interp, int argc, CONST char **argv);
67static int		TestfilewaitCmd(ClientData dummy,
68			    Tcl_Interp *interp, int argc, CONST char **argv);
69static int		TestfindexecutableCmd(ClientData dummy,
70			    Tcl_Interp *interp, int argc, CONST char **argv);
71static int		TestgetopenfileCmd(ClientData dummy,
72			    Tcl_Interp *interp, int argc, CONST char **argv);
73static int		TestgetdefencdirCmd(ClientData dummy,
74			    Tcl_Interp *interp, int argc, CONST char **argv);
75static int		TestsetdefencdirCmd(ClientData dummy,
76			    Tcl_Interp *interp, int argc, CONST char **argv);
77int			TclplatformtestInit(Tcl_Interp *interp);
78static int		TestalarmCmd(ClientData dummy,
79			    Tcl_Interp *interp, int argc, CONST char **argv);
80static int		TestgotsigCmd(ClientData dummy,
81			    Tcl_Interp *interp, int argc, CONST char **argv);
82static void		AlarmHandler(int signum);
83static int		TestchmodCmd(ClientData dummy,
84			    Tcl_Interp *interp, int argc, CONST char **argv);
85
86/*
87 *----------------------------------------------------------------------
88 *
89 * TclplatformtestInit --
90 *
91 *	Defines commands that test platform specific functionality for Unix
92 *	platforms.
93 *
94 * Results:
95 *	A standard Tcl result.
96 *
97 * Side effects:
98 *	Defines new commands.
99 *
100 *----------------------------------------------------------------------
101 */
102
103int
104TclplatformtestInit(
105    Tcl_Interp *interp)		/* Interpreter to add commands to. */
106{
107    Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
108	    (ClientData) 0, NULL);
109    Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
110            (ClientData) 0, NULL);
111    Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
112            (ClientData) 0, NULL);
113    Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
114            (ClientData) 0, NULL);
115    Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
116            (ClientData) 0, NULL);
117    Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
118            (ClientData) 0, NULL);
119    Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
120            (ClientData) 0, NULL);
121    Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
122            (ClientData) 0, NULL);
123    Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
124            (ClientData) 0, NULL);
125    return TCL_OK;
126}
127
128/*
129 *----------------------------------------------------------------------
130 *
131 * TestfilehandlerCmd --
132 *
133 *	This function implements the "testfilehandler" command. It is used to
134 *	test Tcl_CreateFileHandler, Tcl_DeleteFileHandler, and TclWaitForFile.
135 *
136 * Results:
137 *	A standard Tcl result.
138 *
139 * Side effects:
140 *	None.
141 *
142 *----------------------------------------------------------------------
143 */
144
145static int
146TestfilehandlerCmd(
147    ClientData clientData,	/* Not used. */
148    Tcl_Interp *interp,		/* Current interpreter. */
149    int argc,			/* Number of arguments. */
150    CONST char **argv)		/* Argument strings. */
151{
152    Pipe *pipePtr;
153    int i, mask, timeout;
154    static int initialized = 0;
155    char buffer[4000];
156    TclFile file;
157
158    /*
159     * NOTE: When we make this code work on Windows also, the following
160     * variable needs to be made Unix-only.
161     */
162
163    if (!initialized) {
164	for (i = 0; i < MAX_PIPES; i++) {
165	    testPipes[i].readFile = NULL;
166	}
167	initialized = 1;
168    }
169
170    if (argc < 2) {
171	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
172                " option ... \"", NULL);
173        return TCL_ERROR;
174    }
175    pipePtr = NULL;
176    if (argc >= 3) {
177	if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) {
178	    return TCL_ERROR;
179	}
180	if (i >= MAX_PIPES) {
181	    Tcl_AppendResult(interp, "bad index ", argv[2], NULL);
182	    return TCL_ERROR;
183	}
184	pipePtr = &testPipes[i];
185    }
186
187    if (strcmp(argv[1], "close") == 0) {
188	for (i = 0; i < MAX_PIPES; i++) {
189	    if (testPipes[i].readFile != NULL) {
190		TclpCloseFile(testPipes[i].readFile);
191		testPipes[i].readFile = NULL;
192		TclpCloseFile(testPipes[i].writeFile);
193		testPipes[i].writeFile = NULL;
194	    }
195	}
196    } else if (strcmp(argv[1], "clear") == 0) {
197	if (argc != 3) {
198	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
199                    argv[0], " clear index\"", NULL);
200	    return TCL_ERROR;
201	}
202	pipePtr->readCount = pipePtr->writeCount = 0;
203    } else if (strcmp(argv[1], "counts") == 0) {
204	char buf[TCL_INTEGER_SPACE * 2];
205
206	if (argc != 3) {
207	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
208                    argv[0], " counts index\"", NULL);
209	    return TCL_ERROR;
210	}
211	sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
212	Tcl_SetResult(interp, buf, TCL_VOLATILE);
213    } else if (strcmp(argv[1], "create") == 0) {
214	if (argc != 5) {
215	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
216                    argv[0], " create index readMode writeMode\"", NULL);
217	    return TCL_ERROR;
218	}
219	if (pipePtr->readFile == NULL) {
220	    if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
221		Tcl_AppendResult(interp, "couldn't open pipe: ",
222			Tcl_PosixError(interp), NULL);
223		return TCL_ERROR;
224	    }
225#ifdef O_NONBLOCK
226	    fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
227	    fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
228#else
229	    Tcl_SetResult(interp, "can't make pipes non-blocking",
230		    TCL_STATIC);
231	    return TCL_ERROR;
232#endif
233	}
234	pipePtr->readCount = 0;
235	pipePtr->writeCount = 0;
236
237	if (strcmp(argv[3], "readable") == 0) {
238	    Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
239		    TestFileHandlerProc, (ClientData) pipePtr);
240	} else if (strcmp(argv[3], "off") == 0) {
241	    Tcl_DeleteFileHandler(GetFd(pipePtr->readFile));
242	} else if (strcmp(argv[3], "disabled") == 0) {
243	    Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0,
244		    TestFileHandlerProc, (ClientData) pipePtr);
245	} else {
246	    Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"", NULL);
247	    return TCL_ERROR;
248	}
249	if (strcmp(argv[4], "writable") == 0) {
250	    Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE,
251		    TestFileHandlerProc, (ClientData) pipePtr);
252	} else if (strcmp(argv[4], "off") == 0) {
253	    Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile));
254	} else if (strcmp(argv[4], "disabled") == 0) {
255	    Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0,
256		    TestFileHandlerProc, (ClientData) pipePtr);
257	} else {
258	    Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"", NULL);
259	    return TCL_ERROR;
260	}
261    } else if (strcmp(argv[1], "empty") == 0) {
262	if (argc != 3) {
263	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
264                    argv[0], " empty index\"", NULL);
265	    return TCL_ERROR;
266	}
267
268        while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
269            /* Empty loop body. */
270        }
271    } else if (strcmp(argv[1], "fill") == 0) {
272	if (argc != 3) {
273	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
274                    argv[0], " fill index\"", NULL);
275	    return TCL_ERROR;
276	}
277
278	memset(buffer, 'a', 4000);
279        while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
280            /* Empty loop body. */
281        }
282    } else if (strcmp(argv[1], "fillpartial") == 0) {
283	char buf[TCL_INTEGER_SPACE];
284
285	if (argc != 3) {
286	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
287                    argv[0], " fillpartial index\"", NULL);
288	    return TCL_ERROR;
289	}
290
291	memset(buffer, 'b', 10);
292	TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
293	Tcl_SetResult(interp, buf, TCL_VOLATILE);
294    } else if (strcmp(argv[1], "oneevent") == 0) {
295	Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
296    } else if (strcmp(argv[1], "wait") == 0) {
297	if (argc != 5) {
298	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
299                    argv[0], " wait index readable|writable timeout\"", NULL);
300	    return TCL_ERROR;
301	}
302	if (pipePtr->readFile == NULL) {
303	    Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist", NULL);
304	    return TCL_ERROR;
305	}
306	if (strcmp(argv[3], "readable") == 0) {
307	    mask = TCL_READABLE;
308	    file = pipePtr->readFile;
309	} else {
310	    mask = TCL_WRITABLE;
311	    file = pipePtr->writeFile;
312	}
313	if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
314	    return TCL_ERROR;
315	}
316	i = TclUnixWaitForFile(GetFd(file), mask, timeout);
317	if (i & TCL_READABLE) {
318	    Tcl_AppendElement(interp, "readable");
319	}
320	if (i & TCL_WRITABLE) {
321	    Tcl_AppendElement(interp, "writable");
322	}
323    } else if (strcmp(argv[1], "windowevent") == 0) {
324	Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT);
325    } else {
326	Tcl_AppendResult(interp, "bad option \"", argv[1],
327		"\": must be close, clear, counts, create, empty, fill, "
328		"fillpartial, oneevent, wait, or windowevent", NULL);
329	return TCL_ERROR;
330    }
331    return TCL_OK;
332}
333
334static void
335TestFileHandlerProc(
336    ClientData clientData,	/* Points to a Pipe structure. */
337    int mask)			/* Indicates which events happened:
338				 * TCL_READABLE or TCL_WRITABLE. */
339{
340    Pipe *pipePtr = (Pipe *) clientData;
341
342    if (mask & TCL_READABLE) {
343	pipePtr->readCount++;
344    }
345    if (mask & TCL_WRITABLE) {
346	pipePtr->writeCount++;
347    }
348}
349
350/*
351 *----------------------------------------------------------------------
352 *
353 * TestfilewaitCmd --
354 *
355 *	This function implements the "testfilewait" command. It is used to
356 *	test TclUnixWaitForFile.
357 *
358 * Results:
359 *	A standard Tcl result.
360 *
361 * Side effects:
362 *	None.
363 *
364 *----------------------------------------------------------------------
365 */
366
367static int
368TestfilewaitCmd(
369    ClientData clientData,	/* Not used. */
370    Tcl_Interp *interp,		/* Current interpreter. */
371    int argc,			/* Number of arguments. */
372    CONST char **argv)		/* Argument strings. */
373{
374    int mask, result, timeout;
375    Tcl_Channel channel;
376    int fd;
377    ClientData data;
378
379    if (argc != 4) {
380	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
381		" file readable|writable|both timeout\"", NULL);
382	return TCL_ERROR;
383    }
384    channel = Tcl_GetChannel(interp, argv[1], NULL);
385    if (channel == NULL) {
386	return TCL_ERROR;
387    }
388    if (strcmp(argv[2], "readable") == 0) {
389	mask = TCL_READABLE;
390    } else if (strcmp(argv[2], "writable") == 0){
391	mask = TCL_WRITABLE;
392    } else if (strcmp(argv[2], "both") == 0){
393	mask = TCL_WRITABLE|TCL_READABLE;
394    } else {
395	Tcl_AppendResult(interp, "bad argument \"", argv[2],
396		"\": must be readable, writable, or both", NULL);
397	return TCL_ERROR;
398    }
399    if (Tcl_GetChannelHandle(channel,
400	    (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
401	    (ClientData*) &data) != TCL_OK) {
402	Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
403	return TCL_ERROR;
404    }
405    fd = PTR2INT(data);
406    if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
407	return TCL_ERROR;
408    }
409    result = TclUnixWaitForFile(fd, mask, timeout);
410    if (result & TCL_READABLE) {
411	Tcl_AppendElement(interp, "readable");
412    }
413    if (result & TCL_WRITABLE) {
414	Tcl_AppendElement(interp, "writable");
415    }
416    return TCL_OK;
417}
418
419/*
420 *----------------------------------------------------------------------
421 *
422 * TestfindexecutableCmd --
423 *
424 *	This function implements the "testfindexecutable" command. It is used
425 *	to test TclpFindExecutable.
426 *
427 * Results:
428 *	A standard Tcl result.
429 *
430 * Side effects:
431 *	None.
432 *
433 *----------------------------------------------------------------------
434 */
435
436static int
437TestfindexecutableCmd(
438    ClientData clientData,	/* Not used. */
439    Tcl_Interp *interp,		/* Current interpreter. */
440    int argc,			/* Number of arguments. */
441    CONST char **argv)		/* Argument strings. */
442{
443    Tcl_Obj *saveName;
444
445    if (argc != 2) {
446	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
447		" argv0\"", NULL);
448	return TCL_ERROR;
449    }
450
451    saveName = TclGetObjNameOfExecutable();
452    Tcl_IncrRefCount(saveName);
453
454    TclpFindExecutable(argv[1]);
455    Tcl_SetObjResult(interp, TclGetObjNameOfExecutable());
456
457    TclSetObjNameOfExecutable(saveName, NULL);
458    Tcl_DecrRefCount(saveName);
459    return TCL_OK;
460}
461
462/*
463 *----------------------------------------------------------------------
464 *
465 * TestgetopenfileCmd --
466 *
467 *	This function implements the "testgetopenfile" command. It is used to
468 *	get a FILE * value from a registered channel.
469 *
470 * Results:
471 *	A standard Tcl result.
472 *
473 * Side effects:
474 *	None.
475 *
476 *----------------------------------------------------------------------
477 */
478
479static int
480TestgetopenfileCmd(
481    ClientData clientData,	/* Not used. */
482    Tcl_Interp *interp,		/* Current interpreter. */
483    int argc,			/* Number of arguments. */
484    CONST char **argv)		/* Argument strings. */
485{
486    ClientData filePtr;
487
488    if (argc != 3) {
489        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
490                " channelName forWriting\"", NULL);
491        return TCL_ERROR;
492    }
493    if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
494            == TCL_ERROR) {
495        return TCL_ERROR;
496    }
497    if (filePtr == (ClientData) NULL) {
498        Tcl_AppendResult(interp,
499                "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL);
500        return TCL_ERROR;
501    }
502    return TCL_OK;
503}
504
505/*
506 *----------------------------------------------------------------------
507 *
508 * TestsetdefencdirCmd --
509 *
510 *	This function implements the "testsetdefenc" command. It is used to
511 *	test Tcl_SetDefaultEncodingDir().
512 *
513 * Results:
514 *	A standard Tcl result.
515 *
516 * Side effects:
517 *	None.
518 *
519 *----------------------------------------------------------------------
520 */
521
522static int
523TestsetdefencdirCmd(
524    ClientData clientData,	/* Not used. */
525    Tcl_Interp *interp,		/* Current interpreter. */
526    int argc,			/* Number of arguments. */
527    CONST char **argv)		/* Argument strings. */
528{
529    if (argc != 2) {
530        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
531                " defaultDir\"", NULL);
532        return TCL_ERROR;
533    }
534
535    Tcl_SetDefaultEncodingDir(argv[1]);
536    return TCL_OK;
537}
538
539/*
540 *----------------------------------------------------------------------
541 *
542 * TestgetdefencdirCmd --
543 *
544 *	This function implements the "testgetdefenc" command. It is used to
545 *	test Tcl_GetDefaultEncodingDir().
546 *
547 * Results:
548 *	A standard Tcl result.
549 *
550 * Side effects:
551 *	None.
552 *
553 *----------------------------------------------------------------------
554 */
555
556static int
557TestgetdefencdirCmd(
558    ClientData clientData,	/* Not used. */
559    Tcl_Interp *interp,		/* Current interpreter. */
560    int argc,			/* Number of arguments. */
561    CONST char **argv)		/* Argument strings. */
562{
563    if (argc != 1) {
564        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL);
565        return TCL_ERROR;
566    }
567
568    Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL);
569    return TCL_OK;
570}
571
572/*
573 *----------------------------------------------------------------------
574 *
575 * TestalarmCmd --
576 *
577 *	Test that EINTR is handled correctly by generating and handling a
578 *	signal. This requires using the SA_RESTART flag when registering the
579 *	signal handler.
580 *
581 * Results:
582 *	None.
583 *
584 * Side Effects:
585 *	Sets up an signal and async handlers.
586 *
587 *----------------------------------------------------------------------
588 */
589
590static int
591TestalarmCmd(
592    ClientData clientData,	/* Not used. */
593    Tcl_Interp *interp,		/* Current interpreter. */
594    int argc,			/* Number of arguments. */
595    CONST char **argv)		/* Argument strings. */
596{
597#ifdef SA_RESTART
598    unsigned int sec;
599    struct sigaction action;
600
601    if (argc > 1) {
602	Tcl_GetInt(interp, argv[1], (int *)&sec);
603    } else {
604	sec = 1;
605    }
606
607    /*
608     * Setup the signal handling that automatically retries any interrupted
609     * I/O system calls.
610     */
611
612    action.sa_handler = AlarmHandler;
613    memset((void *) &action.sa_mask, 0, sizeof(sigset_t));
614    action.sa_flags = SA_RESTART;
615
616    if (sigaction(SIGALRM, &action, NULL) < 0) {
617	Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), NULL);
618	return TCL_ERROR;
619    }
620    (void) alarm(sec);
621    return TCL_OK;
622#else
623    Tcl_AppendResult(interp,
624	    "warning: sigaction SA_RESTART not support on this platform",
625	    NULL);
626    return TCL_ERROR;
627#endif
628}
629
630/*
631 *----------------------------------------------------------------------
632 *
633 * AlarmHandler --
634 *
635 *	Signal handler for the alarm command.
636 *
637 * Results:
638 *	None.
639 *
640 * Side effects:
641 * 	Calls the Tcl Async handler.
642 *
643 *----------------------------------------------------------------------
644 */
645
646static void
647AlarmHandler(
648    int signum)
649{
650    gotsig = "1";
651}
652
653/*
654 *----------------------------------------------------------------------
655 *
656 * TestgotsigCmd --
657 *
658 * 	Verify the signal was handled after the testalarm command.
659 *
660 * Results:
661 *	None.
662 *
663 * Side Effects:
664 *	Resets the value of gotsig back to '0'.
665 *
666 *----------------------------------------------------------------------
667 */
668
669static int
670TestgotsigCmd(
671    ClientData clientData,	/* Not used. */
672    Tcl_Interp *interp,		/* Current interpreter. */
673    int argc,			/* Number of arguments. */
674    CONST char **argv)		/* Argument strings. */
675{
676    Tcl_AppendResult(interp, gotsig, NULL);
677    gotsig = "0";
678    return TCL_OK;
679}
680
681/*
682 *---------------------------------------------------------------------------
683 *
684 * TestchmodCmd --
685 *
686 *	Implements the "testchmod" cmd.  Used when testing "file" command.
687 *	The only attribute used by the Windows platform is the user write
688 *	flag; if this is not set, the file is made read-only.  Otehrwise, the
689 *	file is made read-write.
690 *
691 * Results:
692 *	A standard Tcl result.
693 *
694 * Side effects:
695 *	Changes permissions of specified files.
696 *
697 *---------------------------------------------------------------------------
698 */
699
700static int
701TestchmodCmd(
702    ClientData dummy,			/* Not used. */
703    Tcl_Interp *interp,			/* Current interpreter. */
704    int argc,				/* Number of arguments. */
705    CONST char **argv)			/* Argument strings. */
706{
707    int i, mode;
708    char *rest;
709
710    if (argc < 2) {
711	usage:
712	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
713		" mode file ?file ...?", NULL);
714	return TCL_ERROR;
715    }
716
717    mode = (int) strtol(argv[1], &rest, 8);
718    if ((rest == argv[1]) || (*rest != '\0')) {
719	goto usage;
720    }
721
722    for (i = 2; i < argc; i++) {
723	Tcl_DString buffer;
724	CONST char *translated;
725
726	translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
727	if (translated == NULL) {
728	    return TCL_ERROR;
729	}
730	if (chmod(translated, (unsigned) mode) != 0) {
731	    Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
732		    NULL);
733	    return TCL_ERROR;
734	}
735	Tcl_DStringFree(&buffer);
736    }
737    return TCL_OK;
738}
739