diff options
| -rwxr-xr-x | Configure | 19 | ||||
| -rw-r--r-- | Porting/config_H | 64 | ||||
| -rw-r--r-- | config_h.SH | 6 | ||||
| -rw-r--r-- | embed.h | 8 | ||||
| -rwxr-xr-x | embed.pl | 2 | ||||
| -rw-r--r-- | perl.c | 53 | ||||
| -rw-r--r-- | perl.h | 13 | ||||
| -rw-r--r-- | pod/perldiag.pod | 6 | ||||
| -rw-r--r-- | proto.h | 2 |
9 files changed, 104 insertions, 69 deletions
@@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Sat Oct 23 18:23:43 EET DST 1999 [metaconfig 3.0 PL70] +# Generated on Tue Oct 26 11:04:43 EET DST 1999 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.com) cat >/tmp/c1$$ <<EOF @@ -370,6 +370,7 @@ d_phostname='' d_uname='' d_gethostprotos='' d_getlogin='' +d_getmnt='' d_getmntent='' d_getnbyaddr='' d_getnbyname='' @@ -8690,8 +8691,15 @@ set fstatfs d_fstatfs eval $inlibc : see if statfs knows about mount flags -set d_statfsflags statfs f_flags $i_sysparam sys/param.h $i_sysmount sys/mount.h -eval $hasfield +case "$d_statfs" in +define) set d_statfsflags statfs f_flags $i_sysparam sys/param.h $i_sysmount sys/mount.h + eval $hasfield + ;; +*) val="$undef" + set d_statfsflags + eval $setvar + ;; +esac : see if statvfs exists @@ -8821,6 +8829,10 @@ eval $hasproto set getlogin d_getlogin eval $inlibc +: see if getmnt exists +set getmnt d_getmnt +eval $inlibc + : see if getmntent exists set getmntent d_getmntent eval $inlibc @@ -13594,6 +13606,7 @@ d_gethent='$d_gethent' d_gethname='$d_gethname' d_gethostprotos='$d_gethostprotos' d_getlogin='$d_getlogin' +d_getmnt='$d_getmnt' d_getmntent='$d_getmntent' d_getnbyaddr='$d_getnbyaddr' d_getnbyname='$d_getnbyname' diff --git a/Porting/config_H b/Porting/config_H index d4fec6a334..a86112e943 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -17,7 +17,7 @@ /* * Package name : perl5 * Source directory : . - * Configuration time: Tue Oct 19 10:28:21 EET DST 1999 + * Configuration time: Sat Oct 23 19:30:38 EET DST 1999 * Configured by : jhi * Target system : osf1 alpha.hut.fi v4.0 878 alpha */ @@ -40,7 +40,7 @@ * This symbol indicates the C compiler can check for function attributes, * such as printf formats. This is normally only supported by GNU cc. */ -/*#define HASATTRIBUTE / **/ +#define HASATTRIBUTE /**/ #ifndef HASATTRIBUTE #define __attribute__(_arg_) #endif @@ -1193,7 +1193,7 @@ * probably use memmove() or memcpy(). If neither is defined, roll your * own version. */ -/*#define HAS_SAFE_MEMCPY / **/ +#define HAS_SAFE_MEMCPY /**/ /* HAS_SANE_MEMCMP: * This symbol, if defined, indicates that the memcmp routine is available @@ -1423,8 +1423,8 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "/opt/perl/lib/5.00562/alpha-dec_osf-thread" /**/ -#define ARCHLIB_EXP "/opt/perl/lib/5.00562/alpha-dec_osf-thread" /**/ +#define ARCHLIB "/usr/local/lib/perl5/5.00562/alpha-dec_osf" /**/ +#define ARCHLIB_EXP "/usr/local/lib/perl5/5.00562/alpha-dec_osf" /**/ /* BIN: * This symbol holds the path of the bin directory where the package will @@ -1434,8 +1434,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "/opt/perl/bin" /**/ -#define BIN_EXP "/opt/perl/bin" /**/ +#define BIN "/usr/local/bin" /**/ +#define BIN_EXP "/usr/local/bin" /**/ /* INSTALL_USR_BIN_PERL: * This symbol, if defined, indicates that Perl is to be installed @@ -1453,8 +1453,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/opt/perl/lib/5.00562" /**/ -#define PRIVLIB_EXP "/opt/perl/lib/5.00562" /**/ +#define PRIVLIB "/usr/local/lib/perl5/5.00562" /**/ +#define PRIVLIB_EXP "/usr/local/lib/perl5/5.00562" /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1469,8 +1469,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "/opt/perl/lib/site_perl/5.00562/alpha-dec_osf-thread" /**/ -#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.00562/alpha-dec_osf-thread" /**/ +#define SITEARCH "/usr/local/lib/site_perl/5.00562/alpha-dec_osf" /**/ +#define SITEARCH_EXP "/usr/local/lib/site_perl/5.00562/alpha-dec_osf" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1485,8 +1485,8 @@ * This symbol contains the ~name expanded version of SITELIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITELIB "/opt/perl/lib/site_perl" /**/ -#define SITELIB_EXP "/opt/perl/lib/site_perl" /**/ +#define SITELIB "/usr/local/lib/site_perl" /**/ +#define SITELIB_EXP "/usr/local/lib/site_perl" /**/ /* PERL_VENDORLIB_EXP: * This symbol contains the ~name expanded version of VENDORLIB, to be used @@ -1546,10 +1546,10 @@ * This symbol is intended to be used along with CPPRUN in the same manner * symbol CPPMINUS is used with CPPSTDIN. It contains either "-" or "". */ -#define CPPSTDIN "cppstdin" -#define CPPMINUS "" -#define CPPRUN "/usr/bin/cpp" -#define CPPLAST "" +#define CPPSTDIN "gcc -E" +#define CPPMINUS "-" +#define CPPRUN "gcc -E" +#define CPPLAST "-" /* HAS_ACCESS: * This manifest constant lets the C program know that the access() @@ -1655,7 +1655,7 @@ #define HAS_UNAME /**/ #undef HAS_PHOSTNAME #ifdef HAS_PHOSTNAME -#define PHOSTNAME "" /* How to get the host name */ +#define PHOSTNAME "/usr/bin/hostname" /* How to get the host name */ #endif /* HAS_GETNETBYADDR: @@ -2086,7 +2086,7 @@ /* MYMALLOC: * This symbol, if defined, indicates that we're using our own malloc. */ -/*#define MYMALLOC / **/ +#define MYMALLOC /**/ /* SIG_NAME: * This symbol contains a list of signal names in order of @@ -2162,7 +2162,7 @@ * that use features like threads and multiplicity it is always * for those versions. */ -/*#define PERL_BINCOMPAT_5005 / **/ +#define PERL_BINCOMPAT_5005 /**/ /* DLSYM_NEEDS_UNDERSCORE: * This symbol, if defined, indicates that we need to prepend an @@ -2190,6 +2190,12 @@ */ /*#define HAS_FTELLO / **/ +/* HAS_GETMNT: + * This symbol, if defined, indicates that the getmnt routine is + * available. + */ +# HAS_GETMNT /**/ + /* HAS_GETMNTENT: * This symbol, if defined, indicates that the getmntent routine is * available to iterate through mounted file systems. @@ -2323,8 +2329,8 @@ * in the <db.h> header file. In older versions of DB, it was * int, while in newer ones it is size_t. */ -#define DB_Hash_t u_int32_t /**/ -#define DB_Prefix_t size_t /**/ +#define DB_Hash_t int /**/ +#define DB_Prefix_t int /**/ /* I_INTTYPES: * This symbol, if defined, indicates to the C program that it should @@ -2441,7 +2447,7 @@ * script to make sure (one hopes) that it runs with perl and not * some shell. */ -#define STARTPERL "#!/opt/perl/bin/perl" /**/ +#define STARTPERL "#!/usr/local/bin/perl" /**/ /* HAS_STDIO_STREAM_ARRAY: * This symbol, if defined, tells that there is an array @@ -2465,7 +2471,7 @@ * be used when available. If not defined, the native default interfaces * will be used (be they 32 or 64 bits). */ -#define USE_64_BITS /**/ +/*#define USE_64_BITS / **/ /* USE_LARGE_FILES: * This symbol, if defined, indicates that large file support @@ -2502,7 +2508,7 @@ /* PERL_XS_APIVERSION: * This variable contains the version of the oldest perl binary * compatible with the present perl. perl.c:incpush() and - * lib/lib.pm will automatically search in /opt/perl/lib/site_perl/5.00562/alpha-dec_osf-thread for older + * lib/lib.pm will automatically search in /usr/local/lib/site_perl/5.00562/alpha-dec_osf for older * directories across major versions back to xs_apiversion. * This is only useful if you have a perl library directory tree * structured like the default one. @@ -2521,7 +2527,7 @@ * compatible with the present perl. (That is, pure perl modules * written for pm_apiversion will still work for the current * version). perl.c:incpush() and lib/lib.pm will automatically - * search in /opt/perl/lib/site_perl for older directories across major versions + * search in /usr/local/lib/site_perl for older directories across major versions * back to pm_apiversion. This is only useful if you have a perl * library directory tree structured like the default one. The * versioned site_perl library was introduced in 5.005, so that's @@ -2531,7 +2537,7 @@ * (presumably) be similar. * See the INSTALL file for how this works. */ -#define PERL_XS_APIVERSION 5.00562 /* Change to string for tuples?*/ +#define PERL_XS_APIVERSION 5.005 /* Change to string for tuples?*/ #define PERL_PM_APIVERSION 5.005 /* Change to string for tuples?*/ /* HAS_DRAND48_PROTO: @@ -2609,7 +2615,7 @@ * where library files may be held under a private library, for * instance. */ -#define ARCHNAME "alpha-dec_osf-thread" /**/ +#define ARCHNAME "alpha-dec_osf" /**/ /* OLD_PTHREAD_CREATE_JOINABLE: * This symbol, if defined, indicates how to create pthread @@ -2660,7 +2666,7 @@ * This symbol, if defined, indicates that Perl should * be built to use the old draft POSIX threads API. */ -#define USE_THREADS /**/ +/*#define USE_THREADS / **/ /*#define OLD_PTHREADS_API / **/ /* Time_t: diff --git a/config_h.SH b/config_h.SH index c10e3369a8..9198190de0 100644 --- a/config_h.SH +++ b/config_h.SH @@ -2204,6 +2204,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_ftello HAS_FTELLO /**/ +/* HAS_GETMNT: + * This symbol, if defined, indicates that the getmnt routine is + * available. + */ +#$d_getmnt HAS_GETMNT /**/ + /* HAS_GETMNTENT: * This symbol, if defined, indicates that the getmntent routine is * available to iterate through mounted file systems. @@ -841,7 +841,7 @@ #define usage S_usage #define validate_suid S_validate_suid # if defined(IAMSUID) -#define fd_on_nosuid_fs S_fd_on_nosuid_fs +#define file_on_nosuid_fs S_file_on_nosuid_fs # endif #define parse_body S_parse_body #define run_body S_run_body @@ -2193,7 +2193,7 @@ #define usage(a) S_usage(aTHX_ a) #define validate_suid(a,b,c) S_validate_suid(aTHX_ a,b,c) # if defined(IAMSUID) -#define fd_on_nosuid_fs(a) S_fd_on_nosuid_fs(aTHX_ a) +#define file_on_nosuid_fs(a,b) S_file_on_nosuid_fs(aTHX_ a,b) # endif #define parse_body(a) S_parse_body(aTHX_ a) #define run_body(a) S_run_body(aTHX_ a) @@ -4307,8 +4307,8 @@ #define S_validate_suid CPerlObj::S_validate_suid #define validate_suid S_validate_suid # if defined(IAMSUID) -#define S_fd_on_nosuid_fs CPerlObj::S_fd_on_nosuid_fs -#define fd_on_nosuid_fs S_fd_on_nosuid_fs +#define S_file_on_nosuid_fs CPerlObj::S_file_on_nosuid_fs +#define file_on_nosuid_fs S_file_on_nosuid_fs # endif #define S_parse_body CPerlObj::S_parse_body #define parse_body S_parse_body @@ -1860,7 +1860,7 @@ s |void |open_script |char *|bool|SV *|int *fd s |void |usage |char * s |void |validate_suid |char *|char*|int # if defined(IAMSUID) -s |int |fd_on_nosuid_fs|int fd +s |int |file_on_nosuid_fs|int fd|char *path # endif s |void* |parse_body |va_list args s |void* |run_body |va_list args @@ -2178,15 +2178,17 @@ sed %s -e \"/^[^#]/b\" \ #ifdef IAMSUID STATIC int -S_fd_on_nosuid_fs(pTHX_ int fd) +S_file_on_nosuid_fs(pTHX_ int fd, char *path) { 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. + * Preferred order: fstatvfs(), fstatfs(), getmnt(), getmntent(). + * fstatvfs() is UNIX98 and uses the fd. + * fstatfs() is BSD 4.3+ and uses the fd. + * getmnt() is BSD 4.2 (4.1?) and uses the path. + * getmntent() is O(number-of-mounted-filesystems) and + * uses neither fd nor path and can hang. */ # ifdef HAS_FSTATVFS @@ -2194,22 +2196,18 @@ S_fd_on_nosuid_fs(pTHX_ int fd) 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; +# ifdef PERL_MOUNT_NOSUID +# 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 +# ifdef HAS_GETMNT + struct fs_data fsd; + check_okay = getmnt(0, &fsd, 0, NOSTAT_ONE, path) == 1; + on_nosuid = check_okay && (fsd.fd_req.flags & PERL_MOUNT_NOSUID); +# endif /* getmnt */ +# endif /* fstatfs */ # else # if defined(HAS_GETMNTENT) && defined(HAS_HASMNTOPT) && defined(MNTOPT_NOSUID) FILE *mtab = fopen("/etc/mtab", "r"); @@ -2217,25 +2215,24 @@ S_fd_on_nosuid_fs(pTHX_ int fd) 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) + 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(). */ + } /* A single fs may well fail its stat(). Or hang :-( */ } } if (mtab) fclose(mtab); -# endif /* mntent */ -# endif /* statfs */ -# endif /* statvfs */ +# endif /* getmntent */ +# endif /* PERL_MOUNT_NOSUID: fstatfs() or getmnt() */ +# endif /* fstatvfs */ if (!check_okay) - Perl_croak(aTHX_ "Can't check filesystem of script \"%s\"", PL_origfilename); + Perl_croak(aTHX_ "Can't check filesystem of script \"%s\" for nosuid", PL_origfilename); return on_nosuid; } #endif /* IAMSUID */ @@ -2309,7 +2306,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript) if (PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&tmpstatbuf) < 0) Perl_croak(aTHX_ "Permission denied"); /* testing full pathname here */ #if defined(IAMSUID) && !defined(NO_NOSUID_CHECK) - if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp))) + if (file_on_nosuid_fs(PerlIO_fileno(PL_rsfp), scriptname)) Perl_croak(aTHX_ "Permission denied"); #endif if (tmpstatbuf.st_dev != PL_statbuf.st_dev || @@ -3202,12 +3202,23 @@ typedef struct am_table_short AMTS; # include <sys/statvfs.h> /* for f?statvfs() */ #endif #ifdef I_SYS_MOUNT -# include <sys/mount.h> /* for *BSD f?statfs() */ +# include <sys/mount.h> /* for *BSD f?statfs() or getmnt() */ #endif #ifdef I_MNTENT # include <mntent.h> /* for getmntent() */ #endif +#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 + #endif /* IAMSUID */ /* and finally... */ diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 5b1c324a48..3c0a212077 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -636,9 +636,11 @@ Something like this will reproduce the error: (F) You called C<perl -x/foo/bar>, but C</foo/bar> is not a directory that you can chdir to, possibly because it doesn't exist. -=item Can't check filesystem of script "%s" +=item Can't check filesystem of script "%s" for nosuid -(P) For some reason you can't check the filesystem of the script for nosuid. +(P) For some reason you can't check the filesystem of the script for nosuid +(whether the filesystem has been mounted to disallow the execution of suid +(and sgid) programs) =item Can't coerce %s to integer in %s @@ -817,7 +817,7 @@ STATIC void S_open_script(pTHX_ char *, bool, SV *, int *fd); STATIC void S_usage(pTHX_ char *); STATIC void S_validate_suid(pTHX_ char *, char*, int); # if defined(IAMSUID) -STATIC int S_fd_on_nosuid_fs(pTHX_ int fd); +STATIC int S_file_on_nosuid_fs(pTHX_ int fd, char *path); # endif STATIC void* S_parse_body(pTHX_ va_list args); STATIC void* S_run_body(pTHX_ va_list args); |