/* perl.c
*
- * Copyright (c) 1987-1998 Larry Wall
+ * Copyright (c) 1987-1999 Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#include "EXTERN.h"
#include "perl.h"
-#include "patchlevel.h"
/* XXX If this causes problems, set i_unistd=undef in the hint file. */
#ifdef I_UNISTD
static void nuke_stacks _((void));
static void open_script _((char *, bool, SV *, int *fd));
static void usage _((char *));
+#ifdef IAMSUID
+static int fd_on_nosuid_fs _((int));
+#endif
static void validate_suid _((char *, char*, int));
static I32 read_e_script _((int idx, SV *buf_sv, int maxlen));
#endif
STATUS_ALL_SUCCESS;
SET_NUMERIC_STANDARD();
-#if defined(SUBVERSION) && SUBVERSION > 0
- sprintf(PL_patchlevel, "%7.5f", (double) 5
- + ((double) PATCHLEVEL / (double) 1000)
- + ((double) SUBVERSION / (double) 100000));
+#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
+ sprintf(PL_patchlevel, "%7.5f", (double) PERL_REVISION
+ + ((double) PERL_VERSION / (double) 1000)
+ + ((double) PERL_SUBVERSION / (double) 100000));
#else
- sprintf(PL_patchlevel, "%5.3f", (double) 5 +
- ((double) PATCHLEVEL / (double) 1000));
+ sprintf(PL_patchlevel, "%5.3f", (double) PERL_REVISION +
+ ((double) PERL_VERSION / (double) 1000));
#endif
#if defined(LOCAL_PATCH_COUNT)
MUTEX_DESTROY(&PL_eval_mutex);
MUTEX_DESTROY(&PL_cred_mutex);
COND_DESTROY(&PL_eval_cond);
+#ifdef EMULATE_ATOMIC_REFCOUNTS
+ MUTEX_DESTROY(&PL_svref_mutex);
+#endif /* EMULATE_ATOMIC_REFCOUNTS */
/* As the penultimate thing, free the non-arena SV for thrsv */
Safefree(SvPVX(PL_thrsv));
s = argv[0]+1;
reswitch:
switch (*s) {
+#ifndef PERL_STRICT_CR
+ case '\r':
+#endif
case ' ':
case '0':
case 'F':
switch_end:
if (!PL_tainting && (s = PerlEnv_getenv("PERL5OPT"))) {
- while (s && *s) {
- while (isSPACE(*s))
- s++;
- if (*s == '-') {
- s++;
- if (isSPACE(*s))
- continue;
+ while (isSPACE(*s))
+ s++;
+ if (*s == '-' && *(s+1) == 'T')
+ PL_tainting = TRUE;
+ else {
+ while (s && *s) {
+ while (isSPACE(*s))
+ s++;
+ if (*s == '-') {
+ s++;
+ if (isSPACE(*s))
+ continue;
+ }
+ if (!*s)
+ break;
+ if (!strchr("DIMUdmw", *s))
+ croak("Illegal switch in PERL5OPT: -%c", *s);
+ s = moreswitches(s);
}
- if (!*s)
- break;
- if (!strchr("DIMUdmw", *s))
- croak("Illegal switch in PERL5OPT: -%c", *s);
- s = moreswitches(s);
}
}
}
SV*
-perl_get_sv(char *name, I32 create)
+perl_get_sv(const char *name, I32 create)
{
GV *gv;
#ifdef USE_THREADS
}
AV*
-perl_get_av(char *name, I32 create)
+perl_get_av(const char *name, I32 create)
{
GV* gv = gv_fetchpv(name, create, SVt_PVAV);
if (create)
}
HV*
-perl_get_hv(char *name, I32 create)
+perl_get_hv(const char *name, I32 create)
{
GV* gv = gv_fetchpv(name, create, SVt_PVHV);
if (create)
}
CV*
-perl_get_cv(char *name, I32 create)
+perl_get_cv(const char *name, I32 create)
{
GV* gv = gv_fetchpv(name, create, SVt_PVCV);
/* XXX unsafe for threads if eval_owner isn't held */
/* Be sure to refetch the stack pointer after calling these routines. */
I32
-perl_call_argv(char *sub_name, I32 flags, register char **argv)
+perl_call_argv(const char *sub_name, I32 flags, register char **argv)
/* See G_* flags in cop.h */
/* null terminated arg list */
}
I32
-perl_call_pv(char *sub_name, I32 flags)
+perl_call_pv(const char *sub_name, I32 flags)
/* name of the subroutine */
/* See G_* flags in cop.h */
{
}
I32
-perl_call_method(char *methname, I32 flags)
+perl_call_method(const char *methname, I32 flags)
/* name of the subroutine */
/* See G_* flags in cop.h */
{
}
SV*
-perl_eval_pv(char *p, I32 croak_on_error)
+perl_eval_pv(const char *p, I32 croak_on_error)
{
dSP;
SV* sv = newSVpv(p, 0);
/* Require a module. */
void
-perl_require_pv(char *pv)
+perl_require_pv(const char *pv)
{
SV* sv;
dSP;
s++;
return s;
case 'v':
-#if defined(SUBVERSION) && SUBVERSION > 0
- printf("\nThis is perl, version 5.%03d_%02d built for %s",
- PATCHLEVEL, SUBVERSION, ARCHNAME);
+#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
+ printf("\nThis is perl, version %d.%03d_%02d built for %s",
+ PERL_REVISION, PERL_VERSION, PERL_SUBVERSION, ARCHNAME);
#else
printf("\nThis is perl, version %s built for %s",
PL_patchlevel, ARCHNAME);
LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
#endif
- printf("\n\nCopyright 1987-1998, Larry Wall\n");
+ printf("\n\nCopyright 1987-1999, Larry Wall\n");
#ifdef MSDOS
printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
#endif
#ifdef DJGPP
printf("djgpp v2 port (jpl5003c) by Hirofumi Watanabe, 1996\n");
- printf("djgpp v2 port (perl5004+) by Laszlo Molnar, 1997-1998\n");
+ printf("djgpp v2 port (perl5004+) by Laszlo Molnar, 1997-1999\n");
#endif
#ifdef OS2
printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
- "Version 5 port Copyright (c) 1994-1998, Andreas Kaiser, Ilya Zakharevich\n");
+ "Version 5 port Copyright (c) 1994-1999, Andreas Kaiser, Ilya Zakharevich\n");
#endif
#ifdef atarist
printf("atariST series port, ++jrb bammi@cadence.com\n");
#endif
#ifdef __BEOS__
- printf("BeOS port Copyright Tom Spindler, 1997-1998\n");
+ printf("BeOS port Copyright Tom Spindler, 1997-1999\n");
#endif
#ifdef MPE
- printf("MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-1998\n");
+ printf("MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-1999\n");
#endif
#ifdef OEMVS
- printf("MVS (OS390) port by Mortice Kern Systems, 1997-1998\n");
+ printf("MVS (OS390) port by Mortice Kern Systems, 1997-1999\n");
#endif
#ifdef __VOS__
- printf("Stratus VOS port by Paul_Green@stratus.com, 1997-1998\n");
+ printf("Stratus VOS port by Paul_Green@stratus.com, 1997-1999\n");
#endif
#ifdef __OPEN_VM
- printf("VM/ESA port by Neale Ferguson, 1998\n");
+ printf("VM/ESA port by Neale Ferguson, 1998-1999\n");
#endif
#ifdef POSIX_BC
- printf("BS2000 (POSIX) port by Start Amadeus GmbH, 1998\n");
+ printf("BS2000 (POSIX) port by Start Amadeus GmbH, 1998-1999\n");
+#endif
+#ifdef __MINT__
+ printf("MiNT port by Guido Flohr, 1997-1999\n");
#endif
#ifdef BINARY_BUILD_NOTICE
BINARY_BUILD_NOTICE;
}
}
+/* Mention
+ * I_SYSSTATVFS HAS_FSTATVFS
+ * I_SYSMOUNT
+ * I_STATFS HAS_FSTATFS
+ * I_MNTENT HAS_GETMNTENT HAS_HASMNTOPT
+ * here so that metaconfig picks them up. */
+
+#ifdef IAMSUID
+static int
+fd_on_nosuid_fs(int fd)
+{
+ int on_nosuid = 0;
+ int check_okay = 0;
+/*
+ * Preferred order: fstatvfs(), fstatfs(), getmntent().
+ * fstatvfs() is UNIX98.
+ * fstatfs() is BSD.
+ * getmntent() is O(number-of-mounted-filesystems) and can hang.
+ */
+
+# ifdef HAS_FSTATVFS
+ struct statvfs stfs;
+ check_okay = fstatvfs(fd, &stfs) == 0;
+ on_nosuid = check_okay && (stfs.f_flag & ST_NOSUID);
+# else
+# if defined(HAS_FSTATFS) && defined(HAS_STRUCT_STATFS_FLAGS)
+ struct statfs stfs;
+ check_okay = fstatfs(fd, &stfs) == 0;
+# undef PERL_MOUNT_NOSUID
+# if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID)
+# define PERL_MOUNT_NOSUID MNT_NOSUID
+# endif
+# if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID)
+# define PERL_MOUNT_NOSUID MS_NOSUID
+# endif
+# if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID)
+# define PERL_MOUNT_NOSUID M_NOSUID
+# endif
+# ifdef PERL_MOUNT_NOSUID
+ on_nosuid = check_okay && (stfs.f_flags & PERL_MOUNT_NOSUID);
+# endif
+# else
+# if defined(HAS_GETMNTENT) && defined(HAS_HASMNTOPT) && defined(MNTOPT_NOSUID)
+ FILE *mtab = fopen("/etc/mtab", "r");
+ struct mntent *entry;
+ struct stat stb, fsb;
+
+ if (mtab && (fstat(fd, &stb) == 0)) {
+ while (entry = getmntent(mtab)) {
+ if (stat(entry->mnt_dir, &fsb) == 0
+ && fsb.st_dev == stb.st_dev)
+ {
+ /* found the filesystem */
+ check_okay = 1;
+ if (hasmntopt(entry, MNTOPT_NOSUID))
+ on_nosuid = 1;
+ break;
+ } /* A single fs may well fail its stat(). */
+ }
+ }
+ if (mtab)
+ fclose(mtab);
+# endif /* mntent */
+# endif /* statfs */
+# endif /* statvfs */
+ if (!check_okay)
+ croak("Can't check filesystem of script \"%s\"", PL_origfilename);
+ return on_nosuid;
+}
+#endif /* IAMSUID */
+
STATIC void
validate_suid(char *validarg, char *scriptname, int fdscript)
{
croak("Can't swap uid and euid"); /* really paranoid */
if (PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&tmpstatbuf) < 0)
croak("Permission denied"); /* testing full pathname here */
+#if defined(IAMSUID) && !defined(NO_NOSUID_CHECK)
+ if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp)))
+ croak("Permission denied");
+#endif
if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
tmpstatbuf.st_ino != PL_statbuf.st_ino) {
(void)PerlIO_close(PL_rsfp);
projects / p5sagit/p5-mst-13.2.git / blobdiff