asn1c.cgi

RSA加密/解密算法源码 asn1c-0.9.12

#!/usr/bin/perl -w
#
# $Id: asn1c.cgi,v 1.17 2005/03/04 09:15:40 vlm Exp $
#

############################################################################
# The following preferences may be modified to match the local environment #
############################################################################

# Directory with the users data.
$TMPDIR = '/tmp/asn1c-cgi-jail/';
$SUIDHelper = './asn1c-suid-helper';
$SkeletonsDir = '/usr/local/share/asn1c';	# Will be needed only once
$CompilerLocation = '/usr/local/bin/asn1c';	# asn1c binary location
$HelpDBFile = $TMPDIR . '/var/db/Help-DB';	# Help requests database
$HashProgramPath = 'md5';			# Program to hash the input
$DM = 0750;					# Directory mode for all mkdirs
$MaxHistoryItems = 5;				# Number of items in History
$DynamicHistory = 'yes';			# Full/Short history
$safeFilename = '^[a-z0-9_-]+[.a-z0-9_-]*$';	# Safe filename
$ASN1C_Page = 'http://lionet.info/asn1c';
$HelpEmail = '[e-mail]';
$defaultUserEmail = 'your@email';

$warn = '<CENTER><FONT SIZE=+1><B>';
$unwarn = '</B></FONT></CENTER>';

$OpEnvFailed = 'Failed to create the operations\' environment:';
$RandFailed = 'No source of randomness';
$SandBoxInitFailed = 'User playground initialization failed';

$myName = $ENV{SCRIPT_NAME};	# URL of this particular script (without args)

$homePath = "<FONT FACE=Courier SIZE=-1>"
	. "<A HREF=http://lionet.info>Home</A>"
	. " &gt;&gt; <A HREF=$ASN1C_Page>asn1c</A>"
	. " &gt;&gt; <A HREF=$ASN1C_Page/asn1c.cgi>Free Online ASN.1 Compiler</A>"
	. "</FONT><P>";

###################################################
# The code below rarely requires any modification #
###################################################

use CGI qw/param cookie header upload escapeHTML/;

$|=1;	# Enable AutoFlush (for older versions of Perl)

my $redirect = '';	# No redirection by default
my $redirect_bottom = '';	# No redirection text by default
my $content = '';	# Default content is empty

sub IssueRedirect() {
	$redirect = "<META HTTP-EQUIV=\"Refresh\" "
		. "CONTENT=\"5; URL=$myName\">";
	$redirect_bottom = "<P><CENTER>This page will <A HREF=$ASN1C_Page/asn1c.cgi>disappear</A> in 5 seconds.</CENTER>"
}

# If something goes wrong, this function is invoked to display the error message
sub bark($@) {
	local $_ = join("<BR>\n", @_);
	$content = $warn . $_ . $unwarn;
	goto PRINTOUT;
}

# Make the directory name containing session files for the given Session ID
sub makeSessionDirName($$) {
	local $pfx = shift;	# Prefix is the name of the top-level directory
	local $sid = shift;	# Session identifier (md5)
	$pfx . '/sessions/' . $sid . '/';
}

# Create ISO 8601 time string: "YYYY-MM-DDThh:mm:ss"
my $cachedTime;
sub isoTime() {
	return $cachedTime if $cachedTime;
	local @tm = localtime(time);

	$tm[5] += 1900;
	$tm[4] += 1;

	# Insert leading zeros
	for(my $i = 0; $i < 5; $i++) {
		$tm[$i] =~ s/^(.)$/0$1/;
	}

	$cachedTime = "$tm[5]-$tm[4]-$tm[3]T$tm[2]:$tm[1]:$tm[0]";
}

