X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=197e73727417220dc6644f7d57a061a7566eacd4;hb=a29d06eddb19ab1d6c524328bb98500ebb28dcdb;hp=3947f28c5ff84b1a093bbd8e1adb33fdd6281587;hpb=25fbdfc0879f30cf6944c322d4607eea9bcc7d15;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.c b/perl.c index 3947f28..197e737 100644 --- a/perl.c +++ b/perl.c @@ -180,6 +180,8 @@ perl_construct(pTHXx) # endif /* EMULATE_ATOMIC_REFCOUNTS */ MUTEX_INIT(&PL_cred_mutex); + MUTEX_INIT(&PL_sv_lock_mutex); + MUTEX_INIT(&PL_fdpid_mutex); thr = init_main_thread(); #endif /* USE_THREADS */ @@ -728,6 +730,7 @@ perl_destruct(pTHXx) MUTEX_DESTROY(&PL_sv_mutex); MUTEX_DESTROY(&PL_eval_mutex); MUTEX_DESTROY(&PL_cred_mutex); + MUTEX_DESTROY(&PL_fdpid_mutex); COND_DESTROY(&PL_eval_cond); #ifdef EMULATE_ATOMIC_REFCOUNTS MUTEX_DESTROY(&PL_svref_mutex); @@ -2057,9 +2060,25 @@ Perl_moreswitches(pTHX_ char *s) case 'd': forbid_setid("-d"); s++; - if (*s == ':' || *s == '=') { - my_setenv("PERL5DB", Perl_form(aTHX_ "use Devel::%s;", ++s)); + /* The following permits -d:Mod to accepts arguments following an = + in the fashion that -MSome::Mod does. */ + if (*s == ':' || *s == '=') { + char *start; + SV *sv; + sv = newSVpv("use Devel::", 0); + start = ++s; + /* We now allow -d:Module=Foo,Bar */ + while(isALNUM(*s) || *s==':') ++s; + if (*s != '=') + sv_catpv(sv, start); + else { + sv_catpvn(sv, start, s-start); + sv_catpv(sv, " split(/,/,q{"); + sv_catpv(sv, ++s); + sv_catpv(sv, "})"); + } s += strlen(s); + my_setenv("PERL5DB", SvPV(sv, PL_na)); } if (!PL_perldb) { PL_perldb = PERLDB_ALL; @@ -2238,6 +2257,10 @@ Perl_moreswitches(pTHX_ char *s) PerlIO_printf(PerlIO_stdout(), "\n\nCopyright 1987-2000, Larry Wall\n"); +#ifdef MACOS_TRADITIONAL + PerlIO_printf(PerlIO_stdout(), + "\nMacOS port Copyright (c) 1991-2000, Matthias Neeracher\n"); +#endif #ifdef MSDOS PerlIO_printf(PerlIO_stdout(), "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n"); @@ -2844,16 +2867,6 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript) if (tmpstatbuf.st_dev != PL_statbuf.st_dev || tmpstatbuf.st_ino != PL_statbuf.st_ino) { (void)PerlIO_close(PL_rsfp); - if (PL_rsfp = PerlProc_popen("/bin/mail root","w")) { /* heh, heh */ - PerlIO_printf(PL_rsfp, -"User %"Uid_t_f" tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\ -(Filename of set-id script was %s, uid %"Uid_t_f" gid %"Gid_t_f".)\n\nSincerely,\nperl\n", - PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino, - (long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino, - CopFILE(PL_curcop), - PL_statbuf.st_uid, PL_statbuf.st_gid); - (void)PerlProc_pclose(PL_rsfp); - } Perl_croak(aTHX_ "Permission denied\n"); } if (