#!/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;