
# This server will bind to a port allowing remote clients
# to connect and issues requests.  At present, the clients
# are submission tool users and remote software adminstrators
# using the communications package. 

require "flush.pl";
use Socket;
use POSIX ":sys_wait_h";

$| = 1; # for non-buffered I/O 

$netBufferSize = 8192;

#
# Create socket 
#

$sockaddr = 'S n a4 x8';
$proto = getprotobyname('tcp');
socket(Server, PF_INET, SOCK_STREAM, $proto)               || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!";

#
# Port to listen on
#

$port = $ARGV[0];
$port = 1111 unless $port; 

#
# Hostname of machine
#

chop($hostname = `hostname`);

#
# Bind socket to port
#

$sockaddr = 'S n a4 x8';
$ATTEMPT = 1;
while (!$STARTED && ($ATTEMPT < 30)) {
  $paddr = pack($sockaddr, PF_INET, $port, INADDR_ANY);
  if (bind(Server, $paddr)) {
    $STARTED = 1;
  } else {
    $ATTEMPT++;
    print "Cannot bind to port $port!\n";
    sleep 60;
  }
}

if ($STARTED == 0) {
  print "Giving up.\n";

  open(MAIL, "|sendmail -oi -t") or print "Cannot send mail warning...\n"; 
  print MAIL <<END;
To: $ENV{SERVER_ADMIN} 
From: NEOS Socket Server 
Subject: WARNING
Reply-to: $ENV{SERVER_COMMENTS}
Could not bind to port $port for past half hour.
Given up.
END

  close(MAIL);
  exit 0;
}


#
# Wait for connections from clients. Once a client connects, a
# fork will be issued so that the child can satisfy the request
# and the parent can wait for more connections.
#

print "$ENV{SERVER_NAME} server accepting connections on $hostname port $port.\n";
listen(Server,50) || die "connect: $!";

