[Vm-dev] VM Maker: FileAttributesPlugin-AlistairGrant.12.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Nov 29 20:19:33 UTC 2019
Eliot Miranda uploaded a new version of FileAttributesPlugin to project VM Maker:
http://source.squeak.org/VMMaker/FileAttributesPlugin-AlistairGrant.12.mcz
==================== Summary ====================
Name: FileAttributesPlugin-AlistairGrant.12
Author: AlistairGrant
Time: 25 July 2017, 6:08:04.058747 pm
UUID: 4f4a6801-af1c-4227-beb4-2a7c1b763349
Ancestors: FileAttributesPlugin-AlistairGrant.11
FileAttributesPlugin V1.0.0
==================== Snapshot ====================
SystemOrganization addCategory: #FileAttributesPlugin!
InterpreterPlugin subclass: #FileAttributesPlugin
instanceVariableNames: 'hasSecurityPlugin smallIntegerMaxVal'
classVariableNames: ''
poolDictionaries: ''
category: 'FileAttributesPlugin'!
!FileAttributesPlugin commentStamp: 'AlistairGrant 5/14/2017 11:37' prior: 0!
FileAttributesPlugin defines the named primitives used by the FileAttributes.
For information on stat(), see http://man7.org/linux/man-pages/man2/stat.2.html
For information on access(), see http://man7.org/linux/man-pages/man2/access.2.html
For information on design considerations, see FileAttributes class comments.
Public interface:
- primitiveFileExists - answer a boolean indicating whether the supplied path name string exists
- primitiveFileAttributes - answer an array containing stat() and/or access() information for the supplied path name string
- primitiveFileMasks - answer an array of stat.st_mode masks
Return codes:
0 - Internal success. This should never be returned by the public primitives
1 - String too long. A file path name was longer than PATH_MAX.
2 - stat() call failed.
!
----- Method: FileAttributesPlugin class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: cg
cg addHeaderFile: '<sys/types.h>'.
cg addHeaderFile: '<dirent.h>
#ifdef WIN32
#include <windows.h>
#include <winbase.h>
#define FAIL() { return -1; }
#include "sqWin32File.h"
#endif
typedef struct dirptrstruct {
DIR *dp;
int path_len;
char *path_file;
char path[PATH_MAX+4];
} osdir;'.
cg addHeaderFile: '<sys/stat.h>
#if !!defined(HAVE_LSTAT) && !!defined(WIN32)
#define HAVE_LSTAT 1
#endif'.
cg addHeaderFile: '<unistd.h>
/* AKG 2017 - ', self moduleName, '.c translated from class ', self name, ' */'.
"Assume the security plugin can be loaded until proven otherwise"
cg var: 'hasSecurityPlugin' declareC: 'int hasSecurityPlugin= 1'.
"The maximum value of a SmallInteger is encoded here so that the plugin can
be regenerated and rebuilt correctly even if the Smalltalk word size or object
format changes. -dtl"
cg var: 'smallIntegerMaxVal' declareC: 'int smallIntegerMaxVal= ', SmallInteger maxVal asString.
"Window creationDate declarations"
!
----- Method: FileAttributesPlugin class>>installedModuleVersionString (in category 'testing') -----
installedModuleVersionString
"Answer the version string for the plugin which is actually running in the VM"
"self installedModuleVersionString"
<primitive: 'primitiveVersionString' module: 'FileAttributesPlugin'>
^ nil
!
----- Method: FileAttributesPlugin class>>versionString (in category 'testing') -----
versionString
"Answer version string for this class. If the installed module is up to date, it
will match this version string."
"self versionString"
^ self new versionString
!
----- Method: FileAttributesPlugin>>accessAttributesForFilename:into:startingAt: (in category 'private - file') -----
accessAttributesForFilename: cPathName into: attributeArray startingAt: offset
"Call access() for each access type (R, W, X) on the c string cPathName, storing the results in the st array attributeArray."
| index boolean |
<var: 'cPathName' type: 'char *'>
index := offset.
((self cCode: 'access(cPathName, R_OK)') = 0)
ifTrue: [boolean := interpreterProxy trueObject]
ifFalse: [boolean := interpreterProxy falseObject].
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: boolean.
index := index + 1.
((self cCode: 'access(cPathName, W_OK)') = 0)
ifTrue: [boolean := interpreterProxy trueObject]
ifFalse: [boolean := interpreterProxy falseObject].
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: boolean.
index := index + 1.
((self cCode: 'access(cPathName, X_OK)') = 0)
ifTrue: [boolean := interpreterProxy trueObject]
ifFalse: [boolean := interpreterProxy falseObject].
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: boolean.
!
----- Method: FileAttributesPlugin>>addressObjectFor: (in category 'private - directory') -----
addressObjectFor: aMachineAddress
"Answer an ExternalAddress object which represents aMachineAddress"
| addressOop addressOopArrayPointer addressUnion idx |
<var: 'aMachineAddress' type: 'void *'>
<var: 'addressUnion' declareC: 'union {void *address; unsigned char bytes[sizeof(void *)];} addressUnion'>
<var: 'addressOopArrayPointer' declareC: 'unsigned char *addressOopArrayPointer'>
addressOop := interpreterProxy
instantiateClass: interpreterProxy classByteArray
indexableSize: self sizeOfPointer.
addressOopArrayPointer := interpreterProxy arrayValueOf: addressOop.
self cCode: 'addressUnion.address = aMachineAddress'.
idx := 0.
[idx < self sizeOfPointer] whileTrue:
[self cCode: 'addressOopArrayPointer[idx] = addressUnion.bytes[idx]'.
idx := idx + 1].
^ addressOop
!
----- Method: FileAttributesPlugin>>byteArrayFromCString:to: (in category 'private') -----
byteArrayFromCString: aCString to: byteArrayOop
"Answer a new ByteArray copied from a null-terminated C string.
Caution: This may invoke the garbage collector."
| len newByteArray byteArrayPtr |
<var: 'aCString' type: 'const char *'>
<var: 'byteArrayPtr' type: 'unsigned char *'>
<var: 'byteArrayOop' type: 'sqInt *'>
len := self strlen: aCString.
"We never return strings longer than PATH_MAX"
len > (self cCode: 'PATH_MAX') ifTrue: [^self stringTooLong].
newByteArray := interpreterProxy
instantiateClass: interpreterProxy classByteArray
indexableSize: len.
byteArrayPtr := interpreterProxy arrayValueOf: newByteArray.
self cCode: 'memcpy(byteArrayPtr, aCString, len)'.
self cCode: '*byteArrayOop = newByteArray'.
^0.!
----- Method: FileAttributesPlugin>>canOpenDirectoryStreamFor:length: (in category 'private - directory') -----
canOpenDirectoryStreamFor: aPathCString length: length
"Answer non-zero if security permits the directory to be listed."
"FIXME: This function has not been tested. -dtl"
| sCLPfn |
<var: 'aPathCString' type: 'char *'>
<var: 'sCLPfn' type: 'void *'>
"If the security plugin can be loaded, use it to check .
If not, assume it's ok"
"The hasSecurityPlugin flag is set to 1 by default"
(hasSecurityPlugin = 0) ifTrue: [^ true].
sCLPfn := interpreterProxy ioLoadFunction: 'secCanListPathOfSize' From: 'SecurityPlugin'.
sCLPfn ~= 0
ifTrue:
[^ self cCode: ' ((int (*) (char *, int)) sCLPfn)(aPathCString, length)'
inSmalltalk: [true]]
ifFalse:
[hasSecurityPlugin := 0. "Reset the flag so we do not try again next time"
^ true]
!
----- Method: FileAttributesPlugin>>canStatFilePath:length: (in category 'private - file') -----
canStatFilePath: aPathCString length: length
"Answer non-zero if security permits the a stat() call on the file path. Allow a
stat() call only on files which we are permitted to open."
"FIXME: This function has not been tested. -dtl"
| sCOFfn |
<var: 'aPathCString' type: 'char *'>
<var: 'sCOFfn' type: 'void *'>
"If the security plugin can be loaded, use it to check .
If not, assume it's ok"
"The hasSecurityPlugin flag is set to 1 by default"
(hasSecurityPlugin = 0) ifTrue: [^ true].
sCOFfn := interpreterProxy ioLoadFunction: 'secCanOpenFileOfSizeWritable' From: 'SecurityPlugin'.
sCOFfn ~= 0
ifTrue:
[^ self cCode: ' ((int (*) (char *, int, int)) sCOFfn)(aPathCString, length, 0)'
inSmalltalk: [true]]
ifFalse:
[hasSecurityPlugin := 0. "Reset the flag so we do not try again next time"
^ true]
!
----- Method: FileAttributesPlugin>>cantAllocateMemory (in category 'errors') -----
cantAllocateMemory
^-10!
----- Method: FileAttributesPlugin>>cantOpenDir (in category 'errors') -----
cantOpenDir
^-9!
----- Method: FileAttributesPlugin>>cantReadlink (in category 'errors') -----
cantReadlink
^-8!
----- Method: FileAttributesPlugin>>cantStatPath (in category 'errors') -----
cantStatPath
"SecurityPlugin determined that the requested path cannot be accessed."
^-3!
----- Method: FileAttributesPlugin>>checkAccess:mode:to: (in category 'private - file') -----
checkAccess: pathString mode: mode to: flag
"Check access to pathString."
| cString len sPtr |
<export: true>
<var: 'cString' declareC: 'char cString[PATH_MAX]'>
<var: 'sPtr' declareC: 'char *sPtr'>
<var: 'flag' type: 'sqInt *'>
len := interpreterProxy stSizeOf: pathString.
"Note: The static sized string buffer is faster than using a Smalltalk allocated
string as the buffer, and is unlikely to fail in practice. In the event that
the buffer turns out to be too small, write an error message to stdout before
failing."
(len >= (self cCode: 'PATH_MAX')) ifTrue: [^self stringTooLong].
"Copy pathString to the new string"
sPtr := interpreterProxy arrayValueOf: pathString.
((self canStatFilePath: sPtr length: len) = 0) ifTrue: [^self cantStatPath].
self cCode: 'memcpy(cString, sPtr, len)'.
cString at: len put: 0.
self cCode: '*flag = access(cString, mode)'.
^0
!
----- Method: FileAttributesPlugin>>corruptValue (in category 'errors') -----
corruptValue
^-7!
----- Method: FileAttributesPlugin>>fileCreationTimeFor:length:to: (in category 'private - windows') -----
fileCreationTimeFor: pathString length: pathLength to: creationDate
"Get the creationDate for the supplied file.
Linux kernel 4.11 should have statx(), so hopefully there will be a cross-platform
solution soon. Just dump the c-code and hope to remove it soon."
| tm |
<var: 'pathString' type: 'char *'>
<var: 'creationDate' type: 'time_t *'>
<var: 'tm' type: 'struct tm'>
self cCode: '
#ifdef WIN32
WIN32_FILE_ATTRIBUTE_DATA winAttrs;
WCHAR *win32Path;
SYSTEMTIME sysTime;
#endif
memset(&tm, 0, sizeof(tm));
#ifdef WIN32
/* convert the supplied path name into a wide string */
ALLOC_WIN32_PATH(win32Path, pathString, pathLength)'.
[(self cCode: 'GetFileAttributesExW(win32Path, 0, &winAttrs)') = 0] ifTrue:
[^self getAttributesFailed].
[(self cCode: 'FileTimeToSystemTime(&winAttrs.ftCreationTime, &sysTime)') = 0] ifTrue:
[^self timeConversionFailed].
self cCode: '
tm.tm_year = sysTime.wYear - 1900;
tm.tm_mon = sysTime.wMonth - 1;
tm.tm_mday = sysTime.wDay;
tm.tm_hour = sysTime.wHour;
tm.tm_min = sysTime.wMinute;
tm.tm_sec = sysTime.wSecond;
tm.tm_isdst = 0;
#endif
*creationDate = mktime(&tm)'.
^0.
!
----- Method: FileAttributesPlugin>>fileExecutableFlag (in category 'private - file') -----
fileExecutableFlag
^ self cCode: 'X_OK' inSmalltalk: [1]!
----- Method: FileAttributesPlugin>>fileOKFlag (in category 'private - file') -----
fileOKFlag
^ self cCode: 'F_OK' inSmalltalk: [0]!
----- Method: FileAttributesPlugin>>fileReadableFlag (in category 'private - file') -----
fileReadableFlag
^ self cCode: 'R_OK' inSmalltalk: [4]!
----- Method: FileAttributesPlugin>>fileToAttributeArray:mask:array: (in category 'private - file') -----
fileToAttributeArray: cPathName mask: attributeMask array: attributeArray
"Answer a file attribute array from pathNameOop."
| getStats useLstat getAccess statArray accessArray combinedArray status fileNameOop statBuf statBufPointer |
<returnTypeC: 'int'>
<var: 'cPathName' type: 'char *'>
<var: 'attributeArray' type: 'sqInt *'>
<var: 'statBuf' type: 'struct stat'>
<var: 'statBufPointer' declareC: 'struct stat *statBufPointer= &statBuf'>
"Determine which attributes to retrieve"
getStats := (attributeMask bitAnd: 1) = 1.
getAccess := (attributeMask bitAnd: 2) = 2.
[getStats or: [getAccess]] ifFalse:
["No information has been requested, which doesn't make sense"
^self invalidArguments].
getStats ifTrue:
[
useLstat := (attributeMask bitAnd: 4) = 4.
statArray := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 12.
useLstat ifFalse:
[ status := self putStatFor: cPathName
intoBuffer: statBufPointer
targetName: (self cCode: '&fileNameOop') ]
ifTrue:
[ status := self putLStatFor: cPathName
intoBuffer: statBufPointer
targetName: (self cCode: '&fileNameOop') ].
status ~= 0 ifTrue: [^status].
status := self statArrayFor: cPathName toArray: statArray from: statBufPointer fileName: fileNameOop.
status ~= 0 ifTrue: [^status].
"Set attributeArray in case only stat() attributes have been requested"
self cCode: '*attributeArray = statArray'.
].
getAccess ifTrue:
[
accessArray := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 3.
self accessAttributesForFilename: cPathName into: accessArray startingAt: 0.
"Set attributeArray in case only access() attributes have been requested"
self cCode: '*attributeArray = accessArray'.
].
[getStats and: [getAccess]] ifTrue:
[
combinedArray := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2.
self cCode: '*attributeArray = combinedArray'.
interpreterProxy
storePointer: 0
ofObject: combinedArray
withValue: statArray.
interpreterProxy
storePointer: 1
ofObject: combinedArray
withValue: accessArray.
].
^0!
----- Method: FileAttributesPlugin>>fileWriteableFlag (in category 'private - file') -----
fileWriteableFlag
^ self cCode: 'W_OK' inSmalltalk: [2]!
----- Method: FileAttributesPlugin>>getAttributesFailed (in category 'errors') -----
getAttributesFailed
^-4!
----- Method: FileAttributesPlugin>>invalidArguments (in category 'errors') -----
invalidArguments
^-6!
----- Method: FileAttributesPlugin>>invalidRequest (in category 'errors') -----
invalidRequest
^-11!
----- Method: FileAttributesPlugin>>isSymlink:boolean: (in category 'private - file') -----
isSymlink: cPathName boolean: resultOop
"Set resultOop to a boolean indicating whether cPathName is a symbolic link.
Answer status (0 = success)"
| status statBuf |
<var: 'cPathName' type: 'char *'>
<var: 'resultOop' type: 'sqInt *'>
<var: 'statBuf' type: 'struct stat'>
self isDefinedTrueExpression: 'HAVE_LSTAT == 1'
inSmalltalk: []
comment: ''
ifTrue: [
status := self cCode: 'lstat(cPathName, &statBuf)'.
(status ~= 0) ifTrue: [^self cantStatPath].
((self cCode: 'S_ISLNK(statBuf.st_mode)') = 0)
ifFalse: [self cCode: '*resultOop = interpreterProxy->trueObject()']
ifTrue: [self cCode: '*resultOop = interpreterProxy->falseObject()'].
]
ifFalse: [].
^0
!
----- Method: FileAttributesPlugin>>oopFromTimeT: (in category 'private') -----
oopFromTimeT: posixSeconds
"Answer an object representation of the provided time (time_t).
The size of time_t is platform dependent, so check the size and convert appropriately."
<var: 'posixSeconds' type: 'time_t'>
[(self cCode: 'sizeof(time_t)') = 4] ifTrue:
[^interpreterProxy signed32BitIntegerFor: posixSeconds].
"Must be 64 bit number"
^interpreterProxy signed64BitIntegerFor: posixSeconds.
!
----- Method: FileAttributesPlugin>>openDirectoryStream:ptr: (in category 'private - directory') -----
openDirectoryStream: pathOOP ptr: osdirPtr
"Open a new directory stream. Answer a pointer to the directory stream or NULL."
| sPtr len dir |
<var: 'osdirPtr' type: 'osdir **'>
<var: 'sPtr' declareC: 'char *sPtr'>
<var: 'dir' type: 'osdir *'>
<returnTypeC: 'int'>
sPtr := interpreterProxy arrayValueOf: pathOOP.
len := interpreterProxy sizeOfSTArrayFromCPrimitive: sPtr.
"The path buffer needs room for a trailing slash and the file name, so subtracting 2 is conservative"
len > (self cCode: 'PATH_MAX-2') ifTrue: [^self stringTooLong].
(self canOpenDirectoryStreamFor: sPtr length: len)
ifTrue:
[
dir := self cCode: '(osdir *) malloc(sizeof(osdir))'.
dir = nil ifTrue: [^self cantAllocateMemory].
self cCode: 'memcpy(dir->path, sPtr, len)'.
"Ensure path has a trailing slash"
self cCode: 'if (dir->path[len-1] !!= ''/'') {
dir->path[len++] = ''/'';
}'.
self cCode: 'dir->path_file = dir->path + len'.
self cCode: 'dir->path_file[0] = ''\0'''.
self cCode: 'dir->path_len = len'.
self cCode: 'dir->dp = opendir(dir->path)'.
(self cCode: 'dir->dp') = nil ifTrue:
[dir free.
^self cantOpenDir].
self cCode: '*osdirPtr = dir'.
^0
].
"If we get here, we can't open the directory"
^self cantOpenDir
!
----- Method: FileAttributesPlugin>>pathOop:toBuffer:maxLen: (in category 'private - file') -----
pathOop: pathNameOop toBuffer: cPathName maxLen: maxLen
"Copy the supplied path name string object to the supplied c string buffer"
| len sPtr |
<var: 'cPathName' type: 'char *'>
<var: 'sPtr' declareC: 'char *sPtr'>
<returnTypeC: 'int'>
len := interpreterProxy stSizeOf: pathNameOop.
(len >= maxLen) ifTrue: [^self stringTooLong].
"Copy pathName to the new string"
sPtr := interpreterProxy arrayValueOf: pathNameOop.
((self canStatFilePath: sPtr length: len) = 0) ifTrue: [^self cantStatPath].
self cCode: 'memcpy(cPathName, sPtr, len)'.
cPathName at: len put: 0.
^0.
!
----- Method: FileAttributesPlugin>>pointerFrom: (in category 'private - directory') -----
pointerFrom: directoryPointerBytes
"Answer the machine address contained in anExternalAddressOop."
| ptr addressUnion idx |
<returnTypeC: 'void *'>
<var: 'ptr' declareC: 'unsigned char *ptr'>
<var: 'addressUnion' declareC: 'union {void *address; unsigned char bytes[sizeof(void *)];} addressUnion'>
((interpreterProxy isBytes: directoryPointerBytes) and:
[(interpreterProxy stSizeOf: directoryPointerBytes) = self sizeOfPointer])
ifFalse: [^ nil].
ptr := interpreterProxy arrayValueOf: directoryPointerBytes.
idx := 0.
[idx < self sizeOfPointer] whileTrue:
[self cCode: 'addressUnion.bytes[idx] = ptr[idx]'.
idx := idx + 1].
^ self cCode: 'addressUnion.address' inSmalltalk: [addressUnion]
!
----- Method: FileAttributesPlugin>>primitiveClosedir (in category 'file primitives') -----
primitiveClosedir
"Close the directory stream for dirPointerOop. Answer dirPointerOop on success."
| dirPointerOop dirStream result |
<export: true>
<var: 'dirStream' declareC: 'osdir *dirStream'>
dirPointerOop := interpreterProxy stackObjectValue: 0.
(dirPointerOop = interpreterProxy nilObject) ifTrue:
[^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
(interpreterProxy is: dirPointerOop KindOf: 'ByteArray') ifFalse:
[self cCode: 'fprintf(stderr, "primitiveClosedir: invalid argument, expected an ByteArray\n")'.
^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
dirStream := self pointerFrom: dirPointerOop.
(dirStream = nil) ifTrue: [^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self corruptValue)].
result := self cCode: 'closedir(dirStream->dp)'.
(result = 0) ifFalse:
[self perror: 'closedir'.
^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self corruptValue)].
self cCode: 'free(dirStream)'.
interpreterProxy pop: 2; push: dirPointerOop.
!
----- Method: FileAttributesPlugin>>primitiveFileAttribute (in category 'file primitives') -----
primitiveFileAttribute
"Answer a single file attribute.
primFileAttributes: aString attributeNumber: attributeNumber
aString is the path to the file
attributeNumber identifies which attribute to return:
1 - 12: stat(): name, mode, ino, dev, nlink, uid, gid, size, accessDate, modifiedDate, changeDate, creationDate
13 - 15: access(): R_OK, W_OK, X_OK
16: isSymlink
On error, answer a single element array containing the appropriate error code."
| fileName attributeNumber resultOop fileNameOop cPathName statBuf statBufPointer sizeIfFile mode creationDate status |
<export: true>
<var: 'statBuf' declareC: 'struct stat statBuf'>
<var: 'statBufPointer' declareC: 'struct stat *statBufPointer= &statBuf'>
<var: 'cPathName' declareC: 'char cPathName[PATH_MAX]'>
<var: 'creationDate' type: 'time_t'>
fileName := interpreterProxy stackObjectValue: 1.
attributeNumber := interpreterProxy stackIntegerValue: 0.
(attributeNumber < 1 or: [attributeNumber > 16]) ifTrue:
[^interpreterProxy pop: 3; push: (self wrappedErrorCode: self invalidArguments)].
(interpreterProxy is: fileName KindOf: 'String') ifFalse:
[^interpreterProxy pop: 3; push: (self wrappedErrorCode: self invalidArguments)].
status := self pathOop: fileName toBuffer: cPathName maxLen: (self cCode: 'PATH_MAX').
[status ~= 0] ifTrue:
[^interpreterProxy pop: 3; push: (self wrappedErrorCode: status)].
resultOop := 0.
attributeNumber < 12 ifTrue:
"Get requested stat entry"
[
status := self
putStatFor: cPathName
intoBuffer: statBufPointer
targetName: (self cCode: '&fileNameOop').
(status ~= 0) ifTrue:
[^interpreterProxy pop: 3; push: (self wrappedErrorCode: status)].
"In C, this would naturally be a switch statement,
but I don't know to mix in the smalltalk code"
attributeNumber = 1 ifTrue: [resultOop := fileNameOop].
attributeNumber = 2 ifTrue:
[resultOop := (self smallOrLargeIntegerObjectFor:
(self cCode: 'statBuf.st_mode'))].
attributeNumber = 3 ifTrue:
[resultOop := (interpreterProxy positive64BitIntegerFor:
(self cCode: 'statBuf.st_ino'))].
attributeNumber = 4 ifTrue:
[resultOop := (interpreterProxy positive64BitIntegerFor:
(self cCode: 'statBuf.st_dev'))].
attributeNumber = 5 ifTrue:
[resultOop := (interpreterProxy positive64BitIntegerFor:
(self cCode: 'statBuf.st_nlink'))].
attributeNumber = 6 ifTrue:
[resultOop := (self smallOrLargeIntegerObjectFor:
(self cCode: 'statBuf.st_uid'))].
attributeNumber = 7 ifTrue:
[resultOop := (self smallOrLargeIntegerObjectFor:
(self cCode: 'statBuf.st_gid'))].
attributeNumber = 8 ifTrue:
[
((self cCode: 'S_ISDIR(statBuf.st_mode)') = 0)
ifTrue:
[sizeIfFile := self cCode: 'statBuf.st_size']
ifFalse:
[sizeIfFile := 0].
resultOop := self smallOrLargeIntegerObjectFor: sizeIfFile
].
attributeNumber = 9 ifTrue:
[resultOop := self oopFromTimeT: (self cCode: 'statBuf.st_atime')].
attributeNumber = 10 ifTrue:
[resultOop := self oopFromTimeT: (self cCode: 'statBuf.st_mtime')].
attributeNumber = 11 ifTrue:
[resultOop := self oopFromTimeT: (self cCode: 'statBuf.st_ctime')].
]
ifFalse: [attributeNumber = 12 ifTrue:
[
status := self fileCreationTimeFor: cPathName
length: cPathName strlen
to: (self cCode: '&creationDate').
status ~= 0 ifTrue:
[^interpreterProxy pop: 3; push: (self wrappedErrorCode: status)].
resultOop := self oopFromTimeT: creationDate.
]
ifFalse: [attributeNumber < 16 ifTrue:
"Get requested access entry"
[
attributeNumber = 13 ifTrue: [mode := self fileReadableFlag].
attributeNumber = 14 ifTrue: [mode := self fileWriteableFlag].
attributeNumber = 15 ifTrue: [mode := self fileExecutableFlag].
((self cCode: 'access(cPathName, mode)') = 0)
ifTrue: [resultOop := interpreterProxy trueObject]
ifFalse: [resultOop := interpreterProxy falseObject].
]
ifFalse: "attributeNumber = 16"
[
status := self isSymlink: cPathName boolean: (self cCode: '&resultOop').
(status ~= 0) ifTrue:
[^interpreterProxy pop: 3; push: (self wrappedErrorCode: status)].
]]].
(resultOop = 0)
ifTrue: ["It shouldn't be possible to get here"
^ interpreterProxy primitiveFail]
ifFalse: [interpreterProxy pop: 3; push: resultOop]
!
----- Method: FileAttributesPlugin>>primitiveFileAttributes (in category 'file primitives') -----
primitiveFileAttributes
"Answer an array of file attributes.
primFileAttributes: aString mask: attributeMask
aString is the path to the file
attributeMask indicates which attributes to retrieve:
bit 0 - get stat() attributes
bit 1 - get access() attributes
bit 2 - use lstat() instead of stat()
On error answer the appropriate error code (Integer)"
| fileName attributeMask attributeArray cPathName status |
<export: true>
<var: 'cPathName' declareC: 'char cPathName[PATH_MAX]'>
fileName := interpreterProxy stackObjectValue: 1.
attributeMask := interpreterProxy stackIntegerValue: 0.
(interpreterProxy is: fileName KindOf: 'String') ifFalse:
[^interpreterProxy pop: 3; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
status := self pathOop: fileName toBuffer: cPathName maxLen: (self cCode: 'PATH_MAX').
status ~= 0 ifTrue:
[^interpreterProxy pop: 3; push: (interpreterProxy signed32BitIntegerFor: status)].
status := self fileToAttributeArray: cPathName mask: attributeMask array: (self cCode: '&attributeArray').
status ~= 0
ifTrue: [interpreterProxy pop: 3; push: (interpreterProxy signed32BitIntegerFor: status)]
ifFalse: [interpreterProxy pop: 3; push: attributeArray]
!
----- Method: FileAttributesPlugin>>primitiveFileExists (in category 'file primitives') -----
primitiveFileExists
"Check for existence of a file with a call to access()."
| pathString status accessFlag |
<export: true>
<var: 'accessFlag' type: 'sqInt'>
pathString := interpreterProxy stackObjectValue: 0.
(interpreterProxy is: pathString KindOf: 'String') ifFalse:
[^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
status := self checkAccess: pathString mode: self fileOKFlag to: (self cCode: '&accessFlag').
[status = 0] ifFalse: [^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: status)].
accessFlag = 0
ifTrue: [interpreterProxy pop: 2; push: interpreterProxy trueObject]
ifFalse: [interpreterProxy pop: 2; push: interpreterProxy falseObject]
!
----- Method: FileAttributesPlugin>>primitiveFileMasks (in category 'file primitives') -----
primitiveFileMasks
"Answer an array of well known file masks"
| masks |
<export: true>
masks := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 8.
interpreterProxy
storePointer: 0
ofObject: masks
withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFMT')).
self isDefinedTrueExpression: 'defined(WIN32)'
inSmalltalk: []
comment: 'windows doesn''t have SOCK or SYMLINK file types'
ifTrue: []
ifFalse: [
interpreterProxy
storePointer: 1
ofObject: masks
withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFSOCK')).
interpreterProxy
storePointer: 2
ofObject: masks
withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFLNK')).
].
interpreterProxy
storePointer: 3
ofObject: masks
withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFREG')).
interpreterProxy
storePointer: 4
ofObject: masks
withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFBLK')).
interpreterProxy
storePointer: 5
ofObject: masks
withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFDIR')).
interpreterProxy
storePointer: 6
ofObject: masks
withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFCHR')).
interpreterProxy
storePointer: 7
ofObject: masks
withValue: (self smallOrLargeIntegerObjectFor: (self cCode: 'S_IFIFO')).
interpreterProxy pop: 1 thenPush: masks!
----- Method: FileAttributesPlugin>>primitiveLogicalDrives (in category 'file primitives') -----
primitiveLogicalDrives
"Answer the logical drive mask on windows"
| mask |
<export: true>
self isDefinedTrueExpression: 'defined(WIN32)'
inSmalltalk: []
comment: 'Answer the logical drive mask on windows'
ifTrue: [
mask := self cCode: 'GetLogicalDrives()'.
[mask ~= 0] ifTrue:
[^interpreterProxy pop: 1 thenPush: (interpreterProxy positive32BitIntegerFor: mask)]
]
ifFalse: [].
^interpreterProxy primitiveFail.!
----- Method: FileAttributesPlugin>>primitiveOpendir (in category 'file primitives') -----
primitiveOpendir
"self primOpendir: '/etc'"
| dirName dir dirOop status |
<export: true>
<var: 'dir' type: 'osdir *'>
<var: 'dirOopArrayPointer' declareC: 'unsigned char *dirOopArrayPointer'>
dirName := interpreterProxy stackObjectValue: 0.
(interpreterProxy is: dirName KindOf: 'String') ifFalse:
[self cCode: 'fprintf(stderr, "primitiveOpendir: invalid argument, expected a String\n")'.
^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
status := self openDirectoryStream: dirName ptr: (self cCode: '&dir').
status ~= 0 ifTrue: [^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: status)].
dirOop := self addressObjectFor: dir.
interpreterProxy pop: 2; push: dirOop
!
----- Method: FileAttributesPlugin>>primitivePathMax (in category 'file primitives') -----
primitivePathMax
"Answer the value of PATH_MAX for the current VM"
<export: true>
^interpreterProxy pop: 1 thenPush: (self smallOrLargeIntegerObjectFor: (self cCode: 'PATH_MAX')).!
----- Method: FileAttributesPlugin>>primitiveReaddir (in category 'file primitives') -----
primitiveReaddir
"Get the next entry in the directory stream. Answer the name of the entry, or
error for end of directory stream."
| dirPointerOop dirStream ent entryName attributeArray resultArray haveEntry entry_len status |
<export: true>
<var: 'ent' declareC: 'struct dirent *ent'>
<var: 'dirStream' declareC: 'osdir *dirStream'>
<var: 'haveEntry' declareC: 'int haveEntry'>
dirPointerOop := interpreterProxy stackObjectValue: 0.
(interpreterProxy is: dirPointerOop KindOf: 'ByteArray') ifFalse:
[self cCode: 'fprintf(stderr, "primitiveReaddir: invalid argument, expected an ByteArray\n")'.
^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
dirStream := self pointerFrom: dirPointerOop.
(dirStream = nil) ifTrue: [^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
haveEntry := 0.
self cCode: 'do {'.
ent := self cCode: 'readdir(dirStream->dp)'.
self cCode: 'if (ent == NULL ||
((!! (ent->d_name[0] == ''.'' && strlen(ent->d_name) == 1)) && strcmp(ent->d_name, "..")))
haveEntry = 1;
} while (haveEntry == 0)'.
(ent = nil) ifTrue: ["This is the normal case for the end of a directory stream,
although it may indicate other error conditions for which errno would be updated.
Assume the normal case here."
^interpreterProxy pop: 2; push: interpreterProxy nilObject].
status := self byteArrayFromCString: (self cCode: 'ent->d_name') to: (self cCode: '&entryName').
[status ~= 0] ifTrue:
[^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: status)].
"Build the path name (append the entry name to the path name)"
entry_len := self cCode: 'strlen(ent->d_name)'.
[(self cCode: 'dirStream->path_len') + entry_len > (self cCode: 'PATH_MAX-1')] ifTrue:
[^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self stringTooLong)].
self cCode: 'memcpy(dirStream->path_file, ent->d_name, entry_len)'.
self cCode: 'dirStream->path_file[entry_len] = ''\0'''.
status := self fileToAttributeArray: (self cCode: 'dirStream->path') mask: 1 array: (self cCode: '&attributeArray').
"If the stat() fails, still return the filename, just no attributes"
status ~= 0 ifTrue: [attributeArray := interpreterProxy nilObject].
resultArray := interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2.
interpreterProxy
storePointer: 0
ofObject: resultArray
withValue: entryName.
interpreterProxy
storePointer: 1
ofObject: resultArray
withValue: attributeArray.
interpreterProxy pop: 2; push: resultArray
!
----- Method: FileAttributesPlugin>>primitiveRewinddir (in category 'file primitives') -----
primitiveRewinddir
"Set directoryStream to first entry. Answer dirPointerOop."
| dirPointerOop dirStream |
<export: true>
<var: 'dirStream' declareC: 'osdir *dirStream'>
dirPointerOop := interpreterProxy stackObjectValue: 0.
(interpreterProxy is: dirPointerOop KindOf: 'ByteArray') ifFalse:
[self cCode: 'fprintf(stderr, "primitiveRewindir: invalid argument, expected an ByteArray\n")'.
^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
dirStream := self pointerFrom: dirPointerOop.
(dirStream = nil) ifTrue: [^interpreterProxy pop: 2; push: (interpreterProxy signed32BitIntegerFor: self invalidArguments)].
self cCode: 'rewinddir(dirStream->dp)'.
interpreterProxy pop: 2; push: dirPointerOop
!
----- Method: FileAttributesPlugin>>primitiveVersionString (in category 'file primitives') -----
primitiveVersionString
"Answer a string containing the version string for this plugin."
<export: true>
interpreterProxy pop: 1 thenPush: (self stringFromCString: self versionString)
!
----- Method: FileAttributesPlugin>>putLStatFor:intoBuffer:targetName: (in category 'private - file') -----
putLStatFor: cPathName intoBuffer: statBufPointer targetName: fileNameOop
"Call stat() on cPathName, storing the results in
the buffer at statBufPointer."
| result cLinkName cLinkPtr len status |
<var: 'cPathName' type: 'char *'>
<var: 'statBufPointer' type: 'struct stat *'>
<var: 'cLinkName' declareC: 'char cLinkName[PATH_MAX]'>
<var: 'cLinkPtr' declareC: 'char *cLinkPtr = (char *) &cLinkName'>
<var: 'fileNameOop' type: 'sqInt *'>
self isDefinedTrueExpression: 'HAVE_LSTAT == 1'
inSmalltalk: []
comment: 'Platforms which do not have lstat() should #define HAVE_LSTAT 0'
ifTrue: [
result := self cCode: 'lstat(cPathName, statBufPointer)'.
(result ~= 0) ifTrue: [^self cantStatPath].
((self cCode: 'S_ISLNK(statBufPointer->st_mode)') = 0)
ifFalse: [
len := self readLink: cPathName into: cLinkPtr maxLength: (self cCode: 'PATH_MAX').
len < 0 ifTrue: [^len].
status := self byteArrayFromCString: cLinkPtr to: fileNameOop.
[status ~= 0] ifTrue: [^status]]
ifTrue:
[self cCode: '*fileNameOop = interpreterProxy->nilObject()'].
]
ifFalse:
[^self invalidRequest].
^0
!
----- Method: FileAttributesPlugin>>putStatFor:intoBuffer:targetName: (in category 'private - file') -----
putStatFor: cPathName intoBuffer: statBufPointer targetName: fileNameOop
"Call stat() on cPathName, storing the results in
the buffer at statBufPointer."
| result status |
<var: 'cPathName' type: 'char *'>
<var: 'statBufPointer' type: 'struct stat *'>
<var: 'fileNameOop' type: 'sqInt *'>
self cCode: '#ifdef WIN32
TIME_ZONE_INFORMATION dtzi;
#endif'.
result :=self cCode: 'stat(cPathName, statBufPointer)'.
(result ~= 0) ifTrue: [^self cantStatPath].
self isDefinedTrueExpression: 'defined(WIN32)'
inSmalltalk: []
comment: 'The windows version of stat() looks like it doesn''t handle dst properly. Adjust for DST. Remove this code if ever switching to cygwin stat().'
ifTrue: [
status := self cCode: 'GetTimeZoneInformation(&dtzi)'.
[status = 2] ifTrue: [
self cCode: 'statBufPointer->st_atime -= 3600'.
self cCode: 'statBufPointer->st_mtime -= 3600'.
self cCode: 'statBufPointer->st_ctime -= 3600'.
].
]
ifFalse: [].
self cCode: '*fileNameOop = interpreterProxy->nilObject()'.
^0
!
----- Method: FileAttributesPlugin>>readLink:into:maxLength: (in category 'private - file') -----
readLink: cPathName into: cLinkPtr maxLength: maxLength
"Get the target filename of the supplied symbolic link."
| len |
<returnTypeC: 'size_t'>
<var: 'cPathName' type: 'char *'>
<var: 'cLinkPtr' type: 'char *'>
<var: 'maxLength' type: 'size_t'>
<var: 'len' type: 'size_t'>
self isDefinedTrueExpression: 'defined(WIN32)'
inSmalltalk: []
comment: 'This should never be called on WIN32, just indicate failure'
ifTrue: [len := -1]
ifFalse: [len := self cCode: 'readlink(cPathName, cLinkPtr, maxLength)'].
len < 0 ifTrue:
[self cCode: 'fprintf(stderr, "FileAttributesPlugin: unable to readlink(): %d\n", len)'.
^self cantReadlink].
cLinkPtr at: len put: 0.
^len.!
----- Method: FileAttributesPlugin>>sizeOfPointer (in category 'private - directory') -----
sizeOfPointer
"Size of a C pointer on this machine"
^ self cCode: 'sizeof(void *)' inSmalltalk: [4]
!
----- Method: FileAttributesPlugin>>smallOrLargeIntegerObjectFor: (in category 'private') -----
smallOrLargeIntegerObjectFor: aPositiveInteger
"Answer an Integer object for aPositiveInteger. If the value is too large
to fit in an SmallInteger, then answer a LargePositiveInteger. Note that
smallIntegerMaxVal is a class variable with an initialization value determined
when this class is translated to C code; see my #declareCVarsIn: class method."
(aPositiveInteger > smallIntegerMaxVal)
ifTrue: [^ interpreterProxy integerObjectOf: aPositiveInteger]
ifFalse: [^ interpreterProxy positive32BitIntegerFor: aPositiveInteger]
!
----- Method: FileAttributesPlugin>>statArrayFor:toArray:from:fileName: (in category 'private - file') -----
statArrayFor: cPathName toArray: attributeArray from: statBufPointer fileName: fileNameOop
"Answer a file entry array from the supplied statBufPointer"
| index sizeIfFile creationDate status |
<var: 'cPathName' type: 'char *'>
<var: 'statBufPointer' type: 'struct stat *'>
<var: 'creationDate' type: 'time_t'>
((self cCode: 'S_ISDIR(statBufPointer->st_mode)') = 0)
ifTrue:
[sizeIfFile := self cCode: 'statBufPointer->st_size']
ifFalse:
[sizeIfFile := 0].
index := 0.
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: fileNameOop.
index := index + 1. "1"
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (self smallOrLargeIntegerObjectFor:
(self cCode: 'statBufPointer->st_mode' inSmalltalk: [0])).
index := index + 1. "2"
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (interpreterProxy positive64BitIntegerFor:
(self cCode: 'statBufPointer->st_ino' inSmalltalk: [0])).
index := index + 1. "3"
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (interpreterProxy positive64BitIntegerFor:
(self cCode: 'statBufPointer->st_dev' inSmalltalk: [0])).
index := index + 1. "4"
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (interpreterProxy positive64BitIntegerFor:
(self cCode: 'statBufPointer->st_nlink' inSmalltalk: [0])).
index := index + 1. "5"
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (self smallOrLargeIntegerObjectFor:
(self cCode: 'statBufPointer->st_uid' inSmalltalk: [0])).
index := index + 1. "6"
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (self smallOrLargeIntegerObjectFor:
(self cCode: 'statBufPointer->st_gid' inSmalltalk: [0])).
index := index + 1. "7"
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (self smallOrLargeIntegerObjectFor: sizeIfFile).
index := index + 1. "8"
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (self oopFromTimeT: (self cCode: 'statBufPointer->st_atime')).
index := index + 1. "9"
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (self oopFromTimeT: (self cCode: 'statBufPointer->st_mtime')).
index := index + 1. "10"
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (self oopFromTimeT: (self cCode: 'statBufPointer->st_ctime')).
index := index + 1. "11"
self isDefinedTrueExpression: 'defined(WIN32)'
inSmalltalk: []
comment: 'windows supports creation date'
ifTrue:
[
status := self fileCreationTimeFor: cPathName
length: cPathName strlen
to: (self cCode: '&creationDate').
status = 0 ifTrue:
[
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (self oopFromTimeT: creationDate).
]
ifFalse:
[
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (interpreterProxy nilObject).
]
]
ifFalse:
[
interpreterProxy
storePointer: index
ofObject: attributeArray
withValue: (interpreterProxy nilObject).
].
^0!
----- Method: FileAttributesPlugin>>statFailed (in category 'errors') -----
statFailed
"A call to stat() failed"
^-2!
----- Method: FileAttributesPlugin>>stringFromCString: (in category 'private') -----
stringFromCString: aCString
"Answer a new String copied from a null-terminated C string.
Caution: This may invoke the garbage collector."
| len newString |
<var: 'aCString' type: 'const char *'>
len := self strlen: aCString.
newString := interpreterProxy
instantiateClass: interpreterProxy classString
indexableSize: len.
self st: (interpreterProxy arrayValueOf: newString)
rn: aCString
cpy: len. "(char *)strncpy()"
^ newString
!
----- Method: FileAttributesPlugin>>stringTooLong (in category 'errors') -----
stringTooLong
"String too long. A file path name was longer than PATH_MAX"
^-1!
----- Method: FileAttributesPlugin>>timeConversionFailed (in category 'errors') -----
timeConversionFailed
^-5!
----- Method: FileAttributesPlugin>>versionString (in category 'version string') -----
versionString
"Answer a string containing the version string for this plugin."
| version |
<returnTypeC: 'char *'>
<var: 'version' declareC: 'static char version[]= "1.0.0"'>
^ self cCode: 'version' inSmalltalk: ['1.0.0']!
----- Method: FileAttributesPlugin>>wrappedErrorCode: (in category 'private') -----
wrappedErrorCode: aNumber
"Answer a single element Array containing the supplied error code."
| newArray |
newArray := interpreterProxy
instantiateClass: interpreterProxy classArray
indexableSize: 1.
interpreterProxy
storePointer: 0
ofObject: newArray
withValue: (interpreterProxy signed32BitIntegerFor: aNumber).
^newArray!
More information about the Vm-dev
mailing list