set on some files as a workaround for binary check. - Fix pathname for svn co in the webupdate script. Approved by: doceng (implicit)
		
			
				
	
	
		
			226 lines
		
	
	
	
		
			6.9 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable file
		
	
	
	
	
			
		
		
	
	
			226 lines
		
	
	
	
		
			6.9 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable file
		
	
	
	
	
#!/usr/bin/perl
 | 
						|
#
 | 
						|
#  Send-pr perl script to send a pr.
 | 
						|
#
 | 
						|
# Copyright (c) 1996 Free Range Media
 | 
						|
#
 | 
						|
#  Copying and distribution permitted under the conditions of the
 | 
						|
#  GNU General Public License Version 2.  
 | 
						|
#     (http://www.gnu.ai.mit.edu/copyleft/gpl.html)
 | 
						|
#
 | 
						|
# $FreeBSD$
 | 
						|
 | 
						|
use Socket;
 | 
						|
use CGI qw/:standard/;
 | 
						|
use DB_File;
 | 
						|
use Fcntl qw(:DEFAULT :flock);
 | 
						|
require "./Gnats.pm"; import Gnats;
 | 
						|
 | 
						|
my $blackhole = "dnsbl.njabl.org";
 | 
						|
my $openproxyip = "127.0.0.9";
 | 
						|
my $blackhole_err = 0;
 | 
						|
my $openproxy;
 | 
						|
 | 
						|
my $expiretime = 2700;
 | 
						|
$dbpath = "/usr/local/www/var/confirm-code/sendpr-code.db";
 | 
						|
 | 
						|
# Maximum size of patch that we'll accept from send-pr.html.
 | 
						|
$maxpatch = 102400;
 | 
						|
 | 
						|
my $patchbuf;
 | 
						|
my $patchhandle;
 | 
						|
 | 
						|
# Environment variables to stuff in the PR header.
 | 
						|
my @ENV_captures = qw/	REMOTE_HOST
 | 
						|
			REMOTE_ADDR
 | 
						|
			REMOTE_PORT
 | 
						|
			HTTP_REFERER
 | 
						|
			HTTP_CLIENT_IP
 | 
						|
			HTTP_FORWARDED
 | 
						|
			HTTP_VIA
 | 
						|
			HTTP_X_FORWARDED_FOR	/;
 | 
						|
 | 
						|
# env2hdr (@ENV_captures)
 | 
						|
# Returns X-header style headers for inclusion in the header of a PR
 | 
						|
sub env2hdr (@) {
 | 
						|
	my $headers = "";
 | 
						|
	for my $var (shift @_) {
 | 
						|
		next unless $ENV{$var};
 | 
						|
		$headers .= "X-$var: $ENV{$var}\n";
 | 
						|
	}
 | 
						|
	return $headers;
 | 
						|
}
 | 
						|
		
 | 
						|
# isopenproxy ($ip, $blackhole_zone, $positive_ip)
 | 
						|
# Returns undef on error, 0 if DNS lookup fails, $positive_ip if verified
 | 
						|
# proxy. A DNS lookup failing can either means that there was a network
 | 
						|
# problem, or that the IP is not listed in the blackhole zone.
 | 
						|
sub isopenproxy ($$$) {
 | 
						|
	# If $? is already set, then a successful gethostbyname() leaves it set
 | 
						|
	local $?;
 | 
						|
	my ($ip, $zone, $proxyip) = @_;
 | 
						|
	my ($reversed_ip, $packed);
 | 
						|
	if (!defined $proxyip) { return undef };
 | 
						|
 | 
						|
	$reversed_ip = join('.', reverse split(/\./, $ip));
 | 
						|
	$packed = gethostbyname("${reversed_ip}.${blackhole}");
 | 
						|
	return undef if $?;
 | 
						|
 | 
						|
	if ($packed && (inet_ntoa($packed) eq $proxyip)) {
 | 
						|
		return $proxyip;
 | 
						|
	} else {
 | 
						|
		return 0;
 | 
						|
	}
 | 
						|
}
 | 
						|
 | 
						|