for($con = 1;;$con++) {

  ($addr = accept(NS,Server)) || die $!; #This is where we wait for clients.

  $PID{$con} = fork();

  if ($PID{$con}!=0) {

    # This is the parent process.

    close(NS);

    sleep 1;
    # wait for any children to avoid "zombies"
 
    foreach $key (keys %PID) {
      if (waitpid($PID{$key}, &WNOHANG)) {
        delete $PID{$key};
      }
    }

  } else {
    
    close(Server);
    # This is the child process.

    # Connection will time out after one week.

    $SIG{"ALRM"} = 'handler';

    # IP of client

    ($af, $port, $iaddr) = unpack($sockaddr, $addr);
    $HOST = gethostbyaddr($iaddr, AF_INET);
    @iaddr = unpack('C4', $iaddr);
    foreach $IP_PART (@iaddr) {
      $IP .= "$IP_PART.";
    }
    chop($IP);
    $HOST = $IP unless ($HOST =~ /\S+/); 
    
    # All connecting clients *should* give us their username.

    chop($ADDRESS = <NS>);
    $ADDRESS =~ s/(.*)\@.*/$1/; #Old clients give us the whole thing.

    # After the location is read, we process their request.

    chop($_ = <NS>);
    chop($date = `date`);

    unless (/^verify$/) {
      print "$ADDRESS\@$HOST($IP):$date:$_\n"; 
    }

    #
    # incoming job 
    #

    $DATA_IN_FILE  = 0;
    $SIGNAL_SOLVER = 0;

    if (/^begin job (.+)$/) {
      print NS "-1\n"; &flush(NS);
      $size = $1;
      $tmpfile = "$ENV{SERVER_TMP}/$ENV{SERVER_USER}-socket-server-$$";
      open (HANDLE, ">$tmpfile");
      print HANDLE "From: $ADDRESS\@$HOST\n\n";
      for ($i=0;($i+$netBufferSize)<=$size;$i+=$netBufferSize) {
        $numread = read(NS, $_, $netBufferSize);
        if ($numread != $netBufferSize)
        {	
          print NS "Part of submission data lost in transit.  Please resubmit." and die;
        }
        print HANDLE $_;
      }
      if (($size%$netBufferSize) > 0) {
        $numread = read(NS, $_, ($size%$netBufferSize));
        if ($numread != ($size%$netBufferSize))
        {	
          print NS "Part of submission data lost in transit.  Please resubmit.";
          close NS;
          die;
        }
        print HANDLE $_;
      }
      close (HANDLE);
      chdir("$ENV{SERVER_SPOOL}/SOCKET");
      system("mv $tmpfile socksub.$con");
      system("touch DONE.socksub.$con; touch MAIL");
      while (!(-f "socksub.$con.number")) {
        fsleep(0.25);
      }
      chop($number = `cat socksub.$con.number`);
      system("rm -f socksub.$con.number");
      print NS "$number\n"; &flush(NS);
      while (!(-f "$ENV{SERVER_JOBS}/job.$number/job.out")) {
        fsleep(0.25);
      }
      open(TAIL, "$ENV{SERVER_JOBS}/job.$number/job.out") || die;
      $totalRead = 0;
      while(1) {
        do {
          $numRead = read(TAIL, $_, $netBufferSize);
          if ($numRead == 0) {
            open(TAIL, "$ENV{SERVER_JOBS}/job.$number/job.out") || die;
            seek(TAIL,$totalRead,0);
            fsleep(0.25);
          }
          $totalRead += $numRead;
        } while ($numRead == 0);
        $buffer .= $_;
        print NS $_; &flush(NS);
        last if ($buffer =~ /<END_STANDARD_OUT>/);
      }
      close(TAIL);
      $data = "";
    }

    #
    # identity of server
    #

    elsif ($_ eq "verify") {
      $data = "$ENV{SERVER_NAME}";
      
      #
      # comms-<version>.tk
      #

    } elsif (/comms-(.+).tk/) {
      $data = `cat $ENV{SERVER_LIB}/TclTk/comms-$1.tk`;
      $data =~ s/<SERVER_COMMENTS>/\"$ENV{SERVER_COMMENTS}\"/g;
      $data =~ s/<SERVER_NAME>/\"$ENV{SERVER_NAME}\"/g;
      $data =~ s/<SERVER_PORT>/\"$ENV{SERVER_PORT}\"/g;
      $data =~ s/<SERVER_HOST>/\"$ENV{SERVER_HOSTNAME}\"/g;
      if (/comms-(.+).tk.gz$/) {
        $tmpfile = "$ENV{SERVER_TMP}/$ENV{SERVER_USER}-socket-server-$$";
        open(HANDLE, ">$tmpfile");
        print HANDLE "$data";
        close(HANDLE);
        system("gzip $tmpfile");
        $data = `cat $tmpfile.gz`; 
        system("rm -f $tmpfile.gz");
      }

    #
    # disable-backup.pl
    #

    } elsif (/disable-backup-(.+).pl/) {
      $data = `cat $ENV{SERVER_LIB}/Perl/disable-backup-$1.pl`;
      $data =~ s/<SERVER_COMMENTS>/\"$ENV{SERVER_COMMENTS}\"/g;
      $data =~ s/<SERVER_NAME>/\"$ENV{SERVER_NAME}\"/g;	 
      $data =~ s/<SERVER_PORT>/\"$ENV{SERVER_PORT}\"/g;	
      $data =~ s/<SERVER_HOST>/\"$ENV{SERVER_HOSTNAME}\"/g;
      if (/disable-backup-(.+).pl.gz$/) {
        $tmpfile = "$ENV{SERVER_TMP}/$ENV{SERVER_USER}-socket-server-$$";
        open(HANDLE, ">$tmpfile");
        print HANDLE "$data";
        close(HANDLE);
        system("gzip $tmpfile");
        $data = `cat $tmpfile.gz`; 
        system("rm -f $tmpfile.gz");
    }

    #
    # comms-backup.pl
    #

    } elsif (/comms-backup-(.+).pl/) {
      $data = `cat $ENV{SERVER_LIB}/Perl/comms-backup-$1.pl`;
      $data =~ s/<SERVER_COMMENTS>/\"$ENV{SERVER_COMMENTS}\"/g;
      $data =~ s/<SERVER_NAME>/\"$ENV{SERVER_NAME}\"/g;
      $data =~ s/<SERVER_PORT>/\"$ENV{SERVER_PORT}\"/g;
      $data =~ s/<SERVER_HOST>/\"$ENV{SERVER_HOSTNAME}\"/g;
      if (/comms-backup-(.+).pl.gz$/) {
        $tmpfile = "$ENV{SERVER_TMP}/$ENV{SERVER_USER}-socket-server-$$";
        open(HANDLE, ">$tmpfile");
        print HANDLE "$data";
        close(HANDLE);
        system("gzip $tmpfile");
        $data = `cat $tmpfile.gz`; 
        system("rm -f $tmpfile.gz");
      }

    #
    # comms-daemon.pl
    #

    } elsif (/comms-daemon-(.+).pl/) {
      $data = `cat $ENV{SERVER_LIB}/Perl/comms-daemon-$1.pl`;
      $data =~ s/<SERVER_COMMENTS>/\"$ENV{SERVER_COMMENTS}\"/g;
      $data =~ s/<SERVER_NAME>/\"$ENV{SERVER_NAME}\"/g;
      $data =~ s/<SERVER_PORT>/\"$ENV{SERVER_PORT}\"/g;
      $data =~ s/<SERVER_HOST>/\"$ENV{SERVER_HOSTNAME}\"/g;
      if (/comms-daemon-(.+).pl.gz$/) {
        $tmpfile = "$ENV{SERVER_TMP}/$ENV{SERVER_USER}-socket-server-$$";
        open(HANDLE, ">$tmpfile");
        print HANDLE "$data";
        close(HANDLE);
        system("gzip $tmpfile");
        $data = `cat $tmpfile.gz`; 
        system("rm -f $tmpfile.gz");
      }

    #
    # submit-<version>.tk 
    #

    } elsif (/submit-(.+).tk/) {
      $data = `cat $ENV{SERVER_LIB}/TclTk/submit-$1.tk`;
      $data =~ s/<SERVER_COMMENTS>/\"$ENV{SERVER_COMMENTS}\"/g;
      $data =~ s/<SERVER_NAME>/\"$ENV{SERVER_NAME}\"/g;
      $data =~ s/<SERVER_PORT>/\"$ENV{SERVER_PORT}\"/g;
      $data =~ s/<SERVER_HOST>/\"$ENV{SERVER_HOSTNAME}\"/g;
      if (/submit-(.+).tk.gz$/) {
        $tmpfile = "$ENV{SERVER_TMP}/$ENV{SERVER_USER}-socket-server-$$";
        open(HANDLE, ">$tmpfile");
        print HANDLE "$data";
        close(HANDLE);
        system("gzip $tmpfile");
        $data = `cat $tmpfile.gz`; 
        system("rm -f $tmpfile.gz");
      }
    } elsif ($_ =~ /(java-client-(.+)\.jar)/) {
      if($release = glob("$ENV{SERVER_LIB}/java/java-client-*.jar")) {
        if($release =~ /$1$/) {
          $data = "UpToDate";
        } else {
          $data = `cat $release`;
        }
      } else {
        $data = "NA";
      }    

    #
    # submit-main.txt 
    #

    } elsif ($_ eq "submit-main.txt") {
      $data = `cat $ENV{SERVER_LIB}/txt/submit-main.txt`;
      if ($ENV{SERVER_EMAIL_READY}) {
        $SERVER_INTERFACES .= "    E-mail:    Send \"help\" to <SERVER_USER>@<SERVER_HOSTNAME>\n";
      }
      if ($ENV{SERVER_WWW_READY}) {
        $SERVER_INTERFACES .= "    WWW:       <SERVER_WWW_URL>\n";
      }
      $data =~ s/<SERVER_INTERFACES>/$SERVER_INTERFACES/g;
      $data =~ s/<SERVER_COMMENTS>/$ENV{SERVER_COMMENTS}/g;
      $data =~ s/<SERVER_USER>/$ENV{SERVER_USER}/g;
      $data =~ s/<SERVER_NAME>/$ENV{SERVER_NAME}/g;
      $data =~ s/<SERVER_HOSTNAME>/$ENV{SERVER_HOSTNAME}/g;
      $data =~ s/<SERVER_WWW_URL>/$ENV{SERVER_WWW_URL}/g;
      $data =~ s/<SERVER_FTP_URL>/$ENV{SERVER_FTP_URL}/g;
      $data =~ s/<SERVER_INTERFACES>/$ENV{SERVER_FTP_URL}/g;

    #
    # submit-help.txt 
    #

    } elsif ($_ eq "submit-help.txt") {
      $data = `cat $ENV{SERVER_LIB}/txt/submit-help.txt`;
      $data =~ s/<SERVER_INTERFACES>/$SERVER_INTERFACES/g;
      $data =~ s/<SERVER_COMMENTS>/$ENV{SERVER_COMMENTS}/g;
      $data =~ s/<SERVER_USER>/$ENV{SERVER_USER}/g;
      $data =~ s/<SERVER_NAME>/$ENV{SERVER_NAME}/g;
      $data =~ s/<SERVER_HOSTNAME>/$ENV{SERVER_HOSTNAME}/g;
      $data =~ s/<SERVER_WWW_URL>/$ENV{SERVER_WWW_URL}/g;
      $data =~ s/<SERVER_FTP_URL>/$ENV{SERVER_FTP_URL}/g;
      $data =~ s/<SERVER_INTERFACES>/$ENV{SERVER_FTP_URL}/g;

    #
    # solver config files
    #

    } elsif (/config(\S+)/) {
      $type = $1;
      if ($type =~ /^ADMIN:.*/) {
        $data = `cat $ENV{SERVER_ADMIN_SOLVERS}/$type/config 2>/dev/null`;
      } else {
        $data = `cat $ENV{SERVER_SOLVERS}/$type/config 2>/dev/null`;
      }

    #
    # solver help files
    #

    } elsif (/help(\S+)/) {
      $type = $1;
      if ($type =~ /^ADMIN:.*$/) {
        $data = `cat $ENV{SERVER_ADMIN_SOLVERS}/$type/submission-tool-help`;
      } else {
        $data = `cat $ENV{SERVER_SOLVERS}/$type/submission-tool-help`;
      }

    #
    # available solvers 
    #

    } elsif (/^(solver|admin)_list$/ ) {
      if($ENV{SERVER_SOLVER_GROUPS}) {
        if(open(IN, "$ENV{SERVER_VAR}/lib/feature_tree")) {
          while(<IN>) {
            if(/^(.+)=(\S+)/) {
              $featureName{$2} = $1;
            }
          }
          close IN;
        }
      }
      if ($1 eq "admin") {
#edit by dolan to allow for whitespace issues in trees
        chomp($data  = `cat $ENV{SERVER_VAR}/lib/solver_tree`);
        $data .= "\n";
        chomp($data  = $data.`cat $ENV{SERVER_LIB}/admin_tree`); 
        $data .= "\n";
        chomp(@LIST  =  `cat $ENV{SERVER_VAR}/lib/solver_list`);
        chomp(@LIST  = (@LIST, `cat $ENV{SERVER_LIB}/admin_list`)); 
      } else {
        chomp($data  = `cat $ENV{SERVER_VAR}/lib/solver_tree`);
        $data .= "\n";
        chomp(@LIST =  `cat $ENV{SERVER_VAR}/lib/solver_list`);
      }
      $data =~ s/(.*)=kestrel_(.*)\n//ig;
      $data .= "BEGIN SOFTWARE\n";
      foreach $ITEM (@LIST) {
        $ITEM  =~ /(.+)=(.+)/;
        $TITLE = $1;
        $TOKEN = $2;
        #Do not return kestrel solvers
        if( $TOKEN !~ /^KESTREL\_/i) {
          if($ENV{SERVER_SOLVER_GROUPS}) {
            if(open( IN, "$ENV{SERVER_VAR}/lib/solvers/$TOKEN/GROUP")) {
              chomp($TITLE = <IN>);
              close IN;
              $TITLE =~ s/\s//g;
              $TITLE .= " ";
              if(open(IN, "$ENV{SERVER_VAR}/lib/solvers/$TOKEN/ACCEPTS")) {
                chomp($ACCEPTS = <IN>);
                close IN;
                $ACCEPTS =~ s/OTHER<ACCEPTS>//;
                @ACC = split '<ACCEPTS>', $ACCEPTS;
                foreach $accepted (@ACC) {
                  if($accepted =~ /^\s*$/) {
                    next;
                  }
                  $feature = "";
                  if(defined($featureName{$accepted})) {
                    $feature = $featureName{$accepted};
                  }
                  if($feature !~ /^\s*$/) {
                    $TITLE .= "[$feature]";
                  }
                }
              }
              if(open(IN, "$ENV{SERVER_VAR}/lib/solvers/$TOKEN/OTHER_FEATURES")) {
                chomp($OTHER = <IN>);
                close IN;
                $TITLE .= "[$OTHER]";
              }
            }
          }
          $data .= "$TITLE=$TOKEN\n";
        }
      }
      
    #
    # This next section deals with requests from the remote comms. packages 
    #

    # tarred up user data

    } elsif (/^dir\s*(\d+)$/) {
      chdir("$ENV{SERVER_JOBS}/job.$1");
      $type = `cat job.type`;
      @config = `cat $ENV{SERVER_SOLVERS}/$type/config`;
      foreach $line (@config) {
        chop($line);
        @data = split(/:/,$line);
        $files .= " $data[4]" if (-f "$data[4]");
      }
      $files .= " FORWARD" if (-f "FORWARD");
      system("tar -cf data.tar $files");
      system("gzip data.tar"); 
      $data = "$ENV{SERVER_JOBS}/job.$1/data.tar.gz";
      $DATA_IN_FILE = 1;

    # outgoing job results to client

    } elsif (/^get results (.+)$/) {
      $number = $1;
      @statList = stat("$ENV{SERVER_JOBS}/job.$number/job.results"); 
      $size = $statList[7];
      print NS "$size\n"; &flush(NS);
      $data = "$ENV{SERVER_JOBS}/job.$number/job.results";
      $DATA_IN_FILE  = 1;
      $SIGNAL_SOLVER = 1;
      
    # incoming job results from comms 

    } elsif (/^begin results (.+) (.+)$/) {
      $size   = $1;
      $number = $2;
      open (HANDLE, ">>$ENV{SERVER_JOBS}/job.$number/job.results");
      for ($i=0;($i+$netBufferSize)<=$size;$i+=$netBufferSize) {
        read(NS, $_, $netBufferSize);
        print HANDLE $_;
      }
      if (($size%$netBufferSize) > 0) {
        read(NS, $_, ($size%$netBufferSize));
        print HANDLE $_;
      }
      close (HANDLE);
      $data = "";
      system("$^X $ENV{SERVER_BIN}/job_end.pl $number 2>> $ENV{SERVER_VAR}/logs/jobs");
      
    # port registration for comms-daemon 

    } elsif (/^register (\S+) (\S+) (\d+)/i) {
      $parse_line = $_;
      $STATION  = $HOST; 
      while ($parse_line =~ /^register (\S+) (\S+) (\d+)/i) {
        $TYPE     = $1; $PASSWORD = $2; 
        $PORT  = $3;
        $TYPE = "\U$TYPE";
        $TYPE =~ s/\s//g; 
        REGISTER: {
          unless (-d "$ENV{SERVER_SOLVERS}/$TYPE") {
            $data  .= "$ENV{SERVER_NAME}: ERROR: Software \"$TYPE\" was not found or is disabled.\n";
            $data .= "$ENV{SERVER_NAME}: $TYPE Did you register your software with $ENV{SERVER_NAME}?\n";
            last REGISTER;
          }
          chop($PASS = `cat $ENV{SERVER_SOLVERS}/$TYPE/PASSWORD`);
          unless ($PASS eq $PASSWORD) {
            $data .= "$ENV{SERVER_NAME}: **ERROR** Incorrect password for \"$TYPE\"\n";
            last REGISTER;
          }
          $FOUND = 0;
          chomp(@station_list = `cat $ENV{SERVER_SOLVERS}/$TYPE/STATIONS`);
          foreach $item (@station_list) {
            $item =~ s/\s+\d+//;
            $item =~ s/\s+//g;
            if ($item eq $STATION) {
              $FOUND = 1;
              last; 
            }
          }
          unless ($FOUND) {
            $data .= "$ENV{SERVER_NAME}: ERROR: $STATION is not registered with $TYPE\n";
            last REGISTER;
          }
          $data .= "$ENV{SERVER_NAME}: $STATION registered for $TYPE with port $PORT.\n";
          open(HANDLE, ">$ENV{SERVER_SPOOL}/PORTS/$con"); 
          print HANDLE "$STATION:$TYPE:$PORT\n";
          close(HANDLE);
          rename("$ENV{SERVER_SPOOL}/PORTS/$con", "$ENV{SERVER_SPOOL}/PORTS/port_update.$TYPE$con");
        }
        $parse_line =~ s/^register (\S+) (\S+) (\d+)/register/i;  
      }
      open(TOUCH, ">$ENV{SERVER_SPOOL}/PORTS/UPDATE");
      close TOUCH;

      #
      # deport - remove solver station:port from those registered 
      #

    } elsif (/^deport (.+) (.+) (.+) (.+)$/i) {
      $TYPE     = $1; $PASSWORD = $2; 
      $STATION  = $3; $PORT  = $4;
      $TYPE = "\U$TYPE";
      $TYPE =~ s/\s//g; 

      $data = "$ENV{SERVER_NAME}: deleted port registration for $TYPE on $STATION $PORT.\n";
      
      open(HANDLE, ">$ENV{SERVER_SPOOL}/PORTS/$con");
      print HANDLE "$STATION:$TYPE:$PORT\n";
      close(HANDLE);
      rename("$ENV{SERVER_SPOOL}/PORTS/$con", "$ENV{SERVER_SPOOL}/PORTS/port_delete.$con");
      open(TOUCH, ">$ENV{SERVER_SPOOL}/PORTS/UPDATE");
      close TOUCH;

      #
      # ignore the request 
      #
    } else {
      print "ERROR: \"$_\" is not recognized by this server.\n";
      $data = "$ENV{SERVER_NAME}: ERROR: \"$_\" is not recognized by this server.\n";
    } 

    # output reply on socket and close connection 

    if ($DATA_IN_FILE) {
      @statList = stat("$ENV{SERVER_JOBS}/job.$number/job.results"); 
      $size = $statList[7];
      print NS "$size\n"; 
      open(data_handle, "$data") or die "Could not open file $data\n";
      while (read(data_handle,$buffer,$netBufferSize)>0) {
        print NS $buffer; 
      }
      close(data_handle);
    } else {
      if (length($data)) { 
        if ($noSize) {
          print NS $data; 
        } else {
          $size = length($data); 
          print NS "$size\n"; 
          print NS $data; 
        }
      }
    }
    close(NS);
    alarm(0);
    exit(0);
  }
} 

sub handler {
  print "$ADDRESS@$HOST timed out.\n"; 
  print NS "$ENV{SERVER_NAME}: Connection timed out.\n"; 
  close(NS);
  exit 0;
}

sub fsleep {
  select(undef, undef, undef, $_[0]);
}
