1/* -*- mode: C; coding: macintosh; -*- 2 * ################################################################### 3 * TclAE - AppleEvent extension for Tcl 4 * 5 * FILE: "tclAEAddress.c" 6 * created: 8/29/99 {5:02:24 PM} 7 * last update: 7/25/10 {10:10:51 PM} 8 * Author: Pete Keleher 9 * Author: Jonathan Guyer 10 * E-mail: jguyer@his.com 11 * mail: Alpha Cabal 12 * POMODORO no seisan 13 * www: http://www.his.com/jguyer/ 14 * 15 * ======================================================================== 16 * Copyright (c) 1999-2009 Jonathan Guyer 17 * Copyright (c) 1990-1998 Pete Keleher 18 * All rights reserved 19 * ======================================================================== 20 * Permission to use, copy, modify, and distribute this software and its 21 * documentation for any purpose and without fee is hereby granted, 22 * provided that the above copyright notice appear in all copies and that 23 * both that the copyright notice and warranty disclaimer appear in 24 * supporting documentation. 25 * 26 * The Authors disclaim all warranties with regard to this software, 27 * including all implied warranties of merchantability and fitness. In 28 * no event shall the Authors be liable for any special, indirect or 29 * consequential damages or any damages whatsoever resulting from loss of 30 * use, data or profits, whether in an action of contract, negligence or 31 * other tortuous action, arising out of or in connection with the use or 32 * performance of this software. 33 * 34 * ======================================================================== 35 * 36 * The command/subcommand implementation is from demoCmd.c in 37 * _Tcl/Tk for real programmers_ 38 * Copyright (c) 1997 Clif Flynt. 39 * All rights reserved. 40 * 41 * IN NO EVENT SHALL Clif Flynt BE LIABLE TO ANY PARTY FOR 42 * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT 43 * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF 44 * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 45 * 46 * Clif Flynt SPECIFICALLY DISCLAIMS ANY WARRANTIES, 47 * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY 48 * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS 49 * ON AN "AS IS" BASIS, AND Clif Flynt HAS NO OBLIGATION TO 50 * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. 51 * 52 * ======================================================================== 53 * See header file for further information 54 * ################################################################### 55 */ 56 57#include <string.h> 58#ifdef TCLAE_USE_FRAMEWORK_INCLUDES 59#include <Carbon/Carbon.h> 60#else 61#include <TextUtils.h> 62#include <Script.h> 63#include <NSLCore.h> 64#include <OpenTransportProviders.h> 65#include <Gestalt.h> 66#include <LaunchServices.h> 67#endif 68 69#if TARGET_API_MAC_CARBON 70/* Needed for building on Jaguar */ 71#ifndef typeApplicationBundleID 72#define typeApplicationBundleID 'bund' 73#endif 74 75#endif 76 77#include "tclAEInt.h" 78#include "tclMacOSError.h" 79 80#ifdef MAC_TCL 81#include <tclMacInt.h> 82#elif TARGET_RT_MAC_MACHO 83#include "osxMacTcl.h" 84#endif 85 86#ifndef TCLAE_NO_EPPC 87typedef struct nameFilter { 88 Str32 portName; 89 struct nameFilter * next; 90} nameFilter; 91 92typedef struct typeCreatorFilter { 93 OSType portType; 94 OSType portCreator; 95 struct typeCreatorFilter * next; 96} typeCreatorFilter; 97 98static typeCreatorFilter * tclAETypeCreatorFilters; 99static nameFilter * tclAENameFilters; 100#endif 101 102 103static void FreeAEAddressInternalRep(Tcl_Obj * objPtr); 104static void DupAEAddressInternalRep(Tcl_Obj * srcPtr, Tcl_Obj * dupPtr); 105static void UpdateStringOfAEAddress(Tcl_Obj * objPtr); 106static int SetAEAddressFromAny(Tcl_Interp * interp, Tcl_Obj * objPtr); 107 108 109/* 110 * The structure below defines the Tcl obj AEAddress type. 111 */ 112Tcl_ObjType tclAEAddressType = { 113 "AEAddress", /* name */ 114 FreeAEAddressInternalRep, /* freeIntRepProc */ 115 DupAEAddressInternalRep, /* dupIntRepProc */ 116 UpdateStringOfAEAddress, /* updateStringProc */ 117 SetAEAddressFromAny /* setFromAnyProc */ 118}; 119 120/* Local application Regular Expression and indices */ 121 122static char * APPL_RE = "^('(....)'|.*)"; 123 124/* 125 * <application name> 126 * '<4CHR>' 127 * 128 * 1: application 129 * 2: creator code 130 */ 131enum { 132 APPL_GeneralRE = 0, 133 APPL_ApplicationRE, 134 APPL_CreatorRE 135}; 136 137/* AppleTalk Regular Expression and indices */ 138 139static char * AT_RE = "^('(....)'|.*)( on ([^@:]+)(:([^@]+))?(@(.*))?)"; 140 141/* 142 * <application name> on <machine>[:type][@zone] 143 * '<4CHR>' on <machine>[:type][@zone] 144 * 145 * 1: application 146 * 2: creator code 147 * 3: AppleTalk specifier 148 * 4: machine name 149 * 6: type 150 * 8: zone 151 */ 152enum { 153 AT_GeneralRE = 0, 154 AT_ApplicationRE, 155 AT_CreatorRE, 156 AT_AddressRE, 157 AT_MachineRE, 158 AT_TypeDummyRE, 159 AT_TypeRE, 160 AT_ZoneDummyRE, 161 AT_ZoneRE 162}; 163 164/* 165* The cmdDefinition structure describes the minimum and maximum number 166* of expected arguments for the subcommand (including cmd and subcommand 167* names), and a usage message to return if the argument 168* count is outside the expected range. 169*/ 170 171typedef struct cmd_Def { 172 char * usage; 173 int minArgCnt; 174 int maxArgCnt; 175} cmdDefinition; 176 177#ifndef TCLAE_NO_EPPC 178/* Prototypes for internal routines */ 179pascal Boolean Tclae_PortFilter(LocationNameRec *locationName, PortInfoRec *thePortInfo); 180 181static void deleteFilters(); 182static int parseNameFilters(Tcl_Interp *interp, Tcl_Obj *listPtr); 183static int parseTypeCreatorFilters(Tcl_Interp *interp, Tcl_Obj *listPtr); 184static int setTargetLocation(Tcl_Interp *interp, Tcl_Obj *addressObj, LocationNameRec *locationPtr); 185 186Tcl_Obj * TclaeNewAEAddressObjFromTarget(Tcl_Interp * interp, TargetID * targetPtr); 187#endif 188 189Tcl_Obj * TclaeNewAEAddressObjFromPSN(Tcl_Interp * interp, ProcessSerialNumber thePSN); 190#if TARGET_API_MAC_CARBON 191Tcl_Obj * TclaeNewAEAddressObjFromCFURL(Tcl_Interp * interp, CFURLRef theURL); 192#endif 193 194static int pStrcmp(ConstStringPtr s1, ConstStringPtr s2); 195void PStringToUtfAndAppendToObj(Tcl_Obj *objPtr, ConstStringPtr pString); 196static Tcl_Obj * PStringToUtfObj(ConstStringPtr pString); 197static void UtfObjToPString(Tcl_Obj *objPtr, StringPtr pString, int len); 198static Tcl_Obj * UnsignedLongToTclObj(unsigned int inLong); 199 200static Tcl_Obj * UtfPathObjFromRef(Tcl_Interp * interp, FSRef *fsrefPtr); 201#if !__LP64__ 202static Tcl_Obj * UtfPathObjFromSpec(Tcl_Interp * interp, FSSpec *spec); 203#endif // !__LP64__ 204#if !TARGET_API_MAC_CARBON 205static int SpecFromUtfPathObj(Tcl_Interp * interp, Tcl_Obj * pathObj, FSSpec* spec); 206#endif 207 208 209/* ���� Public package routines ���� */ 210 211#if TARGET_API_MAC_CARBON 212 213static OSStatus 214AppLaunchNotificationHandler(EventHandlerCallRef inHandlerCallRef, 215 EventRef inEvent, 216 void* inUserData) 217{ 218 GetEventParameter(inEvent, kEventParamProcessID, 219 typeProcessSerialNumber, NULL, 220 sizeof(ProcessSerialNumber), NULL, 221 inUserData); 222 223 return CallNextEventHandler(inHandlerCallRef, inEvent); 224} 225 226DEFINE_ONE_SHOT_HANDLER_GETTER( AppLaunchNotificationHandler ); 227 228static CFURLRef 229TclaeCopyAppURL(Tcl_Interp * interp, Tcl_Obj * appObj) 230{ 231 OSStatus err; 232 CFURLRef appURL = NULL; 233 OSType creator = kLSUnknownCreator; 234 CFStringRef bundleID = NULL; 235 CFStringRef name = NULL; 236 AEAddressDesc * addressDesc; 237 238 if (Tclae_GetConstAEDescFromObj(interp, appObj, (const AEDesc **) &addressDesc, true) == TCL_OK) { 239 switch (addressDesc->descriptorType) { 240 case typeApplicationURL: 241 break; 242 case typeApplicationBundleID: { 243 Size numChars = AEGetDescDataSize((AEDesc *) addressDesc); 244 OSStatus err; 245 Tcl_DString ds; 246 247 Tcl_DStringInit(&ds); 248 Tcl_DStringSetLength(&ds, numChars); 249 err = AEGetDescData((AEDesc *) addressDesc, Tcl_DStringValue(&ds), numChars); 250 bundleID = CFStringCreateWithCString(NULL, Tcl_DStringValue(&ds), kCFStringEncodingUTF8); 251 Tcl_DStringFree(&ds); 252 } 253 break; 254 } 255 } 256 257 if (bundleID == NULL) { 258 creator = TclaeGetOSTypeFromObj(appObj); 259 if (creator == kLSUnknownCreator) { 260 name = CFStringCreateWithCharacters(NULL, Tcl_GetUnicode(appObj), Tcl_GetCharLength(appObj)); 261 } 262 } 263 264 err = LSFindApplicationForInfo(creator, bundleID, name, 265 NULL, &appURL); 266 267 switch (err) { 268 case noErr: 269 break; 270 case kLSApplicationNotFoundErr: 271 appURL = CFURLCreateFromFileSystemRepresentation(kCFAllocatorDefault, (UInt8 *) Tcl_GetString(appObj), Tcl_GetCharLength(appObj), false); 272 default: 273 Tcl_ResetResult(interp); 274 Tcl_AppendResult(interp, "Unable to launch ", 275 Tcl_GetString(appObj), ": ", 276 Tcl_MacOSError(interp, err), 277 (char *) NULL); 278 } 279 280 return appURL; 281} 282 283static int 284TclaeLaunch(Tcl_Interp * interp, Tcl_Obj * appObj, Boolean foreGround, Boolean newInstance, ProcessSerialNumber * thePSNp) 285{ 286 LSLaunchURLSpec lsSpec = {NULL, NULL, NULL, kLSLaunchDefaults, thePSNp}; 287 OSStatus err; 288 int result = TCL_OK; 289 const EventTypeSpec eventList[] = {{kEventClassApplication, kEventAppLaunchNotification}}; 290 EventHandlerRef handlerRef; 291 EventRef outEvent; 292 FSRef launchLocation; 293 CFURLRef outURL; 294 295 lsSpec.appURL = TclaeCopyAppURL(interp, appObj); 296 if (lsSpec.appURL == NULL) { 297 // error message already in interpreter 298 return TCL_ERROR; 299 } 300 301 if (!foreGround) { 302 lsSpec.launchFlags |= kLSLaunchDontSwitch; 303 } 304 305 if (newInstance) { 306 lsSpec.launchFlags |= kLSLaunchNewInstance; 307 } else { 308 thePSNp->highLongOfPSN = kNoProcess; 309 thePSNp->lowLongOfPSN = kNoProcess; 310 311 if (!CFURLGetFSRef(lsSpec.appURL, &launchLocation)) { 312 Tcl_ResetResult(interp); 313 Tcl_AppendResult(interp, "Unable to launch ", 314 Tcl_GetString(appObj), ": ", 315 Tcl_MacOSError(interp, fnfErr), 316 (char *) NULL); 317 return TCL_ERROR; 318 } 319 320 // We need to be ABSOLUTELY CERTAIN that we don't relaunch the same app, but instead 321 // just return its PSN. 322 // Relaunching is not itself a problem, but a relaunch will not send kEventAppLaunchNotification 323 // so ReceiveNextEvent() below will wait forever 324 while (GetNextProcess(thePSNp) != procNotFound) { 325 FSRef processLocation; 326 327 err = GetProcessBundleLocation(thePSNp, &processLocation); 328 if (err == noErr) { 329 // See if the PSNs of this process and the launch request match 330 Boolean running = (FSCompareFSRefs(&processLocation, &launchLocation) == noErr); 331 if (!running) { 332 // If they don't match, it's possible that the launch request is for the bundle 333 // executable and not just the bundle 334 // (/blah/blah/myapp.app/Contents/MacOS/myapp vs. /blah/blah/myapp.app/) 335 // 336 // This seems like an absurd amount of work for this, but nobody on CarbonDev 337 // could offer anything better. 338 CFURLRef processURL = CFURLCreateFromFSRef(kCFAllocatorDefault, &processLocation); 339 if (processURL) { 340 CFBundleRef processBundle = CFBundleCreate(kCFAllocatorDefault, processURL); 341 if (processBundle) { 342 CFURLRef executableURL = CFBundleCopyExecutableURL(processBundle); 343 if (executableURL) { 344 FSRef executableLocation; 345 if (CFURLGetFSRef(executableURL, &executableLocation)) { 346 running = (FSCompareFSRefs(&executableLocation, &launchLocation) == noErr); 347 } 348 CFRelease(executableURL); 349 } 350 CFRelease(processBundle); 351 } 352 } 353 CFRelease(processURL); 354 } 355 if (running) { 356 // Launched app is already running, so return its PSN. If the 357 // -foreground option is specified, bring the process to front 358 // (see Bug 2372 in Alpha-Bugzilla). 359 OSErr theErr = noErr; 360 if (foreGround) { 361 theErr = SetFrontProcess(thePSNp); 362 } 363 if (theErr == noErr) { 364 return TCL_OK; 365 } else { 366 Tcl_ResetResult(interp); 367 Tcl_AppendResult(interp, "Unable to foreground ", 368 Tcl_GetString(appObj), ": ", 369 Tcl_MacOSError(interp, theErr), 370 (char *) NULL); 371 return TCL_ERROR; 372 } 373 } 374 } 375 } 376 } 377 378 err = InstallApplicationEventHandler(GetAppLaunchNotificationHandlerUPP(), 379 GetEventTypeCount(eventList), eventList, 380 thePSNp, &handlerRef); 381 if (err == noErr) { 382 err = LSOpenFromURLSpec(&lsSpec, &outURL); 383 } 384 385 if (err != noErr) { 386 Tcl_ResetResult(interp); 387 Tcl_AppendResult(interp, "Unable to launch ", 388 Tcl_GetString(appObj), ": ", 389 Tcl_MacOSError(interp, err), 390 (char *) NULL); 391 result = TCL_ERROR; 392 } 393 394 err = ReceiveNextEvent(GetEventTypeCount(eventList), eventList, kEventDurationForever, true, &outEvent); 395 err = SendEventToEventTarget(outEvent, GetEventDispatcherTarget()); 396 397 RemoveEventHandler(handlerRef); 398 CFRelease(lsSpec.appURL); 399 400 return result; 401} 402 403#else // !TARGET_API_MAC_CARBON 404 405static int 406TclaeLaunch(Tcl_Interp * interp, Tcl_Obj * appObj, Boolean foreGround, Boolean newInstance, ProcessSerialNumber * thePSNp) 407{ 408 LaunchParamBlockRec lRec; 409 FSSpec spec; 410 OSStatus err; 411 412 if (SpecFromUtfPathObj(interp, appObj, &spec) == TCL_ERROR) { 413 return TCL_ERROR; 414 } 415 416 lRec.launchAppSpec = &spec; 417 lRec.launchBlockID = extendedBlock; 418 lRec.launchEPBLength = extendedBlockLen; 419 lRec.launchControlFlags = launchNoFileFlags | launchContinue; 420 if (!foreGround) { 421 lRec.launchControlFlags |= launchDontSwitch; 422 } 423 lRec.launchAppParameters = NULL; 424 425 err = LaunchApplication(&lRec); 426 if (err != noErr) { 427 Tcl_ResetResult(interp); 428 Tcl_AppendResult(interp, "Unable to launch ", 429 Tcl_GetString(appObj), ": ", 430 Tcl_MacOSError(interp, err), 431 (char *) NULL); 432 return TCL_ERROR; 433 } 434 435 *thePSNp = lRec.launchProcessSN; 436 437 return TCL_OK; 438} 439#endif // TARGET_API_MAC_CARBON 440 441/* 442 * ------------------------------------------------------------------------- 443 * 444 * "Tclae_LaunchCmd" -- 445 * 446 * Launch the named app into the background. 447 * 448 * tclAE::launch [-f] <name> 449 * 450 * Results: 451 * ??? 452 * 453 * Side effects: 454 * None. 455 * ------------------------------------------------------------------------- 456 */ 457int 458Tclae_LaunchCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) 459{ 460 Boolean foreGround = false; 461 Boolean newInstance = false; 462 ProcessSerialNumber thePSN; 463 int j; 464 465 /* Definitions for command options */ 466 CONST84 char *options[] = { 467 "-foreground", "-newInstance", NULL 468 }; 469 470 enum { 471 M_foregroundOption = 0, 472 M_newInstanceOption 473 }; 474 475 cmdDefinition optionDefinitions[] = { 476 {"-foreground", 2 , 2}, 477 {"-newInstance", 2 , 2}, 478 }; 479 480 for (j = 1; 481 (j < objc - 1) 482 && (Tcl_GetString(objv[j])[0] == '-'); 483 j++) { 484 485 int cmdnum; 486 int result = Tcl_GetIndexFromObj(interp, objv[j], options, 487 "option", 0 /* TCL_EXACT */, &cmdnum); 488 489 /* 490 * If the result is not TCL_OK, then the error message is already 491 * in the Tcl Interpreter, this code can immediately return. 492 */ 493 494 if (result != TCL_OK) { 495 return TCL_ERROR; 496 } 497 498 /* 499 * Check that the argument count matches what's expected for this 500 * Option. 501 */ 502 503 if (((objc - j + 1) < optionDefinitions[cmdnum].minArgCnt)) { 504 Tcl_WrongNumArgs(interp, 1, objv, optionDefinitions[cmdnum].usage); 505 return TCL_ERROR; 506 } 507 508 switch (cmdnum) { 509 case M_foregroundOption: 510 foreGround = true; 511 break; 512 case M_newInstanceOption: 513 newInstance = true; 514 break; 515 default: 516 Tcl_ResetResult(interp); 517 Tcl_AppendResult(interp, "Bad option: ", Tcl_GetString(objv[j]), 518 ". Has no entry in switch.", 519 (char *) NULL); 520 return TCL_ERROR; 521 } 522 } 523 524 if (j >= objc) { 525 Tcl_WrongNumArgs(interp, 1, objv, "?options? name"); 526 return TCL_ERROR; 527 } 528 529 if (TclaeLaunch(interp, objv[j], foreGround, newInstance, &thePSN) != TCL_OK) { 530 return TCL_ERROR; 531 } else { 532 Tcl_Obj * psnObj = TclaeNewAEAddressObjFromPSN(interp, thePSN); 533 if (psnObj != NULL) { 534 Tcl_SetObjResult(interp, psnObj); 535 return TCL_OK; 536 } else { 537 return TCL_ERROR; 538 } 539 } 540} 541 542/* 543 * ------------------------------------------------------------------------- 544 * 545 * "Tclae_ProcessesCmd" -- 546 * 547 * Obtains info on active processes 548 * 549 * tclAE::processes 550 * 551 * Results: 552 * ??? 553 * 554 * Side effects: 555 * None. 556 * ------------------------------------------------------------------------- 557 */ 558int 559Tclae_ProcessesCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) 560{ 561 Tcl_Obj * processListObj = Tcl_NewObj(); 562 Tcl_Obj * processInfoObj = NULL; 563 Tcl_Obj * elementObj = NULL; 564 ProcessSerialNumber PSN; 565 int result = TCL_OK; 566 567 PSN.highLongOfPSN = 0; 568 PSN.lowLongOfPSN = kNoProcess; 569 570 while (GetNextProcess(&PSN) != procNotFound) { 571 ProcessInfoRec procInfoRec; 572 Str255 str; 573#if __LP64__ 574 FSRef theAppRef; 575#else 576 FSSpec theAppSpec; 577#endif // __LP64__ 578 579 procInfoRec.processName = str; 580#if __LP64__ 581 procInfoRec.processAppRef = &theAppRef; 582#else 583 procInfoRec.processAppSpec = &theAppSpec; 584#endif // __LP64__ 585 procInfoRec.processInfoLength = sizeof(procInfoRec); 586 587 if (GetProcessInformation(&PSN, &procInfoRec) == noErr) { 588 processInfoObj = Tcl_NewObj(); 589 590 // Name 591 elementObj = PStringToUtfObj(procInfoRec.processName); 592 result = Tcl_ListObjAppendElement(interp, processInfoObj, elementObj); 593 if (result != TCL_OK) { 594 break; 595 } 596 597 // Signature 598 elementObj = TclaeNewOSTypeObj(procInfoRec.processSignature); 599 result = Tcl_ListObjAppendElement(interp, processInfoObj, elementObj); 600 if (result != TCL_OK) { 601 break; 602 } 603 604 // Type 605 elementObj = TclaeNewOSTypeObj(procInfoRec.processType); 606 result = Tcl_ListObjAppendElement(interp, processInfoObj, elementObj); 607 if (result != TCL_OK) { 608 break; 609 } 610 611 // Launch date 612// elementObj = Tcl_NewLongObj(procInfoRec.processLaunchDate); 613 elementObj = UnsignedLongToTclObj(procInfoRec.processLaunchDate); 614 result = Tcl_ListObjAppendElement(interp, processInfoObj, elementObj); 615 if (result != TCL_OK) { 616 break; 617 } 618 619 // PSN 620 elementObj = TclaeNewAEAddressObjFromPSN(interp, procInfoRec.processNumber); 621 if (elementObj == NULL) { 622 result = TCL_ERROR; 623 break; 624 } 625 result = Tcl_ListObjAppendElement(interp, processInfoObj, elementObj); 626 if (result != TCL_OK) { 627 break; 628 } 629 630 // Path 631#if __LP64__ 632 elementObj = UtfPathObjFromRef(interp, procInfoRec.processAppRef); 633#else 634 elementObj = UtfPathObjFromSpec(interp, procInfoRec.processAppSpec); 635#endif // __LP64__ 636 if (elementObj == NULL) { 637 result = TCL_ERROR; 638 break; 639 } 640 result = Tcl_ListObjAppendElement(interp, processInfoObj, elementObj); 641 if (result != TCL_OK) { 642 break; 643 } 644 } 645 646 result = Tcl_ListObjAppendElement(interp, processListObj, processInfoObj); 647 if (result != TCL_OK) { 648 break; 649 } 650 } 651 if (result != TCL_OK) { 652 Tcl_DecrRefCount(processListObj); 653 if (processInfoObj != NULL) { 654 Tcl_DecrRefCount(processInfoObj); 655 } 656 if (elementObj != NULL) { 657 Tcl_DecrRefCount(elementObj); 658 } 659 result = TCL_ERROR; 660 } else { 661 Tcl_SetObjResult(interp, processListObj); 662 } 663 664 return result; 665} 666 667/* 668 * ------------------------------------------------------------------------- 669 * 670 * "Tclae_RemoteProcessResolverGetProcessesCmd" -- 671 * 672 * Obtains info on active processes 673 * 674 * tclAE::remoteProcessResolverGetProcesses 675 * 676 * Results: 677 * ??? 678 * 679 * Side effects: 680 * None. 681 * ------------------------------------------------------------------------- 682 */ 683int 684Tclae_RemoteProcessResolverGetProcessesCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) 685{ 686 Tcl_Obj * processListObj = Tcl_NewObj(); 687 Tcl_Obj * processInfoObj = NULL; 688 689 CFURLRef urlRef; 690 AERemoteProcessResolverRef resolverRef; 691 CFStreamError streamError; 692 CFArrayRef remoteProcessArray; 693 CFIndex idx, count; 694 int result = TCL_OK; 695 696 697 if (objc != 2) { 698 Tcl_WrongNumArgs(interp, 1, objv, "url"); 699 return TCL_ERROR; 700 } 701 702 urlRef = CFURLCreateWithBytes(kCFAllocatorDefault, 703 (UInt8 *) Tcl_GetString(objv[1]), Tcl_GetCharLength(objv[1]), 704 kCFStringEncodingUTF8, NULL); 705 if (urlRef == NULL) { 706 return TCL_ERROR; 707 } 708 709 resolverRef = AECreateRemoteProcessResolver(kCFAllocatorDefault, urlRef); 710 remoteProcessArray = AERemoteProcessResolverGetProcesses(resolverRef, &streamError); 711 if (remoteProcessArray == NULL) { 712 switch (streamError.domain) { 713 case kCFStreamErrorDomainCustom: { 714 715 } 716 case kCFStreamErrorDomainPOSIX: { 717 } 718 case kCFStreamErrorDomainMacOSStatus: { 719 720 } 721/* 722 * kCFStreamErrorDomainNetDB 723 * 724 * kCFStreamErrorDomainNetServices 725 * 726 * kCFStreamErrorDomainMach 727 * 728 * kCFStreamErrorDomainFTP 729 * 730 * kCFStreamErrorDomainHTTP 731 * 732 * kCFStreamErrorDomainSOCKS 733 * 734 * kCFStreamErrorDomainSystemConfiguration 735 * 736 * kCFStreamErrorDomainSSL 737 */ 738 } 739 return TCL_ERROR; 740 } 741 742 CFRetain(remoteProcessArray); 743 AEDisposeRemoteProcessResolver(resolverRef); 744 745 count = CFArrayGetCount(remoteProcessArray); 746 747 for (idx = 0; idx < count; idx++) { 748 CFDictionaryRef theDict = CFArrayGetValueAtIndex(remoteProcessArray, idx); 749 CFURLRef processURL; 750 CFURLRef absoluteProcessURL; 751 CFStringRef name; 752 CFNumberRef number; 753 long value; 754 755 756 processInfoObj = Tcl_NewObj(); 757 758 if (!CFDictionaryGetValueIfPresent(theDict, kAERemoteProcessURLKey, (const void **) &processURL)) { 759 result = TCL_ERROR; 760 break; 761 } 762 763 absoluteProcessURL = CFURLCopyAbsoluteURL(processURL); 764 result = Tcl_ListObjAppendElement(interp, processInfoObj, TclaeNewAEAddressObjFromCFURL(interp, absoluteProcessURL)); 765 CFRelease(absoluteProcessURL); 766 if (result != TCL_OK) { 767 break; 768 } 769 770 if (!CFDictionaryGetValueIfPresent(theDict, kAERemoteProcessNameKey, (const void **) &name)) { 771 result = TCL_ERROR; 772 break; 773 } 774 775 result = Tcl_ListObjAppendElement(interp, processInfoObj, CFStringToTclObj(name)); 776 if (result != TCL_OK) { 777 break; 778 } 779 780 if (!CFDictionaryGetValueIfPresent(theDict, kAERemoteProcessUserIDKey, (const void **) &number)) { 781 result = TCL_ERROR; 782 break; 783 } 784 785 CFNumberGetValue(number, kCFNumberLongType, &value); 786 787 result = Tcl_ListObjAppendElement(interp, processInfoObj, Tcl_NewLongObj(value)); 788 if (result != TCL_OK) { 789 break; 790 } 791 792 if (!CFDictionaryGetValueIfPresent(theDict, kAERemoteProcessProcessIDKey, (const void **) &number)) { 793 result = TCL_ERROR; 794 break; 795 } 796 797 CFNumberGetValue(number, kCFNumberLongType, &value); 798 799 result = Tcl_ListObjAppendElement(interp, processInfoObj, Tcl_NewLongObj(value)); 800 if (result != TCL_OK) { 801 break; 802 } 803 804 result = Tcl_ListObjAppendElement(interp, processListObj, processInfoObj); 805 if (result != TCL_OK) { 806 break; 807 } 808 } 809 810 CFRelease(remoteProcessArray); 811 812 if (result != TCL_OK) { 813 Tcl_DecrRefCount(processListObj); 814 if (processInfoObj != NULL) { 815 Tcl_DecrRefCount(processInfoObj); 816 } 817 result = TCL_ERROR; 818 } else { 819 Tcl_SetObjResult(interp, processListObj); 820 } 821 822 return result; 823} 824 825#if !TARGET_API_MAC_CARBON && !defined(TCLAE_NO_EPPC) // das 25/10/00: Carbonization 826/* 827 * ------------------------------------------------------------------------- 828 * 829 * "Tclae_IPCListPortsCmd" -- 830 * 831 * Tcl wrapper for ToolBox IPCListPorts call. 832 * 833 * tclAE::IPCListPorts ppcNoLocation 834 * tclAE::IPCListPorts ppcNBPLocation <objStr> <typeStr> <zoneStr> 835 * tclAE::IPCListPorts ppcXTIAddrLocation <url> 836 * 837 * Results: 838 * ??? 839 * 840 * Side effects: 841 * None. 842 * ------------------------------------------------------------------------- 843 */ 844int 845Tclae_IPCListPortsCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) 846{ 847 IPCListPortsPBRec theIPCListPortsPBRec; 848 /* By default, look for any application and any port */ 849 PPCPortRec thePPCPortRec = {smRoman, "\p=", ppcByString, "\p="}; 850 LocationNameRec theLocationNameRec; 851 PortInfoRec buffer[256]; 852 int cmdnum; 853 int j; 854 855 /* Definitions for primary command variants */ 856 857 CONST84 char *keywords[] = { 858 "ppcNoLocation", "ppcNBPLocation", "ppcXTIAddrLocation", 859 NULL 860 }; 861 862 enum { 863 M_ppcNoLocation = 0, 864 M_ppcNBPLocation, 865 M_ppcXTIAddrLocation 866 }; 867 868 cmdDefinition definitions[] = { 869 {"ppcNoLocation", 2 , 2}, 870 {"ppcNBPLocation <objStr> <typeStr> <zoneStr>", 5, 5}, 871 {"ppcXTIAddrLocation <url>", 3, 3}, 872 }; 873 874 /* Definitions for command options */ 875 876 CONST84 char *options[] = { 877 "-n", "-pn", "-pc", NULL 878 }; 879 880 enum { 881 M_nameOption = 0, 882 M_portNameOption, 883 M_portCreatorTypeOption 884 }; 885 886 cmdDefinition optionDefinitions[] = { 887 {"-n <name>", 3 , 3}, 888 {"-pn <portTypeStr>", 3, 3}, 889 {"-pc <portCreator> <portType>", 4, 4}, 890 }; 891 892 for (j = 1; 893 (j < objc) 894 && (Tcl_GetString(objv[j])[0] == '-'); 895 j++) { 896 897 int result = Tcl_GetIndexFromObj(interp, objv[j], options, 898 "option", TCL_EXACT, &cmdnum); 899 900 /* 901 * If the result is not TCL_OK, then the error message is already 902 * in the Tcl Interpreter, this code can immediately return. 903 */ 904 905 if (result != TCL_OK) { 906 return TCL_ERROR; 907 } 908 909 /* 910 * Check that the argument count matches what's expected for this 911 * Option. 912 */ 913 914 if (((objc - j + 1) < optionDefinitions[cmdnum].minArgCnt)) { 915 Tcl_WrongNumArgs(interp, 1, objv, optionDefinitions[cmdnum].usage); 916 return TCL_ERROR; 917 } 918 919 switch (cmdnum) { 920 case M_nameOption: 921 UtfObjToPString(objv[++j], thePPCPortRec.name, 32); 922 break; 923 case M_portNameOption: 924 thePPCPortRec.portKindSelector = ppcByString; 925 UtfObjToPString(objv[++j], thePPCPortRec.u.portTypeStr, 31); 926 break; 927 case M_portCreatorTypeOption: 928 thePPCPortRec.portKindSelector = ppcByCreatorAndType; 929 thePPCPortRec.u.port.portCreator = TclaeGetOSTypeFromObj(objv[++j]); 930 thePPCPortRec.u.port.portType = TclaeGetOSTypeFromObj(objv[++j]); 931 break; 932 default: 933 Tcl_ResetResult(interp); 934 Tcl_AppendResult(interp, "Bad option: ", Tcl_GetString(objv[j]), 935 ". Has no entry in switch.", 936 (char *) NULL); 937 return TCL_ERROR; 938 } 939 } 940 941 /* 942 * Find this location subcommand in the list of subcommands. 943 * Tcl_GetIndexFromObj returns the offset of the recognized string, 944 * which is used to index into the command definitions table. 945 */ 946 947 if (j == objc) { 948 /* No location is OK */ 949 cmdnum = M_ppcNoLocation; 950 } else { 951 int result = Tcl_GetIndexFromObj(interp, objv[j], keywords, 952 "location", TCL_EXACT, &cmdnum); 953 954 /* 955 * If the result is not TCL_OK, then the error message is already 956 * in the Tcl Interpreter, this code can immediately return. 957 */ 958 959 if (result != TCL_OK) { 960 return TCL_ERROR; 961 } 962 963 /* 964 * Check that the argument count matches what's expected for this 965 * Subcommand. 966 */ 967 968 if (((objc - j + 1) < definitions[cmdnum].minArgCnt) 969 || ((objc - j + 1) > definitions[cmdnum].maxArgCnt) ) { 970 Tcl_WrongNumArgs(interp, 1, objv, definitions[cmdnum].usage); 971 return TCL_ERROR; 972 } 973 } 974 975 /* 976 * The subcommand is recognized, and has a valid number of arguments 977 * Process the command. 978 */ 979 980 switch (cmdnum) { 981 case M_ppcNoLocation: 982 theLocationNameRec.locationKindSelector = ppcNoLocation; 983 break; 984 case M_ppcNBPLocation: 985 theLocationNameRec.locationKindSelector = ppcNBPLocation; 986 UtfObjToPString(objv[++j], theLocationNameRec.u.nbpEntity.objStr, 32); 987 if (Tcl_GetCharLength(objv[++j]) > 0) { 988 UtfObjToPString(objv[j], theLocationNameRec.u.nbpEntity.typeStr, 32); 989 } else { 990 c2pstrcpy(theLocationNameRec.u.nbpEntity.typeStr, "PPCToolBox"); 991 } 992 UtfObjToPString(objv[++j], theLocationNameRec.u.nbpEntity.zoneStr, 32); 993 break; 994 case M_ppcXTIAddrLocation: 995 setTargetLocation(interp, objv[++j], &theLocationNameRec); 996 break; 997 default: 998 Tcl_ResetResult(interp); 999 Tcl_AppendResult(interp, "Bad sub-command: ", Tcl_GetString(objv[j]), 1000 ". Has no entry in switch.", 1001 (char *) NULL); 1002 return TCL_ERROR; 1003 } 1004 1005 theIPCListPortsPBRec.startIndex = 0; 1006 theIPCListPortsPBRec.requestCount = 256; 1007 theIPCListPortsPBRec.portName = &thePPCPortRec; 1008 theIPCListPortsPBRec.locationName = &theLocationNameRec; 1009 theIPCListPortsPBRec.bufferPtr = buffer; 1010 1011 if (IPCListPorts(&theIPCListPortsPBRec, false) != noErr) { 1012 Tcl_SetResult(interp, "Error listing ports", TCL_STATIC); 1013 return TCL_ERROR; 1014 } else { 1015 TargetID target; 1016 Tcl_Obj * portList = Tcl_NewObj(); 1017 1018 target.location = theLocationNameRec; 1019 1020 for (j = 0; 1021 j < theIPCListPortsPBRec.actualCount 1022 && j <= theIPCListPortsPBRec.requestCount; 1023 j++) { 1024 1025 /* What should this be, if anything? */ 1026 target.sessionID = 0; 1027 memcpy(&target.name, 1028 &buffer[j].name, 1029 sizeof (PPCPortRec)); 1030 /* what about recvrName? */ 1031 1032 Tcl_ListObjAppendElement(interp, portList, 1033 TclaeNewAEAddressObjFromTarget(interp, &target)); 1034 } 1035 1036 Tcl_SetObjResult(interp, portList); 1037 1038 return TCL_OK; 1039 } 1040} 1041 1042/* 1043 * ------------------------------------------------------------------------- 1044 * 1045 * "Tclae_PPCBrowserCmd" -- 1046 * 1047 * Tcl wrapper for ToolBox PPCBrowser call. Produces a TargetID and returns 1048 * a hash key for later access. 1049 * 1050 * Results: 1051 * Hash key for the TargetID. 1052 * 1053 * Side effects: 1054 * None. 1055 * ------------------------------------------------------------------------- 1056 */ 1057int 1058Tclae_PPCBrowserCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) 1059{ 1060 TargetID target; 1061 PortInfoRec thePortInfo; 1062 Str255 prompt = "\pChoose a program to link to"; 1063 Str255 label = "\pPrograms"; 1064 char *arg; 1065 int j; 1066 PPCFilterUPP theFilterProc = NULL; 1067 OSStatus err; 1068 1069 for (j = 1; (j < objc) && ((arg = Tcl_GetString(objv[j]))[0] == '-'); j++) { 1070 switch (arg[1]) { 1071 case 'p': 1072 /* prompt */ 1073 UtfObjToPString(objv[++j], prompt, 255); 1074 break; 1075 case 'l': 1076 /* application label */ 1077 UtfObjToPString(objv[++j], label, 255); 1078 break; 1079 case 'f': 1080 /* filter */ 1081 switch (arg[2]) { 1082 case 'n': 1083 /* names */ 1084 if (parseNameFilters(interp, objv[++j]) != TCL_OK) { 1085 return TCL_ERROR; 1086 } 1087 theFilterProc = NewPPCFilterUPP(Tclae_PortFilter); 1088 break; 1089 case 'c': 1090 /* creator-types */ 1091 if (parseTypeCreatorFilters(interp, objv[++j]) != TCL_OK) { 1092 return TCL_ERROR; 1093 } 1094 theFilterProc = NewPPCFilterUPP(Tclae_PortFilter); 1095 break; 1096 } 1097 break; 1098 default: 1099 Tcl_ResetResult(interp); 1100 Tcl_AppendResult(interp, "Bad option: ", arg, 1101 ". Has no entry in switch.", 1102 (char *) NULL); 1103 return TCL_ERROR; 1104 } 1105 } 1106 1107 // !!! Application MUST be in the foreground before this call !!! 1108 // (although OS 8.6, at least, doesn't seem to mind) 1109 1110 err = PPCBrowser(prompt, label, false, &target.location, &thePortInfo, 1111 theFilterProc, (ConstStr32Param) ""); 1112 if (err != noErr) { 1113 Tcl_ResetResult(interp); 1114 Tcl_AppendResult(interp, "PPCBrowser failure: ", 1115 Tcl_MacOSError(interp, err), 1116 (char *) NULL); 1117 return TCL_ERROR; 1118 } 1119 1120 deleteFilters(); 1121 1122 target.name = thePortInfo.name; 1123 1124 Tcl_SetObjResult(interp, TclaeNewAEAddressObjFromTarget(interp, &target)); 1125 1126 return TCL_OK; 1127} 1128#endif //!TARGET_API_MAC_CARBON // das 25/10/00: Carbonization 1129 1130#ifndef TCLAE_NO_EPPC 1131/* ���� Quasi-public utilities ���� */ 1132 1133pascal Boolean Tclae_PortFilter(LocationNameRec *locationName, PortInfoRec *thePortInfo) 1134{ 1135 int j, count; 1136 Boolean result = false; 1137 nameFilter * nextNameFilter; 1138 typeCreatorFilter * nextTCFilter; 1139 1140 switch (thePortInfo->name.portKindSelector) { 1141 case ppcByString: 1142 for (nextNameFilter = tclAENameFilters; 1143 nextNameFilter != NULL; 1144 nextNameFilter = nextNameFilter->next) { 1145 1146 if (pStrcmp(thePortInfo->name.u.portTypeStr, 1147 nextNameFilter->portName) == 0) { 1148 result = true; 1149 break; 1150 } 1151 } 1152 break; 1153 1154 case ppcByCreatorAndType: 1155 for (nextTCFilter = tclAETypeCreatorFilters; 1156 nextTCFilter != NULL; 1157 nextTCFilter = nextTCFilter->next) { 1158 1159 if ((thePortInfo->name.u.port.portCreator == nextTCFilter->portCreator) 1160 && (thePortInfo->name.u.port.portType == nextTCFilter->portType)) { 1161 result = true; 1162 break; 1163 } 1164 } 1165 break; 1166 } 1167 1168 return result; 1169} 1170#endif 1171 1172/* ���� Internal package routines ���� */ 1173 1174/* 1175 * ------------------------------------------------------------------------- 1176 * 1177 * "TclaeInitAEAddresses" -- 1178 * 1179 * Initialize the AEAddress Tcl object type, allowing Tcl to easily 1180 * reestablish contact with the same process. 1181 * 1182 * Results: 1183 * None. 1184 * 1185 * Side effects: 1186 * tclAEAddressType is registered. 1187 * ------------------------------------------------------------------------- 1188 */ 1189void 1190TclaeInitAEAddresses() 1191{ 1192 Tcl_RegisterObjType(&tclAEAddressType); 1193} 1194 1195/* ���� Private utilities ���� */ 1196#ifndef TCLAE_NO_EPPC 1197static void 1198deleteFilters() 1199{ 1200 nameFilter *nameFilterPtr; 1201 typeCreatorFilter *typeCreatorFilterPtr; 1202 1203 while ((nameFilterPtr = tclAENameFilters) != NULL) { 1204 tclAENameFilters = nameFilterPtr->next; 1205 ckfree((char *) nameFilterPtr); 1206 } 1207 1208 while ((typeCreatorFilterPtr = tclAETypeCreatorFilters) != NULL) { 1209 tclAETypeCreatorFilters = typeCreatorFilterPtr->next; 1210 ckfree((char *) typeCreatorFilterPtr); 1211 } 1212} 1213 1214static int 1215parseNameFilters(Tcl_Interp *interp, Tcl_Obj *listPtr) 1216{ 1217 int res = TCL_OK, count; 1218 1219 if (((res = Tcl_ListObjLength( interp, listPtr, &count )) == TCL_OK) 1220 && (count > 0)) { 1221 1222 int j; 1223 1224 for (j = 0; j < count; j++) { 1225 Tcl_Obj * filterPtr; 1226 nameFilter * nameFilterPtr = (nameFilter *) ckalloc(sizeof(nameFilter)); 1227 1228 nameFilterPtr->next = tclAENameFilters; 1229 tclAENameFilters = nameFilterPtr; 1230 1231 Tcl_ListObjIndex( interp, listPtr, j, &filterPtr ); 1232 UtfObjToPString(filterPtr, nameFilterPtr->portName, 32); 1233 } 1234 } 1235 1236 return res; 1237} 1238 1239static int 1240parseTypeCreatorFilters(Tcl_Interp *interp, Tcl_Obj *listPtr) 1241{ 1242 int result = TCL_OK; 1243 int count; 1244 1245 if ((result = Tcl_ListObjLength( interp, listPtr, &count )) == TCL_OK 1246 && count > 0) { 1247 1248 int j; 1249 1250 for (j = 0; j < count; j++) { 1251 Tcl_Obj * filterObj; 1252 Tcl_Obj * codeObj; 1253 int numElements; 1254 typeCreatorFilter * typeCreatorFilterPtr 1255 = (typeCreatorFilter *) ckalloc(sizeof(typeCreatorFilter)); 1256 1257 typeCreatorFilterPtr->next = tclAETypeCreatorFilters; 1258 tclAETypeCreatorFilters = typeCreatorFilterPtr; 1259 1260 Tcl_ListObjIndex(interp, listPtr, j, &filterObj); 1261 if ((result = Tcl_ListObjLength( interp, filterObj, &numElements )) != TCL_OK 1262 || numElements != 2) { 1263 result = TCL_ERROR; 1264 break; 1265 } 1266 Tcl_ListObjIndex( interp, filterObj, 0, &codeObj ); 1267 typeCreatorFilterPtr->portType = TclaeGetOSTypeFromObj(codeObj); 1268 Tcl_ListObjIndex( interp, filterObj, 1, &codeObj ); 1269 typeCreatorFilterPtr->portCreator = TclaeGetOSTypeFromObj(codeObj); 1270 } 1271 } 1272 1273 return result; 1274} 1275#endif 1276 1277// lifted from oldEndre.c 1278static Tcl_Obj * 1279UtfPathObjFromRef(Tcl_Interp * interp, FSRef *fsrefPtr) 1280{ 1281 Tcl_Obj * pathObj = NULL; 1282 OSErr err; 1283 Handle pathString = NULL; 1284 int size; 1285 1286 err = FSpPathFromLocation(fsrefPtr, &size, &pathString); 1287 if (err == noErr) { 1288 Tcl_DString ds; 1289 1290 Tcl_DStringInit(&ds); 1291 HLock(pathString); 1292 Tcl_ExternalToUtfDString(tclAE_macRoman_encoding, *pathString, size, &ds); 1293 DisposeHandle(pathString); 1294 1295 pathObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); 1296 Tcl_DStringFree(&ds); 1297 } 1298 1299 return pathObj; 1300} 1301 1302#if !__LP64__ 1303static Tcl_Obj * 1304UtfPathObjFromSpec(Tcl_Interp * interp, FSSpec *spec) 1305{ 1306 Tcl_Obj * pathObj = NULL; 1307 FSRef fsref; 1308 OSErr err; 1309 1310 err = FSpMakeFSRef(spec, &fsref); 1311 if (err == noErr) { 1312 pathObj = UtfPathObjFromRef(interp, &fsref); 1313 } 1314 1315 return pathObj; 1316} 1317#endif // !__LP64__ 1318 1319#if !TARGET_API_MAC_CARBON 1320// lifted from io.c 1321static int 1322SpecFromUtfPathObj(Tcl_Interp * interp, Tcl_Obj * pathObj, FSSpec* spec) { 1323 Tcl_DString ds; 1324 OSErr err; 1325 1326 Tcl_UtfToExternalDString(tclAE_macRoman_encoding, Tcl_GetString(pathObj), -1, &ds); 1327 err = FSpLocationFromPath(Tcl_DStringLength(&ds),Tcl_DStringValue(&ds), spec); 1328 if (err == noErr) { 1329 Boolean folder; 1330 Boolean aliased; 1331 1332 err = ResolveAliasFile(spec, TRUE, &folder, &aliased); 1333 } 1334 1335 Tcl_DStringFree(&ds); 1336 1337 if (err != noErr) { 1338 Tcl_AppendResult(interp, "Can't locate '", Tcl_GetString(pathObj), "'", (char *) NULL); 1339 return TCL_ERROR; 1340 } else { 1341 return TCL_OK; 1342 } 1343} 1344#endif // #if !TARGET_API_MAC_CARBON 1345 1346 1347/*=========================== Pascal Strings ============================*/ 1348 1349static int pStrcmp(ConstStringPtr s1, ConstStringPtr s2) 1350{ 1351 size_t len = s1[0]; 1352 size_t res; 1353 1354 if (s2[0] < len) { 1355 len = s2[0]; 1356 } 1357 res = strncmp((const char *) s1+1, (const char *) s2+1, len); 1358 if (res) { 1359 return(res); 1360 } 1361 return((int)(s1[0] - s2[0])); 1362} 1363 1364void 1365PStringToUtfAndAppendToObj(Tcl_Obj *objPtr, ConstStringPtr pString) 1366{ 1367 Tcl_DString tempDS; 1368 1369 Tcl_DStringInit(&tempDS); 1370 Tcl_AppendToObj(objPtr, 1371 Tcl_ExternalToUtfDString(tclAE_macRoman_encoding, 1372 (char *) &pString[1], 1373 pString[0], 1374 &tempDS), 1375 Tcl_DStringLength(&tempDS)); 1376 1377 Tcl_DStringFree(&tempDS); 1378} 1379 1380static Tcl_Obj * 1381PStringToUtfObj(ConstStringPtr pString) 1382{ 1383 Tcl_Obj * obj = Tcl_NewObj(); 1384 char * utfStr; 1385 Tcl_DString tempDS; 1386 1387 Tcl_DStringInit(&tempDS); 1388 1389 utfStr = Tcl_ExternalToUtfDString(tclAE_macRoman_encoding, 1390 (char *) &pString[1], 1391 pString[0], 1392 &tempDS); 1393 1394 Tcl_AppendToObj(obj, utfStr, Tcl_DStringLength(&tempDS)); 1395 1396 Tcl_DStringFree(&tempDS); 1397 1398 return obj; 1399} 1400 1401static void UtfObjToPString(Tcl_Obj *objPtr, StringPtr pString, int len) 1402{ 1403 CFStringRef theString; 1404 1405 theString = TclObjToCFString(objPtr); 1406 CFStringGetPascalString(theString, pString, len+1, kCFStringEncodingMacRoman); 1407} 1408 1409static Tcl_Obj * 1410UnsignedLongToTclObj(unsigned int inLong) 1411{ 1412 Tcl_Obj * obj = Tcl_NewObj(); 1413 char str[64]; 1414 1415 sprintf(str, "%u%c", inLong, 0); 1416 Tcl_AppendToObj(obj, str, strlen(str)); 1417 1418 return obj; 1419} 1420 1421/*======================== Tcl AEAddress Object =========================*/ 1422 1423/* 1424 *---------------------------------------------------------------------- 1425 * 1426 * FreeAEAddressInternalRep -- 1427 * 1428 * Frees the resources associated with a AEAddress object's internal 1429 * representation. 1430 * 1431 * Results: 1432 * None. 1433 * 1434 * Side effects: 1435 * None. 1436 * 1437 *---------------------------------------------------------------------- 1438 */ 1439 1440static void 1441FreeAEAddressInternalRep(Tcl_Obj *objPtr) /* AEAddress object with internal 1442 * representation to free. */ 1443{ 1444 AEAddressDesc * descPtr = (AEAddressDesc *) objPtr->internalRep.otherValuePtr; 1445 1446 if (descPtr != NULL) { 1447 AEDisposeDesc(descPtr); 1448 ckfree((char *) descPtr); 1449 objPtr->internalRep.otherValuePtr = NULL; 1450 } 1451} 1452 1453/* 1454 *---------------------------------------------------------------------- 1455 * 1456 * DupAEAddressInternalRep -- 1457 * 1458 * Initialize the internal representation of an AEAddress Tcl_Obj to a 1459 * copy of the internal representation of an existing AEAddress object. 1460 * 1461 * Results: 1462 * None. 1463 * 1464 * Side effects: 1465 * Internal rep AEAddressDesc of "srcPtr" is duplicated and stored in 1466 * "dupPtr". 1467 * 1468 *---------------------------------------------------------------------- 1469 */ 1470 1471static void 1472DupAEAddressInternalRep(Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ 1473 Tcl_Obj *dupPtr) /* Object with internal rep to set. */ 1474{ 1475 dupPtr->internalRep.otherValuePtr = ckalloc(sizeof(AEAddressDesc)); 1476 1477 /* no point in checking the result because we have no way to report it */ 1478 AEDuplicateDesc((AEAddressDesc *) srcPtr->internalRep.otherValuePtr, 1479 (AEAddressDesc *) dupPtr->internalRep.otherValuePtr); 1480 1481 dupPtr->typePtr = &tclAEAddressType; 1482} 1483 1484/*------------------- update internal representation --------------------*/ 1485 1486#if !TARGET_API_MAC_CARBON && !defined(TCLAE_NO_EPPC) 1487static int 1488setTargetLocation(Tcl_Interp *interp, Tcl_Obj *addressObj, LocationNameRec *locationPtr) 1489{ 1490 Tcl_DString ds; 1491 1492 locationPtr->locationKindSelector = ppcXTIAddrLocation; 1493 locationPtr->u.xtiType.Reserved[0] = 0; 1494 locationPtr->u.xtiType.Reserved[1] = 0; 1495 locationPtr->u.xtiType.Reserved[2] = 0; 1496 1497 Tcl_UtfToExternalDString(tclAE_macRoman_encoding, 1498 Tcl_GetString(addressObj), -1, &ds); 1499 1500 /* address is potentially too long (max 96 bytes, see TN1176) */ 1501 /* Apple's solution involves making ugly OpenTransport calls */ 1502 if (Tcl_DStringLength(&ds) > kMaxPPCXTIAddress) { 1503 Tcl_DStringFree(&ds); 1504 Tcl_ResetResult(interp); 1505 Tcl_AppendResult(interp, "TCP/IP address '", 1506 Tcl_GetString(addressObj), "' is too long.", 1507 (char *) NULL); 1508 return TCL_ERROR; 1509 } 1510 1511 locationPtr->u.xtiType.xtiAddr.fAddressType = kDNSAddrType; 1512 BlockMoveData(Tcl_DStringValue(&ds), 1513 locationPtr->u.xtiType.xtiAddr.fAddress, Tcl_DStringLength(&ds)); 1514 1515 locationPtr->u.xtiType.xtiAddrLen = Tcl_DStringLength(&ds) + sizeof(UInt16); 1516 1517 1518 Tcl_DStringFree(&ds); 1519 1520 return TCL_OK; 1521} 1522 1523static int 1524setTargetApplicationURL(Tcl_Interp * interp, Tcl_Obj *nameObj, TargetID *targetPtr) 1525{ 1526 Tcl_DString ds; 1527 OSErr err; 1528 Boolean textChanged; 1529 UInt16 len = sizeof(targetPtr->name.name) - 1; 1530 1531#if TARGET_CPU_68K 1532 UtfObjToPString(nameObj, targetPtr->name.name, len); 1533#else 1534 if (NSLLibraryPresent()) { 1535 Tcl_UtfToExternalDString(tclAE_macRoman_encoding, 1536 Tcl_GetString(nameObj), -1, &ds); 1537 1538 err = NSLHexDecodeText(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 1539 (char *) targetPtr->name.name, &len, &textChanged); 1540 1541 Tcl_DStringFree(&ds); 1542 1543 if (err != noErr) { 1544 return TCL_ERROR; 1545 } 1546 1547 c2pstr((char *) targetPtr->name.name); 1548 } else { 1549 UtfObjToPString(nameObj, targetPtr->name.name, len); 1550 } 1551#endif 1552 targetPtr->name.nameScript = smRoman; 1553 1554 return TCL_OK; 1555} 1556 1557static Tcl_Obj * 1558decodeApplicationName(Tcl_Obj *nameObj) 1559{ 1560#if TARGET_CPU_68K 1561 return nameObj; 1562#else 1563 if (NSLLibraryPresent()) { 1564 Tcl_DString ds1; 1565 Tcl_DString ds2; 1566 Tcl_Obj * decodedObj; 1567 OSErr err; 1568 Boolean textChanged; 1569 UInt16 len = 255; 1570 1571 Tcl_UtfToExternalDString(tclAE_macRoman_encoding, 1572 Tcl_GetString(nameObj), -1, &ds1); 1573 1574 Tcl_DStringInit(&ds2); 1575 Tcl_DStringSetLength(&ds2, Tcl_DStringLength(&ds1)); 1576 err = NSLHexDecodeText(Tcl_DStringValue(&ds1), Tcl_DStringLength(&ds1), 1577 Tcl_DStringValue(&ds2), &len, &textChanged); 1578 1579 if (err != noErr) { 1580 decodedObj = nameObj; 1581 } else { 1582 decodedObj = Tcl_NewStringObj(Tcl_DStringValue(&ds2), -1); 1583 } 1584 1585 Tcl_DStringFree(&ds1); 1586 Tcl_DStringFree(&ds2); 1587 1588 return decodedObj; 1589} else { 1590 return nameObj; 1591} 1592#endif 1593} 1594 1595static void 1596setTargetApplicationName(Tcl_Interp * interp, Tcl_Obj *nameObj, TargetID *targetPtr) 1597{ 1598 targetPtr->location.locationKindSelector = ppcNoLocation; 1599 1600 targetPtr->name.portKindSelector = ppcByString; 1601 UtfObjToPString(nameObj, targetPtr->name.name, -1); 1602} 1603 1604static void 1605setTargetApplicationCreator(Tcl_Interp * interp, Tcl_Obj *creatorObj, TargetID *targetPtr) 1606{ 1607 targetPtr->location.locationKindSelector = ppcNoLocation; 1608 1609 targetPtr->name.portKindSelector = ppcByCreatorAndType; 1610 targetPtr->name.u.port.portCreator = TclaeGetOSTypeFromObj(creatorObj); 1611 targetPtr->name.u.port.portType = 'ep01'; 1612} 1613#endif // TCLAE_NO_EPPC 1614 1615#if !TARGET_API_MAC_CARBON && !defined(TCLAE_NO_EPPC) 1616static void 1617getApplicationTarget(Tcl_Interp *interp, Tcl_RegExpInfo *reInfo, Tcl_Obj *addressObj, TargetID *targetPtr) 1618{ 1619 Tcl_Obj * rangeObj; 1620 1621 targetPtr->location.locationKindSelector = ppcNoLocation; 1622 1623 if (reInfo->matches[AT_CreatorRE].end > reInfo->matches[AT_CreatorRE].start) { 1624 /* application specified by 'CREA' format */ 1625 rangeObj = Tcl_GetRange(addressObj, reInfo->matches[AT_CreatorRE].start, 1626 reInfo->matches[AT_CreatorRE].end-1); 1627 setTargetApplicationCreator(interp, rangeObj, targetPtr); 1628 } else { 1629 /* application specified by name */ 1630 rangeObj = Tcl_GetRange(addressObj, reInfo->matches[AT_ApplicationRE].start, 1631 reInfo->matches[AT_ApplicationRE].end-1); 1632 setTargetApplicationName(interp, rangeObj, targetPtr); 1633 } 1634} 1635#endif //TCLAE_NO_EPPC 1636 1637/* <application name> on <machine>[:type][@zone] */ 1638/* '4CHR' on <machine>[:type][@zone] */ 1639static int 1640getAppleTalkAddress(Tcl_Interp *interp, 1641 Tcl_RegExpInfo *reInfo, 1642 Tcl_Obj *addressObj, 1643 AEAddressDesc *addressDesc) 1644{ 1645 OSStatus err; 1646 int result = TCL_OK; 1647 SInt32 gestalt; 1648 1649 err = Gestalt(gestaltPPCToolboxAttr, &gestalt); 1650 if (err == noErr 1651 && (gestalt & gestaltPPCSupportsOutgoingAppleTalk)) { 1652#if !TARGET_API_MAC_CARBON && !defined(TCLAE_NO_EPPC) 1653 TargetID target; 1654 Tcl_Obj * rangeObj; 1655 1656 getApplicationTarget(interp, reInfo, addressObj, &target); 1657 1658 target.location.locationKindSelector = ppcNBPLocation; 1659 1660 /* machine */ 1661 rangeObj = Tcl_GetRange(addressObj, reInfo->matches[AT_MachineRE].start, 1662 reInfo->matches[AT_MachineRE].end-1); 1663 UtfObjToPString(rangeObj, target.location.u.nbpEntity.objStr, -1); 1664 1665 /* type */ 1666 rangeObj = Tcl_GetRange(addressObj, reInfo->matches[AT_TypeRE].start, 1667 reInfo->matches[AT_TypeRE].end-1); 1668 if (Tcl_GetCharLength(rangeObj) > 0) { 1669 UtfObjToPString(rangeObj, target.location.u.nbpEntity.typeStr, -1); 1670 } else { 1671 c2pstrcpy(target.location.u.nbpEntity.typeStr, "PPCToolBox"); 1672 } 1673 1674 /* zone */ 1675 rangeObj = Tcl_GetRange(addressObj, reInfo->matches[AT_ZoneRE].start, 1676 reInfo->matches[AT_ZoneRE].end-1); 1677 if (Tcl_GetCharLength(rangeObj) > 0) { 1678 UtfObjToPString(rangeObj, target.location.u.nbpEntity.zoneStr, -1); 1679 } else { 1680 c2pstrcpy(target.location.u.nbpEntity.zoneStr, "*"); 1681 } 1682 1683 // ??? Should we verify the address in any way? What if user wanted 1684 // the application with that name, not the (possibly broken) AEAddress? 1685 err = AECreateDesc(typeTargetID, &target, sizeof(target), addressDesc); 1686#else 1687 Tcl_SetResult(interp, 1688 "It is illegal, immoral, and unsanitary to create TargetIDs on this system", 1689 TCL_STATIC); 1690 result = TCL_ERROR; 1691#endif //TCLAE_NO_EPPC 1692 } else { 1693 Tcl_SetResult(interp, 1694 "AppleEvents over AppleTalk are not available", 1695 TCL_STATIC); 1696 result = TCL_ERROR; 1697 } 1698 1699 return result; 1700} 1701 1702/* look for a local process with this name or creator */ 1703static int 1704getPSNAddress(Tcl_Interp *interp, Tcl_Obj *addressObj, AEAddressDesc *addressDesc) 1705{ 1706 ProcessInfoRec procInfoRec; 1707 ProcessSerialNumber thePSN; 1708 Str255 processNameStorage; 1709 OSStatus err; 1710 int result = TCL_OK; 1711 static Tcl_Obj * applStrObj = NULL; 1712 static Tcl_RegExp applRE = NULL; 1713 1714 if (applStrObj == NULL) { 1715 applStrObj = Tcl_NewStringObj(APPL_RE, -1); 1716 applRE = Tcl_GetRegExpFromObj(interp, applStrObj, TCL_REG_ADVANCED); 1717 if (applRE == NULL) { 1718 return TCL_ERROR; 1719 } 1720 } 1721 1722 thePSN.highLongOfPSN = 0; 1723 thePSN.lowLongOfPSN = kNoProcess; 1724 1725 procInfoRec.processName = processNameStorage; 1726#if __LP64__ 1727 procInfoRec.processAppRef = 0L; 1728#else 1729 procInfoRec.processAppSpec = 0L; 1730#endif // __LP64__ 1731 procInfoRec.processInfoLength = sizeof(procInfoRec); 1732 1733 if (Tcl_RegExpExecObj(interp, applRE, addressObj, 0, -1, 0) == 1) { 1734 Tcl_RegExpInfo reInfo; 1735 1736 Tcl_RegExpGetInfo(applRE, &reInfo); 1737 1738 if (reInfo.matches[APPL_CreatorRE].end > reInfo.matches[APPL_CreatorRE].start) { 1739 OSType sig = TclaeGetOSTypeFromObj(addressObj); 1740 1741 while ((err = GetNextProcess(&thePSN)) != procNotFound) { 1742 if (GetProcessInformation(&thePSN, &procInfoRec) == noErr) { 1743 if (procInfoRec.processSignature == sig) { 1744 break; 1745 } 1746 } 1747 } 1748 } else { 1749 Str255 processName; 1750 1751 UtfObjToPString(addressObj, processName, sizeof(processName)-1); 1752 1753 while ((err = GetNextProcess(&thePSN)) != procNotFound) { 1754 if (GetProcessInformation(&thePSN, &procInfoRec) == noErr) { 1755 if (pStrcmp((ConstStringPtr) procInfoRec.processName, processName) == 0) { 1756 break; 1757 } 1758 } 1759 } 1760 } 1761 1762 if (err == noErr) { 1763 err = AECreateDesc(typeProcessSerialNumber, &thePSN, sizeof(thePSN), addressDesc); 1764 if (err != noErr) { 1765 Tcl_ResetResult(interp); 1766 Tcl_AppendResult(interp, 1767 "Can't create PSN address from '", 1768 Tcl_GetString(addressObj), "': ", 1769 Tcl_MacOSError(interp, err), 1770 (char *) NULL); 1771 result = TCL_ERROR; 1772 } 1773 } else { 1774#if !TARGET_API_MAC_CARBON && !defined(TCLAE_NO_EPPC) 1775 TargetID target; 1776 1777 getApplicationTarget(interp, &reInfo, addressObj, &target); 1778 err = AECreateDesc(typeTargetID, &target, sizeof(target), addressDesc); 1779 if (err != noErr) { 1780 Tcl_ResetResult(interp); 1781 Tcl_AppendResult(interp, 1782 "Can't create TargetID address from '", 1783 Tcl_GetString(addressObj), "': ", 1784 Tcl_MacOSError(interp, err), 1785 (char *) NULL); 1786 result = TCL_ERROR; 1787 } 1788#else 1789 Tcl_ResetResult(interp); 1790 Tcl_AppendResult(interp, 1791 "Process \"", Tcl_GetString(addressObj), "\" not found", 1792 (char *) NULL); 1793 result = TCL_CONTINUE; 1794#endif 1795 } 1796 } else { 1797 result = TCL_ERROR; 1798 } 1799 1800 return result; 1801} 1802 1803static int 1804getOtherAddress(Tcl_Interp *interp, Tcl_Obj *addressObj, AEAddressDesc *addressDesc) 1805{ 1806 static Tcl_Obj * appleTalkStrObj = NULL; 1807 static Tcl_RegExp appleTalkRE = NULL; 1808 int result = TCL_OK; 1809 1810 if (appleTalkStrObj == NULL) { 1811 appleTalkStrObj = Tcl_NewStringObj(AT_RE, -1); 1812 appleTalkRE = Tcl_GetRegExpFromObj(interp, appleTalkStrObj, TCL_REG_ADVANCED); 1813 if (appleTalkRE == NULL) { 1814 return TCL_ERROR; 1815 } 1816 } 1817 1818 if (Tcl_RegExpExecObj(interp, appleTalkRE, addressObj, 0, -1, 0) == 1) { 1819 Tcl_RegExpInfo reInfo; 1820 1821 Tcl_RegExpGetInfo(appleTalkRE, &reInfo); 1822 1823 result = getAppleTalkAddress(interp, &reInfo, addressObj, addressDesc); 1824 } else { 1825 result = getPSNAddress(interp, addressObj, addressDesc); 1826 } 1827 1828 return result; 1829} 1830 1831static int 1832getAEDescAddress(Tcl_Interp *interp, Tcl_Obj *addressObj, AEAddressDesc *addressDesc, int parseGizmo) 1833{ 1834 int result = TCL_CONTINUE; 1835 1836 /* if objPtr is already an AEDesc, then see if it's a legitimate 1837 * AEAddress. If it's not an AEAddress, that's an error. 1838 * If it's not an AEDesc, continue with other parsers. 1839 */ 1840 if (Tclae_GetConstAEDescFromObj(interp, addressObj, (const AEDesc **) &addressDesc, parseGizmo) == TCL_OK) { 1841 switch (addressDesc->descriptorType) { 1842 case typeProcessSerialNumber: 1843 case typeApplicationURL: 1844#if TARGET_API_MAC_CARBON 1845 case typeKernelProcessID: 1846 case typeMachPort: 1847 case typeApplicationBundleID: 1848#endif 1849#if !TARGET_API_MAC_CARBON && !defined(TCLAE_NO_EPPC) 1850 case typeTargetID: 1851#endif 1852 result = TCL_OK; 1853 break; 1854 default: 1855 result = TCL_ERROR; 1856 } 1857 } 1858 1859 return result; 1860} 1861 1862/* 1863 *---------------------------------------------------------------------- 1864 * 1865 * SetAEAddressFromAny -- 1866 * 1867 * Generate an AEAddress internal form for the Tcl object "objPtr". 1868 * 1869 * Results: 1870 * The return value is a standard Tcl result. The conversion always 1871 * succeeds and TCL_OK is returned. 1872 * 1873 * Side effects: 1874 * A pointer to an AEAddressDesc built from objPtr's string rep 1875 * is stored as objPtr's internal representation. 1876 * 1877 *---------------------------------------------------------------------- 1878 */ 1879 1880static int 1881SetAEAddressFromAny(Tcl_Interp * interp, /* Used for error reporting if not NULL. */ 1882 Tcl_Obj * objPtr) /* The object to convert. */ 1883{ 1884 AEAddressDesc * addressDesc = NULL; 1885 char * name; 1886 int result = TCL_OK; 1887 1888 if (getAEDescAddress(interp, objPtr, addressDesc, false) == TCL_CONTINUE) { 1889 /* 1890 * Get "objPtr"s string representation. Make it up-to-date if necessary. 1891 */ 1892 1893 addressDesc = (AEAddressDesc *) ckalloc(sizeof (AEAddressDesc)); 1894 1895 name = objPtr->bytes; 1896 if (name == NULL) { 1897 name = Tcl_GetString(objPtr); 1898 } 1899 1900 if (Tcl_GetCharLength(objPtr) > 0) { 1901 result = getOtherAddress(interp, objPtr, addressDesc); 1902 } else { 1903 /* empty address get's assigned to self */ 1904 ProcessSerialNumber thePSN; 1905 OSStatus err; 1906 1907 thePSN.highLongOfPSN = 0L; 1908 thePSN.lowLongOfPSN = kCurrentProcess; 1909 1910 err = AECreateDesc(typeProcessSerialNumber, &thePSN, sizeof(thePSN), addressDesc); 1911 if (err != noErr) { 1912 Tcl_ResetResult(interp); 1913 Tcl_AppendResult(interp, "Can't create address of self: ", 1914 Tcl_MacOSError(interp, err), 1915 (char *) NULL); 1916 result = TCL_ERROR; 1917 } 1918 } 1919 1920 if (result == TCL_OK) { 1921 /* 1922 * Free the old internalRep before setting the new one. We do this as 1923 * late as possible to allow the conversion code, in particular 1924 * GetStringFromObj, to use that old internalRep. 1925 */ 1926 1927 if ((objPtr->typePtr != NULL) 1928 && (objPtr->typePtr->freeIntRepProc != NULL)) { 1929 objPtr->typePtr->freeIntRepProc(objPtr); 1930 } 1931 1932 objPtr->internalRep.otherValuePtr = addressDesc; 1933 } else { 1934 ckfree((char *) addressDesc); 1935 if (result == TCL_CONTINUE) { 1936 /* check if it's an AEGizmo */ 1937 result = getAEDescAddress(interp, objPtr, addressDesc, true); 1938 } 1939 } 1940 } 1941 1942 if (result == TCL_OK) { 1943 objPtr->typePtr = &tclAEAddressType; 1944 /* debugging */ 1945/* Tcl_InvalidateStringRep(objPtr); */ 1946 } else { 1947 result = TCL_ERROR; 1948 } 1949 1950 return result; 1951} 1952 1953/*-------------------- update string representation ---------------------*/ 1954 1955/* 1956 *---------------------------------------------------------------------- 1957 * 1958 * UpdateStringOfAEAddress -- 1959 * 1960 * Update the string representation for an AEAddressDesc 1961 * object. 1962 * 1963 * Results: 1964 * None. 1965 * 1966 * Side effects: 1967 * The object's string is set to a valid string that results from 1968 * the conversion. 1969 * 1970 *---------------------------------------------------------------------- 1971 */ 1972 1973static void 1974UpdateStringOfAEAddress(Tcl_Obj *objPtr) /* AEAddress obj with string rep to update. */ 1975{ 1976 TclaeUpdateStringOfAEDesc(objPtr); 1977} 1978static Tcl_Obj * 1979TclaeNewAEAddressObjFromAEAddressDesc(Tcl_Interp * interp, OSStatus err, AEAddressDesc * addressDesc) 1980{ 1981 if (err == noErr) { 1982 Tcl_Obj * objPtr = Tcl_NewObj(); 1983 1984 Tcl_InvalidateStringRep(objPtr); 1985 objPtr->internalRep.otherValuePtr = addressDesc; 1986 objPtr->typePtr = &tclAEAddressType; 1987 1988 return objPtr; 1989 } else { 1990 ckfree((char *) addressDesc); 1991 Tcl_ResetResult(interp); 1992 Tcl_AppendResult(interp, "Unable to make AEAddress: ", 1993 Tcl_MacOSError(interp, err), 1994 (char *) NULL); 1995 return NULL; 1996 } 1997} 1998 1999Tcl_Obj * 2000TclaeNewAEAddressObjFromPSN(Tcl_Interp * interp, ProcessSerialNumber thePSN) 2001{ 2002 AEAddressDesc * addressDesc = (AEAddressDesc *) ckalloc(sizeof(AEAddressDesc)); 2003 OSStatus err; 2004 2005 err = AECreateDesc(typeProcessSerialNumber, &thePSN, sizeof(thePSN), addressDesc); 2006 return TclaeNewAEAddressObjFromAEAddressDesc(interp, err, addressDesc); 2007} 2008 2009#if TARGET_API_MAC_CARBON 2010Tcl_Obj * 2011TclaeNewAEAddressObjFromCFURL(Tcl_Interp * interp, CFURLRef theURL) 2012{ 2013 AEAddressDesc * addressDesc = (AEAddressDesc *) ckalloc(sizeof(AEAddressDesc)); 2014 OSStatus err; 2015 CFDataRef dataRef = NULL; 2016 2017 dataRef = CFURLCreateData(kCFAllocatorDefault, theURL, kCFStringEncodingUTF8, true); 2018 if (dataRef) { 2019 CFIndex dataSize = CFDataGetLength(dataRef); 2020 err = AECreateDesc(typeApplicationURL, (Ptr)CFDataGetBytePtr(dataRef), dataSize, addressDesc); 2021 CFRelease(dataRef); 2022 } else { 2023 err = coreFoundationUnknownErr; 2024 } 2025 2026 return TclaeNewAEAddressObjFromAEAddressDesc(interp, err, addressDesc); 2027} 2028#endif // TARGET_API_MAC_CARBON 2029 2030#if !TARGET_API_MAC_CARBON && !defined(TCLAE_NO_EPPC) 2031Tcl_Obj * 2032TclaeNewAEAddressObjFromTarget(Tcl_Interp * interp, TargetID * targetPtr) 2033{ 2034 AEAddressDesc * addressDesc = (AEAddressDesc *) ckalloc(sizeof(AEAddressDesc)); 2035 OSStatus err; 2036 2037 err = AECreateDesc(typeTargetID, targetPtr, sizeof(TargetID), addressDesc); 2038 return TclaeNewAEAddressObjFromAEAddressDesc(interp, err, addressDesc); 2039} 2040#endif // TCLAE_NO_EPPC 2041 2042int 2043Tclae_GetAEAddressDescFromObj(Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 2044 Tcl_Obj *objPtr, /* The object from which to get a int. */ 2045 AEAddressDesc **addressDescPtr) /* Place to store resulting AEAddressDesc. */ 2046{ 2047 int result = TCL_OK; 2048 2049 if (objPtr->typePtr != &tclAEAddressType) { 2050 result = SetAEAddressFromAny(interp, objPtr); 2051 } 2052 2053 if (result == TCL_OK) { 2054 *addressDescPtr = ((AEAddressDesc *) objPtr->internalRep.otherValuePtr); 2055 } 2056 2057 return result; 2058 2059} 2060