sub prerror {
 | 
						|
    print start_html("Problem Report Error");
 | 
						|
    print "<p>There is an error in the configuration of the problem\n",
 | 
						|
          "report form generator.  Please back up one page and report\n",
 | 
						|
          "the problem to the owner of that page.<br />",
 | 
						|
	  "Report <span class=\"prerror\">$_[0]</span>.</p>";
 | 
						|
    print end_html();
 | 
						|
    exit (1);
 | 
						|
}
 | 
						|
 | 
						|
sub piloterror {
 | 
						|
    print start_html("Problem Report Error");
 | 
						|
    print "<p>There is an error with your problem\n",
 | 
						|
          "report submission.\n",
 | 
						|
	  "The problem was: <span class=\"prerror\">$_[0]</span>.</p>";
 | 
						|
    print end_html();
 | 
						|
    exit (1);
 | 
						|
}
 | 
						|
 | 
						|
print header();
 | 
						|
 | 
						|
&prerror("request method problem") if $ENV{'REQUEST_METHOD'} eq 'GET';
 | 
						|
 | 
						|
if (!$submission_program) { &prerror("submit program problem"); }
 | 
						|
 | 
						|
if ($patchhandle = upload('patch')) {
 | 
						|
#    use bytes;
 | 
						|
    unless ((uploadInfo($patchhandle)->{'Content-Type'} =~ m!^text/.*!) ||
 | 
						|
	(uploadInfo($patchhandle)->{'Content-Type'} =~ m!^application/shar$!)) {
 | 
						|
	&piloterror("<p>Patch file has wrong content type: got " . 
 | 
						|
		    uploadInfo($patchhandle)->{'Content-Type'} .
 | 
						|
		    " but was expecting one matching text/.* or application/shar.</p>" .
 | 
						|
		    "<p>Try renaming the file to have a .txt extension" .
 | 
						|
		    " to convince your browser to do the right thing.</p>");
 | 
						|
    }
 | 
						|
    read($patchhandle,$patchbuf,$maxpatch + 1);
 | 
						|
    if (length($patchbuf) > $maxpatch) {
 | 
						|
	&piloterror("Patch file too big (over ${maxpatch} bytes)");
 | 
						|
    }
 | 
						|
}
 | 
						|
 | 
						|
# Verify the code...
 | 
						|
 | 
						|
$db_obj = tie(%db_hash, 'DB_File', $dbpath, O_CREAT|O_RDWR, 0644)
 | 
						|
                    or die "dbcreate $dbpath $!";
 | 
						|
$fd = $db_obj->fd;
 | 
						|
open(DB_FH, "+<&=$fd") or die "fdopen $!";
 | 
						|
 | 
						|
unless (flock (DB_FH, LOCK_EX | LOCK_NB)) {
 | 
						|
    unless (flock (DB_FH, LOCK_EX)) { die "flock: $!" }
 | 
						|
}
 | 
						|
 | 
						|
$codeentered = param('code-confirm');
 | 
						|
$codeentered =~ s/.*/\U$&/;	# Turn input uppercase
 | 
						|
$currenttime = time();
 | 
						|
if (defined($codeentered) && $codeentered && $db_hash{$codeentered} && 
 | 
						|
  (($currenttime - $expiretime) <= $db_hash{$codeentered})) {
 | 
						|
    if (!param('email') || !param('originator') ||
 | 
						|
        !param('synopsis')) {
 | 
						|
	  print start_html("Problem Report Error");
 | 
						|
	  print "<h1>Bad Data</h1><p>You need to specify at least your ",
 | 
						|
              "electronic mail address, your name and a synopsis ",
 | 
						|
              "of the problem.<br />  Please return to the form and add the ",
 | 
						|
              "missing information.  Thank you.</p>";
 | 
						|
          print end_html();
 | 
						|
 | 
						|
          exit(1);
 | 
						|
    }
 | 
						|
} else {
 | 
						|
	print start_html("Problem Report Error");
 | 
						|
	print "<h1>Incorrect confirmation code</h1><p>You need to enter the correct ",
 | 
						|
          "code from the image displayed.  Please return to the form and enter the ",
 | 
						|
          "code exactly as shown. Thank you.</p>";
 | 
						|
        print end_html();
 | 
						|
 | 
						|
        exit(1);
 | 
						|
}
 | 
						|
 | 
						|
