1/*
2 * tclLoadAout.c --
3 *
4 *	This procedure provides a version of dlopen() that
5 *	provides pseudo-static linking using version-7 compatible
6 *	a.out files described in either sys/exec.h or sys/a.out.h.
7 *
8 * Copyright (c) 1995, by General Electric Company. All rights reserved.
9 *
10 * See the file "license.terms" for information on usage and redistribution
11 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 * This work was supported in part by the ARPA Manufacturing Automation
14 * and Design Engineering (MADE) Initiative through ARPA contract
15 * F33615-94-C-4400.
16 *
17 * SCCS: @(#) tclLoadAout.c 1.7 96/02/15 11:58:53
18 */
19
20#include "transformInt.h"
21#include <fcntl.h>
22#include <ctype.h>
23#include <string.h>
24#include <unistd.h>
25#ifdef HAVE_EXEC_AOUT_H
26#   include <sys/exec_aout.h>
27#endif
28
29/*
30 * Some systems describe the a.out header in sys/exec.h, and some in
31 * a.out.h.
32 */
33
34#ifdef USE_SYS_EXEC_H
35#include <sys/exec.h>
36#endif
37#ifdef USE_A_OUT_H
38#include <a.out.h>
39#endif
40#ifdef USE_SYS_EXEC_AOUT_H
41#include <sys/exec_aout.h>
42#define a_magic a_midmag
43#endif
44
45EXTERN char *tclExecutableName;
46
47#define UCHAR(c) ((unsigned char) (c))
48
49/*
50 * TCL_LOADSHIM is the amount by which to shim the break when loading
51 */
52
53#ifndef TCL_LOADSHIM
54#define TCL_LOADSHIM 0x4000L
55#endif
56
57/*
58 * TCL_LOADALIGN must be a power of 2, and is the alignment to which
59 * to force the origin of load modules
60 */
61
62#ifndef TCL_LOADALIGN
63#define TCL_LOADALIGN 0x4000L
64#endif
65
66/*
67 * TCL_LOADMAX is the maximum size of a load module, and is used as
68 * a sanity check when loading
69 */
70
71#ifndef TCL_LOADMAX
72#define TCL_LOADMAX 2000000L
73#endif
74
75/*
76 * Kernel calls that appear to be missing from the system .h files:
77 */
78
79extern char * brk _ANSI_ARGS_((char *));
80extern char * sbrk _ANSI_ARGS_((size_t));
81
82/*
83 * The static variable SymbolTableFile contains the file name where the
84 * result of the last link was stored.  The file is kept because doing so
85 * allows one load module to use the symbols defined in another.
86 */
87
88static char * SymbolTableFile = NULL;
89
90/*
91 * Prototypes for procedures referenced only in this file:
92 */
93
94static int FindLibraries _ANSI_ARGS_((CONST char *fileName, Tcl_DString *buf));
95static void UnlinkSymbolTable _ANSI_ARGS_((void));
96static void Seterror _ANSI_ARGS_((char *message));
97static int GuessPackageName _ANSI_ARGS_((CONST char *fileName, Tcl_DString *bufPtr));
98static char *errorMessage = NULL;
99
100
101/*
102 *----------------------------------------------------------------------
103 *
104 * dlopen --
105 *
106 *	Dynamically loads a binary code file into memory.
107 *
108 * Results:
109 *	A handle which can be used in later calls to dlsym(),
110 *	or NULL when the attempt fails.
111 *
112 * Side effects:
113 *	New code suddenly appears in memory.
114 *
115 *
116 * Bugs:
117 *	This function does not attempt to handle the case where the
118 *	BSS segment is not executable.  It will therefore fail on
119 *	Encore Multimax, Pyramid 90x, and similar machines.  The
120 *	reason is that the mprotect() kernel call, which would
121 *	otherwise be employed to mark the newly-loaded text segment
122 *	executable, results in a system crash on BSD/386.
123 *
124 *	In an effort to make it fast, this function eschews the
125 *	technique of linking the load module once, reading its header
126 *	to determine its size, allocating memory for it, and linking
127 *	it again.  Instead, it `shims out' memory allocation by
128 *	placing the module TCL_LOADSHIM bytes beyond the break,
129 *	and assuming that any malloc() calls required to run the
130 *	linker will not advance the break beyond that point.  If
131 *	the break is advanced beyonnd that point, the load will
132 *	fail with an `inconsistent memory allocation' error.
133 *	It perhaps ought to retry the link, but the failure has
134 *	not been observed in two years of daily use of this function.
135 *----------------------------------------------------------------------
136 */
137
138VOID *
139dlopen(path, flags)
140    CONST char *path;
141    int flags;
142{
143  char * inputSymbolTable;	/* Name of the file containing the
144				 * symbol table from the last link. */
145  Tcl_DString linkCommandBuf;	/* Command to do the run-time relocation
146				 * of the module.*/
147  char * linkCommand;
148  char relocatedFileName [L_tmpnam];
149				/* Name of the file holding the relocated */
150				/* text of the module */
151  int relocatedFd = -1;		/* File descriptor of the file holding
152				 * relocated text */
153  struct exec relocatedHead;	/* Header of the relocated text */
154  unsigned long relocatedSize;	/* Size of the relocated text */
155  char * startAddress;		/* Starting address of the module */
156  int status;			/* Status return from Tcl_ calls */
157  char *p, *q;
158  Tcl_Interp *interp = NULL;
159  Tcl_DString fullPath;
160
161  errno = 0;
162  if (errorMessage) {
163    ckfree(errorMessage);
164    errorMessage = NULL;
165  }
166
167  /* Find the file that contains the symbols for the run-time link. */
168
169  if (SymbolTableFile != NULL) {
170    inputSymbolTable = SymbolTableFile;
171  } else if (tclExecutableName == NULL) {
172    Seterror("can't find the tclsh executable");
173    goto error;
174  } else {
175    inputSymbolTable = tclExecutableName;
176  }
177
178  /* Construct the `ld' command that builds the relocated module */
179
180  interp = Tcl_CreateInterp();
181
182  Tcl_DStringInit (&fullPath);
183  if (Tcl_GetPathType(path) == TCL_PATH_RELATIVE) {
184      p = getenv("LD_LIBRARY_PATH");
185      while (p) {
186          if ((q = strchr(p,':')) == NULL) {
187              q = p; while(*q) q++;
188          }
189          if (p == q) break;
190          Tcl_DStringAppend(&fullPath, p, q-p);
191          Tcl_DStringAppend(&fullPath, "/", 1);
192          Tcl_DStringAppend(&fullPath, path, -1);
193          if (access(Tcl_DStringValue(&fullPath), F_OK) != -1) {
194              break;
195          }
196          Tcl_DStringSetLength(&fullPath, 0);
197          p = q; if (*p) p++;
198      }
199  }
200  if (*Tcl_DStringValue(&fullPath) == 0) {
201    Tcl_DStringAppend(&fullPath, path, -1);
202  }
203  tmpnam (relocatedFileName);
204  Tcl_DStringInit (&linkCommandBuf);
205  Tcl_DStringAppend (&linkCommandBuf, "exec ld -o ", -1);
206  Tcl_DStringAppend (&linkCommandBuf, relocatedFileName, -1);
207#if defined(__mips) || defined(mips)
208  Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1);
209#endif
210  Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1);
211  GuessPackageName(Tcl_DStringValue(&fullPath), &linkCommandBuf);
212  Tcl_DStringAppend (&linkCommandBuf, " -A ", -1);
213  Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1);
214  Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1);
215  Tcl_DStringAppend (&linkCommandBuf, Tcl_DStringValue(&fullPath), -1);
216  p = getenv("LD_LIBRARY_PATH");
217  while (p) {
218    if ((q = strchr(p,':')) == NULL) {
219      q = p; while(*q) q++;
220    }
221    if (p == q) break;
222    Tcl_DStringAppend(&linkCommandBuf, " -L", 3);
223    Tcl_DStringAppend(&linkCommandBuf, p, q-p);
224    p = q; if (*p) p++;
225  }
226  Tcl_DStringAppend (&linkCommandBuf, " ", -1);
227  if (FindLibraries (Tcl_DStringValue(&fullPath), &linkCommandBuf) != TCL_OK) {
228    Tcl_DStringFree (&linkCommandBuf);
229    Tcl_DStringFree (&fullPath);
230    goto error;
231  }
232  Tcl_DStringFree (&fullPath);
233  linkCommand = Tcl_DStringValue (&linkCommandBuf);
234
235  /* Determine the starting address, and plug it into the command */
236
237  startAddress = (char *) (((unsigned long) sbrk (0)
238			    + TCL_LOADSHIM + TCL_LOADALIGN - 1)
239			   & (- TCL_LOADALIGN));
240  p = strstr (linkCommand, "-T") + 3;
241  sprintf (p, "%08lx", (long) startAddress);
242  p [8] = ' ';
243
244  /* Run the linker */
245
246  status = Tcl_Eval (interp, linkCommand);
247  Tcl_DStringFree (&linkCommandBuf);
248  if (status != 0) {
249    Seterror(interp->result);
250    errno = 0;
251    goto error;
252  }
253
254  /* Open the linker's result file and read the header */
255
256  relocatedFd = open (relocatedFileName, O_RDONLY);
257  if (relocatedFd < 0) {
258    goto ioError;
259  }
260  status= read (relocatedFd, (char *) & relocatedHead, sizeof relocatedHead);
261  if (status < sizeof relocatedHead) {
262    goto ioError;
263  }
264
265  /* Check the magic number */
266
267  if (relocatedHead.a_magic != OMAGIC) {
268    Seterror("bad magic number in intermediate file");
269    goto failure;
270  }
271
272  /* Make sure that memory allocation is still consistent */
273
274  if ((unsigned long) sbrk (0) > (unsigned long) startAddress) {
275    Seterror("can't load, memory allocation is inconsistent");
276    goto failure;
277  }
278
279  /* Make sure that the relocated module's size is reasonable */
280
281  relocatedSize = relocatedHead.a_text + relocatedHead.a_data
282    + relocatedHead.a_bss;
283  if (relocatedSize > TCL_LOADMAX) {
284    Seterror("module too big to load");
285    goto failure;
286  }
287
288  /* Advance the break to protect the loaded module */
289
290  (void) brk (startAddress + relocatedSize);
291
292  /* Seek to the start of the module's text */
293
294#if defined(__mips) || defined(mips)
295  status = lseek (relocatedFd,
296		  N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o),
297		  SEEK_SET);
298#else
299  status = lseek (relocatedFd, N_TXTOFF (relocatedHead), SEEK_SET);
300#endif
301  if (status < 0) {
302    goto ioError;
303  }
304
305  /* Read in the module's text and data */
306
307  relocatedSize = relocatedHead.a_text + relocatedHead.a_data;
308  if (read (relocatedFd, startAddress, relocatedSize) < relocatedSize) {
309    brk (startAddress);
310  ioError:
311    Seterror("error on intermediate file: ");
312  failure:
313    (void) unlink (relocatedFileName);
314    goto error;
315  }
316
317  /* Close the intermediate file. */
318
319  (void) close (relocatedFd);
320
321  /* Arrange things so that intermediate symbol tables eventually get
322   * deleted. If the flag RTLD_GLOBAL is not set, just keep the
323   * old file. */
324
325  if (flags & RTLD_GLOBAL) {
326    if (SymbolTableFile != NULL) {
327      UnlinkSymbolTable ();
328    } else {
329      atexit (UnlinkSymbolTable);
330    }
331    SymbolTableFile = ckalloc (strlen (relocatedFileName) + 1);
332    strcpy (SymbolTableFile, relocatedFileName);
333  } else {
334    (void) unlink (relocatedFileName);
335  }
336  return (VOID *) startAddress;
337
338error:
339  if (relocatedFd>=0) {
340	close (relocatedFd);
341  }
342  if (interp) {
343    Tcl_DeleteInterp(interp);
344  }
345  return NULL;
346}
347
348
349/*
350 *----------------------------------------------------------------------
351 *
352 * dlsym --
353 *
354 *	This function returns the address of a
355 *	symbol, give the handle returned by dlopen().
356 *
357 * Results:
358 *	Returns the address of the symbol in the dll.
359 *
360 * Side effects:
361 *	None.
362 *
363 *----------------------------------------------------------------------
364 */
365
366VOID *dlsym(handle, symbol)
367    VOID *handle;
368    CONST char *symbol;
369{
370    if ((handle != NULL) && (symbol != NULL)) {
371	return ((VOID * (*) _ANSI_ARGS_((CONST char *))) handle) (symbol);
372    } else {
373	return (VOID *) NULL;
374    }
375}
376
377
378/*
379 *----------------------------------------------------------------------
380 *
381 * dlerror --
382 *
383 *	This function returns a string describing the error which
384 *	occurred in dlopen().
385 *
386 * Results:
387 *	Returns an error message.
388 *
389 * Side effects:
390 *	None.
391 *
392 *----------------------------------------------------------------------
393 */
394
395char *
396dlerror()
397{
398    char *err, *msg;
399
400    if (errorMessage && errno) {
401	err = Tcl_ErrnoMsg(errno);
402	msg = ckalloc(strlen(errorMessage)+strlen(err)+1);
403	strcpy(msg, errorMessage);
404	strcat(msg, err);
405	ckfree(errorMessage);
406	errorMessage = msg;
407    }
408    return errorMessage;
409}
410
411
412/*
413 *----------------------------------------------------------------------
414 *
415 * dlclose --
416 *
417 *	Just a dummy function, only for compatibility. There is no
418 *	way to remove dll's from memory.
419 *
420 * Results:
421 *	Always returns 0 (= O.K.)
422 *
423 * Side effects:
424 *	None
425 *
426 *----------------------------------------------------------------------
427 */
428
429int
430dlclose(handle)
431    VOID *handle;
432{
433    return 0;
434}
435
436static void
437Seterror(message)
438    char *message;
439{
440    if (errorMessage) {
441	ckfree(errorMessage);
442    }
443    errorMessage = ckalloc(strlen(message)+1);
444    strcpy(errorMessage, message);
445    return;
446}
447
448
449/*
450 *------------------------------------------------------------------------
451 *
452 * FindLibraries --
453 *
454 *	Find the libraries needed to link a load module at run time.
455 *
456 * Results:
457 *	A standard Tcl completion code.  If an error occurs,
458 *	an error message is left in interp->result.  The -l and -L flags
459 *	are concatenated onto the dynamic string `buf'.
460 *
461 *------------------------------------------------------------------------
462 */
463
464static int
465FindLibraries (fileName, buf)
466     CONST char * fileName;	/* Name of the load module */
467     Tcl_DString * buf;		/* Buffer where the -l an -L flags */
468{
469  FILE * f;			/* The load module */
470  int c = EOF;			/* Byte from the load module */
471  char * p;
472
473  /* Open the load module */
474
475  if ((f = fopen (fileName, "rb")) == NULL) {
476    Seterror("");
477    return TCL_ERROR;
478  }
479
480  /* Search for the library list in the load module */
481
482  p = "@LIBS: ";
483  while (*p != '\0' && (c = getc (f)) != EOF) {
484    if (c == *p) {
485      ++p;
486    }
487    else {
488      p = "@LIBS: ";
489      if (c == *p) {
490	++p;
491      }
492    }
493  }
494
495  /* No library list -- this must be an ill-formed module */
496
497  if (c == EOF) {
498    Seterror("is not a Tcl load module.");
499    (void) fclose (f);
500    return TCL_ERROR;
501  }
502
503  /* Accumulate the library list */
504
505  while ((c = getc (f)) != '\0' && c != EOF) {
506    char cc = c;
507    Tcl_DStringAppend (buf, &cc, 1);
508  }
509  (void) fclose (f);
510
511  if (c == EOF) {
512    Seterror("Library directory ends prematurely");
513    return TCL_ERROR;
514  }
515
516  return TCL_OK;
517}
518
519/*
520 *------------------------------------------------------------------------
521 *
522 * UnlinkSymbolTable --
523 *
524 *	Remove the symbol table file from the last dynamic link.
525 *
526 * Results:
527 *	None.
528 *
529 * Side effects:
530 *	The symbol table file from the last dynamic link is removed.
531 *	This function is called when (a) a new symbol table is present
532 *	because another dynamic link is complete, or (b) the process
533 *	is exiting.
534 *------------------------------------------------------------------------
535 */
536
537static void
538UnlinkSymbolTable ()
539{
540  (void) unlink (SymbolTableFile);
541  ckfree (SymbolTableFile);
542  SymbolTableFile = NULL;
543}
544
545/*
546 *----------------------------------------------------------------------
547 *
548 * GuessPackageName --
549 *
550 *	Determinsed the package name from the file name. The package
551 *	name is appended to the dynamic string, if possible.
552 *
553 * Results:
554 *	Returns 1 if the guess succeeds, 0 otherwise.
555 *
556 * Side effects:
557 *	None.
558 *
559 *----------------------------------------------------------------------
560 */
561
562static int
563GuessPackageName(fileName, bufPtr)
564    CONST char *fileName;	/* Name of file containing package (already
565				 * translated to local form if needed). */
566    Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
567				 * package name to this if possible. */
568{
569    CONST char *p,*pkgGuess;
570    char *r;
571
572    if ((pkgGuess = strrchr(fileName,'/')) != NULL) {
573	pkgGuess++;
574    } else {
575	pkgGuess = fileName;
576    }
577    if (!strncmp(pkgGuess,"lib",3)) {
578	pkgGuess+=3;
579    }
580    for (p = pkgGuess; (*p) && (*p != '.') && (!isdigit(UCHAR(*p))); p++) {
581	/* Empty loop body. */
582    }
583    if ((p>pkgGuess+2) && !strncmp(p-2,"_G0.",4)) {
584	p-=2;
585    }
586    if (p == pkgGuess) {
587	return 0;
588    }
589
590    Tcl_DStringAppend(bufPtr,pkgGuess, p-pkgGuess);
591
592    r = Tcl_DStringValue(bufPtr);
593    r += strlen(r) - (p-pkgGuess);
594
595    if (islower(UCHAR(*r))) {
596	*r = (char) toupper(UCHAR(*r));
597    }
598    while (*(++r)) {
599	if (isupper(UCHAR(*r))) {
600	    *r = (char) tolower(UCHAR(*r));
601	}
602    }
603
604    return 1;
605}
606