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
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;
|
|
|