1/* 2 * tclUnixInit.c -- 3 * 4 * Contains the Unix-specific interpreter initialization functions. 5 * 6 * Copyright (c) 1995-1997 Sun Microsystems, Inc. 7 * Copyright (c) 1999 by Scriptics Corporation. 8 * All rights reserved. 9 * 10 * RCS: @(#) $Id: tclUnixInit.c,v 1.34.2.15 2007/04/29 02:19:51 das Exp $ 11 */ 12 13#if defined(HAVE_COREFOUNDATION) 14#include <CoreFoundation/CoreFoundation.h> 15#endif 16#include "tclInt.h" 17#include "tclPort.h" 18#include <locale.h> 19#ifdef HAVE_LANGINFO 20# include <langinfo.h> 21# ifdef __APPLE__ 22# if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030 23 /* Support for weakly importing nl_langinfo on Darwin. */ 24# define WEAK_IMPORT_NL_LANGINFO 25 extern char *nl_langinfo(nl_item) WEAK_IMPORT_ATTRIBUTE; 26# endif 27# endif 28#endif 29#if defined(__FreeBSD__) && defined(__GNUC__) 30# include <floatingpoint.h> 31#endif 32#if defined(__bsdi__) 33# include <sys/param.h> 34# if _BSDI_VERSION > 199501 35# include <dlfcn.h> 36# endif 37#endif 38 39/* 40 * The Init script (common to Windows and Unix platforms) is 41 * defined in tkInitScript.h 42 */ 43#include "tclInitScript.h" 44 45/* Used to store the encoding used for binary files */ 46static Tcl_Encoding binaryEncoding = NULL; 47/* Has the basic library path encoding issue been fixed */ 48static int libraryPathEncodingFixed = 0; 49 50/* 51 * Tcl tries to use standard and homebrew methods to guess the right 52 * encoding on the platform. However, there is always a final fallback, 53 * and this value is it. Make sure it is a real Tcl encoding. 54 */ 55 56#ifndef TCL_DEFAULT_ENCODING 57#define TCL_DEFAULT_ENCODING "iso8859-1" 58#endif 59 60/* 61 * Default directory in which to look for Tcl library scripts. The 62 * symbol is defined by Makefile. 63 */ 64 65static char defaultLibraryDir[sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY; 66 67/* 68 * Directory in which to look for packages (each package is typically 69 * installed as a subdirectory of this directory). The symbol is 70 * defined by Makefile. 71 */ 72 73static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH; 74 75/* 76 * The following table is used to map from Unix locale strings to 77 * encoding files. If HAVE_LANGINFO is defined, then this is a fallback 78 * table when the result from nl_langinfo isn't a recognized encoding. 79 * Otherwise this is the first list checked for a mapping from env 80 * encoding to Tcl encoding name. 81 */ 82 83typedef struct LocaleTable { 84 CONST char *lang; 85 CONST char *encoding; 86} LocaleTable; 87 88static CONST LocaleTable localeTable[] = { 89#ifdef HAVE_LANGINFO 90 {"gb2312-1980", "gb2312"}, 91 {"ansi-1251", "cp1251"}, /* Solaris gets this wrong. */ 92#ifdef __hpux 93 {"SJIS", "shiftjis"}, 94 {"eucjp", "euc-jp"}, 95 {"euckr", "euc-kr"}, 96 {"euctw", "euc-cn"}, 97 {"greek8", "cp869"}, 98 {"iso88591", "iso8859-1"}, 99 {"iso88592", "iso8859-2"}, 100 {"iso88595", "iso8859-5"}, 101 {"iso88596", "iso8859-6"}, 102 {"iso88597", "iso8859-7"}, 103 {"iso88598", "iso8859-8"}, 104 {"iso88599", "iso8859-9"}, 105 {"iso885915", "iso8859-15"}, 106 {"roman8", "iso8859-1"}, 107 {"tis620", "tis-620"}, 108 {"turkish8", "cp857"}, 109 {"utf8", "utf-8"}, 110#endif /* __hpux */ 111#endif /* HAVE_LANGINFO */ 112 113 {"ja_JP.SJIS", "shiftjis"}, 114 {"ja_JP.EUC", "euc-jp"}, 115 {"ja_JP.eucJP", "euc-jp"}, 116 {"ja_JP.JIS", "iso2022-jp"}, 117 {"ja_JP.mscode", "shiftjis"}, 118 {"ja_JP.ujis", "euc-jp"}, 119 {"ja_JP", "euc-jp"}, 120 {"Ja_JP", "shiftjis"}, 121 {"Jp_JP", "shiftjis"}, 122 {"japan", "euc-jp"}, 123#ifdef hpux 124 {"japanese", "shiftjis"}, 125 {"ja", "shiftjis"}, 126#else 127 {"japanese", "euc-jp"}, 128 {"ja", "euc-jp"}, 129#endif 130 {"japanese.sjis", "shiftjis"}, 131 {"japanese.euc", "euc-jp"}, 132 {"japanese-sjis", "shiftjis"}, 133 {"japanese-ujis", "euc-jp"}, 134 135 {"ko", "euc-kr"}, 136 {"ko_KR", "euc-kr"}, 137 {"ko_KR.EUC", "euc-kr"}, 138 {"ko_KR.euc", "euc-kr"}, 139 {"ko_KR.eucKR", "euc-kr"}, 140 {"korean", "euc-kr"}, 141 142 {"ru", "iso8859-5"}, 143 {"ru_RU", "iso8859-5"}, 144 {"ru_SU", "iso8859-5"}, 145 146 {"zh", "cp936"}, 147 {"zh_CN.gb2312", "euc-cn"}, 148 {"zh_CN.GB2312", "euc-cn"}, 149 {"zh_CN.GBK", "euc-cn"}, 150 {"zh_TW.Big5", "big5"}, 151 {"zh_TW", "euc-tw"}, 152 153 {NULL, NULL} 154}; 155 156#ifdef HAVE_COREFOUNDATION 157static int MacOSXGetLibraryPath _ANSI_ARGS_(( 158 Tcl_Interp *interp, int maxPathLen, 159 char *tclLibPath)); 160#endif /* HAVE_COREFOUNDATION */ 161#if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \ 162 defined(MAC_OS_X_VERSION_MIN_REQUIRED) && ( \ 163 (defined(TCL_THREADS) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \ 164 (defined(__LP64__) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050) || \ 165 (defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050)\ 166 ))) 167/* 168 * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c: 169 * initialize release global at startup from uname(). 170 */ 171#define GET_DARWIN_RELEASE 1 172long tclMacOSXDarwinRelease = 0; 173#endif 174 175 176/* 177 *--------------------------------------------------------------------------- 178 * 179 * TclpInitPlatform -- 180 * 181 * Initialize all the platform-dependant things like signals and 182 * floating-point error handling. 183 * 184 * Called at process initialization time. 185 * 186 * Results: 187 * None. 188 * 189 * Side effects: 190 * None. 191 * 192 *--------------------------------------------------------------------------- 193 */ 194 195void 196TclpInitPlatform() 197{ 198 tclPlatform = TCL_PLATFORM_UNIX; 199 200 /* 201 * Make sure, that the standard FDs exist. [Bug 772288] 202 */ 203 if (TclOSseek(0, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { 204 open("/dev/null", O_RDONLY); 205 } 206 if (TclOSseek(1, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { 207 open("/dev/null", O_WRONLY); 208 } 209 if (TclOSseek(2, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { 210 open("/dev/null", O_WRONLY); 211 } 212 213 /* 214 * The code below causes SIGPIPE (broken pipe) errors to 215 * be ignored. This is needed so that Tcl processes don't 216 * die if they create child processes (e.g. using "exec" or 217 * "open") that terminate prematurely. The signal handler 218 * is only set up when the first interpreter is created; 219 * after this the application can override the handler with 220 * a different one of its own, if it wants. 221 */ 222 223#ifdef SIGPIPE 224 (void) signal(SIGPIPE, SIG_IGN); 225#endif /* SIGPIPE */ 226 227#if defined(__FreeBSD__) && defined(__GNUC__) 228 /* 229 * Adjust the rounding mode to be more conventional. Note that FreeBSD 230 * only provides the __fpsetreg() used by the following two for the GNU 231 * Compiler. When using, say, Intel's icc they break. (Partially based on 232 * patch in BSD ports system from root@celsius.bychok.com) 233 */ 234 235 fpsetround(FP_RN); 236 fpsetmask(0L); 237#endif 238 239#if defined(__bsdi__) && (_BSDI_VERSION > 199501) 240 /* 241 * Find local symbols. Don't report an error if we fail. 242 */ 243 (void) dlopen (NULL, RTLD_NOW); /* INTL: Native. */ 244#endif 245 246#ifdef GET_DARWIN_RELEASE 247 { 248 struct utsname name; 249 if (!uname(&name)) { 250 tclMacOSXDarwinRelease = strtol(name.release, NULL, 10); 251 } 252 } 253#endif 254} 255 256/* 257 *--------------------------------------------------------------------------- 258 * 259 * TclpInitLibraryPath -- 260 * 261 * Initialize the library path at startup. We have a minor 262 * metacircular problem that we don't know the encoding of the 263 * operating system but we may need to talk to operating system 264 * to find the library directories so that we know how to talk to 265 * the operating system. 266 * 267 * We do not know the encoding of the operating system. 268 * We do know that the encoding is some multibyte encoding. 269 * In that multibyte encoding, the characters 0..127 are equivalent 270 * to ascii. 271 * 272 * So although we don't know the encoding, it's safe: 273 * to look for the last slash character in a path in the encoding. 274 * to append an ascii string to a path. 275 * to pass those strings back to the operating system. 276 * 277 * But any strings that we remembered before we knew the encoding of 278 * the operating system must be translated to UTF-8 once we know the 279 * encoding so that the rest of Tcl can use those strings. 280 * 281 * This call sets the library path to strings in the unknown native 282 * encoding. TclpSetInitialEncodings() will translate the library 283 * path from the native encoding to UTF-8 as soon as it determines 284 * what the native encoding actually is. 285 * 286 * Called at process initialization time. 287 * 288 * Results: 289 * Return 1, indicating that the UTF may be dirty and require "cleanup" 290 * after encodings are initialized. 291 * 292 * Side effects: 293 * None. 294 * 295 *--------------------------------------------------------------------------- 296 */ 297 298int 299TclpInitLibraryPath(path) 300CONST char *path; /* Path to the executable in native 301 * multi-byte encoding. */ 302{ 303#define LIBRARY_SIZE 32 304 Tcl_Obj *pathPtr, *objPtr; 305 CONST char *str; 306 Tcl_DString buffer, ds; 307 int pathc; 308 CONST char **pathv; 309 char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE]; 310 311 Tcl_DStringInit(&ds); 312 pathPtr = Tcl_NewObj(); 313 314 /* 315 * Initialize the substrings used when locating an executable. The 316 * installLib variable computes the path as though the executable 317 * is installed. The developLib computes the path as though the 318 * executable is run from a develpment directory. 319 */ 320 321 sprintf(installLib, "lib/tcl%s", TCL_VERSION); 322 sprintf(developLib, "tcl%s/library", TCL_PATCH_LEVEL); 323 324 /* 325 * Look for the library relative to default encoding dir. 326 */ 327 328 str = Tcl_GetDefaultEncodingDir(); 329 if ((str != NULL) && (str[0] != '\0')) { 330 objPtr = Tcl_NewStringObj(str, -1); 331 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 332 } 333 334 /* 335 * Look for the library relative to the TCL_LIBRARY env variable. 336 * If the last dirname in the TCL_LIBRARY path does not match the 337 * last dirname in the installLib variable, use the last dir name 338 * of installLib in addition to the orginal TCL_LIBRARY path. 339 */ 340 341 str = getenv("TCL_LIBRARY"); /* INTL: Native. */ 342 Tcl_ExternalToUtfDString(NULL, str, -1, &buffer); 343 str = Tcl_DStringValue(&buffer); 344 345 if ((str != NULL) && (str[0] != '\0')) { 346 /* 347 * If TCL_LIBRARY is set, search there. 348 */ 349 350 objPtr = Tcl_NewStringObj(str, -1); 351 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 352 353 Tcl_SplitPath(str, &pathc, &pathv); 354 if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) { 355 /* 356 * If TCL_LIBRARY is set but refers to a different tcl 357 * installation than the current version, try fiddling with the 358 * specified directory to make it refer to this installation by 359 * removing the old "tclX.Y" and substituting the current 360 * version string. 361 */ 362 363 pathv[pathc - 1] = installLib + 4; 364 str = Tcl_JoinPath(pathc, pathv, &ds); 365 objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); 366 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 367 Tcl_DStringFree(&ds); 368 } 369 ckfree((char *) pathv); 370 } 371 372 /* 373 * Look for the library relative to the executable. This algorithm 374 * should be the same as the one in the tcl_findLibrary procedure. 375 * 376 * This code looks in the following directories: 377 * 378 * <bindir>/../<installLib> 379 * (e.g. /usr/local/bin/../lib/tcl8.4) 380 * <bindir>/../../<installLib> 381 * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4) 382 * <bindir>/../library 383 * (e.g. /usr/src/tcl8.4.0/unix/../library) 384 * <bindir>/../../library 385 * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../library) 386 * <bindir>/../../<developLib> 387 * (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library) 388 * <bindir>/../../../<developLib> 389 * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library) 390 */ 391 392 393 /* 394 * The variable path holds an absolute path. Take care not to 395 * overwrite pathv[0] since that might produce a relative path. 396 */ 397 398 if (path != NULL) { 399 int i, origc; 400 CONST char **origv; 401 402 Tcl_SplitPath(path, &origc, &origv); 403 pathc = 0; 404 pathv = (CONST char **) ckalloc((unsigned int)(origc * sizeof(char *))); 405 for (i=0; i< origc; i++) { 406 if (origv[i][0] == '.') { 407 if (strcmp(origv[i], ".") == 0) { 408 /* do nothing */ 409 } else if (strcmp(origv[i], "..") == 0) { 410 pathc--; 411 } else { 412 pathv[pathc++] = origv[i]; 413 } 414 } else { 415 pathv[pathc++] = origv[i]; 416 } 417 } 418 if (pathc > 2) { 419 str = pathv[pathc - 2]; 420 pathv[pathc - 2] = installLib; 421 path = Tcl_JoinPath(pathc - 1, pathv, &ds); 422 pathv[pathc - 2] = str; 423 objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); 424 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 425 Tcl_DStringFree(&ds); 426 } 427 if (pathc > 3) { 428 str = pathv[pathc - 3]; 429 pathv[pathc - 3] = installLib; 430 path = Tcl_JoinPath(pathc - 2, pathv, &ds); 431 pathv[pathc - 3] = str; 432 objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); 433 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 434 Tcl_DStringFree(&ds); 435 } 436 if (pathc > 2) { 437 str = pathv[pathc - 2]; 438 pathv[pathc - 2] = "library"; 439 path = Tcl_JoinPath(pathc - 1, pathv, &ds); 440 pathv[pathc - 2] = str; 441 objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); 442 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 443 Tcl_DStringFree(&ds); 444 } 445 if (pathc > 3) { 446 str = pathv[pathc - 3]; 447 pathv[pathc - 3] = "library"; 448 path = Tcl_JoinPath(pathc - 2, pathv, &ds); 449 pathv[pathc - 3] = str; 450 objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); 451 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 452 Tcl_DStringFree(&ds); 453 } 454 if (pathc > 3) { 455 str = pathv[pathc - 3]; 456 pathv[pathc - 3] = developLib; 457 path = Tcl_JoinPath(pathc - 2, pathv, &ds); 458 pathv[pathc - 3] = str; 459 objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); 460 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 461 Tcl_DStringFree(&ds); 462 } 463 if (pathc > 4) { 464 str = pathv[pathc - 4]; 465 pathv[pathc - 4] = developLib; 466 path = Tcl_JoinPath(pathc - 3, pathv, &ds); 467 pathv[pathc - 4] = str; 468 objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); 469 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 470 Tcl_DStringFree(&ds); 471 } 472 ckfree((char *) origv); 473 ckfree((char *) pathv); 474 } 475 476 /* 477 * Finally, look for the library relative to the compiled-in path. 478 * This is needed when users install Tcl with an exec-prefix that 479 * is different from the prtefix. 480 */ 481 482 { 483#ifdef HAVE_COREFOUNDATION 484 char tclLibPath[MAXPATHLEN + 1]; 485 486 if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) { 487 str = tclLibPath; 488 } else 489#endif /* HAVE_COREFOUNDATION */ 490 { 491 str = defaultLibraryDir; 492 } 493 if (str[0] != '\0') { 494 objPtr = Tcl_NewStringObj(str, -1); 495 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); 496 } 497 } 498 499 TclSetLibraryPath(pathPtr); 500 Tcl_DStringFree(&buffer); 501 502 return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */ 503} 504 505/* 506 *--------------------------------------------------------------------------- 507 * 508 * TclpSetInitialEncodings -- 509 * 510 * Based on the locale, determine the encoding of the operating 511 * system and the default encoding for newly opened files. 512 * 513 * Called at process initialization time, and part way through 514 * startup, we verify that the initial encodings were correctly 515 * setup. Depending on Tcl's environment, there may not have been 516 * enough information first time through (above). 517 * 518 * Results: 519 * None. 520 * 521 * Side effects: 522 * The Tcl library path is converted from native encoding to UTF-8, 523 * on the first call, and the encodings may be changed on first or 524 * second call. 525 * 526 *--------------------------------------------------------------------------- 527 */ 528 529void 530TclpSetInitialEncodings() 531{ 532 CONST char *encoding = NULL; 533 int i, setSysEncCode = TCL_ERROR; 534 Tcl_Obj *pathPtr; 535 536 /* 537 * Determine the current encoding from the LC_* or LANG environment 538 * variables. We previously used setlocale() to determine the locale, 539 * but this does not work on some systems (e.g. Linux/i386 RH 5.0). 540 */ 541#ifdef HAVE_LANGINFO 542 if ( 543#ifdef WEAK_IMPORT_NL_LANGINFO 544 nl_langinfo != NULL && 545#endif 546 setlocale(LC_CTYPE, "") != NULL) { 547 Tcl_DString ds; 548 549 /* 550 * Use a DString so we can overwrite it in name compatability 551 * checks below. 552 */ 553 554 Tcl_DStringInit(&ds); 555 encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1); 556 557 Tcl_UtfToLower(Tcl_DStringValue(&ds)); 558#ifdef HAVE_LANGINFO_DEBUG 559 fprintf(stderr, "encoding '%s'", encoding); 560#endif 561 if (encoding[0] == 'i' && encoding[1] == 's' && encoding[2] == 'o' 562 && encoding[3] == '-') { 563 char *p, *q; 564 /* need to strip '-' from iso-* encoding */ 565 for(p = Tcl_DStringValue(&ds)+3, q = Tcl_DStringValue(&ds)+4; 566 *p; *p++ = *q++); 567 } else if (encoding[0] == 'i' && encoding[1] == 'b' 568 && encoding[2] == 'm' && encoding[3] >= '0' 569 && encoding[3] <= '9') { 570 char *p, *q; 571 /* if langinfo reports "ibm*" we should use "cp*" */ 572 p = Tcl_DStringValue(&ds); 573 *p++ = 'c'; *p++ = 'p'; 574 for(q = p+1; *p ; *p++ = *q++); 575 } else if ((*encoding == '\0') 576 || !strcmp(encoding, "ansi_x3.4-1968")) { 577 /* Use iso8859-1 for empty or 'ansi_x3.4-1968' encoding */ 578 encoding = "iso8859-1"; 579 } 580#ifdef HAVE_LANGINFO_DEBUG 581 fprintf(stderr, " ?%s?", encoding); 582#endif 583 setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding); 584 if (setSysEncCode != TCL_OK) { 585 /* 586 * If this doesn't return TCL_OK, the encoding returned by 587 * nl_langinfo or as we translated it wasn't accepted. Do 588 * this fallback check. If this fails, we will enter the 589 * old fallback below. 590 */ 591 592 for (i = 0; localeTable[i].lang != NULL; i++) { 593 if (strcmp(localeTable[i].lang, encoding) == 0) { 594 setSysEncCode = Tcl_SetSystemEncoding(NULL, 595 localeTable[i].encoding); 596 break; 597 } 598 } 599 } 600#ifdef HAVE_LANGINFO_DEBUG 601 fprintf(stderr, " => '%s'\n", encoding); 602#endif 603 Tcl_DStringFree(&ds); 604 } 605#ifdef HAVE_LANGINFO_DEBUG 606 else { 607 fprintf(stderr, "setlocale returned NULL\n"); 608 } 609#endif 610#endif /* HAVE_LANGINFO */ 611 612 if (setSysEncCode != TCL_OK) { 613 /* 614 * Classic fallback check. This tries a homebrew algorithm to 615 * determine what encoding should be used based on env vars. 616 */ 617 char *langEnv = getenv("LC_ALL"); 618 encoding = NULL; 619 620 if (langEnv == NULL || langEnv[0] == '\0') { 621 langEnv = getenv("LC_CTYPE"); 622 } 623 if (langEnv == NULL || langEnv[0] == '\0') { 624 langEnv = getenv("LANG"); 625 } 626 if (langEnv == NULL || langEnv[0] == '\0') { 627 langEnv = NULL; 628 } 629 630 if (langEnv != NULL) { 631 for (i = 0; localeTable[i].lang != NULL; i++) { 632 if (strcmp(localeTable[i].lang, langEnv) == 0) { 633 encoding = localeTable[i].encoding; 634 break; 635 } 636 } 637 /* 638 * There was no mapping in the locale table. If there is an 639 * encoding subfield, we can try to guess from that. 640 */ 641 642 if (encoding == NULL) { 643 char *p; 644 for (p = langEnv; *p != '\0'; p++) { 645 if (*p == '.') { 646 p++; 647 break; 648 } 649 } 650 if (*p != '\0') { 651 Tcl_DString ds; 652 Tcl_DStringInit(&ds); 653 encoding = Tcl_DStringAppend(&ds, p, -1); 654 655 Tcl_UtfToLower(Tcl_DStringValue(&ds)); 656 setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding); 657 if (setSysEncCode != TCL_OK) { 658 encoding = NULL; 659 } 660 Tcl_DStringFree(&ds); 661 } 662 } 663#ifdef HAVE_LANGINFO_DEBUG 664 fprintf(stderr, "encoding fallback check '%s' => '%s'\n", 665 langEnv, encoding); 666#endif 667 } 668 if (setSysEncCode != TCL_OK) { 669 if (encoding == NULL) { 670 encoding = TCL_DEFAULT_ENCODING; 671 } 672 673 Tcl_SetSystemEncoding(NULL, encoding); 674 } 675 676 /* 677 * Initialize the C library's locale subsystem. This is required 678 * for input methods to work properly on X11. We only do this for 679 * LC_CTYPE because that's the necessary one, and we don't want to 680 * affect LC_TIME here. The side effect of setting the default 681 * locale should be to load any locale specific modules that are 682 * needed by X. [BUG: 5422 3345 4236 2522 2521]. 683 * In HAVE_LANGINFO, this call is already done above. 684 */ 685#ifndef HAVE_LANGINFO 686 setlocale(LC_CTYPE, ""); 687#endif 688 } 689 690 /* 691 * In case the initial locale is not "C", ensure that the numeric 692 * processing is done in "C" locale regardless. This is needed because 693 * Tcl relies on routines like strtod, but should not have locale 694 * dependent behavior. 695 */ 696 697 setlocale(LC_NUMERIC, "C"); 698 699 if ((libraryPathEncodingFixed == 0) && strcmp("identity", 700 Tcl_GetEncodingName(Tcl_GetEncoding(NULL, NULL))) ) { 701 /* 702 * Until the system encoding was actually set, the library path was 703 * actually in the native multi-byte encoding, and not really UTF-8 704 * as advertised. We cheated as follows: 705 * 706 * 1. It was safe to allow the Tcl_SetSystemEncoding() call to 707 * append the ASCII chars that make up the encoding's filename to 708 * the names (in the native encoding) of directories in the library 709 * path, since all Unix multi-byte encodings have ASCII in the 710 * beginning. 711 * 712 * 2. To open the encoding file, the native bytes in the file name 713 * were passed to the OS, without translating from UTF-8 to native, 714 * because the name was already in the native encoding. 715 * 716 * Now that the system encoding was actually successfully set, 717 * translate all the names in the library path to UTF-8. That way, 718 * next time we search the library path, we'll translate the names 719 * from UTF-8 to the system encoding which will be the native 720 * encoding. 721 */ 722 723 pathPtr = TclGetLibraryPath(); 724 if (pathPtr != NULL) { 725 int objc; 726 Tcl_Obj **objv; 727 728 objc = 0; 729 Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); 730 for (i = 0; i < objc; i++) { 731 int length; 732 char *string; 733 Tcl_DString ds; 734 735 string = Tcl_GetStringFromObj(objv[i], &length); 736 Tcl_ExternalToUtfDString(NULL, string, length, &ds); 737 Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), 738 Tcl_DStringLength(&ds)); 739 Tcl_DStringFree(&ds); 740 } 741 } 742 743 libraryPathEncodingFixed = 1; 744 } 745 746 /* This is only ever called from the startup thread */ 747 if (binaryEncoding == NULL) { 748 /* 749 * Keep the iso8859-1 encoding preloaded. The IO package uses 750 * it for gets on a binary channel. 751 */ 752 binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1"); 753 } 754} 755 756/* 757 *--------------------------------------------------------------------------- 758 * 759 * TclpSetVariables -- 760 * 761 * Performs platform-specific interpreter initialization related to 762 * the tcl_library and tcl_platform variables, and other platform- 763 * specific things. 764 * 765 * Results: 766 * None. 767 * 768 * Side effects: 769 * Sets "tclDefaultLibrary", "tcl_pkgPath", and "tcl_platform" Tcl 770 * variables. 771 * 772 *---------------------------------------------------------------------- 773 */ 774 775void 776TclpSetVariables(interp) 777 Tcl_Interp *interp; 778{ 779#ifndef NO_UNAME 780 struct utsname name; 781#endif 782 int unameOK; 783 CONST char *user; 784 Tcl_DString ds; 785 786#ifdef HAVE_COREFOUNDATION 787 char tclLibPath[MAXPATHLEN + 1]; 788 789#if MAC_OS_X_VERSION_MAX_ALLOWED > 1020 790 /* 791 * Set msgcat fallback locale to current CFLocale identifier. 792 */ 793 CFLocaleRef localeRef; 794 795 if (CFLocaleCopyCurrent != NULL && CFLocaleGetIdentifier != NULL && 796 (localeRef = CFLocaleCopyCurrent())) { 797 CFStringRef locale = CFLocaleGetIdentifier(localeRef); 798 799 if (locale) { 800 char loc[256]; 801 802 if (CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) { 803 if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) { 804 Tcl_ResetResult(interp); 805 } 806 Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY); 807 } 808 } 809 CFRelease(localeRef); 810 } 811#endif 812 813 if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) { 814 CONST char *str; 815 Tcl_DString ds; 816 CFBundleRef bundleRef; 817 818 Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, 819 TCL_GLOBAL_ONLY); 820 Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, 821 TCL_GLOBAL_ONLY); 822 Tcl_SetVar(interp, "tcl_pkgPath", " ", 823 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 824 str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds); 825 if ((str != NULL) && (str[0] != '\0')) { 826 char *p = Tcl_DStringValue(&ds); 827 /* convert DYLD_FRAMEWORK_PATH from colon to space separated */ 828 do { 829 if(*p == ':') *p = ' '; 830 } while (*p++); 831 Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds), 832 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 833 Tcl_SetVar(interp, "tcl_pkgPath", " ", 834 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 835 Tcl_DStringFree(&ds); 836 } 837 if ((bundleRef = CFBundleGetMainBundle())) { 838 CFURLRef frameworksURL; 839 Tcl_StatBuf statBuf; 840 if((frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef))) { 841 if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE, 842 (unsigned char*) tclLibPath, MAXPATHLEN) && 843 ! TclOSstat(tclLibPath, &statBuf) && 844 S_ISDIR(statBuf.st_mode)) { 845 Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, 846 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 847 Tcl_SetVar(interp, "tcl_pkgPath", " ", 848 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 849 } 850 CFRelease(frameworksURL); 851 } 852 if((frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef))) { 853 if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE, 854 (unsigned char*) tclLibPath, MAXPATHLEN) && 855 ! TclOSstat(tclLibPath, &statBuf) && 856 S_ISDIR(statBuf.st_mode)) { 857 Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, 858 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 859 Tcl_SetVar(interp, "tcl_pkgPath", " ", 860 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 861 } 862 CFRelease(frameworksURL); 863 } 864 } 865 Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, 866 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); 867 } else 868#endif /* HAVE_COREFOUNDATION */ 869 { 870 Tcl_SetVar(interp, "tclDefaultLibrary", defaultLibraryDir, 871 TCL_GLOBAL_ONLY); 872 Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY); 873 } 874 875#ifdef DJGPP 876 Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY); 877#else 878 Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY); 879#endif 880 unameOK = 0; 881#ifndef NO_UNAME 882 if (uname(&name) >= 0) { 883 CONST char *native; 884 885 unameOK = 1; 886 887 native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds); 888 Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY); 889 Tcl_DStringFree(&ds); 890 891 /* 892 * The following code is a special hack to handle differences in 893 * the way version information is returned by uname. On most 894 * systems the full version number is available in name.release. 895 * However, under AIX the major version number is in 896 * name.version and the minor version number is in name.release. 897 */ 898 899 if ((strchr(name.release, '.') != NULL) 900 || !isdigit(UCHAR(name.version[0]))) { /* INTL: digit */ 901 Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, 902 TCL_GLOBAL_ONLY); 903 } else { 904 Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version, 905 TCL_GLOBAL_ONLY); 906 Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".", 907 TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); 908 Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, 909 TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); 910 } 911 Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine, 912 TCL_GLOBAL_ONLY); 913 } 914#endif 915 if (!unameOK) { 916 Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY); 917 Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY); 918 Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY); 919 } 920 921 /* 922 * Copy USER or LOGNAME environment variable into tcl_platform(user) 923 */ 924 925 Tcl_DStringInit(&ds); 926 user = TclGetEnv("USER", &ds); 927 if (user == NULL) { 928 user = TclGetEnv("LOGNAME", &ds); 929 if (user == NULL) { 930 user = ""; 931 } 932 } 933 Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY); 934 Tcl_DStringFree(&ds); 935 936} 937 938/* 939 *---------------------------------------------------------------------- 940 * 941 * TclpFindVariable -- 942 * 943 * Locate the entry in environ for a given name. On Unix this 944 * routine is case sensetive, on Windows this matches mixed case. 945 * 946 * Results: 947 * The return value is the index in environ of an entry with the 948 * name "name", or -1 if there is no such entry. The integer at 949 * *lengthPtr is filled in with the length of name (if a matching 950 * entry is found) or the length of the environ array (if no matching 951 * entry is found). 952 * 953 * Side effects: 954 * None. 955 * 956 *---------------------------------------------------------------------- 957 */ 958 959int 960TclpFindVariable(name, lengthPtr) 961 CONST char *name; /* Name of desired environment variable 962 * (native). */ 963 int *lengthPtr; /* Used to return length of name (for 964 * successful searches) or number of non-NULL 965 * entries in environ (for unsuccessful 966 * searches). */ 967{ 968 int i, result = -1; 969 register CONST char *env, *p1, *p2; 970 Tcl_DString envString; 971 972 Tcl_DStringInit(&envString); 973 for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { 974 p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); 975 p2 = name; 976 977 for (; *p2 == *p1; p1++, p2++) { 978 /* NULL loop body. */ 979 } 980 if ((*p1 == '=') && (*p2 == '\0')) { 981 *lengthPtr = p2 - name; 982 result = i; 983 goto done; 984 } 985 986 Tcl_DStringFree(&envString); 987 } 988 989 *lengthPtr = i; 990 991 done: 992 Tcl_DStringFree(&envString); 993 return result; 994} 995 996/* 997 *---------------------------------------------------------------------- 998 * 999 * Tcl_Init -- 1000 * 1001 * This procedure is typically invoked by Tcl_AppInit procedures 1002 * to find and source the "init.tcl" script, which should exist 1003 * somewhere on the Tcl library path. 1004 * 1005 * Results: 1006 * Returns a standard Tcl completion code and sets the interp's 1007 * result if there is an error. 1008 * 1009 * Side effects: 1010 * Depends on what's in the init.tcl script. 1011 * 1012 *---------------------------------------------------------------------- 1013 */ 1014 1015int 1016Tcl_Init(interp) 1017 Tcl_Interp *interp; /* Interpreter to initialize. */ 1018{ 1019 Tcl_Obj *pathPtr; 1020 1021 if (tclPreInitScript != NULL) { 1022 if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { 1023 return (TCL_ERROR); 1024 }; 1025 } 1026 1027 pathPtr = TclGetLibraryPath(); 1028 if (pathPtr == NULL) { 1029 pathPtr = Tcl_NewObj(); 1030 } 1031 Tcl_IncrRefCount(pathPtr); 1032 Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY); 1033 Tcl_DecrRefCount(pathPtr); 1034 return Tcl_Eval(interp, initScript); 1035} 1036 1037/* 1038 *---------------------------------------------------------------------- 1039 * 1040 * Tcl_SourceRCFile -- 1041 * 1042 * This procedure is typically invoked by Tcl_Main of Tk_Main 1043 * procedure to source an application specific rc file into the 1044 * interpreter at startup time. 1045 * 1046 * Results: 1047 * None. 1048 * 1049 * Side effects: 1050 * Depends on what's in the rc script. 1051 * 1052 *---------------------------------------------------------------------- 1053 */ 1054 1055void 1056Tcl_SourceRCFile(interp) 1057 Tcl_Interp *interp; /* Interpreter to source rc file into. */ 1058{ 1059 Tcl_DString temp; 1060 CONST char *fileName; 1061 Tcl_Channel errChannel; 1062 1063 fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); 1064 1065 if (fileName != NULL) { 1066 Tcl_Channel c; 1067 CONST char *fullName; 1068 1069 Tcl_DStringInit(&temp); 1070 fullName = Tcl_TranslateFileName(interp, fileName, &temp); 1071 if (fullName == NULL) { 1072 /* 1073 * Couldn't translate the file name (e.g. it referred to a 1074 * bogus user or there was no HOME environment variable). 1075 * Just do nothing. 1076 */ 1077 } else { 1078 1079 /* 1080 * Test for the existence of the rc file before trying to read it. 1081 */ 1082 1083 c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); 1084 if (c != (Tcl_Channel) NULL) { 1085 Tcl_Close(NULL, c); 1086 if (Tcl_EvalFile(interp, fullName) != TCL_OK) { 1087 errChannel = Tcl_GetStdChannel(TCL_STDERR); 1088 if (errChannel) { 1089 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); 1090 Tcl_WriteChars(errChannel, "\n", 1); 1091 } 1092 } 1093 } 1094 } 1095 Tcl_DStringFree(&temp); 1096 } 1097} 1098 1099/* 1100 *---------------------------------------------------------------------- 1101 * 1102 * TclpCheckStackSpace -- 1103 * 1104 * Detect if we are about to blow the stack. Called before an 1105 * evaluation can happen when nesting depth is checked. 1106 * 1107 * Results: 1108 * 1 if there is enough stack space to continue; 0 if not. 1109 * 1110 * Side effects: 1111 * None. 1112 * 1113 *---------------------------------------------------------------------- 1114 */ 1115 1116int 1117TclpCheckStackSpace() 1118{ 1119 /* 1120 * This function is unimplemented on Unix platforms. 1121 */ 1122 1123 return 1; 1124} 1125 1126/* 1127 *---------------------------------------------------------------------- 1128 * 1129 * MacOSXGetLibraryPath -- 1130 * 1131 * If we have a bundle structure for the Tcl installation, 1132 * then check there first to see if we can find the libraries 1133 * there. 1134 * 1135 * Results: 1136 * TCL_OK if we have found the tcl library; TCL_ERROR otherwise. 1137 * 1138 * Side effects: 1139 * Same as for Tcl_MacOSXOpenVersionedBundleResources. 1140 * 1141 *---------------------------------------------------------------------- 1142 */ 1143 1144#ifdef HAVE_COREFOUNDATION 1145static int 1146MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath) 1147{ 1148 int foundInFramework = TCL_ERROR; 1149#ifdef TCL_FRAMEWORK 1150 foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, 1151 "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen, tclLibPath); 1152#endif 1153 return foundInFramework; 1154} 1155#endif /* HAVE_COREFOUNDATION */ 1156