TRIMSP/singleTrimSP.cgi

#!/usr/bin/perl
#
# Copyright Zaher Salman 2023-.
# zaher.salman@psi.ch

use strict;
use warnings;
use CGI;
use File::Path qw(make_path remove_tree);
use File::Temp qw(tempfile);
use JSON::PP qw(encode_json);

# The web installer rewrites this path to the selected installed binary.
my $trimsp_bin = "/usr/local/bin/trimspNL";
my $workroot = "/tmp";

my $in = CGI->new;
my $action = $in->param("action") // "run";

if ($action eq "read") {
    my $read_filename = $in->param("fn") // "";
    if ($read_filename !~ m{^/tmp/[A-Za-z0-9_-]+/[A-Za-z0-9_.-]+$}
	|| !-f $read_filename) {
	print "Status: 404 Not Found\r\n";
	print "Content-Type: text/plain; charset=UTF-8\r\n\r\n";
	print "Requested simulation output was not found.\n";
	exit 0;
    }

    open(my $input_file, "<", $read_filename) or do {
	print "Status: 500 Internal Server Error\r\n";
	print "Content-Type: text/plain; charset=UTF-8\r\n\r\n";
	print "Requested simulation output could not be read.\n";
	exit 0;
    };
    print "Content-Type: text/plain; charset=UTF-8\r\n\r\n";
    while (read($input_file, my $buffer, 65536)) {
	print $buffer;
    }
    close($input_file);
    exit 0;
}

if ($action eq "download") {
    my $download_run = $in->param("run") // "";
    my $archive_path = "$workroot/$download_run.tgz";
    if ($download_run !~ /^[A-Za-z0-9_-]+$/ || !-f $archive_path) {
	print "Status: 404 Not Found\r\n";
	print "Content-Type: text/plain; charset=UTF-8\r\n\r\n";
	print "Requested results archive was not found.\n";
	exit 0;
    }

    open(my $archive_file, "<", $archive_path) or do {
	print "Status: 500 Internal Server Error\r\n";
	print "Content-Type: text/plain; charset=UTF-8\r\n\r\n";
	print "Requested results archive could not be read.\n";
	exit 0;
    };
    binmode($archive_file);
    binmode(STDOUT);
    print "Content-Type: application/gzip\r\n";
    print "Content-Disposition: attachment; filename=\"$download_run.tgz\"\r\n";
    print "Content-Length: " . (-s $archive_path) . "\r\n\r\n";
    while (read($archive_file, my $buffer, 65536)) {
	print $buffer;
    }
    close($archive_file);
    exit 0;
}

my $requested_filename = $in->param("fn") // "";
my $rng_type = $in->param("rngType") // "pcg32";

# Accept only the private run path produced by TrimSPweb.js. Restricting both
# path components prevents CGI parameters from selecting arbitrary files.
if ($requested_filename !~ m{^/tmp/([A-Za-z0-9_-]+)/([A-Za-z0-9_.-]+)$}) {
    print "Status: 400 Bad Request\r\n";
    print "Content-Type: application/json\r\n\r\n";
    print encode_json({
	ok => JSON::PP::false,
	phase => "request",
	message => "Invalid simulation filename",
    });
    exit 0;
}

my ($run_name, $file_name) = ($1, $2);
$rng_type = "pcg32" unless $rng_type =~ /^(?:ranlux|pcg32|xoshiro|xoshiro256)$/;

my $work_path = "$workroot/$run_name";
my $filename = "$work_path/$file_name";
my $run_base = $file_name;
$run_base =~ s/\.inp$//;

# Reconstruct submitted file content in numeric line order. CGI parameter
# iteration order is not guaranteed for line10, line11, and later fields.
my @line_parameters = sort {
    ($a =~ /line(\d+)/)[0] <=> ($b =~ /line(\d+)/)[0]
} grep { /^line\d+$/ } $in->param;
my $content = join("\n", map { scalar($in->param($_) // "") } @line_parameters) . "\n";

make_path($work_path, { mode => 0755 }) unless -d $work_path;
open(my $output_file, ">", $filename) or do {
    print "Status: 500 Internal Server Error\r\n";
    print "Content-Type: application/json\r\n\r\n";
    print encode_json({
	ok => JSON::PP::false,
	phase => "write",
	message => "Could not write the submitted simulation file",
    });
    exit 0;
};
print {$output_file} $content;
close($output_file);

my $phase = "save";
my $message = "Saved $file_name";
my $exit_code;
my $archive_url;
my $log_content = "";
my $request_logfile;
my $ok = JSON::PP::true;

if ($filename =~ /_Seq_Results\.dat$/) {
    $phase = "archive";
    unlink("$work_path/edist");

    # Only simulation files live in the run directory. Diagnostic output is
    # captured separately and is therefore excluded from the archive.
    my $archive_path = "$workroot/$run_name.tgz";
    my ($log_handle, $logfile) = tempfile("trimsp-$run_name-XXXXXX", DIR => $workroot, UNLINK => 0);
    close($log_handle);
    $request_logfile = $logfile;
    my $command = "tar -czf '$archive_path' -C '$work_path' . > '$logfile' 2>&1";
    system($command);
    $exit_code = $? == -1 ? 127 : $? >> 8;
    if ($exit_code == 0) {
	$archive_url = "/cgi-bin/singleTrimSP.cgi?action=download&run=$run_name";
	$message = "Created results archive";
	remove_tree($work_path);
    } else {
	$ok = JSON::PP::false;
	$message = "Could not create results archive";
    }
} elsif ($filename !~ /TrimSP\.cfg$/) {
    $phase = "simulation";
    my ($log_handle, $logfile) = tempfile("trimsp-$run_name-XXXXXX", DIR => $workroot, UNLINK => 0);
    close($log_handle);
    $request_logfile = $logfile;

    # All user-derived command components were restricted above. Each request
    # receives a private log file so concurrent users never share output.
    my $command = "cd '$work_path' && timeout 300 '$trimsp_bin' "
	. "'$run_base' '$rng_type' >> '$logfile' 2>&1";
    system($command);
    $exit_code = $? == -1 ? 127 : $? >> 8;
    $ok = JSON::PP::false if $exit_code != 0;
    $message = $exit_code == 0
	? "TRIM.SP-NL completed $run_base"
	: "TRIM.SP-NL failed while running $run_base";
}

# Return at most the latest 64 KiB to the browser and immediately remove the
# temporary server-side copy. Diagnostic logs never enter the results archive.
if ($request_logfile && -f $request_logfile && open(my $log_handle, "<", $request_logfile)) {
    my $log_size = -s $log_handle;
    seek($log_handle, $log_size - 65536, 0) if $log_size > 65536;
    local $/;
    $log_content = <$log_handle> // "";
    close($log_handle);
    unlink($request_logfile);
}

print "Content-Type: application/json\r\n\r\n";
print encode_json({
    ok => $ok,
    phase => $phase,
    message => $message,
    exitCode => $exit_code,
    archiveUrl => $archive_url,
    log => $log_content,
});

exit 0;