PERL Apache Realtime Output From Script

admin — Tue, 22 Jun 2010 13:10:14 +0000

As of Apache 1.3, CGI scripts are essentially not buffered. Every time your script does a “flush” to output data, that data gets relayed on to the client. Some scripting languages, for example Perl, have their own buffering for output – this can be disabled by setting the $| special variable to 1. Of course this does increase the overall number of packets being transmitted, which can result in a sense of slowness for the end user.
CGI scripts that generate their own headers are called nph (non-parsed headers) scripts. The server must know in advance whether the particular CGI script intends to return a complete set of headers. Web servers handle this differently, but most recognize CGI scripts with a nph- prefix in their filename.
When sending complete headers, you must at least send the status line plus the Content-type and Server headers. You must print the entire status line; you should not print the Status header. As you will recall, the status line includes the protocol and version string (e.g., “HTTP/1.1″), but as you should recall, CGI provides this to you in the environment variable SERVER_PROTOCOL. Always use this variable in your CGI scripts, instead of hardcoding it, because the version in the SERVER_PROTOCOL may vary for older clients.
For example the next perl script, is using telnet to connect to remote host and is executing traceroute. ( The source of this script is taken from freshmeat’s looking glass project). The most important lines are from 2 to 5. This script is using “Content-type: text/plain”, if you plan to use html tags chenged to “Content-type: text/html”.
$| – If set to nonzero, forces a flush after every write or print.
Example of nph-realtime-output.pl

#!/usr/bin/perl
print "$ENV{SERVER_PROTOCOL} 200 OK\n";
print "Server: $ENV{SERVER_SOFTWARE}\n";
print "Content-type: text/plain\n\n";
$|=1;
use Net::Telnet;
$login="MyLogin";
$password="MySecret";
$port="23";
$host="xxx.xxx.xxx.xxx";
$command="traceroute www.google.com | no-more";
$telnet = new Net::Telnet;
$telnet->errmode( sub { print "ERROR:" . join('|', @_) . "\n"; } );
$telnet->timeout('10');
$telnet->option_callback( sub { return; } );
$telnet->option_accept(Do => 31);
$telnet->open(Host => $host, Port => $port);
if ($login ne "") {
  $telnet->waitfor('/(ogin|name|word):.*$/');
  $telnet->print("$login");
}
if ($password ne "") {
    $telnet->waitfor('/word:.*$/');
    $telnet->print("$password");
}
$telnet->waitfor(Match => '/.*[\$%>] {0,1}$/',
                 Match => '/^[^#]*[\$%#>] {0,1}$/');
$telnet->telnetmode(0);
$telnet->put(pack("C9",
                  255,                  # TELNET_IAC
                  250,                  # TELNET_SB
                  31, 0, 200, 0, 0,     # TELOPT_NAWS
                  255,                  # TELNET_IAC
                  240));                # TELNET_SE
$telnet->telnetmode(1);
my $telnetcmd = $command;
$telnet->print("$telnetcmd");
$telnet->getline;               # read out command line
while (1) {
  if ($#output >= 0) {
    $_ = shift (@output);
  }
  elsif (! $telnet->eof) {
    my ($prematch, $match) = $telnet->waitfor(Match => '/\n/',
                                              Match => '/[\$%#>] {0,1}$/',
                                              Errmode => "return")
    or do {
    };
    if ($match =~ /[\$%#>] {0,1}$/) {
      $telnet->print("quit");
      $telnet->close;
      last;
    }
    push @output, $prematch . $match;
    next;
  }
  else {
    last;
  }
  print $_;
}

Networking Blog » apache

PERL Apache Realtime Output From Script