You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 

138 lines
3.5 KiB

###############################################################
# Driverlib.pm - A package of helper functions for Perl drivers
#
# Copyright (c) 2005 David R. O'Hallaron, All rights reserved.
###############################################################
package Driverlib;
use Socket;
# Autogenerated header file with lab-specific constants
use lib ".";
use Driverhdrs;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
driver_post
);
use strict;
#####
# Public functions
#
#
# driver_post - This is the routine that a driver calls when
# it needs to transmit an autoresult string to the result server.
#
sub driver_post ($$) {
my $userid = shift; # User id for this submission
my $result = shift; # Autoresult string
my $autograded = shift; # Set if called by an autograder
# Echo the autoresult string to stdout if the driver was called
# by an autograder
if ($autograded) {
print "\n";
print "AUTORESULT_STRING=$result\n";
return;
}
# If the driver was called with a specific userid, then submit
# the autoresult string to the result server over the Internet.
if ($userid) {
my $status = submitr($Driverhdrs::SERVER_NAME,
$Driverhdrs::SERVER_PORT,
$Driverhdrs::COURSE_NAME,
$userid,
$Driverhdrs::LAB,
$result);
# Print the status of the transfer
if (!($status =~ /OK/)) {
print "$status\n";
print "Did not send autoresult string to the result server.\n";
exit(1);
}
print "Success: Sent autoresult string for $userid to the result server.\n";
}
}
#####
# Private functions
#
#
# submitr - Sends an autoresult string to the result server
#
sub submitr ($$$$$$) {
my $hostname = shift;
my $port = shift;
my $course = shift;
my $userid = shift;
my $lab = shift;
my $result = shift;
my $internet_addr;
my $enc_result;
my $paddr;
my $line;
my $http_version;
my $errcode;
my $errmsg;
# Establish the connection to the server
socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
$internet_addr = inet_aton($hostname)
or die "Could not convert $hostname to an internet address: $!\n";
$paddr = sockaddr_in($port, $internet_addr);
connect(SERVER, $paddr)
or die "Could not connect to $hostname:$port:$!\n";
select((select(SERVER), $| = 1)[0]); # enable command buffering
# Send HTTP request to server
$enc_result = url_encode($result);
print SERVER "GET /$course/submitr.pl/?userid=$userid&lab=$lab&result=$enc_result&submit=submit HTTP/1.0\r\n\r\n";
# Get first HTTP response line
$line = <SERVER>;
chomp($line);
($http_version, $errcode, $errmsg) = split(/\s+/, $line);
if ($errcode != 200) {
return "Error: HTTP request failed with error $errcode: $errmsg";
}
# Read the remaining HTTP response header lines
while ($line = <SERVER>) {
if ($line =~ /^\r\n/) {
last;
}
}
# Read and return the response from the result server
$line = <SERVER>;
chomp($line);
close SERVER;
return $line;
}
#
# url_encode - Encode text string so it can be included in URI of GET request
#
sub url_encode ($) {
my $value = shift;
$value =~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
return $value;
}
# Always end a module with a 1 so that it returns TRUE
1;