From e252fb7f4398511d4d604689cf97bb09dbd94e58 Mon Sep 17 00:00:00 2001 From: Ahmon Dancy Date: Wed, 19 Jul 2017 12:19:39 -0700 Subject: [PATCH] Fixed symlink-p operation on ACL 10.1 ACL 10.1 is built with Visual Studio 2015. (ACL 10.0 was built with MSVC 6.0). There are some changes in behavior in the VS 2015 runtime libraries (as compared to MSVC 6) which adversely affect the behavior of Allegro NFS. This commit works around those changes. The notable change in behavior is that the stat64 function now returns -1 and ENOENT for pagefile.sys where it didn't before. This problem is manifested by any operation which uses excl::filestat, such as 'file-length' and 'open'. symlink-p calls file-length on a file to see if it has an even length (meaning it might be a symlink file). symlink-p is used by unix-mode-from-file-attributes which is used by unicode-stat and stat-via-find-first-file (which is called by unicode-stat). To work around the problem symlink-p now takes the file-length as a required argument. This information is already available in the caller anyway. symlink-p also now uses with-unicode-open instead of with-open-file Additional code cleanup: * Factored out a common pattern into dword-pair-to-integer. * Remove unused old-unicode-stat function. Removed unused stat64 struct, wstat64 foreign call, and related foreign type defs. * Remove unused unix-mode-from-file-information function. Change-Id: If3a66ba666c44763cde6e1d4f5ba038c1fe4cf9a Reviewed-on: https://gerrit.franz.com:9080/8059 Reviewed-by: Ahmon Dancy Reviewed-by: Kevin Layer Tested-by: Kevin Layer --- nfs-common.cl | 2 +- unicode-file.cl | 205 ++++++++++++++++-------------------------------- 2 files changed, 69 insertions(+), 138 deletions(-) diff --git a/nfs-common.cl b/nfs-common.cl index 1614178..dff06a3 100644 --- a/nfs-common.cl +++ b/nfs-common.cl @@ -32,7 +32,7 @@ ;; NOTE: the form of the version *must* be a.b.c. If you're starting ;; a new release, say 6.0, then use 6.0.0. For betas, use ;; something like 6.2.beta.0. -(defvar *nfsd-version* "6.3.0") +(defvar *nfsd-version* "6.3.1") (defvar *nfsd-long-version* (format nil "~a (NFSv2/NFSv3)" *nfsd-version*)) (load (merge-pathnames "commit-id.cl" *load-pathname*)) diff --git a/unicode-file.cl b/unicode-file.cl index 9b1801e..b9f3543 100644 --- a/unicode-file.cl +++ b/unicode-file.cl @@ -75,6 +75,12 @@ (defconstant *error-no-more-files* 18) +(defun dword-pair-to-integer (high low) + ;; Takes high and low 32-bit dwords and returns the corresponding integer + (declare (optimize speed (safety 0)) + ((unsigned-byte 32) high low)) + (logior (ash high 32) low)) + ;; Not the same as the CL directory call. Only returns basenames, and it ;; includes the . and .. names. (defun unicode-directory (dir) @@ -174,77 +180,6 @@ (when (streamp ,var) (close ,var :abort ,abort)))))) -(ff:def-foreign-type dev_t :unsigned-int) -(ff:def-foreign-type ino_t :unsigned-short) -(ff:def-foreign-type int64 - (:struct - (low :unsigned-int) - (high :unsigned-int))) -(ff:def-foreign-type time64_t int64) - -#| -struct __stat64 { - _dev_t st_dev; - _ino_t st_ino; - unsigned short st_mode; - short st_nlink; - short st_uid; - short st_gid; - _dev_t st_rdev; - __int64 st_size; - __time64_t st_atime; - __time64_t st_mtime; - __time64_t st_ctime; - }; -|# - -(ff:def-foreign-type stat64 - (:struct - (dev dev_t) ; 0 4 - (ino ino_t) ; 4 2 - (mode :unsigned-short) ; 6 2 - (nlink :short) ; 8 2 - (uid :short) ; 10 2 - (gid :short) ; 12 2 - ; 2 bytes of alignment pad - (rdev dev_t) ; 16 4 - (pad1 :int) ; 20 4 - (size int64) ; 24 - (atime time64_t) - (mtime time64_t) - (ctime time64_t))) - -(ff:def-foreign-call (wstat64 "_wstat64") - ((path (* :void)) - (buffer (* stat64))) - :strings-convert nil - :error-value :errno) - -;; Returns values used by Allegro NFS: -:: mode nlink uid gid size atime mtime ctime -(defun old-unicode-stat (filename) - (declare (optimize speed)) - (ff:with-static-fobject (sb 'stat64 :allocation :foreign-static-gc) - (multiple-value-bind (status errno) - (wstat64 filename sb) - (if (not (zerop status)) - (excl.osi:perror errno "stat64")) - (macrolet ((slot (&rest rest) - `(ff:fslot-value-typed 'stat64 :foreign-static-gc sb ,@rest))) - (macrolet ((timeslot (name) - `(excl.osi:unix-to-universal-time (slot ,name :low)))) - (let ((mode (slot 'mode))) - (if (symlink-p filename) - (setf mode #o0120777)) - (values mode (slot 'nlink) (slot 'uid) (slot 'gid) - (logior (slot 'size 'low) (ash (slot 'size 'high) 32)) - (timeslot 'atime) - (timeslot 'mtime) - ;; bug21964: use the mtime as the ctime since the ctime - ;; isn't what we thought was it (create time instead of - ;; inode change time as it's supposed to be). - (timeslot 'mtime)))))))) - (ff:def-foreign-call (GetFileAttributes "GetFileAttributesW") ((lpFileName (* :void))) :returning :int @@ -265,13 +200,15 @@ struct __stat64 { (aref *symlink-header* n))) (return)))) -(defun symlink-p (filename &optional attrs) +;; Called by unix-mode-from-file-attributes, :operator +(defun symlink-p (filename attrs file-length) (declare (optimize speed)) - (let ((res (or attrs (GetFileAttributes filename)))) - (when (and (not (eq res INVALID_FILE_ATTRIBUTES)) - (not (zerop (logand res FILE_ATTRIBUTE_SYSTEM))) - (zerop (logand res FILE_ATTRIBUTE_DIRECTORY)) - (evenp (file-length filename))) + (let ((attrs (or attrs (GetFileAttributes filename))) + (file-length (or file-length (file-length filename)))) + (when (and (not (eq attrs INVALID_FILE_ATTRIBUTES)) + (not (zerop (logand attrs FILE_ATTRIBUTE_SYSTEM))) + (zerop (logand attrs FILE_ATTRIBUTE_DIRECTORY)) + (evenp file-length)) (let ((buf (make-ausb8 8))) (declare (optimize (safety 0)) (dynamic-extent buf)) @@ -280,9 +217,11 @@ struct __stat64 { (handler-bind ((syscall-error (lambda (e) - (when (eq (syscall-error-errno e) *eacces*) - (return-from symlink-p nil))))) - (with-open-file (f filename) + (let ((errno (syscall-error-errno e))) + (when (eq errno *eacces*) + ;;(format t "symlink-p returning nil due to errno ~a~%" errno) + (return-from symlink-p nil)))))) + (with-unicode-open (f filename) (if (and (eq 8 (read-vector buf f)) (symlink-header-p buf)) t))))))) @@ -438,8 +377,10 @@ struct __stat64 { (declare (optimize speed)) (let* ((ticks-per-sec 10000000) (secs-from-windows-epoch-to-unix-epoch 11644473600) - (ticks (logior (ash (ff:fslot-value-typed 'win:filetime :c filetime-ptr 'dwHighDateTime) 32) - (ff:fslot-value-typed 'win:filetime :c filetime-ptr 'dwLowDateTime)))) + (ticks (dword-pair-to-integer + (ff:fslot-value-typed 'win:filetime :c filetime-ptr 'dwHighDateTime) + (ff:fslot-value-typed 'win:filetime :c filetime-ptr 'dwLowDateTime)))) + (multiple-value-bind (secs-since-1601 remaining-ticks) (truncate ticks ticks-per-sec) (values @@ -459,9 +400,12 @@ struct __stat64 { :error-value :os-specific :strings-convert nil) -(defun unix-mode-from-file-attributes (filename attrs) +;;;Called by +;;;stat-via-find-first-file, :operator +;;;unicode-stat, :operator +(defun unix-mode-from-file-attributes (filename attrs file-length) (declare (optimize speed)) - (if* (symlink-p filename attrs) + (if* (symlink-p filename attrs file-length) then #o0120777 else ;; Windows documentation claims: ;; Setting a folder to read-only makes all the files in the @@ -479,11 +423,6 @@ struct __stat64 { (logior type perms)))) -(defun unix-mode-from-file-information (filename info) - (declare (optimize speed)) - (unix-mode-from-file-attributes filename - (ff:fslot-value-typed 'by-handle-file-information :foreign info 'dwFileAttributes))) - (defun stat-via-find-first-file (filename) (ff:with-stack-fobject (data 'win32-find-data-w) (multiple-value-bind (handle err) @@ -494,20 +433,27 @@ struct __stat64 { (macrolet ((access-slot (&rest names) `(ff:fslot-value-typed 'win32-find-data-w :foreign data ,@names))) - (values - ;; If we had to resort to using stat-via-find-first-file, then the file wasn't - ;; accessible using normal mechanisms, which means that attempts to read/write it - ;; in the future definitely won't work, so we reflect that in the mode bits. - (logandc2 (unix-mode-from-file-attributes filename (access-slot 'dwFileAttributes)) #o777) - 1 ;; nlinks - 0 ;; uid - 0 ;; gid - (logior (ash (access-slot 'nFileSizeHigh) 32) (access-slot 'nFileSizeLow)) ;; size - (filetime-to-universal-time (access-slot 'ftLastAccessTime)) ;; atime - (filetime-to-universal-time (access-slot 'ftLastWriteTime)) ;; mtime - ;; Return same info as mtime for ctime - (filetime-to-universal-time (access-slot 'ftLastWriteTime)) ;; ctime - ))))) + + (let ((file-length (dword-pair-to-integer (access-slot 'nFileSizeHigh) + (access-slot 'nFileSizeLow)))) + + (values + ;; If we had to resort to using stat-via-find-first-file, then the file wasn't + ;; accessible using normal mechanisms, which means that attempts to read/write it + ;; in the future definitely won't work, so we reflect that in the mode bits. + (logandc2 (unix-mode-from-file-attributes filename + (access-slot 'dwFileAttributes) + file-length) + #o777) + 1 ;; nlinks + 0 ;; uid + 0 ;; gid + file-length ;; size + (filetime-to-universal-time (access-slot 'ftLastAccessTime)) ;; atime + (filetime-to-universal-time (access-slot 'ftLastWriteTime)) ;; mtime + ;; Return same info as mtime for ctime + (filetime-to-universal-time (access-slot 'ftLastWriteTime)) ;; ctime + )))))) (defconstant ERROR_SHARING_VIOLATION 32) @@ -521,17 +467,21 @@ struct __stat64 { (if* success then (macrolet ((access-slot (&rest names) `(ff:fslot-value-typed 'win:win32_file_attribute_data :foreign info ,@names))) - (values - (unix-mode-from-file-attributes filename (access-slot 'win::dwFileAttributes)) - 1 ;; nlinks - 0 ;; uid - 0 ;; gid - (logior (ash (access-slot 'nFileSizeHigh) 32) (access-slot 'nFileSizeLow)) ;; size - (filetime-to-universal-time (access-slot 'ftLastAccessTime)) ;; atime - (filetime-to-universal-time (access-slot 'ftLastWriteTime)) ;; mtime - ;; Return same info as mtime for ctime - (filetime-to-universal-time (access-slot 'ftLastWriteTime)) ;; ctime - )) + (let ((file-length (dword-pair-to-integer (access-slot 'nFileSizeHigh) + (access-slot 'nFileSizeLow)))) + (values + (unix-mode-from-file-attributes filename + (access-slot 'win::dwFileAttributes) + file-length) + 1 ;; nlinks + 0 ;; uid + 0 ;; gid + file-length ;; size + (filetime-to-universal-time (access-slot 'ftLastAccessTime)) ;; atime + (filetime-to-universal-time (access-slot 'ftLastWriteTime)) ;; mtime + ;; Return same info as mtime for ctime + (filetime-to-universal-time (access-slot 'ftLastWriteTime)) ;; ctime + ))) elseif (= err ERROR_SHARING_VIOLATION) then ;; Try alternate approach (stat-via-find-first-file filename) @@ -545,25 +495,6 @@ struct __stat64 { (let ((mode (unicode-stat filename))) (= (logand mode *s-ifmt*) *s-ifdir*))) -#+ignore -(defun test () - (labels ((test-old (path) - (let ((values (multiple-value-list (old-unicode-stat path)))) - (format t "Old ~a: ~a~%" path values))) - (test-new (path) - (let ((values (multiple-value-list (unicode-stat path)))) - (format t "New ~a: ~a~%" path values)))) - (test-old "c:/") - (test-new "c:/") - (test-old "c:/System Volume Information") - (test-new "c:/System Volume Information") - (test-old "c:/pagefile.sys") - (test-new "c:/pagefile.sys") - (test-old "c:/temp/victim") - (test-new "c:/temp/victim") - )) - - (ff:def-foreign-type large-integer (:struct (LowPart win:dword) ;; unsigned long @@ -576,9 +507,9 @@ struct __stat64 { (HighPart win:dword))) (defun get-ularge-integer (uli) - (logior - (ff:fslot-value-typed 'ularge-integer :foreign uli 'LowPart) - (ash (ff:fslot-value-typed 'ularge-integer :foreign uli 'HighPart) 32))) + (dword-pair-to-integer + (ff:fslot-value-typed 'ularge-integer :foreign uli 'HighPart) + (ff:fslot-value-typed 'ularge-integer :foreign uli 'LowPart))) (ff:def-foreign-call GetDiskFreeSpaceExW ;; Must be a directory! Can't be a file (unlike Unix statfs). @@ -846,7 +777,7 @@ struct __stat64 { (macrolet ((access-slot (&rest names) `(ff:fslot-value-typed 'by-handle-file-information :foreign info ,@names))) - (prog1 (logior (ash (access-slot 'nFileIndexHigh) 32) (access-slot 'nFileIndexLow)) + (prog1 (dword-pair-to-integer (access-slot 'nFileIndexHigh) (access-slot 'nFileIndexLow)) (win:CloseHandle handle)))))))