Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number

Debugging cgi-bin script

by walkingthecow (Friar)
on Jan 05, 2013 at 22:40 UTC ( #1011811=perlquestion: print w/replies, xml ) Need Help??
walkingthecow has asked for the wisdom of the Perl Monks concerning the following question:

I am trying to use meryln's code for watching a long process from here. As it is, it works perfectly on one of my systems, yet on another it doesn't work at all. The two systems are entirely different (one is Solaris 10, other is RHEL 6.3; one running Perl 5.8.8, other running perl 5.10.1; both running different apache versions with differing setups).

I do not expect that because it works on system A that it will work on system B. However, I'd like to figure out what is wrong with the script. I have installed Cache::Cache and Digest::MD5. The script runs, but it doesn't seem to pass of the session. What I mean is this: one server A (where script works), I enter host and goes to a new page that refreshes with traceroute results; on server B I enter host and it waits for traceroute to completely finish before going to the next page and showing me the results. I'd just like to figure out why this is the case. My apache logs are completely useless, and I can't run the script at a terminal.

Thanks for taking the time to read my post fellow monks.


Alright, so in the process of debugging (my method was to just throw a bunch of print statements in to see where it was stalling) I somehow got it to work by adding a print statement. Go to merlyn's article for the original code, and below is all I added (and it now works):

} elsif (my $host = param('host')) { # returning to select host if ($host =~ /^([a-zA-Z0-9.\-]{1,100})\z/) { # create a session $host = $1; # untainted now print h1("Yes"); # The line I added, only thing I changed. my $session = get_session_id(); my $cache = get_cache_handle(); $cache->set($session, [0, ""]); # no data yet
Anyone have any idea why that print statement would make it work? Also, after a run through it never even prints "Yes."

Replies are listed 'Best First'.
Re: Debugging cgi-bin script
by davido (Archbishop) on Jan 06, 2013 at 00:47 UTC

    I suspect, given the description of how the behavior differs from one system to the next, combined with the fact that simply adding a 'print' here and there changed the behavior, that you're suffering from buffering. You could try setting The special variable, $| to a true value to disable buffering on STDOUT, or just be sure to flush the output buffer with a newline at appropriate times.


      One of the first things merlyn's script does (and mine as well) is sets $| to true with $|++. I still think it's possible that it could somehow be a buffering issue though.
Re: Debugging cgi-bin script
by Anonymous Monk on Jan 06, 2013 at 01:09 UTC

    Hmm, that should not have fixed anything :) can you post the whole code you used?

    Maybe you omitted autoflush

      Here's the full code:
      #!/usr/local/perl5/bin/perl use strict; use diagnostics; $|++; $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/ +sbin"; use CGI qw(:all delete_all escapeHTML); if (my $session = param('session')) { # returning to pick up session d +ata my $cache = get_cache_handle(); my $data = $cache->get($session); unless ($data and ref $data eq "ARRAY") { # something is wrong show_form(); exit 0; } print header; print start_html(-title => "Traceroute Results", ($data->[0] ? () : (-head => ["<meta http-equiv=refresh content=5>"])) +); print h1("Traceroute Results"); print pre(escapeHTML($data->[1])); print p(i("... working ...")) unless $data->[0]; print end_html; } elsif (my $host = param('host')) { # returning to select host if ($host =~ /^([a-zA-Z0-9.\-]{1,100})\z/) { # create a session $host = $1; # untainted now print h1("Yes"); my $session = get_session_id(); my $cache = get_cache_handle(); $cache->set($session, [0, ""]); # no data yet if (my $pid = fork) { # parent does delete_all(); # clear parameters param('session', $session); print redirect(self_url()); } elsif (defined $pid) { # child does close STDOUT; # so parent can go on unless (open F, "-|") { open STDERR, ">&=1"; exec "/usr/sbin/traceroute", $host; die "Cannot execute traceroute: $!"; } my $buf = ""; while (<F>) { $buf .= $_; $cache->set($session, [0, $buf]); } $cache->set($session, [1, $buf]); exit 0; } else { die "Cannot fork: $!"; } } else { show_form(); } } else { # display form show_form(); } exit 0; sub show_form { print header, start_html("Traceroute"), h1("Traceroute"); print start_form; print submit('traceroute to this host:'), " ", textfield('host'); print end_form, end_html; } sub get_cache_handle { require Cache::FileCache; Cache::FileCache->new ({ namespace => 'traceroute', username => 'nobody', default_expires_in => '30 minutes', auto_purge_interval => '4 hours', }); } sub get_session_id { require Digest::MD5; Digest::MD5::md5_hex(Digest::MD5::md5_hex(time().{}.rand().$$)); }

        This may be a bit off topic, but...

        Designing your own random number generator in a high-level language is a terrible, terrible idea. There just isn't any way for a normal process to get access to as much entropy as the operating system can gather from timing I/O completions.

        How many bits of entropy are actually in the return from get_session_id? Let's add it up: essentially nothing from the call to time() (because the attacker knows what time it is), about 13 bits from the memory address from {} (estimated on perl 5.14.3 on Linux 3.6), 32 bits from the call to rand() (because an strace shows that perl seeded it by reading four bytes from /dev/urandom), and 15 bits at most from $$ (unless you change /proc/sys/kernel/pid_max and start a lot of processes on your system).

        That's at most 60 bits of randomness that get_session_id tries to magically inflate into 128 bits by calling Digest::MD5::md5_hex a second time. Whatever the second call was intended to do, it's not going to be able to do it.

        Both Solaris and RHEL have had /dev/urandom for a long time; it became standard in Solaris 9 in 2002 and was available as a patch since 2.6 in 1997. It's been standard in every release of RHEL, and was in the old pre-RHEL Red Hat since 4.0 in 1996.

        To make sure your /dev/urandom is working, try

        od -x /dev/urandom | head

        To use it in your script, try this:

        sub get_session_id { require Digest::MD5; open my $ur, "<", "/dev/urandom" or die "Cannot open /dev/urandom, $!"; my $buflen = sysread( $ur, my $buf, 16 ); defined $buflen or die "Failed to read /dev/urandom, $!"; $buflen == 16 or die "Tried to read 16 bytes from /dev/urandom but got $bufl +en"; Digest::MD5::md5_hex( $buf ); }

        Incidentally, never use /dev/random instead of /dev/urandom in this application. For a web server, it exposes the server to a denial-of-service attack where the attacker removes entropy from the system-wide pool, by starting new sessions, faster than entropy is added to the pool, by (mostly) I/O completions.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1011811]
Approved by Corion
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (5)
As of 2017-07-22 11:12 GMT
Find Nodes?
    Voting Booth?
    I came, I saw, I ...

    Results (338 votes). Check out past polls.