Commit 5d32c21c authored by Lev Walkin's avatar Lev Walkin

enhancements

parent 9b395c94
...@@ -17,10 +17,12 @@ $HashProgramPath = 'md5'; # Program to hash the input ...@@ -17,10 +17,12 @@ $HashProgramPath = 'md5'; # Program to hash the input
$DM = 0750; # Directory mode for all mkdirs $DM = 0750; # Directory mode for all mkdirs
$MaxHistoryItems = 5; # Number of items in History $MaxHistoryItems = 5; # Number of items in History
$DynamicHistory = 'yes'; # Full/Short history $DynamicHistory = 'yes'; # Full/Short history
$safeFilename = '^[a-z0-9_-]+[.a-z0-9_-]*$'; # Safe filename $safeFilenameRE = '[a-zA-Z0-9_]+[.a-zA-Z0-9_-]{0,200}'; # Safe filename regex
$safeTimeRE = '[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}';
$ASN1C_Page = 'http://lionet.info/asn1c'; $ASN1C_Page = 'http://lionet.info/asn1c';
$HelpEmail = 'asn1c@lionet.info'; $HelpEmail = 'asn1c@lionet.info';
$defaultUserEmail = 'your@email-for-reply'; $defaultUserEmail = 'your@email-for-reply';
$DataERR = 65; # EX_DATAERR from <sysexits.h>
$warn = '<CENTER><FONT SIZE=+1><B>'; $warn = '<CENTER><FONT SIZE=+1><B>';
$unwarn = '</B></FONT></CENTER>'; $unwarn = '</B></FONT></CENTER>';
...@@ -52,7 +54,7 @@ my $content = ''; # Default content is empty ...@@ -52,7 +54,7 @@ my $content = ''; # Default content is empty
sub IssueRedirect() { sub IssueRedirect() {
$redirect = "<META HTTP-EQUIV=\"Refresh\" " $redirect = "<META HTTP-EQUIV=\"Refresh\" "
. "CONTENT=\"5; URL=$myName\">"; . "CONTENT=\"5; URL=$myName\">";
$redirect_bottom = "<P><CENTER>This page will <A HREF=$ASN1C_Page/asn1c.cgi>disappear</A> in 5 seconds.</CENTER>" $redirect_bottom = "<P><CENTER>This page will <A HREF=$myName>disappear</A> in 5 seconds.</CENTER>"
} }
# If something goes wrong, this function is invoked to display the error message # If something goes wrong, this function is invoked to display the error message
...@@ -64,8 +66,8 @@ sub bark($@) { ...@@ -64,8 +66,8 @@ sub bark($@) {
# Make the directory name containing session files for the given Session ID # Make the directory name containing session files for the given Session ID
sub makeSessionDirName($$) { sub makeSessionDirName($$) {
local $pfx = shift; # Prefix is the name of the top-level directory my $pfx = shift; # Prefix is the name of the top-level directory
local $sid = shift; # Session identifier (md5) my $sid = shift; # Session identifier (md5)
$pfx . '/sessions/' . $sid . '/'; $pfx . '/sessions/' . $sid . '/';
} }
...@@ -73,7 +75,7 @@ sub makeSessionDirName($$) { ...@@ -73,7 +75,7 @@ sub makeSessionDirName($$) {
my $cachedTime; my $cachedTime;
sub isoTime() { sub isoTime() {
return $cachedTime if $cachedTime; return $cachedTime if $cachedTime;
local @tm = localtime(time); my @tm = localtime(time);
$tm[5] += 1900; $tm[5] += 1900;
$tm[4] += 1; $tm[4] += 1;
...@@ -132,9 +134,9 @@ sub prepareChrootEnvironment() { ...@@ -132,9 +134,9 @@ sub prepareChrootEnvironment() {
} }
sub makeArchive($$) { sub makeArchive($$) {
local $TMPDIR = shift; my $TMPDIR = shift;
local $sandbox = shift; my $sandbox = shift;
local $archName = $sandbox . '/+Archive.tgz'; my $archName = $sandbox . '/+Archive.tgz';
if(! -f $archName) { if(! -f $archName) {
system("cd $sandbox && " system("cd $sandbox && "
...@@ -174,7 +176,7 @@ if(defined($tmpEmail)) { ...@@ -174,7 +176,7 @@ if(defined($tmpEmail)) {
} }
if($userEmail ne $previousEmail) { if($userEmail ne $previousEmail) {
# Refresh cookie contents. # Refresh cookie contents.
local $ck = cookie(-name=>'userEmail', my $ck = cookie(-name=>'userEmail',
-value=>$userEmail, -value=>$userEmail,
-path=>'/', -expires=>'+1d'); -path=>'/', -expires=>'+1d');
print "Set-Cookie: " . $ck . "\n"; print "Set-Cookie: " . $ck . "\n";
...@@ -191,7 +193,7 @@ if (defined($tmpHSParam) ...@@ -191,7 +193,7 @@ if (defined($tmpHSParam)
&& $tmpHSParam ne $HistoryShow && $tmpHSParam ne $HistoryShow
&& $tmpHSParam =~ /^(full|short)$/) { && $tmpHSParam =~ /^(full|short)$/) {
$HistoryShow = $tmpHSParam; $HistoryShow = $tmpHSParam;
local $ck = cookie(-name=>'HistoryShow', my $ck = cookie(-name=>'HistoryShow',
-value=>$HistoryShow, -value=>$HistoryShow,
-path=>'/', -expires=>'+1h'); -path=>'/', -expires=>'+1h');
print "Set-Cookie: " . $ck . "\n"; print "Set-Cookie: " . $ck . "\n";
...@@ -224,8 +226,7 @@ unless($session) { ...@@ -224,8 +226,7 @@ unless($session) {
mkdir($sessionDir, $DM) or bark($SandBoxInitFailed); mkdir($sessionDir, $DM) or bark($SandBoxInitFailed);
my $ck = cookie(-name=>'SessionID', -value=>$session, my $ck = cookie(-name=>'SessionID', -value=>$session,
-path=>'/', -expires=>'+1y'); -path=>'/', -expires=>'+1y');
print header(-expires=>'-1y', -cookie=>$ck); print "Set-Cookie: " . $ck . "\n";
$HTTPHeaderGenerated = 1;
} else { } else {
$session =~ s/[^a-f0-9]//ig; $session =~ s/[^a-f0-9]//ig;
bark("Nope, try again") if(length($session) != 32); # cool hacker? bark("Nope, try again") if(length($session) != 32); # cool hacker?
...@@ -235,21 +236,28 @@ unless($session) { ...@@ -235,21 +236,28 @@ unless($session) {
mkdir($sessionDir, $DM) or bark($SandBoxInitFailed) mkdir($sessionDir, $DM) or bark($SandBoxInitFailed)
unless(-d $sessionDir); unless(-d $sessionDir);
local $t = param('time'); my $t = param('time');
local $file = param('file'); my $file = param('file');
local $fetch = param('fetch'); my $fetch = param('fetch');
local $show = param('show'); my $show = param('show');
my $remove = param('remove');
unless(defined($t) && defined($file) unless(defined($t) && defined($file)
&& $t =~ /^[0-9TZ:+-]{14,}$/ && $t =~ /^${safeTimeRE}$/
&& $file =~ /$safeFilename/i) { && $file =~ /^${safeFilenameRE}$/
&& ($fetch eq '' or $fetch =~ /^${safeFilenameRE}$/)
) {
$file = '';
$fetch = ''; $fetch = '';
$show = ''; $show = '';
$remove = '';
} }
if($fetch =~ /$safeFilename/i || $show =~ /^(log|tgz)$/) { if($fetch ne '' or $show =~ /^(log|unber|tgz)$/ or $remove ne '') {
local $sandbox = $sessionDir . '/' . $t . '--' . $file; my $sandbox = $sessionDir . '/' . $t . '--' . $file;
my $targetFile = '';
if($show eq 'tgz') { if($show eq 'tgz') {
local $tarball = makeArchive($TMPDIR, $sandbox); my $tarball = makeArchive($TMPDIR, $sandbox);
defined $tarball defined $tarball
or bark("Cannot create archive [$sandbox]"); or bark("Cannot create archive [$sandbox]");
...@@ -257,21 +265,28 @@ unless($session) { ...@@ -257,21 +265,28 @@ unless($session) {
printf("Content-Encoding: gzip\n\n"); printf("Content-Encoding: gzip\n\n");
exec("cat $tarball"); exec("cat $tarball");
exit(0); exit(0);
} } elsif($show eq 'unber') {
$targetFile = $sandbox . '/+UNBER';
if($show eq 'log') { } elsif($show eq 'log') {
$sandbox .= '/+Compiler.Log'; $targetFile = $sandbox . '/+Compiler.Log';
} elsif($remove ne '') {
print "Status: 303 See Other\n";
print "Location: $myName\n";
print "\n";
rename($sandbox,
$sessionDir . '/' . $t . '-R--' . $file);
exit(0);
} else { } else {
$sandbox .= '/' . $fetch; $targetFile = $sandbox . '/' . $fetch;
} }
open(I, "< " . $sandbox) if($targetFile ne '') {
or bark("Invalid or outdated request: [$sandbox] [$show] $!"); open(I, '< ' . $targetFile)
or bark("Invalid or outdated request $!");
printf "Content-Type: text/plain\n\n"; printf "Content-Type: text/plain\n\n";
while(<I>) { print while <I>;
print;
}
exit(0); exit(0);
} }
}
} }
# #
...@@ -279,7 +294,7 @@ unless($session) { ...@@ -279,7 +294,7 @@ unless($session) {
# #
$transHelp = param('transHelp'); $transHelp = param('transHelp');
if(defined($transHelp) if(defined($transHelp)
&& $transHelp =~ /^([0-9]+)--([0-9TZ:+-]{14,})--([_.a-zA-Z0-9-]+)$/) { && $transHelp =~ /^([0-9]+)--($safeTimeRE)--($safeFilenameRE)$/) {
open(S, "| sendmail -it") open(S, "| sendmail -it")
or bark("Cannot perform help request, " or bark("Cannot perform help request, "
. "please email to the address below"); . "please email to the address below");
...@@ -326,11 +341,10 @@ if($#gotNames != -1 && $gotNames[0] ne "") { ...@@ -326,11 +341,10 @@ if($#gotNames != -1 && $gotNames[0] ne "") {
$gotFile = undef; $gotFile = undef;
} }
my $asnText = param('text');
if($#gotNames == -1) { if($#gotNames == -1) {
my $text = param('text'); push(@gotNames, 'module.asn1') if $asnText;
if($text) {
push(@gotNames, 'module.asn1');
}
} }
# Make safe filenames # Make safe filenames
...@@ -339,7 +353,7 @@ foreach my $fname (@gotNames) { ...@@ -339,7 +353,7 @@ foreach my $fname (@gotNames) {
s/.*\///g; # Strip directory components s/.*\///g; # Strip directory components
s/.*\\//g; # Strip directory components (DOS version) s/.*\\//g; # Strip directory components (DOS version)
s/^[.-]/_/g; # Don't allow filenames starting with a dot or a dash s/^[.-]/_/g; # Don't allow filenames starting with a dot or a dash
s/[^._a-z0-9-]/_/gi; s/[^._a-zA-Z0-9-]/_/g;
if(!length($_)) { if(!length($_)) {
print LOG "\n"; print LOG "\n";
bark("Too strange filename: \"$fname\""); bark("Too strange filename: \"$fname\"");
...@@ -364,14 +378,16 @@ if($#gotSafeNames >= 0) { ...@@ -364,14 +378,16 @@ if($#gotSafeNames >= 0) {
open(O, '> ' . $sandbox . '/+safeNames'); open(O, '> ' . $sandbox . '/+safeNames');
print O join("\n", @gotSafeNames); print O join("\n", @gotSafeNames);
for(my $i = 0; $i <= $#gotSafeNames; $i++) { for(my $i = 0; $i <= $#gotSafeNames; $i++) {
local $name = $gotSafeNames[$i]; my $name = $gotSafeNames[$i];
open(O, '> ' . $sandbox . '/'. $name); open(O, '> ' . $sandbox . '/'. $name);
if($#gotFiles == -1) { if($#gotFiles == -1) {
print O scalar(param('text')); print O $asnText; # param(text)
unlink $sessionDir . '/lastText';
symlink $transactionDir . '/' . $name,
$sessionDir . '/lastText';
} else { } else {
while(<$gotFile>) { # Save the uploaded data into specified file
print O; print O while <$gotFile>;
}
} }
} }
close(O); close(O);
...@@ -391,53 +407,107 @@ if($#gotSafeNames >= 0) { ...@@ -391,53 +407,107 @@ if($#gotSafeNames >= 0) {
$options .= " -fcompound-names" if(defined($optCN) && $optNT eq "on"); $options .= " -fcompound-names" if(defined($optCN) && $optNT eq "on");
my $CompileASN = "$TMPDIR/bin/asn1c -v | sed -e 's/^/-- /'" my $CompileASN = "$TMPDIR/bin/asn1c -v | sed -e 's/^/-- /'"
. " > $sandbox/+Compiler.Log 2>&1" . " > $sandbox/+Compiler.Log 2>&1"
. "; $SUIDHelper $TMPDIR $inChDir $options @gotSafeNames " . "; $SUIDHelper $TMPDIR $inChDir asn1c $options @gotSafeNames "
. " >> $sandbox/+Compiler.Log 2>&1" . " >> $sandbox/+Compiler.Log 2>&1"
. "; echo \$? > $sandbox/+ExitCode"; . "; ec=\$?; echo \$ec > $sandbox/+ExitCode"
system($CompileASN); . "; exit \$ec";
my $ec = (256 * $DataERR); # Simulate EX_DATAERR
my $fType = param('fileType');
# Compile as ASN.1 text
if($fType ne 'ber') {
$ec = system($CompileASN);
bark("Failed to initiate compilation process: $!") bark("Failed to initiate compilation process: $!")
if(!-r $sandbox . '/+ExitCode'); if(!-r $sandbox . '/+ExitCode');
}
if($ec == (256 * $DataERR) and $fType ne 'asn') {
# Unrecognized ASN.1 module format.
# Try out BER decoding.
my $uec = system("$SUIDHelper $TMPDIR $inChDir unber @gotSafeNames > $TMPDIR/$inChDir/+UNBER.tmp 2>&1");
if(($uec == 0 or $fType eq 'ber')
and open(U, "> $TMPDIR/$inChDir/+UNBER")) {
my $fnames = escapeHTML(join(", ", @gotNames));
open(T, "< $TMPDIR/$inChDir/+UNBER.tmp");
print U "<!-- BER structure of $fnames; decoded by 'unber' (c) Lev Walkin <vlm\@lionet.info> -->\n";
print U while <T>;
close(U);
close(T);
}
unlink("$TMPDIR/$inChDir/+UNBER.tmp");
} else {
makeArchive($TMPDIR, $sandbox); makeArchive($TMPDIR, $sandbox);
}
if($ENV{REQUEST_METHOD} ne 'GET') {
print "Status: 303 See Other\n";
print "Location: $myName\n";
}
} }
#print join("<BR>\n", `env`); my $rtt = '';
if(-f $sessionDir . '/lastText') {
if(param('resetText')) {
unlink $sessionDir . '/lastText';
} else {
$rtt = "<BR>&nbsp;&nbsp;[<A HREF=$myName?resetText=ok>refill with sample ASN.1 module text</A>]";
}
}
$form = $form =
"<FORM METHOD=POST ACTION=$myName ENCTYPE=\"multipart/form-data\">" "<FORM METHOD=POST ACTION=$myName ENCTYPE=\"multipart/form-data\">"
. "Pick the ASN.1 module file:<BR>\n" . "<TABLE BORDER=0><TR><TD>&nbsp;</TD><TD COLSPAN=2>"
. "<INPUT TYPE=file NAME=file SIZE=35><BR clear=all>\n" . "Pick the ASN.1 module or binary encoded data file:\n"
. "Or enter the ASN.1 module text into the following area:<BR>\n" . "</TD></TR><TD VALIGN=top><FONT COLOR=green>&rArr;</FONT></TD><TD>"
. "<SELECT NAME=fileType>"
. "<OPTION VALUE=auto>Autodetect type of file ..."
. "<OPTION VALUE=asn>ASN.1 text file ..."
. "<OPTION VALUE=ber>BER/DER/CER data ..."
. "</SELECT>"
. "</TD><TD ALIGN=right>"
. "<INPUT TYPE=file NAME=file SIZE=13>"
. "</TD></TR><TR><TD>&nbsp;</TD><TD COLSPAN=2>"
. "Or paste the ASN.1 text into the following area:$rtt\n"
. "</TD></TR><TD VALIGN=top><FONT COLOR=green>&rArr;</FONT></TD><TD COLSPAN=2>"
. "<TEXTAREA NAME=text ROWS=16 COLS=60>\n" . "<TEXTAREA NAME=text ROWS=16 COLS=60>\n"
. "/*\n" ;
. " * This ASN.1 specification is given for illustrative purposes.\n" if(open(T, '< ' . $sessionDir . '/lastText')) {
. " * Your own ASN.1 module must be properly formed too!\n" $form .= escapeHTML($_) while <T>;
. " * (Make sure it has BEGIN/END statements, etc.)\n" close(T);
. " */\n" } else {
. "TestModule { iso org(3) dod(6) internet(1) private(4)\n" $form .= ""
. " 1 spelio(9363) software(1) asn1c(5) webcgi(2) 1 }\n" . "/*\n"
. "DEFINITIONS ::= BEGIN\n" . " * This ASN.1 specification is given for illustrative purposes.\n"
. "\n" . " * Your own ASN.1 module must be properly formed too!\n"
. " TestType ::= SEQUENCE {\n" . " * (Make sure it has BEGIN/END statements, etc.)\n"
. " num [PRIVATE 1] INTEGER,\n" . " */\n"
. " str UTF8String (SIZE(1..20)) OPTIONAL\n" . "TestModule DEFINITIONS ::= \n"
. " }\n" . "BEGIN\n"
. "\n" . "\n"
. "END\n" . " TestType ::= SEQUENCE {\n"
. "</TEXTAREA><BR>\n" . " num [PRIVATE 1] INTEGER,\n"
. "<P>" . " str UTF8String (SIZE(1..20)) OPTIONAL\n"
. "<FONT SIZE=-1>" . " }\n"
. "\n"
. "END\n"
;
}
$form .= "</TEXTAREA>\n"
. "</TD></TR><TD COLSPAN=3 ID=extrasmall"
. " STYLE=\"border-left: dashed 1px rgb(200, 200, 200);\">\n"
. "These options may be used to control the compiler's behavior:<BR>\n" . "These options may be used to control the compiler's behavior:<BR>\n"
. "<INPUT TYPE=checkbox NAME=optDebugL> Debug lexer (<I>-Wdebug-lexer</I>)<BR>\n" . "<INPUT TYPE=checkbox NAME=optDebugL> Debug lexer (<I>-Wdebug-lexer</I>)<BR>\n"
. "<INPUT TYPE=checkbox NAME=optE> Just parse and dump (do not compile) (<I>-E</I>)<BR>\n" . "<INPUT TYPE=checkbox NAME=optE> Just parse and dump (do not verify) (<I>-E</I>)<BR>\n"
. "<INPUT TYPE=checkbox NAME=optEF> Parse, perform semantic checks, and dump (<I>-E -F</I>)<BR>\n" . "<INPUT TYPE=checkbox NAME=optEF> Parse, verify validity, and dump (<I>-E -F</I>)<BR>\n"
. "<INPUT TYPE=checkbox NAME=optNT CHECKED=on> Employ native machine types (e.g. <b>double</b> instead of <b>REAL_t</b>) (<I>-fnative-types</I>)<BR>\n" . "<INPUT TYPE=checkbox NAME=optNT CHECKED=on> Use native machine types (e.g. <b>double</b> instead of <b>REAL_t</b>) (<I>-fnative-types</I>)<BR>\n"
. "<INPUT TYPE=checkbox NAME=optCN> Prevent name clashes in compiled output (<I>-fcompound-names</I>)<BR>\n" . "<INPUT TYPE=checkbox NAME=optCN> Prevent name clashes in compiled output (<I>-fcompound-names</I>)<BR>\n"
. "<I>... the command line ASN.1 compiler, <A HREF=$ASN1C_Page>asn1c</A>, supports many other parameters</I>." . "<I>... the command line ASN.1 compiler, <A HREF=$ASN1C_Page>asn1c</A>, supports many other parameters</I>."
. "</FONT>" . "</FONT>"
. "<P>\n" . "</TD></TR><TD VALIGN=top><FONT COLOR=green>&rArr;</FONT></TD><TD COLSPAN=2>"
. "<INPUT TYPE=submit VALUE=\"Proceed with ASN.1 compilation\">" . "<INPUT TYPE=submit VALUE=\"Proceed with ASN.1 compilation\">"
. " (<A HREF=$ASN1C_Page>What is ASN.1?</A>)" . " (<A HREF=$ASN1C_Page>What is ASN.1?</A>)"
. "</FORM>"; . "</FORM></TD></TR></TABLE>";
# #
# Gather previous transactions to generate the history page. # Gather previous transactions to generate the history page.
...@@ -447,51 +517,70 @@ $form = ...@@ -447,51 +517,70 @@ $form =
# #
opendir(SD, $sessionDir) or bark("Cannot open sandbox: $!"); opendir(SD, $sessionDir) or bark("Cannot open sandbox: $!");
my @transactions = sort { $b cmp $a } my @transactions = sort { $b cmp $a }
(grep {/^[0-9TZ:+-]{14,}--[_.a-zA-Z0-9-]+$/} (grep {/^${safeTimeRE}(-R)?--${safeFilenameRE}?$/}
readdir(SD)); readdir(SD));
my $CountHistoryItems = 0; my $CountHistoryItems = 0;
my $CountGlobalItems = 0;
my $CountShownItems = 0;
my $fullresp = param("fullresp"); my $fullresp = param("fullresp");
foreach my $trans (sort { $b cmp $a } @transactions) { foreach my $trans (sort { $b cmp $a } @transactions) {
next unless($trans =~ /^([0-9TZ:+-]{14,})--([_.a-zA-Z0-9-]+)$/); $CountGlobalItems++;
next unless($trans =~ /^($safeTimeRE)--($safeFilenameRE)$/);
$CountHistoryItems++;
next if($CountHistoryItems > $MaxHistoryItems
&& $HistoryShow ne 'full');
$CountShownItems++;
local ($t, $f) = ($1, $2); my ($t, $f) = ($1, $2);
local $origTime = $t; my $origTime = $t;
$t =~ s/T/ /; # "1999-01-02T13:53:12" => "1999-01-02 13:53:12" $t =~ s/T/ /; # "1999-01-02T13:53:12" => "1999-01-02 13:53:12"
# Global transaction number # Global transaction number
local $tNum = 1 + $#transactions - $CountHistoryItems; my $tNum = 2 + $#transactions - $CountGlobalItems;
# Open the list of file names under which these files are known # Open the list of file names under which these files are known
# at the remote system. # at the remote system.
open(I, '< ' . $sessionDir . '/' . $trans . '/+Names'); open(I, '< ' . $sessionDir . '/' . $trans . '/+Names');
local @Names = <I>; my @Names = <I>;
# Open the list of "safe" file names under which these files # Open the list of "safe" file names under which these files
# are known to our file system. # are known to our file system.
open(I, '< ' . $sessionDir . '/' . $trans . '/+safeNames'); open(I, '< ' . $sessionDir . '/' . $trans . '/+safeNames');
local @safeNames = <I>; my @safeNames = <I>;
# Create a list of real file names whith appropriate links to the # Create a list of real file names whith appropriate links to the
# "safe" file names for subsequent file fetching. # "safe" file names for subsequent file fetching.
local @markedNames = (); my @markedNames = ();
for(my $i = 0; $i <= $#Names; $i++) { for(my $i = 0; $i <= $#Names; $i++) {
local $_ = "<A HREF=\"$myName?time=" local $_ = "<A HREF=\"$myName?time="
. escapeHTML($origTime) . escapeHTML($origTime)
. "&file=$f" . "&file=$f"
. "&fetch=$safeNames[$i]\">$Names[$i]</A>"; . "&fetch=$safeNames[$i]\" ID=modrefs>"
. escapeHTML($Names[$i])
. "</A>";
@markedNames = (@markedNames, $_); @markedNames = (@markedNames, $_);
} }
local $ec = ''; my $ec = '';
open(I, '< ' . $sessionDir . '/' . $trans . '/+ExitCode') open(I, '< ' . $sessionDir . '/' . $trans . '/+ExitCode')
and chop($ec = <I>); and chop($ec = <I>);
my $resCode = "log";
my $resText = "Show compiler log";
if($ec eq "0") { if($ec eq "0") {
$results = "<FONT COLOR=darkgreen><B>" $results = "<FONT COLOR=darkgreen><B>"
. "Compiled OK</B></FONT><BR>\n"; . "Compiled OK</B></FONT><BR>\n";
} elsif(-f $sessionDir . '/' . $trans . '/+UNBER') {
my $msg = 'This looks like a BER-encoded data';
$msg = "Treating input as BER-encoded data" if $ec eq '';
$results = "<FONT COLOR=darkgreen><B>$msg</B></FONT><BR>\n";
$resText = "Show BER structure";
$resCode = "unber";
$ec = 0;
} else { } else {
my $why = $ec; my $why = $ec;
$why = "<NOBR>Invalid input file</NOBR>" if $ec == 65; $why = "<NOBR>Broken input file</NOBR>" if $ec == $DataERR;
$results = "<FONT COLOR=darkred SIZE=-1>" $results = "<FONT COLOR=darkred SIZE=-1>"
. "<NOBR>ASN.1 compiler error:</NOBR> " . "<NOBR>ASN.1 compiler error:</NOBR> "
. "$why</FONT><BR>\n"; . "$why</FONT><BR>\n";
...@@ -503,20 +592,22 @@ foreach my $trans (sort { $b cmp $a } @transactions) { ...@@ -503,20 +592,22 @@ foreach my $trans (sort { $b cmp $a } @transactions) {
$results .= "<NOBR>" $results .= "<NOBR>"
. ($allowFetchResults ? '1. ' : '') . ($allowFetchResults ? '1. ' : '')
. "<A HREF=\"$myName/$f-$tNum.Log?time=" . "<A HREF=\"$myName/$f-$tNum.$resCode?time="
. escapeHTML($origTime) . escapeHTML($origTime)
. "&file=$f" . "&file=$f"
. "&show=log\">" . "&show=$resCode\">"
. "Show compiler log</A></NOBR>"; . "$resText</A>"
. ($ec ? ' &larr;' : '')
. "</NOBR>";
$results .= "<BR>\n<NOBR>" $results .= "<BR>\n<NOBR>"
. "2. <A HREF=\"$myName/$f-$tNum.tgz?time=" . "2. <A HREF=\"$myName/$f-$tNum.tgz?time="
. escapeHTML($origTime) . escapeHTML($origTime)
. "&file=$f" . "&file=$f"
. "&show=tgz\">" . "&show=tgz\">"
. "Fetch compiled C sources (.tgz)</A></NOBR>" . "Fetch compiled C sources (.tgz)</A> &larr;</NOBR>"
if $allowFetchResults; if $allowFetchResults;
if($ec ne "0") { if($ec ne "0") {
local ($eml, @resp); my ($eml, @resp);
open(H, '< ' . $sessionDir . '/' . $trans . '/+HelpResp') open(H, '< ' . $sessionDir . '/' . $trans . '/+HelpResp')
and @resp = <H>; and @resp = <H>;
open(H, '< ' . $sessionDir . '/' . $trans . '/+HelpReq') open(H, '< ' . $sessionDir . '/' . $trans . '/+HelpReq')
...@@ -524,13 +615,17 @@ foreach my $trans (sort { $b cmp $a } @transactions) { ...@@ -524,13 +615,17 @@ foreach my $trans (sort { $b cmp $a } @transactions) {
if($#resp >= 0) { if($#resp >= 0) {
shift(@resp) while($resp[0] =~ /^$/); shift(@resp) while($resp[0] =~ /^$/);
if($fullresp eq $tNum) { if($fullresp eq $tNum) {
$results .= "<P><B>Analysis:</B><BLOCKQUOTE>"; my $r = join("<BR>", @resp);
$results .= join("<BR>", @resp); $r =~ s/ /&nbsp;/g;
$results .= "<P><B>Analysis:</B>";
$results .= "<BR>(<A HREF=\"$myName\">Hide full explanation</A>)";
$results .= "<BLOCKQUOTE>";
$results .= $r;
$results .= "</BLOCKQUOTE>"; $results .= "</BLOCKQUOTE>";
$results .= "(<A HREF=\"$myName\">Hide full text</A>)"; $results .= "(<A HREF=\"$myName\">Hide full explanation</A>)";
} else { } else {
$results .= "<P><B>Analysis:</B> $resp[0]<BR>"; $results .= "<P><B>Analysis:</B> $resp[0]<BR>";
$results .= "(<A HREF=\"$myName?fullresp=$tNum\">Show full text</A>)"; $results .= "(<A HREF=\"$myName?fullresp=$tNum\">Show full explanation</A>)";
} }
} elsif($eml) { } elsif($eml) {
$results .= "<P><FONT COLOR=darkred Family=Serif><B>" $results .= "<P><FONT COLOR=darkred Family=Serif><B>"
...@@ -539,81 +634,77 @@ foreach my $trans (sort { $b cmp $a } @transactions) { ...@@ -539,81 +634,77 @@ foreach my $trans (sort { $b cmp $a } @transactions) {
. "expect results in a few hours.<B></FONT>"; . "expect results in a few hours.<B></FONT>";
} else { } else {
$results .= '<P>' $results .= '<P>'
. "<FONT SIZE=-2>To get free help, leave a return address:</FONT><BR>" . "To get free help, leave a return address:<BR>"
. "<INPUT TYPE=text NAME=email VALUE=\"$userEmail\"><BR>" . "<INPUT TYPE=text NAME=email VALUE=\"$userEmail\"><BR>"
. "<INPUT TYPE=hidden NAME=transHelp VALUE=\"$tNum--$trans\">" . "<INPUT TYPE=hidden NAME=transHelp VALUE=\"$tNum--$trans\">"
. '<INPUT TYPE=Submit VALUE="Help me fix it!">' . '<INPUT TYPE=Submit VALUE="Help me fix it!">'
. '<!-- <A HREF="mailto:asn1c@lionet.info?Subject=asn1c compiler help: '
. "transaction $tNum ("
. join(', ', @safeNames)
. ") failed with code $ec"
. '&body=leave body empty or add more comments">Help me fix it!</A> (See bottom line) -->'
; ;
$atLeastOneError = 1; $atLeastOneError = 1;
} }
} }
$trColor = ' BGCOLOR=#f8f8f8'; $trColor = ' BGCOLOR=#f8f8f8';
$trColor = ' BGCOLOR=#d0ffe0' unless($CountHistoryItems); $trColor = ' BGCOLOR=#d0ffe0' if $CountHistoryItems == 1;
$tNum = '<I>' . $tNum . '</I>' unless($CountHistoryItems);
$history .= "<TR $trColor>" $history .= "<TR $trColor>"
. "<TH ALIGN=center><FONT FACE=Helvetica SIZE=-2>$tNum</FONT></TH>" . "<TH ALIGN=center ID=num>$tNum"
. "<TD ALIGN=center><FONT SIZE=-1 FACE=Helvetica>" . "<BR><FONT FACE=Serif>[<A ID=modrefs "
. "HREF=\"$myName?time="
. escapeHTML($origTime)
. "&file=$f&remove=$tNum\""
. ">&times;</A>]</FONT>"
. "</TH>"
. "<TD ALIGN=center>"
. join(", ", @markedNames) . join(", ", @markedNames)
. "</FONT></TD>" . "</TD></TD>"
. "<FORM METHOD=POST ACTION=$myName><TD><FONT SIZE=-2 FACE=Helvetica>" . "<FORM METHOD=POST ACTION=$myName><TD ID=extrasmall>"
. $results . $results
. "</TD></FORM>" . "</TD></FORM>"
. "</TR>\n"; . "</TR>"
;
last if(++$CountHistoryItems >= $MaxHistoryItems
&& $HistoryShow ne 'full');
} }
if($DynamicHistory eq 'yes') { if($DynamicHistory eq 'yes') {
# [Un-]limit number of history items # [Un-]limit number of history items
$HistoryItemsHidden = 1 + $#transactions - $CountHistoryItems; $HistoryItemsHidden = $CountHistoryItems - $CountShownItems;
if($HistoryItemsHidden > 0) { if($HistoryItemsHidden > 0) {
# Propose to expand the list. # Propose to expand the list.
local $item = 'item'; my $item = 'item';
$HistoryItemsHidden == 1 or $item = 'items'; $HistoryItemsHidden == 1 or $item = 'items';
$history .= "<TR BGCOLOR=white><TD COLSPAN=3 ALIGN=center>" $history .= "<TR BGCOLOR=white><TD COLSPAN=3 ALIGN=center>"
. "<FONT SIZE=-1><A HREF=\"$myName?history=full\">" . "<A HREF=\"$myName?history=full\">"
. "Show full history</A> " . "Show full history</A> "
. "($HistoryItemsHidden hidden $item)" . "($HistoryItemsHidden hidden $item)"
. "</FONT></TD></TR>\n"; . "</TD></TR>\n";
} elsif($HistoryShow eq "full" && $#transactions >= $MaxHistoryItems) { } elsif($HistoryShow eq "full" && $#transactions >= $MaxHistoryItems) {
# Propose to shorten the list. # Propose to shorten the list.
local $item = 'item'; my $item = 'item';
$MaxHistoryItems == 1 or $item = 'items'; $MaxHistoryItems == 1 or $item = 'items';
$history .= "<TR BGCOLOR=white><TD COLSPAN=3 ALIGN=center>" $history .= "<TR BGCOLOR=white><TD COLSPAN=3 ALIGN=center>"
. "<FONT SIZE=-1><A HREF=\"$myName?history=short\">" . "<A HREF=\"$myName?history=short\">"
. "Short history</A> ($MaxHistoryItems $item)" . "Short history</A> ($MaxHistoryItems $item)"
. "</FONT></TD></TR>\n"; . "</TD></TR>\n";
} }
} }
if($history) { if($history) {
$history = "<H3>History</H3>" $history = "<H3>History</H3>"
. "<TABLE CELLPADDING=0 CELLSPACING=0 BGCOLOR=#404040 WIDTH=100%><TR><TD>" . "<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 BGCOLOR=#404040 WIDTH=100%><TR><TD>"
. "<TABLE BORDER=0 CELLPADDING=5 CELLSPACING=1 WIDTH=100%>\n" . "<TABLE BORDER=0 CELLPADDING=5 CELLSPACING=1 WIDTH=100%>\n"
. "<TR BGCOLOR=#e0f0d0>" . "<TR BGCOLOR=#e0f0d0>"
. "<TH WIDTH=1%><FONT COLOR=#404040 FACE=Courier>N</FONT></TH>" . "<TH WIDTH=1%>N</TH><TH>Files processed</TH><TH>Result</TH>\n"
. "<TH><FONT COLOR=#404040 FACE=Courier>Files processed</FONT></TH>"
. "<TH><FONT COLOR=#404040 FACE=Courier>Result</FONT></TH>"
. "</TR>\n" . "</TR>\n"
. $history . "</TABLE></TD></TR></TABLE><BR>\n"; . $history . "</TABLE></TD></TR></TABLE><BR>\n";
if($atLeastOneError) { if($atLeastOneError) {
$history .= "<FONT SIZE=-1 COLOR=#404040>" $history .= "<FONT COLOR=#404040>"
. "<FONT COLOR=darkred><B>Bottom line:</B> ASN.1 compiler was unable to process some of the input files.</FONT><BR>" . "<FONT COLOR=darkred><B>Bottom line:</B> ASN.1 compiler was unable to process some of the input.</FONT><BR>"
. "This is typically caused by syntax errors in the input files.\n" . "This is typically caused by syntax errors in the input files.\n"
. "Such errors are normally fixed by removing or adding a couple of characters in the ASN.1 module.<BR>\n" . "Such errors are normally fixed by removing or adding a couple of characters in the ASN.1 module.<BR>\n"
. "<BR><B><FONT COLOR=darkred>Please consider clicking on the appropriate &quot;<I>Help me fix it!</I>&quot; button above.</FONT></B><BR>\n" . "<BR><B><FONT COLOR=darkred>Please consider clicking on the appropriate &quot;<I>Help me fix it!</I>&quot; button above.</FONT></B><BR>\n"
. "An email will be sent to a person who will gladly fix the ASN.1 module for you. (The typical turn-around time is less than 24 hours.)\n" . "An email will be sent to a live person who will fix the ASN.1 module for you. (The typical turn-around time is less than 24 hours.)\n"
. "<BR>This is <B>free</B>, and highly advisable.\n" . "<BR>This is <B>free</B>, and highly advisable.\n"
. "Your request will help us make a better compiler!\n" . "<BR>Your request will help us make a better compiler!\n"
. "<BR>Thank you." . "<BR>Thank you."
. "</FONT>"; . "</FONT>";
} }
...@@ -633,11 +724,10 @@ $content .= ...@@ -633,11 +724,10 @@ $content .=
. "$form" . "$form"
. "</TD><TD WIDTH=60% HEIGHT=50% ALIGN=center VALIGN=$histValign>$history \n" . "</TD><TD WIDTH=60% HEIGHT=50% ALIGN=center VALIGN=$histValign>$history \n"
. "</TD></TR><TR><TD HEIGHT=50% VALIGN=bottom>" . "</TD></TR><TR><TD HEIGHT=50% VALIGN=bottom>"
. "<FONT SIZE=-1><B>Privacy Note:</B> this page is tailored " . "<B>Privacy Note:</B> this page is tailored "
. "to your browser using a cryprographically strong cookie. " . "to your browser using a cryprographically strong cookie. "
. "<I>Other users will see their own (different) data.</I> " . "<I>Other users will see their own (different) data.</I> "
. "(<A HREF=asn1c-privacy.html>Read more...</A>)" . "(<A HREF=asn1c-privacy.html>Read more...</A>)"
. "</FONT>"
. "</TD></TR></TABLE>"; . "</TD></TR></TABLE>";
$ua = $ENV{HTTP_USER_AGENT}; $ua = $ENV{HTTP_USER_AGENT};
...@@ -648,7 +738,7 @@ print LOG "\n"; # Finalize logging record ...@@ -648,7 +738,7 @@ print LOG "\n"; # Finalize logging record
PRINTOUT: PRINTOUT:
print header(-expires=>'-1y') unless($HTTPHeaderGenerated); print header(-expires=>'-1y');
# If environment has never been set up completely, remove it. # If environment has never been set up completely, remove it.
if($EnvironmentSetOK != 1 && $TMPDIR ne "/") { if($EnvironmentSetOK != 1 && $TMPDIR ne "/") {
...@@ -662,9 +752,36 @@ print<<EOM; ...@@ -662,9 +752,36 @@ print<<EOM;
<META NAME="Description" CONTENT="Free Online ASN.1 Compiler"> <META NAME="Description" CONTENT="Free Online ASN.1 Compiler">
$redirect $redirect
<STYLE TYPE="text/css"> <STYLE TYPE="text/css">
TH {
font-size: 11pt;
color: #404040;
font-family: monospace;
}
TH#num {
font-size: 8pt;
font-family: sans-serif;
}
TD {
font-size: 10pt;
font-family: sans-serif;
}
TD#inputbox { TD#inputbox {
border-right: dashed 1px rgb(200, 200, 200); border-right: dashed 1px rgb(200, 200, 200);
} }
TD#extrasmall {
font-size: 8pt;
font-family: sans-serif;
}
A#modrefs {
color: #606060;
text-decoration: none;
}
A:hover#modrefs {
text-decoration: underline;
}
A:visited#modrefs {
color: #b06060;
}
</STYLE> </STYLE>
</HEAD> </HEAD>
<BODY BGCOLOR=white> <BODY BGCOLOR=white>
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment