diff --git a/configure.ac b/configure.ac index 4fc25536b..2fd72a477 100644 --- a/configure.ac +++ b/configure.ac @@ -773,7 +773,7 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime # cuserid - on Tru64 5.1b the declaration is documented to be available # only with `_XOPEN_SOURCE' or some such. # -AC_CHECK_HEADERS([crypt.h netdb.h pthread.h sys/param.h sys/resource.h sys/file.h]) +AC_CHECK_HEADERS([crypt.h netdb.h pthread.h sys/param.h sys/resource.h sys/file.h sys/mman.h]) AC_CHECK_FUNCS(chroot flock getlogin cuserid getpriority setpriority getpass sethostname gethostname) AC_CHECK_DECLS([sethostname, hstrerror, cuserid]) diff --git a/libguile/objcodes.c b/libguile/objcodes.c index e91e265da..448badafb 100644 --- a/libguile/objcodes.c +++ b/libguile/objcodes.c @@ -23,12 +23,18 @@ #include #include #include + +#ifdef HAVE_SYS_MMAN_H #include +#endif + #include #include #include #include +#include + #include "_scm.h" #include "programs.h" #include "objcodes.h" @@ -44,6 +50,52 @@ verify (((sizeof (SCM_OBJCODE_COOKIE) - 1) & 7) == 0); * Objcode type */ +static void +verify_cookie (char *cookie, struct stat *st, int map_fd, void *map_addr) +#define FUNC_NAME "make_objcode_from_file" +{ + /* The cookie ends with a version of the form M.N, where M is the + major version and N is the minor version. For this Guile to be + able to load an objcode, M must be SCM_OBJCODE_MAJOR_VERSION, and N + must be less than or equal to SCM_OBJCODE_MINOR_VERSION. Since N + is the last character, we do a strict comparison on all but the + last, then a <= on the last one. */ + if (memcmp (cookie, SCM_OBJCODE_COOKIE, strlen (SCM_OBJCODE_COOKIE) - 1)) + { + SCM args = scm_list_1 (scm_from_latin1_stringn + (cookie, strlen (SCM_OBJCODE_COOKIE))); + if (map_fd >= 0) + { + (void) close (map_fd); +#ifdef HAVE_SYS_MMAN_H + (void) munmap (map_addr, st->st_size); +#endif + } + scm_misc_error (FUNC_NAME, "bad header on object file: ~s", args); + } + + { + char minor_version = cookie[strlen (SCM_OBJCODE_COOKIE) - 1]; + + if (minor_version > SCM_OBJCODE_MINOR_VERSION_STRING[0]) + { + if (map_fd >= 0) + { + (void) close (map_fd); +#ifdef HAVE_SYS_MMAN_H + (void) munmap (map_addr, st->st_size); +#endif + } + + scm_misc_error (FUNC_NAME, "objcode minor version too new (~a > ~a)", + scm_list_2 (scm_from_latin1_stringn (&minor_version, 1), + scm_from_latin1_string + (SCM_OBJCODE_MINOR_VERSION_STRING))); + } + } +} +#undef FUNC_NAME + /* The words in an objcode SCM object are as follows: - scm_tc7_objcode | type | flags - the struct scm_objcode C object @@ -53,77 +105,91 @@ verify (((sizeof (SCM_OBJCODE_COOKIE) - 1) & 7) == 0); */ static SCM -make_objcode_by_mmap (int fd) -#define FUNC_NAME "make_objcode_by_mmap" +make_objcode_from_file (int fd) +#define FUNC_NAME "make_objcode_from_file" { int ret; - char *addr; + /* The SCM_OBJCODE_COOKIE is a string literal, and thus has an extra + trailing NUL, hence the - 1. */ + char cookie[sizeof (SCM_OBJCODE_COOKIE) - 1]; struct stat st; - SCM sret = SCM_BOOL_F; - struct scm_objcode *data; ret = fstat (fd, &st); if (ret < 0) SCM_SYSERROR; - if (st.st_size <= sizeof (struct scm_objcode) + strlen (SCM_OBJCODE_COOKIE)) + if (st.st_size <= sizeof (struct scm_objcode) + sizeof cookie) scm_misc_error (FUNC_NAME, "object file too small (~a bytes)", scm_list_1 (SCM_I_MAKINUM (st.st_size))); - addr = mmap (0, st.st_size, PROT_READ, MAP_PRIVATE, fd, 0); - if (addr == MAP_FAILED) - { - (void) close (fd); - SCM_SYSERROR; - } - - /* The cookie ends with a version of the form M.N, where M is the - major version and N is the minor version. For this Guile to be - able to load an objcode, M must be SCM_OBJCODE_MAJOR_VERSION, and N - must be less than or equal to SCM_OBJCODE_MINOR_VERSION. Since N - is the last character, we do a strict comparison on all but the - last, then a <= on the last one. */ - if (memcmp (addr, SCM_OBJCODE_COOKIE, strlen (SCM_OBJCODE_COOKIE) - 1)) - { - SCM args = scm_list_1 (scm_from_latin1_stringn - (addr, strlen (SCM_OBJCODE_COOKIE))); - (void) close (fd); - (void) munmap (addr, st.st_size); - scm_misc_error (FUNC_NAME, "bad header on object file: ~s", args); - } - +#ifdef HAVE_SYS_MMAN_H { - char minor_version = addr[strlen (SCM_OBJCODE_COOKIE) - 1]; + char *addr; + struct scm_objcode *data; - if (minor_version > SCM_OBJCODE_MINOR_VERSION_STRING[0]) - scm_misc_error (FUNC_NAME, "objcode minor version too new (~a > ~a)", - scm_list_2 (scm_from_latin1_stringn (&minor_version, 1), - scm_from_latin1_string - (SCM_OBJCODE_MINOR_VERSION_STRING))); + addr = mmap (0, st.st_size, PROT_READ, MAP_PRIVATE, fd, 0); + + if (addr == MAP_FAILED) + { + int errno_save = errno; + (void) close (fd); + errno = errno_save; + SCM_SYSERROR; + } + else + { + memcpy (cookie, addr, sizeof cookie); + data = (struct scm_objcode *) (addr + sizeof cookie); + } + + verify_cookie (cookie, &st, fd, addr); + + + if (data->len + data->metalen + != (st.st_size - sizeof (*data) - sizeof cookie)) + { + size_t total_len = sizeof (*data) + data->len + data->metalen; + + (void) close (fd); + (void) munmap (addr, st.st_size); + + scm_misc_error (FUNC_NAME, "bad length header (~a, ~a)", + scm_list_2 (scm_from_size_t (st.st_size), + scm_from_size_t (total_len))); + } + + /* FIXME: we leak ourselves and the file descriptor. but then again so does + dlopen(). */ + return scm_permanent_object + (scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_MMAP, 0), + (scm_t_bits)(addr + strlen (SCM_OBJCODE_COOKIE)), + SCM_UNPACK (scm_from_int (fd)), 0)); } +#else + { + SCM bv = scm_c_make_bytevector (st.st_size - sizeof cookie); - data = (struct scm_objcode*)(addr + strlen (SCM_OBJCODE_COOKIE)); + if (full_read (fd, cookie, sizeof cookie) != sizeof cookie + || full_read (fd, SCM_BYTEVECTOR_CONTENTS (bv), + SCM_BYTEVECTOR_LENGTH (bv)) != SCM_BYTEVECTOR_LENGTH (bv)) + { + int errno_save = errno; + (void) close (fd); + errno = errno_save; + SCM_SYSERROR; + } - if (data->len + data->metalen != (st.st_size - sizeof (*data) - strlen (SCM_OBJCODE_COOKIE))) - { - (void) close (fd); - (void) munmap (addr, st.st_size); - scm_misc_error (FUNC_NAME, "bad length header (~a, ~a)", - scm_list_2 (scm_from_size_t (st.st_size), - scm_from_uint32 (sizeof (*data) + data->len - + data->metalen))); - } + (void) close (fd); - sret = scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_MMAP, 0), - (scm_t_bits)(addr + strlen (SCM_OBJCODE_COOKIE)), - SCM_UNPACK (scm_from_int (fd)), 0); + verify_cookie (cookie, &st, -1, NULL); - /* FIXME: we leak ourselves and the file descriptor. but then again so does - dlopen(). */ - return scm_permanent_object (sret); + return scm_bytecode_to_objcode (bv); + } +#endif } #undef FUNC_NAME + SCM scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr) #define FUNC_NAME "make-objcode-slice" @@ -233,7 +299,7 @@ SCM_DEFINE (scm_load_objcode, "load-objcode", 1, 0, 0, free (c_file); if (fd < 0) SCM_SYSERROR; - return make_objcode_by_mmap (fd); + return make_objcode_from_file (fd); } #undef FUNC_NAME