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