# This code has now been used, so remove it.
 | 
						|
delete $db_hash{"$codeentered"};
 | 
						|
 | 
						|
# Sweep for and remove expired codes.
 | 
						|
foreach $randomcode (keys %db_hash) {
 | 
						|
	if ( ($currenttime - $expiretime) >= $db_hash{$randomcode}) {
 | 
						|
		delete $db_hash{"$randomcode"};
 | 
						|
	}
 | 
						|
}
 | 
						|
$db_obj->sync();                   # to flush
 | 
						|
flock(DB_FH, LOCK_UN);
 | 
						|
undef $db_obj;                     # removing the last reference to the DB
 | 
						|
                                   # closes it. Closing DB_FH is implicit.
 | 
						|
untie %db_hash;
 | 
						|
 | 
						|
 | 
						|
$openproxy = isopenproxy($ENV{'REMOTE_ADDR'}, $blackhole, $openproxyip);
 | 
						|
if (defined $openproxy) {
 | 
						|
	if ($openproxy) {
 | 
						|
		&prerror("$ENV{'REMOTE_ADDR'} is an open proxy server");
 | 
						|
	}
 | 
						|
} else {
 | 
						|
	$blackhole_err++;
 | 
						|
}
 | 
						|
 | 
						|
# Build the PR.
 | 
						|
$pr = "To: $submission_address\n" .
 | 
						|
      "From: " . param('originator') . " <" . param('email') . ">\n" . 
 | 
						|
      "Subject: " . param('synopsis') . "\n" .
 | 
						|
      env2hdr(@ENV_captures);
 | 
						|
if ($blackhole_err) {
 | 
						|
      $pr .= "X-REMOTE_ADDR-Is-Open-Proxy: Maybe\n";
 | 
						|
}
 | 
						|
 | 
						|
$pr .= "X-Send-Pr-Version: www-3.1\n" .
 | 
						|
      "X-GNATS-Notify: \n\n" .
 | 
						|
      ">Submitter-Id:\t" . param('submitterid') . "\n" .
 | 
						|
      ">Originator:\t" . param('originator') . "\n" .
 | 
						|
      ">Organization:\t" . param('organization') . "\n" .
 | 
						|
      ">Confidential:\t" . param('confidential') . "\n" .
 | 
						|
      ">Synopsis:\t" . param('synopsis') . "\n" .
 | 
						|
      ">Severity:\t" . param('severity') . "\n" .
 | 
						|
      ">Priority:\t" . param('priority') . "\n" .
 | 
						|
      ">Category:\t" . param('category') . "\n" .
 | 
						|
      ">Class:\t\t" . param('class') . "\n" .
 | 
						|
      ">Release:\t" . param('release') . "\n" .
 | 
						|
      ">Environment:\t" . param('environment') . "\n" .
 | 
						|
      ">Description:\n" . param('description') . "\n" .
 | 
						|
      ">How-To-Repeat:\n" . param('howtorepeat') . "\n" .
 | 
						|
      ">Fix:\n" . param('fix') . "\n";
 | 
						|
 | 
						|
if (length($patchbuf) > 0) {
 | 
						|
	$pr .= "\nPatch attached with submission follows:\n\n"
 | 
						|
	    . $patchbuf . "\n";
 | 
						|
}
 | 
						|
 | 
						|
# remove any carriage returns that appear in the report.
 | 
						|
$pr =~ s/\r//g;
 | 
						|
 | 
						|
if (open (SUBMIT, "|$submission_program")){
 | 
						|
 | 
						|
    print SUBMIT $pr;
 | 
						|
    print SUBMIT "\n.\n";
 | 
						|
    close (SUBMIT);
 | 
						|
    print start_html("Thank you for the problem report");
 | 
						|
    print "<h1>Thank You</h1>",
 | 
						|
	  "<p>Thank you for the problem report.  You should receive confirmation",
 | 
						|
	  " of your report by electronic mail within a day.</p>";
 | 
						|
} else {
 | 
						|
    print start_html("Error raising problem report");
 | 
						|
    print "<h1>Error</h1><p>An error occured processing your problem report.</p>";
 | 
						|
}
 | 
						|
print end_html();
 |