Import Upstream version 5d6upstream/5d6

1 files changed, 29 insertions, 24 deletions

diff --git a/posix.c b/posix.c
index cf3a0fa..8af5c0b 100644
--- a/posix.c
+++ b/posix.c
@@ -15,26 +15,26 @@
  * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA.
  *
  * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
+ * for additional uses of the text contained in its release of SCM.
  *
- * The exception is that, if you link the GUILE library with other files
+ * The exception is that, if you link the SCM library with other files
  * to produce an executable, this does not by itself cause the
  * resulting executable to be covered by the GNU General Public License.
  * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
+ * linking the SCM library code into it.
  *
  * This exception does not however invalidate any other reasons why
  * the executable file might be covered by the GNU General Public License.
  *
  * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE.  If you copy
+ * Free Software Foundation under the name SCM.  If you copy
  * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
+ * SCM, as the General Public License permits, the exception does
  * not apply to the code that you add in this way.  To avoid misleading
  * anyone as to the status of such modified files, you must delete
  * this exception notice from them.
  *
- * If you write modifications of your own for GUILE, it is your choice
+ * If you write modifications of your own for SCM, it is your choice
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.
  */
@@ -60,11 +60,14 @@
 # else
 #  ifdef linux
 #    include <unistd.h>
+#  else
+#   ifdef __OpenBSD__
+#    include <unistd.h>
+#   endif
 #  endif
 # endif
 #endif
 
-     /* Only the superuser can successfully execute this call */
 static char s_chown[] = "chown";
 SCM l_chown(path, owner, group)
      SCM path, owner, group;
@@ -94,6 +97,7 @@ SCM l_pipe()
   FILE *f_rd, *f_wt;
   SCM p_rd, p_wt;
   NEWCELL(p_rd); NEWCELL(p_wt);
+  DEFER_INTS;
   SYSCALL(ret = pipe(fd););
   if (ret) {ALLOW_INTS; return BOOL_F;}
   SYSCALL(f_rd = fdopen(fd[0], "r"););
@@ -108,10 +112,8 @@ SCM l_pipe()
     close(fd[1]);
     wta(UNDEFINED, (char *)NALLOC, s_port_type);
   }
-  CAR(p_rd) = scm_port_entry(tc16_fport, mode_bits("r", (char *)0));
-  CAR(p_wt) = scm_port_entry(tc16_fport, mode_bits("w", (char *)0));
-  SETSTREAM(p_rd, f_rd);
-  SETSTREAM(p_wt, f_wt);
+  p_rd = scm_port_entry(f_rd, tc16_fport, mode_bits("r", (char *)0));
+  p_wt = scm_port_entry(f_wt, tc16_fport, mode_bits("w", (char *)0));
   ALLOW_INTS;
   return cons(p_rd, p_wt);
 }
@@ -123,24 +125,18 @@ SCM open_pipe(pipestr, modes)
 	FILE *f;
 	register SCM z;
 	ASSERT(NIMP(pipestr) && STRINGP(pipestr), pipestr, ARG1, s_op_pipe);
-	ASSERT(NIMP(modes) && STRINGP(modes), modes, ARG2, s_op_pipe);
+	ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_op_pipe);
 	NEWCELL(z);
 	/* DEFER_INTS, SYSCALL, and ALLOW_INTS are probably paranoid here*/
 	DEFER_INTS;
 	ignore_signals();
 	SCM_OPENCALL(f = popen(CHARS(pipestr), CHARS(modes)));
 	unignore_signals();
-	if (!f) {
-	  ALLOW_INTS;
-	  return BOOL_F;
-	}
-	else {
-	  CAR(z) = scm_port_entry(tc16_pipe,
-			  OPN | (strchr(CHARS(modes), 'r') ? RDNG : WRTNG));
-	  SETSTREAM(z, f);
-	}
+	z = f ?
+	  scm_port_entry(f, tc16_pipe,
+			 OPN | (strchr(CHARS(modes), 'r') ? RDNG : WRTNG)) :
+	  BOOL_F;
 	ALLOW_INTS;
-	SCM_PORTDATA(z) = pipestr;
 	return z;
 }
 
@@ -156,8 +152,9 @@ SCM scm_getgroups()
      strings are now checked for null termination during gc.
      The length needs not be exactly right */
   grps = must_malloc_cell((0L + ngroups) * sizeof(gid_t),
-	  MAKE_LENGTH(((0L + ngroups) * sizeof(gid_t))/sizeof(long), tc7_uvect),
-	  scm_s_getgroups);
+			  MAKE_LENGTH(((0L + ngroups) * sizeof(gid_t))/sizeof(long),
+				      tc7_uvect),
+			  scm_s_getgroups);
   ALLOW_INTS;
   {
     gid_t *groups = (gid_t *)CHARS(grps);
@@ -261,6 +258,10 @@ SCM l_getppid()
   return MAKINUM(0L+getppid());
 }
 
+SCM scm_getlogin()
+{
+  return makfrom0str(getlogin());
+}
 SCM l_getuid()
 {
   return MAKINUM(0L+getuid());
@@ -350,6 +351,7 @@ static iproc subr0s[] = {
 	{"pipe", l_pipe},
 	{scm_s_getgroups, scm_getgroups},
 	{"getppid", l_getppid},
+	{"getlogin", scm_getlogin},
 	{"getuid", l_getuid},
 	{"getgid", l_getgid},
 #ifndef LACK_E_IDs
@@ -403,5 +405,8 @@ void init_posix()
 	scm_ldstr("\n\
 (define (open-input-pipe cmd) (open-pipe cmd \"r\"))\n\
 (define (open-output-pipe cmd) (open-pipe cmd \"w\"))\n\
+(define getlogin\n\
+  (let ((getlogin getlogin))\n\
+    (lambda () (or (getlogin) (getenv \"USER\") (getenv \"LOGNAME\")))))\n\
 ");
 }