# Create the necessary environment for chrooting into.
sub prepareChrootEnvironment() {
	return 1 if(-d $TMPDIR);	# Envuronment already exists
	mkdir $TMPDIR, $DM, or bark($OpEnvFailed, $!);	# Global directory
	mkdir $TMPDIR . 'sessions', $DM or bark($OpEnvFailed, $!); # sessions
	mkdir $TMPDIR . 'bin', $DM or bark($OpEnvFailed, $!);	# asn1c location
	mkdir $TMPDIR . 'skeletons', $DM or bark($OpEnvFailed, $!); # asn1c data
	mkdir $TMPDIR . 'var', $DM or bark($OpEnvFailed, $!);
	mkdir $TMPDIR . 'var/db', $DM or bark($OpEnvFailed, $!);
	if(-d '/lib') {
		# Merge in dynamic libc
		mkdir $TMPDIR . 'lib', $DM or bark($OpEnvFailed, $!);
		system("cd $TMPDIR/lib && "
			. "for i in"
				. " /lib/ld-linux.*"	# Linux ELF loader
				. " /lib/libc.*"	# Standard C library
				. " /lib/libm.*"	# Math library
			. '; do ln $i; done');
	} elsif(-d '/usr/lib') {
		# There's no /lib on MacOS
		mkdir $TMPDIR . 'usr', $DM or bark($OpEnvFailed, $!);
		mkdir $TMPDIR . 'usr/lib', $DM or bark($OpEnvFailed, $!);
		mkdir $TMPDIR . 'usr/lib/system', $DM or bark($OpEnvFailed, $!);
		system("cd $TMPDIR/usr/lib && "
			. "for i in"
				. " /usr/lib/libc.*"
				. " /usr/lib/libSystem.*"
				. " /usr/lib/system/libmath*"
				. " /usr/lib/dy*"
			. '; do ln $i; done');
	}
	if(-d '/usr/libexec') {
		# FreeBSD ELF loader
		mkdir $TMPDIR . 'usr', $DM;
		mkdir $TMPDIR . 'usr/libexec',$DM or bark($OpEnvFailed, $!);
		system("cd $TMPDIR/usr/libexec && "
			. 'for i in /usr/libexec/ld-elf.*; do ln $i; done');
	}
	system("cp $CompilerLocation $TMPDIR/bin 2>/dev/null") == 0
		or bark($OpEnvFailed, $!);
	system("cp -r $SkeletonsDir/* $TMPDIR/skeletons >/dev/null 2>&1") == 0
			or bark($OpEnvFailed, $!);
	return 1;
}

sub makeArchive($$) {
	local $TMPDIR = shift;
	local $sandbox = shift;
	local $archName = $sandbox . '/+Archive.tgz';

	if(! -f $archName) {
		system("cd $sandbox && "
			. "for i in ./*.[ch]; do if [ -L \$i ]; then"
			. " cp $TMPDIR/skeletons/\$i \$i.-;"
			. " mv \$i.- \$i;"
			. " fi done && tar --dereference --ignore-failed-read --owner nobody --group nobody -zcf +tmp." . $$ . " *.[ch] Makefile* +Compiler.Log *.asn *.asn1"
			. " && rm -f ./*.[ch] ./Makefile*"
			. " && mv ./+tmp." . $$ . " $archName"
			. " || rm -f ./+tmp." . $$);
		undef unless -f $archName;
	}

	$archName;
}

my $EnvironmentSetOK = prepareChrootEnvironment();

#
# Record user's email.
#
$userEmail = cookie('userEmail');
$userEmail = $defaultUserEmail unless defined($userEmail);
$tmpEmail = param('email');
if(defined($tmpEmail)) {
	unless($tmpEmail =~ /^\s*([a-z0-9._+-]+@[a-z0-9.+-]+)\s*$/i) {
		bark("Invalid email address: "
			. "<B><FONT COLOR=darkred>$tmpEmail</FONT></B>");
	}
	my $previousEmail = $userEmail;
	$userEmail = $1;
	if($userEmail eq $defaultUserEmail) {
		IssueRedirect();
		bark("Please enter <FONT COLOR=red>your own</FONT> "
			. "email address, "
			. "instead of default \"<FONT COLOR=darkred>$defaultUserEmail</FONT>\"");
	}
	if($userEmail ne $previousEmail) {
		# Refresh cookie contents.
		local $ck = cookie(-name=>'userEmail',
			-value=>$userEmail,
			-path=>'/', -expires=>'+1d');
		print "Set-Cookie: " . $ck . "\n";
	}
}

#
# Check if full history requested.
#
$HistoryShow = cookie('HistoryShow');
$HistoryShow = '' unless $HistoryShow;
$tmpHSParam = param('history');	# Control cookie setting
if (defined($tmpHSParam)
 && $tmpHSParam ne $HistoryShow
 && $tmpHSParam =~ /^(full|short)$/) {
	$HistoryShow = $tmpHSParam;
	local $ck = cookie(-name=>'HistoryShow',
		-value=>$HistoryShow,
		-path=>'/', -expires=>'+1h');
	print "Set-Cookie: " . $ck . "\n";
}

