1 #include <Rts.h>
2 #include "PathUtils.h"
3
4 #include "sm/Storage.h"
5 #include "sm/OSMem.h"
6 #include "RtsUtils.h"
7 #include "LinkerInternals.h"
8 #include "CheckUnload.h" // loaded_objects, insertOCSectionIndices
9 #include "linker/M32Alloc.h"
10
11 /* Platform specific headers */
12 #if defined(OBJFORMAT_PEi386)
13 # include "linker/PEi386.h"
14 #elif defined(OBJFORMAT_MACHO)
15 # include "linker/MachO.h"
16 # include <regex.h>
17 # include <mach/machine.h>
18 # include <mach-o/fat.h>
19 #elif defined(OBJFORMAT_ELF)
20 #include "linker/Elf.h"
21 #endif
22
23 #include <string.h>
24 #include <stddef.h>
25 #include <ctype.h>
26 #include <fs_rts.h>
27
28 #define FAIL(...) do {\
29 errorBelch("loadArchive: "__VA_ARGS__); \
30 goto fail;\
31 } while (0)
32
33 #define DEBUG_LOG(...) IF_DEBUG(linker, debugBelch("loadArchive: " __VA_ARGS__))
34
35 #if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
36 /* Read 4 bytes and convert to host byte order */
read4Bytes(const char buf[static4])37 static uint32_t read4Bytes(const char buf[static 4])
38 {
39 return ntohl(*(uint32_t*)buf);
40 }
41
loadFatArchive(char tmp[static20],FILE * f,pathchar * path)42 static StgBool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path)
43 {
44 uint32_t nfat_arch, nfat_offset, cputype, cpusubtype;
45 #if defined(i386_HOST_ARCH)
46 const uint32_t mycputype = CPU_TYPE_X86;
47 const uint32_t mycpusubtype = CPU_SUBTYPE_X86_ALL;
48 #elif defined(x86_64_HOST_ARCH)
49 const uint32_t mycputype = CPU_TYPE_X86_64;
50 const uint32_t mycpusubtype = CPU_SUBTYPE_X86_64_ALL;
51 #elif defined(aarch64_HOST_ARCH)
52 const uint32_t mycputype = CPU_TYPE_ARM64;
53 const uint32_t mycpusubtype = CPU_SUBTYPE_ARM64_ALL;
54 #elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH)
55 #error No Darwin support on PowerPC
56 #else
57 #error Unknown Darwin architecture
58 #endif
59
60 nfat_arch = read4Bytes(tmp + 4);
61 DEBUG_LOG("found a fat archive containing %d architectures\n", nfat_arch);
62 nfat_offset = 0;
63 for (uint32_t i = 0; i < nfat_arch; i++) {
64 /* search for the right arch */
65 int n = fread(tmp, 1, 12, f);
66 if (n != 12) {
67 errorBelch("Failed reading arch from `%" PATH_FMT "'", path);
68 return false;
69 }
70 cputype = read4Bytes(tmp);
71 cpusubtype = read4Bytes(tmp + 4);
72 if (cputype == mycputype && cpusubtype == mycpusubtype) {
73 DEBUG_LOG("found my archive in a fat archive\n");
74 nfat_offset = read4Bytes(tmp + 8);
75 break;
76 }
77 }
78 if (nfat_offset == 0) {
79 errorBelch("Fat archive contains %d architectures, "
80 "but none of them are compatible with the host",
81 (int)nfat_arch);
82 return false;
83 } else {
84 /* Seek to the correct architecture */
85 int n = fseek(f, nfat_offset, SEEK_SET);
86 if (n != 0) {
87 errorBelch("Failed to seek to arch in `%" PATH_FMT "'", path);
88 return false;
89 }
90
91 /* Read the header */
92 n = fread(tmp, 1, 8, f);
93 if (n != 8) {
94 errorBelch("Failed reading header from `%" PATH_FMT "'", path);
95 return false;
96 }
97
98 /* Check the magic number */
99 if (strncmp(tmp, "!<arch>\n", 8) != 0) {
100 errorBelch("couldn't find archive in `%" PATH_FMT "'"
101 "at offset %d", path, nfat_offset);
102 return false;
103 }
104 }
105 return true;
106 }
107 #endif
108
readThinArchiveMember(int n,int memberSize,pathchar * path,char * fileName,char * image)109 static StgBool readThinArchiveMember(int n, int memberSize, pathchar* path,
110 char* fileName, char* image)
111 {
112 StgBool has_succeeded = false;
113 FILE* member = NULL;
114 pathchar *pathCopy, *dirName, *memberPath, *objFileName;
115 memberPath = NULL;
116 /* Allocate and setup the dirname of the archive. We'll need
117 this to locate the thin member */
118 pathCopy = pathdup(path); // Convert the char* to a pathchar*
119 dirName = pathdir(pathCopy);
120 /* Append the relative member name to the dirname. This should be
121 be the full path to the actual thin member. */
122 int memberLen = pathlen(dirName) + 1 + strlen(fileName) + 1;
123 memberPath = stgMallocBytes(pathsize * memberLen, "loadArchive(file)");
124 objFileName = mkPath(fileName);
125 pathprintf(memberPath, memberLen, WSTR("%" PATH_FMT "%" PATH_FMT), dirName,
126 objFileName);
127 stgFree(objFileName);
128 stgFree(dirName);
129 member = pathopen(memberPath, WSTR("rb"));
130 if (!member) {
131 errorBelch("loadObj: can't read thin archive `%" PATH_FMT "'",
132 memberPath);
133 goto inner_fail;
134 }
135 n = fread(image, 1, memberSize, member);
136 if (n != memberSize) {
137 errorBelch("loadArchive: error whilst reading `%s'",
138 fileName);
139 goto inner_fail;
140 }
141 has_succeeded = true;
142
143 inner_fail:
144 fclose(member);
145 stgFree(memberPath);
146 stgFree(pathCopy);
147 return has_succeeded;
148 }
149
checkFatArchive(char magic[static20],FILE * f,pathchar * path)150 static StgBool checkFatArchive(char magic[static 20], FILE* f, pathchar* path)
151 {
152 StgBool success;
153 success = false;
154 #if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
155 /* Not a standard archive, look for a fat archive magic number: */
156 if (read4Bytes(magic) == FAT_MAGIC)
157 success = loadFatArchive(magic, f, path);
158 else
159 errorBelch("loadArchive: Neither an archive, nor a fat archive: "
160 "`%" PATH_FMT "'", path);
161 #else
162 (void)magic;
163 (void)f;
164 errorBelch("loadArchive: Not an archive: `%" PATH_FMT "'", path);
165 #endif
166 return success;
167 }
168
169 /**
170 * Look up the filename in the GNU-variant index file pointed to by
171 * gnuFileIndex.
172 * @param fileName_ a pointer to a pointer to the file name to be looked up.
173 * The file name must have been allocated with `StgMallocBytes`, and will
174 * be reallocated on return; the old value is now _invalid_.
175 * @param gnuFileIndexSize The size of the index.
176 */
177 static StgBool
lookupGNUArchiveIndex(int gnuFileIndexSize,char ** fileName_,char * gnuFileIndex,pathchar * path,size_t * thisFileNameSize,size_t * fileNameSize)178 lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_,
179 char* gnuFileIndex, pathchar* path, size_t* thisFileNameSize,
180 size_t* fileNameSize)
181 {
182 int n;
183 char *fileName = *fileName_;
184 if (isdigit(fileName[1])) {
185 int i;
186 for (n = 2; isdigit(fileName[n]); n++)
187 ;
188
189 fileName[n] = '\0';
190 n = atoi(fileName + 1);
191 if (gnuFileIndex == NULL) {
192 errorBelch("loadArchive: GNU-variant filename "
193 "without an index while reading from `%" PATH_FMT "'",
194 path);
195 return false;
196 }
197 if (n < 0 || n > gnuFileIndexSize) {
198 errorBelch("loadArchive: GNU-variant filename "
199 "offset %d out of range [0..%d] "
200 "while reading filename from `%" PATH_FMT "'",
201 n, gnuFileIndexSize, path);
202 return false;
203 }
204 if (n != 0 && gnuFileIndex[n - 1] != '\n') {
205 errorBelch("loadArchive: GNU-variant filename offset "
206 "%d invalid (range [0..%d]) while reading "
207 "filename from `%" PATH_FMT "'",
208 n, gnuFileIndexSize, path);
209 return false;
210 }
211 for (i = n; gnuFileIndex[i] != '\n'; i++)
212 ;
213
214 size_t FileNameSize = i - n - 1;
215 if (FileNameSize >= *fileNameSize) {
216 /* Double it to avoid potentially continually
217 increasing it by 1 */
218 *fileNameSize = FileNameSize * 2;
219 *fileName_ = fileName = stgReallocBytes(fileName, *fileNameSize,
220 "loadArchive(fileName)");
221 }
222 memcpy(fileName, gnuFileIndex + n, FileNameSize);
223 fileName[FileNameSize] = '\0';
224 *thisFileNameSize = FileNameSize;
225 }
226 /* Skip 32-bit symbol table ("/" + 15 blank characters)
227 and 64-bit symbol table ("/SYM64/" + 9 blank characters) */
228 else if (0 == strncmp(fileName + 1, " ", 15) ||
229 0 == strncmp(fileName + 1, "SYM64/ ", 15)) {
230 fileName[0] = '\0';
231 *thisFileNameSize = 0;
232 }
233 else {
234 errorBelch("loadArchive: invalid GNU-variant filename `%.16s' "
235 "while reading filename from `%" PATH_FMT "'",
236 fileName, path);
237 return false;
238 }
239
240 return true;
241 }
242
loadArchive_(pathchar * path)243 static HsInt loadArchive_ (pathchar *path)
244 {
245 char *image = NULL;
246 HsInt retcode = 0;
247 int memberSize;
248 FILE *f = NULL;
249 int n;
250 size_t thisFileNameSize = (size_t)-1; /* shut up bogus GCC warning */
251 char *fileName;
252 size_t fileNameSize;
253 int isObject, isGnuIndex, isThin, isImportLib;
254 char tmp[20];
255 char *gnuFileIndex;
256 int gnuFileIndexSize;
257 int misalignment = 0;
258
259 DEBUG_LOG("start\n");
260 DEBUG_LOG("Loading archive `%" PATH_FMT "'\n", path);
261
262 /* Check that we haven't already loaded this archive.
263 Ignore requests to load multiple times */
264 if (isAlreadyLoaded(path)) {
265 IF_DEBUG(linker,
266 debugBelch("ignoring repeated load of %" PATH_FMT "\n", path));
267 return 1; /* success */
268 }
269
270 gnuFileIndex = NULL;
271 gnuFileIndexSize = 0;
272
273 fileNameSize = 32;
274 fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
275
276 isThin = 0;
277 isImportLib = 0;
278
279 f = pathopen(path, WSTR("rb"));
280 if (!f)
281 FAIL("loadObj: can't read `%" PATH_FMT "'", path);
282
283 /* Check if this is an archive by looking for the magic "!<arch>\n"
284 * string. Usually, if this fails, we belch an error and return. On
285 * Darwin however, we may have a fat archive, which contains archives for
286 * more than one architecture. Fat archives start with the magic number
287 * 0xcafebabe, always stored big endian. If we find a fat_header, we scan
288 * through the fat_arch structs, searching through for one for our host
289 * architecture. If a matching struct is found, we read the offset
290 * of our archive data (nfat_offset) and seek forward nfat_offset bytes
291 * from the start of the file.
292 *
293 * A subtlety is that all of the members of the fat_header and fat_arch
294 * structs are stored big endian, so we need to call byte order
295 * conversion functions.
296 *
297 * If we find the appropriate architecture in a fat archive, we gobble
298 * its magic "!<arch>\n" string and continue processing just as if
299 * we had a single architecture archive.
300 */
301
302 n = fread ( tmp, 1, 8, f );
303 if (n != 8) {
304 FAIL("Failed reading header from `%" PATH_FMT "'", path);
305 }
306 if (strncmp(tmp, "!<arch>\n", 8) == 0) {}
307 /* Check if this is a thin archive by looking for the magic string "!<thin>\n"
308 *
309 * ar thin libraries have the exact same format as normal archives except they
310 * have a different magic string and they don't copy the object files into the
311 * archive.
312 *
313 * Instead each header entry points to the location of the object file on disk.
314 * This is useful when a library is only created to satisfy a compile time dependency
315 * instead of to be distributed. This saves the time required for copying.
316 *
317 * Thin archives are always flattened. They always only contain simple headers
318 * pointing to the object file and so we need not allocate more memory than needed
319 * to find the object file.
320 *
321 */
322 else if (strncmp(tmp, "!<thin>\n", 8) == 0) {
323 isThin = 1;
324 }
325 else {
326 StgBool success = checkFatArchive(tmp, f, path);
327 if (!success)
328 goto fail;
329 }
330 DEBUG_LOG("loading archive contents\n");
331
332 while (1) {
333 DEBUG_LOG("reading at %ld\n", ftell(f));
334 n = fread ( fileName, 1, 16, f );
335 if (n != 16) {
336 if (feof(f)) {
337 DEBUG_LOG("EOF while reading from '%" PATH_FMT "'\n", path);
338 break;
339 }
340 else {
341 FAIL("Failed reading file name from `%" PATH_FMT "'", path);
342 }
343 }
344
345 #if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
346 if (strncmp(fileName, "!<arch>\n", 8) == 0) {
347 DEBUG_LOG("found the start of another archive, breaking\n");
348 break;
349 }
350 #endif
351
352 n = fread ( tmp, 1, 12, f );
353 if (n != 12)
354 FAIL("Failed reading mod time from `%" PATH_FMT "'", path);
355 n = fread ( tmp, 1, 6, f );
356 if (n != 6)
357 FAIL("Failed reading owner from `%" PATH_FMT "'", path);
358 n = fread ( tmp, 1, 6, f );
359 if (n != 6)
360 FAIL("Failed reading group from `%" PATH_FMT "'", path);
361 n = fread ( tmp, 1, 8, f );
362 if (n != 8)
363 FAIL("Failed reading mode from `%" PATH_FMT "'", path);
364 n = fread ( tmp, 1, 10, f );
365 if (n != 10)
366 FAIL("Failed reading size from `%" PATH_FMT "'", path);
367 tmp[10] = '\0';
368 for (n = 0; isdigit(tmp[n]); n++);
369 tmp[n] = '\0';
370 memberSize = atoi(tmp);
371
372 DEBUG_LOG("size of this archive member is %d\n", memberSize);
373 n = fread ( tmp, 1, 2, f );
374 if (n != 2)
375 FAIL("Failed reading magic from `%" PATH_FMT "'", path);
376 if (strncmp(tmp, "\x60\x0A", 2) != 0)
377 FAIL("Failed reading magic from `%" PATH_FMT "' at %ld. Got %c%c",
378 path, ftell(f), tmp[0], tmp[1]);
379
380 isGnuIndex = 0;
381 /* Check for BSD-variant large filenames */
382 if (0 == strncmp(fileName, "#1/", 3)) {
383 size_t n = 0;
384 fileName[16] = '\0';
385 if (isdigit(fileName[3])) {
386 for (n = 4; isdigit(fileName[n]); n++)
387 ;
388
389 fileName[n] = '\0';
390 thisFileNameSize = atoi(fileName + 3);
391 memberSize -= thisFileNameSize;
392 if (thisFileNameSize >= fileNameSize) {
393 /* Double it to avoid potentially continually
394 increasing it by 1 */
395 fileNameSize = thisFileNameSize * 2;
396 fileName = stgReallocBytes(fileName, fileNameSize,
397 "loadArchive(fileName)");
398 }
399 n = fread(fileName, 1, thisFileNameSize, f);
400 if (n != thisFileNameSize) {
401 errorBelch("Failed reading filename from `%" PATH_FMT "'",
402 path);
403 goto fail;
404 }
405 fileName[thisFileNameSize] = 0;
406 /* On OS X at least, thisFileNameSize is the size of the
407 fileName field, not the length of the fileName
408 itself. */
409 thisFileNameSize = strlen(fileName);
410 } else {
411 errorBelch("BSD-variant filename size not found "
412 "while reading filename from `%" PATH_FMT "'", path);
413 goto fail;
414 }
415 }
416 /* Check for GNU file index file */
417 else if (0 == strncmp(fileName, "//", 2)) {
418 fileName[0] = '\0';
419 thisFileNameSize = 0;
420 isGnuIndex = 1;
421 }
422 /* Check for a file in the GNU file index */
423 else if (fileName[0] == '/') {
424 if (!lookupGNUArchiveIndex(gnuFileIndexSize, &fileName,
425 gnuFileIndex, path, &thisFileNameSize, &fileNameSize)) {
426 goto fail;
427 }
428 }
429 /* Finally, the case where the filename field actually contains
430 the filename */
431 else {
432 /* GNU ar terminates filenames with a '/', this allowing
433 spaces in filenames. So first look to see if there is a
434 terminating '/'. */
435 for (thisFileNameSize = 0;
436 thisFileNameSize < 16;
437 thisFileNameSize++) {
438 if (fileName[thisFileNameSize] == '/') {
439 fileName[thisFileNameSize] = '\0';
440 break;
441 }
442 }
443 /* If we didn't find a '/', then a space teminates the
444 filename. Note that if we don't find one, then
445 thisFileNameSize ends up as 16, and we already have the
446 '\0' at the end. */
447 if (thisFileNameSize == 16) {
448 for (thisFileNameSize = 0;
449 thisFileNameSize < 16;
450 thisFileNameSize++) {
451 if (fileName[thisFileNameSize] == ' ') {
452 fileName[thisFileNameSize] = '\0';
453 break;
454 }
455 }
456 }
457 }
458
459 DEBUG_LOG("Found member file `%s'\n", fileName);
460
461 /* TODO: Stop relying on file extensions to determine input formats.
462 Instead try to match file headers. See #13103. */
463 isObject = (thisFileNameSize >= 2 && strncmp(fileName + thisFileNameSize - 2, ".o" , 2) == 0)
464 || (thisFileNameSize >= 3 && strncmp(fileName + thisFileNameSize - 3, ".lo" , 3) == 0)
465 || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".p_o", 4) == 0)
466 || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".obj", 4) == 0);
467
468 #if defined(OBJFORMAT_PEi386)
469 /*
470 * Note [MSVC import files (ext .lib)]
471 * MSVC compilers store the object files in
472 * the import libraries with extension .dll
473 * so on Windows we should look for those too.
474 * The PE COFF format doesn't specify any specific file name
475 * for sections. So on windows, just try to load it all.
476 *
477 * Linker members (e.g. filename / are skipped since they are not needed)
478 */
479 isImportLib = thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".dll", 4) == 0;
480 #endif // windows
481
482 DEBUG_LOG("\tthisFileNameSize = %d\n", (int)thisFileNameSize);
483 DEBUG_LOG("\tisObject = %d\n", isObject);
484
485 if (isObject) {
486 char *archiveMemberName;
487
488 DEBUG_LOG("Member is an object file...loading...\n");
489
490 #if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
491 if (RTS_LINKER_USE_MMAP)
492 image = mmapAnonForLinker(memberSize);
493 else {
494 /* See loadObj() */
495 misalignment = machoGetMisalignment(f);
496 image = stgMallocBytes(memberSize + misalignment,
497 "loadArchive(image)");
498 image += misalignment;
499 }
500
501 #else // not darwin
502 image = stgMallocBytes(memberSize, "loadArchive(image)");
503 #endif
504 if (isThin) {
505 if (!readThinArchiveMember(n, memberSize, path,
506 fileName, image)) {
507 goto fail;
508 }
509 }
510 else
511 {
512 n = fread ( image, 1, memberSize, f );
513 if (n != memberSize) {
514 FAIL("error whilst reading `%" PATH_FMT "'", path);
515 }
516 }
517
518 archiveMemberName = stgMallocBytes(pathlen(path) + thisFileNameSize + 3,
519 "loadArchive(file)");
520 sprintf(archiveMemberName, "%" PATH_FMT "(%.*s)",
521 path, (int)thisFileNameSize, fileName);
522
523 ObjectCode *oc = mkOc(path, image, memberSize, false, archiveMemberName,
524 misalignment);
525 #if defined(OBJFORMAT_MACHO)
526 ocInit_MachO( oc );
527 #endif
528 #if defined(OBJFORMAT_ELF)
529 ocInit_ELF( oc );
530 #endif
531
532 stgFree(archiveMemberName);
533
534 if (0 == loadOc(oc)) {
535 stgFree(fileName);
536 fclose(f);
537 return 0;
538 } else {
539 insertOCSectionIndices(oc); // also adds the object to `objects` list
540 oc->next_loaded_object = loaded_objects;
541 loaded_objects = oc;
542 }
543 }
544 else if (isGnuIndex) {
545 if (gnuFileIndex != NULL) {
546 FAIL("GNU-variant index found, but already have an index, \
547 while reading filename from `%" PATH_FMT "'", path);
548 }
549 DEBUG_LOG("Found GNU-variant file index\n");
550 #if RTS_LINKER_USE_MMAP
551 gnuFileIndex = mmapAnonForLinker(memberSize + 1);
552 #else
553 gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
554 #endif
555 n = fread ( gnuFileIndex, 1, memberSize, f );
556 if (n != memberSize) {
557 FAIL("error whilst reading `%" PATH_FMT "'", path);
558 }
559 gnuFileIndex[memberSize] = '/';
560 gnuFileIndexSize = memberSize;
561 }
562 else if (isImportLib) {
563 #if defined(OBJFORMAT_PEi386)
564 if (checkAndLoadImportLibrary(path, fileName, f)) {
565 DEBUG_LOG("Member is an import file section... "
566 "Corresponding DLL has been loaded...\n");
567 }
568 else {
569 DEBUG_LOG("Member is not a valid import file section... "
570 "Skipping...\n");
571 n = fseek(f, memberSize, SEEK_CUR);
572 if (n != 0)
573 FAIL("error whilst seeking by %d in `%" PATH_FMT "'",
574 memberSize, path);
575 }
576 #endif
577 }
578 else {
579 DEBUG_LOG("`%s' does not appear to be an object file\n",
580 fileName);
581 if (!isThin || thisFileNameSize == 0) {
582 n = fseek(f, memberSize, SEEK_CUR);
583 if (n != 0)
584 FAIL("error whilst seeking by %d in `%" PATH_FMT "'",
585 memberSize, path);
586 }
587 }
588
589 /* .ar files are 2-byte aligned */
590 if (!(isThin && thisFileNameSize > 0) && memberSize % 2) {
591 DEBUG_LOG("trying to read one pad byte\n");
592 n = fread ( tmp, 1, 1, f );
593 if (n != 1) {
594 if (feof(f)) {
595 DEBUG_LOG("found EOF while reading one pad byte\n");
596 break;
597 }
598 else {
599 FAIL("Failed reading padding from `%" PATH_FMT "'", path);
600 }
601 }
602 DEBUG_LOG("successfully read one pad byte\n");
603 }
604 DEBUG_LOG("reached end of archive loading while loop\n");
605 }
606 retcode = 1;
607 fail:
608 if (f != NULL)
609 fclose(f);
610
611 if (fileName != NULL)
612 stgFree(fileName);
613 if (gnuFileIndex != NULL) {
614 #if RTS_LINKER_USE_MMAP
615 munmap(gnuFileIndex, gnuFileIndexSize + 1);
616 #else
617 stgFree(gnuFileIndex);
618 #endif
619 }
620
621 DEBUG_LOG("done\n");
622 return retcode;
623 }
624
loadArchive(pathchar * path)625 HsInt loadArchive (pathchar *path)
626 {
627 ACQUIRE_LOCK(&linker_mutex);
628 HsInt r = loadArchive_(path);
629 RELEASE_LOCK(&linker_mutex);
630 return r;
631 }
632