Cgiserver.Pl

HomePage>>SourceCode>>PerlSource

A perl script that listens for remote connections, and feeds them thru a named pipe to CGI.MASTER

sunset /root/perl> cat cgiserver.pl    
#!/usr/local/bin/perl
use IO::Socket;

# Delimiter to seperate rows is @AM
$rec_delim=chr(254);
# Delimiter to seperate fields is @VM
$fld_delim=chr(253);

# Start listening on socket 1999
$server = IO::Socket::INET->new([[LocalPort]] => 1999,
                                 Type     => [[SOCK_STREAM]],
                                 Reuse    => 1,
                                 Listen   => 10 )
or die "Couldn't be a server on 1999: $!\n";


open (LOG, ">cgi.log") or die "Cannot open cgi.log: $!\n";

# Turn off buffering on the log filehandle
my $oldfh = select LOG; $| = 1; select $oldfh;

log_msg("Listening on port 1999");

# Keep accepting connections, forever
while ( $client = $server->accept() ) {
   $acc=<$client>;
   chomp($acc);
   if ($acc ne "TRINITY" && $acc ne "SFSI") {
      print $client "<H1>Internal cgi error - must specify an account!</H1>\n";
      log_msg("Internal cgi error - must specify an account!");
      next;
   }
   # Use process id for temp file
   $rr = $$;
   # This is the named pipe that the basic program is monitoring
   $infile = "/samba_share/web/in/$acc/in_from_perl";
   open(INFO, ">$infile") or die "Cannot open $infile: $!\n";

   # Make the named pipe to read from, later
   $outfile = "/samba_share/web/out/$acc/$rr";
   if (system('mknod', $outfile, 'p')) {
      die "mknod $outfile failed: $!\n";
   }
   chmod 0777, $outfile;

   # First, tell CGI.MASTER the place to write its output - the named pipe
   # we just created.  as soon as we send everything, we'll wait for some
   # output from the named pipe
   print INFO $outfile,$rec_delim;

   while(<$client>) {
      chomp;
      if (/^EOF$/) {
         last;
      }
      # Send the data thru the named pipe to CGI.MASTER
      log_msg($_);
      print INFO $_,$rec_delim;
   }
   close(INFO) or die "Cannot close $infile: $!\n";

   # This next line will block until something is sent to the named pipe
   open(OUTF, "<$outfile") or die "Cannot open $outfile: $!\n";

   # Ok, now we've got some data, send it back thru the pipe, to the web server
   # will pass on to the browser... oh, the tangled webs we weave!
   while (<OUTF>) {
      # We undo the messing around with field delims on the way back
      s/$rec_delim/\n/og;
      s/$fld_delim/\n/og;
      # Send the html back thru the net connection
      print $client $_;
   }
   # Finally, get rid of the temporary named pipe
   unlink($outfile) or die "Cannot unlink $outfile:$!\n";

   # Shutdown this network connection
   shutdown($client,2);
}

sub log_msg {
   my ($msg) = @_;
   print LOG scalar localtime, " $msg\n";
}