diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:26 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:26 -0800 |
commit | deda2c0fd8689349fea2a900199a76ff7ecb319e (patch) | |
tree | c9726d54a0806a9b0c75e6c82db8692aea0053cf /posix.c | |
parent | 3278b75942bdbe706f7a0fba87729bb1e935b68b (diff) | |
download | scm-upstream/5d6.tar.gz scm-upstream/5d6.zip |
Import Upstream version 5d6upstream/5d6
Diffstat (limited to 'posix.c')
-rw-r--r-- | posix.c | 53 |
1 files changed, 29 insertions, 24 deletions
@@ -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\ "); } |