perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0 Changes
Date Tue, 17 Feb 2004 01:22:42 GMT
stas        2004/02/16 17:22:42

  Modified:    src/modules/perl modperl_io.c
               .        Changes
  Added:       t/response/TestModperl io_nested_with_closed_stds.pm
                        io_with_closed_stds.pm
  Log:
  Fix the STDIN/OUT overriding process to handle gracefully cases, when
  either or both are closed/bogus (the problem was only with useperlio
  enabled perl) + tests
  
  Revision  Changes    Path
  1.23      +93 -47    modperl-2.0/src/modules/perl/modperl_io.c
  
  Index: modperl_io.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_io.c,v
  retrieving revision 1.22
  retrieving revision 1.23
  diff -u -u -r1.22 -r1.23
  --- modperl_io.c	22 Nov 2003 20:38:54 -0000	1.22
  +++ modperl_io.c	17 Feb 2004 01:22:41 -0000	1.23
  @@ -92,25 +92,34 @@
   {
       dHANDLE("STDIN");
       int status;
  -    GV *handle_save = gv_fetchpv(Perl_form(aTHX_ "Apache::RequestIO::_GEN_%ld",
  -                                           (long)PL_gensym++),
  -                                 TRUE, SVt_PVIO);
  +    GV *handle_save = (GV*)Nullsv;
       SV *sv = sv_newmortal();
   
  -    sv_setref_pv(sv, "Apache::RequestRec", (void*)r);
       MP_TRACE_o(MP_FUNC, "start");
   
  -    /* open my $oldout, "<&STDIN" or die "Can't dup STDIN: $!"; */
  -    status = Perl_do_open(aTHX_ handle_save, "<&STDIN", 7, FALSE, O_RDONLY,
  -                          0, Nullfp);
  -    if (status == 0) {
  -        Perl_croak(aTHX_ "Failed to dup STDIN: %_", get_sv("!", TRUE));
  +    sv_setref_pv(sv, "Apache::RequestRec", (void*)r);
  +
  +    /* STDIN could be closed or invalid */
  +    if (handle && SvTYPE(handle) == SVt_PVGV &&
  +        IoTYPE(GvIO(handle)) != IoTYPE_CLOSED) {
  +        handle_save = gv_fetchpv(Perl_form(aTHX_
  +                                           "Apache::RequestIO::_GEN_%ld",
  +                                           (long)PL_gensym++),
  +                                 TRUE, SVt_PVIO);
  +
  +        /* open my $oldout, "<&STDIN" or die "Can't dup STDIN: $!"; */
  +        status = Perl_do_open(aTHX_ handle_save, "<&STDIN", 7, FALSE,
  +                              O_RDONLY, 0, Nullfp);
  +        if (status == 0) {
  +            Perl_croak(aTHX_ "Failed to dup STDIN: %_", get_sv("!", TRUE));
  +        }
  +
  +        /* similar to PerlIO::scalar, the PerlIO::Apache layer doesn't
  +         * have file descriptors, so STDIN must be closed before it can
  +         * be reopened */
  +        Perl_do_close(aTHX_ handle, TRUE);
       }
   
  -    /* similar to PerlIO::scalar, the PerlIO::Apache layer doesn't
  -     * have file descriptors, so STDIN must be closed before it can
  -     * be reopened */
  -    Perl_do_close(aTHX_ handle, TRUE); 
       status = Perl_do_open9(aTHX_ handle, "<:Apache", 8, FALSE, O_RDONLY,
                              0, Nullfp, sv, 1);
       if (status == 0) {
  @@ -127,26 +136,34 @@
   {
       dHANDLE("STDOUT");
       int status;
  -    GV *handle_save = gv_fetchpv(Perl_form(aTHX_ "Apache::RequestIO::_GEN_%ld",
  -                                           (long)PL_gensym++),
  -                                 TRUE, SVt_PVIO);
  +    GV *handle_save = (GV*)Nullsv;
       SV *sv = sv_newmortal();
   
       MP_TRACE_o(MP_FUNC, "start");
   
       sv_setref_pv(sv, "Apache::RequestRec", (void*)r);
   
  -    /* open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!"; */
  -    status = Perl_do_open(aTHX_ handle_save, ">&STDOUT", 8, FALSE, O_WRONLY,
  -                          0, Nullfp);
  -    if (status == 0) {
  -        Perl_croak(aTHX_ "Failed to dup STDOUT: %_", get_sv("!", TRUE));
  +    /* STDOUT could be closed or invalid */
  +    if (handle && SvTYPE(handle) == SVt_PVGV &&
  +        IoTYPE(GvIO(handle)) != IoTYPE_CLOSED) {
  +        handle_save = gv_fetchpv(Perl_form(aTHX_
  +                                           "Apache::RequestIO::_GEN_%ld",
  +                                           (long)PL_gensym++),
  +                                 TRUE, SVt_PVIO);
  +        
  +        /* open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!"; */
  +        status = Perl_do_open(aTHX_ handle_save, ">&STDOUT", 8, FALSE,
  +                              O_WRONLY, 0, Nullfp);
  +        if (status == 0) {
  +            Perl_croak(aTHX_ "Failed to dup STDOUT: %_", get_sv("!", TRUE));
  +        }
  +
  +        /* similar to PerlIO::scalar, the PerlIO::Apache layer doesn't
  +         * have file descriptors, so STDOUT must be closed before it can
  +         * be reopened */
  +        Perl_do_close(aTHX_ handle, TRUE);
       }
   
  -    /* similar to PerlIO::scalar, the PerlIO::Apache layer doesn't
  -     * have file descriptors, so STDOUT must be closed before it can
  -     * be reopened */
  -    Perl_do_close(aTHX_ handle, TRUE); 
       status = Perl_do_open9(aTHX_ handle, ">:Apache", 8, FALSE, O_WRONLY,
                              0, Nullfp, sv, 1);
       if (status == 0) {
  @@ -166,20 +183,33 @@
   MP_INLINE void modperl_io_perlio_restore_stdin(pTHX_ GV *handle)
   {
       GV *handle_orig = gv_fetchpv("STDIN", FALSE, SVt_PVIO);
  -    int status;
   
       MP_TRACE_o(MP_FUNC, "start");
   
  -    /* Perl_do_close(aTHX_ handle_orig, FALSE); */
  +    /* close the overriding filehandle */
  +    Perl_do_close(aTHX_ handle_orig, FALSE);
   
  -    /* open STDIN, "<&STDIN_SAVED" or die "Can't dup STDIN_SAVED: $!"; */
  -    status = Perl_do_open9(aTHX_ handle_orig, "<&", 2, FALSE, O_RDONLY,
  -                           0, Nullfp, (SV*)handle, 1);
  -    Perl_do_close(aTHX_ handle, FALSE);
  -    (void)hv_delete(gv_stashpv("Apache::RequestIO", TRUE), 
  -		    GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
  -    if (status == 0) {
  -        Perl_croak(aTHX_ "Failed to restore STDIN: %_", get_sv("!", TRUE));
  +    /*
  +     * open STDIN, "<&STDIN_SAVED" or die "Can't dup STDIN_SAVED: $!";
  +     * close STDIN_SAVED;
  +     */
  +    if (handle != (GV*)Nullsv) {
  +        SV *err = Nullsv;
  +        
  +        MP_TRACE_o(MP_FUNC, "restoring STDIN");
  +
  +        if (Perl_do_open9(aTHX_ handle_orig, "<&", 2, FALSE,
  +                          O_RDONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
  +            err = get_sv("!", TRUE);
  +        }
  +        
  +        Perl_do_close(aTHX_ handle, FALSE);
  +        (void)hv_delete(gv_stashpv("Apache::RequestIO", TRUE), 
  +                        GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
  +
  +        if (err != Nullsv) {
  +            Perl_croak(aTHX_ "Failed to restore STDIN: %_", err);
  +        }
       }
   
       MP_TRACE_o(MP_FUNC, "end\n");
  @@ -188,7 +218,6 @@
   MP_INLINE void modperl_io_perlio_restore_stdout(pTHX_ GV *handle)
   { 
       GV *handle_orig = gv_fetchpv("STDOUT", FALSE, SVt_PVIO);
  -    int status;
   
       MP_TRACE_o(MP_FUNC, "start");
   
  @@ -199,18 +228,35 @@
        * level STDOUT is attempted to be closed. To prevent this
        * situation always explicitly flush STDOUT, before reopening it.
        */
  -    if (GvIOn(handle_orig) && IoOFP(GvIOn(handle_orig))) {
  -        PerlIO_flush(IoOFP(GvIOn(handle_orig)));
  +    if (GvIOn(handle_orig) && IoOFP(GvIOn(handle_orig)) &&
  +        (PerlIO_flush(IoOFP(GvIOn(handle_orig))) == -1)) {
  +        Perl_croak(aTHX_ "Failed to flush STDOUT: %_", get_sv("!", TRUE));
       }
  -    /* open STDOUT, ">&STDOUT_SAVED" or die "Can't dup STDOUT_SAVED: $!"; */
  -    /* open first closes STDOUT */
  -    status = Perl_do_open9(aTHX_ handle_orig, ">&", 2, FALSE, O_WRONLY,
  -                           0, Nullfp, (SV*)handle, 1);
  -    Perl_do_close(aTHX_ handle, FALSE);
  -    (void)hv_delete(gv_stashpv("Apache::RequestIO", TRUE), 
  -		    GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
  -    if (status == 0) {
  -        Perl_croak(aTHX_ "Failed to restore STDOUT: %_", get_sv("!", TRUE));
  +
  +    /* close the overriding filehandle */
  +    Perl_do_close(aTHX_ handle_orig, FALSE);
  +    
  +    /*
  +     * open STDOUT, ">&STDOUT_SAVED" or die "Can't dup STDOUT_SAVED: $!";
  +     * close STDOUT_SAVED;
  +     */
  +    if (handle != (GV*)Nullsv) {
  +        SV *err = Nullsv;
  +        
  +        MP_TRACE_o(MP_FUNC, "restoring STDOUT");
  +
  +        if (Perl_do_open9(aTHX_ handle_orig, ">&", 2, FALSE,
  +                          O_WRONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
  +            err = get_sv("!", TRUE);
  +        }
  +        
  +        Perl_do_close(aTHX_ handle, FALSE);
  +        (void)hv_delete(gv_stashpv("Apache::RequestIO", TRUE), 
  +                        GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
  +
  +        if (err != Nullsv) {
  +            Perl_croak(aTHX_ "Failed to restore STDOUT: %_", err);
  +        }
       }
   
       MP_TRACE_o(MP_FUNC, "end\n");
  
  
  
  1.1                  modperl-2.0/t/response/TestModperl/io_nested_with_closed_stds.pm
  
  Index: io_nested_with_closed_stds.pm
  ===================================================================
  package TestModperl::io_nested_with_closed_stds;
  
  # test that we can successfully override STD(IN|OUT) for
  # 'perl-script', even if they are closed. Here we use
  # internal_redirect(), which causes a nested override of already
  # overriden STD streams
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  use Apache::SubRequest ();
  
  use Apache::Test;
  
  use Apache::Const -compile => 'OK';
  
  sub handler {
      my $r = shift;
  
      my $args = $r->args || '';
      if ($args eq 'redirect') {
          # sub-req
          $r->content_type('text/plain');
          # do not use plan() here, since it messes up with STDOUT,
          # which affects this test.
          print "1..1\nok 1\n";
      }
      else {
          # main-req
          my $redirect_uri = $r->uri . "?redirect";
  
          # we must close STDIN as well, due to a perl bug (5.8.0 - 5.8.3
          # w/useperlio), which emits a warning if dup is called with
          # one of the STD streams is closed.
          # but we must restore the STD streams so not to affect other
          # tests.
          open my $oldin,  "<&STDIN"  or die "Can't dup STDIN: $!";
          open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!";
          close STDIN;
          close STDOUT;
  
          $r->internal_redirect($redirect_uri);
  
          open STDIN,  "<&", $oldin  or die "Can't dup \$oldin: $!";
          open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";
          close $oldin;
          close $oldout;
      }
  
      Apache::OK;
  }
  
  1;
  __DATA__
  SetHandler perl-script
  
  
  
  
  1.1                  modperl-2.0/t/response/TestModperl/io_with_closed_stds.pm
  
  Index: io_with_closed_stds.pm
  ===================================================================
  package TestModperl::io_with_closed_stds;
  
  # test that we can successfully override STD(IN|OUT) for
  # 'perl-script', even if they are closed.
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::RequestRec ();
  use Apache::RequestUtil ();
  use Apache::RequestIO ();
  use Apache::SubRequest ();
  
  use Apache::Test;
  
  use Apache::Const -compile => 'OK';
  
  sub fixup {
      my $r = shift;
  
      # we must close STDIN as well, due to a perl bug (5.8.0 - 5.8.3
      # w/useperlio), which emits a warning if dup is called with
      # one of the STD streams is closed.
      open my $oldin,  "<&STDIN"  or die "Can't dup STDIN: $!";
      open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!";
      close STDIN;
      close STDOUT;
      $r->pnotes(oldin  => $oldin);
      $r->pnotes(oldout => $oldout);
  
      Apache::OK;
  }
  
  sub handler {
      my $r = shift;
  
      plan $r, tests => 1;
  
      ok 1;
  
      Apache::OK;
  }
  
  sub cleanup {
      my $r = shift;
  
      # restore the STD(IN|OUT) streams so not to affect other tests.
      my $oldin  = $r->pnotes('oldin');
      my $oldout = $r->pnotes('oldout');
      open STDIN,  "<&", $oldin  or die "Can't dup \$oldin: $!";
      open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";
      close $oldin;
      close $oldout;
  
      Apache::OK;
  }
  
  1;
  __DATA__
  PerlModule TestModperl::io_with_closed_stds
  SetHandler perl-script
  PerlFixupHandler    TestModperl::io_with_closed_stds::fixup
  PerlResponseHandler TestModperl::io_with_closed_stds
  PerlCleanupHandler  TestModperl::io_with_closed_stds::cleanup
  
  
  
  1.332     +4 -0      modperl-2.0/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Changes,v
  retrieving revision 1.331
  retrieving revision 1.332
  diff -u -u -r1.331 -r1.332
  --- Changes	16 Feb 2004 19:58:18 -0000	1.331
  +++ Changes	17 Feb 2004 01:22:42 -0000	1.332
  @@ -12,6 +12,10 @@
   
   =item 1.99_13-dev
   
  +Fix the STDIN/OUT overriding process to handle gracefully cases, when
  +either or both are closed/bogus (the problem was only with useperlio
  +enabled perl) [Stas]
  +
   copy apr_table_compress logic from later httpd versions in case mod_perl
   is built against 2.0.46, as mod_perl now requires it internally.  users
   should be aware that 2.0.47 may become the oldest supported httpd version 
  
  
  

Mime
View raw message