libguile/posix.c

   1 /*      Copyright (C) 1995-2000 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
  43    gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
  44
  45 \f
  46
  47 #include <stdio.h>
  48 #include "_scm.h"
  49 #include "fports.h"
  50 #include "scmsigs.h"
  51 #include "feature.h"
  52
  53 #include "scm_validate.h"
  54 #include "posix.h"
  55 \f
  56
  57 #ifdef HAVE_STRING_H
  58 #include <string.h>
  59 #endif
  60 #ifdef TIME_WITH_SYS_TIME
  61 # include <sys/time.h>
  62 # include <time.h>
  63 #else
  64 # if HAVE_SYS_TIME_H
  65 #  include <sys/time.h>
  66 # else
  67 #  include <time.h>
  68 # endif
  69 #endif
  70
  71 #ifdef HAVE_UNISTD_H
  72 #include <unistd.h>
  73 #else
  74 #ifndef ttyname
  75 extern char *ttyname();
  76 #endif
  77 #endif
  78
  79 #ifdef LIBC_H_WITH_UNISTD_H
  80 #include <libc.h>
  81 #endif
  82
  83 #include <sys/types.h>
  84 #include <sys/stat.h>
  85 #include <fcntl.h>
  86
  87 #include <pwd.h>
  88
  89 #if HAVE_SYS_WAIT_H
  90 # include <sys/wait.h>
  91 #endif
  92 #ifndef WEXITSTATUS
  93 # define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
  94 #endif
  95 #ifndef WIFEXITED
  96 # define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
  97 #endif
  98
  99 #include <signal.h>
 100
 101 extern FILE *popen ();
 102 extern char ** environ;
 103
 104 #include <grp.h>
 105 #include <sys/utsname.h>
 106
 107 #if HAVE_DIRENT_H
 108 # include <dirent.h>
 109 # define NAMLEN(dirent) strlen((dirent)->d_name)
 110 #else
 111 # define dirent direct
 112 # define NAMLEN(dirent) (dirent)->d_namlen
 113 # if HAVE_SYS_NDIR_H
 114 #  include <sys/ndir.h>
 115 # endif
 116 # if HAVE_SYS_DIR_H
 117 #  include <sys/dir.h>
 118 # endif
 119 # if HAVE_NDIR_H
 120 #  include <ndir.h>
 121 # endif
 122 #endif
 123
 124 #ifdef HAVE_SETLOCALE
 125 #include <locale.h>
 126 #endif
 127
 128 /* Some Unix systems don't define these.  CPP hair is dangerous, but
 129    this seems safe enough... */
 130 #ifndef R_OK
 131 #define R_OK 4
 132 #endif
 133
 134 #ifndef W_OK
 135 #define W_OK 2
 136 #endif
 137
 138 #ifndef X_OK
 139 #define X_OK 1
 140 #endif
 141
 142 #ifndef F_OK
 143 #define F_OK 0
 144 #endif
 145
 146 /* On NextStep, <utime.h> doesn't define struct utime, unless we
 147    #define _POSIX_SOURCE before #including it.  I think this is less
 148    of a kludge than defining struct utimbuf ourselves.  */
 149 #ifdef UTIMBUF_NEEDS_POSIX
 150 #define _POSIX_SOURCE
 151 #endif
 152
 153 #ifdef HAVE_SYS_UTIME_H
 154 #include <sys/utime.h>
 155 #endif
 156
 157 #ifdef HAVE_UTIME_H
 158 #include <utime.h>
 159 #endif
 160
 161 /* Please don't add any more #includes or #defines here.  The hack
 162    above means that _POSIX_SOURCE may be #defined, which will
 163    encourage header files to do strange things.  */
 164
 165 \f
 166 SCM_SYMBOL (sym_read_pipe, "read pipe");
 167 SCM_SYMBOL (sym_write_pipe, "write pipe");
 168
 169 SCM_DEFINE (scm_pipe, "pipe", 0, 0, 0,
 170             (),
 171 "Creates a pipe which can be used for communication.  The return value
 172 is a pair in which the CAR contains an input port and the CDR an
 173 output port.  Data written to the output port can be read from the
 174 input port.  Note that both ports are buffered so it may be necessary
 175 to flush the output port before data will actually be sent across the pipe.
 176 Alternatively a buffer can be added to the port using @code{setvbuf}
 177 (see below).")
 178 #define FUNC_NAME s_scm_pipe
 179 {
 180   int fd[2], rv;
 181   SCM p_rd, p_wt;
 182
 183   rv = pipe (fd);
 184   if (rv)
 185     SCM_SYSERROR;
 186
 187   p_rd = scm_fdes_to_port (fd[0], "r", sym_read_pipe);
 188   p_wt = scm_fdes_to_port (fd[1], "w", sym_write_pipe);
 189   return scm_cons (p_rd, p_wt);
 190 }
 191 #undef FUNC_NAME
 192
 193
 194 #ifdef HAVE_GETGROUPS
 195 SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
 196             (),
 197 "Returns a vector of integers representing the current supplimentary group IDs.")
 198 #define FUNC_NAME s_scm_getgroups
 199 {
 200   SCM grps, ans;
 201   int ngroups = getgroups (0, NULL);
 202   if (!ngroups)
 203     SCM_SYSERROR;
 204   SCM_NEWCELL(grps);
 205   SCM_DEFER_INTS;
 206   {
 207     GETGROUPS_T *groups;
 208     int val;
 209
 210     groups = SCM_MUST_MALLOC_TYPE_NUM(GETGROUPS_T,ngroups);
 211     val = getgroups(ngroups, groups);
 212     if (val < 0)
 213       {
 214         int en = errno;
 215         scm_must_free((char *)groups);
 216         errno = en;
 217         SCM_SYSERROR;
 218       }
 219     SCM_SETCHARS(grps, groups); /* set up grps as a GC protect */
 220     SCM_SETLENGTH(grps, 0L + ngroups * sizeof(GETGROUPS_T), scm_tc7_string);
 221     ans = scm_make_vector (SCM_MAKINUM(ngroups), SCM_UNDEFINED);
 222     while (--ngroups >= 0) SCM_VELTS(ans)[ngroups] = SCM_MAKINUM(groups[ngroups]);
 223     SCM_SETCHARS(grps, groups); /* to make sure grps stays around. */
 224     SCM_ALLOW_INTS;
 225     return ans;
 226   }
 227 }
 228 #undef FUNC_NAME
 229 #endif
 230
 231
 232 SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
 233             (SCM user),
 234 "Look up an entry in the user database.  @var{obj} can be an integer,
 235 a string, or omitted, giving the behaviour of getpwuid, getpwnam
 236 or getpwent respectively.")
 237 #define FUNC_NAME s_scm_getpwuid
 238 {
 239   SCM result;
 240   struct passwd *entry;
 241   SCM *ve;
 242
 243   result = scm_make_vector (SCM_MAKINUM (7), SCM_UNSPECIFIED);
 244   ve = SCM_VELTS (result);
 245   if (SCM_UNBNDP (user) || SCM_FALSEP (user))
 246     {
 247       SCM_SYSCALL (entry = getpwent ());
 248       if (! entry)
 249         {
 250           return SCM_BOOL_F;
 251         }
 252     }
 253   else if (SCM_INUMP (user))
 254     {
 255       entry = getpwuid (SCM_INUM (user));
 256     }
 257   else
 258     {
 259       SCM_VALIDATE_ROSTRING (1,user);
 260       if (SCM_SUBSTRP (user))
 261         user = scm_makfromstr (SCM_ROCHARS (user), SCM_ROLENGTH (user), 0);
 262       entry = getpwnam (SCM_ROCHARS (user));
 263     }
 264   if (!entry)
 265     SCM_MISC_ERROR ("entry not found", SCM_EOL);
 266
 267   ve[0] = scm_makfrom0str (entry->pw_name);
 268   ve[1] = scm_makfrom0str (entry->pw_passwd);
 269   ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid);
 270   ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid);
 271   ve[4] = scm_makfrom0str (entry->pw_gecos);
 272   if (!entry->pw_dir)
 273     ve[5] = scm_makfrom0str ("");
 274   else
 275     ve[5] = scm_makfrom0str (entry->pw_dir);
 276   if (!entry->pw_shell)
 277     ve[6] = scm_makfrom0str ("");
 278   else
 279     ve[6] = scm_makfrom0str (entry->pw_shell);
 280   return result;
 281 }
 282 #undef FUNC_NAME
 283
 284
 285 #ifdef HAVE_SETPWENT
 286 SCM_DEFINE (scm_setpwent, "setpw", 0, 1, 0,
 287             (SCM arg),
 288 "If called with a true argument, initialize or reset the password data
 289 stream.  Otherwise, close the stream.  The @code{setpwent} and
 290 @code{endpwent} procedures are implemented on top of this.")
 291 #define FUNC_NAME s_scm_setpwent
 292 {
 293   if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
 294     endpwent ();
 295   else
 296     setpwent ();
 297   return SCM_UNSPECIFIED;
 298 }
 299 #undef FUNC_NAME
 300 #endif
 301
 302
 303
 304 /* Combines getgrgid and getgrnam.  */
 305 SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
 306             (SCM name),
 307 "Look up an entry in the group database.  @var{obj} can be an integer,
 308 a string, or omitted, giving the behaviour of getgrgid, getgrnam
 309 or getgrent respectively.")
 310 #define FUNC_NAME s_scm_getgrgid
 311 {
 312   SCM result;
 313   struct group *entry;
 314   SCM *ve;
 315   result = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED);
 316   ve = SCM_VELTS (result);
 317   if (SCM_UNBNDP (name) || (name == SCM_BOOL_F))
 318     {
 319       SCM_SYSCALL (entry = getgrent ());
 320       if (! entry)
 321         {
 322           return SCM_BOOL_F;
 323         }
 324     }
 325   else if (SCM_INUMP (name))
 326     SCM_SYSCALL (entry = getgrgid (SCM_INUM (name)));
 327   else
 328     {
 329       SCM_VALIDATE_ROSTRING (1,name);
 330       SCM_COERCE_SUBSTR (name);
 331       SCM_SYSCALL (entry = getgrnam (SCM_ROCHARS (name)));
 332     }
 333   if (!entry)
 334     SCM_SYSERROR;
 335
 336   ve[0] = scm_makfrom0str (entry->gr_name);
 337   ve[1] = scm_makfrom0str (entry->gr_passwd);
 338   ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid);
 339   ve[3] = scm_makfromstrs (-1, entry->gr_mem);
 340   return result;
 341 }
 342 #undef FUNC_NAME
 343
 344
 345
 346 SCM_DEFINE (scm_setgrent, "setgr", 0, 1, 0,
 347             (SCM arg),
 348 "If called with a true argument, initialize or reset the group data
 349 stream.  Otherwise, close the stream.  The @code{setgrent} and
 350 @code{endgrent} procedures are implemented on top of this.")
 351 #define FUNC_NAME s_scm_setgrent
 352 {
 353   if (SCM_UNBNDP (arg) || SCM_FALSEP (arg))
 354     endgrent ();
 355   else
 356     setgrent ();
 357   return SCM_UNSPECIFIED;
 358 }
 359 #undef FUNC_NAME
 360
 361
 362
 363 SCM_DEFINE (scm_kill, "kill", 2, 0, 0,
 364             (SCM pid, SCM sig),
 365 "Sends a signal to the specified process or group of processes.
 366
 367 @var{pid} specifies the processes to which the signal is sent:
 368
 369 @table @r
 370 @item @var{pid} greater than 0
 371 The process whose identifier is @var{pid}.
 372 @item @var{pid} equal to 0
 373 All processes in the current process group.
 374 @item @var{pid} less than -1
 375 The process group whose identifier is -@var{pid}
 376 @item @var{pid} equal to -1
 377 If the process is privileged, all processes except for some special
 378 system processes.  Otherwise, all processes with the current effective
 379 user ID.
 380 @end table
 381
 382 @var{sig} should be specified using a variable corresponding to
 383 the Unix symbolic name, e.g.,
 384
 385 @defvar SIGHUP
 386 Hang-up signal.
 387 @end defvar
 388
 389 @defvar SIGINT
 390 Interrupt signal.
 391 @end defvar")
 392 #define FUNC_NAME s_scm_kill
 393 {
 394   SCM_VALIDATE_INUM (1,pid);
 395   SCM_VALIDATE_INUM (2,sig);
 396   /* Signal values are interned in scm_init_posix().  */
 397   if (kill ((int) SCM_INUM (pid), (int) SCM_INUM (sig)) != 0)
 398     SCM_SYSERROR;
 399   return SCM_UNSPECIFIED;
 400 }
 401 #undef FUNC_NAME
 402
 403 #ifdef HAVE_WAITPID
 404 SCM_DEFINE (scm_waitpid, "waitpid", 1, 1, 0,
 405             (SCM pid, SCM options),
 406 "This procedure collects status information from a child process which
 407 has terminated or (optionally) stopped.  Normally it will
 408 suspend the calling process until this can be done.  If more than one
 409 child process is eligible then one will be chosen by the operating system.
 410
 411 The value of @var{pid} determines the behaviour:
 412
 413 @table @r
 414 @item @var{pid} greater than 0
 415 Request status information from the specified child process.
 416 @item @var{pid} equal to -1 or WAIT_ANY
 417 Request status information for any child process.
 418 @item @var{pid} equal to 0 or WAIT_MYPGRP
 419 Request status information for any child process in the current process
 420 group.
 421 @item @var{pid} less than -1
 422 Request status information for any child process whose process group ID
 423 is -@var{PID}.
 424 @end table
 425
 426 The @var{options} argument, if supplied, should be the bitwise OR of the
 427 values of zero or more of the following variables:
 428
 429 @defvar WNOHANG
 430 Return immediately even if there are no child processes to be collected.
 431 @end defvar
 432
 433 @defvar WUNTRACED
 434 Report status information for stopped processes as well as terminated
 435 processes.
 436 @end defvar
 437
 438 The return value is a pair containing:
 439
 440 @enumerate
 441 @item
 442 The process ID of the child process, or 0 if @code{WNOHANG} was
 443 specified and no process was collected.
 444 @item
 445 The integer status value.
 446 @end enumerate")
 447 #define FUNC_NAME s_scm_waitpid
 448 {
 449   int i;
 450   int status;
 451   int ioptions;
 452   SCM_VALIDATE_INUM (1,pid);
 453   if (SCM_UNBNDP (options))
 454     ioptions = 0;
 455   else
 456     {
 457       SCM_VALIDATE_INUM (2,options);
 458       /* Flags are interned in scm_init_posix.  */
 459       ioptions = SCM_INUM (options);
 460     }
 461   SCM_SYSCALL (i = waitpid (SCM_INUM (pid), &status, ioptions));
 462   if (i == -1)
 463     SCM_SYSERROR;
 464   return scm_cons (SCM_MAKINUM (0L + i), SCM_MAKINUM (0L + status));
 465 }
 466 #undef FUNC_NAME
 467 #endif /* HAVE_WAITPID */
 468
 469 SCM_DEFINE (scm_status_exit_val, "status:exit-val", 1, 0, 0,
 470             (SCM status),
 471 "Returns the exit status value, as would be
 472 set if a process ended normally through a
 473 call to @code{exit} or @code{_exit}, if any, otherwise @code{#f}.")
 474 #define FUNC_NAME s_scm_status_exit_val
 475 {
 476   int lstatus;
 477
 478   SCM_VALIDATE_INUM (1,status);
 479
 480   /* On Ultrix, the WIF... macros assume their argument is an lvalue;
 481      go figure.  SCM_INUM does not yield an lvalue.  */
 482   lstatus = SCM_INUM (status);
 483   if (WIFEXITED (lstatus))
 484     return (SCM_MAKINUM (WEXITSTATUS (lstatus)));
 485   else
 486     return SCM_BOOL_F;
 487 }
 488 #undef FUNC_NAME
 489
 490 SCM_DEFINE (scm_status_term_sig, "status:term-sig", 1, 0, 0,
 491             (SCM status),
 492 "Returns the signal number which terminated the
 493 process, if any, otherwise @code{#f}.")
 494 #define FUNC_NAME s_scm_status_term_sig
 495 {
 496   int lstatus;
 497
 498   SCM_VALIDATE_INUM (1,status);
 499
 500   lstatus = SCM_INUM (status);
 501   if (WIFSIGNALED (lstatus))
 502     return SCM_MAKINUM (WTERMSIG (lstatus));
 503   else
 504     return SCM_BOOL_F;
 505 }
 506 #undef FUNC_NAME
 507
 508 SCM_DEFINE (scm_status_stop_sig, "status:stop-sig", 1, 0, 0,
 509             (SCM status),
 510 "Returns the signal number which stopped the
 511 process, if any, otherwise @code{#f}.")
 512 #define FUNC_NAME s_scm_status_stop_sig
 513 {
 514   int lstatus;
 515
 516   SCM_VALIDATE_INUM (1,status);
 517
 518   lstatus = SCM_INUM (status);
 519   if (WIFSTOPPED (lstatus))
 520     return SCM_MAKINUM (WSTOPSIG (lstatus));
 521   else
 522     return SCM_BOOL_F;
 523 }
 524 #undef FUNC_NAME
 525
 526 SCM_DEFINE (scm_getppid, "getppid", 0, 0, 0,
 527             (),
 528 "Returns an integer representing the process ID of the parent process.")
 529 #define FUNC_NAME s_scm_getppid
 530 {
 531   return SCM_MAKINUM (0L + getppid ());
 532 }
 533 #undef FUNC_NAME
 534
 535
 536
 537 SCM_DEFINE (scm_getuid, "getuid", 0, 0, 0,
 538             (),
 539 "Returns an integer representing the current real user ID.")
 540 #define FUNC_NAME s_scm_getuid
 541 {
 542   return SCM_MAKINUM (0L + getuid ());
 543 }
 544 #undef FUNC_NAME
 545
 546
 547
 548 SCM_DEFINE (scm_getgid, "getgid", 0, 0, 0,
 549             (),
 550 "Returns an integer representing the current real group ID.")
 551 #define FUNC_NAME s_scm_getgid
 552 {
 553   return SCM_MAKINUM (0L + getgid ());
 554 }
 555 #undef FUNC_NAME
 556
 557
 558
 559 SCM_DEFINE (scm_geteuid, "geteuid", 0, 0, 0,
 560             (),
 561 "Returns an integer representing the current effective user ID.
 562 If the system does not support effective IDs, then the real ID
 563 is returned.  @code{(feature? 'EIDs)} reports whether the system
 564 supports effective IDs.")
 565 #define FUNC_NAME s_scm_geteuid
 566 {
 567 #ifdef HAVE_GETEUID
 568   return SCM_MAKINUM (0L + geteuid ());
 569 #else
 570   return SCM_MAKINUM (0L + getuid ());
 571 #endif
 572 }
 573 #undef FUNC_NAME
 574
 575
 576
 577 SCM_DEFINE (scm_getegid, "getegid", 0, 0, 0,
 578             (),
 579 "Returns an integer representing the current effective group ID.
 580 If the system does not support effective IDs, then the real ID
 581 is returned.  @code{(feature? 'EIDs)} reports whether the system
 582 supports effective IDs.")
 583 #define FUNC_NAME s_scm_getegid
 584 {
 585 #ifdef HAVE_GETEUID
 586   return SCM_MAKINUM (0L + getegid ());
 587 #else
 588   return SCM_MAKINUM (0L + getgid ());
 589 #endif
 590 }
 591 #undef FUNC_NAME
 592
 593
 594 SCM_DEFINE (scm_setuid, "setuid", 1, 0, 0,
 595             (SCM id),
 596 "Sets both the real and effective user IDs to the integer @var{id}, provided
 597 the process has appropriate privileges.
 598 The return value is unspecified.")
 599 #define FUNC_NAME s_scm_setuid
 600 {
 601   SCM_VALIDATE_INUM (1,id);
 602   if (setuid (SCM_INUM (id)) != 0)
 603     SCM_SYSERROR;
 604   return SCM_UNSPECIFIED;
 605 }
 606 #undef FUNC_NAME
 607
 608 SCM_DEFINE (scm_setgid, "setgid", 1, 0, 0,
 609             (SCM id),
 610 "Sets both the real and effective group IDs to the integer @var{id}, provided
 611 the process has appropriate privileges.
 612 The return value is unspecified.")
 613 #define FUNC_NAME s_scm_setgid
 614 {
 615   SCM_VALIDATE_INUM (1,id);
 616   if (setgid (SCM_INUM (id)) != 0)
 617     SCM_SYSERROR;
 618   return SCM_UNSPECIFIED;
 619 }
 620 #undef FUNC_NAME
 621
 622 SCM_DEFINE (scm_seteuid, "seteuid", 1, 0, 0,
 623             (SCM id),
 624 "Sets the effective user ID to the integer @var{id}, provided the process
 625 has appropriate privileges.  If effective IDs are not supported, the
 626 real ID is set instead -- @code{(feature? 'EIDs)} reports whether the
 627 system supports effective IDs.
 628 The return value is unspecified.")
 629 #define FUNC_NAME s_scm_seteuid
 630 {
 631   int rv;
 632
 633   SCM_VALIDATE_INUM (1,id);
 634 #ifdef HAVE_SETEUID
 635   rv = seteuid (SCM_INUM (id));
 636 #else
 637   rv = setuid (SCM_INUM (id));
 638 #endif
 639   if (rv != 0)
 640     SCM_SYSERROR;
 641   return SCM_UNSPECIFIED;
 642 }
 643 #undef FUNC_NAME
 644
 645 #ifdef HAVE_SETEGID
 646 SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0,
 647             (SCM id),
 648 "Sets the effective group ID to the integer @var{id}, provided the process
 649 has appropriate privileges.  If effective IDs are not supported, the
 650 real ID is set instead -- @code{(feature? 'EIDs)} reports whether the
 651 system supports effective IDs.
 652 The return value is unspecified.")
 653 #define FUNC_NAME s_scm_setegid
 654 {
 655   int rv;
 656
 657   SCM_VALIDATE_INUM (1,id);
 658 #ifdef HAVE_SETEUID
 659   rv = setegid (SCM_INUM (id));
 660 #else
 661   rv = setgid (SCM_INUM (id));
 662 #endif
 663   if (rv != 0)
 664     SCM_SYSERROR;
 665   return SCM_UNSPECIFIED;
 666
 667 }
 668 #undef FUNC_NAME
 669 #endif
 670
 671 SCM_DEFINE (scm_getpgrp, "getpgrp", 0, 0, 0,
 672             (),
 673 "Returns an integer representing the current process group ID.
 674 This is the POSIX definition, not BSD.")
 675 #define FUNC_NAME s_scm_getpgrp
 676 {
 677   int (*fn)();
 678   fn = (int (*) ()) getpgrp;
 679   return SCM_MAKINUM (fn (0));
 680 }
 681 #undef FUNC_NAME
 682
 683 #ifdef HAVE_SETPGID
 684 SCM_DEFINE (scm_setpgid, "setpgid", 2, 0, 0,
 685             (SCM pid, SCM pgid),
 686 "Move the process @var{pid} into the process group @var{pgid}.  @var{pid} or
 687 @var{pgid} must be integers: they can be zero to indicate the ID of the
 688 current process.
 689 Fails on systems that do not support job control.
 690 The return value is unspecified.")
 691 #define FUNC_NAME s_scm_setpgid
 692 {
 693   SCM_VALIDATE_INUM (1,pid);
 694   SCM_VALIDATE_INUM (2,pgid);
 695   /* FIXME(?): may be known as setpgrp.  */
 696   if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0)
 697     SCM_SYSERROR;
 698   return SCM_UNSPECIFIED;
 699 }
 700 #undef FUNC_NAME
 701 #endif /* HAVE_SETPGID */
 702
 703 #ifdef HAVE_SETSID
 704 SCM_DEFINE (scm_setsid, "setsid", 0, 0, 0,
 705             (),
 706 "Creates a new session.  The current process becomes the session leader
 707 and is put in a new process group.  The process will be detached
 708 from its controlling terminal if it has one.
 709 The return value is an integer representing the new process group ID.")
 710 #define FUNC_NAME s_scm_setsid
 711 {
 712   pid_t sid = setsid ();
 713   if (sid == -1)
 714     SCM_SYSERROR;
 715   return SCM_UNSPECIFIED;
 716 }
 717 #undef FUNC_NAME
 718 #endif /* HAVE_SETSID */
 719
 720 SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
 721             (SCM port),
 722 "Returns a string with the name of the serial terminal device underlying
 723 @var{port}.")
 724 #define FUNC_NAME s_scm_ttyname
 725 {
 726   char *ans;
 727   int fd;
 728
 729   port = SCM_COERCE_OUTPORT (port);
 730   SCM_VALIDATE_OPPORT (1,port);
 731   if (scm_tc16_fport != SCM_TYP16 (port))
 732     return SCM_BOOL_F;
 733   fd = SCM_FPORT_FDES (port);
 734   SCM_SYSCALL (ans = ttyname (fd));
 735   if (!ans)
 736     SCM_SYSERROR;
 737   /* ans could be overwritten by another call to ttyname */
 738   return (scm_makfrom0str (ans));
 739 }
 740 #undef FUNC_NAME
 741
 742 #ifdef HAVE_CTERMID
 743 SCM_DEFINE (scm_ctermid, "ctermid", 0, 0, 0,
 744             (),
 745 "Returns a string containing the file name of the controlling terminal
 746 for the current process.")
 747 #define FUNC_NAME s_scm_ctermid
 748 {
 749   char *result = ctermid (NULL);
 750   if (*result == '\0')
 751     SCM_SYSERROR;
 752   return scm_makfrom0str (result);
 753 }
 754 #undef FUNC_NAME
 755 #endif /* HAVE_CTERMID */
 756
 757 #ifdef HAVE_TCGETPGRP
 758 SCM_DEFINE (scm_tcgetpgrp, "tcgetpgrp", 1, 0, 0,
 759             (SCM port),
 760 "Returns the process group ID of the foreground
 761 process group associated with the terminal open on the file descriptor
 762 underlying @var{port}.
 763
 764 If there is no foreground process group, the return value is a
 765 number greater than 1 that does not match the process group ID
 766 of any existing process group.  This can happen if all of the
 767 processes in the job that was formerly the foreground job have
 768 terminated, and no other job has yet been moved into the
 769 foreground.")
 770 #define FUNC_NAME s_scm_tcgetpgrp
 771 {
 772   int fd;
 773   pid_t pgid;
 774
 775   port = SCM_COERCE_OUTPORT (port);
 776
 777   SCM_VALIDATE_OPFPORT (1,port);
 778   fd = SCM_FPORT_FDES (port);
 779   if ((pgid = tcgetpgrp (fd)) == -1)
 780     SCM_SYSERROR;
 781   return SCM_MAKINUM (pgid);
 782 }
 783 #undef FUNC_NAME
 784 #endif /* HAVE_TCGETPGRP */
 785
 786 #ifdef HAVE_TCSETPGRP
 787 SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0,
 788             (SCM port, SCM pgid),
 789 "Set the foreground process group ID for the terminal used by the file
 790 descriptor underlying @var{port} to the integer @var{pgid}.
 791 The calling process
 792 must be a member of the same session as @var{pgid} and must have the same
 793 controlling terminal.  The return value is unspecified.")
 794 #define FUNC_NAME s_scm_tcsetpgrp
 795 {
 796   int fd;
 797
 798   port = SCM_COERCE_OUTPORT (port);
 799
 800   SCM_VALIDATE_OPFPORT (1,port);
 801   SCM_VALIDATE_INUM (2,pgid);
 802   fd = SCM_FPORT_FDES (port);
 803   if (tcsetpgrp (fd, SCM_INUM (pgid)) == -1)
 804     SCM_SYSERROR;
 805   return SCM_UNSPECIFIED;
 806 }
 807 #undef FUNC_NAME
 808 #endif /* HAVE_TCSETPGRP */
 809
 810 /* Copy exec args from an SCM vector into a new C array.  */
 811
 812 static char **
 813 scm_convert_exec_args (SCM args, int pos, const char *subr)
 814 {
 815   char **execargv;
 816   int num_args;
 817   int i;
 818
 819   SCM_ASSERT (SCM_NULLP (args)
 820               || (SCM_CONSP (args)),
 821               args, pos, subr);
 822   num_args = scm_ilength (args);
 823   execargv = (char **)
 824     scm_must_malloc ((num_args + 1) * sizeof (char *), subr);
 825   for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), ++i)
 826     {
 827       scm_sizet len;
 828       char *dst;
 829       char *src;
 830       SCM_ASSERT (SCM_ROSTRINGP (SCM_CAR (args)),
 831                   SCM_CAR (args), SCM_ARGn, subr);
 832       len = 1 + SCM_ROLENGTH (SCM_CAR (args));
 833       dst = (char *) scm_must_malloc ((long) len, subr);
 834       src = SCM_ROCHARS (SCM_CAR (args));
 835       while (len--)
 836         dst[len] = src[len];
 837       execargv[i] = dst;
 838     }
 839   execargv[i] = 0;
 840   return execargv;
 841 }
 842
 843 SCM_DEFINE (scm_execl, "execl", 1, 0, 1,
 844             (SCM filename, SCM args),
 845 "Executes the file named by @var{path} as a new process image.
 846 The remaining arguments are supplied to the process; from a C program
 847 they are accessable as the @code{argv} argument to @code{main}.
 848 Conventionally the first @var{arg} is the same as @var{path}.
 849 All arguments must be strings.
 850
 851 If @var{arg} is missing, @var{path} is executed with a null
 852 argument list, which may have system-dependent side-effects.
 853
 854 This procedure is currently implemented using the @code{execv} system
 855 call, but we call it @code{execl} because of its Scheme calling interface.")
 856 #define FUNC_NAME s_scm_execl
 857 {
 858   char **execargv;
 859   SCM_VALIDATE_ROSTRING (1,filename);
 860   SCM_COERCE_SUBSTR (filename);
 861   execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
 862   execv (SCM_ROCHARS (filename), execargv);
 863   SCM_SYSERROR;
 864   /* not reached.  */
 865   return SCM_BOOL_F;
 866 }
 867 #undef FUNC_NAME
 868
 869 SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1,
 870             (SCM filename, SCM args),
 871 "Similar to @code{execl}, however if
 872 @var{filename} does not contain a slash
 873 then the file to execute will be located by searching the
 874 directories listed in the @code{PATH} environment variable.
 875
 876 This procedure is currently implemented using the @code{execlv} system
 877 call, but we call it @code{execlp} because of its Scheme calling interface.")
 878 #define FUNC_NAME s_scm_execlp
 879 {
 880   char **execargv;
 881   SCM_VALIDATE_ROSTRING (1,filename);
 882   SCM_COERCE_SUBSTR (filename);
 883   execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME);
 884   execvp (SCM_ROCHARS (filename), execargv);
 885   SCM_SYSERROR;
 886   /* not reached.  */
 887   return SCM_BOOL_F;
 888 }
 889 #undef FUNC_NAME
 890
 891 static char **
 892 environ_list_to_c (SCM envlist, int arg, const char *proc)
 893 {
 894   int num_strings;
 895   char **result;
 896   int i = 0;
 897
 898   SCM_ASSERT (SCM_NULLP (envlist) || SCM_CONSP (envlist),
 899               envlist, arg, proc);
 900   num_strings = scm_ilength (envlist);
 901   result = (char **) malloc ((num_strings + 1) * sizeof (char *));
 902   if (result == NULL)
 903     scm_memory_error (proc);
 904   while (SCM_NNULLP (envlist))
 905     {
 906       int len;
 907       char *src;
 908
 909       SCM_ASSERT (SCM_ROSTRINGP (SCM_CAR (envlist)),
 910                   envlist, arg, proc);
 911       len = 1 + SCM_ROLENGTH (SCM_CAR (envlist));
 912       result[i] = malloc ((long) len);
 913       if (result[i] == NULL)
 914         scm_memory_error (proc);
 915       src = SCM_ROCHARS (SCM_CAR (envlist));
 916       while (len--)
 917         result[i][len] = src[len];
 918       envlist = SCM_CDR (envlist);
 919       i++;
 920     }
 921   result[i] = 0;
 922   return result;
 923 }
 924
 925 SCM_DEFINE (scm_execle, "execle", 2, 0, 1,
 926             (SCM filename, SCM env, SCM args),
 927 "Similar to @code{execl}, but the environment of the new process is
 928 specified by @var{env}, which must be a list of strings as returned by the
 929 @code{environ} procedure.
 930
 931 This procedure is currently implemented using the @code{execve} system
 932 call, but we call it @code{execle} because of its Scheme calling interface.")
 933 #define FUNC_NAME s_scm_execle
 934 {
 935   char **execargv;
 936   char **exec_env;
 937
 938   SCM_VALIDATE_ROSTRING (1,filename);
 939   SCM_COERCE_SUBSTR (filename);
 940
 941   execargv = scm_convert_exec_args (args, SCM_ARG1, FUNC_NAME);
 942   exec_env = environ_list_to_c (env, SCM_ARG2, FUNC_NAME);
 943   execve (SCM_ROCHARS (filename), execargv, exec_env);
 944   SCM_SYSERROR;
 945   /* not reached.  */
 946   return SCM_BOOL_F;
 947 }
 948 #undef FUNC_NAME
 949
 950 SCM_DEFINE (scm_fork, "primitive-fork", 0, 0, 0,
 951             (),
 952 "Creates a new \"child\" process by duplicating the current \"parent\" process.
 953 In the child the return value is 0.  In the parent the return value is
 954 the integer process ID of the child.
 955
 956 This procedure has been renamed from @code{fork} to avoid a naming conflict
 957 with the scsh fork.")
 958 #define FUNC_NAME s_scm_fork
 959 {
 960   int pid;
 961   pid = fork ();
 962   if (pid == -1)
 963     SCM_SYSERROR;
 964   return SCM_MAKINUM (0L+pid);
 965 }
 966 #undef FUNC_NAME
 967
 968 #ifdef HAVE_UNAME
 969 SCM_DEFINE (scm_uname, "uname", 0, 0, 0,
 970             (),
 971 "Returns an object with some information about the computer system the
 972 program is running on.")
 973 #define FUNC_NAME s_scm_uname
 974 {
 975   struct utsname buf;
 976   SCM ans = scm_make_vector (SCM_MAKINUM(5), SCM_UNSPECIFIED);
 977   SCM *ve = SCM_VELTS (ans);
 978   if (uname (&buf) < 0)
 979     SCM_SYSERROR;
 980   ve[0] = scm_makfrom0str (buf.sysname);
 981   ve[1] = scm_makfrom0str (buf.nodename);
 982   ve[2] = scm_makfrom0str (buf.release);
 983   ve[3] = scm_makfrom0str (buf.version);
 984   ve[4] = scm_makfrom0str (buf.machine);
 985 /*
 986    a linux special?
 987   ve[5] = scm_makfrom0str (buf.domainname);
 988 */
 989   return ans;
 990 }
 991 #undef FUNC_NAME
 992 #endif /* HAVE_UNAME */
 993
 994 SCM_DEFINE (scm_environ, "environ", 0, 1, 0,
 995             (SCM env),
 996 "If @var{env} is omitted, returns the current environment as a list of strings.
 997 Otherwise it sets the current environment, which is also the
 998 default environment for child processes, to the supplied list of strings.
 999 Each member of @var{env} should be of the form
1000 @code{NAME=VALUE} and values of @code{NAME} should not be duplicated.
1001 If @var{env} is supplied then the return value is unspecified.")
1002 #define FUNC_NAME s_scm_environ
1003 {
1004   if (SCM_UNBNDP (env))
1005     return scm_makfromstrs (-1, environ);
1006   else
1007     {
1008       char **new_environ;
1009
1010       new_environ = environ_list_to_c (env, SCM_ARG1, FUNC_NAME);
1011       /* Free the old environment, except when called for the first
1012        * time.
1013        */
1014       {
1015         char **ep;
1016         static int first = 1;
1017         if (!first)
1018           {
1019             for (ep = environ; *ep != NULL; ep++)
1020               free (*ep);
1021             free ((char *) environ);
1022           }
1023         first = 0;
1024       }
1025       environ = new_environ;
1026       return SCM_UNSPECIFIED;
1027     }
1028 }
1029 #undef FUNC_NAME
1030
1031 #ifdef L_tmpnam
1032
1033 SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
1034             (),
1035 "Create a new file in the file system with a unique name.  The return
1036 value is the name of the new file.  This function is implemented with
1037 the @code{tmpnam} function in the system libraries.")
1038 #define FUNC_NAME s_scm_tmpnam
1039 {
1040   char name[L_tmpnam];
1041   SCM_SYSCALL (tmpnam (name););
1042   return scm_makfrom0str (name);
1043 }
1044 #undef FUNC_NAME;
1045
1046 #endif
1047
1048 SCM_DEFINE (scm_utime, "utime", 1, 2, 0,
1049             (SCM pathname, SCM actime, SCM modtime),
1050 "@code{utime} sets the access and modification times for
1051 the file named by @var{path}.  If @var{actime} or @var{modtime}
1052 is not supplied, then the current time is used.
1053 @var{actime} and @var{modtime}
1054 must be integer time values as returned by the @code{current-time}
1055 procedure.
1056
1057 E.g.,
1058
1059 @smalllisp
1060 (utime \"foo\" (- (current-time) 3600))
1061 @end smalllisp
1062
1063 will set the access time to one hour in the past and the modification
1064 time to the current time.")
1065 #define FUNC_NAME s_scm_utime
1066 {
1067   int rv;
1068   struct utimbuf utm_tmp;
1069
1070   SCM_VALIDATE_ROSTRING (1,pathname);
1071   SCM_COERCE_SUBSTR (pathname);
1072   if (SCM_UNBNDP (actime))
1073     SCM_SYSCALL (time (&utm_tmp.actime));
1074   else
1075     utm_tmp.actime = SCM_NUM2ULONG (2,actime);
1076
1077   if (SCM_UNBNDP (modtime))
1078     SCM_SYSCALL (time (&utm_tmp.modtime));
1079   else
1080     utm_tmp.modtime = SCM_NUM2ULONG (3,modtime);
1081
1082   SCM_SYSCALL (rv = utime (SCM_ROCHARS (pathname), &utm_tmp));
1083   if (rv != 0)
1084     SCM_SYSERROR;
1085   return SCM_UNSPECIFIED;
1086 }
1087 #undef FUNC_NAME
1088
1089 SCM_DEFINE (scm_access, "access?", 2, 0, 0,
1090             (SCM path, SCM how),
1091 "Returns @code{#t} if @var{path} corresponds to an existing
1092 file and the current process
1093 has the type of access specified by @var{how}, otherwise
1094 @code{#f}.
1095 @var{how} should be specified
1096 using the values of the variables listed below.  Multiple values can
1097 be combined using a bitwise or, in which case @code{#t} will only
1098 be returned if all accesses are granted.
1099
1100 Permissions are checked using the real id of the current process,
1101 not the effective id, although it's the effective id which determines
1102 whether the access would actually be granted.
1103
1104 @defvar R_OK
1105 test for read permission.
1106 @end defvar
1107 @defvar W_OK
1108 test for write permission.
1109 @end defvar
1110 @defvar X_OK
1111 test for execute permission.
1112 @end defvar
1113 @defvar F_OK
1114 test for existence of the file.
1115 @end defvar")
1116 #define FUNC_NAME s_scm_access
1117 {
1118   int rv;
1119
1120   SCM_VALIDATE_ROSTRING (1,path);
1121   if (SCM_SUBSTRP (path))
1122     path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
1123   SCM_VALIDATE_INUM (2,how);
1124   rv = access (SCM_ROCHARS (path), SCM_INUM (how));
1125   return SCM_NEGATE_BOOL(rv);
1126 }
1127 #undef FUNC_NAME
1128
1129 SCM_DEFINE (scm_getpid, "getpid", 0, 0, 0,
1130             (),
1131 "Returns an integer representing the current process ID.")
1132 #define FUNC_NAME s_scm_getpid
1133 {
1134   return SCM_MAKINUM ((unsigned long) getpid ());
1135 }
1136 #undef FUNC_NAME
1137
1138 SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0,
1139             (SCM str),
1140 "Modifies the environment of the current process, which is
1141 also the default environment inherited by child processes.
1142
1143 If @var{string} is of the form @code{NAME=VALUE} then it will be written
1144 directly into the environment, replacing any existing environment string
1145 with
1146 name matching @code{NAME}.  If @var{string} does not contain an equal
1147 sign, then any existing string with name matching @var{string} will
1148 be removed.
1149
1150 The return value is unspecified.")
1151 #define FUNC_NAME s_scm_putenv
1152 {
1153   int rv;
1154   char *ptr;
1155
1156   SCM_VALIDATE_ROSTRING (1,str);
1157   /* must make a new copy to be left in the environment, safe from gc.  */
1158   ptr = malloc (SCM_LENGTH (str) + 1);
1159   if (ptr == NULL)
1160     SCM_MEMORY_ERROR;
1161   strncpy (ptr, SCM_ROCHARS (str), SCM_LENGTH (str));
1162   ptr[SCM_LENGTH(str)] = 0;
1163   rv = putenv (ptr);
1164   if (rv < 0)
1165     SCM_SYSERROR;
1166   return SCM_UNSPECIFIED;
1167 }
1168 #undef FUNC_NAME
1169
1170 #ifdef HAVE_SETLOCALE
1171 SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
1172             (SCM category, SCM locale),
1173 "If @var{locale} is omitted, returns the current value of the specified
1174 locale category
1175 as a system-dependent string.
1176 @var{category} should be specified using the values @code{LC_COLLATE},
1177 @code{LC_ALL} etc.
1178
1179 Otherwise the specified locale category is set to
1180 the string @var{locale}
1181 and the new value is returned as a system-dependent string.  If @var{locale}
1182 is an empty string, the locale will be set using envirionment variables.")
1183 #define FUNC_NAME s_scm_setlocale
1184 {
1185   char *clocale;
1186   char *rv;
1187
1188   SCM_VALIDATE_INUM (1,category);
1189   if (SCM_UNBNDP (locale))
1190     {
1191       clocale = NULL;
1192     }
1193   else
1194     {
1195       SCM_VALIDATE_ROSTRING (2,locale);
1196       SCM_COERCE_SUBSTR (locale);
1197       clocale = SCM_ROCHARS (locale);
1198     }
1199
1200   rv = setlocale (SCM_INUM (category), clocale);
1201   if (rv == NULL)
1202     SCM_SYSERROR;
1203   return scm_makfrom0str (rv);
1204 }
1205 #undef FUNC_NAME
1206 #endif /* HAVE_SETLOCALE */
1207
1208 #ifdef HAVE_MKNOD
1209 SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
1210             (SCM path, SCM type, SCM perms, SCM dev),
1211 "Creates a new special file, such as a file corresponding to a device.
1212 @var{path} specifies the name of the file.  @var{type} should
1213 be one of the following symbols:
1214 regular, directory, symlink, block-special, char-special,
1215 fifo, or socket.  @var{perms} (an integer) specifies the file permissions.
1216 @var{dev} (an integer) specifies which device the special file refers
1217 to.  Its exact interpretation depends on the kind of special file
1218 being created.
1219
1220 E.g.,
1221 @example
1222 (mknod "/dev/fd0" 'block-special #o660 (+ (* 2 256) 2))
1223 @end example
1224
1225 The return value is unspecified.")
1226 #define FUNC_NAME s_scm_mknod
1227 {
1228   int val;
1229   char *p;
1230   int ctype = 0;
1231
1232   SCM_VALIDATE_ROSTRING (1,path);
1233   SCM_VALIDATE_SYMBOL (2,type);
1234   SCM_VALIDATE_INUM (3,perms);
1235   SCM_VALIDATE_INUM (4,dev);
1236   SCM_COERCE_SUBSTR (path);
1237
1238   p = SCM_CHARS (type);
1239   if (strcmp (p, "regular") == 0)
1240     ctype = S_IFREG;
1241   else if (strcmp (p, "directory") == 0)
1242     ctype = S_IFDIR;
1243   else if (strcmp (p, "symlink") == 0)
1244     ctype = S_IFLNK;
1245   else if (strcmp (p, "block-special") == 0)
1246     ctype = S_IFBLK;
1247   else if (strcmp (p, "char-special") == 0)
1248     ctype = S_IFCHR;
1249   else if (strcmp (p, "fifo") == 0)
1250     ctype = S_IFIFO;
1251   else if (strcmp (p, "socket") == 0)
1252     ctype = S_IFSOCK;
1253   else
1254     SCM_OUT_OF_RANGE (2,type);
1255
1256   SCM_SYSCALL (val = mknod(SCM_ROCHARS(path), ctype | SCM_INUM (perms),
1257                            SCM_INUM (dev)));
1258   if (val != 0)
1259     SCM_SYSERROR;
1260   return SCM_UNSPECIFIED;
1261 }
1262 #undef FUNC_NAME
1263 #endif /* HAVE_MKNOD */
1264
1265 #ifdef HAVE_NICE
1266 SCM_DEFINE (scm_nice, "nice", 1, 0, 0,
1267             (SCM incr),
1268 "Increment the priority of the current process by @var{incr}.  A higher
1269 priority value means that the process runs less often.
1270 The return value is unspecified.")
1271 #define FUNC_NAME s_scm_nice
1272 {
1273   SCM_VALIDATE_INUM (1,incr);
1274   if (nice(SCM_INUM(incr)) != 0)
1275     SCM_SYSERROR;
1276   return SCM_UNSPECIFIED;
1277 }
1278 #undef FUNC_NAME
1279 #endif /* HAVE_NICE */
1280
1281 #ifdef HAVE_SYNC
1282 SCM_DEFINE (scm_sync, "sync", 0, 0, 0,
1283             (),
1284 "Flush the operating system disk buffers.
1285 The return value is unspecified.")
1286 #define FUNC_NAME s_scm_sync
1287 {
1288   sync();
1289   return SCM_UNSPECIFIED;
1290 }
1291 #undef FUNC_NAME
1292 #endif /* HAVE_SYNC */
1293
1294 void
1295 scm_init_posix ()
1296 {
1297   scm_add_feature ("posix");
1298 #ifdef HAVE_GETEUID
1299   scm_add_feature ("EIDs");
1300 #endif
1301 #ifdef WAIT_ANY
1302   scm_sysintern ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY));
1303 #endif
1304 #ifdef WAIT_MYPGRP
1305   scm_sysintern ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP));
1306 #endif
1307 #ifdef WNOHANG
1308   scm_sysintern ("WNOHANG", SCM_MAKINUM (WNOHANG));
1309 #endif
1310 #ifdef WUNTRACED
1311   scm_sysintern ("WUNTRACED", SCM_MAKINUM (WUNTRACED));
1312 #endif
1313
1314   /* access() symbols.  */
1315   scm_sysintern ("R_OK", SCM_MAKINUM (R_OK));
1316   scm_sysintern ("W_OK", SCM_MAKINUM (W_OK));
1317   scm_sysintern ("X_OK", SCM_MAKINUM (X_OK));
1318   scm_sysintern ("F_OK", SCM_MAKINUM (F_OK));
1319
1320 #ifdef LC_COLLATE
1321   scm_sysintern ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE));
1322 #endif
1323 #ifdef LC_CTYPE
1324   scm_sysintern ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE));
1325 #endif
1326 #ifdef LC_MONETARY
1327   scm_sysintern ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY));
1328 #endif
1329 #ifdef LC_NUMERIC
1330   scm_sysintern ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC));
1331 #endif
1332 #ifdef LC_TIME
1333   scm_sysintern ("LC_TIME", SCM_MAKINUM (LC_TIME));
1334 #endif
1335 #ifdef LC_MESSAGES
1336   scm_sysintern ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES));
1337 #endif
1338 #ifdef LC_ALL
1339   scm_sysintern ("LC_ALL", SCM_MAKINUM (LC_ALL));
1340 #endif
1341 #include "cpp_sig_symbols.c"
1342 #include "posix.x"
1343 }