#
# Prepare the session and create the session directory.
# If session exists, perfom arguments checking and execute historic views.
#
$session = cookie('SessionID');
unless($session) {
	$session = '';
	open(R, '/dev/urandom')
		or open(R, '/dev/random')
			or bark($RandFailed);
	read(R, $session, 16) == 16 or bark("Not enough randomness");
	if($ENV{HTTP_USER_AGENT}) {
		$session .= $ENV{HTTP_USER_AGENT};	# Add randomness
	}
	my $pid = open(R, "-|");
	if($pid == 0) {	# Child
		open(W, "| $HashProgramPath") or die;
		print W $session;
		exit(0);
	}
	$session = <R>;
	$session =~ s/[^a-f0-9]//ig;
	bark("md5 program is rotten here") if(length($session) != 32);
	$sessionDir = makeSessionDirName($TMPDIR, $session);
	mkdir($sessionDir, $DM) or bark($SandBoxInitFailed);
	my $ck = cookie(-name=>'SessionID', -value=>$session,
			-path=>'/', -expires=>'+1y');
	print header(-expires=>'-1y', -cookie=>$ck);
	$HTTPHeaderGenerated = 1;
} else {
	$session =~ s/[^a-f0-9]//ig;
	bark("Nope, try again") if(length($session) != 32);	# cool hacker?

	# Make sure the session directory exists
	$sessionDir = makeSessionDirName($TMPDIR, $session);
	mkdir($sessionDir, $DM) or bark($SandBoxInitFailed)
		unless(-d $sessionDir);

	local $t = param('time');
	local $file = param('file');
	local $fetch = param('fetch');
	local $show = param('show');
	unless(defined($t) && defined($file)
		&& $t =~ /^[0-9TZ:+-]{14,}$/
		&& $file =~ /$safeFilename/i) {
		$fetch = '';
		$show = '';
	}
	if($fetch =~ /$safeFilename/i || $show =~ /^(log|tgz)$/) {
		local $sandbox = $sessionDir . '/' . $t . '--' . $file;

		if($show eq 'tgz') {
			local $tarball = makeArchive($TMPDIR, $sandbox);
			defined $tarball
				or bark("Cannot create archive [$sandbox]");

			printf("Content-Type: application/x-tar\n");
			printf("Content-Encoding: gzip\n\n");
			exec("cat $tarball");
			exit(0);
		}

		if($show eq 'log') {
			$sandbox .= '/+Compiler.Log';
		} else {
			$sandbox .= '/' . $fetch;
		}
		open(I, "< " . $sandbox)
			or bark("Invalid or outdated request: [$sandbox] [$show] $!");
		printf "Content-Type: text/plain\n\n";
		while(<I>) {
			print;
		}
		exit(0);
	}
}

#
# Check if transaction help is requested.
#
$transHelp = param('transHelp');
if(defined($transHelp)
&& $transHelp =~ /^([0-9]+)--([0-9TZ:+-]{14,})--([_.a-zA-Z0-9-]+)$/) {
	open(S, "| sendmail -it")
		or bark("Cannot perform help request, "
			. "please email to the address below");
	print S "From: $userEmail\n";
	print S "To: $HelpEmail\n";
	print S "Subject: asn1c help requested for $3 ($1) by $userEmail\n";
	print S "\n";
	print S "\n-- \n";
	print S "User $userEmail requested help with\n";
	print S "$session/$2--$3 ($1)\n";
	close(S);

	open(S, '>> ' . $sessionDir . '/' . $2 . '--' . $3 . '/+HelpReq')
		or bark("Cannot perform help request, "
			. "please email to the address below");
	print S "$userEmail\n";
	close(S);

	open(S, '>> ' . $HelpDBFile);	# Susceptible to race condition.
	print S "$session/$2--$1--$3\n";
	close(S);

	$content = '<CENTER>Transaction '
		. "$1 ($3) is marked for manual processing.<BR>"
		. "Results will be mailed to "
		. "<FONT COLOR=darkgreen>$userEmail</FONT> shortly."
		. "</CONTENT>";
	IssueRedirect();
	goto PRINTOUT;
}

open(LOG, ">> $sessionDir/+logfile") or bark("Sandbox error: $!");
print LOG isoTime() . "\tIP=$ENV{REMOTE_ADDR}";
print LOG "\tEMAIL=$userEmail" if($userEmail ne $defaultUserEmail);

@gotSafeNames = ();
@gotNames = param('file');
if($#gotNames != -1 && $gotNames[0] ne "") {
	$gotFile = param('file');
	@gotFiles = upload('file');
} else {
	@gotNames = ();
	@gotFiles = ();
	$gotFile = undef;
}

if($#gotNames == -1) {
	my $text = param('text');
	if($text) {
		push(@gotNames, 'module.asn1');
	}
}

# Make safe filenames
foreach my $fname (@gotNames) {
	local $_ = $fname;
	s/.*\///g;	# Strip directory components
	s/.*\\//g;	# Strip directory components (DOS version)