From 91b7fea462eaa6e4ce8884c47e0ebfb8bce890c9 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Sun, 18 Oct 2015 00:18:17 -0700
Subject: [PATCH] Add more missing things from unix-glibc2.

In particular, use the 64-bit versions of most functions.
---
 src/code/unix.lisp | 66 +++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 62 insertions(+), 4 deletions(-)

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index d14f8f205..8201bc514 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -37,6 +37,8 @@
 
 
 ;;;; Common machine independent structures.
+#+linux
+(defconstant +max-u-long+ 4294967295)
 
 (def-alien-type int64-t (signed 64))
 
@@ -53,6 +55,9 @@
     #+alpha unsigned-int
     #-(or alpha netbsd) unsigned-long)
 
+#+linux
+(def-alien-type ino64-t u-int64-t)
+
 (def-alien-type size-t
     #-(or linux alpha) long
     #+linux unsigned-int 
@@ -488,6 +493,7 @@
 (defconstant l_incr 1 _N"increment the file pointer")
 (defconstant l_xtnd 2 _N"extend the file size")
 
+#-linux
 (defun unix-lseek (fd offset whence)
   _N"Unix-lseek accepts a file descriptor and moves the file pointer ahead
    a certain offset for that file.  Whence can be any of the following:
@@ -501,6 +507,24 @@
 	   (type (integer 0 2) whence))
   (off-t-syscall ("lseek" (int off-t int)) fd offset whence))
 
+#+linux
+(defun unix-lseek (fd offset whence)
+  _N"UNIX-LSEEK accepts a file descriptor and moves the file pointer ahead
+   a certain OFFSET for that file.  WHENCE can be any of the following:
+
+   l_set        Set the file pointer.
+   l_incr       Increment the file pointer.
+   l_xtnd       Extend the file size.
+  "
+  (declare (type unix-fd fd)
+	   (type (signed-byte 64) offset)
+	   (type (integer 0 2) whence))
+  (let ((result (alien-funcall
+                 (extern-alien "lseek64" (function off-t int off-t int))
+                 fd offset whence)))
+    (if (minusp result)
+        (values nil (unix-errno))
+        (values result 0))))
 ;;; Unix-mkdir accepts a name and a mode and attempts to create the
 ;;; corresponding directory with mode mode.
 
@@ -606,7 +630,7 @@
   
   (declare (type unix-pathname name)
 	   (type unix-file-mode mode))
-  (int-syscall (#+solaris "creat64" #-solaris "creat" c-string int)
+  (int-syscall (#+(or linux solaris) "creat64" #-(or linux solaris) "creat" c-string int)
 	       (%name->file name) mode))
 
 ;;; Unix-read accepts a file descriptor, a buffer, and the length to read.
@@ -1463,7 +1487,8 @@
   (when (string= name "")
     (setf name "."))
   (with-alien ((buf (struct stat)))
-    (syscall (#-netbsd "stat" #+netbsd "__stat50" c-string (* (struct stat)))
+    (syscall (#+linux "stat64" #+netbsd "__stat50" #-(or linux netbsd) "stat"
+	      c-string (* (struct stat)))
 	     (extract-stat-results buf)
 	     (%name->file name) (addr buf))))
 
@@ -1472,7 +1497,8 @@
    file must be a symbolic link."
   (declare (type unix-pathname name))
   (with-alien ((buf (struct stat)))
-    (syscall (#-netbsd "lstat" #+netbsd "__lstat50" c-string (* (struct stat)))
+    (syscall (#+linux "lstat64" #+netbsd "__lstat50" #-(or linux netbsd) "lstat"
+              c-string (* (struct stat)))
 	     (extract-stat-results buf)
 	     (%name->file name) (addr buf))))
 
@@ -1481,7 +1507,8 @@
    by the file descriptor fd."
   (declare (type unix-fd fd))
   (with-alien ((buf (struct stat)))
-    (syscall (#-netbsd "fstat" #+netbsd "__fstat50" int (* (struct stat)))
+    (syscall (#+linux "fstat64" #+netbsd "__fstat50" #-(or linux netbsd) "fstat" 
+              int (* (struct stat)))
 	     (extract-stat-results buf)
 	     fd (addr buf))))
 )
@@ -2630,6 +2657,37 @@
        :dir (string (cast (slot result 'pw-dir) c-call:c-string))
        :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))
 
+#+linux
+(defun unix-getpwuid (uid)
+  _N"Return a USER-INFO structure for the user identified by UID, or NIL if not found."
+  (declare (type unix-uid uid))
+  (with-alien ((buf (array c-call:char 1024))
+	       (user-info (struct passwd))
+               (result (* (struct passwd))))
+    (let ((returned
+	   (alien-funcall
+	    (extern-alien "getpwuid_r"
+			  (function c-call:int
+                                    c-call:unsigned-int
+                                    (* (struct passwd))
+                                    (* c-call:char)
+                                    c-call:unsigned-int
+                                    (* (* (struct passwd)))))
+	    uid
+	    (addr user-info)
+	    (cast buf (* c-call:char))
+	    1024
+            (addr result))))
+      (when (zerop returned)
+        (make-user-info
+         :name (string (cast (slot result 'pw-name) c-call:c-string))
+         :password (string (cast (slot result 'pw-passwd) c-call:c-string))
+         :uid (slot result 'pw-uid)
+         :gid (slot result 'pw-gid)
+         :gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
+         :dir (string (cast (slot result 'pw-dir) c-call:c-string))
+         :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
+
 ;;; Getrusage is not provided in the C library on Solaris 2.4, and is
 ;;; rather slow on later versions so the "times" system call is
 ;;; provided.
-- 
GitLab