PERL Apache Realtime Output From Script
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 $_;
}
