;;;; -*- coding: utf-8; -*-
changes in sbcl-1.0.14 relative to sbcl-1.0.13:
+ * Revived support for OpenBSD (contributed by Josh Elsasser)
* bug fix: RESOLVE-CONFLICT (and the other name conflict machinery)
is now actually exported from SB-EXT as documented. (reported by
Maciej Katafiasz)
"UID-USERNAME"
"UID-HOMEDIR"
"WITH-RESTARTED-SYSCALL"
+ "SB-MKSTEMP"
;; stuff with a one-to-one mapping to Unix constructs
"D-INO" "D-NAME" "D-NAMLEN" "D-OFF" "D-RECLEN" "DEV-T" "DIRECT"
"RU-STIME" "RU-UTIME" "RUSAGE_CHILDREN" "RUSAGE_SELF" "RUSEAGE"
"R_OK" "S-IEXEC" "S-IFBLK" "S-IFCHR" "S-IFDIR" "S-IFLNK" "S-IFMT"
"S-IFREG" "S-IFSOCK" "S-IREAD" "S-ISGID" "S-ISUID" "S-ISVTX"
- "S-IWRITE" "SAVETEXT" "SC-MASK" "SC-ONSTACK" "SC-PC" "SETGIDEXEC"
+ "S-IWRITE" "SAVETEXT" "SB-MKSTEMP" "SC-MASK" "SC-ONSTACK"
"SETUIDEXEC" "SG-ERASE" "SG-FLAGS" "SG-ISPEED" "SG-KILL"
"SG-OSPEED" "SGTTYB" "SIZE-T" "ST-ATIME" "ST-BLKSIZE" "ST-BLOCKS"
"ST-CTIME" "ST-DEV" "ST-GID" "ST-MODE" "ST-MTIME" "ST-NLINK"
"TIMEVAL" "TIMEZONE" "TIOCFLUSH" "TIOCGETC" "TIOCGETP" "TIOCGLTC"
"TIOCGPGRP" "TIOCGWINSZ" "TIOCNOTTY" "TIOCSETC" "TIOCSETP"
"TIOCSLTC" "TIOCSPGRP" "TIOCSWINSZ" "TV-SEC" "TV-USEC"
- "TZ-DSTTIME" "TZ-MINUTESWEST" "UID-T" "UNIX-CHMOD" "UNIX-CLOSE"
+ "TZ-DSTTIME" "TZ-MINUTESWEST" "UID-T" "UNIX-CLOSE"
"UNIX-DUP""UNIX-EXIT" "UNIX-FILE-MODE" "UNIX-FSTAT"
"UNIX-GETHOSTNAME" "UNIX-GETPID" "UNIX-GETRUSAGE"
"UNIX-GETTIMEOFDAY" "UNIX-GETUID" "UNIX-GID" "UNIX-IOCTL"
"UNIX-ISATTY" "UNIX-LSEEK" "UNIX-LSTAT" "UNIX-MKDIR"
- "UNIX-MKSTEMP" "UNIX-OPEN" "UNIX-PATHNAME" "UNIX-PID"
+ "UNIX-OPEN" "UNIX-PATHNAME" "UNIX-PID"
"UNIX-PIPE" "UNIX-READ" "UNIX-READLINK" "UNIX-REALPATH"
"UNIX-RENAME" "UNIX-SELECT" "UNIX-STAT" "UNIX-UID"
"UNIX-UNLINK" "UNIX-WRITE"
(declare (ignore ino nlink gid rdev size atime))
(if existsp
(case query-for
- (:truename (parse-native-namestring
- ;; Note: in case the file is stat'able, POSIX
- ;; realpath(3) gets us a canonical absolute
- ;; filename, even if the post-merge PATHNAME
- ;; is not absolute...
- (multiple-value-bind (realpath errno)
- (sb!unix:unix-realpath filename)
- (if realpath
- realpath
- (simple-file-perror "couldn't resolve ~A"
- filename errno)))
- (pathname-host pathname)
- (sane-default-pathname-defaults)
- ;; ... but without any trailing slash.
- :as-directory (eql (logand mode sb!unix:s-ifmt)
- sb!unix:s-ifdir)))
+ (:truename (nth-value
+ 0
+ (parse-native-namestring
+ ;; Note: in case the file is stat'able, POSIX
+ ;; realpath(3) gets us a canonical absolute
+ ;; filename, even if the post-merge PATHNAME
+ ;; is not absolute...
+ (multiple-value-bind (realpath errno)
+ (sb!unix:unix-realpath filename)
+ (if realpath
+ realpath
+ (simple-file-perror "couldn't resolve ~A"
+ filename errno)))
+ (pathname-host pathname)
+ (sane-default-pathname-defaults)
+ ;; ... but without any trailing slash.
+ :as-directory (eql (logand mode sb!unix:s-ifmt)
+ sb!unix:s-ifdir))))
(:author (sb!unix:uid-username uid))
(:write-date (+ unix-to-universal-time mtime)))
(progn
;; re-merge against *DEFAULT-PATHNAME-DEFAULTS*,
;; since PATHNAME may be a relative pathname.
(merge-pathnames
- (parse-native-namestring
- (multiple-value-bind (realpath errno)
- (sb!unix:unix-realpath
- (native-namestring
- (make-pathname
- :name :unspecific
- :type :unspecific
- :version :unspecific
- :defaults (parse-native-namestring
- filename
- (pathname-host pathname)
- (sane-default-pathname-defaults)))))
- (if realpath
- realpath
- (simple-file-perror "couldn't resolve ~A"
- filename errno)))
- (pathname-host pathname)
- (sane-default-pathname-defaults)
- :as-directory t)
+ (nth-value
+ 0
+ (parse-native-namestring
+ (multiple-value-bind (realpath errno)
+ (sb!unix:unix-realpath
+ (native-namestring
+ (make-pathname
+ :name :unspecific
+ :type :unspecific
+ :version :unspecific
+ :defaults (parse-native-namestring
+ filename
+ (pathname-host pathname)
+ (sane-default-pathname-defaults)))))
+ (if realpath
+ realpath
+ (simple-file-perror "couldn't resolve ~A"
+ filename errno)))
+ (pathname-host pathname)
+ (sane-default-pathname-defaults)
+ :as-directory t))
pathname))
(:author (sb!unix:uid-username uid))
(:write-date (+ unix-to-universal-time mtime))))))
;; run afoul of disk quotas or to choke on small /tmp file systems.
(flet ((make-temp-fd ()
(multiple-value-bind (fd name/errno)
- (sb-unix:unix-mkstemp "/tmp/.run-program-XXXXXX")
+ (sb-unix:sb-mkstemp "/tmp/.run-program-XXXXXX" #o0600)
(unless fd
(error "could not open a temporary file: ~A"
(strerror name/errno)))
- #-win32 #|FIXME: should say (logior s_irusr s_iwusr)|#
- (unless (sb-unix:unix-chmod name/errno #o600)
- (sb-unix:unix-close fd)
- (error "failed to chmod the temporary file?!"))
(unless (sb-unix:unix-unlink name/errno)
(sb-unix:unix-close fd)
(error "failed to unlink ~A" name/errno))
;;;; stdlib.h
;;; There are good reasons to implement some OPEN options with an
-;;; mkstemp(3) followed by a fchmod(2) followed by a rename(2), but we
-;;; don't do that yet. Instead, this function is used only to make a
-;;; temporary file for RUN-PROGRAM. sb_mkstemp() is a wrapper that
-;;; lives in src/runtime/wrap.c.
-(defun unix-mkstemp (template-string)
+;;; mkstemp(3)-like routine, but we don't do that yet. Instead, this
+;;; function is used only to make a temporary file for RUN-PROGRAM.
+;;; sb_mkstemp() is a wrapper that lives in src/runtime/wrap.c. Since
+;;; SUSv3 mkstemp() doesn't specify the mode of the created file and
+;;; since we have to implement most of this ourselves for Windows
+;;; anyway, it seems worthwhile to depart from the mkstemp()
+;;; specification by taking a mode to use when creating the new file.
+(defun sb-mkstemp (template-string mode)
+ (declare (type string template-string)
+ (type unix-file-mode mode))
(let ((template-buffer (string-to-octets template-string)))
(with-pinned-objects (template-buffer)
(let ((fd (alien-funcall (extern-alien "sb_mkstemp"
- (function int (* char)))
- (vector-sap template-buffer))))
+ (function int (* char) int))
+ (vector-sap template-buffer)
+ mode)))
(if (minusp fd)
(values nil (get-errno))
(values fd (octets-to-string template-buffer)))))))
(syscall ("fstat_wrapper" int (* (struct wrapped_stat)))
(%extract-stat-results (addr buf))
fd (addr buf))))
-
-;;; RUN-PROGRAM creates temporary files with mkstemp, but SUSv3
-;;; doesn't specify the mode of a newly created file under mkstemp,
-;;; and C libraries may vary, so we fix the mode ourselves.
-;;; Eventually some OPEN actions should probably be implemented with
-;;; mkstemp(3)/chmod(2)/rename(2) as well.
-#!-win32
-(defun unix-chmod (path mode)
- (declare (type unix-pathname path)
- (type unix-file-mode mode))
- (void-syscall ("chmod" c-string int) path mode))
\f
;;;; time.h
#include <unistd.h>
#include <errno.h>
#include <limits.h>
+#include <fcntl.h>
+
#ifndef LISP_FEATURE_WIN32
#include <pwd.h>
#include <sys/wait.h>
#if defined(LISP_FEATURE_WIN32)
#define WIN32_LEAN_AND_MEAN
-#include <fcntl.h>
#include <errno.h>
#endif
return ret;
}
\f
-/* A wrapper for mkstemp(3), which seems not to exist on Windows. */
-int sb_mkstemp (char *template) {
+/* A wrapper for mkstemp(3), for two reasons: (1) mkstemp does not
+ exist on Windows; (2) by passing down a mode_t, we don't need a
+ binding to chmod in SB-UNIX, and need not concern ourselves with
+ umask issues if we want to use mkstemp to make new files in
+ OPEN. */
+int sb_mkstemp (char *template, mode_t mode) {
#ifdef LISP_FEATURE_WIN32
+#define PATHNAME_BUFFER_SIZE MAX_PATH
+#define MKTEMP _mktemp
+#else
+#define PATHNAME_BUFFER_SIZE PATH_MAX
+#define MKTEMP mktemp
+#endif
int fd;
- char buf[MAX_PATH];
+ char buf[PATHNAME_BUFFER_SIZE];
while (1) {
+ /* Fruit fallen from the tree: for people who like
+ microoptimizations, we might not need to copy the whole
+ template on every loop, but only the last several characters.
+ But I didn't feel like testing the boundary cases in Windows's
+ _mktemp. */
strcpy((char*)&buf, template);
- if (_mktemp((char*)&buf)) {
- if ((fd=open((char*)&buf, O_CREAT|O_EXCL|O_RDWR, S_IRUSR|S_IWUSR))!=-1) {
+ if (MKTEMP((char*)&buf)) {
+ if ((fd=open((char*)&buf, O_CREAT|O_EXCL|O_RDWR, mode))!=-1) {
strcpy(template, (char*)&buf);
return (fd);
} else
} else
return (-1);
}
-#else
- return(mkstemp(template));
-#endif
+#undef MKTEMP
+#undef PATHNAME_BUFFER_SIZE
}
\f
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.13.18"
+"1.0.13.19"
projects / sbcl.git / commitdiff