# -*- Mode: perl; indent-tabs-mode: nil -*- # # The contents of this file are subject to the Mozilla Public # License Version 1.1 (the "License"); you may not use this file # except in compliance with the License. You may obtain a copy of # the License at http://www.mozilla.org/MPL/ # # Software distributed under the License is distributed on an "AS # IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or # implied. See the License for the specific language governing # rights and limitations under the License. # # The Original Code is the Bugzilla Bug Tracking System. # # The Initial Developer of the Original Code is Netscape Communications # Corporation. Portions created by Netscape are # Copyright (C) 1998 Netscape Communications Corporation. All # Rights Reserved. # # Contributor(s): Terry Weissman # Dan Mosedale # Joe Robins # Dave Miller # Christopher Aillon # Gervase Markham # Contains some global routines used throughout the CGI scripts of Bugzilla. use diagnostics; use strict; # use Carp; # for confess # Shut up misguided -w warnings about "used only once". For some reason, # "use vars" chokes on me when I try it here. # commented out the following snippet of code. this tosses errors into the # CGI if you are perl 5.6, and doesn't if you have perl 5.003. # We want to check for the existence of the LDAP modules here. # eval "use Mozilla::LDAP::Conn"; # my $have_ldap = $@ ? 0 : 1; sub CGI_pl_sillyness { my $zz; $zz = %::FILENAME; $zz = %::MFORM; $zz = %::dontchange; } use CGI::Carp qw(fatalsToBrowser); require 'globals.pl'; sub GeneratePersonInput { my ($field, $required, $def_value, $extraJavaScript) = (@_); $extraJavaScript ||= ""; if ($extraJavaScript ne "") { $extraJavaScript = "onChange=\"$extraJavaScript\""; } return ""; } sub GeneratePeopleInput { my ($field, $def_value) = (@_); return ""; } # Implementations of several of the below were blatently stolen from CGI.pm, # by Lincoln D. Stein. # Get rid of all the %xx encoding and the like from the given URL. sub url_decode { my ($todecode) = (@_); $todecode =~ tr/+/ /; # pluses become spaces $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; return $todecode; } # Quotify a string, suitable for putting into a URL. sub url_quote { my($toencode) = (@_); $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg; return $toencode; } sub ParseUrlString { my ($buffer, $f, $m) = (@_); undef %$f; undef %$m; my %isnull; my $remaining = $buffer; while ($remaining ne "") { my $item; if ($remaining =~ /^([^&]*)&(.*)$/) { $item = $1; $remaining = $2; } else { $item = $remaining; $remaining = ""; } my $name; my $value; if ($item =~ /^([^=]*)=(.*)$/) { $name = $1; $value = url_decode($2); } else { $name = $item; $value = ""; } if ($value ne "") { if (defined $f->{$name}) { $f->{$name} .= $value; my $ref = $m->{$name}; push @$ref, $value; } else { $f->{$name} = $value; $m->{$name} = [$value]; } } else { $isnull{$name} = 1; } } if (%isnull) { foreach my $name (keys(%isnull)) { if (!defined $f->{$name}) { $f->{$name} = ""; $m->{$name} = []; } } } } sub ProcessFormFields { my ($buffer) = (@_); return ParseUrlString($buffer, \%::FORM, \%::MFORM); } sub ProcessMultipartFormFields { my ($boundary) = (@_); $boundary =~ s/^-*//; my $remaining = $ENV{"CONTENT_LENGTH"}; my $inheader = 1; my $itemname = ""; # open(DEBUG, ">debug") || die "Can't open debugging thing"; # print DEBUG "Boundary is '$boundary'\n"; while ($remaining > 0 && ($_ = )) { $remaining -= length($_); # print DEBUG "< $_"; if ($_ =~ m/^-*$boundary/) { # print DEBUG "Entered header\n"; $inheader = 1; $itemname = ""; next; } if ($inheader) { if (m/^\s*$/) { $inheader = 0; # print DEBUG "left header\n"; $::FORM{$itemname} = ""; } if (m/^Content-Disposition:\s*form-data\s*;\s*name\s*=\s*"([^\"]+)"/i) { $itemname = $1; # print DEBUG "Found itemname $itemname\n"; if (m/;\s*filename\s*=\s*"([^\"]+)"/i) { $::FILENAME{$itemname} = $1; } } next; } $::FORM{$itemname} .= $_; } delete $::FORM{""}; # Get rid of trailing newlines. foreach my $i (keys %::FORM) { chomp($::FORM{$i}); $::FORM{$i} =~ s/\r$//; } } # check and see if a given field exists, is non-empty, and is set to a # legal value. assume a browser bug and abort appropriately if not. # if $legalsRef is not passed, just check to make sure the value exists and # is non-NULL # sub CheckFormField (\%$;\@) { my ($formRef, # a reference to the form to check (a hash) $fieldname, # the fieldname to check $legalsRef # (optional) ref to a list of legal values ) = @_; if ( !defined $formRef->{$fieldname} || trim($formRef->{$fieldname}) eq "" || (defined($legalsRef) && lsearch($legalsRef, $formRef->{$fieldname})<0) ){ print "A legal $fieldname was not set; "; print Param("browserbugmessage"); PutFooter(); exit 0; } } # check and see if a given field is defined, and abort if not # sub CheckFormFieldDefined (\%$) { my ($formRef, # a reference to the form to check (a hash) $fieldname, # the fieldname to check ) = @_; if ( !defined $formRef->{$fieldname} ) { print "$fieldname was not defined; "; print Param("browserbugmessage"); PutFooter(); exit 0; } } sub ValidateBugID { # Validates and verifies a bug ID, making sure the number is a # positive integer, that it represents an existing bug in the # database, and that the user is authorized to access that bug. my ($id) = @_; # Make sure the bug number is a positive integer. # Whitespace can be ignored because the SQL server will ignore it. $id =~ /^\s*([1-9][0-9]*)\s*$/ || DisplayError("The bug number is invalid.") && exit; # Get the values of the usergroupset and userid global variables # and write them to local variables for use within this function, # setting those local variables to the default value of zero if # the global variables are undefined. # "usergroupset" stores the set of groups the user is a member of, # while "userid" stores the user's unique ID. These variables are # set globally by either confirm_login() or quietly_check_login(), # one of which should be run before calling this function; otherwise # this function will treat the user as if they were not logged in # and throw an error if they try to access a bug that requires # permissions/authorization to access. my $usergroupset = $::usergroupset || 0; my $userid = $::userid || 0; # Query the database for the bug, retrieving a boolean value that # represents whether or not the user is authorized to access the bug. # Users are authorized to access bugs if they are a member of all # groups to which the bug is restricted. User group membership and # bug restrictions are stored as bits within bitsets, so authorization # can be determined by comparing the intersection of the user's # bitset with the bug's bitset. If the result matches the bug's bitset # the user is a member of all groups to which the bug is restricted # and is authorized to access the bug. # A user is also authorized to access a bug if she is the reporter, # assignee, QA contact, or member of the cc: list of the bug and the bug # allows users in those roles to see the bug. The boolean fields # reporter_accessible, assignee_accessible, qacontact_accessible, and # cclist_accessible identify whether or not those roles can see the bug. # Bit arithmetic is performed by MySQL instead of Perl because bitset # fields in the database are 64 bits wide (BIGINT), and Perl installations # may or may not support integers larger than 32 bits. Using bitsets # and doing bitset arithmetic is probably not cross-database compatible, # however, so these mechanisms are likely to change in the future. # Get data from the database about whether or not the user belongs to # all groups the bug is in, and who are the bug's reporter and qa_contact # along with which roles can always access the bug. SendSQL("SELECT ((groupset & $usergroupset) = groupset) , reporter , assigned_to , qa_contact , reporter_accessible , assignee_accessible , qacontact_accessible , cclist_accessible FROM bugs WHERE bug_id = $id"); # Make sure the bug exists in the database. MoreSQLData() || DisplayError("Bug #$id does not exist.") && exit; my ($isauthorized, $reporter, $assignee, $qacontact, $reporter_accessible, $assignee_accessible, $qacontact_accessible, $cclist_accessible) = FetchSQLData(); # Finish validation and return if the user is a member of all groups to which the bug belongs. return if $isauthorized; # Finish validation and return if the user is in a role that has access to the bug. if ($userid) { return if ($reporter_accessible && $reporter == $userid) || ($assignee_accessible && $assignee == $userid) || ($qacontact_accessible && $qacontact == $userid); } # Try to authorize the user one more time by seeing if they are on # the cc: list. If so, finish validation and return. if ( $cclist_accessible ) { my @cclist; SendSQL("SELECT cc.who FROM bugs , cc WHERE bugs.bug_id = $id AND cc.bug_id = bugs.bug_id "); while (my ($ccwho) = FetchSQLData()) { # more efficient to just check the var here instead of # creating a potentially huge array to grep against return if ($userid == $ccwho); } } # The user did not pass any of the authorization tests, which means they # are not authorized to see the bug. Display an error and stop execution. # The error the user sees depends on whether or not they are logged in # (i.e. $userid contains the user's positive integer ID). if ($userid) { DisplayError("You are not authorized to access bug #$id."); } else { DisplayError( qq|You are not authorized to access bug #$id. To see this bug, you must first log in to an account with the appropriate permissions.| ); } exit; } # check and see if a given string actually represents a positive # integer, and abort if not. # sub CheckPosInt($) { my ($number) = @_; # the fieldname to check if ( $number !~ /^[1-9][0-9]*$/ ) { print "Received string \"$number\" when positive integer expected; "; print Param("browserbugmessage"); PutFooter(); exit 0; } } sub FormData { my ($field) = (@_); return $::FORM{$field}; } sub html_quote { my ($var) = (@_); $var =~ s/\&/\&/g; $var =~ s//\>/g; return $var; } sub value_quote { my ($var) = (@_); $var =~ s/\&/\&/g; $var =~ s//\>/g; $var =~ s/"/\"/g; # See bug http://bugzilla.mozilla.org/show_bug.cgi?id=4928 for # explanaion of why bugzilla does this linebreak substitution. # This caused form submission problems in mozilla (bug 22983, 32000). $var =~ s/\r\n/\ /g; $var =~ s/\n\r/\ /g; $var =~ s/\r/\ /g; $var =~ s/\n/\ /g; return $var; } sub navigation_header { if (defined $::COOKIE{"BUGLIST"} && $::COOKIE{"BUGLIST"} ne "" && defined $::FORM{'id'}) { my @bugs = split(/:/, $::COOKIE{"BUGLIST"}); my $cur = lsearch(\@bugs, $::FORM{"id"}); print "Bug List: (@{[$cur + 1]} of @{[$#bugs + 1]})\n"; print "First\n"; print "Last\n"; if ($cur > 0) { print "Prev\n"; } else { print "Prev\n"; } if ($cur < $#bugs) { $::next_bug = $bugs[$cur + 1]; print "Next\n"; } else { print "Next\n"; } print qq{  Show list\n}; } print "     Query page\n"; print "     Enter new bug\n" } # Adds elements for bug lists. These can be inserted into the header by # (ab)using the "jscript" parameter to PutHeader, which inserts an arbitrary # string into the header. This function is modelled on the one above. sub navigation_links($) { my ($buglist) = @_; my $retval = ""; # We need to be able to pass in a buglist because when you sort on a column # the bugs in the cookie you are given will still be in the old order. # If a buglist isn't passed, we just use the cookie. $buglist ||= $::COOKIE{"BUGLIST"}; if (defined $buglist && $buglist ne "") { my @bugs = split(/:/, $buglist); if (defined $::FORM{'id'}) { # We are on an individual bug my $cur = lsearch(\@bugs, $::FORM{"id"}); if ($cur > 0) { $retval .= "\n"; $retval .= "\n"; } if ($cur < $#bugs) { $retval .= "\n"; $retval .= "\n"; } $retval .= "\n"; $retval .= "\n"; } else { # We are on a bug list $retval .= "\n"; $retval .= "\n"; $retval .= "\n"; } } return $retval; } sub make_checkboxes { my ($src,$default,$isregexp,$name) = (@_); my $last = ""; my $capitalized = ""; my $popup = ""; my $found = 0; $default = "" if !defined $default; if ($src) { foreach my $item (@$src) { if ($item eq "-blank-" || $item ne $last) { if ($item eq "-blank-") { $item = ""; } $last = $item; $capitalized = $item; $capitalized =~ tr/A-Z/a-z/; $capitalized =~ s/^(.?)(.*)/\u$1$2/; if ($isregexp ? $item =~ $default : $default eq $item) { $popup .= "$capitalized
"; $found = 1; } else { $popup .= "$capitalized
"; } } } } if (!$found && $default ne "") { $popup .= "$default"; } return $popup; } # # make_selection_widget: creates an HTML selection widget from a list of text strings. # $groupname is the name of the setting (form value) that this widget will control # $src is the list of options # you can specify a $default value which is either a string or a regex pattern to match to # identify the default value # $capitalize lets you optionally capitalize the option strings; the default is the value # of Param("capitalizelists") # $multiple is 1 if several options are selectable (default), 0 otherwise. # $size is used for lists to control how many items are shown. The default is 7. A list of # size 1 becomes a popup menu. # $preferLists is 1 if selection lists should be used in favor of radio buttons and # checkboxes, and 0 otherwise. The default is the value of Param("preferlists"). # # The actual widget generated depends on the parameter settings: # # MULTIPLE PREFERLISTS SIZE RESULT # 0 (single) 0 =1 Popup Menu (normal for list of size 1) # 0 (single) 0 >1 Radio buttons # 0 (single) 1 =1 Popup Menu (normal for list of size 1) # 0 (single) 1 n>1 List of size n, single selection # 1 (multi) 0 n/a Check boxes; size ignored # 1 (multi) 1 n/a List of size n, multiple selection, of size n # sub make_selection_widget { my ($groupname,$src,$default,$isregexp,$multiple, $size, $capitalize, $preferLists) = (@_); my $last = ""; my $popup = ""; my $found = 0; my $displaytext = ""; $groupname = "" if !defined $groupname; $default = "" if !defined $default; $capitalize = Param("capitalizelists") if !defined $capitalize; $multiple = 1 if !defined $multiple; $preferLists = Param("preferlists") if !defined $preferLists; $size = 7 if !defined $size; my $type = "LIST"; if (!$preferLists) { if ($multiple) { $type = "CHECKBOX"; } else { if ($size > 1) { $type = "RADIO"; } } } if ($type eq "LIST") { $popup .= "$displaytext
"; } else { $popup .= "