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