From 267802c97c4a19354647eb96893429d5c67214df Mon Sep 17 00:00:00 2001
From: Kaz Kyheku <kaz@kylheku.com>
Date: Wed, 15 Jan 2020 20:07:06 -0800
Subject: chmod: work on streams and descriptors using fchmod.

* configure: extend chmod detection to cover fchmod.

* sysif.c (get_fd): New static functions.
(chmod_wrap): Include fchmod wrapping for integer
or stream argument.
(sysif_init): Register fchmod intrinsic.
---
 configure |  5 +++--
 sysif.c   | 37 +++++++++++++++++++++++++++++++------
 txr.1     | 29 +++++++++++++++++++++++++----
 3 files changed, 59 insertions(+), 12 deletions(-)

diff --git a/configure b/configure
index d42e72bf..85336937 100755
--- a/configure
+++ b/configure
@@ -2278,13 +2278,14 @@ else
   printf "no\n"
 fi
 
-printf "Checking for chmod ... "
+printf "Checking for chmod/fchmod ... "
 cat > conftest.c <<!
 #include <sys/stat.h>
 
 int main(void)
 {
-  int r = chmod("a", S_IWUSR);
+  int r0 = chmod("a", S_IWUSR);
+  int r1 = fchmod(4, S_IWUSR);
   return 0;
 }
 !
diff --git a/sysif.c b/sysif.c
index aa36c3a6..8e9457d0 100644
--- a/sysif.c
+++ b/sysif.c
@@ -451,17 +451,42 @@ static val mknod_wrap(val path, val mode, val dev)
 
 #if HAVE_CHMOD
 
-static val chmod_wrap(val path, val mode)
+static int get_fd(val stream, val self)
 {
+  val fd_in = if3(integerp(stream), stream, stream_get_prop(stream, fd_k));
+
+  if (stream && !fd_in)
+    uw_throwf(file_error_s,
+              lit("~a: stream ~s has no :fd property"),
+              self, stream, nao);
+
+  if (!stream)
+    uw_throwf(file_error_s,
+              lit("~a: ~s isn't a stream object"),
+              self, stream, nao);
+
+  return c_int(fd_in, self);
+}
+
+static val chmod_wrap(val target, val mode)
+{
+  val self = lit("chmod");
   cnum cmode = c_num(mode);
-  char *u8path = utf8_dup_to(c_str(path));
-  int err = chmod(u8path, cmode);
-  free(u8path);
+  int err;
+
+  if (stringp(target)) {
+    char *u8path = utf8_dup_to(c_str(target));
+    err = chmod(u8path, cmode);
+    free(u8path);
+  } else {
+    int fd = get_fd(target, self);
+    err = fchmod(fd, cmode);
+  }
 
   if (err < 0) {
     int eno = errno;
-    uw_throwf(errno_to_file_error(eno), lit("chmod ~a #o~o: ~d/~s"),
-              path, mode, num(eno), string_utf8(strerror(eno)), nao);
+    uw_throwf(errno_to_file_error(eno), lit("~a ~a #o~o: ~d/~s"),
+              self, target, mode, num(eno), string_utf8(strerror(eno)), nao);
   }
 
   return t;
diff --git a/txr.1 b/txr.1
index 33a4a197..af6cd8a8 100644
--- a/txr.1
+++ b/txr.1
@@ -57880,15 +57880,18 @@ from a combined device number.
 
 .coNP Function @ chmod
 .synb
-.mets (chmod < path << mode )
+.mets (chmod < target << mode )
 .syne
 .desc
 The
 .code chmod
-function changes the permissions of the filesystem objects
+function changes the permissions of the filesystem object
 specified by
-.metn path .
-It is a direct wrapper for the POSIX C library function of the same name.
+.metn target .
+It is implemented in terms of the POSIX functions
+.code chmod
+and
+.codn fchmod .
 
 The permissions are specified by
 .metn mode ,
@@ -57903,6 +57906,24 @@ The function throws a
 exception if an error occurs, otherwise it returns
 .codn t .
 
+The
+.meta target
+argument may be a character string, in which case it specifies a pathname in
+the filesystem. In this case, the POSIX function
+.code chmod
+is invoked.
+
+The
+.meta target
+argument may also be an integer file descriptor, or a stream. In these two
+cases, the POSIX
+.code fchmod
+function is invoked. For a stream
+.metn target ,
+the integer file descriptor is retrieved from the stream using
+.code fileno
+function.
+
 .TP* Example:
 .verb
   ;; Set permissions of foo.txt to "rw-r--r--"
-- 
cgit v1.2.3