#!/usr/local/bin/perl -w # # Original version: Karen Kenny # # Multi-server version: J.E. Fritz # # Changes: # # 1-Feb-1995 Use vanilla 5.001m Socket.pm # # 20-Nov-1997 Eliminate opal, add hercules # # 22-Jan-1999 Eliminate griffin/sphinx/cyclops add xena, physio # %::hosts= ('electro.psi.vcu.edu' => 5010, 'physio.psi.vcu.edu' => 5010, 'hercules.vcu.edu' => 1, 'xena.vcu.edu' => 1); my $defaulthost= 'hercules.vcu.edu'; use strict; chdir '/tmp'; sub abandon; # Print headers and flush buffer BEGIN {$|= 1; print "Content-type: text/html\r\n\r\n"; $!= 0} close(STDERR); open(STDERR,">&".fileno(STDOUT)); my $opcode= $ENV{'PATH_INFO'} || '/print_form'; if ($opcode eq '/print_form') { &print_form; } elsif ($opcode eq '/process_form') { &process_form; } elsif ($opcode eq '/load_average') { &load_average; } else {abandon("Sorry, unknown request type: $opcode.")} exit; sub print_form { my $localhost = `hostname`; chop $localhost; my ($h,@opt,$found_local); $found_local= 0; foreach $h (keys(%::hosts)) { if ($h eq $localhost) { $found_local= 1; push(@opt,'
'); } elsif ($h eq $defaulthost) { push(@opt,'
') } else {push(@opt,'
')} push(@opt,$h,"\n"); } my $script_name = $ENV{'SCRIPT_NAME'}; while (
) { s/\$SCRIPT_NAME(\W)/$script_name$1/; if (s/^\s*\$HOSTS\s*$//) { print '
',@opt,'
'; } print; } } sub server; sub process_form { my ($buffer,@pairs,$pair,$name,$value,%FORM); # Get the input $buffer= ''; # shut up -w read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); # Split the name-value pairs @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); # Un-Webify plus signs and %-encoding $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $FORM{$name} = $value; } $FORM{'mxcode'} or abandon('Sorry, no MX code found.'); my $host= $FORM{'host'}; if ($host eq 'localhost') { open(MXI,"|/home/neale/bin/mxhtml"); print MXI $FORM{'mxcode'},"\n"; close MXI; } else { my $port = $::hosts{$host} or abandon('Sorry, $host is not on the interactive MX list.'); server($host,$port,$FORM{'mxcode'}); } } sub server { use Socket; my ($remote,$port,$mxcode) = @_; my ($localhost, $rmt, $lcl, $proto, $line); chop($localhost = `hostname`); my $sockaddr= 'S n a4 x8'; $proto = getprotobyname('tcp'); ($lcl= gethostbyname($localhost) and $lcl= pack($sockaddr,AF_INET,0,$lcl) and socket(SOCK, PF_INET, SOCK_STREAM, $proto) and bind(SOCK,$lcl) ) or abandon("TCP/IP error: $!"); ($rmt= gethostbyname($remote) and $rmt= pack($sockaddr,AF_INET,$port,$rmt) and connect(SOCK, $rmt) ) or abandon("Can't connect to $remote: $!"); open(SOCKIN,"<&".fileno(SOCK)) or abandon("Can't open $remote for input: $!"); my $oldfh= select(SOCK) or abandon("Internal error: $!"); $|= 1; {no strict 'refs'; select($oldfh)} print SOCK "mxhtml\r\n"; $line=
; if ($line =~ /^\+/) { print SOCK length($mxcode),"\r\n",$mxcode,"\r\n"; while ($line=
) {print STDOUT $line} } close (SOCK) } sub load_average { print <
Load Averages
Load Averages
Load
refers to the number of jobs which are waiting for the computer to become available so they can run. For each machine the numbers below give the average load over the last 1, 5, and 15 minutes.
DONEHEADER open(RUP,"rup ".join(' ',keys(%::hosts))."|") or abandon("Sorry -- can't execute rup command."); while (
) { if (/\s*(\S+)/) { print "\n
$1
"; if (/(load average\:.*$)/) {print $1} else {print 'No information found'} } } print "\n
