class: UnixOperatingSystem
authorStefan Vogel <sv@exept.de>
Mon, 08 Jul 2013 21:27:29 +0200
changeset 15492 626feb0ef3a5
parent 15491 bb2780950dd1
child 15493 1b8acec57959
class: UnixOperatingSystem added: #accessModeOfFd: #changeAccessModeOfFd:to:
UnixOperatingSystem.st
--- a/UnixOperatingSystem.st	Mon Jul 08 21:27:09 2013 +0200
+++ b/UnixOperatingSystem.st	Mon Jul 08 21:27:29 2013 +0200
@@ -4018,6 +4018,42 @@
    "
 !
 
+accessModeOfFd:aFileDescriptor
+    "return a number representing access rights rwxrwxrwx for owner,
+     group and others. Return nil if such a file does not exist.
+     Notice that the returned number is OS dependent - use the
+     modeMasks as returned by OperatingSystem>>accessMaskFor:"
+
+%{
+    struct stat buf;
+    int ret;
+
+    if (__isSmallInteger(aFileDescriptor)) {
+# ifdef TRACE_STAT_CALLS
+        printf("fstat on '%d' for accessMode\n", __smallIntegerVal(aFileDescriptor));
+# endif
+        __BEGIN_INTERRUPTABLE__
+        do {
+            ret = fstat(__smallIntegerVal(aFileDescriptor), &buf);
+        } while ((ret < 0) && (errno == EINTR));
+        __END_INTERRUPTABLE__
+
+        if (ret < 0) {
+            @global(LastErrorNumber) = __mkSmallInteger(errno);
+            RETURN ( nil );
+        }
+        RETURN ( __mkSmallInteger(buf.st_mode & 0777) );
+    }
+%}.
+   ^ self primitiveFailed
+
+   "
+    '/' asFilename readingFileDo:[:s|
+        (OperatingSystem accessModeOfFd:s fileDescriptor) printStringRadix:8
+    ].
+   "
+!
+
 changeAccessModeOf:aPathName to:modeBits
     "change the access rights of aPathName to the OS dependent modeBits.
      You should construct this mask using accessMaskFor, to be OS
@@ -4044,6 +4080,32 @@
     }
 %}.
     ^ self primitiveFailed
+!
+
+changeAccessModeOfFd:aFileDescriptor to:modeBits
+    "change the access rights of the file referenced by aFileDescriptor
+     to the OS dependent modeBits.
+     You should construct this mask using accessMaskFor, to be OS
+     independent. Return true if changed,
+     false if such a file does not exist or change was not allowd."
+
+%{
+    int ret;
+
+    if (__isSmallInteger(aFileDescriptor) && __isSmallInteger(modeBits)) {
+        __BEGIN_INTERRUPTABLE__
+        do {
+            ret = fchmod(__smallIntegerVal(aFileDescriptor), __intVal(modeBits));
+        } while (ret < 0 && errno == EINTR);
+        __END_INTERRUPTABLE__
+        if (ret < 0) {
+            @global(LastErrorNumber) = __mkSmallInteger(errno);
+            RETURN ( false );
+        }
+        RETURN ( true );
+    }
+%}.
+    ^ self primitiveFailed
 ! !
 
 !UnixOperatingSystem class methodsFor:'file locking'!
@@ -6121,20 +6183,6 @@
     ^ nil
 !
 
-makePTYPair
-    "make a pty-pair, return an array with two filedescriptors on success,
-     nil on failure.
-     This is a leftover compatibility lowLevel entry, not for public use.
-     See NonPositionableExternalStream>>makePTYPair for a more user-friendly,
-     public interface."
-
-    |triple|
-
-    triple := self makePTY.
-    triple isNil ifTrue:[^ nil].
-    ^ Array with:(triple at:1) with:(triple at:2)
-!
-
 makePTY
     "make a pty-pair, return a triple with two filedescriptors and the pty's name
      on success, nil on failure.
@@ -6336,6 +6384,20 @@
     ^ nil
 !
 
+makePTYPair
+    "make a pty-pair, return an array with two filedescriptors on success,
+     nil on failure.
+     This is a leftover compatibility lowLevel entry, not for public use.
+     See NonPositionableExternalStream>>makePTYPair for a more user-friendly,
+     public interface."
+
+    |triple|
+
+    triple := self makePTY.
+    triple isNil ifTrue:[^ nil].
+    ^ Array with:(triple at:1) with:(triple at:2)
+!
+
 makePipe
     "make a pipe, return array with two filedescriptors on success,
      nil on failure.
@@ -13574,11 +13636,11 @@
 !UnixOperatingSystem class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.328 2013-07-07 12:21:18 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.329 2013-07-08 19:27:29 stefan Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.328 2013-07-07 12:21:18 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.329 2013-07-08 19:27:29 stefan Exp $'
 ! !