diff --git a/en_US.ISO8859-1/htdocs/cgi/Gnats.pm b/en_US.ISO8859-1/htdocs/cgi/Gnats.pm deleted file mode 100644 index f16f980207..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/Gnats.pm +++ /dev/null @@ -1,41 +0,0 @@ -# $FreeBSD$ -package Gnats; - -# We probably don't have "our" in this Perl -use vars qw/ - $gnats_root - $query_pr - $submission_address - $submission_program - $use_mail - /; - -$gnats_root="/usr/local/libexec/gnats"; -$query_pr="/usr/local/bin/query-pr.web"; -$submission_address="freebsd-gnats-submit\@FreeBSD.org"; -$use_mail=1; - -if ($use_mail) { - if (-e "/usr/lib/sendmail") { $submission_program = "/usr/lib/sendmail -t" }; - if (-e "/usr/sbin/sendmail") { $submission_program = "/usr/sbin/sendmail -t" }; -} else { - if (-e "$gnats_root/queue-pr") { $submission_program = "$gnats_root/queue-pr -q" }; -} - -##### End site specific stuff - -BEGIN { - use Exporter(); - use vars qw/$VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS/; - $VERSION = 0.01; # Has to have two decimal places - @ISA = qw/Exporter/; - # Names for sets of symbols - %EXPORT_TAGS = ( - 'standard'=>[qw/$gnats_root $query_pr $submission_address - $submission_program/], - ); - Exporter::export_tags('standard'); - Exporter::export_ok_tags('standard'); -} - -1; diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR.pm b/en_US.ISO8859-1/htdocs/cgi/GnatsPR.pm deleted file mode 100644 index 70973f1524..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR.pm +++ /dev/null @@ -1,641 +0,0 @@ -#!/usr/bin/perl -Tw -#------------------------------------------------------------------------------ -# Copyright (C) 2011, Shaun Amott -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND -# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -# SUCH DAMAGE. -# -# $FreeBSD$ -#------------------------------------------------------------------------------ - -package GnatsPR; - -#use MIME::Base64; # ports/converters/p5-MIME-Base64 -#use MIME::QuotedPrint; # -#use Convert::UU qw(uudecode uuencode); # ports/converters/p5-Convert-UU - -use GnatsPR::Section::Text; -use GnatsPR::Section::Patch; -use GnatsPR::Section::Email; -use GnatsPR::Section::StateChange; -use GnatsPR::Section::FieldStart; - -use GnatsPR::SectionIterator; - -use strict; - -require 5.006; - - -#------------------------------------------------------------------------------ -# Constants -#------------------------------------------------------------------------------ - -use constant ENCODING_BASE64 => 1; -use constant ENCODING_QP => 2; - -use constant PATCH_ANY => 0x0001; -use constant PATCH_DIFF => 0x0002; -use constant PATCH_UUENC => 0x0004; -use constant PATCH_UUENC_BIN => 0x0008; -use constant PATCH_SHAR => 0x0010; -use constant PATCH_BASE64 => 0x0020; - - -#------------------------------------------------------------------------------ -# Func: new() -# Desc: Constructor - Parses data if provided. -# -# Args: [data] - Raw data (or ref. to) from query-pr (optional) -# -# Retn: $self -#------------------------------------------------------------------------------ - -sub new -{ - my $class = shift; - my ($data) = @_; - - my $self = { - blobs_single => {}, # Raw text, single-line fields - blobs_multi => {}, # Raw text, multi-line fields - header => {}, # E-mail header bits - sections => {}, # Hash of arrayrefs of sections - fromwebform => 0, # PR came from the web form? - numfields => 0 # Number of fields we have - }; - - bless $self, $class; - - if (defined $data) { - ref $data - ? $self->Parse($data) - : $self->Parse(\$data); - } - - return $self; -} - - -#------------------------------------------------------------------------------ -# Func: Header() -# Desc: Return a value from the header hash. -# -# Args: $key - Header name, case insensitive. -# -# Retn: $val - Value. -#------------------------------------------------------------------------------ - -sub Header -{ - my $self = shift; - my ($key) = @_; - - return $self->{header}->{lc $key}; -} - - -#------------------------------------------------------------------------------ -# Func: FieldSingle() -# Desc: Return a single line field value. -# -# Args: $key - Field name. -# -# Retn: $val - Value. -#------------------------------------------------------------------------------ - -sub FieldSingle -{ - my $self = shift; - my ($key) = @_; - - return $self->{blobs_single}->{$key}; -} - - -#------------------------------------------------------------------------------ -# Func: Parse() -# Desc: Parse a blob of text from query-pr into a structured unit for easy -# manipulation. -# -# Args: \$data - Raw data from query-pr (non-ref scalar is acceptable too). -# -# Retn: n/a -#------------------------------------------------------------------------------ - -sub Parse -{ - my $self = shift; - my ($data) = @_; - - my $ismulti = 0; - my $pastheader = 0; - - # GNATS ensures that > isn't allowed as the first - # character on a line, except for field headers. - # Any lines beginning with > will be shunted into - # 'Unformatted' - my @fieldblobs = split /\n>(?!\s)/m, $$data; - - # In the rare case the Unformatted field did - # have some debris, be sure to assemble it back - # into a complete section. - while ($fieldblobs[$#fieldblobs] !~ /^Unformatted:/) { - my $last = pop @fieldblobs; - exists $fieldblobs[$#fieldblobs] or last; - $fieldblobs[$#fieldblobs] .= $last; - } - - foreach my $blob (@fieldblobs) { - my $key; - - # Parse e-mail header; we only care about a few - # fields, not the e-mail routing stuff. - if (!$pastheader) { - foreach my $line (split /\n/, $blob) { - if ($line =~ /^(\S+):\s*(.*)$/) { - my $val = $2; - $key = lc $1; - - # Ignore multiple defs (e.g. Received: headers) - exists $self->{header}->{$key} - and next; - - $self->{header}->{$key} = $val; - } elsif ($line =~ /^\s+(.*)$/) { - my $val = $1; - - defined $key - or next; - - # No field to append to - exists $self->{header}->{$key} - or next; - - $self->{header}->{$key} .= "\n$val"; - } - } - - $pastheader = 1; - next; - } - - if ($blob =~ s/^([^:]+):(\n|\s*)//) { - $key = $1; - #$ismulti = ($2 and $2 eq "\n"); - - # It's multi-liners from here on in - $key eq 'Organization' - and $ismulti = 1; - } else { - # Hmm... - next; - } - - # Remove leading/trailing whitespace - $blob =~ s/^[\n\s]+//; - $blob =~ s/[\n\s]+$//; - - if ($ismulti) { - $self->{blobs_multi}->{$key} = $blob; - } else { - $self->{blobs_single}->{$key} = $blob; - } - } - - $self->{numfields} = scalar @fieldblobs; - - $self->{fromwebform} = - $self->{header}->{'x-send-pr-version'} =~ /^www-/; - - $self->ParseBlobs(); -} - - -#------------------------------------------------------------------------------ -# Func: ParseBlobs() -# Desc: Parse all the raw field "blobs" into section objects. -# -# Args: n/a -# -# Retn: n/a -#------------------------------------------------------------------------------ - -sub ParseBlobs -{ - my $self = shift; - - foreach my $field (keys %{$self->{blobs_multi}}) { - $self->{sections}->{$field} = []; - - push @{$self->{sections}->{$field}}, - new GnatsPR::Section::FieldStart($field); - - if ($field eq 'Fix') { - $self->ParsePatches($field, \($self->{blobs_multi}->{$field})); - next; - } - - if ($field eq 'Audit-Trail') { - # We'll break up the Audit-Trail field by change events. - # This is the most reliable way to split, although it's far - # from perfect. We'll then look for e-mail responses inside - # each chunk for further splitting later. - # - # Notes/Caveats: - # - If someone happened to paste an audit trail event - # inside another's "Why" field, it'd break this. I haven't - # seen this yet and don't expect to. - # - The From-To field has to come first. No reason it wouldn't - # under normal circumstances. - # - Pasted e-mails in the Why field will be promoted to - # responses, although they often break the GNATS conventions - # we (ab)use to find e-mails (e.g.: leading space on message - # body lines), which makes this more difficult. - my @auditevents = - split /(?=^(?:[A-Za-z_]+)-Changed-From-To: (?:.*?)\s*$)/m, - $self->{blobs_multi}->{$field}; - - foreach my $evt (@auditevents) { - my $sect = new GnatsPR::Section::StateChange; - my $gotwhat = 0; - my $gotsect = 0; - while ($evt =~ s/^([A-Za-z_]+)-Changed-([A-Za-z_-]+?): (.*?)\s*\n//) { - my ($what, $key, $val) = ($1, $2, $3); - - if (!$gotwhat) { - $sect->what($what); - $gotwhat = 1; - } - - $gotsect = 1; - - if ($key eq 'From-To') { - my $fromto = $val; - if ($fromto =~ /^(.*)->(.*)$/) { - $sect->from($1); - $sect->to($2); - } - } elsif ($key eq 'When') { - $sect->when($val); - } elsif ($key eq 'By') { - $sect->by($val); - } elsif ($key eq 'Why') { - # This is the last one; it's a multi-line - # field (remainder of the text.) - last; - } - } - - push @{$self->{sections}->{$field}}, $sect - if ($gotsect); - - # Now look for blocks that appear to be e-mail replies - # Note: these header fields are the only ones we allow - # as the first header; we could feasibly back- - # track to find the start of the block (in case - # we're not there already), but the more headers - # we accept the more likely this will break on - # some unexpected content. - my $next_email = qr/^(From|To|Cc|Subject|Date): (.*)$/m; - my $gotwhy = 0; - - while ($evt =~ /$next_email/) { - my $match_start = $-[0]; - my ($header, $body, $indented); - my $why; - - $match_start > 0 - and $why = substr($evt, 0, $match_start, ''); - - if ($gotsect) { - # We now know where "Why" terminates - $sect->why($why) if $sect; - } elsif ($why) { - # If the first block was a date block, - # we need to use a text section for the - # intermediate text instead. - push @{$self->{sections}->{$field}}, - new GnatsPR::Section::Text($why) - unless ($why =~ /^[\n\s]+$/); - } - - $gotwhy = 1; - $sect = undef; - - # Chop leading blank lines - $evt =~ s/^\n+//; - - if ($evt =~ /^$/m) { - # First blank line signals the end of the - # e-mail header - $header = substr($evt, 0, $+[0]+1, ''); - - # Deciding where the body ends is more - # difficult... - - # First, let's see if the message is - # indented (per GNATS standards) - $indented = ($evt =~ /^ /); - - # If, so, find the next blank line, which - # signals the body end. - if ($indented) { - if ($evt =~ /^$/m) { - $body = substr($evt, 0, $-[0], ''); - } else { - $body = $evt; - } - $body =~ s/^ //mg; # Remove indent char - } else { - # Look for another e-mail block - if ($evt =~ /$next_email/) { - $body = substr($evt, 0, $-[0], ''); - } else { - # Otherwise, use the whole section - $body = $evt; - } - } - - push @{$self->{sections}->{$field}}, - new GnatsPR::Section::Email($header, $body); - } else { - # No end-of-header marker: no choice but to - # dump the (possible) e-mail into the Why field - - if ($gotsect && $sect) { - $sect->why($evt); - } elsif ($evt) { - push @{$self->{sections}->{$field}}, - new GnatsPR::Section::Text($evt); - } - } - } - - # Check for dangling "Why" block - if (!$gotwhy) { - if ($gotsect && $sect) { - $sect->why($evt); - } elsif ($evt) { - push @{$self->{sections}->{$field}}, - new GnatsPR::Section::Text($evt); - } - } - } - - next; - } - - # Everything else is just text - push @{$self->{sections}->{$field}}, - new GnatsPR::Section::Text($self->{blobs_multi}->{$field}); - } -} - - -#------------------------------------------------------------------------------ -# Func: ParsePatches() -# Desc: Parse the patches out of the given blob of text, emitting Patch and -# Text sections as appropriate. -# -# Args: $field - Field to push new sections to. -# \$text - Raw text -# -# Retn: n/a -#------------------------------------------------------------------------------ - -sub ParsePatches -{ - my $self = shift; - my ($field, $text) = @_; - - while (my $pi = $self->FindPatchStart($text)) { - # Everything up to this fragment can be - # promoted to a text section - push @{$self->{sections}->{$field}}, - new GnatsPR::Section::Text(substr( - $$text, - 0, - $pi->{start}, - '' - )) - unless $pi->{start} == 0; - - $pi->{start} = 0; - - $self->FindPatchEnd($text, $pi); - - # Try to determine if a web/send-pr attachment - # has another type of patch inside. - if ($pi->{type} eq 'stdattach' or $pi->{type} eq 'webattach') { - if (my $pi2 = $self->FindPatchStart($text)) { - # Upgrade to more specific type - $pi->{type} = $pi2->{type} - if ($pi2->{start} == 0); - } - } - - push @{$self->{sections}->{$field}}, - new GnatsPR::Section::Patch(substr( - $$text, - 0, - $pi->{size}, - '' - ), $pi->{name}, $pi->{type}); - - $$text =~ s/^[\n\s]+//; - } - - # Rest of the field is text - push @{$self->{sections}->{$field}}, - new GnatsPR::Section::Text($$text) - if ($$text); - - $text = ''; -} - - -#------------------------------------------------------------------------------ -# Func: FindPatchStart() -# Desc: Find the beginning of the first patch inside the given text blob, -# if there is one. -# -# Args: \$text - Raw text -# -# Retn: \%pi - Hash of patch info (or undef): -# - start - Start offset of patch -# - type - Type of attachment found -# - name - Filename, if available -#------------------------------------------------------------------------------ - -sub FindPatchStart -{ - my $self = shift; - my ($text) = @_; - - # Patch from web CGI script. Characteristics: - # - Only ever one of them. - # - Appended to the end of Fix: - # - Blank line after header line - # - Could contain other types of patch (e.g. shar(1) archive) - if ($$text =~ /^Patch attached with submission follows:$/m && $self->{fromwebform}) { - my $start = $+[0]; # The newline on the above - - # Next non-blank line (i.e. start of patch) - if ($$text =~ /\G^./m) { - $start += $+[0]+1; - return {start => $start, type => 'webattach'}; - } - - return undef; - } - - # Patch from send-pr(1). Characteristics: - # - Has header and footer line. - # - Appended to the end of Fix: - # - User has an opportunity to edit/mangle. - # - Could contain other types of patch (e.g. shar(1) archive) - if ($$text =~ /^---{1,8}\s?([A-Za-z0-9-_.,:%]+) (begins|starts) here\s?---+\n/mi) { - my $r = {start => $-[0], type => 'stdattach', name => $1}; - - # Chop header line - substr($$text, $-[0], $+[0] - $-[0], ''); - - return $r; - } - - # Patch files from diff(1). Characteristics: - # - Easy to find start. - # - Difficult to find the end. - $$text =~ /^((?:(?:---|\*\*\*)\ (?:\S+)\s*(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun)\ .*) - |(?:(?:---|\*\*\*)\ (?:\S+)\s*(?:\d\d\d\d-\d\d-\d\d\ \d\d:\d\d:\d\d\.\d+)\ .*) - |(diff\ -.*?\ .*?\ .*)|(Index:\ \S+) - |(\*{3}\ \d+,\d+\ \*{4}))$/mx - and return {start => $-[0], type => 'diff'}; - - # Shell archive from shar(1) - $$text =~ /^# This is a shell archive\. Save it in a file, remove anything before/m - and return {start => $-[0], type => 'shar'}; - - # UUencoded file. Characteristics: - # - Has header and footer. - $$text =~ /^begin \d\d\d (.*)/m - and return {start => $-[0], type => 'uuencoded', name => $1}; - - # Base64 encoded file. Characteristics: - # - Has header and footer. - $$text =~ /^begin-base64 \d\d\d (.*)/m - and return {start => $-[0], type => 'base64', name => $1}; - - return undef; -} - - -#------------------------------------------------------------------------------ -# Func: FindPatchEnd() -# Desc: Find the end of the first patch inside the given text blob, if any. -# -# Args: \$text - Raw text -# \%pi - Patch info hash from FindPatchStart(). We'll add more data: -# - size - Length of the patch. -# -# Retn: \%pi - Same as above, except undef will be returned if no actual -# endpoint was found (size in pi would extend to the end of the -# text blob in this case.) -#------------------------------------------------------------------------------ - -sub FindPatchEnd -{ - my $self = shift; - my ($text, $pi) = @_; - - $pi->{size} = 0; - - if ($pi->{type} eq 'webattach') { - $$text =~ /$/ - and $pi->{size} = $+[0]; - } elsif ($pi->{type} eq 'stdattach') { - $$text =~ /^---{1,8}\s?\Q$pi->{name}\E ends here\s?---+/mi - and $pi->{size} = $-[0]-1; - # Chop footer line - substr($$text, $-[0], $+[0] - $-[0], ''); - } elsif ($pi->{type} eq 'diff') { - # XXX: could do better - $$text =~ /^$/m - and $pi->{size} = $-[0]-1; - } elsif ($pi->{type} eq 'shar') { - $$text =~ /^exit$/m - and $pi->{size} = $+[0]; - } elsif ($pi->{type} eq 'uuencoded') { - $$text =~ /^end$/m - and $pi->{size} = $+[0]; - } elsif ($pi->{type} eq 'base64') { - $$text =~ /^====$/m - and $pi->{size} = $+[0]; - } - - if ($pi->{size} == 0) { - $pi->{size} = length $$text; - return undef; - } - - return $pi; -} - - -#------------------------------------------------------------------------------ -# Func: GetAttachment() -# Desc: Recursively search sections for a downloadable attachment. -# -# Args: $num - Attachment index (counts from 1) -# -# Retn: $sec - Attachment section (or undef) -#------------------------------------------------------------------------------ - -sub GetAttachment -{ - my $self = shift; - my ($num) = @_; - my $cur = 1; - - my $iter = GnatsPR::SectionIterator->new($self, 'Fix', 'Audit-Trail'); - - while (my $item = $iter->next()) { - if (ref $item eq 'GnatsPR::Section::Patch') { - # Patch sections - return $item if ($cur++ == $num); - } elsif (ref $item eq 'GnatsPR::Section::Email') { - # Attachments from MIME messages - my $mime_iter = GnatsPR::MIMEIterator->new($item); - while (my $part = $mime_iter->next()) { - if ($part->isattachment) { - return $part if ($cur++ == $num); - } - } - } - } - - return undef; -} - - -1; diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/MIMEIterator.pm b/en_US.ISO8859-1/htdocs/cgi/GnatsPR/MIMEIterator.pm deleted file mode 100644 index ea7aafa052..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/MIMEIterator.pm +++ /dev/null @@ -1,153 +0,0 @@ -#!/usr/bin/perl -Tw -#------------------------------------------------------------------------------ -# Copyright (C) 2011, Shaun Amott -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND -# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -# SUCH DAMAGE. -# -# $FreeBSD$ -#------------------------------------------------------------------------------ - -package GnatsPR::MIMEIterator; - -use strict; - -require 5.006; - - -#------------------------------------------------------------------------------ -# Func: new() -# Desc: Constructor. -# -# Args: $email - GnatsPR::Section::Email instance. -# -# Retn: $self -#------------------------------------------------------------------------------ - -sub new -{ - my $class = shift; - my $email = shift; - - my $self = { - idxlist => [ -1 ], - email => undef - }; - - bless $self, $class; - - $self->{email} = $email; - - return $self; -} - - -#------------------------------------------------------------------------------ -# Func: next() -# Desc: Return next iterator element. -# -# Args: n/a -# -# Retn: $next -#------------------------------------------------------------------------------ - -sub next -{ - my $self = shift; - - my $curr = $self->_current(); - - while (1) { - my $next = ++$self->{idxlist}->[$#{$self->{idxlist}}]; - - # Past last element? - if ($next > $#{$curr->{mimeparts}}) { - # Back out - pop @{$self->{idxlist}}; - - # Reached the root - $#{$self->{idxlist}} > -1 - or return undef; - - $curr = $self->_current(); - next; - } - - last; - } - - my $rpart = $curr->{mimeparts}->[$self->{idxlist}->[$#{$self->{idxlist}}]]; - - # Container part? - find a leaf node - while ($#{$rpart->{mimeparts}} > -1) { - $rpart = $rpart->{mimeparts}->[0]; - push @{$self->{idxlist}}, 0; - } - - return $rpart; -} - - -#------------------------------------------------------------------------------ -# Func: isfirst() -# Desc: Determine if the iterator is at the first element. -# -# Args: n/a -# -# Retn: $isfirst - true/false -#------------------------------------------------------------------------------ - -sub isfirst -{ - my $self = shift; - - return ( - $#{$self->{idxlist}} == 0 - and $self->{idxlist}->[$#{$self->{idxlist}}] == 0 - ); -} - - -#------------------------------------------------------------------------------ -# Func: _current() -# Desc: Traverse to, and return, the current container element. -# -# Args: n/a -# -# Retn: $curr -#------------------------------------------------------------------------------ - -sub _current -{ - my $self = shift; - my $curr = $self->{email}; - - # Find current MIME part container - for (my $depth = 0; $depth < $#{$self->{idxlist}}; $depth++) { - $curr = $curr->{mimeparts}->[$self->{idxlist}->[$depth]]; - } - - return $curr; -} - - -1; diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Makefile b/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Makefile deleted file mode 100644 index 0a461624bd..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Makefile +++ /dev/null @@ -1,14 +0,0 @@ -# $FreeBSD$ - -.if exists(../Makefile.conf) -.include "../Makefile.conf" -.endif -.if exists(../Makefile.inc) -.include "../Makefile.inc" -.endif - -SUBDIR= Section - -DATA= MIMEIterator.pm Section.pm SectionIterator.pm - -.include "${DOC_PREFIX}/share/mk/web.site.mk" diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Makefile.inc b/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Makefile.inc deleted file mode 100644 index 92ed9d8d6f..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Makefile.inc +++ /dev/null @@ -1,4 +0,0 @@ -# $FreeBSD$ - -WEBBASE?= /data/cgi/GnatsPR -DOC_PREFIX?= ${.CURDIR}/../../../../.. diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section.pm b/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section.pm deleted file mode 100644 index 451021ad39..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section.pm +++ /dev/null @@ -1,58 +0,0 @@ -#!/usr/bin/perl -Tw -#------------------------------------------------------------------------------ -# Copyright (C) 2011, Shaun Amott -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND -# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -# SUCH DAMAGE. -# -# $FreeBSD$ -#------------------------------------------------------------------------------ - -package Section; - -use strict; - -require 5.006; - - -#------------------------------------------------------------------------------ -# Func: new() -# Desc: Constructor. -# -# Args: n/a -# -# Retn: $self -#------------------------------------------------------------------------------ - -sub new -{ - my $class = shift; - - my $self = { - }; - - bless $self, $class; - return $self; -} - - -1; diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/Email.pm b/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/Email.pm deleted file mode 100644 index ae7007a9e9..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/Email.pm +++ /dev/null @@ -1,189 +0,0 @@ -#!/usr/bin/perl -Tw -#------------------------------------------------------------------------------ -# Copyright (C) 2011, Shaun Amott -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND -# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -# SUCH DAMAGE. -# -# $FreeBSD$ -#------------------------------------------------------------------------------ - -package GnatsPR::Section::Email; - -use GnatsPR::Section::MIME; - -use strict; - -require 5.006; - - -#------------------------------------------------------------------------------ -# Func: new() -# Desc: Constructor. -# -# Args: $header - Raw e-mail header. -# $body - Raw message body. -# -# Retn: $self -#------------------------------------------------------------------------------ - -sub new -{ - my $class = shift; - my ($header, $body) = @_; - - my $self = { - headerblob => '', - bodyblob => '', - - headers => {}, - - mimeparts => [] - }; - - bless $self, $class; - - $self->{headerblob} = $header; - $self->{bodyblob} = $body; - - $self->ParseHeader() if ($header); - $self->ParseBody() if ($body); - - return $self; -} - - -#------------------------------------------------------------------------------ -# Func: ParseHeader() -# Desc: Parse header blob into fields. -# -# Args: n/a -# -# Retn: n/a -#------------------------------------------------------------------------------ - -sub ParseHeader -{ - my $self = shift; - - my $key; - - foreach my $line (split /\n/, $self->{headerblob}) { - if ($line =~ /^(\S+):\s*(.*)$/) { - my $val = $2; - $key = lc $1; - - # Ignore multiple defs (e.g. Received: headers) - exists $self->{headers}->{$key} - and next; - - $self->{headers}->{$key} = $val; - } elsif ($line =~ /^\s*(.*)$/) { - my $val = $1; - - defined $key - or next; - - # No field to append to - exists $self->{headers}->{$key} - or next; - - $self->{headers}->{$key} .= ' '.$val; - } - } -} - - -#------------------------------------------------------------------------------ -# Func: ParseBody() -# Desc: Parse body blob. -# -# Args: n/a -# -# Retn: n/a -#------------------------------------------------------------------------------ - -sub ParseBody -{ - # XXX: recurse to second-level parts - - my $self = shift; - - $self->{mimeparts} = []; - - # First of all - attempt to split into MIME parts - # Note that since GNATS nukes a bunch of the headers - # that we need, this is purely of a heuristic nature. - - # Technically less permissive than RFC1341 - - my $nextbound = qr/^--([A-Za-z0-9'()+_,-.\/:=?]{6,70})$/m; - my $first = 1; - - while ($self->{bodyblob} =~ s/$nextbound//m) { - my $last; - - if ($first) { - my $boundary = $1; - $nextbound = qr/^--\Q$boundary\E(--)?$/m; - $last = 0; - $first = 0; - } else { - $last = ($2 and $2 eq '--'); - } - - # Promote to MIME part - - push @{$self->{mimeparts}}, - new GnatsPR::Section::MIME( - substr($self->{bodyblob}, 0, $-[0], '') - ) - unless ($-[0] == 0); - } - - if (!@{$self->{mimeparts}}) { - # No parts - just plain text - push @{$self->{mimeparts}}, - new GnatsPR::Section::MIME($self->{bodyblob}); - } -} - - -#------------------------------------------------------------------------------ -# Func: Header() -# Desc: Return a header field. -# -# Args: $key - Header name, case insensitive. -# -# Retn: $val - Value. -#------------------------------------------------------------------------------ - -sub Header -{ - my $self = shift; - my ($key) = @_; - - return $self->{headers}->{lc $key}; -} - - -1; diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/FieldStart.pm b/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/FieldStart.pm deleted file mode 100644 index fe3aa8752c..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/FieldStart.pm +++ /dev/null @@ -1,80 +0,0 @@ -#!/usr/bin/perl -Tw -#------------------------------------------------------------------------------ -# Copyright (C) 2011, Shaun Amott -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND -# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -# SUCH DAMAGE. -# -# $FreeBSD$ -#------------------------------------------------------------------------------ - -package GnatsPR::Section::FieldStart; - -use strict; - -require 5.006; - - -#------------------------------------------------------------------------------ -# Func: new() -# Desc: Constructor. -# -# Args: $name - Field name. -# -# Retn: $self -#------------------------------------------------------------------------------ - -sub new -{ - my $class = shift; - my ($name) = @_; - - my $self = { - name => '' - }; - - bless $self, $class; - - $self->{name} = $name; - - return $self; -} - - -#------------------------------------------------------------------------------ -# Func: string() -# Desc: Return the field name. -# -# Args: n/a -# -# Retn: $string -#------------------------------------------------------------------------------ - -sub string -{ - my $self = shift; - - return $self->{name}; -} - - -1; diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/MIME.pm b/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/MIME.pm deleted file mode 100644 index d5fadcbf8f..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/MIME.pm +++ /dev/null @@ -1,334 +0,0 @@ -#!/usr/bin/perl -Tw -#------------------------------------------------------------------------------ -# Copyright (C) 2011, Shaun Amott -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND -# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -# SUCH DAMAGE. -# -# $FreeBSD$ -#------------------------------------------------------------------------------ - -package GnatsPR::Section::MIME; - -use MIME::Base64; # ports/converters/p5-MIME-Base64 -use MIME::QuotedPrint; # -use Convert::UU qw(uudecode uuencode); # ports/converters/p5-Convert-UU - -use Encode; - -use strict; - -require 5.006; - - -#------------------------------------------------------------------------------ -# Func: new() -# Desc: Constructor. -# -# Args: $blob - Raw MIME part, inc. any headers. -# -# Retn: $self -#------------------------------------------------------------------------------ - -sub new -{ - my $class = shift; - my ($blob) = @_; - - my $self = { - body => '', - decoded_body => '', - headers => {}, - binary => 0, - encoded => 0, - attachment => 0, - filename => '', - mimeparts => [] # Sub parts (usually empty) - }; - - bless $self, $class; - - $self->{body} = $blob; - - $self->Parse() if ($blob); - - return $self; -} - - -#------------------------------------------------------------------------------ -# Accessors -#------------------------------------------------------------------------------ - -sub body -{ - my $self = shift; - $self->{body} = $_[0] if @_; - return $self->{body}; -} - -sub isbinary -{ - my $self = shift; - return $self->{binary}; -} - -sub isencoded -{ - my $self = shift; - return $self->{encoded}; -} - -sub isattachment -{ - my $self = shift; - return $self->{attachment}; -} - -sub filename -{ - my $self = shift; - return $self->{filename}; -} - -sub data -{ - my $self = shift; - return $self->{encoded} ? $self->{decoded_body} : $self->{body}; -} - -sub size -{ - my $self = shift; - return length($self->{encoded} ? $self->{decoded_body} : $self->{body}); -} - - -#------------------------------------------------------------------------------ -# Func: Parse() -# Desc: Parse and decode raw MIME part. -# -# Args: n/a -# -# Retn: n/a -#------------------------------------------------------------------------------ - -sub Parse -{ - my $self = shift; - - my $charset; - - $self->{body} =~ s/^[\n\s]+//; - $self->{body} =~ s/[\n\s]+$/\n/; - - $self->ParseHeader(); - - # Determine if we're a multi-part container - if (lc $self->header('content-type') =~ /multipart/ - and $self->header('content-type:boundary')) { - my $bound = $self->header('content-type:boundary'); - @{$self->{mimeparts}} = - map { - new GnatsPR::Section::MIME($_); - } - grep !/^[\n\s]*$/, - split /^--\Q$bound\E(?:--)?$/m, $self->{body}; - $self->{body} = undef; - return; - } - - if ($self->header('content-type:charset')) { - my $cs = $self->header('content-type:charset'); - - if ($cs =~ /utf.*8/i) { - $cs = 'utf-8'; - } else { - $cs = Encode::resolve_alias($cs); - } - - if ($cs and $cs ne 'ascii') { - $charset = $cs; - } - } - - # Look for Quoted-Printable (explicit or using a silly heuristic) - if (lc $self->header('content-transfer-encoding') eq 'quoted-printable' - or $self->{body} =~ /=[0-9A-Fa-f]{2}=[0-9A-Fa-f]{2}/) { - $self->{body} = decode_qp($self->{body}); - $self->{body} = decode($charset, $self->{body}) - if ($charset); - - # Base64 -- probably better not to decode - } elsif (lc $self->header('content-transfer-encoding') eq 'base64') { - $self->{decoded_body} = decode_base64($self->{body}); - $self->{decoded_body} = decode($charset, $self->{decoded_body}) - if ($charset); - $self->{encoded} = 1; - } - - # Catches too much stuff that we can display - #if ($self->header('content-type') - # && $self->header('content-type') !~ 'text/') { - # $self->{binary} = 1; - #} - - if (lc $self->header('content-disposition') eq 'attachment') { - my $filename = - $self->header('content-disposition:filename') - || $self->header('content-type:name') - || $self->header('x-attachment-id') - || 'attachment'; - - $filename =~ '(?:\.gz|\.bz2|\.zip|\.tar)$' - and $self->{binary} = 1; - - $self->{attachment} = 1; - $self->{filename} = $filename; - } - - if ($self->{body} =~ /^begin \d\d\d (.*)/ && !$self->{encoded}) { - $self->{decoded_body} = uudecode($self->{body}); - $self->{encoded} = 1; - } -} - - -#------------------------------------------------------------------------------ -# Func: ParseHeader() -# Desc: Parse out any MIME header fields. -# -# Args: n/a -# -# Retn: n/a -#------------------------------------------------------------------------------ - -sub ParseHeader -{ - my $self = shift; - my $header = ''; - my $key; - - # Start with some defaults - $self->{headers}->{'content-type'} = 'text/plain'; - - # No header? - $self->{body} =~ /^Content-/i - or return; - - # Ensure we have an end-of-header marker. Returning here - # will result in some bodyless headers being dumped as - # text (example in conf/138672) -- but I think this is - # the safe option, in case such a header is in fact the - # body of a malformed message. - $self->{body} =~ /^$/m and $+[0] != length($self->{body}) or return; - - $header = substr($self->{body}, 0, $+[0]+1, ''); - - $self->{body} =~ s/^[\n\s]+//; - - foreach my $line (split /\n/, $header) { - if ($line =~ /^(\S+): (.*)$/) { - $key = lc $1; - $self->{headers}->{$key} = $2; - } elsif ($line =~ /^\s+(.*)$/) { - $key or next; - $self->{headers}->{$key} .= ' ' . $1; - } - } - - # Split up aggregate headers into individual values - - foreach my $key (keys %{$self->{headers}}) { - $self->{headers}->{$key} =~ /;/ or next; - - my @chars = split //, $self->{headers}->{$key}; - my $inquote = 0; - my $gotkey = 0; - my $k = ''; - my $v = ''; - - foreach my $char (@chars) { - if ($char eq '"') { - $inquote = !$inquote; - next; - } elsif ($char eq '=' && !$inquote) { - $gotkey = 1; - next; - } elsif ($char eq ';' && !$inquote) { - if ($k and $v) { - $k = lc $k; - $self->{headers}->{"$key:$k"} = $v; - } - $k = $v = ''; - $gotkey = 0; - next; - } elsif (($char eq ' ' or $char eq '\t') && !$inquote) { - next; - } - - if ($gotkey) { - $v .= $char; - } else { - $k .= $char; - } - } - - if ($k and $v) { - $k = lc $k; - $self->{headers}->{"$key:$k"} = $v; - } - - $self->{headers}->{$key} =~ s/;.*$//; - } - - # Normalise - - $self->{headers}->{'content-type'} = - lc $self->{headers}->{'content-type'}; -} - - -#------------------------------------------------------------------------------ -# Func: header() -# Desc: Return header. -# -# Args: $key -# -# Retn: $val -#------------------------------------------------------------------------------ - -sub header -{ - my $self = shift; - my ($key) = @_; - - $key = lc $key; - - return $self->{headers}->{$key} - if (exists $self->{headers}->{$key}); - - return ''; -} - - -1; diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/Makefile b/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/Makefile deleted file mode 100644 index e2f5044953..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -# $FreeBSD$ - -.if exists(../Makefile.conf) -.include "../Makefile.conf" -.endif -.if exists(../Makefile.inc) -.include "../Makefile.inc" -.endif - -DATA= Email.pm FieldStart.pm MIME.pm Patch.pm StateChange.pm Text.pm - -.include "${DOC_PREFIX}/share/mk/web.site.mk" diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/Patch.pm b/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/Patch.pm deleted file mode 100644 index c170c810ce..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/Patch.pm +++ /dev/null @@ -1,188 +0,0 @@ -#!/usr/bin/perl -Tw -#------------------------------------------------------------------------------ -# Copyright (C) 2011, Shaun Amott -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND -# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -# SUCH DAMAGE. -# -# $FreeBSD$ -#------------------------------------------------------------------------------ - -package GnatsPR::Section::Patch; - -use MIME::Base64; # ports/converters/p5-MIME-Base64 -use Convert::UU qw(uudecode uuencode); # ports/converters/p5-Convert-UU - -use strict; - -require 5.006; - - -#------------------------------------------------------------------------------ -# Func: new() -# Desc: Constructor. -# -# Args: $text - Blob of text. -# $filename - Filename of patch, if we have one. -# $type - Patch type string (if known). -# -# Retn: $self -#------------------------------------------------------------------------------ - -sub new -{ - my $class = shift; - my ($text, $filename, $type) = @_; - - my $self = { - text => '', - filename => 'patch.txt', - binary => 0, - encoded => 0, - type => 'unknown' - }; - - bless $self, $class; - - $self->{text} = $text; - - $self->{filename} = $filename if $filename; - $self->{type} = $type if $type; - - $self->{filename} =~ '(?:\.gz|\.bz2|\.zip|\.tar)$' - and $self->{binary} = 1; - - if ($self->{type} eq 'uuencoded') { - $self->{encoded} = 1; - $self->{decoded_text} = uudecode($self->{text}); - } elsif ($self->{type} eq 'base64') { - $self->{encoded} = 1; - $self->{decoded_text} = decode_base64($self->{text}); - } - - return $self; -} - - -#------------------------------------------------------------------------------ -# Func: string() -# Desc: Return string contained within. -# -# Args: n/a -# -# Retn: $string -#------------------------------------------------------------------------------ - -sub string -{ - my $self = shift; - - return $self->{text}; -} - - -#------------------------------------------------------------------------------ -# Func: size() -# Desc: Return the length of the contained data. -# -# Args: n/a -# -# Retn: $string -#------------------------------------------------------------------------------ - -sub size -{ - my $self = shift; - - return length($self->{encoded} ? $self->{decoded_text} : $self->{text}); -} - - -#------------------------------------------------------------------------------ -# Func: data() -# Desc: Return the raw decoded (if possible/necessary) data. -# -# Args: n/a -# -# Retn: $string -#------------------------------------------------------------------------------ - -sub data -{ - my $self = shift; - - return $self->{encoded} ? $self->{decoded_text} : $self->{text}; -} - - -#------------------------------------------------------------------------------ -# Func: filename() -# Desc: Return the patch's filename. -# -# Args: n/a -# -# Retn: $filename -#------------------------------------------------------------------------------ - -sub filename -{ - my $self = shift; - - return $self->{filename}; -} - - -#------------------------------------------------------------------------------ -# Func: type() -# Desc: Return the patch's type. -# -# Args: n/a -# -# Retn: $type -#------------------------------------------------------------------------------ - -sub type -{ - my $self = shift; - - return $self->{type}; -} - - -#------------------------------------------------------------------------------ -# Func: isbinary() -# Desc: Is patch binary? -# -# Args: n/a -# -# Retn: $type -#------------------------------------------------------------------------------ - -sub isbinary -{ - my $self = shift; - - return $self->{binary}; -} - - -1; diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/StateChange.pm b/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/StateChange.pm deleted file mode 100644 index 1228ee2bb3..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/StateChange.pm +++ /dev/null @@ -1,117 +0,0 @@ -#!/usr/bin/perl -Tw -#------------------------------------------------------------------------------ -# Copyright (C) 2011, Shaun Amott -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND -# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -# SUCH DAMAGE. -# -# $FreeBSD$ -#------------------------------------------------------------------------------ - -package GnatsPR::Section::StateChange; - -use strict; - -require 5.006; - - -#------------------------------------------------------------------------------ -# Func: new() -# Desc: Constructor. -# -# Args: n/a -# -# Retn: $self -#------------------------------------------------------------------------------ - -sub new -{ - my $class = shift; - - my $self = { - what => '', # State or Responsible - from => '', # Change from - to => '', # Change to - why => '', # Reason for change - when => '', # Date of change - by => '' # Who changed it - }; - - bless $self, $class; - - return $self; -} - - -#------------------------------------------------------------------------------ -# Accessors -#------------------------------------------------------------------------------ - -sub what -{ - my $self = shift; - $self->{what} = $_[0] if @_; - return $self->{what}; -} - -sub from -{ - my $self = shift; - $self->{from} = $_[0] if @_; - return $self->{from}; -} - -sub to -{ - my $self = shift; - $self->{to} = $_[0] if @_; - return $self->{to}; -} - -sub why -{ - my $self = shift; - - if (scalar @_) { - $self->{why} = $_[0]; - $self->{why} =~ s/^\s+//; - $self->{why} =~ s/[\n\s]+$//; - } - return $self->{why}; -} - -sub when -{ - my $self = shift; - $self->{when} = $_[0] if @_; - return $self->{when}; -} - -sub by -{ - my $self = shift; - $self->{by} = $_[0] if @_; - return $self->{by}; -} - - -1; diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/Text.pm b/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/Text.pm deleted file mode 100644 index 05a2782311..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/Section/Text.pm +++ /dev/null @@ -1,82 +0,0 @@ -#!/usr/bin/perl -Tw -#------------------------------------------------------------------------------ -# Copyright (C) 2011, Shaun Amott -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND -# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -# SUCH DAMAGE. -# -# $FreeBSD$ -#------------------------------------------------------------------------------ - -package GnatsPR::Section::Text; - -use strict; - -require 5.006; - - -#------------------------------------------------------------------------------ -# Func: new() -# Desc: Constructor. -# -# Args: $text - Blob of text. -# -# Retn: $self -#------------------------------------------------------------------------------ - -sub new -{ - my $class = shift; - my ($text) = @_; - - my $self = { - text => '' - }; - - bless $self, $class; - - $text =~ s/[\s\n]+$//s; # Tidy up trailing whitespace - - $self->{text} = $text; - - return $self; -} - - -#------------------------------------------------------------------------------ -# Func: string() -# Desc: Return string contained within. -# -# Args: n/a -# -# Retn: $string -#------------------------------------------------------------------------------ - -sub string -{ - my $self = shift; - - return $self->{text}; -} - - -1; diff --git a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/SectionIterator.pm b/en_US.ISO8859-1/htdocs/cgi/GnatsPR/SectionIterator.pm deleted file mode 100644 index 851ca24052..0000000000 --- a/en_US.ISO8859-1/htdocs/cgi/GnatsPR/SectionIterator.pm +++ /dev/null @@ -1,114 +0,0 @@ -#!/usr/bin/perl -Tw -#------------------------------------------------------------------------------ -# Copyright (C) 2011, Shaun Amott -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND -# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -# SUCH DAMAGE. -# -# $FreeBSD$ -#------------------------------------------------------------------------------ - -package GnatsPR::SectionIterator; - -use strict; - -require 5.006; - - -#------------------------------------------------------------------------------ -# Func: new() -# Desc: Constructor. -# -# Args: $gnatspr - GnatsPR instance. -# @fields - Which fields we want sections from. The order determines -# the order of the returned sections. Undefined behaviour if -# no no fields specified. -# -# Retn: $self -#------------------------------------------------------------------------------ - -sub new -{ - my $class = shift; - my $gnatspr = shift; - - my $self = { - gnatspr => $gnatspr, - currfield => -1, - currsection => -1, - wantfields => [] - }; - - bless $self, $class; - - while (my $f = shift) { - push @{$self->{wantfields}}, $f; - } - - return $self; -} - - -#------------------------------------------------------------------------------ -# Func: next() -# Desc: Return next iterator element. -# -# Args: n/a -# -# Retn: $next -#------------------------------------------------------------------------------ - -sub next -{ - my $self = shift; - my ($fieldkey, $maxsection); - - # Next section - $self->{currsection}++; - - # First field? - $self->{currfield} == -1 - and $self->{currfield} = 0; - - $fieldkey = $self->{wantfields}->[$self->{currfield}]; - $maxsection = $#{$self->{gnatspr}->{sections}->{$fieldkey}}; - - # We've passed the last section in this field - while ($self->{currsection} > $maxsection) { - # Next field, first section - $self->{currfield}++; - $self->{currsection} = 0; - - # Run out of fields? - $self->{currfield} > $#{$self->{wantfields}} - and return undef; - - # Update, and go back to check next field - $fieldkey = $self->{wantfields}->[$self->{currfield}]; - $maxsection = $#{$self->{gnatspr}->{sections}->{$fieldkey}}; - } - - return $self->{gnatspr}->{sections}->{$fieldkey}->[$self->{currsection}]; -} - - -1; diff --git a/en_US.ISO8859-1/htdocs/cgi/Makefile b/en_US.ISO8859-1/htdocs/cgi/Makefile index 5852e17fb5..1309f51750 100644 --- a/en_US.ISO8859-1/htdocs/cgi/Makefile +++ b/en_US.ISO8859-1/htdocs/cgi/Makefile @@ -8,28 +8,17 @@ .endif DATA= -DATA+= Gnats.pm -DATA+= GnatsPR.pm DATA+= cgi-lib.pl DATA+= cgi-style.pl -DATA+= query-pr-lib.pl CGI= -CGI+= confirm-code.cgi -CGI+= dosendpr.cgi CGI+= getmsg.cgi CGI+= mailindex.cgi CGI+= man.cgi CGI+= mid.cgi CGI+= mirror.cgi -CGI+= missing_handler.cgi CGI+= monthly.cgi CGI+= ports.cgi -CGI+= query-pr.cgi -CGI+= query-pr-summary.cgi -CGI+= search.cgi - -SUBDIR= GnatsPR .SUFFIXES: .C .cgi diff --git a/en_US.ISO8859-1/htdocs/cgi/cgi-style.pl b/en_US.ISO8859-1/htdocs/cgi/cgi-style.pl index 3ca960228c..f439834548 100644 --- a/en_US.ISO8859-1/htdocs/cgi/cgi-style.pl +++ b/en_US.ISO8859-1/htdocs/cgi/cgi-style.pl @@ -14,7 +14,7 @@ if (!defined($hsty_base)) { # However, if we aren't running as a cgi, or if we're # running on cgi, hub, docs or people, use the absolute home path. if (!defined($ENV{'HTTP_HOST'}) || - $ENV{'HTTP_HOST'} =~ /(cgi|hub|docs|people).freebsd.org/i) { + $ENV{'HTTP_HOST'} =~ /(cgi|hub|docs|people|mailarchive.ysv).freebsd.org/i) { $hsty_base = '//www.FreeBSD.org' } else { @@ -22,7 +22,7 @@ if (!defined($hsty_base)) { } } if (!defined($hsty_email)) { - $hsty_email = 'www@FreeBSD.org'; + $hsty_email = 'Contact'; } if (!defined($hsty_author)) { $hsty_author = "$hsty_email"; @@ -83,7 +83,7 @@ $i_topbar = qq`