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}
1978static 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