1/* 2 * tclXunixOS.c -- 3 * 4 * OS system dependent interface for Unix systems. The idea behind these 5 * functions is to provide interfaces to various functions that vary on the 6 * various platforms. These functions either implement the call in a manner 7 * approriate to the platform or return an error indicating the functionality 8 * is not available on that platform. This results in code with minimal 9 * number of #ifdefs. 10 *----------------------------------------------------------------------------- 11 * Copyright 1996-1999 Karl Lehenbauer and Mark Diekhans. 12 * 13 * Permission to use, copy, modify, and distribute this software and its 14 * documentation for any purpose and without fee is hereby granted, provided 15 * that the above copyright notice appear in all copies. Karl Lehenbauer and 16 * Mark Diekhans make no representations about the suitability of this 17 * software for any purpose. It is provided "as is" without express or 18 * implied warranty. 19 *----------------------------------------------------------------------------- 20 * $Id: tclXunixOS.c,v 8.9 2005/07/12 19:03:15 hobbs Exp $ 21 *----------------------------------------------------------------------------- 22 */ 23 24#include "tclExtdInt.h" 25 26#ifndef NO_GETPRIORITY 27#include <sys/resource.h> 28#endif 29 30/* 31 * Tcl 8.4 had some weird and unnecessary ifdef'ery for readdir 32 * readdir() should be thread-safe according to the Single Unix Spec. 33 * [Bug #1095909] 34 */ 35#ifdef readdir 36#undef readdir 37#endif 38 39/* 40 * Cheat a little to avoid configure checking for floor and ceil being 41 * This breaks with GNU libc headers...really should check with autoconf. 42 */ 43#ifndef __GNU_LIBRARY__ 44extern 45double floor (); 46 47extern 48double ceil (); 49#endif 50 51/* 52 * Prototypes of internal functions. 53 */ 54static int 55ChannelToFnum _ANSI_ARGS_((Tcl_Channel channel, 56 int direction)); 57 58static int 59ConvertOwnerGroup _ANSI_ARGS_((Tcl_Interp *interp, 60 unsigned options, 61 char *ownerStr, 62 char *groupStr, 63 uid_t *ownerId, 64 gid_t *groupId)); 65 66 67/*----------------------------------------------------------------------------- 68 * TclXNotAvailableError -- 69 * Return an error about functionality not being available under Windows. 70 * 71 * Parameters: 72 * o interp - Errors returned in result. 73 * o funcName - Command or other name to use in not available error. 74 * Returns: 75 * TCL_ERROR. 76 *----------------------------------------------------------------------------- 77 */ 78int 79TclXNotAvailableError (interp, funcName) 80 Tcl_Interp *interp; 81 char *funcName; 82{ 83 TclX_AppendObjResult (interp, funcName, " is not available on this system", 84 (char *) NULL); 85 return TCL_ERROR; 86} 87 88/*----------------------------------------------------------------------------- 89 * ChannelToFnum -- 90 * 91 * Convert a channel to a file number. 92 * 93 * Parameters: 94 * o channel - Channel to get file number for. 95 * o direction - TCL_READABLE or TCL_WRITABLE, or zero. If zero, then 96 * return the first of the read and write numbers. 97 * Returns: 98 * The file number or -1 if a file number is not associated with this access 99 * direction. Normally the resulting file number is just passed to a system 100 * call and let the system calls generate an error when -1 is returned. 101 *----------------------------------------------------------------------------- 102 */ 103static int 104ChannelToFnum (channel, direction) 105 Tcl_Channel channel; 106 int direction; 107{ 108 ClientData handle; 109 110 if (direction == 0) { 111 if (Tcl_GetChannelHandle (channel, TCL_READABLE, &handle) != TCL_OK && 112 Tcl_GetChannelHandle (channel, TCL_WRITABLE, &handle) != TCL_OK) { 113 return -1; 114 } 115 } else { 116 if (Tcl_GetChannelHandle (channel, direction, &handle) != TCL_OK) { 117 return -1; 118 } 119 } 120 return (int) handle; 121} 122 123/*----------------------------------------------------------------------------- 124 * TclXOSTicksToMS -- 125 * 126 * Convert clock ticks to milliseconds. 127 * 128 * Parameters: 129 * o numTicks - Number of ticks. 130 * Returns: 131 * Milliseconds. 132 *----------------------------------------------------------------------------- 133 */ 134clock_t 135TclXOSTicksToMS (numTicks) 136 clock_t numTicks; 137{ 138 static clock_t msPerTick = 0; 139 140 /* 141 * Some systems (SVR4) implement CLK_TCK as a call to sysconf, so lets only 142 * reference it once in the life of this process. 143 */ 144 if (msPerTick == 0) 145 msPerTick = CLK_TCK; 146 147 if (msPerTick <= 100) { 148 /* 149 * On low resolution systems we can do this all with integer math. Note 150 * that the addition of half the clock hertz results in appoximate 151 * rounding instead of truncation. 152 */ 153 return (numTicks) * (1000 + msPerTick / 2) / msPerTick; 154 } else { 155 /* 156 * On systems (Cray) where the question is ticks per millisecond, not 157 * milliseconds per tick, we need to use floating point arithmetic. 158 */ 159 return ((numTicks) * 1000.0 / msPerTick); 160 } 161} 162 163/*----------------------------------------------------------------------------- 164 * TclXOSgetpriority -- 165 * System dependent interface to getpriority functionality. 166 * 167 * Parameters: 168 * o interp - Errors returned in result. 169 * o priority - Process priority is returned here. 170 * o funcName - Command or other name to use in not available error. 171 * Results: 172 * TCL_OK or TCL_ERROR. 173 *----------------------------------------------------------------------------- 174 */ 175int 176TclXOSgetpriority (interp, priority, funcName) 177 Tcl_Interp *interp; 178 int *priority; 179 char *funcName; 180{ 181#ifndef NO_GETPRIORITY 182 *priority = getpriority (PRIO_PROCESS, 0); 183#else 184 *priority = nice (0); 185#endif 186 return TCL_OK; 187} 188 189/*----------------------------------------------------------------------------- 190 * TclXOSincrpriority-- 191 * System dependent interface to increment or decrement the current priority. 192 * 193 * Parameters: 194 * o interp - Errors returned in result. 195 * o priorityIncr - Amount to adjust the priority by. 196 * o priority - The new priority.. 197 * o funcName - Command or other name to use in not available error. 198 * Results: 199 * TCL_OK or TCL_ERROR. 200 *----------------------------------------------------------------------------- 201 */ 202int 203TclXOSincrpriority (interp, priorityIncr, priority, funcName) 204 Tcl_Interp *interp; 205 int priorityIncr; 206 int *priority; 207 char *funcName; 208{ 209 errno = 0; /* Old priority might be -1 */ 210 211#ifndef NO_GETPRIORITY 212 *priority = getpriority (PRIO_PROCESS, 0) + priorityIncr; 213 if (errno == 0) { 214 setpriority (PRIO_PROCESS, 0, *priority); 215 } 216#else 217 *priority = nice (priorityIncr); 218#endif 219 if (errno != 0) { 220 TclX_AppendObjResult (interp, "failed to increment priority: ", 221 Tcl_PosixError (interp), (char *) NULL); 222 return TCL_ERROR; 223 } 224 return TCL_OK; 225} 226 227/*----------------------------------------------------------------------------- 228 * TclXOSpipe -- 229 * System dependent interface to create a pipes for the pipe command. 230 * 231 * Parameters: 232 * o interp - Errors returned in result. 233 * o channels - Two element array to return read and write channels in. 234 * Results: 235 * TCL_OK or TCL_ERROR. 236 *----------------------------------------------------------------------------- 237 */ 238int 239TclXOSpipe (interp, channels) 240 Tcl_Interp *interp; 241 Tcl_Channel *channels; 242{ 243 int fileNums [2]; 244 245 if (pipe (fileNums) < 0) { 246 TclX_AppendObjResult (interp, "pipe creation failed: ", 247 Tcl_PosixError (interp), (char *) NULL); 248 return TCL_ERROR; 249 } 250 channels [0] = Tcl_MakeFileChannel ((ClientData) fileNums [0], 251 TCL_READABLE); 252 Tcl_RegisterChannel (interp, channels [0]); 253 254 channels [1] = Tcl_MakeFileChannel ((ClientData) fileNums [1], 255 TCL_WRITABLE); 256 Tcl_RegisterChannel (interp, channels [1]); 257 258 return TCL_OK; 259} 260 261 262/*----------------------------------------------------------------------------- 263 * TclXOSsetitimer -- 264 * System dependent interface to setitimer functionality. 265 * 266 * Parameters: 267 * o interp - Errors returned in result. 268 * o seconds (I/O) - Seconds to pause for, it is updated with the time 269 * remaining on the last alarm. 270 * o funcName - Command or other name to use in not available error. 271 * Results: 272 * TCL_OK or TCL_ERROR. 273 *----------------------------------------------------------------------------- 274 */ 275int 276TclXOSsetitimer (interp, seconds, funcName) 277 Tcl_Interp *interp; 278 double *seconds; 279 char *funcName; 280{ 281/* 282 * A million microseconds per seconds. 283 */ 284#define TCL_USECS_PER_SEC (1000L * 1000L) 285 286#ifndef NO_SETITIMER 287 double secFloor; 288 struct itimerval timer, oldTimer; 289 290 secFloor = floor (*seconds); 291 292 timer.it_value.tv_sec = secFloor; 293 timer.it_value.tv_usec = (long) ((*seconds - secFloor) * 294 (double) TCL_USECS_PER_SEC); 295 timer.it_interval.tv_sec = 0; 296 timer.it_interval.tv_usec = 0; 297 298 if (setitimer (ITIMER_REAL, &timer, &oldTimer) < 0) { 299 TclX_AppendObjResult (interp, "unable to obtain timer: ", 300 Tcl_PosixError (interp), (char *) NULL); 301 return TCL_ERROR; 302 } 303 *seconds = oldTimer.it_value.tv_sec; 304 *seconds += ((double) oldTimer.it_value.tv_usec) / 305 ((double) TCL_USECS_PER_SEC); 306 307 return TCL_OK; 308#else 309 unsigned useconds; 310 311 useconds = ceil (*seconds); 312 *seconds = alarm (useconds); 313 314 return TCL_OK; 315#endif 316} 317 318/*----------------------------------------------------------------------------- 319 * TclXOSsleep -- 320 * System dependent interface to sleep functionality. 321 * 322 * Parameters: 323 * o seconds - Seconds to sleep. 324 *----------------------------------------------------------------------------- 325 */ 326void 327TclXOSsleep (seconds) 328 unsigned seconds; 329{ 330 Tcl_Sleep (seconds*1000); 331} 332 333/*----------------------------------------------------------------------------- 334 * TclXOSsync -- 335 * System dependent interface to sync functionality. 336 *----------------------------------------------------------------------------- 337 */ 338void 339TclXOSsync () 340{ 341 sync (); 342} 343 344/*----------------------------------------------------------------------------- 345 * TclXOSfsync -- 346 * System dependent interface to fsync functionality. Does a sync if fsync 347 * is not available. 348 * 349 * Parameters: 350 * o interp - Errors returned in result. 351 * o channel - The channel to sync. 352 * Results: 353 * TCL_OK or TCL_ERROR. 354 *----------------------------------------------------------------------------- 355 */ 356int 357TclXOSfsync (interp, channel) 358 Tcl_Interp *interp; 359 Tcl_Channel channel; 360{ 361 if (Tcl_Flush (channel) < 0) 362 goto posixError; 363 364#ifndef NO_FSYNC 365 if (fsync (ChannelToFnum (channel, TCL_WRITABLE)) < 0) 366 goto posixError; 367#else 368 sync (); 369#endif 370 return TCL_OK; 371 372 posixError: 373 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 374 Tcl_PosixError (interp), (char *) NULL); 375 return TCL_ERROR; 376} 377 378/*----------------------------------------------------------------------------- 379 * TclXOSsystem -- 380 * System dependent interface to system functionality (executing a command 381 * with the standard system shell). 382 * 383 * Parameters: 384 * o interp - Errors returned in result. 385 * o command - Command to execute. 386 * o exitCode - Exit code of the child process. 387 * Results: 388 * TCL_OK or TCL_ERROR. 389 *----------------------------------------------------------------------------- 390 */ 391int 392TclXOSsystem (interp, command, exitCode) 393 Tcl_Interp *interp; 394 char *command; 395 int *exitCode; 396{ 397 int errPipes [2], childErrno; 398 pid_t pid; 399 WAIT_STATUS_TYPE waitStatus; 400 401 errPipes [0] = errPipes [1] = -1; 402 403 /* 404 * Create a close on exec pipe to get status back from the child if 405 * the exec fails. 406 */ 407 if (pipe (errPipes) != 0) { 408 TclX_AppendObjResult (interp, "couldn't create pipe: ", 409 Tcl_PosixError (interp), (char *) NULL); 410 goto errorExit; 411 } 412 if (fcntl (errPipes [1], F_SETFD, FD_CLOEXEC) != 0) { 413 TclX_AppendObjResult (interp, "couldn't set close on exec for pipe: ", 414 Tcl_PosixError (interp), (char *) NULL); 415 goto errorExit; 416 } 417 418 pid = fork (); 419 if (pid == -1) { 420 TclX_AppendObjResult (interp, "couldn't fork child process: ", 421 Tcl_PosixError (interp), (char *) NULL); 422 goto errorExit; 423 } 424 if (pid == 0) { 425 close (errPipes [0]); 426 execl ("/bin/sh", "sh", "-c", command, (char *) NULL); 427 write (errPipes [1], &errno, sizeof (errno)); 428 _exit (127); 429 } 430 431 close (errPipes [1]); 432 if (read (errPipes [0], &childErrno, sizeof (childErrno)) > 0) { 433 errno = childErrno; 434 TclX_AppendObjResult (interp, "couldn't execing /bin/sh: ", 435 Tcl_PosixError (interp), (char *) NULL); 436 waitpid (pid, (int *) &waitStatus, 0); 437 goto errorExit; 438 } 439 close (errPipes [0]); 440 441 if (waitpid (pid, (int *) &waitStatus, 0) < 0) { 442 TclX_AppendObjResult (interp, "wait failed: ", 443 Tcl_PosixError (interp), (char *) NULL); 444 return TCL_ERROR; 445 } 446 447 /* 448 * Return status based on wait result. 449 */ 450 if (WIFEXITED (waitStatus)) { 451 *exitCode = WEXITSTATUS (waitStatus); 452 return TCL_OK; 453 } 454 455 if (WIFSIGNALED (waitStatus)) { 456 Tcl_SetErrorCode (interp, "SYSTEM", "SIG", 457 Tcl_SignalId (WTERMSIG (waitStatus)), (char *) NULL); 458 TclX_AppendObjResult (interp, "system command terminate with signal ", 459 Tcl_SignalId (WTERMSIG (waitStatus)), 460 (char *) NULL); 461 return TCL_ERROR; 462 } 463 464 /* 465 * Should never get this status back unless the implementation is 466 * really brain-damaged. 467 */ 468 if (WIFSTOPPED (waitStatus)) { 469 TclX_AppendObjResult (interp, "system command child stopped", 470 (char *) NULL); 471 return TCL_ERROR; 472 } 473 474 errorExit: 475 close (errPipes [0]); 476 close (errPipes [1]); 477 return TCL_ERROR; 478} 479 480/*----------------------------------------------------------------------------- 481 * TclX_OSlink -- 482 * System dependent interface to link functionality. 483 * 484 * Parameters: 485 * o interp - Errors returned in result. 486 * o srcPath - File to link. 487 * o targetPath - Path to new link. 488 * o funcName - Command or other name to use in not available error. 489 * Results: 490 * TCL_OK or TCL_ERROR. 491 *----------------------------------------------------------------------------- 492 */ 493int 494TclX_OSlink (interp, srcPath, targetPath, funcName) 495 Tcl_Interp *interp; 496 char *srcPath; 497 char *targetPath; 498 char *funcName; 499{ 500 if (link (srcPath, targetPath) != 0) { 501 TclX_AppendObjResult (interp, "linking \"", srcPath, "\" to \"", 502 targetPath, "\" failed: ", 503 Tcl_PosixError (interp), (char *) NULL); 504 return TCL_ERROR; 505 } 506 return TCL_OK; 507} 508 509/*----------------------------------------------------------------------------- 510 * TclX_OSsymlink -- 511 * System dependent interface to symlink functionality. 512 * 513 * Parameters: 514 * o interp - Errors returned in result. 515 * o srcPath - Value of symbolic link. 516 * o targetPath - Path to new symbolic link. 517 * o funcName - Command or other name to use in not available error. 518 * Results: 519 * TCL_OK or TCL_ERROR. 520 *----------------------------------------------------------------------------- 521 */ 522int 523TclX_OSsymlink (interp, srcPath, targetPath, funcName) 524 Tcl_Interp *interp; 525 char *srcPath; 526 char *targetPath; 527 char *funcName; 528{ 529#ifdef S_IFLNK 530 if (symlink (srcPath, targetPath) != 0) { 531 TclX_AppendObjResult (interp, "creating symbolic link \"", 532 targetPath, "\" failed: ", 533 Tcl_PosixError (interp), (char *) NULL); 534 return TCL_ERROR; 535 } 536 return TCL_OK; 537#else 538 TclX_AppendObjResult (interp, 539 "symbolic links are not supported on this", 540 " Unix system", (char *) NULL); 541 return TCL_ERROR; 542#endif 543} 544 545/*----------------------------------------------------------------------------- 546 * TclXOSElapsedTime -- 547 * System dependent interface to get the elapsed CPU and real time. 548 * 549 * Parameters: 550 * o realTime - Elapsed real time, in milliseconds is returned here. 551 * o cpuTime - Elapsed CPU time, in milliseconds is returned here. 552 *----------------------------------------------------------------------------- 553 */ 554void 555TclXOSElapsedTime (realTime, cpuTime) 556 clock_t *realTime; 557 clock_t *cpuTime; 558{ 559/* 560 * If times returns elapsed real time, this is easy. If it returns a status, 561 * real time must be obtained in other ways. 562 */ 563#ifndef TIMES_RETS_STATUS 564 struct tms cpuTimes; 565 566 *realTime = TclXOSTicksToMS (times (&cpuTimes)); 567 *cpuTime = TclXOSTicksToMS (cpuTimes.tms_utime + cpuTimes.tms_stime); 568#else 569 static struct timeval startTime = {0, 0}; 570 struct timeval currentTime; 571 struct tms cpuTimes; 572 573 /* 574 * If this is the first call, get base time. 575 */ 576 if ((startTime.tv_sec == 0) && (startTime.tv_usec == 0)) 577 gettimeofday (&startTime, NULL); 578 579 gettimeofday (¤tTime, NULL); 580 currentTime.tv_sec = currentTime.tv_sec - startTime.tv_sec; 581 currentTime.tv_usec = currentTime.tv_usec - startTime.tv_usec; 582 *realTime = (currentTime.tv_sec * 1000) + (currentTime.tv_usec / 1000); 583 times (&cpuTimes); 584 *cpuTime = TclXOSTicksToMS (cpuTimes.tms_utime + cpuTimes.tms_stime); 585#endif 586} 587 588/*----------------------------------------------------------------------------- 589 * TclXOSkill -- 590 * System dependent interface to send a signal to a process. 591 * 592 * Parameters: 593 * o interp - Errors returned in result. 594 * o pid - Process id, negative process group, etc. 595 * o signal - Signal to send. 596 * o funcName - Command or other name to use in not available error. 597 * Results: 598 * TCL_OK or TCL_ERROR. 599 *----------------------------------------------------------------------------- 600 */ 601int 602TclXOSkill (interp, pid, signal, funcName) 603 Tcl_Interp *interp; 604 pid_t pid; 605 int signal; 606 char *funcName; 607{ 608 if (kill (pid, signal) < 0) { 609 char pidStr [32]; 610 611 TclX_AppendObjResult (interp, "sending signal ", 612 (signal == 0) ? 0 : Tcl_SignalId (signal), 613 (char *) NULL); 614 if (pid > 0) { 615 sprintf (pidStr, "%d", pid); 616 TclX_AppendObjResult (interp, " to process ", pidStr, 617 (char *) NULL); 618 } else if (pid == 0) { 619 sprintf (pidStr, "%d", getpgrp ()); 620 TclX_AppendObjResult (interp, " to current process group (", 621 pidStr, ")", (char *) NULL); 622 } else if (pid == -1) { 623 TclX_AppendObjResult (interp, " to all processess ", 624 (char *) NULL); 625 } else if (pid < -1) { 626 sprintf (pidStr, "%d", -pid); 627 TclX_AppendObjResult (interp, " to process group ", 628 pidStr, (char *) NULL); 629 } 630 TclX_AppendObjResult (interp, " failed: ", 631 Tcl_PosixError (interp), (char *) NULL); 632 return TCL_ERROR; 633 } 634 return TCL_OK; 635} 636 637/*----------------------------------------------------------------------------- 638 * TclXOSFstat -- 639 * System dependent interface to get status information on an open file. 640 * 641 * Parameters: 642 * o interp - Errors are returned in result. 643 * o channel - Channel to get the status of. 644 * o statBuf - Status information, made to look as much like Unix as 645 * possible. 646 * o ttyDev - If not NULL, a boolean indicating if the device is 647 * associated with a tty. 648 * Results: 649 * TCL_OK or TCL_ERROR. 650 *----------------------------------------------------------------------------- 651 */ 652int 653TclXOSFstat (interp, channel, statBuf, ttyDev) 654 Tcl_Interp *interp; 655 Tcl_Channel channel; 656 struct stat *statBuf; 657 int *ttyDev; 658{ 659 int fileNum = ChannelToFnum (channel, 0); 660 661 if (fstat (fileNum, statBuf) < 0) { 662 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 663 Tcl_PosixError (interp), (char *) NULL); 664 return TCL_ERROR; 665 } 666 if (ttyDev != NULL) 667 *ttyDev = isatty (fileNum); 668 return TCL_OK; 669} 670 671/*----------------------------------------------------------------------------- 672 * TclXOSSeakable -- 673 * System dependent interface to determine if a channel is seekable. 674 * 675 * Parameters: 676 * o interp - Errors are returned in result. 677 * o channel - Channel to get the status of. 678 * o seekable - TRUE is return if seekable, FALSE if not. 679 * Results: 680 * TCL_OK or TCL_ERROR. 681 *----------------------------------------------------------------------------- 682 */ 683int 684TclXOSSeekable (interp, channel, seekablePtr) 685 Tcl_Interp *interp; 686 Tcl_Channel channel; 687 int *seekablePtr; 688{ 689 struct stat statBuf; 690 int fileNum = ChannelToFnum (channel, TCL_READABLE); 691 692 if (fileNum < 0) { 693 *seekablePtr = FALSE; 694 return TCL_OK; 695 } 696 697 if (fstat (fileNum, &statBuf) < 0) { 698 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 699 Tcl_PosixError (interp), (char *) NULL); 700 return TCL_ERROR; 701 } 702 if (S_ISREG (statBuf.st_mode)) { 703 *seekablePtr = TRUE; 704 } else { 705 *seekablePtr = FALSE; 706 } 707 return TCL_OK; 708} 709 710/*----------------------------------------------------------------------------- 711 * TclXOSWalkDir -- 712 * System dependent interface to reading the contents of a directory. The 713 * specified directory is walked and a callback is called on each entry. 714 * The "." and ".." entries are skipped. 715 * 716 * Parameters: 717 * o interp - Interp to return errors in. 718 * o path - Path to the directory. 719 * o hidden - Include hidden files. Ignored on Unix. 720 * o callback - Callback function to call on each directory entry. 721 * It should return TCL_OK to continue processing, TCL_ERROR if an 722 * error occured and TCL_BREAK to stop processing. The parameters are: 723 * o interp - Interp is passed though. 724 * o path - Normalized path to directory. 725 * o fileName - Tcl normalized file name in directory. 726 * o caseSensitive - Are the file names case sensitive? Always 727 * TRUE on Unix. 728 * o clientData - Client data that was passed. 729 * o clientData - Client data to pass to callback. 730 * Results: 731 * TCL_OK if completed directory walk. TCL_BREAK if callback returned 732 * TCL_BREAK and TCL_ERROR if an error occured. 733 *----------------------------------------------------------------------------- 734*/ 735int 736TclXOSWalkDir (interp, path, hidden, callback, clientData) 737 Tcl_Interp *interp; 738 char *path; 739 int hidden; 740 TclX_WalkDirProc *callback; 741 ClientData clientData; 742{ 743 DIR *handle; 744 struct dirent *entryPtr; 745 int result = TCL_OK; 746 747 handle = opendir (path); 748 if (handle == NULL) { 749 if (interp != NULL) 750 TclX_AppendObjResult (interp, "open of directory \"", path, 751 "\" failed: ", Tcl_PosixError (interp), 752 (char *) NULL); 753 return TCL_ERROR; 754 } 755 756 while (TRUE) { 757 entryPtr = readdir (handle); 758 if (entryPtr == NULL) { 759 break; 760 } 761 if (entryPtr->d_name [0] == '.') { 762 if (entryPtr->d_name [1] == '\0') 763 continue; 764 if ((entryPtr->d_name [1] == '.') && 765 (entryPtr->d_name [2] == '\0')) 766 continue; 767 } 768 result = (*callback) (interp, path, entryPtr->d_name, 769 TRUE, clientData); 770 if (!((result == TCL_OK) || (result == TCL_CONTINUE))) 771 break; 772 } 773 if (result == TCL_ERROR) { 774 closedir (handle); 775 return TCL_ERROR; 776 } 777 if (closedir (handle) < 0) { 778 if (interp != NULL) 779 TclX_AppendObjResult (interp, "close of directory failed: ", 780 Tcl_PosixError (interp), (char *) NULL); 781 return TCL_ERROR; 782 } 783 return result; 784} 785 786/*----------------------------------------------------------------------------- 787 * TclXOSGetFileSize -- 788 * System dependent interface to get the size of an open file. 789 * 790 * Parameters: 791 * o channel - Channel. 792 * o fileSize - File size is returned here. 793 * Results: 794 * TCL_OK or TCL_ERROR. A POSIX error will be set. 795 *----------------------------------------------------------------------------- 796 */ 797int 798TclXOSGetFileSize (channel, fileSize) 799 Tcl_Channel channel; 800 off_t *fileSize; 801{ 802 struct stat statBuf; 803 804 if (fstat (ChannelToFnum (channel, 0), &statBuf)) { 805 return TCL_ERROR; 806 } 807 *fileSize = statBuf.st_size; 808 return TCL_OK; 809} 810 811/*----------------------------------------------------------------------------- 812 * TclXOSftruncate -- 813 * System dependent interface to ftruncate functionality. 814 * 815 * Parameters: 816 * o interp - Error messages are returned in the interpreter. 817 * o channel - Channel to truncate. 818 * o newSize - Size to truncate the file to. 819 * o funcName - Command or other name to use in not available error. 820 * Returns: 821 * TCL_OK or TCL_ERROR. 822 *----------------------------------------------------------------------------- 823 */ 824int 825TclXOSftruncate (interp, channel, newSize, funcName) 826 Tcl_Interp *interp; 827 Tcl_Channel channel; 828 off_t newSize; 829 char *funcName; 830{ 831#if (!defined(NO_FTRUNCATE)) || defined(HAVE_CHSIZE) 832 int stat; 833 834#ifndef NO_FTRUNCATE 835 stat = ftruncate (ChannelToFnum (channel, 0), newSize); 836#else 837 stat = chsize (ChannelToFnum (channel, 0), newSize); 838#endif 839 if (stat != 0) { 840 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 841 Tcl_PosixError (interp), (char *) NULL); 842 return TCL_ERROR; 843 } 844 return TCL_OK; 845#else 846 return TclXNotAvailableError (interp, funcName); 847#endif 848} 849 850/*----------------------------------------------------------------------------- 851 * TclXOSfork -- 852 * System dependent interface to fork functionality. 853 * 854 * Parameters: 855 * o interp - A format process id or errors are returned in result. 856 * o funcName - Command or other name to use in not available error. 857 * Results: 858 * TCL_OK or TCL_ERROR. 859 *----------------------------------------------------------------------------- 860 */ 861int 862TclXOSfork (interp, funcNameObj) 863 Tcl_Interp *interp; 864 Tcl_Obj *funcNameObj; 865{ 866 pid_t pid; 867 868 pid = fork (); 869 if (pid < 0) { 870 TclX_AppendObjResult (interp, "fork failed: ", 871 Tcl_PosixError (interp), (char *) NULL); 872 return TCL_ERROR; 873 } 874 875 Tcl_SetIntObj (Tcl_GetObjResult (interp), (int)pid); 876 return TCL_OK; 877} 878 879/*----------------------------------------------------------------------------- 880 * TclXOSexecl -- 881 * System dependent interface to execl functionality. 882 * 883 * Parameters: 884 * o interp - Errors are returned in result. 885 * o path - Path to the program. 886 * o argList - NULL terminated argument vector. 887 * Results: 888 * TCL_ERROR or does not return. 889 *----------------------------------------------------------------------------- 890 */ 891int 892TclXOSexecl (interp, path, argList) 893 Tcl_Interp *interp; 894 char *path; 895 char **argList; 896{ 897 execvp (path, argList); 898 899 /* 900 * Can only make it here on an error. 901 */ 902 TclX_AppendObjResult (interp, "exec of \"", path, "\" failed: ", 903 Tcl_PosixError (interp), (char *) NULL); 904 return TCL_ERROR; 905} 906 907/*----------------------------------------------------------------------------- 908 * TclXOSInetAtoN -- 909 * 910 * Convert an internet address to an "struct in_addr" representation. 911 * 912 * Parameters: 913 * o interp - If not NULL, an error message is return in the result. 914 * If NULL, no error message is generated. 915 * o strAddress - String address to convert. 916 * o inAddress - Converted internet address is returned here. 917 * Returns: 918 * TCL_OK or TCL_ERROR. 919 *----------------------------------------------------------------------------- 920 */ 921int 922TclXOSInetAtoN (interp, strAddress, inAddress) 923 Tcl_Interp *interp; 924 char *strAddress; 925 struct in_addr *inAddress; 926{ 927#ifndef NO_INET_ATON 928 if (inet_aton (strAddress, inAddress)) 929 return TCL_OK; 930#else 931 inAddress->s_addr = inet_addr (strAddress); 932 if (inAddress->s_addr != INADDR_NONE) 933 return TCL_OK; 934#endif 935 if (interp != NULL) { 936 TclX_AppendObjResult (interp, "malformed address: \"", 937 strAddress, "\"", (char *) NULL); 938 } 939 return TCL_ERROR; 940} 941 942/*----------------------------------------------------------------------------- 943 * TclXOSgetpeername -- 944 * System dependent interface to getpeername functionality. 945 * 946 * Parameters: 947 * o interp - Errors are returned in result. 948 * o channel - Channel associated with the socket. 949 * o sockaddr - Pointer to sockaddr structure. 950 * o sockaddrSize - Size of the sockaddr struct. 951 * Results: 952 * TCL_OK or TCL_ERROR, sets a posix error. 953 *----------------------------------------------------------------------------- 954 */ 955int 956TclXOSgetpeername (interp, channel, sockaddr, sockaddrSize) 957 Tcl_Interp *interp; 958 Tcl_Channel channel; 959 void *sockaddr; 960 int sockaddrSize; 961{ 962 963 if (getpeername (ChannelToFnum (channel, 0), 964 (struct sockaddr *) sockaddr, &sockaddrSize) < 0) { 965 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 966 Tcl_PosixError (interp), (char *) NULL); 967 return TCL_ERROR; 968 } 969 return TCL_OK; 970} 971 972/*----------------------------------------------------------------------------- 973 * TclXOSgetsockname -- 974 * System dependent interface to getsockname functionality. 975 * 976 * Parameters: 977 * o interp - Errors are returned in result. 978 * o channel - Channel associated with the socket. 979 * o sockaddr - Pointer to sockaddr structure. 980 * o sockaddrSize - Size of the sockaddr struct. 981 * Results: 982 * TCL_OK or TCL_ERROR, sets a posix error. 983 *----------------------------------------------------------------------------- 984 */ 985int 986TclXOSgetsockname (interp, channel, sockaddr, sockaddrSize) 987 Tcl_Interp *interp; 988 Tcl_Channel channel; 989 void *sockaddr; 990 int sockaddrSize; 991{ 992 if (getsockname (ChannelToFnum (channel, 0), 993 (struct sockaddr *) sockaddr, &sockaddrSize) < 0) { 994 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 995 Tcl_PosixError (interp), (char *) NULL); 996 return TCL_ERROR; 997 } 998 return TCL_OK; 999} 1000 1001/*----------------------------------------------------------------------------- 1002 * TclXOSgetsockopt -- 1003 * Get the value of a integer socket option. 1004 * 1005 * Parameters: 1006 * o interp - Errors are returned in the result. 1007 * o channel - Channel associated with the socket. 1008 * o option - Socket option to get. 1009 * o valuePtr - Integer value is returned here. 1010 * Returns: 1011 * TCL_OK or TCL_ERROR. 1012 *----------------------------------------------------------------------------- 1013 */ 1014int 1015TclXOSgetsockopt (interp, channel, option, valuePtr) 1016 Tcl_Interp *interp; 1017 Tcl_Channel channel; 1018 int option; 1019 int *valuePtr; 1020{ 1021 int valueLen = sizeof (*valuePtr); 1022 1023 if (getsockopt (ChannelToFnum (channel, 0), SOL_SOCKET, option, 1024 (void*) valuePtr, &valueLen) != 0) { 1025 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 1026 Tcl_PosixError (interp), (char *) NULL); 1027 return TCL_ERROR; 1028 } 1029 return TCL_OK; 1030} 1031 1032/*----------------------------------------------------------------------------- 1033 * TclXOSsetsockopt -- 1034 * Set the value of a integer socket option. 1035 * 1036 * Parameters: 1037 * o interp - Errors are returned in the result. 1038 * o channel - Channel associated with the socket. 1039 * o option - Socket option to get. 1040 * o value - Valid integer value for the option. 1041 * Returns: 1042 * TCL_OK or TCL_ERROR. 1043 *----------------------------------------------------------------------------- 1044 */ 1045int 1046TclXOSsetsockopt (interp, channel, option, value) 1047 Tcl_Interp *interp; 1048 Tcl_Channel channel; 1049 int option; 1050 int value; 1051{ 1052 int valueLen = sizeof (value); 1053 1054 if (setsockopt (ChannelToFnum (channel, 0), SOL_SOCKET, option, 1055 (void*) &value, valueLen) != 0) { 1056 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 1057 Tcl_PosixError (interp), (char *) NULL); 1058 return TCL_ERROR; 1059 } 1060 return TCL_OK; 1061} 1062 1063/*----------------------------------------------------------------------------- 1064 * TclXOSchmod -- 1065 * System dependent interface to chmod functionality. 1066 * 1067 * Parameters: 1068 * o interp - Errors returned in result. 1069 * o fileName - Name of to set the mode on. 1070 * o mode - New, unix style file access mode. 1071 * Results: 1072 * TCL_OK or TCL_ERROR. 1073 *----------------------------------------------------------------------------- 1074 */ 1075int 1076TclXOSchmod (interp, fileName, mode) 1077 Tcl_Interp *interp; 1078 char *fileName; 1079 int mode; 1080{ 1081 if (chmod (fileName, mode) < 0) { 1082 TclX_AppendObjResult (interp, fileName, ": ", 1083 Tcl_PosixError (interp), (char *) NULL); 1084 return TCL_ERROR; 1085 } 1086 return TCL_OK; 1087} 1088 1089/*----------------------------------------------------------------------------- 1090 * TclXOSfchmod -- 1091 * System dependent interface to fchmod functionality. 1092 * 1093 * Parameters: 1094 * o interp - Errors returned in result. 1095 * o channel - Channel to set the mode on. 1096 * o mode - New, unix style file access mode. 1097 * o funcName - Command or other string to use in not available error. 1098 * Results: 1099 * TCL_OK or TCL_ERROR. 1100 *----------------------------------------------------------------------------- 1101 */ 1102int 1103TclXOSfchmod (interp, channel, mode, funcName) 1104 Tcl_Interp *interp; 1105 Tcl_Channel channel; 1106 int mode; 1107 char *funcName; 1108{ 1109#ifndef NO_FCHMOD 1110 if (fchmod (ChannelToFnum (channel, 0), mode) < 0) { 1111 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 1112 Tcl_PosixError (interp), (char *) NULL); 1113 return TCL_ERROR; 1114 } 1115 return TCL_OK; 1116#else 1117 return TclXNotAvailableError (interp, funcName); 1118#endif 1119} 1120 1121/*----------------------------------------------------------------------------- 1122 * ConvertOwnerGroup -- 1123 * Convert the owner and group specification to ids. 1124 * 1125 * Parameters: 1126 * o interp - Pointer to the current interpreter, error messages will be 1127 * returned in the result. 1128 * o options - Option flags are: 1129 * o TCLX_CHOWN - Change file's owner. 1130 * o TCLX_CHGRP - Change file's group. 1131 * o ownerStr - String containing owner name or id. NULL if TCLX_CHOWN 1132 * not specified. 1133 * o groupStr - String containing owner name or id. NULL if TCLX_CHOWN 1134 * not specified. If NULL and TCLX_CHOWN is specified, the user's group 1135 * is used. 1136 * o ownerId - Owner id is returned here. 1137 * o groupId - Group id is returned here. 1138 * Returns: 1139 * TCL_OK or TCL_ERROR. 1140 *----------------------------------------------------------------------------- 1141 */ 1142static int 1143ConvertOwnerGroup (interp, options, ownerStr, groupStr, ownerId, groupId) 1144 Tcl_Interp *interp; 1145 unsigned options; 1146 char *ownerStr; 1147 char *groupStr; 1148 uid_t *ownerId; 1149 gid_t *groupId; 1150{ 1151 struct passwd *passwdPtr = NULL; 1152 struct group *groupPtr = NULL; 1153 int tmpId; 1154 1155 if (options & TCLX_CHOWN) { 1156 passwdPtr = getpwnam (ownerStr); 1157 if (passwdPtr != NULL) { 1158 *ownerId = passwdPtr->pw_uid; 1159 } else { 1160 if (!TclX_StrToInt (ownerStr, 10, &tmpId)) 1161 goto unknownUser; 1162 /* 1163 * Check for overflow. 1164 */ 1165 *ownerId = tmpId; 1166 if ((int) (*ownerId) != tmpId) 1167 goto unknownUser; 1168 } 1169 } 1170 1171 if (options & TCLX_CHGRP) { 1172 if (groupStr == NULL) { 1173 if (passwdPtr == NULL) { 1174 passwdPtr = getpwuid (*ownerId); 1175 if (passwdPtr == NULL) 1176 goto noGroupForUser; 1177 } 1178 *groupId = passwdPtr->pw_gid; 1179 } else { 1180 groupPtr = getgrnam (groupStr); 1181 if (groupPtr != NULL) { 1182 *groupId = groupPtr->gr_gid; 1183 } else { 1184 if (!TclX_StrToInt (groupStr, 10, &tmpId)) 1185 goto unknownGroup; 1186 /* 1187 * Check for overflow. 1188 */ 1189 *groupId = tmpId; 1190 if ((int) (*groupId) != tmpId) 1191 goto unknownGroup; 1192 } 1193 } 1194 } 1195 1196 endpwent (); 1197 return TCL_OK; 1198 1199 unknownUser: 1200 TclX_AppendObjResult (interp, "unknown user id: ", 1201 ownerStr, (char *) NULL); 1202 goto errorExit; 1203 1204 noGroupForUser: 1205 TclX_AppendObjResult (interp, "can't find group for user id: ", 1206 ownerStr, (char *) NULL); 1207 goto errorExit; 1208 1209 unknownGroup: 1210 TclX_AppendObjResult (interp, "unknown group id: ", groupStr, 1211 (char *) NULL); 1212 goto errorExit; 1213 1214 errorExit: 1215 endpwent (); 1216 return TCL_ERROR; 1217} 1218 1219/*----------------------------------------------------------------------------- 1220 * TclXOSChangeOwnGrpObj -- 1221 * Change the owner and/or group of a file by file name. 1222 * 1223 * Parameters: 1224 * o interp - Pointer to the current interpreter, error messages will be 1225 * returned in the result. 1226 * o options - Option flags are: 1227 * o TCLX_CHOWN - Change file's owner. 1228 * o TCLX_CHGRP - Change file's group. 1229 * o ownerStr - String containing owner name or id. NULL if TCLX_CHOWN 1230 * not specified. 1231 * o groupStr - String containing owner name or id. NULL if TCLX_CHOWN 1232 * not specified. If NULL and TCLX_CHOWN is specified, the user's group 1233 * is used. 1234 * o files - NULL terminated list of file names. 1235 * o funcName - Command or other name to use in not available error. 1236 * Returns: 1237 * TCL_OK or TCL_ERROR. 1238 *----------------------------------------------------------------------------- 1239 */ 1240int 1241TclXOSChangeOwnGrpObj (interp, options, ownerStr, groupStr, fileListObj, funcName) 1242 Tcl_Interp *interp; 1243 unsigned options; 1244 char *ownerStr; 1245 char *groupStr; 1246 Tcl_Obj *fileListObj; 1247 char *funcName; 1248{ 1249 int idx; 1250 struct stat fileStat; 1251 uid_t ownerId; 1252 gid_t groupId; 1253 char *filePath; 1254 Tcl_DString pathBuf; 1255 char *fileNameString; 1256 Tcl_Obj **filesObjv; 1257 int fileCount; 1258 1259 if (ConvertOwnerGroup (interp, options, ownerStr, groupStr, 1260 &ownerId, &groupId) != TCL_OK) 1261 return TCL_ERROR; 1262 1263 if (Tcl_ListObjGetElements (interp, fileListObj, &fileCount, &filesObjv) 1264 != TCL_OK) 1265 return TCL_ERROR; 1266 1267 Tcl_DStringInit (&pathBuf); 1268 1269 for (idx = 0; idx < fileCount; idx++) { 1270 fileNameString = Tcl_GetStringFromObj (filesObjv [idx], NULL); 1271 filePath = Tcl_TranslateFileName (interp, fileNameString, &pathBuf); 1272 if (filePath == NULL) { 1273 Tcl_DStringFree (&pathBuf); 1274 return TCL_ERROR; 1275 } 1276 1277 /* 1278 * If we are not changing both owner and group, we need to get the 1279 * old ids. 1280 */ 1281 if ((options & (TCLX_CHOWN | TCLX_CHGRP)) != 1282 (TCLX_CHOWN | TCLX_CHGRP)) { 1283 if (stat (filePath, &fileStat) != 0) 1284 goto fileError; 1285 if ((options & TCLX_CHOWN) == 0) 1286 ownerId = fileStat.st_uid; 1287 if ((options & TCLX_CHGRP) == 0) 1288 groupId = fileStat.st_gid; 1289 } 1290 if (chown (filePath, ownerId, groupId) < 0) 1291 goto fileError; 1292 } 1293 return TCL_OK; 1294 1295 fileError: 1296 TclX_AppendObjResult (interp, filePath, ": ", 1297 Tcl_PosixError (interp), (char *) NULL); 1298 Tcl_DStringFree (&pathBuf); 1299 return TCL_ERROR; 1300} 1301 1302/*----------------------------------------------------------------------------- 1303 * TclXOSFChangeOwnGrpObj -- 1304 * Change the owner and/or group of a file by open channel. 1305 * 1306 * Parameters: 1307 * o interp - Pointer to the current interpreter, error messages will be 1308 * returned in the result. 1309 * o options - Option flags are: 1310 * o TCLX_CHOWN - Change file's owner. 1311 * o TCLX_CHGRP - Change file's group. 1312 * o ownerStr - String containing owner name or id. NULL if TCLX_CHOWN 1313 * not specified. 1314 * o groupStr - String containing owner name or id. NULL if TCLX_CHOWN 1315 * not specified. If NULL and TCLX_CHOWN is specified, the user's group 1316 * is used. 1317 * o channelIds - NULL terminated list of channel ids. 1318 * o funcName - Command or other name to use in not available error. 1319 * Returns: 1320 * TCL_OK or TCL_ERROR. 1321 *----------------------------------------------------------------------------- 1322 */ 1323int 1324TclXOSFChangeOwnGrpObj (interp, options, ownerStr, groupStr, channelIdsObj, 1325 funcName) 1326 Tcl_Interp *interp; 1327 unsigned options; 1328 char *ownerStr; 1329 char *groupStr; 1330 Tcl_Obj *channelIdsObj; 1331 char *funcName; 1332{ 1333#ifndef NO_FCHOWN 1334 int idx, fnum; 1335 struct stat fileStat; 1336 uid_t ownerId; 1337 gid_t groupId; 1338 Tcl_Channel channel; 1339 Tcl_Obj **channelIdsListObj; 1340 int channelCount; 1341 1342 if (ConvertOwnerGroup (interp, options, ownerStr, groupStr, 1343 &ownerId, &groupId) != TCL_OK) 1344 return TCL_ERROR; 1345 1346 if (Tcl_ListObjGetElements (interp, channelIdsObj, 1347 &channelCount, &channelIdsListObj) != TCL_OK) 1348 return TCL_ERROR; 1349 1350 for (idx = 0; idx < channelCount; idx++) { 1351 channel = TclX_GetOpenChannelObj (interp, channelIdsListObj [idx], 0); 1352 if (channel == NULL) { 1353 return TCL_ERROR; 1354 } 1355 fnum = ChannelToFnum (channel, 0); 1356 1357 /* 1358 * If we are not changing both owner and group, we need to get the 1359 * old ids. 1360 */ 1361 if ((options & (TCLX_CHOWN | TCLX_CHGRP)) != 1362 (TCLX_CHOWN | TCLX_CHGRP)) { 1363 if (fstat (fnum, &fileStat) != 0) 1364 goto fileError; 1365 if ((options & TCLX_CHOWN) == 0) 1366 ownerId = fileStat.st_uid; 1367 if ((options & TCLX_CHGRP) == 0) 1368 groupId = fileStat.st_gid; 1369 } 1370 if (fchown (fnum, ownerId, groupId) < 0) 1371 goto fileError; 1372 } 1373 return TCL_OK; 1374 1375 fileError: 1376 TclX_AppendObjResult (interp, channelIdsListObj [idx], ": ", 1377 Tcl_PosixError (interp), (char *) NULL); 1378 return TCL_ERROR; 1379#else 1380 return TclXNotAvailableError (interp, funcName); 1381#endif 1382} 1383 1384/*----------------------------------------------------------------------------- 1385 * TclXOSFChangeOwnGrp -- 1386 * Change the owner and/or group of a file by open channel. 1387 * 1388 * Parameters: 1389 * o interp - Pointer to the current interpreter, error messages will be 1390 * returned in the result. 1391 * o options - Option flags are: 1392 * o TCLX_CHOWN - Change file's owner. 1393 * o TCLX_CHGRP - Change file's group. 1394 * o ownerStr - String containing owner name or id. NULL if TCLX_CHOWN 1395 * not specified. 1396 * o groupStr - String containing owner name or id. NULL if TCLX_CHOWN 1397 * not specified. If NULL and TCLX_CHOWN is specified, the user's group 1398 * is used. 1399 * o channelIds - NULL terminated list of channel ids. 1400 * o funcName - Command or other name to use in not available error. 1401 * Returns: 1402 * TCL_OK or TCL_ERROR. 1403 *----------------------------------------------------------------------------- 1404 */ 1405int 1406TclXOSFChangeOwnGrp (interp, options, ownerStr, groupStr, channelIds, funcName) 1407 Tcl_Interp *interp; 1408 unsigned options; 1409 char *ownerStr; 1410 char *groupStr; 1411 char **channelIds; 1412 char *funcName; 1413{ 1414#ifndef NO_FCHOWN 1415 int idx, fnum; 1416 struct stat fileStat; 1417 uid_t ownerId; 1418 gid_t groupId; 1419 Tcl_Channel channel; 1420 1421 if (ConvertOwnerGroup (interp, options, ownerStr, groupStr, 1422 &ownerId, &groupId) != TCL_OK) 1423 return TCL_ERROR; 1424 1425 for (idx = 0; channelIds [idx] != NULL; idx++) { 1426 channel = TclX_GetOpenChannel (interp, channelIds [idx], 0); 1427 if (channel == NULL) 1428 return TCL_ERROR; 1429 fnum = ChannelToFnum (channel, 0); 1430 1431 /* 1432 * If we are not changing both owner and group, we need to get the 1433 * old ids. 1434 */ 1435 if ((options & (TCLX_CHOWN | TCLX_CHGRP)) != 1436 (TCLX_CHOWN | TCLX_CHGRP)) { 1437 if (fstat (fnum, &fileStat) != 0) 1438 goto fileError; 1439 if ((options & TCLX_CHOWN) == 0) 1440 ownerId = fileStat.st_uid; 1441 if ((options & TCLX_CHGRP) == 0) 1442 groupId = fileStat.st_gid; 1443 } 1444 if (fchown (fnum, ownerId, groupId) < 0) 1445 goto fileError; 1446 } 1447 return TCL_OK; 1448 1449 fileError: 1450 TclX_AppendObjResult (interp, channelIds [idx], ": ", 1451 Tcl_PosixError (interp), (char *) NULL); 1452 return TCL_ERROR; 1453#else 1454 return TclXNotAvailableError (interp, funcName); 1455#endif 1456} 1457 1458/*----------------------------------------------------------------------------- 1459 * TclXOSGetSelectFnum -- 1460 * Convert a channel its read or write file numbers for use in select. 1461 * 1462 * Parameters: 1463 * o interp - Pointer to the current interpreter, error messages will be 1464 * returned in the result. 1465 * o channel - Channel to get the numbers for. 1466 * o direction - TCL_READABLE or TCL_WRITABLE. 1467 * o fnumPtr - The file number for the direction is returned here. 1468 * Returns: 1469 * TCL_OK or TCL_ERROR. 1470 *----------------------------------------------------------------------------- 1471 */ 1472int 1473TclXOSGetSelectFnum (interp, channel, direction, fnumPtr) 1474 Tcl_Interp *interp; 1475 Tcl_Channel channel; 1476 int direction; 1477 int *fnumPtr; 1478{ 1479 ClientData handle; 1480 1481 if (Tcl_GetChannelHandle (channel, direction, &handle) != TCL_OK) { 1482 TclX_AppendObjResult (interp, "channel ", 1483 Tcl_GetChannelName (channel), 1484 " was not open for requested access", 1485 (char *) NULL); 1486 return TCL_ERROR; 1487 } 1488 *fnumPtr = (int) handle; 1489 return TCL_OK; 1490} 1491 1492/*----------------------------------------------------------------------------- 1493 * TclXOSHaveFlock -- 1494 * System dependent interface to determine if file locking is available. 1495 * Returns: 1496 * TRUE if file locking is available, FALSE if it is not. 1497 *----------------------------------------------------------------------------- 1498 */ 1499int 1500TclXOSHaveFlock () 1501{ 1502#ifdef F_SETLKW 1503 return TRUE; 1504#else 1505 return FALSE; 1506#endif 1507} 1508 1509/*----------------------------------------------------------------------------- 1510 * TclXOSFlock -- 1511 * System dependent interface to locking a file. 1512 * 1513 * Parameters: 1514 * o interp - Pointer to the current interpreter, error messages will be 1515 * returned in the result. 1516 * o lockInfoPtr - Lock specification, gotLock will be initialized. 1517 * Returns: 1518 * TCL_OK or TCL_ERROR. 1519 *----------------------------------------------------------------------------- 1520 */ 1521int 1522TclXOSFlock (interp, lockInfoPtr) 1523 Tcl_Interp *interp; 1524 TclX_FlockInfo *lockInfoPtr; 1525{ 1526#ifdef F_SETLKW 1527 int fnum, stat; 1528 struct flock flockInfo; 1529 1530 flockInfo.l_start = lockInfoPtr->start; 1531 flockInfo.l_len = lockInfoPtr->len; 1532 flockInfo.l_type = 1533 (lockInfoPtr->access == TCL_WRITABLE) ? F_WRLCK : F_RDLCK; 1534 flockInfo.l_whence = lockInfoPtr->whence; 1535 1536 fnum = ChannelToFnum (lockInfoPtr->channel, lockInfoPtr->access); 1537 1538 stat = fcntl (fnum, lockInfoPtr->block ? F_SETLKW : F_SETLK, 1539 &flockInfo); 1540 1541 /* 1542 * Handle status from non-blocking lock. 1543 */ 1544 if ((stat < 0) && (!lockInfoPtr->block) && 1545 ((errno == EACCES) || (errno == EAGAIN))) { 1546 lockInfoPtr->gotLock = FALSE; 1547 return TCL_OK; 1548 } 1549 1550 if (stat < 0) { 1551 lockInfoPtr->gotLock = FALSE; 1552 TclX_AppendObjResult (interp, "lock of \"", 1553 Tcl_GetChannelName (lockInfoPtr->channel), 1554 "\" failed: ", Tcl_PosixError (interp), 1555 (char *) NULL); 1556 return TCL_ERROR; 1557 } 1558 1559 lockInfoPtr->gotLock = TRUE; 1560 return TCL_OK; 1561#else 1562 return TclXNotAvailableError (interp, 1563 "file locking"); 1564#endif 1565} 1566 1567/*----------------------------------------------------------------------------- 1568 * TclXOSFunlock -- 1569 * System dependent interface to unlocking a file. 1570 * 1571 * Parameters: 1572 * o interp - Pointer to the current interpreter, error messages will be 1573 * returned in the result. 1574 * o lockInfoPtr - Lock specification. 1575 * Returns: 1576 * TCL_OK or TCL_ERROR. 1577 *----------------------------------------------------------------------------- 1578 */ 1579int 1580TclXOSFunlock (interp, lockInfoPtr) 1581 Tcl_Interp *interp; 1582 TclX_FlockInfo *lockInfoPtr; 1583{ 1584#ifdef F_SETLKW 1585 int fnum, stat; 1586 struct flock flockInfo; 1587 1588 flockInfo.l_start = lockInfoPtr->start; 1589 flockInfo.l_len = lockInfoPtr->len; 1590 flockInfo.l_type = F_UNLCK; 1591 flockInfo.l_whence = lockInfoPtr->whence; 1592 1593 fnum = ChannelToFnum (lockInfoPtr->channel, lockInfoPtr->access); 1594 1595 stat = fcntl (fnum, F_SETLK, &flockInfo); 1596 if (stat < 0) { 1597 TclX_AppendObjResult (interp, "lock of \"", 1598 Tcl_GetChannelName (lockInfoPtr->channel), 1599 "\" failed: ", Tcl_PosixError (interp)); 1600 return TCL_ERROR; 1601 } 1602 1603 return TCL_OK; 1604#else 1605 return TclXNotAvailableError (interp, 1606 "file locking"); 1607#endif 1608} 1609 1610/*----------------------------------------------------------------------------- 1611 * TclXOSGetAppend -- 1612 * System dependent interface determine if a channel is in force append mode. 1613 * 1614 * Parameters: 1615 * o interp - Pointer to the current interpreter, error messages will be 1616 * returned in the result. 1617 * o channel - Channel to get mode for. The write file is used. 1618 * o valuePtr - TRUE is returned if in append mode, FALSE if not. 1619 * Returns: 1620 * TCL_OK or TCL_ERROR. 1621 *----------------------------------------------------------------------------- 1622 */ 1623int 1624TclXOSGetAppend (interp, channel, valuePtr) 1625 Tcl_Interp *interp; 1626 Tcl_Channel channel; 1627 int *valuePtr; 1628{ 1629 int fnum, mode; 1630 1631 fnum = ChannelToFnum (channel, TCL_WRITABLE); 1632 if (fnum < 0) { 1633 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), 1634 " is not open for write access", 1635 (char *) NULL); 1636 return TCL_ERROR; 1637 } 1638 1639 mode = fcntl (fnum, F_GETFL, 0); 1640 if (mode == -1) 1641 goto posixError; 1642 1643 *valuePtr = ((mode & O_APPEND) != 0); 1644 return TCL_OK; 1645 1646 posixError: 1647 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 1648 Tcl_PosixError (interp), (char *) NULL); 1649 return TCL_ERROR; 1650} 1651 1652/*----------------------------------------------------------------------------- 1653 * TclXOSSetAppend -- 1654 * System dependent interface set force append mode on a channel. 1655 * 1656 * Parameters: 1657 * o interp - Pointer to the current interpreter, error messages will be 1658 * returned in the result. 1659 * o channel - Channel to get mode for. The write file is used. 1660 * o value - TRUE to enable, FALSE to disable. 1661 * Returns: 1662 * TCL_OK or TCL_ERROR. 1663 *----------------------------------------------------------------------------- 1664 */ 1665int 1666TclXOSSetAppend (interp, channel, value) 1667 Tcl_Interp *interp; 1668 Tcl_Channel channel; 1669 int value; 1670{ 1671 int fnum, mode; 1672 1673 fnum = ChannelToFnum (channel, TCL_WRITABLE); 1674 if (fnum < 0) { 1675 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), 1676 " is not open for write access", 1677 (char *) NULL); 1678 return TCL_ERROR; 1679 } 1680 1681 mode = fcntl (fnum, F_GETFL, 0); 1682 if (mode == -1) 1683 goto posixError; 1684 1685 mode = (mode & ~O_APPEND) | (value ? O_APPEND : 0); 1686 1687 if (fcntl (fnum, F_SETFL, mode) == -1) 1688 goto posixError; 1689 1690 return TCL_OK; 1691 1692 posixError: 1693 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 1694 Tcl_PosixError (interp), (char *) NULL); 1695 return TCL_ERROR; 1696} 1697 1698/*----------------------------------------------------------------------------- 1699 * TclXOSGetCloseOnExec -- 1700 * System dependent interface determine if a channel has close-on-exec set. 1701 * 1702 * Parameters: 1703 * o interp - Pointer to the current interpreter, error messages will be 1704 * returned in the result. 1705 * o channel - Channel to get mode for. The write file is used. 1706 * o valuePtr - TRUE is close-on-exec, FALSE if not. 1707 * Returns: 1708 * TCL_OK or TCL_ERROR. 1709 *----------------------------------------------------------------------------- 1710 */ 1711int 1712TclXOSGetCloseOnExec (interp, channel, valuePtr) 1713 Tcl_Interp *interp; 1714 Tcl_Channel channel; 1715 int *valuePtr; 1716{ 1717 int readFnum; 1718 int writeFnum; 1719 int readMode = 0; 1720 int writeMode = 0; 1721 1722 readFnum = ChannelToFnum (channel, TCL_READABLE); 1723 writeFnum = ChannelToFnum (channel, TCL_WRITABLE); 1724 1725 if (readFnum >= 0) { 1726 readMode = fcntl (readFnum, F_GETFD, 0); 1727 if (readMode == -1) 1728 goto posixError; 1729 } 1730 if (writeFnum >= 0) { 1731 writeMode = fcntl (writeFnum, F_GETFD, 0); 1732 if (writeMode == -1) 1733 goto posixError; 1734 } 1735 1736 /* 1737 * It's an error if both files are not the same. This could only happen 1738 * if they were set outside of TclX. While this maybe overly strict, 1739 * this may prevent bugs. 1740 */ 1741 if ((readFnum >= 0) && (writeFnum >= 0) && 1742 ((readMode & 1) != (writeMode & 1))) { 1743 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), 1744 ": read file of channel has close-on-exec ", 1745 (readMode & 1) ? "on" : "off", 1746 " and write file has it ", 1747 (writeMode & 1) ? "on" : "off", 1748 "; don't know how to get attribute for a ", 1749 "channel configure this way", (char *) NULL); 1750 return TCL_ERROR; 1751 } 1752 1753 *valuePtr = (readFnum >= 0) ? (readMode & 1) : (writeMode & 1); 1754 return TCL_OK; 1755 1756 posixError: 1757 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 1758 Tcl_PosixError (interp), (char *) NULL); 1759 return TCL_ERROR; 1760} 1761 1762/*----------------------------------------------------------------------------- 1763 * TclXOSSetCloseOnExec -- 1764 * System dependent interface set close-on-exec on a channel. 1765 * 1766 * Parameters: 1767 * o interp - Pointer to the current interpreter, error messages will be 1768 * returned in the result. 1769 * o channel - Channel to get mode for. The write file is used. 1770 * o value - TRUE to enable, FALSE to disable. 1771 * Returns: 1772 * TCL_OK or TCL_ERROR. 1773 *----------------------------------------------------------------------------- 1774 */ 1775int 1776TclXOSSetCloseOnExec (interp, channel, value) 1777 Tcl_Interp *interp; 1778 Tcl_Channel channel; 1779 int value; 1780{ 1781 int readFnum, writeFnum; 1782 1783 readFnum = ChannelToFnum (channel, TCL_READABLE); 1784 writeFnum = ChannelToFnum (channel, TCL_WRITABLE); 1785 1786 if (readFnum > 0) { 1787 if (fcntl (readFnum, F_SETFD, value ? 1 : 0) == -1) 1788 goto posixError; 1789 } 1790 if ((writeFnum > 0) && (readFnum != writeFnum)) { 1791 if (fcntl (writeFnum, F_SETFD, value ? 1 : 0) == -1) 1792 goto posixError; 1793 } 1794 return TCL_OK; 1795 1796 posixError: 1797 TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", 1798 Tcl_PosixError (interp), (char *) NULL); 1799 return TCL_ERROR; 1800} 1801 1802 1803