From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 14463 invoked from network); 16 Oct 2003 14:20:21 -0000 Received: from unknown (HELO monty-python.gnu.org) (199.232.76.173) by sources.redhat.com with SMTP; 16 Oct 2003 14:20:21 -0000 Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.24) id 1AA8xI-0003hI-O0 for listarch-gnats-devel@sources.redhat.com; Thu, 16 Oct 2003 10:18:20 -0400 Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.24) id 1AA8tR-0002m3-3S for help-gnats@gnu.org; Thu, 16 Oct 2003 10:14:21 -0400 Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.24) id 1AA8su-0002bo-C4 for help-gnats@gnu.org; Thu, 16 Oct 2003 10:14:19 -0400 Received: from [149.239.160.240] (helo=ppd00021.deutschepost.de) by monty-python.gnu.org with esmtp (Exim 4.24) id 1AA8sb-0002RI-5a for help-gnats@gnu.org; Thu, 16 Oct 2003 10:13:29 -0400 Received: from d0006006.deutschepost.de (d0006006.deutschepost.de [10.160.6.6]) by ppd00021.deutschepost.de (8.12.2/8.12.1) with ESMTP id h9GEDB2a002837 for ; Thu, 16 Oct 2003 16:13:12 +0200 (METDST) Received: from ddaah015.deutschepost.de (unverified) by d0006006.deutschepost.de (Content Technologies SMTPRS 4.2.10) with ESMTP id for ; Thu, 16 Oct 2003 16:13:02 +0200 Received: by DDAAH015.DeutschePost.de with Internet Mail Service (5.5.2653.19) id <4D7ZGL0L>; Thu, 16 Oct 2003 16:13:01 +0200 Message-ID: <712FA1811754D511BC5740000039F0075F944E@SPCAH007.DeutschePost.de> From: "Leu, Fa. PostDirekt MA" To: "'help-gnats@gnu.org'" Date: Thu, 16 Oct 2003 14:20:00 -0000 MIME-Version: 1.0 X-Mailer: Internet Mail Service (5.5.2653.19) Content-Type: multipart/mixed; boundary="----_=_NextPart_000_01C393EF.993A7DC0" Subject: GNATS help needed (2) (i've forgotten the configfiles, sorry) X-BeenThere: help-gnats@gnu.org X-Mailman-Version: 2.1.2 Precedence: list List-Id: General discussion about GNU GNATS List-Archive: List-Post: List-Help: List-Subscribe: , Sender: help-gnats-bounces+listarch-gnats-devel=sources.redhat.com@gnu.org Errors-To: help-gnats-bounces+listarch-gnats-devel=sources.redhat.com@gnu.org X-SW-Source: 2003-q4/txt/msg00018.txt.bz2 This message is in MIME format. Since your mail reader does not understand this format, some or all of this message may not be legible. ------_=_NextPart_000_01C393EF.993A7DC0 Content-Type: text/plain; charset="iso-8859-1" Content-Transfer-Encoding: quoted-printable Content-length: 575 Hi, i am trying to customize and translate GNATS to have a German User Interfac= e.=20 After serveral good iterations i'am stuck - since i've changed the field "C= losed-Date"=20 send-pr won't do anything anymore and gnatsweb returns "unparseable reply f= rom gnatsd:" (without a reply) in the directory gnats-adm a file "gnats.lock" is created. I've undone my c= hanges but get still the same result.=20=20 1. What can i do to recover.=20 2. Is a translation generally possible (may be there are hardcoded fieldnam= es, etc) many thanks in advance Hans-J=F6rg Leu=20 ------_=_NextPart_000_01C393EF.993A7DC0 Content-Type: application/octet-stream; name="dbconfig" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="dbconfig" Content-length: 23952 # This configuration file describes the standard "out-of-the-box" configura= tion=0A= # for GNATS. It is responsible for describing the types of data stored=0A= # in fields, the order of fields in the index file, and the format of=0A= # results returned from query-pr.=0A= #=0A= # The format of the file is rather freeform; whitespace is unnecessary, and= is=0A= # ignored. Any text after a # is considered to be a comment, and is ignore= d=20=0A= # until the end of the line.=0A= #=0A= # The first section describes various aspects of the database.=0A= =0A= database-info {=0A= # If true, mail is sent to the gnats-admin mail address instead=0A= # of the submitter. (Should be set to false or true.)=0A= debug-mode false=0A= =0A= # If true, all of the Received: headers are kept in the PR,=0A= # otherwise only the first one is kept.=0A= keep-all-received-headers false=0A= =0A= # If true, we track required PR times and notify the responsible=0A= # people when the times expire.=0A= notify-about-expired-prs true=0A= =0A= # Send the PR submitter an acknowledgement for a newly-submitted PR;=0A= # the format of the message is the "mail-format" query format.=0A= send-submitter-ack true=0A= =0A= # The directory where at-pr and mail-pr can be found.=0A= libexecdir "/usr/local/libexec/gnats"=0A= =0A= # The hours that define a business day, in 24-hour format.=0A= business-day-hours 9-17=0A= # The starting and ending days of the week that define the business day= .=0A= business-week-days 1-5=0A= =0A= # If true, directories for categories are automatically created if they= =0A= # don't already exist.=0A= create-category-dirs true=0A= =0A= # The default permission mask for new category directories.=0A= # NOTE: If local users on the GNATS server itself will be running=0A= # tools such as query-pr, you may to need set permissions to 0755.=0A= category-dir-perms "0750"=0A= }=0A= =0A= #=0A= # The second section describes each field within the PR.=0A= #=0A= # The name specified here is also used as the field header in the PR, with= =0A= # a `>' prepended and a `:' appended.=0A= #=0A= =0A= field "Nummer" {=0A= # This entry describes a builtin field; "number" is the internal=0A= # name of the field. (The builtin names correspond to the old gnats=0A= # field names, and are case-insensitive as are field names.)=0A= builtin-name "number"=0A= =0A= # A one-line description of the field, in human-readable form.=0A= description "Ticket Nummer"=0A= =0A= # Integer values are stored in this field.=0A= integer {=0A= # This must be -1 -- code in various programs relies on the first= =0A= # character of the field being a '-' if the value wasn't specified.= =0A= # Really, it shouldn't have a default.=0A= default "-1"=0A= }=0A= # The field value may not be edited.=0A= read-only=0A= }=0A= =0A= field "CC-Adressen" {=0A= description "Addressen von Personen, die bei =C4nderungen benachrichtig= t werden sollen"=0A= text=0A= query-default inexact-regexp=0A= textsearch=0A= }=0A= =0A= field "Kategorie" {=0A= builtin-name "category"=0A= description "In welchen Bereich f=E4llt des Ticket?"=0A= #=0A= # The possible values for this field are enumerated in a separate file.= =0A= #=0A= enumerated-in-file {=0A= #=0A= # The name of the file is "categories"; it is located in the=0A= # gnats-adm subdirectory of the database.=0A= #=0A= path "categories"=0A= #=0A= # The names of the fields in the file; the file has 4 fields.=0A= # Fields within the file are separated by colons (:).=0A= #=0A= fields {=0A= "category" "fullname" "person" "notify"=0A= }=0A= # The file is keyed on this field. (This is currently ignored, but=0A= # it will eventually be used and should be present. For now, this=0A= # must always be the first field listed above.)=0A= key "category"=0A= }=0A= # This field is searched when doing a --text search in query-pr.=0A= textsearch=0A= }=0A= =0A= field "Betreff" {=0A= builtin-name "synopsis"=0A= description "Kurze Beschreibung des Problems"=0A= text=0A= # When doing queries on this field, by default regexps do not need to= =0A= # match the contents of the field exactly. The other possible=0A= # value is "exact-regexp".=0A= query-default inexact-regexp=0A= textsearch=0A= }=0A= =0A= field "Vertraulich" {=0A= builtin-name "confidential"=0A= description "Yes/no flag indicating if the PR contents are confidential= "=0A= # An enumerated field with two possible values; the default value=0A= # is "yes".=0A= enum {=0A= values { "ja" "nein" }=0A= default "nein"=0A= }=0A= textsearch=0A= # This field may not be queried unless the user has full permissions=0A= # to search it. (Does this actually do anything??? Probably not.)=0A= restricted=0A= }=0A= =0A= field "Severity" {=0A= builtin-name "severity"=0A= description "How severe is the PR?"=0A= enum {=0A= values { "kritisch" "wichtig" "unkritisch" }=0A= default "wichtig"=0A= # We don't want to suggest a default when a PR is being input.=0A= input-default ""=0A= }=0A= textsearch=0A= }=0A= =0A= field "Priorit=E4t" {=0A= builtin-name "priority"=0A= description "Wie Kritisch ist das Problem?"=0A= enum {=0A= values { "hoch" "mittel" "niedrig" }=0A= default "mittel"=0A= # We don't want to suggest a default when a PR is being input.=0A= input-default ""=0A= }=0A= query-default exact-regexp=0A= textsearch=0A= }=0A= =0A= =0A= field "Verantwortlich" {=0A= builtin-name "responsible"=0A= description "Der Benutzer, der f=FCr dieses Ticket verantwortlich ist"= =0A= enumerated-in-file {=0A= path "responsible"=0A= fields {=0A= "responsible" "fullname" "alias"=0A= }=0A= key "responsible"=0A= # We have to allow any value here, because old GNATS didn't require=0A= # all possible responsible users to be listed in the responsible=0A= # file--it looks in the password database as well.=0A= #=0A= # The flag indicates that the value in the field doesn't have to=0A= # match one of the entries in the administrative file.=0A= allow-any-value=0A= }=0A= textsearch=0A= # When the field is edited, we want an audit-trail entry to be added,= =0A= # and we want to require a reason for the change.=0A= on-change {=0A= add-audit-trail=0A= require-change-reason=0A= }=0A= =0A= # Terminate the entry in the index after the first space. (bleah! Probabl= y=0A= # no longer needed. And we should handle this by allowing a format=20=0A= # character in the index spec instead of this option.)=0A= nospaces-in-index=0A= }=0A= =0A= field "Status" {=0A= builtin-name "state"=0A= description "Der aktuelle Zustand des Tickets"=0A= enumerated-in-file {=0A= path "states"=0A= fields { "state" "type" "description" }=0A= key "state"=0A= }=0A= textsearch=0A= =0A= on-change {=0A= # Add Audit-Trail entries when this field changes.=0A= add-audit-trail=0A= # Require that a reason be supplied when this field is edited.=0A= require-change-reason=0A= }=0A= =0A= #=0A= # Here's an example of how we would set the Closed-Date: field when the=0A= # State: field is changed to "closed".=0A= #=0A= # Note that a \ followed by a newline is ignored, and \n within strings=0A= # is translated to the EOL character.=0A= #=0A= # Only do the edit if the new State's type is "closed" and if=0A= # a) the previous State wasn't of type closed=0A= # or b) the Closed-Date is not yet defined=0A= # With this rule, we keep the Closed-Date if we change from a "closed"=0A= # state to another "closed" state.=0A= #=0A= on-change "State[type]=3D=3D\"closed\" \=0A= & (oldpr:State[Type]!=3D\"closed\" | Closed-Date=3D=3D\"\")" = {=0A= #=0A= # Set the Closed-Date field to the current date. (We can also=0A= # use $OldValue and $NewValue here as well, in addition to any=0A= # of the PR's field values.)=0A= #=0A= set-field "Closed-Date" {=0A= "%s"=0A= "$CurrentDate"=0A= }=0A= }=0A= =0A= #=0A= # If the new PR's State: field type is not closed...then we want to clear= =0A= # the Closed-Date field.=0A= #=0A= on-change "State[type]!=3D\"closed\"" {=0A= #=0A= # Null it out.=0A= #=0A= set-field "Closed-Date" {=0A= ""=0A= }=0A= }=0A= }=0A= =0A= field "Class" {=0A= description "The type of bug"=0A= enumerated-in-file {=0A= path "classes"=0A= fields { "class" "type" "description" }=0A= key "class"=0A= }=0A= textsearch=0A= }=0A= =0A= field "Absender-Id" {=0A= builtin-name "submitter-id"=0A= description "Von welcher Organisation wurde die Anfrage gestellt?"=0A= enumerated-in-file {=0A= path "submitters"=0A= fields {=0A= "submitter" "fullname" "type" "rtime" "contact" "notify"=0A= }=0A= key "submitter"=0A= }=0A= textsearch=0A= }=0A= =0A= field "Eingang-am" {=0A= builtin-name "arrival-date"=0A= description "Arrival date of the PR"=0A= # A date field. Dates are validated as to format before they can be=0A= # stored; the field contents may also be empty.=0A= date=0A= # The field value may not be edited.=0A= read-only=0A= }=0A= =0A= field "Closed-Date" {=0A= builtin-name "closed-date"=0A= description "Date when the PR was closed"=0A= date=0A= # The field may not be edited by the user.=0A= read-only=0A= }=0A= =0A= field "Last-Modified" {=0A= builtin-name "last-modified"=0A= description "Last modification date of the PR"=0A= date=0A= # The field may not be edited by the user.=0A= read-only=0A= }=0A= =0A= field "Ersteller" {=0A= builtin-name "originator"=0A= =0A= description "Name des Autors des Tickets"=0A= =0A= # The data type stored in this field is text.=20=0A= text=0A= =0A= query-default inexact-regexp=0A= =0A= textsearch=0A= }=0A= =0A= field "Release" {=0A= description "Release number or tag"=0A= text=0A= query-default inexact-regexp=0A= textsearch=0A= }=0A= =0A= field "Organization" {=0A= description "Organization of PR author"=0A= # Multiple lines of text may appear in the field.=0A= multitext=0A= }=0A= =0A= field "Environment" {=0A= description "Machine, OS, target, libraries"=0A= multitext=0A= }=0A= =0A= field "Beschreibung" {=0A= builtin-name "description"=0A= description "Genaue Beschreibung"=0A= multitext=0A= }=0A= =0A= field "How-To-Repeat" {=0A= description "Code/input/activities to reproduce the problem"=0A= multitext=0A= }=0A= =0A= field "Fix" {=0A= description "Wie kann das Problem gehoben werden (soweit bekannt)"=0A= multitext {=0A= # Do we really want this here?=0A= default "\nUnknown"=0A= }=0A= }=0A= =0A= field "Release-Note" {=0A= multitext=0A= }=0A= =0A= field "Audit-Trail" {=0A= builtin-name "audit-trail"=0A= description "Log of specific changes to the PR"=0A= multitext=0A= }=0A= =0A= #=0A= # This is the "limbo death nuke" field where unparsed text ends up.=0A= #=0A= field "Unformatted" {=0A= builtin-name "unformatted"=0A= description "Miscellaneous text that was not parsed properly"=0A= multitext=0A= }=0A= =0A= #=0A= # The following query sections describe the output of various types of=0A= # queries.=0A= #=0A= # For a full query, all fields are printed out. The format used is=0A= # the same as a normal PR.=0A= #=0A= query "full" {=0A= fields all=0A= }=0A= =0A= #=0A= # Used for edits. The field contents are displayed "raw".=0A= #=0A= query "edit" {=0A= fields all=0A= raw=0A= }=0A= =0A= #=0A= # If a list of fields is given without any format specifier, the fields=0A= # are printed out in the same format as they would appear in a PR,=0A= # complete with headers.=0A= #=0A= # The standard query type is the one that is performed by default if no=0A= # format is specified to query-pr.=0A= #=20=0A= query "standard" {=0A= fields {=0A= "Nummer" "Kategorie" "Betreff" "Vertraulich" "Severity"=0A= "Priorit=E4t" "Verantwortlich" "Status" "Class" "Absender-Id"=0A= "Eingang-am" "Closed-Date" "Last-Modified" "Ersteller"=0A= "Release"=0A= }=0A= }=0A= =0A= #=0A= # The format string uses printf-style formatting to format its=0A= # output. No headers are printed, and a trailing EOL character is=0A= # always output. \n within the string is replaced with the proper EOL=0A= # character.=0A= #=0A= # The format characters are:=0A= # %s - plain string.=0A= # %S - similar to %s, but the string is terminated at the first space=0A= # that occurs in the field contents. Used for the Responsible:=0A= # field.=0A= # %d - integer value. This is normally used to print out enumerated=0A= # fields with their integer equivalent, or to print out dates=0A= # as "seconds since Jan 1, 1970".=0A= # %D - formatted date field.=0A= # %Q - SQL-formatted date field.=0A= # %F - write the entire field with the header and a newline, just as if=0A= # it were being written to a PR. Any positional indicators and=0A= # such are ignored.=0A= #=0A= # For most %-formats the usual `-' and `+' positional specifiers may be giv= en.=0A= #=0A= # This is the --summary format in query-pr.=0A= #=0A= query "summary" {=0A= format "%8s %-8.8S %-8.8s %-9.9s %-9.9s %-8.8s %-10.10s %s"=0A= fields {=0A= "Nummer" "Verantwortlich" "Kategorie" "Status" "Severity" "Priorit=E4t"=0A= "Absender-Id" "Betreff"=0A= }=0A= }=0A= =0A= #=0A= # The next two are historical silliness.=0A= #=0A= query "sql" {=0A= format "%-8.8s|%-16.16s|%-128.128s|%-3.3s|%1.1d|%1.1d|%-16.16S|%1.1d|%1= .1d|%-16.16s|%-21.21Q|%-64.64s|%-64.64s|%-21.21Q|%-21.21Q|"=0A= fields {=0A= "Nummer" "Kategorie" "Betreff" "Vertraulich" "Severity" "Priorit=E4t"=0A= "Verantwortlich" "Status" "Class" "Absender-Id" "Eingang-am"=0A= "Ersteller" "Release" "Last-Modified" "Closed-Date"=0A= }=0A= }=0A= =0A= query "sql2" {=0A= format "%s|%s|%s|%s|%d|%d|%S|%d|%d|%s|%Q|%s|%s|%Q|%Q|"=0A= fields {=0A= "Nummer" "Kategorie" "Betreff" "Vertraulich" "Severity" "Priorit=E4t"=0A= "Verantwortlich" "Status" "Class" "Absender-Id" "Eingang-am"=0A= "Ersteller" "Release" "Last-Modified" "Closed-Date"=0A= }=0A= }=0A= =0A= #=0A= # The format used for Audit-Trail entries. The following parameters=0A= # are passed in, and can be used in addition to any of the PR fields:=0A= # $FieldName -- the name of the field that has changed=0A= # $OldValue -- the old value of the field=0A= # $NewValue -- the new field value=0A= # $EditUserEmailAddr -- the email address of the user editing the field=0A= # $CurrentDate -- the current date=0A= # $ChangeReason -- the reason for the change (may be blank if no reason was= =0A= # supplied)=0A= #=0A= audit-trail-format {=0A= format "\=0A= %s-Changed-From-To: %s->%s\n\=0A= %s-Changed-By: %s\n\=0A= %s-Changed-When: %s\n\=0A= %s-Changed-Why:\n\=0A= %s\n\n"=0A= =0A= fields {=0A= "$FieldName" "$OldValue" "$NewValue"=0A= "$FieldName" "$EditUserEmailAddr"=0A= "$FieldName" "$CurrentDate"=0A= "$FieldName" "$ChangeReason"=0A= }=0A= }=0A= =0A= #=0A= # This message is used when mailing an initial response back to the=20=0A= # PR submitter.=0A= #=0A= =0A= mail-format "initial-response-to-submitter" {=0A= from-address {=0A= fixed-address "gnats-admin"=0A= }=0A= =0A= # For addresses that are joined with |, we try each one in turn, from= =0A= # left to right, until we find one that's non-empty.=0A= # Multiple addresses may be listed here.=0A= to-addresses {=0A= "Reply-To:" | "From:" | "From" | "Absender-Id"=0A= }=0A= =0A= header {=0A= format "Subject: Re: %s/%s: %s\n"=0A= =0A= fields { "Kategorie" "Nummer" "Subject:" }=0A= }=0A= =0A= body {=0A= format "Thank you very much for your problem report.\n\=0A= It has the internal identification `%s/%s'.\n\=0A= The individual assigned to look at your\n\=0A= report is: %s. \n\=0A= \n\=0A= %F%F%F%F\n\=0A= "=0A= fields { "Kategorie" "Nummer" "Verantwortlich"=0A= "Kategorie" "Verantwortlich" "Betreff" "Eingang-am" }=0A= }=0A= }=0A= =0A= #=0A= # The message sent to the responsible parties when a new non-pending=0A= # PR arrives.=0A= #=0A= =0A= mail-format "initial-pr-notification" {=0A= # Who the mail is from.=0A= from-address {=0A= "From:" | "From"=0A= }=0A= =0A= # We send mail to the responsible person, the addresses listed in=0A= # the contact and notify fields of the submitter adm file entry for=0A= # the Submitter-Id, and the notify person listed in the category=0A= # adm file.=0A= to-addresses {=0A= "Verantwortlich"=0A= "Submitter-Id[contact]"=0A= "Submitter-Id[notify]"=0A= "Category[notify]"=0A= }=0A= =0A= # The reply-to address; either use the Reply-To: or From: header values= =20=0A= # from the PR, or the Submitter-Id's mail address.=0A= reply-to {=0A= "Reply-To:" | "From:" | "Absender-Id"=0A= }=0A= =0A= # Any additional header text we want to add. Must have a newline at th= e=0A= # end of each line.=0A= header {=0A= format "Subject: %s/%s: %s\nCc: %s\n"=0A= fields { "Kategorie" "Nummer" "Subject:" "CC-Adressen" }=0A= }=0A= =0A= body {=0A= # Need to add this feature, or something like it.=0A= # ($ExpireTime !=3D "") {=0A= # format "\tThe contract type is `%s' with a response time of %d business = hours.\n"=0A= # fields { "Submitter-Id[type]" "$ExpireTime" }=0A= # }=0A= # %P is "write the entire PR". Ugh. FIXME XXX ??? !!!=0A= format "%P"=0A= # And if there's a %-format...there has to be an associated field.=20=20= =0A= # Double bleah.=0A= fields { "$" }=0A= }=0A= }=0A= =0A= #=0A= # This format is used for initial PRs that end up as pending PRs.=0A= #=0A= mail-format "initial-pr-notification-pending" {=0A= #=0A= # Is this good?=0A= #=0A= from-address {=0A= "From:" | "From"=0A= }=0A= =0A= #=0A= # Boring--we only tell gnats-admin about it.=0A= #=0A= to-addresses {=0A= fixed-address "gnats-admin"=0A= }=0A= =0A= #=0A= # Questionable for a pending PR.=0A= #=0A= reply-to {=0A= "Reply-To:" | "From:" | "Absender-Id"=0A= }=0A= =0A= header {=0A= format "Subject: %s/%s: %s (pending)\nCc: %s\n"=0A= fields { "Kategorie" "Nummer" "Subject:" "CC-Adressen" }=0A= }=0A= =0A= body {=0A= #=0A= # See above.=0A= #=0A= # ($ExpireTime !=3D "") {=0A= # format "\tThe contract type is `%s' with a response time of %d business = hours.\n"=0A= # fields { "Submitter-Id[type]" "$ExpireTime" }=0A= # }=0A= format "%P"=0A= fields { "$" }=0A= }=0A= }=0A= =0A= #=0A= # Used when a response to a PR is received via email.=0A= #=0A= # The following parameters are passed in:=0A= # $MailFrom -- the From: line of the original message=0A= # $MailTo -- the To: line of the original message=0A= # $MailSubject: The Subject: line of the original message=0A= # $MailCC: The CC: line of the original message=0A= # $NewAuditTrail -- the text of the new audit trail entry (the body of=0A= # the message)=0A= #=0A= mail-format "appended-email-response" {=0A= from-address {=0A= "$MailFrom"=0A= }=0A= =0A= #=0A= # Should we send a copy to the user that sent in the message?=0A= #=0A= to-addresses {=0A= "Verantwortlich"=0A= "Submitter-Id[contact]"=0A= }=0A= =0A= reply-to {=0A= "$MailFrom"=0A= }=0A= =0A= header {=0A= format "Subject: %s/%s: %s\n"=0A= fields { "Kategorie" "Nummer" "$MailSubject" }=0A= }=0A= =0A= body {=0A= format "The following reply was made to PR %s/%s; it has been noted by GNA= TS.\n\n%s"=0A= fields { "Kategorie" "Nummer" "$NewAuditTrail" }=0A= }=0A= }=0A= =0A= #=0A= # Used to send mail for a change that generates an Audit-Trail entry.=0A= # The following parameters are available:=0A= # $EditUserEmailAddr -- the email address of the user editing the PR=0A= # $OldResponsible -- the previous Responsible field entry, if it was change= d=0A= # $NewAuditTrail -- the Audit-Trail: entries that have been appended=0A= # by the edits=0A= #=0A= mail-format "audit-mail" {=0A= from-address {=0A= "$EditUserEmailAddr"=0A= }=0A= =0A= #=0A= to-addresses {=0A= "Verantwortlich"=0A= "$OldResponsible"=0A= "Category[notify]"=0A= "Submitter-Id[contact]"=0A= "$EditUserEmailAddr"=0A= "Reply-To:" | "From:" | "From"=0A= }=0A= =0A= #=0A= # ??? Good question!=0A= #=0A= reply-to {=0A= fixed-address "bugs"=0A= }=0A= =0A= header {=0A= format "Subject: Re: %s/%s\nCc: %s\n"=0A= fields { "Kategorie" "Nummer" "CC-Adressen" }=0A= }=0A= =0A= body {=0A= format "Synopsis: %s\n\n%s\n"=0A= fields { "Betreff" "$NewAuditTrail" }=0A= }=0A= }=0A= =0A= #=0A= # Used to send mail when a PR is deleted.=0A= # The following parameters are available:=0A= # $EditUserEmailAddr -- the email address of the user deleting the PR=0A= # $PRNum -- the number of the PR that was deleted=0A= # Can't refer to the deleted PR at this point--it's been deleted. *bam*=0A= #=0A= mail-format "deleted-pr-mail" {=0A= from-address {=0A= "$EditUserEmailAddr"=0A= }=0A= =0A= #=0A= to-addresses {=0A= fixed-address "gnats-admin"=0A= }=0A= =0A= header {=0A= format "Subject: Deleted PR %s\n"=0A= fields { "$PRNum" }=0A= }=0A= =0A= body {=0A= format "PR %s was deleted by user %s.\n"=0A= fields { "$PRNum" "$EditUserEmailAddr" }=0A= }=0A= }=0A= =0A= #=0A= # Global on-change sections are executed once for each PR edit.=0A= #=0A= # This one takes care of setting the Last-Modified field. The following=0A= # format parameters are available:=0A= #=0A= # $CurrentDate -- the current date=0A= # $EditUserEmailAddr -- the email address of the user making the change(s)= =0A= #=0A= on-change {=0A= set-field "Last-Modified" { "%s" "$CurrentDate" }=0A= }=0A= =0A= #=0A= # The index entry lists the fields that appear in the index. For now, the = PR=0A= # ID (consisting of "category/number") is always first in the index records= ,=0A= # and is not explicitly given here.=0A= #=0A= # The binary-index keyword indicates that a binary file format will be used= =0A= # to store the index. This has several advantages over the old ASCII forma= t,=0A= # not the least of which is avoiding problems with quoting field separators= =0A= # (which didn't work properly in GNATS v3).=0A= #=20=0A= # If the old ASCII format is used (by setting binary-index to false) a '|' = is=0A= # used as the separator between fields by default. An alternate field=20= =0A= # separator may be given with the "separator" keyword.=0A= #=0A= index {=0A= # Name of the index file in the gnats-adm directory. The name is=0A= # respected, but you can only have one index entry per database (for=0A= # now). The index is keyed by PR number.=0A= path "index"=0A= # The fields in the index, in the order in which they will appear.=0A= fields {=0A= "Absender-Id" "Verantwortlich" "Status" "Vertraulich" "Severity"=0A= "Priorit=E4t" "Eingang-am" "Last-Modified" "Closed-Date" "Class"=0A= "Ersteller" "Release" "Betreff"=0A= }=0A= # A somewhat convoluted binary format is used when binary-index is set= =0A= # to true.=0A= binary-index true=0A= }=0A= =0A= # initial-entry describes which fields should be present on initial entry;= =0A= # this is used by send-pr (for example) to decide which fields to include= =20=0A= # in the template.=20=20=0A= #=0A= # These are listed in the approximate order in which they should appear in= =0A= # the template.=0A= initial-entry {=0A= fields {=0A= "Absender-Id" "CC-Adressen" "Ersteller"=20=0A= "Betreff" "Severity" "Kategorie"=0A= "Beschreibung"=20=0A= }=0A= }=0A= ------_=_NextPart_000_01C393EF.993A7DC0 Content-Type: application/octet-stream; name="gnatsweb.pl" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="gnatsweb.pl" Content-length: 150081 #!/usr/bin/perl -w=0A= #=0A= # Gnatsweb - web front-end to GNATS=0A= #=0A= # Copyright 1998, 1999, 2001, 2002=0A= # - The Free Software Foundation Inc.=0A= #=0A= # GNU Gnatsweb is free software; you can redistribute it and/or modify=0A= # it under the terms of the GNU General Public License as published by=0A= # the Free Software Foundation; either version 2, or (at your option)=0A= # any later version.=0A= #=0A= # GNU Gnatsweb is distributed in the hope that it will be useful, but=0A= # WITHOUT ANY WARRANTY; without even the implied warranty of=0A= # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU=0A= # General Public License for more details.=0A= #=0A= # You should have received a copy of the GNU General Public License=0A= # along with Gnatsweb; see the file COPYING. If not, write to the Free=0A= # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA=0A= # 02111-1307, USA.=0A= #=0A= # $Id: gnatsweb.pl,v 1.119 2002/11/25 22:31:13 yngves Exp $=0A= #=0A= =0A= use strict;=0A= =0A= # static global configuration switches and values. set at the top of=0A= # this program, but overridable in gnatsweb-site.pl=0A= use vars qw($site_gnats_host $site_gnats_port=0A= $site_gnatsweb_server_auth $site_no_gnats_passwords=0A= $no_create_without_access $site_mail_domain $site_post_max=0A= $description_in_view $help_page_path $site_banner_text=0A= $site_banner_background $site_banner_foreground=0A= $site_button_foreground $site_button_background $site_stylesheet=0A= $include_audit_trail $popup_menu_becomes_obnoxious=0A= $scrolling_menu_default_size $site_background=0A= $site_required_field_color $use_temp_db_prefs_cookie=0A= $global_cookie_expires $global_cookie_path $textwidth=0A= $site_allow_remote_debug $attachment_delimiter %mark_urls=0A= $gnats_info_top %site_pr_submission_address $VERSION);=0A= =0A= # dynamic configuration switches, set during initial gnatsd=0A= # communication and general setup=0A= use vars qw($script_name $global_no_cookies $global_list_of_dbs=0A= $client_cmd_debug $reply_debug $access_level);=0A= =0A= # these vars are used for error handling in communications=0A= # with gnatsd=0A= use vars qw($client_would_have_exited $suppress_client_exit);=0A= =0A= # the following variable needs to be global in order to make gnatsweb=0A= # callable from another source file. Used for 'make test...'=0A= use vars qw($suppress_main);=0A= =0A= # global variables containing most of the info from the gnats-adm=0A= # directory. these should probably be rolled into one giant hash.=0A= # in fact, this code should be set up so that gnatsweb under mod_perl=0A= # could cache all this hooey...=0A= use vars qw(%category_notify @submitter_id %submitter_contact=0A= %submitter_complete %submitter_notify @responsible=0A= %responsible_address %category_desc %responsible_complete %fielddata=0A= @fieldnames %responsible_fullname);=0A= =0A= # the information from the user cookies.=0A= # db_prefs just has username & password=0A= # global_prefs has email address, default columns for query results=0A= # SUBMITTER_ID_FIELD default value and ORIGINATOR_FIELD default value=0A= # i think that the columns info should be moved to db_prefs, and the=0A= # code suitably munged so that a user could have different column=0A= # prefs for different databases.=0A= use vars qw(%global_prefs %db_prefs);=0A= =0A= # the CGI object=0A= use vars '$q';=0A= =0A= # i couldn't manage to get these two beaten into shape as=0A= # lexical variables. maybe next time...=0A= use vars qw($pr %fields);=0A= =0A= #--------------------------------------------------------------------------= ---=0A= # what do you call the file containing the site-specific customizations?=0A= # you could, i suppose, by dint of creative programming, have different=0A= # config files for different databases, or some such madness...=0A= my $gnatsweb_site_file =3D './gnatsweb-site.pl';=0A= =0A= # Site-specific customization -=0A= #=0A= # DO NOT EDIT THESE VARIABLES HERE!=0A= #=0A= # Instead, put them in a file called 'gnatsweb-site.pl' in the=0A= # same directory. That way, when a new version of gnatsweb is=0A= # released, you won't need to edit them again.=0A= #=0A= =0A= # Info about your gnats host.=0A= $site_gnats_host =3D 'localhost';=0A= $site_gnats_port =3D 1529;=0A= =0A= # is your installation of gnatsweb set up with server authentication?=0A= # if you want to set up a more tightly secured installation, you can=0A= # have the web server do authentication (against an htpasswd file,=0A= # LDAP server, or some third-party system). this will set the=0A= # REMOTE_USER environment variable with the correct user id. with=0A= # this switch set, the "logout" button is replaced by a "change=0A= # database" button.=0A= $site_gnatsweb_server_auth =3D 0;=0A= =0A= # or does it merely ignore the gnats password? the gnats network mode=0A= # is quite cavalier about passwords, and some sites may elect not to=0A= # use gnats passwords. if so, there's no point in gnatsweb asking for=0A= # them. if this switch is set, the login page does not prompt for a=0A= # password. this means that anyone can pretend to be anyone, but=0A= # since the gnats command line tools are hardly more secure, it's not=0A= # a big deal...=0A= $site_no_gnats_passwords =3D 0;=0A= =0A= # set a minimum access level for access to the create function=0A= # (this is probably only meaningful if gnatsweb is the only interface=0A= # to your gnats installation, since by default gnats allows *everyone*=0A= # to submit PRs)=0A= # value must be a valid gnatsd.h access level, see %LEVEL_TO_CODE below.=0A= #$no_create_without_access =3D 'edit';=0A= $no_create_without_access =3D '';=0A= =0A= # mail domain for responsible field -- bare user-ids in responsible=0A= # fields will have this added to the end to create a sane mailto: link.=0A= # you must put the '@' sign at the beginning of the string=0A= $site_mail_domain =3D '@yourdomain.here';=0A= =0A= # hash of addresses that your site uses for submission of PRs=0A= # if this is defined for a given database, the edit and view pages=0A= # will include a link "submit a follup by email" -- a mailto: this=0A= # address and the Reply-To address of the PR.=0A= #%site_pr_submission_address =3D ('default' =3D> 'bugs@example.com',=0A= # 'other_db' =3D> 'other-bugs@example.com');=0A= %site_pr_submission_address =3D ();=0A= =0A= # the maximum size posting we'll accept=0A= $site_post_max =3D 1024 * 1024;=0A= =0A= # show field descriptions on the view PR page? this tends to look=0A= # messy, so by default we only show them on the create and edit pages.=0A= $description_in_view =3D 0;=0A= =0A= # path to the gnatsweb help page. this is the file that will be=0A= # returned when the user clicks on the Help button.=0A= $help_page_path =3D './gnatsweb.html';=0A= =0A= # Name you want in the page banner and banner colors.=0A= $site_banner_text =3D 'GNU Gnatsweb';=0A= $site_banner_background =3D '#000000';=0A= $site_banner_foreground =3D '#ffffff';=0A= $site_button_background =3D '#000000';=0A= $site_button_foreground =3D '#ffffff';=0A= =0A= # Uncomment the following line and insert stylesheet URL in order to=0A= # link all generated pages to an external stylesheet. Both absolute=0A= # and relative URLs are supported.=0A= #$site_stylesheet=3D'http://url.of/stylesheet';=0A= $site_stylesheet =3D undef;=0A= =0A= # When $include_audit_trail is set to 1, the Audit-Trail will be=0A= # visible by default in the View PR screen. Sites that expect large=0A= # Audit-Trails, i.e. lot of mail back and forth etc., will want to set=0A= # this to 0.=0A= $include_audit_trail =3D 1;=0A= =0A= # when we have more than this many items, use a scrolling list=0A= # instead of a popup=0A= $popup_menu_becomes_obnoxious =3D 20;=0A= =0A= # default size for scrolling lists. overridden for some fields=0A= $scrolling_menu_default_size =3D 3;=0A= =0A= # Page background color -- not used unless defined.=0A= #$site_background =3D '#c0c0c0';=0A= $site_background =3D undef;=0A= =0A= # Color to use for marking the names of required fields on the Create=0A= # PR page.=0A= $site_required_field_color =3D '#ff0000';=0A= =0A= # control the mark_urls routine, which "htmlifies" PRs for view_pr.=0A= # it adds a lot of usability, but can be slow for huge (100K+) fields.=0A= # urls =3D make links clickable=0A= # emails =3D make addresses mailto: links=0A= # prs =3D make PR numbers links to gnatsweb=0A= # max_length =3D strings larger than this will not be processed=0A= %mark_urls =3D (=0A= 'urls' =3D> 1,=0A= 'emails' =3D> 1,=0A= 'prs' =3D> 1,=0A= 'max_length' =3D> 1024*100,=0A= );=0A= =0A= # Use temporary cookie for login information? Gnatsweb stores login=0A= # information in the db_prefs cookie in the user's browser. With=0A= # $use_temp_db_prefs_cookie set to 1, the cookie is stored in the=0A= # browser, not on disk. Thus, the cookie gets deleted when the user=0A= # exits the browser, improving security. Otherwise, the cookie will=0A= # remain active until the expiration date specified by=0A= # $global_cookie_expires arrives.=0A= $use_temp_db_prefs_cookie =3D 0;=0A= =0A= # What to use as the -path argument in cookies. Using '' (or omitting=0A= # -path) causes CGI.pm to pass the basename of the script. With that=0A= # setup, moving the location of gnatsweb.pl causes it to see the old=0A= # cookies but not be able to delete them.=0A= $global_cookie_path =3D '/';=0A= $global_cookie_expires =3D '+30d';=0A= =0A= # width of text fields=0A= $textwidth =3D 60;=0A= =0A= # do we allow users to spy on our communications with gnatsd?=0A= # if this is set, setting the 'debug' param will display communications=0A= # with gnatsd to the browser. really only useful to gnats administrators.= =0A= $site_allow_remote_debug =3D 1;=0A= =0A= # delimiter to use within PRs for storage of attachments=0A= # if you change this, all your old PRs with attachments will=0A= # break...=0A= $attachment_delimiter =3D "----gnatsweb-attachment----\n";=0A= =0A= # where to get help -- a web site with translated info documentation=0A= $gnats_info_top =3D 'http://www.gnu.org/software/gnats/gnats_toc.html';=0A= =0A= # end customization=0A= #--------------------------------------------------------------------------= ---=0A= =0A= # Use CGI::Carp first, so that fatal errors come to the browser, including= =0A= # those caused by old versions of CGI.pm.=0A= use CGI::Carp qw/fatalsToBrowser/;=0A= # 8/22/99 kenstir: CGI.pm-2.50's file upload is broken.=0A= # 9/19/99 kenstir: CGI.pm-2.55's file upload is broken.=0A= use CGI 2.56 qw/-nosticky/;=0A= use Socket;=0A= use IO::Handle;=0A= use Text::Tabs;=0A= =0A= # Version number + RCS revision number=0A= $VERSION =3D '3.99.4';=0A= my $REVISION =3D (split(/ /, '$Revision: 1.119 $ '))[1];=0A= my $GNATS_VERS =3D '0.0';=0A= =0A= # bits in fieldinfo(field, flags) has (set=3Dyes not-set=3Dno)=0A= my $SENDINCLUDE =3D 1; # whether the send command should include the fie= ld=0A= my $REASONCHANGE =3D 2; # whether change to a field requires reason=0A= my $READONLY =3D 4; # if set, can't be edited=0A= my $AUDITINCLUDE =3D 8; # if set, save changes in Audit-Trail=0A= my $SENDREQUIRED =3D 16; # whether the send command _must_ include this fi= eld=0A= =0A= # The possible values of a server reply type. $REPLY_CONT means that there= =0A= # are more reply lines that will follow; $REPLY_END Is the final line.=0A= my $REPLY_CONT =3D 1;=0A= my $REPLY_END =3D 2;=0A= =0A= #=0A= # Various PR field names that should probably not be referenced in here.=0A= #=0A= # Actually, the majority of uses are probably OK--but we need to map=0A= # internal names to external ones. (All of these field names correspond=0A= # to internal fields that are likely to be around for a long time.)=0A= #=0A= my $CATEGORY_FIELD =3D 'Kategorie';=0A= my $SYNOPSIS_FIELD =3D 'Betreff';=0A= my $SUBMITTER_ID_FIELD =3D 'Absender-Id';=0A= my $ORIGINATOR_FIELD =3D 'Ersteller';=0A= my $AUDIT_TRAIL_FIELD =3D 'Audit-Trail';=0A= my $RESPONSIBLE_FIELD =3D 'Verantwortlich';=0A= my $LAST_MODIFIED_FIELD =3D 'Letzte_=C4nderung';=0A= my $NUMBER_FIELD =3D 'builtinfield:Nummer';=0A= my $STATE_FIELD =3D 'Status';=0A= my $UNFORMATTED_FIELD =3D 'Unformatted';=0A= #my $RELEASE_FIELD =3D 'Release';=0A= =0A= # we use the access levels defined in gnatsd.h to do=0A= # access level comparisons=0A= #define ACCESS_UNKNOWN 0x00=0A= #define ACCESS_DENY 0x01=0A= #define ACCESS_NONE 0x02=0A= #define ACCESS_SUBMIT 0x03=0A= #define ACCESS_VIEW 0x04=0A= #define ACCESS_VIEWCONF 0x05=0A= #define ACCESS_EDIT 0x06=0A= #define ACCESS_ADMIN 0x07=0A= my %LEVEL_TO_CODE =3D ('deny' =3D> 1,=0A= 'none' =3D> 2,=0A= 'submit' =3D> 3,=0A= 'view' =3D> 4,=0A= 'viewconf' =3D> 5,=0A= 'edit' =3D> 6,=0A= 'admin' =3D> 7);=0A= =0A= =0A= my $CODE_GREETING =3D 200;=0A= my $CODE_CLOSING =3D 201;=0A= my $CODE_OK =3D 210;=0A= my $CODE_SEND_PR =3D 211;=0A= my $CODE_SEND_TEXT =3D 212;=0A= my $CODE_NO_PRS_MATCHED =3D 220;=0A= my $CODE_NO_ADM_ENTRY =3D 221;=0A= my $CODE_PR_READY =3D 300;=0A= my $CODE_TEXT_READY =3D 301;=0A= my $CODE_INFORMATION =3D 350;=0A= my $CODE_INFORMATION_FILLER =3D 351;=0A= my $CODE_NONEXISTENT_PR =3D 400;=0A= my $CODE_EOF_PR =3D 401;=0A= my $CODE_UNREADABLE_PR =3D 402;=0A= my $CODE_INVALID_PR_CONTENTS =3D 403;=0A= my $CODE_INVALID_FIELD_NAME =3D 410;=0A= my $CODE_INVALID_ENUM =3D 411;=0A= my $CODE_INVALID_DATE =3D 412;=0A= my $CODE_INVALID_FIELD_CONTENTS =3D 413;=0A= my $CODE_INVALID_SEARCH_TYPE =3D 414;=0A= my $CODE_INVALID_EXPR =3D 415;=0A= my $CODE_INVALID_LIST =3D 416;=0A= my $CODE_INVALID_DATABASE =3D 417;=0A= my $CODE_INVALID_QUERY_FORMAT =3D 418;=0A= my $CODE_NO_KERBEROS =3D 420;=0A= my $CODE_AUTH_TYPE_UNSUP =3D 421;=0A= my $CODE_NO_ACCESS =3D 422;=0A= my $CODE_LOCKED_PR =3D 430;=0A= my $CODE_GNATS_LOCKED =3D 431;=0A= my $CODE_GNATS_NOT_LOCKED =3D 432;=0A= my $CODE_PR_NOT_LOCKED =3D 433;=0A= my $CODE_CMD_ERROR =3D 440;=0A= my $CODE_WRITE_PR_FAILED =3D 450;=0A= my $CODE_ERROR =3D 600;=0A= my $CODE_TIMEOUT =3D 610;=0A= my $CODE_NO_GLOBAL_CONFIG =3D 620;=0A= my $CODE_INVALID_GLOBAL_CONFIG =3D 621;=0A= my $CODE_NO_INDEX =3D 630;=0A= my $CODE_FILE_ERROR =3D 640;=0A= =0A= $| =3D 1; # flush output after each print=0A= =0A= # A couple of internal status variables:=0A= # Have the HTTP header, start_html, heading already been printed?=0A= my $print_header_done =3D 0;=0A= my $page_start_html_done =3D 0;=0A= my $page_heading_done =3D 0;=0A= =0A= sub gerror=0A= {=0A= my($text) =3D @_;=0A= my $page =3D 'Fehler';=0A= print_header();=0A= page_start_html($page);=0A= page_heading($page, 'Fehler');=0A= print "

$text\n

\n";=0A= }=0A= =0A= # Close the client socket and exit. The exit can be suppressed by:=0A= # setting $suppress_client_exit =3D 1 in the calling routine (using local)= =0A= # [this is only set in edit_pr and the initial login section]=0A= sub client_exit=0A= {=0A= if (! defined($suppress_client_exit))=0A= {=0A= close(SOCK);=0A= exit();=0A= }=0A= else=0A= {=0A= $client_would_have_exited =3D 1;=0A= }=0A= }=0A= =0A= sub server_reply=0A= {=0A= my($state, $text, $type);=0A= my $raw_reply =3D ;=0A= if(defined($reply_debug))=0A= {=20=20=0A= print_header();=0A= print "server_reply: $raw_reply
\n";=0A= }=0A= if($raw_reply =3D~ /(\d+)([- ]?)(.*$)/)=0A= {=0A= $state =3D $1;=0A= $text =3D $3;=0A= if($2 eq '-')=0A= {=0A= $type =3D $REPLY_CONT;=0A= }=0A= else=0A= {=0A= if($2 ne ' ')=0A= {=0A= gerror("bad type of reply from server");=0A= }=0A= $type =3D $REPLY_END;=0A= }=0A= return ($state, $text, $type);=0A= }=0A= else=0A= {=0A= # unparseable reply. send back the raw reply for error reporting=0A= return (undef, undef, undef, $raw_reply);=0A= }=0A= }=0A= =0A= sub read_server=0A= {=0A= my(@text);=0A= =0A= while()=0A= {=0A= if(defined($reply_debug))=0A= {=0A= print_header();=0A= print "read_server: $_
\n";=0A= }=0A= if(/^\.\r/)=0A= {=0A= return @text;=0A= }=0A= $_ =3D~ s/[\r\n]//g;=0A= # Lines which begin with a '.' are escaped by gnatsd with another '.'= =0A= $_ =3D~ s/^\.\././;=0A= push(@text, $_);=0A= }=0A= }=0A= =0A= sub get_reply=0A= {=0A= my $client_cmd_debug =3D 1;=0A= my $reply_debug =3D 1;=0A= my @rettext =3D ();=0A= my ($state, $text, $type, $raw_reply);=0A= =0A= do {=0A= ($state, $text, $type, $raw_reply) =3D server_reply();=0A= =0A= unless ($state) {=0A= # gnatsd has returned something unparseable=0A= if ($reply_debug || $client_cmd_debug) {=0A= gerror("unparseable reply from gnatsd: $raw_reply;; user=3D$db_prefs{'= user'}, db=3D$global_prefs{'database'}; stacktrace: ", print_stacktrace())= =0A= } else {=0A= gerror("Unparseable reply from gnatsd");=0A= }=0A= warn("gnatsweb: unparseable gnatsd output: $raw_reply; user=3D$db_prefs{'u= ser'}, db=3D$global_prefs{'database'}; stacktrace: ", print_stacktrace());= =0A= return;=0A= }=0A= =0A= if($state =3D=3D $CODE_GREETING)=0A= {=0A= push(@rettext, $text);=0A= # nothing=0A= }=0A= elsif($state =3D=3D $CODE_OK || $state =3D=3D $CODE_GREETING=20=0A= || $state =3D=3D $CODE_CLOSING)=0A= {=0A= push(@rettext, $text);=0A= # nothing=0A= }=0A= elsif($state =3D=3D $CODE_PR_READY || $state =3D=3D $CODE_TEXT_READY)= =0A= {=0A= @rettext =3D read_server();=0A= }=0A= elsif($state =3D=3D $CODE_SEND_PR || $state =3D=3D $CODE_SEND_TEXT)=0A= {=0A= # nothing, tho it would be better...=0A= }=0A= elsif($state =3D=3D $CODE_INFORMATION_FILLER)=0A= {=0A= # nothing=0A= }=0A= elsif($state =3D=3D $CODE_INFORMATION)=0A= {=0A= push(@rettext, $text);=0A= }=0A= elsif($state =3D=3D $CODE_NO_PRS_MATCHED)=0A= {=0A= gerror("Return code: $state - $text");=0A= page_footer('Fehler');=0A= page_end_html('Fehler');=0A= client_exit();=0A= push(@rettext, $text);=0A= }=0A= elsif($state >=3D 400 && $state <=3D 799)=0A= {=0A= if ($state =3D=3D $CODE_NO_ACCESS)=20=0A= {=0A= if ($site_gnatsweb_server_auth) {=0A= $text =3D " Sie haben keinen Zugriff auf die Datenbank \"$global_prefs= {'database'}\"";=0A= # $text =3D " You do not have access to database \"$global_prefs{'data= base'}\"";=0A= } else {=0A= $text =3D " Zufriff verweigert (Bitte melden Sie sich erneut an und pr= =FCfen Sie Username und Passwort)";=0A= # $text =3D " Access denied (login again & check usercode/password)";= =0A= }=0A= }=0A= gerror("Return code: $state - $text");=0A= warn("gnatsweb: gnatsd error $state-$text; user=3D$db_prefs{'user'}, = db=3D$global_prefs{'database'}; stacktrace: ", print_stacktrace());=0A= page_footer('Fehler');=0A= page_end_html('Fehler');=0A= client_exit();=0A= push(@rettext, $text);=0A= }=0A= else=0A= {=0A= # gnatsd returned a state, but we don't know what it is=0A= push(@rettext, $text);=0A= gerror("Cannot understand gnatsd output: $state '$text'");=0A= warn("gnatsweb: gnatsd error $state-$text; user=3D$db_prefs{'user'}, = db=3D$global_prefs{'database'}; stacktrace: ", print_stacktrace());=0A= }=0A= } until ($type !=3D $REPLY_CONT);=0A= return @rettext;=0A= }=0A= =0A= =0A= # print a stacktrace=0A= # used by the various warn() statments to emit useful diagnostics=0A= # to the web server error logs.=0A= sub print_stacktrace {=0A= my @stacktrace;=0A= my $i =3D 1;=0A= while ( my($subroutine) =3D (caller($i++))[3] ) {=0A= push(@stacktrace, $subroutine);=0A= }=0A= return 'In: ' . join(' <=3D ', @stacktrace);=0A= }=0A= =0A= sub multiselect_menu=0A= {=0A= my $size =3D @{$_[1]} < 4 ? @{$_[1]} : 4;=0A= return $q->scrolling_list(-name=3D>$_[0], -values=3D>$_[1], -size=3D>$siz= e,=0A= -multiple=3D>'true', -default=3D>$_[2]);=0A= }=0A= =0A= sub popup_or_scrolling_menu=0A= {=0A= my $size=3D$_[3];=0A= if (!(defined $size))=0A= {=0A= $size =3D $scrolling_menu_default_size;=0A= }=0A= =0A= # a hack to make responsible field easier to deal with when=0A= # there are many names in the responsible file=0A= if ($_[0] =3D~ m/responsible/i) {=0A= $size =3D 5;=0A= }=0A= =0A= # put human readable values in the popup lists for common=0A= # gnats fields=0A= my $labels;=0A= if ($_[0] eq "Kategorie") {=0A= $labels =3D \%category_desc;=0A= }=0A= elsif ($_[0] eq "Verantwortlich") {=0A= $labels =3D \%responsible_complete;=0A= }=0A= elsif ($_[0] eq "Absender-Id") {=0A= $labels =3D \%submitter_complete;=0A= }=0A= =0A= if ($#{$_[1]} >=3D $popup_menu_becomes_obnoxious)=0A= {=0A= return $q->scrolling_list (-name=3D>$_[0],=0A= -size=3D>$size,=0A= -values=3D>$_[1],=0A= -labels=3D>$labels,=0A= -default=3D>$_[2]);=0A= }=0A= else=0A= {=0A= return $q->popup_menu (-name=3D>$_[0],=0A= -values=3D>$_[1],=0A= -labels=3D>$labels,=0A= -default=3D>$_[2]);=0A= =0A= }=0A= }=0A= =0A= # wrapper functions for formstart...=0A= sub multipart_form_start=0A= {=0A= formstart(1, @_);=0A= }=0A= sub form_start=0A= {=0A= formstart(0, @_);=0A= }=0A= =0A= # workaround for an exceedingly dumb netscape bug. we hates=0A= # netscape... this bug manifests if you click on the "create"=0A= # button bar link (but not the grey button on the main page), submit a=0A= # PR, then hit the back button (usually because you got an error).=0A= # you're taken "back" to the same error page -- all the stuff you=0A= # entered into the submission form is *gone*. this is kind of annoying...= =0A= # (it also manifests if you click the edit link from the query results page= .)=0A= sub formstart=0A= {=0A= # this bugfix is mostly lifted from the CGI.pm docs. here's what they= =0A= # have to say:=0A= # When you press the "back" button, the same page is loaded, not=0A= # the previous one. Netscape's history list gets confused=0A= # when processing multipart forms. If the script generates=0A= # different pages for the form and the results, hitting the=0A= # "back" button doesn't always return you to the previous page;=0A= # instead Netscape reloads the current page. This happens even=0A= # if you don't use an upload file field in your form.=0A= #=0A= # A workaround for this is to use additional path information to=0A= # trick Netscape into thinking that the form and the response=0A= # have different URLs. I recommend giving each form a sequence=0A= # number and bumping the sequence up by one each time the form=0A= # is accessed:=0A= =0A= # should we do multipart?=0A= my $multi =3D shift;=0A= =0A= # in case the caller has some args to pass...=0A= my %args =3D @_;=0A= =0A= # if the caller has given an "action" arg, we don't do any=0A= # subterfuge. let the caller worry about the bug...=0A= if (!exists $args{'-action'}) {=0A= # get sequence number and increment it=0A= my $s =3D $q->path_info =3D~ m{/(\d+)/?$};=0A= $s++;=0A= # Trick Netscape into thinking it's loading a new script:=0A= $args{-action} =3D $q->script_name . "/$s";=0A= }=0A= =0A= if ($multi) {=0A= print $q->start_multipart_form(%args);=0A= } else {=0A= print $q->start_form(%args);=0A= }=0A= =0A= return;=0A= }=0A= =0A= sub fieldinfo=0A= {=0A= my ($fieldname, $member) =3D @_;=0A= return $fielddata{$fieldname}{$member};=0A= }=0A= =0A= sub isvalidfield=0A= {=0A= return exists($fielddata{$_[0]}{'fieldtype'});=0A= }=0A= =0A= sub init_fieldinfo=0A= {=0A= my $debug =3D 0;=0A= my $field;=0A= =0A= @fieldnames =3D client_cmd("list FieldNames");=0A= my @type =3D client_cmd ("ftyp ". join(" ",@fieldnames));=0A= my @desc =3D client_cmd ("fdsc ". join(" ",@fieldnames));=0A= my @flgs =3D client_cmd ("fieldflags ". join(" ",@fieldnames));=0A= my @fdflt =3D client_cmd ("inputdefault ". join(" ",@fieldnames));=0A= foreach $field (@fieldnames) {=0A= $fielddata{$field}{'flags'} =3D 0;=0A= $fielddata{$field}{'fieldtype'} =3D lc(shift @type);=0A= $fielddata{$field}{'desc'} =3D shift @desc;=0A= $fielddata{$field}{'fieldflags'} =3D lc(shift @flgs);=0A= if ($fielddata{$field}{'fieldflags'} =3D~ /requirechangereason/)=0A= {=0A= $fielddata{$field}{'flags'} |=3D $REASONCHANGE;=0A= }=0A= if ($fielddata{$field}{'fieldflags'} =3D~ /readonly/)=0A= {=0A= $fielddata{$field}{'flags'} |=3D $READONLY;=0A= }=0A= if ($fielddata{$field}{'fieldtype'} eq 'multienum')=0A= {=0A= my @response =3D client_cmd("ftypinfo $field separators");=0A= $response[0] =3D~ /'(.*)'/;=0A= $fielddata{$field}{'separators'} =3D $1;=0A= $fielddata{$field}{'default_sep'} =3D substr($1, 0, 1);=0A= }=0A= my @values =3D client_cmd ("fvld $field");=0A= $fielddata{$field}{'values'} =3D [@values];=0A= $fielddata{$field}{'default'} =3D shift (@fdflt);=0A= $fielddata{$field}{'default'} =3D~ s/\\n/\n/g;=0A= $fielddata{$field}{'default'} =3D~ s/\s$//;=0A= }=0A= foreach $field (client_cmd ("list InitialInputFields")) {=0A= $fielddata{$field}{flags} |=3D $SENDINCLUDE;=0A= }=0A= foreach $field (client_cmd ("list InitialRequiredFields")) {=0A= $fielddata{$field}{flags} |=3D $SENDREQUIRED;=0A= }=0A= if ($debug)=0A= {=0A= foreach $field (@fieldnames) {=0A= warn "name =3D $field\n";=0A= warn " type =3D $fielddata{$field}{'fieldtype'}\n";=0A= warn " flags =3D $fielddata{$field}{'flags'}\n";=0A= warn " values =3D $fielddata{$field}{'values'}\n";=0A= warn "\n";=0A= }=0A= }=0A= }=0A= =0A= sub client_init=0A= {=0A= my($iaddr, $paddr, $proto, $line, $length);=0A= if(!($iaddr =3D inet_aton($site_gnats_host)))=0A= {=0A= error_page("Unknown GNATS host '$site_gnats_host'",=0A= "Check your Gnatsweb configuration.");=0A= exit();=0A= }=0A= $paddr =3D sockaddr_in($site_gnats_port, $iaddr);=0A= =0A= $proto =3D getprotobyname('tcp');=0A= if(!socket(SOCK, PF_INET, SOCK_STREAM, $proto))=0A= {=0A= gerror("socket: $!");=0A= warn("gnatsweb: client_init error: $! ; user=3D$db_prefs{'user'}, db=3D= $global_prefs{'database'}; stacktrace: ", print_stacktrace());=0A= exit();=0A= }=0A= if(!connect(SOCK, $paddr))=0A= {=0A= gerror("connect: $!");=0A= warn("gnatsweb: client_init error: $! ; user=3D$db_prefs{'user'}, db=3D= $global_prefs{'database'}; stacktrace: ", print_stacktrace());=0A= exit();=0A= }=0A= SOCK->autoflush(1);=0A= get_reply();=0A= }=0A= =0A= # to debug:=0A= # local($client_cmd_debug) =3D 1;=0A= # client_cmd(...);=0A= sub client_cmd=0A= {=0A= my($cmd) =3D @_;=0A= my $debug =3D 0;=0A= print SOCK "$cmd\n";=0A= warn "client_cmd: $cmd" if $debug;=0A= if(defined($client_cmd_debug))=0A= {=0A= print_header();=0A= print "
client_cmd: 
$cmd

\n";=0A= }=0A= return get_reply();=0A= }=0A= =0A= =0A= # keep the "cached" value of $can_do_mime lexically scoped=0A= do {=0A= my $can_do_mime;=0A= =0A= # Return true if module MIME::Base64 is available. If available, it's= =0A= # loaded the first time this sub is called.=0A= sub can_do_mime=0A= {=0A= return $can_do_mime if (defined($can_do_mime));=0A= =0A= eval 'use MIME::Base64;';=0A= if ($@) {=0A= warn "HINWEIS: Das Fileuploadfeatur kann nicht ohne das MIME::Base64= modul genutzt werden\n";=0A= $can_do_mime =3D 0;=0A= } else {=0A= $can_do_mime =3D 1;=0A= }=0A= $can_do_mime;=0A= }=0A= };=0A= =0A= # Take the file attachment's file name, and return only the tail. Don't=0A= # want to store any path information, for security and clarity. Support=0A= # both DOS-style and Unix-style paths here, because we have both types of= =0A= # clients.=0A= sub attachment_filename_tail=0A= {=0A= my($filename) =3D @_;=0A= $filename =3D~ s,.*/,,; # Remove leading Unix path elements.=0A= $filename =3D~ s,.*\\,,; # Remove leading DOS path elements.=0A= =0A= return $filename;=0A= }=0A= =0A= # Retrieve uploaded file attachment. Return it as=0A= # ($filename, $content_type, $data). Returns (undef,undef,undef)=0A= # if not present.=0A= #=0A= # See 'perldoc CGI' for details about this code.=0A= sub get_attachment=0A= {=0A= my $upload_param_name =3D shift;=0A= my $debug =3D 0;=0A= my $filename =3D $q->param($upload_param_name);=0A= return (undef, undef, undef) unless $filename;=0A= =0A= # 9/6/99 kenstir: My testing reveals that if uploadInfo returns undef,=0A= # then you can't read the file either.=0A= warn "get_attachment: filename=3D$filename\n" if $debug;=0A= my $hashref =3D $q->uploadInfo($filename);=0A= if (!defined($hashref)) {=0A= warn("gnatsweb: attachment filename w/o attachment; user=3D$db_prefs{'u= ser'}, db=3D$global_prefs{'database'}; stacktrace: ", print_stacktrace());= =0A= die "Got attachment filename ($filename) but no attachment data! Proba= bly this is a programming error -- the form which submitted this data must = be multipart/form-data (start_multipart_form()).";=0A= }=0A= if ($debug) {=0A= my ($k, $v);=0A= while (($k, $v) =3D each %$hashref) {=0A= warn "get_attachment: uploadInfo($k)=3D$v\n";=0A= }=0A= }=0A= =0A= # 9/6/99 kenstir: When testing locally on Linux, a .gz file yielded=0A= # no Content-Type. Therefore, have to assume binary. Would like to=0A= # check (-B $fh) to see if the stream is binary but that doesn't work.=0A= my $ctype =3D $hashref->{'Content-Type'} || 'application/octet-stream';= =0A= warn "get_attachment: Content-Type=3D$ctype\n" if $debug;=0A= =0A= my $data =3D '';=0A= my $buf;=0A= my $fh =3D $q->upload($upload_param_name);=0A= warn "get_attachment: fh=3D$fh\n" if $debug;=0A= while (read($fh, $buf, 1024)) {=0A= $data .=3D $buf;=0A= }=0A= close $fh;=0A= =0A= return ($filename, $ctype, $data);=0A= }=0A= =0A= # Retrieve uploaded file attachment, and encode it so that it's=20=0A= # printable, for inclusion into the PR text.=0A= #=0A= # Returns the printable text representing the attachment. Returns '' if=0A= # the attachment was not present.=0A= sub encode_attachment=0A= {=0A= my $upload_param_name =3D shift;=0A= my $debug =3D 0;=0A= =0A= return '' unless can_do_mime();=0A= =0A= my ($filename, $ctype, $data) =3D get_attachment($upload_param_name);=0A= return '' unless $filename;=0A= =0A= # Strip off path elements in $filename.=0A= $filename =3D attachment_filename_tail($filename);=0A= =0A= warn "encode_attachment: $filename was ", length($data), " bytes of $ctyp= e\n"=0A= if $debug;=0A= my $att =3D '';=0A= =0A= # Plain text is included inline; all else is encoded.=0A= $att .=3D "Content-Type: $ctype; name=3D\"$filename\"\n";=0A= if ($ctype eq 'text/plain') {=0A= $att .=3D "Content-Disposition: inline; filename=3D\"$filename\"\n\n";= =0A= $att .=3D $data;=0A= }=0A= else {=0A= $att .=3D "Content-Transfer-Encoding: base64\n";=0A= $att .=3D "Content-Disposition: attachment; filename=3D\"$filename\"\n\= n";=0A= $att .=3D encode_base64($data);=0A= }=0A= warn "encode_attachment: done\n" if $debug;=0A= =0A= return $att;=0A= }=0A= =0A= # Takes the encoded file attachment, decodes it and returns it as a hashref= .=0A= sub decode_attachment=0A= {=0A= my $att =3D shift;=0A= my $debug =3D 0;=0A= my $hash_ref =3D {'original_attachment' =3D> $att};=0A= =0A= # Split the envelope from the body.=0A= my ($envelope, $body) =3D split(/\n\n/, $att, 2);=0A= return $hash_ref unless ($envelope && $body);=0A= =0A= # Split mbox-like headers into (header, value) pairs, with a leading=0A= # "From_" line swallowed into USELESS_LEADING_ENTRY. Junk the leading=0A= # entry. Chomp all values.=0A= warn "decode_attachment: envelope=3D>$envelope<=3D\n" if $debug;=0A= %$hash_ref =3D (USELESS_LEADING_ENTRY =3D> split /^(\S*?):\s*/m, $envelop= e);=0A= delete($hash_ref->{USELESS_LEADING_ENTRY});=0A= for (keys %$hash_ref) {=0A= chomp $hash_ref->{$_};=0A= }=0A= =0A= # Keep the original_attachment intact.=0A= $$hash_ref{'original_attachment'} =3D $att;=0A= =0A= if (!$$hash_ref{'Content-Type'}=0A= || !$$hash_ref{'Content-Disposition'})=0A= {=0A= warn("gnatsweb: unable to parse file attachment; user=3D$db_prefs{'user= '}, db=3D$global_prefs{'database'}; stacktrace: ", print_stacktrace());=0A= die "Unable to parse file attachment";=0A= }=0A= =0A= # Parse filename.=0A= # Note: the extra \ before the " is just so that perl-mode can parse it.= =0A= if ($$hash_ref{'Content-Disposition'} !~ /(\S+); filename=3D\"([^\"]+)\"/= ) {=0A= warn("gnatsweb: unable to parse file attachment Content-Disposition; us= er=3D$db_prefs{'user'}, db=3D$global_prefs{'database'}; stacktrace: ", prin= t_stacktrace());=0A= die "Unable to parse file attachment Content-Disposition";=0A= }=0A= $$hash_ref{'filename'} =3D attachment_filename_tail($2);=0A= =0A= # Decode the data if encoded.=0A= if (exists($$hash_ref{'Content-Transfer-Encoding'})=0A= && $$hash_ref{'Content-Transfer-Encoding'} eq 'base64')=0A= {=0A= $$hash_ref{'data'} =3D decode_base64($body);=0A= }=0A= else {=0A= $$hash_ref{'data'} =3D $body;=0A= }=0A= =0A= return $hash_ref;=0A= }=0A= =0A= # Print file attachment browser and buttons to download the attachments.=0A= # Which of these appear depend on the mode.=0A= sub print_attachments=0A= {=0A= my($fields_hash_ref, $mode) =3D @_;=0A= =0A= return unless can_do_mime();=0A= =0A= print "Datei Anh=E4nge:\n";=0A= =0A= # Add file upload button for adding new attachment.=0A= if ($mode eq 'sendpr' || $mode eq 'edit') {=0A= print "Add a file attachment:
",=0A= $q->filefield(-name=3D>'attached_file',=0A= -size=3D>50);=0A= # that's all we need to do if this is the sendpr page=0A= return if $mode eq 'sendpr';=0A= }=0A= =0A= # Print table of existing attachments.=0A= # Add column with delete button in edit mode.=0A= my $array_ref =3D $$fields_hash_ref{'attachments'};=0A= my $table_rows_aref =3D [];=0A= my $i =3D 0;=0A= foreach my $hash_ref (@$array_ref) {=0A= my $size =3D int(length($$hash_ref{'data'}) / 1024.0);=0A= $size =3D 1 if ($size < 1);=0A= my $row_data =3D $q->td( [ $q->submit('cmd', "download attachment $i"),= =0A= $$hash_ref{'filename'},=0A= "${size}k" ] );=0A= $row_data .=3D $q->td($q->checkbox(-name=3D>'delete attachments',=0A= -value=3D>$i,=0A= -label=3D>"delete attachment $i"))=0A= if ($mode eq 'edit');=0A= push(@$table_rows_aref, $row_data);=0A= $i++;=0A= }=0A= if (@$table_rows_aref)=0A= {=0A= my $header_row_data =3D $q->th( ['download','filename','size' ] );=0A= $header_row_data .=3D $q->th('delete')=0A= if ($mode eq 'edit');=0A= print $q->table({-border=3D>1},=0A= $q->Tr($header_row_data),=0A= $q->Tr($table_rows_aref));=0A= print "\n\n";=0A= }=0A= }=0A= =0A= # The user has requested download of a particular attachment.=0A= # Serve it up.=0A= sub download_attachment=0A= {=0A= my $attachment_number =3D shift;=0A= my($pr) =3D $q->param('pr');=0A= =0A= # strip out leading category (and any other non-digit trash) from $pr=0A= $pr =3D~ s/\D//g;=0A= =0A= if(!$pr) {=20=0A= warn("gnatsweb: download_attachment called with no PR number; user=3D= $db_prefs{'user'}, db=3D$global_prefs{'database'}; stacktrace: ", print_sta= cktrace());=0A= die "download_attachment called with no PR number"=0A= }=0A= =0A= my(%fields) =3D readpr($pr);=0A= my $array_ref =3D $fields{'attachments'};=0A= my $hash_ref =3D $$array_ref[$attachment_number];=0A= my $disp;=0A= =0A= # Internet Explorer 5.5 does not handle "content-disposition: attachment"= =0A= # in the expected way. It needs a content-disposition of "file".=0A= ($ENV{'HTTP_USER_AGENT'} =3D~ "MSIE 5.5") ? ($disp =3D 'file') : ($disp = =3D 'attachment');=0A= # Now serve the attachment, with the appropriate headers.=0A= print_header(-type =3D> 'application/octet-stream',=0A= -content_disposition =3D> "$disp; filename=3D\"$$hash_ref{'f= ilename'}\"");=0A= print $$hash_ref{'data'};=0A= }=0A= =0A= # Add the given (gnatsweb-encoded) attachment to the %fields hash.=0A= sub add_encoded_attachment_to_pr=0A= {=0A= my($fields_hash_ref, $encoded_attachment) =3D @_;=0A= return unless $encoded_attachment;=0A= my $ary_ref =3D $$fields_hash_ref{'attachments'} || [];=0A= my $hash_ref =3D { 'original_attachment' =3D> $encoded_attachment };=0A= push(@$ary_ref, $hash_ref);=0A= $$fields_hash_ref{'attachments'} =3D $ary_ref;=0A= }=0A= =0A= # Add the given (gnatsweb-decoded) attachment to the %fields hash.=0A= sub add_decoded_attachment_to_pr=0A= {=0A= my($fields_hash_ref, $decoded_attachment_hash_ref) =3D @_;=0A= return unless $decoded_attachment_hash_ref;=0A= my $ary_ref =3D $$fields_hash_ref{'attachments'} || [];=0A= push(@$ary_ref, $decoded_attachment_hash_ref);=0A= $$fields_hash_ref{'attachments'} =3D $ary_ref;=0A= }=0A= =0A= # Remove the given attachments from the %fields hash.=0A= sub remove_attachments_from_pr=0A= {=0A= my($fields_hash_ref, @attachment_numbers) =3D @_;=0A= return unless @attachment_numbers;=0A= my $ary_ref =3D $$fields_hash_ref{'attachments'} || [];=0A= foreach my $attachment_number (@attachment_numbers)=0A= {=0A= # Remove the attachment be replacing it with the empty hash.=0A= # The sub unparsepr skips these.=0A= $$ary_ref[$attachment_number] =3D {};=0A= }=0A= }=0A= =0A= # sendpr -=0A= # The Create PR page.=0A= #=0A= sub sendpr=0A= {=0A= my $client_cmd_debug =3D 1;=0A= my $page =3D 'PD Ticket Erstellen';=0A= page_start_html($page);=0A= page_heading($page, 'Neues Ticket erfassen');=0A= =0A= print multipart_form_start(-name=3D>'PrForm'), "\n",=0A= hidden_db(),=0A= hidden_debug(),=0A= $q->span($q->submit('cmd', 'senden'),=0A= " oder ",=0A= $q->reset(-name=3D>'reset')),=0A= $q->hidden(-name=3D>'return_url'),=0A= "
\n",=0A= "";=0A= my $def_email =3D $global_prefs{'email'} || '';=0A= print "\n\n\n\n";=0A= # keep count of field number, so that javascript hooks can=0A= # have a way to access fields with dashes in their names=0A= # they'll need to use PrForm.elements[fieldNumber].value=0A= # instead of the dashed name=0A= # note that this is a zero-based count!!=0A= # there are six fields "hardcoded" into the form above this point.=0A= my $field_number =3D 5;=0A= =0A= foreach (@fieldnames)=0A= {=0A= if (! (fieldinfo ($_, 'flags') & $SENDINCLUDE))=0A= {=0A= next;=0A= }=0A= =0A= $field_number++;=0A= =0A= # Get default value(s).=0A= my $default =3D fieldinfo($_, 'default');=0A= =0A= my $values =3D fieldinfo($_, 'values');=0A= =0A= # The "intro" provides a way for the site callback to print something= =0A= # at the top of a given field.=0A= my $intro =3D cb("sendpr_intro_$_", $field_number) || '';=0A= =0A= print "\n\n";=0A= }=0A= elsif (fieldinfo ($_, 'fieldtype') eq 'multienum')=0A= {=0A= my $defaultsref =3D parse_multienum($default, $_);=0A= print multiselect_menu($_, $values, $defaultsref),=0A= "\n\n";=0A= }=0A= elsif (fieldinfo($_, 'fieldtype') eq "multitext")=0A= {=0A= my $rows =3D 4;=0A= print $q->textarea(-name=3D>$_,=0A= -cols=3D>$textwidth,=0A= -rows=3D>$rows,=0A= -default=3D>$default),=0A= "\n\n";=0A= # Create file upload button after Description.=0A= if (/Description/)=0A= {=0A= print_attachments(undef, 'sendpr');=0A= }=0A= }=0A= else=0A= {=0A= print $q->textfield(-name=3D>$_,=0A= -size=3D>$textwidth,=0A= -default=3D>$default),=0A= "\n\n";=0A= }=0A= print "\n";=0A= }=0A= print "
Absender eMail:",=0A= $q->textfield(-name=3D>'email',=0A= -default=3D>$def_email,=0A= -size=3D>$textwidth), "
";=0A= fieldinfo ($_, 'flags') & $SENDREQUIRED ?=0A= print "$_" : = print "$_";=0A= print "
\n",=0A= fieldinfo($_, 'desc'),=0A= "		\n", $intro, "\n";=0A= =0A= if (fieldinfo($_, 'fieldtype') eq "enum")=0A= {=0A= # Force user to choose a category.=0A= if ($_ eq $CATEGORY_FIELD)=0A= {=0A= push(@$values, "unknown") if (!grep /^unknown$/, @$values);=0A= $default =3D "unknown";=0A= }=0A= print popup_or_scrolling_menu($_, $values, $default),=0A= "
",=0A= $q->p($q->submit('cmd', 'senden'),=0A= " oder ",=0A= $q->reset(-name=3D>'reset')),=0A= $q->end_form();=0A= =0A= page_footer($page);=0A= page_end_html($page);=0A= }=0A= =0A= # validate_email_field -=0A= # Used by validate_new_pr to check email address fields in a new PR.=0A= sub validate_email_field=0A= {=0A= my($fieldname, $fieldval, $required) =3D @_;=0A= =0A= my $blank =3D ($fieldval =3D~ /^\s*$/);=0A= if ($required && $blank)=0A= {=0A= return "$fieldname Pflichtfeld und ist leer";=0A= # return "$fieldname is blank";=0A= }=0A= # From rkimball@vgi.com, allows @ only if it's followed by what looks=0A= # more or less like a domain name.=0A= my $email =3D '[^@\s]+(@\S+\.\S+)?';=0A= if (!$blank && $fieldval !~ /^\s*($email\s*)+$/)=0A= {=0A= return "'$fieldval' scheint keine g=FCltige eMail adresse zu sein. (Auf= bau: xxx\@xxx.xxx)";=0A= # return "'$fieldval' doesn't look like a valid email address (xxx\@xxx= .xxx)";=0A= }=0A= return '';=0A= }=0A= =0A= # validate_new_pr -=0A= # Make sure fields have reasonable values before submitting a new PR.= =0A= sub validate_new_pr=0A= {=0A= my(%fields) =3D @_;=0A= my(@errors) =3D ();=0A= my $err;=0A= =0A= # validate email fields=0A= $err =3D validate_email_field('E-mail Address', $fields{'email'}, 'requir= ed');=0A= push(@errors, $err) if $err;=0A= =0A= # XXX ??? !!! FIXME=0A= # validate some other fields=0A= if($fields{$CATEGORY_FIELD} =3D~ /^\s*$/=20=0A= || $fields{$CATEGORY_FIELD} eq "unknown")=0A= {=0A= push(@errors, "Kategorie ist nicht gef=FCllt oder 'unknown'");=0A= }=0A= if($fields{$SYNOPSIS_FIELD} =3D~ /^\s*$/=0A= || $fields{$SYNOPSIS_FIELD} eq "unknown")=0A= {=0A= push(@errors, "Betreff ist nicht gef=FCllt oder 'unknown'");=0A= }=0A= if($fields{$SUBMITTER_ID_FIELD} eq 'unknown')=0A= {=0A= push(@errors, "Absender-Id ist 'unknown'");=0A= }=0A= =0A= @errors;=0A= }=0A= =0A= sub submitnewpr=0A= {=0A= my $page =3D 'Erstelle Ticket Ergebnisse';=0A= =0A= my $debug =3D 0;=0A= my(@values, $key);=0A= my(%fields);=0A= =0A= foreach $key ($q->param)=0A= {=0A= my $val =3D $q->param($key);=0A= if((fieldinfo ($key, 'fieldtype') || '') eq 'multitext')=0A= {=0A= $val =3D fix_multiline_val($val);=0A= }=0A= elsif((fieldinfo ($key, 'fieldtype') || '') eq 'multienum')=0A= {=0A= my @val =3D $q->param($key);=0A= $val =3D unparse_multienum(\@val, $key);=0A= }=0A= $fields{$key} =3D $val;=0A= }=0A= =0A= # Make sure the pr is valid.=0A= my(@errors) =3D validate_new_pr(%fields);=0A= if (@errors)=0A= {=0A= print_header(-cookie =3D> create_global_cookie());=0A= page_start_html($page);=0A= page_heading($page, 'Fehler');=0A= print "

Ihre Anfrage wurde nicht gesendet.

\n",=0A= "

Bitte bereinigen sie folgende Unplausibilit=E4ten und senden = Sie die Anfrage erneut:

",=0A= $q->ul($q->li(\@errors));=0A= return;=0A= }=0A= =0A= my $fullname=3D$db_prefs{'user'};=0A= if (exists ($responsible_fullname{$fullname}))=0A= {=0A= $fullname=3D" (".$responsible_fullname{$fullname}.")";=0A= }=0A= else=0A= {=0A= $fullname=3D"";=0A= }=0A= # Supply a default value for Originator=0A= $fields{$ORIGINATOR_FIELD} =3D $fields{$ORIGINATOR_FIELD} || ($fields{'em= ail'} . $fullname);=0A= =0A= # Handle the attached_file, if any.=0A= add_encoded_attachment_to_pr(\%fields, encode_attachment('attached_file')= );=0A= =0A= # Compose the PR.=0A= my $text =3D unparsepr('send', %fields);=0A= $text =3D < create_global_cookie());=0A= page_start_html($page);=0A= print "

debugging -- PR NOT SENT

",=0A= $q->pre($q->escapeHTML($text)),=0A= "
";=0A= page_end_html($page);=0A= return;=0A= }=0A= =0A= # Check PR text before submitting=0A= client_cmd ("chek initial");=0A= # If the check fails, the next call will exit after leaving=0A= # an error message.=0A= client_cmd("$text.");=0A= =0A= client_cmd ("subm");=0A= client_cmd("$text.");=0A= =0A= my $return_url =3D $q->param('return_url') || get_script_name();=0A= my $refresh =3D 5;=0A= =0A= print_header(-Refresh =3D> "$refresh; URL=3D$return_url",=0A= -cookie =3D> create_global_cookie());=0A= =0A= # Workaround for MSIE:=0A= my @extra_head_args =3D (-head =3D> $q->meta({-http_equiv=3D>'Refresh',= =0A= -content=3D>"$refresh; URL=3D$return_url"= }));=0A= =0A= page_start_html($page, 0, \@extra_head_args);=0A= =0A= # Give feedback for success=0A= page_heading($page, 'Die Anfrage wurde versendet.');=0A= print "

Danke f=FCr diese Anfrage. Ihr Auftrag wird verarbeitet.=20=20= =20=0A= Sie erhalten in K=FCrze eine automatisch generierte eMail, die den=20=0A= gesamten Vorgang, inclusive die Ticketnummer, und der Person/Gruppe=20=0A= der die Anfrage zugeordnet wurde.

";=0A= print "

Sie werden in $refresh Sekunden auf ihre vorherige Seite weitergeleitet...

";=0A= =0A= page_footer($page);=0A= page_end_html($page);=0A= }=0A= =0A= # Return a URL which will take one to the specified $pr and with a=0A= # specified $cmd. For commands such as 'erstellen' that have no=0A= # associated PR number, we pass $pr =3D 0, and this routine then leaves=0A= # out the pr parameter. For ease of use, when the user makes a=0A= # successful edit, we want to return to the URL he was looking at=0A= # before he decided to edit the PR. The return_url param serves to=0A= # store that info, and is included if $include_return_url is=0A= # specified. Note that the return_url is saved even when going into=0A= # the view page, since the user might go from there to the edit page.=0A= #=0A= sub get_pr_url=0A= {=0A= my($cmd, $pr, $include_return_url) =3D @_;=0A= my $url =3D $q->url() . "?cmd=3D$cmd&database=3D$global_prefs{'database'}= ";=0A= $url .=3D "&pr=3D$pr" if $pr;=0A= $url .=3D "&return_url=3D" . $q->escape($q->self_url())=0A= if $include_return_url;=0A= return $url;=0A= }=0A= =0A= # Return a URL to edit the given pr. See get_pr_url().=0A= #=0A= sub get_editpr_url=0A= {=0A= return get_pr_url('edit', @_);=0A= }=0A= =0A= # Return a URL to view the given pr. See get_pr_url().=0A= #=0A= sub get_viewpr_url=0A= {=0A= my $viewcmd =3D $include_audit_trail ? 'view%20audit-trail' : 'view';=0A= return get_pr_url($viewcmd, @_);=0A= }=0A= =0A= # Same as script_name(), but includes 'database=3Dxxx' param.=0A= #=0A= sub get_script_name=0A= {=0A= my $url =3D $q->script_name();=0A= $url .=3D "?database=3D$global_prefs{'database'}"=0A= if defined($global_prefs{'database'});=0A= return $url;=0A= }=0A= =0A= # Return links which send email regarding the current PR.=0A= # first link goes to interested parties, second link goes to=0A= # PR submission address and Reply-To (ie. it gets tacked on to=0A= # the audit trail).=0A= sub get_mailto_link=0A= {=0A= my $sub_mailto =3D '';=0A= my($pr,%fields) =3D @_;=0A= my $int_mailto =3D $q->escape(scalar(interested_parties($pr, %fields)));= =0A= if (defined($site_pr_submission_address{ $global_prefs{'database'} }))=0A= {=0A= $sub_mailto =3D $q->escape($site_pr_submission_address{$global_prefs{'= database'}} .=0A= ',' . $fields{'Reply-To'});=0A= }=0A= my $subject =3D $q->escape("Re: $fields{$CATEGORY_FIELD}/$pr: $fields{$SY= NOPSIS_FIELD}");=0A= my $body =3D $q->escape(get_viewpr_url($pr));=0A= =0A= # Netscape Navigator up to and including 4.x should get the URL in=0A= # the body encoded only once=0A= unless ( ($ENV{'HTTP_USER_AGENT'} =3D~ "Mozilla\/(.)(.*)") && ($1 < 5)=0A= && ($2 !=3D~ "compatible") )=0A= {=0A= $body =3D $q->escape($body);=0A= }=0A= =0A= my $reply =3D "" .=0A= "send email to interested parties\n";=0A= =0A= if ($sub_mailto) {=0A= # include a link to email followup=0A= $reply .=3D "or send email followup to audit-trail\n";=0A= }=0A= =0A= return $reply;=0A= }=0A= =0A= sub view=0A= {=0A= my($viewaudit, $tmp) =3D @_;=0A= =0A= # $pr must be 'local' to be available to site callback=0A= local($pr) =3D $q->param('pr');=0A= # strip out leading category (and any other non-digit trash) from $pr=0A= $pr =3D~ s/\D//g;=0A= =0A= my $page =3D "Ticket $pr anzeigen";=0A= page_start_html($page);=0A= =0A= if(!$pr)=0A= {=0A= error_page("Sie m=FCssen eine Ticketnummer angeben");=0A= return;=0A= }=0A= =0A= # %fields must be 'local' to be available to site callback=0A= local(%fields) =3D readpr($pr);=0A= =0A= if (scalar(keys(%fields)) < 4) {=0A= # looks like there is no such PR, complain to the customer=0A= # (readpr() hardcodes 3 fields, even if there's no PR)=0A= gerror("PR $pr does not exist");=0A= page_end_html($page);=0A= return;=0A= }=0A= =0A= page_heading($page, "Ticket anzeigen: $pr");=0A= =0A= print $q->start_form(-method=3D>'get'),=0A= hidden_db(),=0A= hidden_debug(),=0A= $q->hidden('pr', $pr),=0A= $q->hidden('return_url');=0A= =0A= # print 'edit' and 'view audit-trail' buttons as appropriate, mailto link= =0A= print "";=0A= print $q->submit('cmd', '=E4ndern'), ' oder ' if (can_edit())= ;=0A= print $q->submit('cmd', 'view audit-trail'), ' or ' if (!$viewaudit);=0A= print get_mailto_link($pr, %fields);=0A= print "";=0A= print $q->hr(),=0A= "\n";=0A= print "\n\n\n\n\n";=0A= =0A= foreach (@fieldnames)=0A= {=0A= # XXX ??? !!! FIXME=0A= if ($_ eq $AUDIT_TRAIL_FIELD)=0A= {=0A= next;=0A= }=0A= my $val =3D $q->escapeHTML($fields{$_}) || ''; # to avoid -w warning=0A= my $valign =3D '';=0A= if (fieldinfo($_, 'fieldtype') eq 'multitext')=0A= {=0A= $valign =3D ' valign=3D"top"';=0A= $val =3D expand($val);=0A= $val =3D~ s/$/
/gm;=0A= $val =3D~ s/
$//; # previous substitution added one too many
'= s=0A= $val =3D~ s/ /  /g;=0A= $val =3D~ s/  /   /g;=0A= }=0A= =0A= # make links in various fields=0A= if ($_ =3D~ /responsible/i) {=0A= # values in the responsible field are likely to be bare usernames,=0A= # so mark_urls won't work on them.=0A= $val =3D make_mailto($val);=0A= } elsif ($_ =3D~ /related-prs/i) {=0A= # make the Related-PRs field show links to the PRs=0A= # dtb - this is juniper specific, but i think it's a good field to have in= =0A= # the dbconfig...=0A= $val =3D~ s{(\b|PR)(\d+)\b}{'$1$2"}egi;=0A= } else {=0A= # make urls and email addresses into live hrefs=0A= $val =3D mark_urls($val);=0A= }=0A= =0A= if ($description_in_view) {=0A= print "\n\n\n";=0A= =0A= # Print attachments after Description.=0A= print_attachments(\%fields, 'view') if /Description/;=0A= }=0A= print "
Absender eMail:",=0A= $q->tt(make_mailto($fields{'Reply-To'})), "
$_:
\n",=0A= fieldinfo($_, 'desc'),=0A= "		";=0A= } else {=0A= print "
$_:";=0A= }=0A= print $q->tt($val), "
",=0A= $q->hr();=0A= =0A= # print 'edit' and 'view audit-trail' buttons as appropriate, mailto link= =0A= print "

";=0A= print $q->submit('cmd', '=E4ndern'), ' or ' if (can_edit());= =0A= print $q->submit('cmd', 'view audit-trail'), ' or ' if (!$viewaudit);=0A= print get_mailto_link($pr, %fields);=0A= print "

";=0A= print $q->end_form();=0A= =0A= # Footer comes before the audit-trail.=0A= page_footer($page);=0A= =0A= if($viewaudit)=0A= {=0A= print "\n

=C4nderungs Historie:

\n
\n",=0A=
          mark_urls($q->escapeHTML($fields{$AUDIT_TRAIL_FIELD})),=0A=
	  "\n
\n";=0A= }=0A= =0A= page_end_html($page);=0A= }=0A= =0A= # edit -=0A= # The Edit PR page.=0A= #=0A= sub edit=0A= {=0A= my($pr) =3D $q->param('pr');=0A= # strip out leading category (and any other non-digit trash) from=0A= # $pr, since it will unduly confuse gnats when we try to submit the=0A= # edit=0A= $pr =3D~ s/\D//g;=0A= my $page =3D "=C4ndern des Ticket $pr";=0A= page_start_html($page);=0A= =0A= #my $debug =3D 0;=0A= =0A= =0A= if(!$pr)=0A= {=0A= error_page("Sie m=FCssen eine Ticketnummer angeben.");=0A= return;=0A= }=0A= =0A= my(%fields) =3D readpr($pr);=0A= =0A= page_heading($page, "=C4ndern eines Tickets: $pr");=0A= =0A= # Trim Responsible for compatibility. XXX ??? !!! FIXME=0A= $fields{$RESPONSIBLE_FIELD} =3D trim_responsible($fields{$RESPONSIBLE_FIE= LD});=0A= =0A= print multipart_form_start(-name=3D>'PrForm'), "\n",=0A= hidden_db(),=0A= hidden_debug(),=0A= $q->span($q->submit('cmd', 'submit edit'),=0A= " oder ",=0A= $q->reset(-name=3D>'reset'),=0A= " oder ",=0A= get_mailto_link($pr, %fields)),=0A= $q->hidden(-name=3D>'=C4nderung_durch',=0A= -value=3D>$db_prefs{'user'},=0A= -override=3D>1), "\n",=0A= $q->hidden(-name=3D>'Letzte_=C4nderung',=0A= -value=3D>$fields{$LAST_MODIFIED_FIELD},=0A= -override=3D>1), "\n",=0A= $q->hidden(-name=3D>'pr', -value=3D>$pr, -override=3D>1),=0A= $q->hidden(-name=3D>'return_url'),=0A= "
\n";=0A= =0A= print "\n";=0A= print "\n\n\n\n";=0A= =0A= # keep count of field number, so that javascript hooks can=0A= # have a way to access fields with dashes in their names=0A= # they'll need to use PrForm.elements[fieldNumber].value=0A= # instead of the dashed name=0A= # note that this is a zero-based count!!=0A= # there are nine fields "hardcoded" into the form above this point.=0A= my $field_number =3D 8;=0A= =0A= foreach (@fieldnames)=0A= {=0A= if (fieldinfo ($_, 'flags') & $READONLY)=0A= {=0A= next;=0A= }=0A= =0A= $field_number++;=0A= =0A= my $values =3D fieldinfo($_, 'values');=0A= =0A= # The "intro" provides a way for the site callback to print something= =0A= # at the top of a given field.=0A= my $intro =3D cb("edit_intro_$_", $field_number) || '';=0A= print "\n\n";=0A= }=0A= elsif (fieldinfo ($_, 'fieldtype') eq 'multienum')=0A= {=0A= my $defaultsref =3D parse_multienum($fields{$_}, $_);=0A= print multiselect_menu($_, $values, $defaultsref),=0A= "\n\n";=0A= }=0A= elsif (fieldinfo ($_, 'fieldtype') eq 'multitext')=0A= {=0A= my $rows =3D 4;=0A= $rows =3D 8 if /Description/;=0A= $rows =3D 2 if /Environment/;=0A= print $q->textarea(-name=3D>$_,=0A= -cols=3D>$textwidth,=0A= -rows=3D>$rows,=0A= -default=3D>$fields{$_}),=0A= "\n\n";=0A= # Print attachments after Description.=0A= print_attachments(\%fields, 'edit') if /Description/;=0A= }=0A= else=0A= {=0A= print $q->textfield(-name=3D>$_,=0A= -size=3D>$textwidth,=0A= -default=3D>$fields{$_}),=0A= "\n\n";=0A= }=0A= if (fieldinfo ($_, 'flags') & $REASONCHANGE)=0A= {=0A= print "\n\n\n";=0A= }=0A= print "\n";=0A= }=0A= print "
Absender eMail:",=0A= $q->textfield(-name=3D>'Reply-To',=0A= -default=3D>$fields{'Reply-To'},=0A= -size=3D>$textwidth),=0A= "
$_:
= \n",=0A= fieldinfo($_, 'desc'),=0A= "		\n", $intro, "\n";=0A= =0A= if (fieldinfo ($_, 'fieldtype') eq 'enum')=0A= {=0A= my $default =3D $fields{$_};=0A= # Check whether field value is a known enumeration value.=0A= if (!(grep /^$default$/, @$values))=0A= {=0A= push(@$values, 'unknown') if (!grep /^unknown$/, @$values);=0A= $default =3D 'unknown';=0A= }=0A= print popup_or_scrolling_menu($_, $values, $default),=0A= "
=C4nderungsgrund:",= =0A= $q->textarea(-name=3D>"$_-Changed-Why",=0A= -default=3D>'',=0A= -override=3D>1,=0A= -cols=3D>$textwidth,=0A= -rows=3D>2,=0A= -wrap=3D>'hard'),=0A= "
",=0A= $q->p($q->submit('cmd', 'submit edit'),=0A= " oder ",=0A= $q->reset(-name=3D>'reset'),=0A= " oder ",=0A= get_mailto_link($pr, %fields)), "\n",=0A= $q->end_form(), "\n",=0A= $q->hr(), "\n";=0A= =0A= # Footer comes before the audit-trail.=0A= page_footer($page);=0A= =0A= print "\n

Audit Trail:

\n
\n",=0A=
          mark_urls($q->escapeHTML($fields{$AUDIT_TRAIL_FIELD})),=0A=
	  "\n
\n";=0A= page_end_html($page);=0A= }=0A= =0A= # Print out the %fields hash for debugging.=0A= sub debug_print_fields=0A= {=0A= my $fields_hash_ref =3D shift;=0A= foreach my $f (sort keys %$fields_hash_ref)=0A= {=0A= print "$f",=0A= $q->pre($q->escapeHTML($$fields_hash_ref{$f})),=0A= "\n";=0A= }=0A= my $aref =3D $$fields_hash_ref{'attachments'} || [];=0A= my $i=3D0;=0A= foreach my $href (@$aref) {=0A= print "attachment $i",=0A= ($$href{'original_attachment'}=0A= ? $$href{'original_attachment'} : "--- empty ---");=0A= $i++;=0A= }=0A= print "
\n";=0A= }=0A= =0A= sub submitedit=0A= {=0A= my $page =3D 'Edit PR Results';=0A= =0A= my $debug =3D 0;=0A= my $lock_end_reached;=0A= =0A= my($pr) =3D $q->param('pr');=0A= =0A= # strip out leading category (and any other non-digit trash) from=0A= # $pr, since it will unduly confuse gnats when we try to submit the=0A= # edit=0A= $pr =3D~ s/\D//g;=0A= =0A= if(!$pr)=0A= {=0A= error_page("Sie m=FCssen eine Ticketnummer angeben");=0A= return;=0A= }=0A= =0A= my(%fields, %mailto, $adr);=0A= my $audittrail =3D '';=0A= my $err =3D '';=0A= =0A= # Retrieve new attachment (if any) before locking PR, in case it fails.= =0A= my $encoded_attachment =3D encode_attachment('attached_file');=0A= =0A= my(%oldfields) =3D lockpr($pr, $db_prefs{'user'});=0A= LOCKED:=0A= {=0A= # Trim Responsible for compatibility.=0A= $oldfields{$RESPONSIBLE_FIELD} =3D trim_responsible($oldfields{$RESPONS= IBLE_FIELD});=0A= =0A= # Merge %oldfields and CGI params to get %fields. Not all gnats=0A= # fields have to be present in the CGI params; the ones which are=0A= # not specified default to their old values.=0A= %fields =3D %oldfields;=0A= foreach my $key ($q->param)=0A= {=0A= my $val =3D $q->param($key);=0A= my $ftype =3D fieldinfo($key, 'fieldtype') || '';=0A= if($key =3D~ /-Changed-Why/=0A= || ($ftype eq 'multitext'))=0A= {=0A= $val =3D fix_multiline_val($val);=0A= }=0A= elsif($ftype eq 'multienum')=0A= {=0A= my @val =3D $q->param($key);=0A= $val =3D unparse_multienum(\@val, $key);=0A= }=0A= $fields{$key} =3D $val;=0A= }=0A= =0A= # Add the attached file, if any, to the new PR.=0A= add_encoded_attachment_to_pr(\%fields, $encoded_attachment);=0A= =0A= # Delete any attachments, if directed.=0A= my(@deleted_attachments) =3D $q->param('delete attachments');=0A= remove_attachments_from_pr(\%fields, @deleted_attachments);=0A= =0A= if ($debug)=0A= {=0A= print "

debugging -- PR edits not submitted

";=0A= debug_print_fields(\%fields);=0A= last LOCKED;=0A= }=0A= =0A= my $newlastmod =3D $fields{$LAST_MODIFIED_FIELD} || '';=0A= my $oldlastmod =3D $oldfields{$LAST_MODIFIED_FIELD} || '';=0A= =0A= if($newlastmod ne $oldlastmod)=0A= {=0A= error_page("Sorry, PR $pr has been modified since you started editing= it.",=0A= "Please return to the edit form, press the Reload button, "= .=0A= "then make your edits again.\n" .=0A= "
Last-Modified was    '$newlastmod'\n" .=0A=
                "Last-Modified is now '$oldlastmod'
");=0A= last LOCKED;=0A= }=0A= =0A= my (@errors) =3D ();=0A= if ($fields{$RESPONSIBLE_FIELD} eq "unknown")=0A= {=0A= push(@errors, "$RESPONSIBLE_FIELD is 'unknown'");=0A= }=0A= if ($fields{$CATEGORY_FIELD} eq "unknown")=0A= {=0A= push(@errors, "$CATEGORY_FIELD is 'unknown'.");=0A= }=0A= if($fields{$SUBMITTER_ID_FIELD} eq "unknown")=0A= {=0A= push(@errors, "$SUBMITTER_ID_FIELD is 'unknown'.");=0A= }=0A= if (@errors)=0A= {=0A= push(@errors,=0A= "Go back to the edit form, correct the errors and submit again.");=0A= error_page("The PR has not been submitted.", \@errors);=0A= last LOCKED;=0A= }=0A= =0A= # If Reply-To changed, we need to splice the change into the envelope.= =0A= if($fields{'Reply-To'} ne $oldfields{'Reply-To'})=0A= {=0A= if ($fields{'envelope'} =3D~ /^'Reply-To':/m)=0A= {=0A= # Replace existing header with new one.=0A= $fields{'envelope'} =3D~ s/^'Reply-To':.*$/'Reply-To': $fields{'Rep= ly-To'}/m;=0A= }=0A= else=0A= {=0A= # Insert new header at end (blank line). Keep blank line at end.= =0A= $fields{'envelope'} =3D~ s/^$/'Reply-To': $fields{'Reply-To'}\n/m;= =0A= }=0A= }=0A= =0A= # Check whether fields that are specified in dbconfig as requiring a=0A= # 'Reason Changed' have the reason specified:=0A= foreach my $fieldname (keys %fields)=0A= {=0A= my $newvalue =3D $fields{$fieldname} || '';=0A= my $oldvalue =3D $oldfields{$fieldname} || '';=0A= my $fieldflags =3D fieldinfo($fieldname, 'flags') || 0;=0A= if ( ($newvalue ne $oldvalue) && ( $fieldflags & $REASONCHANGE) )=0A= {=0A= if($fields{$fieldname."-Changed-Why"} =3D~ /^\s*$/)=0A= {=0A= error_page("Field '$fieldname' must have a reason for change",=0A= "Please press the 'Back' button of you browser, correct= the problem and resubmit.");=0A= last LOCKED;=0A= }=0A= }=0A= if ($newvalue eq $oldvalue && exists $fields{$fieldname."-Changed-Why= "} )=0A= {=0A= delete $fields{$fieldname."-Changed-Why"};=0A= }=0A= }=0A= =0A= my($newpr) =3D unparsepr('gnatsd', %fields);=0A= $newpr =3D~ s/\r//g;=0A= =0A= # Submit the edits. We need to unlock the PR even if the edit fails=0A= local($suppress_client_exit) =3D 1;=0A= client_cmd("editaddr $db_prefs{'user'}");=0A= last LOCKED if ($client_would_have_exited);=0A= client_cmd("edit $pr");=0A= last LOCKED if ($client_would_have_exited);=0A= client_cmd("$newpr.");=0A= =0A= $lock_end_reached =3D 1;=0A= }=0A= unlockpr($pr);=0A= =0A= if ( (! $client_would_have_exited) && $lock_end_reached) {=0A= # We print out the "Edit successful" message after unlocking the PR. If= the user hits=0A= # the Stop button of the browser while submitting, the web server won't= terminate the=0A= # script until the next time the server attempts to output something to= the browser.=0A= # Since this is the first output after the PR was locked, we print it a= fter the unlocking.=0A= # Let user know the edit was successful. After a 2s delay, refresh back= =0A= # to where the user was before the edit. Internet Explorer does not hon= or the=0A= # HTTP Refresh header, so we have to complement the "clean" CGI.pm meth= od=0A= # with the ugly hack below, with a HTTP-EQUIV in the HEAD to make thing= s work.=0A= my $return_url =3D $q->param('return_url') || get_script_name();=0A= # the refresh header chokes on the query-string if the=0A= # params are separated by semicolons...=0A= $return_url =3D~ s/\;/&/g;=0A= =0A= my $refresh =3D 2;=0A= print_header(-Refresh =3D> "$refresh; URL=3D$return_url");=0A= =0A= # Workaround for MSIE:=0A= my @extra_head_args =3D (-head =3D> $q->meta({-http_equiv=3D>'Refresh',= =0A= -content=3D>"$refresh; URL=3D$return_ur= l"}));=0A= =0A= page_start_html($page, 0, \@extra_head_args);=0A= page_heading($page, 'Edit successful');=0A= print <You will be returned to your previous page= =0A= in $refresh seconds...

=0A= EOM=0A= }=0A= =0A= page_footer($page);=0A= page_end_html($page);=0A= }=0A= =0A= sub query_page=0A= {=0A= my $page =3D 'Query PR';=0A= page_start_html($page);=0A= page_heading($page, 'Query Problem Reports');=0A= print_stored_queries();=0A= print $q->start_form(),=0A= hidden_db(),=0A= hidden_debug(),=0A= $q->submit('cmd', 'submit query'),=0A= "
",=0A= "";=0A= =0A= foreach (@fieldnames)=20=0A= {=0A= if (fieldinfo($_, 'fieldtype') =3D~ /enum/)=0A= {=0A= print "\n\n\n";=0A= }=0A= }=0A= =20=20=0A= print=0A= "\n\n\n\n",=0A= "\n\n\n\n",=0A= "\n\n\n\n";=0A= =0A= print "\n\n\n\n";=0A= =0A= print "\n\n\n\n",=0A= "
$_:";=0A= my $value_list=3Dfieldinfo($_, 'values');=0A= my @values=3D('any', @$value_list);=0A= if (fieldinfo($_, 'fieldtype') eq 'enum')=0A= {=0A= print popup_or_scrolling_menu ($_, \@values, $values[0]);=0A= }=0A= elsif (fieldinfo($_, 'fieldtype') eq 'multienum')=0A= {=0A= my $size =3D @values < 4 ? @values : 4;=0A= print $q->scrolling_list(-name=3D>$_, -values=3D>\@values, -size=3D= >$size,=0A= -multiple=3D>'true', -defaults=3D>$values[= 0]);=0A= }=0A= if ($_ eq $STATE_FIELD)=0A= {=0A= print "
",=0A= $q->checkbox_group(-name=3D>'ignoreclosed',=0A= -values=3D>['Ignore Closed'],=0A= -defaults=3D>['Ignore Closed']);=0A= }=0A= elsif ($_ eq $SUBMITTER_ID_FIELD)=0A= {=0A= print "
",=0A= $q->checkbox_group(-name=3D>'originatedbyme',=0A= -values=3D>['Originated by You'],=0A= -defaults=3D>[]);=0A= }=0A= print "
$SYNOPSIS_FIELD Search:",=0A= $q->textfield(-name=3D>$SYNOPSIS_FIELD,-size=3D>25),=0A= "
Multi-line Text Search:",=0A= $q->textfield(-name=3D>'multitext',-size=3D>25),=0A= "
Column Display:";=0A= =0A= my @allcolumns;=0A= foreach (@fieldnames) {=0A= if (fieldinfo($_, 'fieldtype') ne 'multitext') {=0A= push (@allcolumns, $_);=0A= }=0A= }=0A= # The 'number' field is always first in the @allcolumns array. If=0A= # users were allowed to select it in this list, the PR number would=0A= # appear twice in the Query Results table. We prevent this by=0A= # shifting 'number' out of the array.=0A= shift(@allcolumns);=0A= =0A= my(@columns) =3D split(' ', $global_prefs{'columns'} || '');=0A= @columns =3D @allcolumns unless @columns;=0A= =0A= print $q->scrolling_list(-name=3D>'columns',=0A= -values=3D>\@allcolumns,=0A= -defaults=3D>\@columns,=0A= -multiple=3D>1,=0A= -size=3D>5),=0A= "
Sort By:",=0A= $q->scrolling_list(-name=3D>'sortby',=0A= -values=3D>\@fieldnames,=0A= -multiple=3D>0,=0A= -size=3D>1),=0A= "
",=0A= $q->checkbox_group(-name=3D>'reversesort',=0A= -values=3D>['Reverse Order'],=0A= -defaults=3D>[]),=0A= "
Display:",=0A= $q->checkbox_group(-name=3D>'displaydate',=0A= -values=3D>['Current Date'],=0A= -defaults=3D>['Current Date']),=0A= "
\n",=0A= "
\n",=0A= $q->submit('cmd', 'submit query'),=0A= $q->end_form();=0A= =0A= page_footer($page);=0A= page_end_html($page);=0A= }=0A= =0A= sub advanced_query_page=0A= {=0A= my $page =3D 'Advanced Query';=0A= page_start_html($page);=0A= page_heading($page, 'Query Problem Reports');=0A= print_stored_queries();=0A= print $q->start_form(),=0A= hidden_debug(),=0A= hidden_db();=0A= =0A= my $width =3D 30;=0A= my $heading_bg =3D '#9fbdf9';=0A= my $cell_bg =3D '#d0d0d0';=0A= =0A= print $q->span($q->submit('cmd', 'submit query'),=0A= " oder ",=0A= $q->reset(-name=3D>'reset'));=0A= print "
";=0A= print "
";=0A= =0A= ### Text and multitext queries=0A= =0A= print "\n",=0A= "\n",=0A= "\n",=0A= "\n",=0A= "\n",=0A= "\n";=0A= print "\n\n\n\n",=0A= "\n\n\n\n",=0A= "
Search All Text
Search these text fieldsusing regular expression
Single-line text fields:",=0A= $q->textfield(-name=3D>'text', -size=3D>$width),=0A= "
Multi-line text fields:",=0A= $q->textfield(-name=3D>'multitext', -size=3D>$width),=0A= "
\n";=0A= print "
 
\n";=0A= =0A= ### Date queries=0A= =0A= print "\n",=0A= "\n",=0A= "\n",=0A= "\n",=0A= "\n",=0A= "\n";=0A= =0A= foreach (@fieldnames)=0A= {=0A= if (fieldinfo ($_, 'fieldtype') eq 'date')=0A= {=0A= print "\n\n\n\n";=0A= print "\n\n\n\n";=0A= }=0A= }=0A= print $q->Tr( $q->td({-colspan=3D>2},=0A= $q->small( $q->b("NOTE:"), "If your search includes 'Closed After'= =0A= or 'Closed Before', uncheck 'Ignore Closed' below.")));= =0A= print "
Search By Date
Date SearchExample: 1999-04-01 05:00 GMT
$_ after:",=0A= $q->textfield(-name=3D>$_."_after", -size=3D>$width),=0A= "
$_ before:",=0A= $q->textfield(-name=3D>$_."_before", -size=3D>$width),=0A= "
\n";=0A= print "
 
\n";=0A= =0A= ### Field queries=0A= =0A= print "\n",=0A= "\n",=0A= "\n",=0A= "\n",=0A= "\n",=0A= "\n",=0A= "\n";=0A= foreach (@fieldnames)=0A= {=0A= print "\n";=0A= =0A= # 1st column is field name=0A= print "\n";=0A= =0A= # 2nd column is regexp search field=0A= print "\n";=0A= =0A= # 3rd column is blank or scrolling multi-select list=0A= print "\n\n";=0A= }=0A= print "
Search Individual Fields
Search this fieldusing regular expression, orusing multi-selection
$_:",=0A= $q->textfield(-name=3D>$_,=0A= -size=3D>$width);=0A= print "\n";=0A= # XXX ??? !!! FIXME=0A= # This should be fixed by allowing a 'not' in front of the fields, so= =0A= # one can simply say "not closed".=0A= if ($_ eq $STATE_FIELD)=0A= {=0A= print "
",=0A= $q->checkbox_group(-name=3D>'ignoreclosed',=0A= -values=3D>['Ignore Closed'],=0A= -defaults=3D>['Ignore Closed']),=0A= }=0A= print "		";=0A= if (fieldinfo($_, 'fieldtype') =3D~ 'enum')=0A= {=0A= my $ary_ref =3D fieldinfo($_, 'values');=0A= my $size =3D scalar(@$ary_ref);=0A= $size =3D 4 if $size > 4;=0A= print $q->scrolling_list(-name=3D>$_,=0A= -values=3D>$ary_ref,=0A= -multiple=3D>1,=0A= -size=3D>$size);=0A= }=0A= else=0A= {=0A= print " ";=0A= }=0A= print "
\n";=0A= print "
 
\n";=0A= =0A= print "\n",=0A= "\n",=0A= "\n\n\n\n";=0A= =0A= print "\n\n\n\n";=0A= print "\n\n\n\n",=0A= "\n\n
Display
Display these columns:";=0A= =0A= my @allcolumns;=0A= foreach (@fieldnames) {=0A= if (fieldinfo($_, 'fieldtype') ne 'multitext') {=0A= push (@allcolumns, $_);=0A= }=0A= }=0A= # The 'number' field is always first in the @allcolumns array. If=0A= # users were allowed to select it in this list, the PR number would=0A= # appear twice in the Query Results table. We prevent this by=0A= # shifting 'number' out of the array.=0A= shift(@allcolumns);=0A= =0A= my(@columns) =3D split(' ', $global_prefs{'columns'} || '');=0A= @columns =3D @allcolumns unless @columns;=0A= =0A= print $q->scrolling_list(-name=3D>'columns',=0A= -values=3D>\@allcolumns,=0A= -defaults=3D>\@columns,=0A= -multiple=3D>1,=0A= -size=3D>5),=0A= "
Sort By:",=0A= $q->scrolling_list(-name=3D>'sortby',=0A= -values=3D>\@fieldnames,=0A= -multiple=3D>0,=0A= -size=3D>1),=0A= "
",=0A= $q->checkbox_group(-name=3D>'reversesort',=0A= -values=3D>['Reverse Order'],=0A= -defaults=3D>[]),=0A= "
Display:",=0A= $q->checkbox_group(-name=3D>'displaydate',=0A= -values=3D>['Current Date'],=0A= -defaults=3D>['Current Date']),=0A= "
\n";=0A= print "
 
\n";=0A= ### Wrapup=0A= =0A= print "
\n";=0A= print "
",=0A= $q->p($q->submit('cmd', 'submit query'),=0A= " oder ",=0A= $q->reset(-name=3D>'reset')),=0A= $q->end_form();=0A= page_footer($page);=0A= page_end_html($page);=0A= }=0A= =0A= =0A= # takes a string, and turns it into a mailto: link=0A= # if it's not a full address, $site_mail_domain is appended first=0A= sub make_mailto {=0A= my $string =3D shift;=0A= if ($string !~ /@/) {=0A= $string =3D qq*$string= *;=0A= } else {=0A= $string =3D qq*$string*;=0A= }=0A= return $string;=0A= }=0A= =0A= # takes a string, attempts to make urls, PR references and email=0A= # addresses in that string into links:=0A= # 'foo bar baz@quux.com flibbet PR# 1234 and furthermore=0A= # http://www.abc.com/whatever.html'=0A= # is returned as:=0A= # 'foo bar baz@quux.com flibbet=0A= # PR# 1234=0A= # =0A= # http://www.abc.com/whatever.html'=0A= # returns the (possibly) modified string=0A= # behavior can be modified by twiddling knobs in the %mark_urls hash.=0A= sub mark_urls {=0A= my $string =3D shift || '';=0A= =0A= # skip empty strings, or strings longer than the limit=0A= return $string if ($string =3D~ /^\s*$/ ||=0A= length($string) > $mark_urls{'max_length'});=0A= =0A= if ($mark_urls{'urls'})=0A= {=0A= # make URLs live=0A= $string =3D~ s{=0A= \b=0A= (=0A= (http|telnet|gopher|file|wais|ftp):=0A= [\w/#~+=3D&%@!.:;?\-]+?=0A= )=0A= (?=3D=0A= [.:?\-]*=0A= [^\w/#~+=3D&%@!.;:?\-]=0A= |=0A= $=0A= )=0A= }=0A= {$1}igx;=0A= }=0A= =0A= if ($mark_urls{'prs'})=0A= {=0A= # make "PR: 12345" into a link to "/cgi-bin/gnats?cmd=3Dview;pr=3D12345"= =0A= $string =3D~ s{=0A= (\WPR[:s#]?\s?) # PR followed by :|s|whitespace=0A= (\s[a-z0-9-]+\/)? # a category name & a slash (optional)=0A= ([0-9]+) # the PR number=0A= }=0A= {$1.''.$2.$3.''}egix;=0A= }=0A= =0A= if ($mark_urls{'emails'})=0A= {=0A= # make email addresses live=0A= $string =3D~ s{=0A= \b=0A= (=0A= (?$1}igx;=0A= }=0A= =0A= return $string;=0A= }=0A= =0A= =0A= sub appendexpr=0A= {=0A= my $lhs =3D shift;=0A= my $op =3D shift;=0A= my $rhs =3D shift;=0A= =0A= if ($lhs eq "")=0A= {=0A= return $rhs;=0A= }=0A= if ($rhs eq "")=0A= {=0A= return $lhs;=0A= }=0A= return "($lhs) $op ($rhs)";=0A= }=0A= =0A= sub submitquery=0A= {=0A= my $page =3D 'Query Results';=0A= my $queryname =3D $q->param('queryname');=0A= =0A= my $heading =3D 'Query Results';=0A= $heading .=3D ": $queryname" if $queryname;=0A= page_start_html($page);=0A= page_heading($page, $heading);=0A= my $debug =3D 0;=0A= =0A= my $originatedbyme =3D $q->param('originatedbyme');=0A= my $ignoreclosed =3D $q->param('ignoreclosed');=0A= =0A= local($client_cmd_debug) =3D 1 if $debug;=0A= client_cmd("rset");=0A= =0A= my $expr =3D "";=0A= if ($originatedbyme)=0A= {=0A= $expr =3D 'builtinfield:originator=3D"'.$db_prefs{'user'}.'"';=0A= }=0A= if ($ignoreclosed)=0A= {=0A= $expr =3D appendexpr ('(! builtinfield:State[type]=3D"closed")', '&', $= expr);=0A= }=0A= =0A= ### Construct expression for each param which specifies a query.=0A= my $field;=0A= foreach $field ($q->param())=0A= {=0A= my @val =3D $q->param($field);=0A= my $stringval =3D join(" ", @val);=0A= =0A= # Bleah. XXX ??? !!!=0A= if ($stringval ne '')=0A= {=0A= if (isvalidfield ($field))=0A= {=0A= my $subexp =3D "";=0A= my $sval;=0A= =0A= # Turn multiple param values into ORs.=0A= foreach $sval (@val)=0A= {=0A= if ($sval ne 'any' && $sval ne '')=0A= {=0A= # Most (?) people expect queries on enums to be of the=0A= # exact, not the substring type.=0A= # Hence, provide explicit anchoring for enums. This=0A= # still leaves the user the possibility of inserting=0A= # ".*" before and/or after regular expression searches=0A= # on the advanced query page.=0A= if (fieldinfo($field, 'fieldtype') =3D~ "enum|multienum")=0A= {=0A= $subexp =3D appendexpr ($subexp, '|', "$field~\"^$sval\$\"");= =0A= }=0A= else=0A= {=0A= $subexp =3D appendexpr ($subexp, '|', "$field~\"$sval\"");=0A= }=0A= }=0A= }=0A= $expr =3D appendexpr ($expr, '&', $subexp);=0A= }=0A= elsif ($field eq 'text' || $field eq 'multitext')=0A= {=0A= $expr =3D appendexpr ($expr, '&', "fieldtype:$field~\"$stringval\""= );=0A= }=0A= elsif ($field =3D~ /_after$/ || $field =3D~ /_before$/)=0A= {=0A= my $op;=0A= # Waaah, nasty. XXX ??? !!!=0A= if ($field =3D~ /_after$/)=0A= {=0A= $op =3D '>';=0A= }=0A= else=0A= {=0A= $op =3D '<';=0A= }=0A= # Whack off the trailing _after or _before.=0A= $field =3D~ s/_[^_]*$//;=0A= $expr =3D appendexpr ($expr, '&', $field.$op.'"'.$stringval.'"');= =0A= }=0A= }=0A= }=0A= =0A= my $format=3D"\"%s";=0A= =0A= my @columns =3D $q->param('columns');=0A= # We are using ASCII octal 037 (unit separator) to separate the=0A= # fields in the query output. Note that the format strings are=0A= # interpolated (quoted with ""'s), so make sure to escape any $ or @=0A= # signs.=0A= foreach (@columns) {=0A= if (fieldinfo ($_, 'fieldtype') eq 'date') {=0A= $format .=3D "\037%{%Y-%m-%d %H:%M:%S %Z}D";=0A= } elsif (fieldinfo ($_, 'fieldtype') eq 'enum') {=0A= $format .=3D "\037%d";=0A= } else {=0A= $format .=3D "\037%s";=0A= }=0A= }=0A= =0A= $format .=3D "\" ".${NUMBER_FIELD}." ".join (" ", @columns);=0A= =0A= client_cmd("expr $expr") if $expr;=0A= client_cmd("qfmt $format");=0A= =0A= my(@query_results) =3D client_cmd("quer");=0A= =0A= display_query_results(@query_results);=0A= page_footer($page);=0A= page_end_html($page);=0A= }=0A= =0A= # nonempty -=0A= # Turn empty strings into " " so that Netscape tables won't=0A= # look funny.=0A= #=0A= sub nonempty=0A= {=0A= my $str =3D shift;=0A= $str =3D ' ' if !$str;=0A= return $str;=0A= }=0A= =0A= =0A= # display_query_results -=0A= # Display the query results, and the "store query" form.=0A= # The results only have the set of fields that we requested, although= =0A= # the first field is always the PR number.=0A= sub display_query_results=0A= {=0A= my(@query_results) =3D @_;=0A= my $displaydate =3D $q->param('displaydate');=0A= my $reversesort =3D $q->param('reversesort');=0A= =0A= my $num_matches =3D scalar(@query_results);=0A= my $heading =3D sprintf("%s %s found",=0A= $num_matches ? $num_matches : "No",=0A= ($num_matches =3D=3D 1) ? "match" : "matches");=0A= my $heading2 =3D $displaydate ? $q->small("( Query executed ",=0A= (scalar localtime), ")") : '';=0A= print $q->table({cellpadding=3D>0, cellspacing=3D>0, border=3D>0},=0A= $q->Tr($q->td($q->font({size=3D>'+2'},=0A= $q->strong($heading)))), $q->Tr($q->td($heading2)));=0A= print $q->start_form(),=0A= hidden_debug(),=0A= $q->hidden(name=3D>'cmd', -value=3D>'anzeigen', -override=3D>1),=0A= "\n";=0A= =0A= # By default sort by PR number.=0A= my($sortby) =3D $q->param('sortby') || $fieldnames[0];=0A= =0A= my $whichfield =3D 0;=0A= my ($sortbyfieldnum) =3D 0;=0A= my @columns =3D $q->param('columns');=0A= my $noofcolumns =3D @columns;=0A= # Print table header which allows sorting by columns.=0A= # While printing the headers, temporarily override the 'sortby' param=0A= # so that self_url() works right.=0A= for ($fieldnames[0], @columns)=0A= {=0A= $q->param(-name=3D>'sortby', -value=3D>$_);=0A= if ($_ eq $sortby) {=0A= $sortbyfieldnum =3D $whichfield;=0A= }=0A= $whichfield++;=0A= =0A= # strip empty params out of self_url(). in a gnats db with many=0A= # fields, the url query-string will become very long. this is a=0A= # problem, since IE5 truncates query-strings at ~2048 characters.=0A= my ($query_string) =3D $q->self_url() =3D~ m/^[^?]*\?(.*)$/;=0A= $query_string =3D~ s/(\w|-)+=3D;//g;=0A= =0A= my $href =3D $script_name . '?' . $query_string;=0A= print "\n\n";=0A= }=0A= # finished the header row=0A= print "\n";=0A= =0A= # Reset param 'sortby' to its original value, so that 'store query' works= .=0A= $q->param(-name=3D>'sortby', -value=3D>$sortby);=0A= =0A= # Sort @query_results according to the rules in by_field().=0A= # Using the "map, sort" idiom allows us to perform the expensive=0A= # split() only once per item, as opposed to during every comparison.=0A= my(@presplit_prs) =3D map { [ (split /\037/) ] } @query_results;=0A= my(@sorted_prs);=0A= my $sortby_fieldtype =3D fieldinfo ($sortby, 'fieldtype') || '';=0A= if ($sortby_fieldtype eq 'enum' || $sortby_fieldtype eq 'integer') {=0A= # sort numerically=0A= @sorted_prs =3D sort({$a->[$sortbyfieldnum] <=3D> $b->[$sortbyfieldnum]= }=0A= @presplit_prs);=0A= } else {=0A= # sort alphabetically=0A= @sorted_prs =3D sort({lc($a->[$sortbyfieldnum] || '') cmp lc($b->[$sort= byfieldnum] ||'')}=0A= @presplit_prs);=0A= }=0A= =0A= @sorted_prs =3D reverse @sorted_prs if $reversesort;=0A= =0A= # Print the PR's.=0A= my @fieldtypes =3D map { fieldinfo ($_, 'fieldtype') } @columns;=0A= foreach (@sorted_prs)=0A= {=0A= print "\n";=0A= my $id =3D shift @{$_};=0A= =0A= print "";=0A= =0A= my $fieldcontents;=0A= my $whichfield =3D 0;=0A= foreach $fieldcontents (@{$_})=0A= {=0A= # The query returned the enums as numeric values, now we have to=0A= # map them back into strings.=0A= if ($fieldtypes[$whichfield] eq 'enum')=0A= {=0A= my $enumvals =3D fieldinfo($columns[$whichfield], 'values');=0A= # A zero means that the string is absent from the enumeration type.=0A= $fieldcontents =3D $fieldcontents ? $$enumvals[$fieldcontents - 1] = : 'unknown';=0A= }=0A= $fieldcontents =3D $q->escapeHTML($fieldcontents);=0A= $fieldcontents =3D nonempty($fieldcontents);=0A= =0A= if ($columns[$whichfield] =3D~ /responsible/i) {=0A= $fieldcontents =3D make_mailto($fieldcontents);=0A= } else {=0A= # make urls and email addresses into live hrefs=0A= $fieldcontents =3D mark_urls($fieldcontents);=0A= }=0A= =0A= print "";=0A= $whichfield++;=0A= }=0A= # Pad the remaining, empty columns with  's=0A= my $n =3D @{$_};=0A= while ($noofcolumns - $n > 0)=0A= {=0A= print "";=0A= $n++;=0A= }=0A= print "\n\n";=0A= }=0A= print "
$_
$id"= ;=20=0A= if (can_edit())=0A= {=0A= print " = edit";=0A= }=0A= print "$fieldcontents 
",=0A= $q->end_form();=0A= =0A= # Provide a URL which someone can use to bookmark this query.=0A= my $url =3D $q->self_url();=0A= # strip empty params out of $url. in a gnats db with many=0A= # fields, the url query-string will become very long. this is a=0A= # problem, since IE5 truncates query-strings at ~2048 characters.=0A= $url =3D~ s/(\w|-)+=3D;//g;=0A= =0A= print "\n

",=0A= qq{View for bookmarking},=0A= "
";=0A= if ($reversesort) {=0A= $url =3D~ s/[&;]reversesort=3D[^&;]*//;=0A= } else {=0A= $url .=3D $q->escapeHTML(";reversesort=3DDescending Order");=0A= }=0A= print qq{Reverse sort order},=0A= "

";=0A= =0A= # Allow the user to store this query. Need to repeat params as hidden=0A= # fields so they are available to the 'store query' handler.=0A= print $q->start_form(), hidden_debug();=0A= foreach ($q->param())=0A= {=0A= # Ignore certain params.=0A= next if /^(cmd|queryname)$/;=0A= print $q->hidden($_), "\n";=0A= }=0A= print "\n\n",=0A= "\n",=0A= "\n",=0A= "\n\n\n
Diese Abfrage speichern unter:",=0A= $q->textfield(-name=3D>'queryname', -size=3D>25),=0A= "";=0A= # Note: include hidden 'cmd' so user can simply press Enter w/o clicking.= =0A= print $q->hidden(-name=3D>'cmd', -value=3D>'abfrage speichern', -override= =3D>1),=0A= $q->submit('cmd', 'abfrage speichern'),=0A= $q->hidden('return_url', $q->self_url()),=0A= "\n
",=0A= $q->end_form();=0A= }=0A= =0A= # store_query -=0A= # Save the current query in a cookie.=0A= #=0A= # Queries are stored as individual cookies named=0A= # 'gnatsweb-query-$queryname'.=0A= #=0A= sub store_query=0A= {=0A= my $debug =3D 0;=0A= my $queryname =3D $q->param('queryname');=0A= if (!$queryname || ($queryname =3D~ /[;|,|\s]+/) ) {=0A= error_page('Illegal query name',=0A= "You tried to store the query with an illegal name. "=0A= . "Legal names are not blank and do not contain the symbols = "=0A= . "';' (semicolon), ',' (comma) or the space character.");= =0A= exit();=0A= }=0A= # First make sure we don't already have too many cookies.=0A= # See http://home.netscape.com/newsref/std/cookie_spec.html for=0A= # limitations -- 20 cookies; 4k per cookie.=0A= my(@cookie_names) =3D $q->cookie();=0A= if (@cookie_names >=3D 20) {=0A= error_page('Cannot store query -- too many cookies',=0A= "Gnatsweb cannot store this query as another cookie because"= =0A= . "there already are "=0A= . scalar(@cookie_names)=0A= . " cookies being passed to gnatsweb. There is a maximum"= =0A= . " of 20 cookies per server or domain as specified in"=0A= . " "=0A= . "http://home.netscape.com/newsref/std/cookie_spec.html= ");=0A= exit();=0A= }=0A= =0A= # Don't save certain params.=0A= $q->delete('cmd');=0A= my $query_string =3D $q->query_string();=0A= =0A= # strip empty params out of $query_string. in a gnats db with many=0A= # fields, the query-string will become very long, and may exceed the=0A= # 4K limit for cookies.=0A= $query_string =3D~ s/\w+=3D;//g;=0A= =0A= if (length($query_string . $global_cookie_path . "gnatsweb-query-$queryna= me") > 4050) {=0A= # this cookie is going to be longer than 4K, so we'll have to punt=0A= error_page('Cannot store query -- cookie too large',=0A= "Gnatsweb cannot store this query as a cookie because"=0A= . " it would exceed the maximum of 4K per cookie, as specifi= ed in"=0A= . " "=0A= . "http://home.netscape.com/newsref/std/cookie_spec.html= ");=0A= exit();=0A= }=0A= =0A= # Have to generate the cookie before printing the header.=0A= my $new_cookie =3D $q->cookie(-name =3D> "gnatsweb-query-$queryname",=0A= -value =3D> $query_string,=0A= -path =3D> $global_cookie_path,=0A= -expires =3D> '+10y');=0A= =0A= # Now print the page.=0A= my $page =3D 'Query Saved';=0A= my $return_url =3D $q->param('return_url') || get_script_name();=0A= my $refresh =3D 5;=0A= =0A= print_header(-Refresh =3D> "$refresh; URL=3D$return_url",=0A= -cookie =3D> $new_cookie);=0A= =0A= # Workaround for MSIE:=0A= my @extra_head_args =3D (-head =3D> $q->meta({-http_equiv=3D>'Refresh',= =0A= -content=3D>"$refresh; URL=3D$r= eturn_url"}));=0A= =0A= page_start_html($page, 0, \@extra_head_args);=0A= =0A= page_heading($page, 'Query Saved');=0A= print "

debugging

",=0A=
        "query_string: $query_string",=0A=
        "cookie: $new_cookie\n",=0A=
        "
\n"=0A= if $debug;=0A= print "

Your query \"$queryname\" has been saved. It will be available= ",=0A= "the next time you reload the Query page.

";=0A= print "

You will be returned to your previous= page ",=0A= " in $refresh seconds...

";=0A= page_footer($page);=0A= page_end_html($page);=0A= }=0A= =0A= # print_stored_queries -=0A= # Retrieve any stored queries and print out a short form allowing=0A= # the submission of these queries.=0A= #=0A= # Queries are stored as individual cookies named=0A= # 'gnatsweb-query-$queryname'.=0A= #=0A= # side effects:=0A= # Sets global %stored_queries.=0A= #=0A= sub print_stored_queries=0A= {=0A= my %stored_queries =3D ();=0A= foreach my $cookie ($q->cookie())=0A= {=0A= if ($cookie =3D~ /gnatsweb-query-(.*)/)=0A= {=0A= my $query_key =3D $1;=0A= my $query_param =3D $q->cookie($cookie);=0A= # extract queries relevant to the current database:=0A= if ($query_param =3D~ /database=3D$global_prefs{'database'}/ )=0A= {=0A= $stored_queries{$query_key} =3D $query_param;=0A= }=0A= }=0A= }=0A= if (%stored_queries)=0A= {=0A= print "",=0A= "",=0A= $q->start_form(),=0A= hidden_debug(),=0A= "
",=0A= hidden_db(),=0A= $q->submit('cmd', 'submit stored query'),=0A= " ",=0A= $q->popup_menu(-name=3D>'queryname',=0A= -values=3D>[ sort(keys %stored_queries) ]),=0A= $q->end_form(),=0A= $q->start_form(),=0A= hidden_debug(),=0A= "",=0A= $q->hidden('return_url', $q->self_url()),=0A= hidden_db(),=0A= $q->submit('cmd', 'delete stored query'),=0A= " ",=0A= $q->popup_menu(-name=3D>'queryname',=0A= -values=3D>[ sort(keys %stored_queries) ]),=0A= $q->end_form(),=0A= "
";=0A= }=0A= }=0A= =0A= # submit_stored_query -=0A= # Submit the query named in the param 'queryname'.=0A= #=0A= # Queries are stored as individual cookies named=0A= # 'gnatsweb-query-$queryname'.=0A= #=0A= sub submit_stored_query=0A= {=0A= my $debug =3D 0;=0A= my $queryname =3D $q->param('queryname');=0A= my $query_string;=0A= my $err =3D '';=0A= if (!$queryname)=0A= {=0A= $err =3D "Internal error: no 'queryname' parameter";=0A= }=0A= elsif (!($query_string =3D $q->cookie("gnatsweb-query-$queryname")))=0A= {=0A= $err =3D "No such named query: $queryname";=0A= }=0A= if ($err)=0A= {=0A= error_page($err);=0A= }=0A= else=0A= {=0A= # 9/10/99 kenstir: Must use full (not relative) URL in redirect.=0A= # Patch by Elgin Lee .=0A= my $query_url =3D $q->url() . '?cmd=3D' . $q->escape('submit query')=0A= . '&' . $query_string;=0A= if ($debug)=0A= {=0A= print_header(),=0A= $q->start_html(),=0A= $q->pre("debug: query_url: $query_url\n");=0A= }=0A= else=0A= {=0A= print $q->redirect($query_url);=0A= }=0A= }=0A= }=0A= =0A= # delete_stored_query -=0A= # Delete the query named in the param 'queryname'.=0A= #=0A= # Queries are stored as individual cookies named=0A= # 'gnatsweb-query-$queryname'.=0A= #=0A= sub delete_stored_query=0A= {=0A= my $debug =3D 0;=0A= my $queryname =3D $q->param('queryname');=0A= my $query_string;=0A= my $err =3D '';=0A= if (!$queryname)=0A= {=0A= $err =3D "Internal error: no 'queryname' parameter";=0A= }=0A= elsif (!($query_string =3D $q->cookie("gnatsweb-query-$queryname")))=0A= {=0A= $err =3D "No such named query: $queryname";=0A= }=0A= if ($err)=0A= {=0A= error_page($err);=0A= }=0A= else=0A= {=0A= # The negative -expire causes the old cookie to expire immediately.=0A= my $expire_cookie_with_path =3D=0A= $q->cookie(-name =3D> "gnatsweb-query-$queryname",=0A= -value =3D> 'does not matter',=0A= -path =3D> $global_cookie_path,=0A= -expires =3D> '-1d');=0A= my $expire_cookies =3D $expire_cookie_with_path;=0A= =0A= # If we're using a non-empty $global_cookie_path, then we need to=0A= # create two expire cookies. One or the other will delete the stored= =0A= # query, depending on whether the query was created with this version= =0A= # of gnatsweb, or with an older version.=0A= if ($global_cookie_path)=0A= {=0A= my $expire_cookie_no_path =3D=0A= $q->cookie(-name =3D> "gnatsweb-query-$queryname",=0A= -value =3D> 'does not matter',=0A= # No -path here!=0A= -expires =3D> '-1d');=0A= $expire_cookies =3D [ $expire_cookie_with_path, $expire_cookie_no_pat= h ];=0A= }=0A= =0A= # Return the user to the page they were viewing when they pressed=0A= # 'delete stored query'.=0A= my $return_url =3D $q->param('return_url') || get_script_name();=0A= my $refresh =3D 0;=0A= =0A= print_header(-Refresh =3D> "$refresh; URL=3D$return_url",=0A= -cookie =3D> $expire_cookies);=0A= =0A= # Workaround for MSIE:=0A= print $q->start_html(-head =3D> $q->meta({-http_equiv=3D>'Refresh',=0A= -content=3D>"$refresh; URL=3D$return_ur= l"}));=0A= }=0A= }=0A= =0A= # send_html -=0A= # Send HTML help file, after first trimming out everything but=0A= # ... This is done in this way for convenience of=0A= # installation. If the gnatsweb.html is installed into the cgi-bin=0A= # directory along with the gnatsweb.pl file, then it can't be loaded=0A= # directly by Apache. So, we send it indirectly through gnatsweb.pl.= =0A= # This approach has the benefit that the resulting page has the=0A= # customized gnatsweb look.=0A= #=0A= sub send_html=0A= {=0A= my $file =3D shift;=0A= open(HTML, "<$file") || return;=0A= local $/ =3D undef; # slurp file whole=0A= my $html =3D ;=0A= close(HTML);=0A= =0A= # send just the stuff inside ..=0A= $html =3D~ s/.*//is;=0A= $html =3D~ s/<\/body>.*//is;=0A= =0A= print $html;=0A= }=0A= =0A= sub error_page=0A= {=0A= my($err_heading, $err_text) =3D @_;=0A= my $page =3D 'Fehler';=0A= print_header();=0A= page_start_html($page);=0A= page_heading($page, 'Fehler');=0A= print $q->h3($err_heading);=0A= print $q->p($err_text) if $err_text;=0A= page_footer($page);=0A= page_end_html($page);=0A= }=0A= =0A= sub help_page=0A= {=0A= my $html_file =3D $help_page_path;=0A= my $page =3D $q->param('help_title') || 'Help';=0A= my $heading =3D $page;=0A= page_start_html($page);=0A= page_heading($page, $heading);=0A= =0A= # If send_html doesn't work, print some default, very limited, help text.= =0A= if (!send_html($html_file))=0A= {=0A= print $q->p('Welcome to our problem report database. ',=0A= 'You\'ll notice that here we call them "problem reports" ',=0A= 'or "PR\'s", not "bugs".');=0A= print $q->p('This web interface is called "gnatsweb". ',=0A= 'The database system itself is called "gnats".',=0A= 'You may want to peruse ',=0A= $q->a({-href=3D>"$gnats_info_top"}, 'the gnats manual'),=0A= 'to read about bug lifecycles and the like, ',=0A= 'but then again, you may not.');=0A= }=0A= =0A= page_footer($page);=0A= page_end_html($page);=0A= }=0A= =0A= # hidden_db -=0A= # Return hidden form element to maintain current database. This=0A= # enables people to keep two browser windows open to two databases.=0A= #=0A= sub hidden_db=0A= {=0A= return $q->hidden(-name=3D>'database', -value=3D>$global_prefs{'database'= }, -override=3D>1);=0A= }=0A= =0A= # hidden_debug -=0A= # Return hidden form element to maintain state of debug params=0A= #=0A= sub hidden_debug=0A= {=0A= if ($site_allow_remote_debug) {=0A= return $q->hidden(-name=3D>'debug');=0A= } else {=0A= return;=0A= }=0A= }=0A= =0A= # one_line_form -=0A= # One line, two column form used for main page.=0A= #=0A= sub one_line_form=0A= {=0A= my($label, @form_body) =3D @_;=0A= my $valign =3D 'baseline';=0A= return $q->Tr({-valign=3D>$valign},=0A= $q->td($q->b($label)),=0A= $q->td($q->start_form(-method=3D>'get'), hidden_debug(),=0A= hidden_db(), @form_body, $q->end_form()));=0A= }=0A= =0A= # can_create -=0A= # If $no_create_without_access is set to a defined gnats=0A= # access_level, return false unless user's access_level is >=3D to=0A= # level set in $no_create_without_access=0A= sub can_create=0A= {=0A= if (exists($LEVEL_TO_CODE{$no_create_without_access})) {=0A= return ($LEVEL_TO_CODE{$access_level} >=3D $LEVEL_TO_CODE{$no_create_= without_access});=0A= } else {=0A= return 1;=0A= }=0A= }=0A= =0A= # can_edit -=0A= # Return true if the user has edit privileges or better.=0A= sub can_edit=0A= {=0A= return ($LEVEL_TO_CODE{$access_level} >=3D $LEVEL_TO_CODE{'edit'});=0A= }=0A= =0A= sub main_page=0A= {=0A= my $page =3D 'Main';=0A= =0A= my $viewcmd =3D $include_audit_trail ? 'view audit-trail' : 'view';=0A= =0A= page_start_html($page);=0A= page_heading($page, 'Post Direkt Ticket System');=0A= =0A= print '';=0A= =0A= my $top_buttons_html =3D cb('main_page_top_buttons') || '';=0A= print $top_buttons_html;=0A= =0A= # Only include Create action if user is allowed to create PRs.=0A= # (only applicable if $no_create_without_edit flag is set)=0A= print one_line_form('Neues Ticket erstellen:',=0A= $q->submit('cmd', 'erstellen'))=0A= if can_create();=0A= # Only include Edit action if user is allowed to edit PRs.=0A= # Note: include hidden 'cmd' so user can simply type into the textfield= =0A= # and press Enter w/o clicking.=0A= print one_line_form('Ticket editieren:',=0A= $q->hidden(-name=3D>'cmd', -value=3D>'=E4ndern', -ove= rride=3D>1),=0A= $q->submit('cmd', '=E4ndern'),=0A= '#',=0A= $q->textfield(-size=3D>6, -name=3D>'pr'))=0A= if can_edit();=0A= print one_line_form('Ticket anzeigen:',=0A= $q->hidden(-name=3D>'cmd', -value=3D>$viewcmd, -overr= ide=3D>1),=0A= $q->submit('cmd', 'anzeigen'),=0A= '#',=0A= $q->textfield(-size=3D>6, -name=3D>'pr'));=0A= print one_line_form('Ticketdatenbank abfragen:',=0A= $q->submit('cmd', 'abfrage'),=0A= ' ', $q->submit('cmd', 'erw. abfrage'));=0A= if ($site_gnatsweb_server_auth)=0A= {=0A= print one_line_form('Datenbank wechseln:',=0A= $q->scrolling_list(-name=3D>'new_db',=0A= -values=3D>$global_list_of_dbs,=0A= -default=3D>$global_prefs{'database'},=0A= -multiple=3D>0,=0A= -size=3D>1),=0A= $q->submit('cmd', 'datenbank wechseln') );=0A= }=0A= else=0A= {=0A= print one_line_form("Abmelden / Datenbank wechseln: ",=0A= $q->submit('cmd', 'abmelden'));=0A= }=0A= print one_line_form('Hilfe:',=0A= $q->submit('cmd', 'hilfe'));=0A= =0A= my $bot_buttons_html =3D cb('main_page_bottom_buttons') || '';=0A= print $bot_buttons_html;=0A= =0A= print '
';=0A= page_footer($page);=0A= print '
'=0A= . "Gnatsweb v$VERSION, Gnats v$GNATS_VERS"=0A= . '';=0A= page_end_html($page);=0A= exit;=0A= }=0A= =0A= # cb -=0A= #=0A= # Calls site_callback subroutine if defined.=0A= #=0A= # usage:=0A= # $something =3D cb($reason, @args) || 'default_value';=0A= # # -or-=0A= # $something =3D cb($reason, @args)=0A= # $something =3D 'default_value' unless defined($something);=0A= #=0A= # arguments:=0A= # $reason - reason for the call. Each reason is unique.=0A= # @args - additional parameters may be provided in @args.=0A= #=0A= # returns:=0A= # undef if &site_callback is not defined,=0A= # else value returned by &site_callback.=0A= #=0A= sub cb=0A= {=0A= my($reason, @args) =3D @_;=0A= my $val =3D undef;=0A= if (defined &site_callback)=0A= {=0A= $val =3D site_callback($reason, @args);=0A= }=0A= $val;=0A= }=0A= =0A= # print_header -=0A= # Print HTTP header unless it's been printed already.=0A= #=0A= sub print_header=0A= {=0A= # Protect against multiple calls.=0A= return if $print_header_done;=0A= $print_header_done =3D 1;=0A= =0A= print $q->header(@_);=0A= }=0A= =0A= # page_start_html -=0A= #=0A= # Print the HTML which starts off each page (...).= =20=20=0A= #=0A= # By default, print a banner containing $site_banner_text, followed=0A= # by the given page $title.=0A= #=0A= # The starting HTML can be overridden by &site_callback.=0A= #=0A= # Supports debugging.=0A= #=0A= # arguments:=0A= # $title - title of page=0A= #=0A= sub page_start_html=0A= {=0A= my $title =3D $_[0];=0A= my $no_button_bar =3D $_[1];=0A= my @extra_head_args =3D @{$_[2]} if defined $_[2];=0A= my $debug =3D 0;=0A= =0A= # Protect against multiple calls.=0A= return if $page_start_html_done;=0A= $page_start_html_done =3D 1;=0A= =0A= # Allow site callback to override html.=0A= my $html =3D cb('page_start_html', $title);=0A= if ($html)=0A= {=0A= print $html;=0A= return;=0A= }=0A= =0A= # Call start_html, with -bgcolor if we need to override that.=0A= my @args =3D (-title=3D>"$title - $site_banner_text");=0A= push(@args, -bgcolor=3D>$site_background)=0A= if defined($site_background);=0A= push(@args, -style=3D>{-src=3D>$site_stylesheet})=0A= if defined($site_stylesheet);=0A= push(@args, @extra_head_args);=0A= print $q->start_html(@args);=0A= =0A= # Add the page banner. The $site_banner_text is linked back to the=0A= # main page.=0A= #=0A= # Note that the banner uses inline style, rather than a GIF; this=0A= # makes installation easier by eliminating the need to install GIFs=0A= # into a separate directory. At least for Apache, you can't serve=0A= # GIFs out of your CGI directory.=0A= #=0A= my $bannerstyle =3D <\n);=0A= $row .=3D qq(\n);=0A= $row .=3D qq($global_prefs= {'database'}  )=0A= if $global_prefs{'database'};=0A= $row .=3D qq(User: $db_pre= fs{'user'}  )=0A= if $db_prefs{'user'};=0A= $row .=3D qq(Access: $acce= ss_level)=0A= if $access_level;=0A= $row .=3D qq(\n\n\n\n
=0A= $site_= banner_text=0A=
\n);=0A= =0A= $row2 =3D qq(\n);=0A= $row2 .=3D qq();=0A= $row2 .=3D qq(\n);=0A= $row2 .=3D qq();=0A= $row2 .=3D qq()=0A= if can_create();=0A= $row2 .=3D qq();=0A= $row2 .=3D qq();=0A= $row2 .=3D qq()=0A= unless ($site_gnatsweb_server_auth);=0A= $row2 .=3D qq();=0A= $row2 .=3D qq(\n);=0A= $row2 .=3D qq(
START SEITE= ERSTELLEN= A= BFRAGEERW. ABFRAGE= ABMELDENHIL= FE
\n\n);=0A= =0A= $banner =3D qq($row);=0A= $banner .=3D qq($row2) unless $no_button_bar;=0A= $banner .=3D qq(
);=0A= =0A= print $banner;=0A= =0A= # debugging=0A= if ($debug)=0A= {=0A= print "

debugging params

";=0A=
    my($param,@val);=0A=
    foreach $param (sort $q->param())=0A=
    {=0A=
      @val =3D $q->param($param);=0A=
      printf "%-12s %s\n", $param, $q->escapeHTML(join(' ', @val));=0A=
    }=0A=
    print "
\n";=0A= }=0A= }=0A= =0A= # page_heading -=0A= #=0A= # Print the HTML which starts off a page. Basically a fancy

=0A= # plus user + database names.=0A= #=0A= sub page_heading=0A= {=0A= my($title, $heading) =3D @_;=0A= =0A= # Protect against multiple calls.=0A= return if $page_heading_done;=0A= $page_heading_done =3D 1;=0A= =0A= # Allow site callback to override html.=0A= my $html =3D cb('page_heading', $title, $heading);=0A= if ($html)=0A= {=0A= print $html;=0A= return;=0A= }=0A= print $q->h1({-style=3D>'font-weight: normal'}, $heading);=0A= }=0A= =0A= # page_footer -=0A= #=0A= # Allow the site_callback to take control before the end of the=0A= # page.=0A= #=0A= sub page_footer=0A= {=0A= my $title =3D shift;=0A= =0A= my $html =3D cb('page_footer', $title);=0A= print $html if ($html);=0A= }=0A= =0A= # page_end_html -=0A= #=0A= # Print the HTML which ends a page. Allow the site_callback to=0A= # take control here too.=0A= #=0A= sub page_end_html=0A= {=0A= my $title =3D shift;=0A= =0A= # Allow site callback to override html.=0A= my $html =3D cb('page_end_html', $title);=0A= if ($html)=0A= {=0A= print $html;=0A= return;=0A= }=0A= =0A= print $q->end_html();=0A= }=0A= =0A= # fix_multiline_val -=0A= # Modify text of multitext field so that it contains \n separators=0A= # (not \r\n or \n as some platforms use), and so that it has a \n=0A= # at the end.=0A= #=0A= sub fix_multiline_val=0A= {=0A= my $val =3D shift;=0A= $val =3D~ s/\r\n?/\n/g;=0A= $val .=3D "\n" unless $val =3D~ /\n$/;=0A= $val;=0A= }=0A= =0A= # unparse_multienum -=0A= # Multienum field values arrive from the form as an array. We=0A= # need to put all values into one string, values separated by the=0A= # multienum separator specified in the field config.=0A= sub unparse_multienum=0A= {=0A= my @values =3D @{$_[0]};=0A= my $field =3D $_[1];=0A= my $valstring;=0A= =0A= # Prepare the string of separated values.=0A= $valstring =3D join($fielddata{$field}{'default_sep'}, @values);=0A= =0A= return $valstring;=0A= }=0A= =0A= # parse_multienum=0A= # Passed a properly separated Multienum value string, we parse it=0A= # by splitting on the multienum separator(s) specified in the=0A= # field config and return the result as an array ref.=0A= sub parse_multienum=0A= {=0A= my $valstring =3D $_[0];=0A= my $field =3D $_[1];=0A= =20=20=0A= # Split and return array ref.=0A= my @values =3D split /[$fielddata{$field}{'separators'}]/, $valstring;=0A= return \@values;=0A= }=0A= =0A= # parse_categories -=0A= # Parse the categories file.=0A= sub parse_categories=0A= {=0A= my(@lines) =3D @_;=0A= =0A= # dtb - it looks to me like @category is only used within this sub=0A= # so why is it used at all?=0A= my @category =3D ();=0A= %category_notify =3D ();=0A= %category_desc =3D ();=0A= =0A= foreach $_ (sort @lines)=0A= {=0A= my($cat, $desc, $resp, $notify) =3D split(/:/);=0A= $category_desc{$cat} =3D $cat . ' - ' . $desc;=0A= push(@category, $cat);=0A= $category_notify{$cat} =3D $notify;=0A= }=0A= }=0A= =0A= # parse_submitters -=0A= # Parse the submitters file.=0A= sub parse_submitters=0A= {=0A= my(@lines) =3D @_;=0A= =0A= @submitter_id =3D ();=0A= %submitter_complete =3D ();=0A= %submitter_contact =3D ();=0A= %submitter_notify =3D ();=0A= =0A= foreach $_ (sort @lines)=0A= {=0A= my($submitter, $fullname, $type, $response_time, $contact, $notify)=0A= =3D split(/:/);=0A= push(@submitter_id, $submitter);=0A= $submitter_complete{$submitter} =3D $submitter .' - ' . $fullname;=0A= $submitter_contact{$submitter} =3D $contact;=0A= $submitter_notify{$submitter} =3D $notify;=0A= }=0A= }=0A= =0A= # parse_responsible -=0A= # Parse the responsible file.=0A= sub parse_responsible=0A= {=0A= my(@lines) =3D @_;=0A= =0A= @responsible =3D ();=0A= %responsible_fullname =3D ();=0A= %responsible_address =3D ();=0A= =0A= foreach $_ (sort @lines)=0A= {=0A= my($person, $fullname, $address) =3D split(/:/);=0A= push(@responsible, $person);=0A= $responsible_fullname{$person} =3D $fullname;=0A= $responsible_complete{$person} =3D $person . ' - ' . $fullname;=0A= $responsible_address{$person} =3D $address || $person;=0A= }=0A= }=0A= =0A= # initialize -=0A= # Initialize gnatsd-related globals and login to gnatsd.=0A= #=0A= sub initialize=0A= {=0A= my $regression_testing =3D shift;=0A= =0A= my(@lines);=0A= my $response;=0A= =0A= ($response) =3D client_init();=0A= =0A= # Get gnatsd version from initial server connection text.=0A= if ($response =3D~ /GNATS server (.*) ready/)=0A= {=0A= $GNATS_VERS =3D $1;=0A= }=0A= =0A= # Suppress fatal exit while issuing CHDB and USER commands. Otherwise=0A= # an error in the user or database cookie values can cause a user to=0A= # get in a bad state.=0A= LOGIN:=0A= {=0A= local($suppress_client_exit) =3D 1=0A= unless $regression_testing;=0A= =0A= # Issue DBLS command, so that we have a list of databases, in case=0A= # the user has tried to get into a db they don't have access to,=0A= # after which we won't be able to do this=0A= =0A= my (@db_list) =3D client_cmd("dbls");=0A= if (length($db_list[0]) =3D=3D 0 || $client_would_have_exited) {=0A= login_page($q->url());=0A= exit();=0A= } else {=0A= # store the list of databases for later use=0A= $global_list_of_dbs =3D \@db_list;=0A= }=0A= =0A= # Issue CHDB command; revert to login page if it fails.=0A= # use the three-arg version, to authenticate at the same time=0A= my (@chdb_response) =3D client_cmd("chdb $global_prefs{'database'} $db_p= refs{'user'} $db_prefs{'password'}");=0A= if (length($chdb_response[0]) =3D=3D 0 || $client_would_have_exited) {= =0A= login_page($q->url());=0A= exit();=0A= }=0A= =0A= # Get user permission level from the return value of CHDB=0A= # three arg CHDB should return something like this:=0A= # 210-Now accessing GNATS database 'foo'=0A= # 210 User access level set to 'edit'=0A= if ($chdb_response[1] =3D~ /User access level set to '(\w*)'/) {=0A= $access_level =3D lc($1);=0A= } else {=0A= $access_level =3D 'edit';=0A= }=0A= =0A= # check access level. if < view, make them log in again.=0A= # it might be better to allow "create-only" access for users=0A= # with 'submit' access.=0A= if ($LEVEL_TO_CODE{$access_level} < $LEVEL_TO_CODE{'edit'}) {=0A= login_page(undef, "You do not have access to database: $global_prefs= {'database'}.
\nPlease log in to another database

\n");=0A= undef($suppress_client_exit);=0A= client_exit();=0A= }=0A= }=0A= =0A= # Now initialize our metadata from the database.=0A= init_fieldinfo ();=0A= =0A= # List various gnats-adm files, and parse their contents for data we=0A= # will need later. Each parse subroutine stashes information away in=0A= # its own global vars. The call to client_cmd() happens here to=0A= # enable regression testing of the parse subs using fixed files.=0A= @lines =3D client_cmd("LIST Categories");=0A= parse_categories(@lines);=0A= @lines =3D client_cmd("LIST Submitters");=0A= parse_submitters(@lines);=0A= @lines =3D client_cmd("LIST Responsible");=0A= parse_responsible(@lines);=0A= =0A= # Now that everything's all set up, let the site_callback have at it.=0A= # It's return value doesn't matter, but here it can muck with our default= s.=0A= cb('initialize');=0A= }=0A= =0A= # trim_responsible -=0A= # Trim the value of the Responsible field to get a=0A= # valid responsible person. This exists here, and in gnats itself=0A= # (modify_pr(), check_pr(), gnats(), append_report()), for=0A= # compatibility with old databases, which had 'person (Full Name)'=0A= # in the Responsible field.=0A= sub trim_responsible=0A= {=0A= my $resp =3D shift;=0A= $resp =3D~ s/ .*//;=0A= $resp;=0A= }=0A= =0A= # fix_email_addrs -=0A= # Trim email addresses as they appear in an email From or Reply-To=0A= # header into a comma separated list of just the addresses.=0A= #=0A= # Delete everything inside ()'s and outside <>'s, inclusive.=0A= #=0A= sub fix_email_addrs=0A= {=0A= my $addrs =3D shift;=0A= my @addrs =3D split_csl ($addrs);=0A= my @trimmed_addrs;=0A= my $addr;=0A= foreach $addr (@addrs)=0A= {=0A= $addr =3D~ s/\(.*\)//;=0A= $addr =3D~ s/.*<(.*)>.*/$1/;=0A= $addr =3D~ s/^\s+//;=0A= $addr =3D~ s/\s+$//;=0A= push(@trimmed_addrs, $addr);=0A= }=0A= $addrs =3D join(', ', @trimmed_addrs);=0A= $addrs;=0A= }=0A= =0A= sub parsepr=0A= {=0A= # 9/18/99 kenstir: This two-liner can almost replace the next 30 or so=0A= # lines of code, but not quite. It strips leading spaces from multiline= =0A= # fields.=0A= #my $prtext =3D join("\n", @_);=0A= #my(%fields) =3D ('envelope' =3D> split /^>(\S*?):\s*/m, $prtext);=0A= # my $prtext =3D join("\n", @_);=0A= # my(%fields) =3D ('envelope' =3D> split /^>(\S*?):(?: *|\n)/m, $prtext)= ;=0A= =0A= my $debug =3D 0;=0A= =0A= my($hdrmulti) =3D "envelope";=0A= my(%fields);=0A= foreach (@_)=0A= {=0A= chomp($_);=0A= $_ .=3D "\n";=0A= if(!/^([>\w\-]+):\s*(.*)\s*$/)=0A= {=0A= if($hdrmulti ne "")=0A= {=0A= $fields{$hdrmulti} .=3D $_;=0A= }=0A= next;=0A= }=0A= my ($hdr, $arg, $ghdr) =3D ($1, $2, "*not valid*");=0A= if($hdr =3D~ /^>(.*)$/)=0A= {=0A= $ghdr =3D $1;=0A= }=0A= =0A= my $cleanhdr =3D $ghdr;=0A= $cleanhdr =3D~ s/^>([^:]*).*$/$1/;=0A= =0A= if(isvalidfield ($cleanhdr))=0A= {=0A= if(fieldinfo($cleanhdr, 'fieldtype') eq 'multitext')=0A= {=0A= $hdrmulti =3D $ghdr;=0A= $fields{$ghdr} =3D "";=0A= }=0A= else=0A= {=0A= $hdrmulti =3D "";=0A= $fields{$ghdr} =3D $arg;=0A= }=0A= }=0A= elsif($hdrmulti ne "")=0A= {=0A= $fields{$hdrmulti} .=3D $_;=0A= }=0A= =0A= # Grab a few fields out of the envelope as it flies by=0A= # 8/25/99 ehl: Grab these fields only out of the envelope, not=0A= # any other multiline field.=0A= if($hdrmulti eq "envelope" &&=0A= ($hdr eq "Reply-To" || $hdr eq "From"))=0A= {=0A= $arg =3D fix_email_addrs($arg);=0A= $fields{$hdr} =3D $arg;=0A= #print "storing, hdr =3D $hdr, arg =3D $arg\n";=0A= }=0A= }=0A= =0A= # 5/8/99 kenstir: To get the reporter's email address, only=0A= # $fields{'Reply-to'} is consulted. Initialized it from the 'From'=0A= # header if it's not set, then discard the 'From' header.=0A= $fields{'Reply-To'} =3D $fields{'Reply-To'} || $fields{'From'};=0A= delete $fields{'From'};=0A= =0A= # Ensure that the pseudo-fields are initialized to avoid perl warnings.= =0A= $fields{'X-GNATS-Notify'} ||=3D '';=0A= =0A= # 3/30/99 kenstir: For some reason Unformatted always ends up with an=0A= # extra newline here.=0A= $fields{$UNFORMATTED_FIELD} ||=3D ''; # Default to empty value=0A= $fields{$UNFORMATTED_FIELD} =3D~ s/\n$//;=0A= =0A= # Decode attachments stored in Unformatted field.=0A= my $any_attachments =3D 0;=0A= if (can_do_mime()) {=0A= my(@attachments) =3D split(/$attachment_delimiter/, $fields{$UNFORMATTE= D_FIELD});=0A= # First element is any random text which precedes delimited attachments= .=0A= $fields{$UNFORMATTED_FIELD} =3D shift(@attachments);=0A= foreach my $attachment (@attachments) {=0A= warn "att=3D>$attachment<=3D\n" if $debug;=0A= $any_attachments =3D 1;=0A= # Strip leading spaces on each line of the attachment=0A= $attachment =3D~ s/^[ ]//mg;=0A= add_decoded_attachment_to_pr(\%fields, decode_attachment($attachment)= );=0A= }=0A= }=0A= =0A= if ($debug) {=0A= warn "--- parsepr fields ----\n";=0A= my %fields_copy =3D %fields;=0A= foreach (@fieldnames)=0A= {=0A= warn "$_ =3D>$fields_copy{$_}<=3D\n";=0A= delete $fields_copy{$_}=0A= }=0A= warn "--- parsepr pseudo-fields ----\n";=0A= foreach (sort keys %fields_copy) {=0A= warn "$_ =3D>$fields_copy{$_}<=3D\n";=0A= }=0A= warn "--- parsepr attachments ---\n";=0A= my $aref =3D $fields{'attachments'} || [];=0A= foreach my $href (@$aref) {=0A= warn " ----\n";=0A= my ($k,$v);=0A= while (($k,$v) =3D each %$href) {=0A= warn " $k =3D>$v<=3D\n";=0A= }=0A= }=0A= }=0A= =0A= return %fields;=0A= }=0A= =0A= # unparsepr -=0A= # Turn PR fields hash into a multi-line string.=0A= #=0A= # The $purpose arg controls how things are done. The possible values= =0A= # are:=0A= # 'gnatsd' - PR will be filed using gnatsd; proper '.' escaping do= ne=0A= # 'send' - PR will be field using gnatsd, and is an initial PR.= =0A= # 'test' - we're being called from the regression tests=0A= sub unparsepr=0A= {=0A= my($purpose, %fields) =3D @_;=0A= my($tmp, $text);=0A= my $debug =3D 0;=0A= =0A= # First create or reconstruct the Unformatted field containing the=0A= # attachments, if any.=0A= $fields{$UNFORMATTED_FIELD} ||=3D ''; # Default to empty.=0A= warn "unparsepr 1 =3D>$fields{$UNFORMATTED_FIELD}<=3D\n" if $debug;=0A= my $array_ref =3D $fields{'attachments'};=0A= foreach my $hash_ref (@$array_ref) {=0A= my $attachment_data =3D $$hash_ref{'original_attachment'};=0A= # Deleted attachments leave empty hashes behind.=0A= next unless defined($attachment_data);=0A= $fields{$UNFORMATTED_FIELD} .=3D $attachment_delimiter . $attachment_da= ta . "\n";=0A= }=0A= warn "unparsepr 2 =3D>$fields{$UNFORMATTED_FIELD}<=3D\n" if $debug;=0A= =0A= # Reconstruct the text of the PR into $text.=0A= $text =3D $fields{'envelope'};=0A= foreach (@fieldnames)=0A= {=0A= # Do include Unformatted field in 'send' operation, even though=0A= # it's excluded. We need it to hold the file attachment.=0A= # XXX ??? !!! FIXME=0A= if(($purpose eq 'send')=0A= && (! (fieldinfo ($_, 'flags') & $SENDINCLUDE))=0A= && ($_ ne $UNFORMATTED_FIELD))=0A= {=0A= next;=0A= }=0A= if(fieldinfo($_, 'fieldtype') eq 'multitext')=0A= {=0A= # Lines which begin with a '.' need to be escaped by another '.'=0A= # if we're feeding it to gnatsd.=0A= $tmp =3D $fields{$_};=0A= $tmp =3D~ s/^[.]/../gm=0A= if ($purpose ne 'test');=0A= $text .=3D sprintf(">$_:\n%s", $tmp);=0A= }=0A= else=0A= {=0A= # Format string derived from gnats/pr.c.=0A= $fields{$_} ||=3D ''; # Default to empty=0A= $text .=3D sprintf("%-16s %s\n", ">$_:", $fields{$_});=0A= }=0A= if (exists ($fields{$_."-Changed-Why"}))=0A= {=0A= # Lines which begin with a '.' need to be escaped by another '.'=0A= # if we're feeding it to gnatsd.=0A= $tmp =3D $fields{$_."-Changed-Why"};=0A= $tmp =3D~ s/^[.]/../gm=0A= if ($purpose ne 'test');=0A= $text .=3D sprintf(">$_-Changed-Why:\n%s\n", $tmp);=0A= }=0A= }=0A= return $text;=0A= }=0A= =0A= sub lockpr=0A= {=0A= my($pr, $user) =3D @_;=0A= #print "
locking $pr $user\n
";=0A= return parsepr(client_cmd("lock $pr $user"));=0A= }=0A= =0A= sub unlockpr=0A= {=0A= my($pr) =3D @_;=0A= #print "
unlocking $pr\n
";=0A= client_cmd("unlk $pr");=0A= }=0A= =0A= sub readpr=0A= {=0A= my($pr) =3D @_;=0A= =0A= # Not sure if we want to do a RSET here but it probably won't hurt.=0A= client_cmd ("rset");=0A= client_cmd ("QFMT full");=0A= return parsepr(client_cmd("quer $pr"));=0A= }=0A= =0A= # interested_parties -=0A= # Get list of parties to notify about a PR change.=0A= #=0A= # Returns hash in array context; string of email addrs otherwise.=0A= sub interested_parties=0A= {=0A= my($pr, %fields) =3D @_;=0A= =0A= my(@people);=0A= my $person;=0A= my $list;=0A= =0A= # Get list of people by constructing it ourselves.=0A= @people =3D ();=0A= foreach $list ($fields{'Reply-To'},=0A= $fields{$RESPONSIBLE_FIELD},=0A= $category_notify{$fields{$CATEGORY_FIELD}},=0A= $submitter_contact{$fields{$SUBMITTER_ID_FIELD}},=0A= $submitter_notify{$fields{$SUBMITTER_ID_FIELD}})=0A= {=0A= if (defined($list)) {=0A= foreach $person (split_csl ($list))=0A= {=0A= push(@people, $person) if $person;=0A= }=0A= }=0A= }=0A= =0A= # Expand any unexpanded addresses, and build up the %addrs hash.=0A= my(%addrs) =3D ();=0A= my $addr;=0A= foreach $person (@people)=0A= {=0A= $addr =3D praddr($person) || $person;=0A= $addrs{$addr} =3D 1;=0A= }=0A= return wantarray ? %addrs : join(', ', keys(%addrs));=0A= }=0A= =0A= # Split comma-separated list.=0A= # Commas in quotes are not separators!=0A= sub split_csl=0A= {=0A= my ($list) =3D @_;=0A= =20=20=0A= # Substitute commas in quotes with \002.=0A= while ($list =3D~ m~"([^"]*)"~g)=0A= {=0A= my $pos =3D pos($list);=0A= my $str =3D $1;=0A= $str =3D~ s~,~\002~g;=0A= $list =3D~ s~"[^"]*"~"$str"~;=0A= pos($list) =3D $pos;=0A= }=0A= =0A= my @res;=0A= foreach my $person (split(/\s*,\s*/, $list))=0A= {=0A= $person =3D~ s/\002/,/g;=0A= push(@res, $person) if $person;=0A= }=0A= return @res;=0A= }=0A= =0A= # praddr -=0A= # Return email address of responsible person, or undef if not found.=0A= sub praddr=0A= {=0A= my $person =3D shift;=0A= # Done this way to avoid -w warning=0A= my $addr =3D exists($responsible_address{$person})=0A= ? $responsible_address{$person} : undef;=0A= }=0A= =0A= # login_page_javascript -=0A= # Returns some Javascript code to test if cookies are being accepted.= =0A= #=0A= sub login_page_javascript=0A= {=0A= my $ret =3D q{=0A= =0A= =20=20=20=0A= };=0A= }=0A= =20=0A= =0A= # change the database in the global cookie=0A= #=0A= sub change_database=0A= {=0A= $global_prefs{'database'} =3D $q->param('new_db');=0A= my $global_cookie =3D create_global_cookie();=0A= my $url =3D $q->url();=0A= # the refresh header chokes on the query-string if the=0A= # params are separated by semicolons...=0A= $url =3D~ s/\;/&/g;=0A= =0A= print_header(-Refresh =3D> "0; URL=3D$url",=0A= -cookie =3D> [$global_cookie]),=0A= $q->start_html();=0A= print $q->h3("Hold on... Redirecting...
".=0A= "In case it does not work automatically, please follow ".= =0A= "this link."),=0A= $q->end_html();=0A= }=0A= =0A= # clear the db_prefs cookie containing username and password and take=0A= # the user back to the login page=0A= sub cmd_logout=0A= {=0A= my $db =3D $global_prefs{'database'};=0A= my $db_cookie =3D $q->cookie(-name =3D> "gnatsweb-db-$db",=0A= -value =3D> 'does not matter',=0A= -path =3D> $global_cookie_path,=0A= -expires =3D> '-1d');=0A= my $url =3D $q->url();=0A= # the refresh header chokes on the query-string if the=0A= # params are separated by semicolons...=0A= $url =3D~ s/\;/&/g;=0A= =0A= print_header(-Refresh =3D> "0; URL=3D$url",=0A= -cookie =3D> [$db_cookie]),=0A= $q->start_html();=0A= print $q->h3("Hold on... Redirecting...
".=0A= "In case it does not work automatically, please follow ".=0A= "this link."),=0A= $q->end_html();=0A= }=0A= =0A= # execute the login, after the user submits from the login page=0A= #=0A= sub cmd_login {=0A= unless ($site_gnatsweb_server_auth) {=0A= # first, do some sanity checking on the username=0A= # user name must be something reasonable=0A= # and must not be all digits (like a PR number...)=0A= my $user =3D $q->param('user');=0A= if ($user !~ /^[\w-]+$/ || $user !~ /[a-z]/i) {=0A= if ($user =3D~ /\s/) {=0A= $user =3D $user . ' (contains whitespace)';=0A= }=0A= print_header();=0A= login_page(undef, 'Invalid User Name: "'.$user.'", please log in again= ');=0A= exit();=0A= }=0A= }=0A= =0A= my $global_cookie =3D create_global_cookie();=0A= my $db =3D $global_prefs{'database'};=0A= =0A= # Have to generate the cookie before printing the header.=0A= my %cookie_hash =3D (=0A= -name =3D> "gnatsweb-db-$db",=0A= -value =3D> camouflage(\%db_prefs),=0A= -path =3D> $global_cookie_path=0A= );=0A= %cookie_hash =3D (%cookie_hash, -expires =3D> $global_cookie_expires)= =0A= unless $use_temp_db_prefs_cookie;=0A= my $db_cookie =3D $q->cookie(%cookie_hash);=0A= =0A= my $expire_old_cookie =3D $q->cookie(-name =3D> 'gnatsweb',=0A= -value =3D> 'does not matter',=0A= #-path was not used for gnatsweb 2.5 cookies= =0A= -expires =3D> '-1d');=0A= my $url =3D $q->param('return_url');=0A= # the refresh header chokes on the query-string if the=0A= # params are separated by semicolons...=0A= $url =3D~ s/\;/&/g;=0A= =0A= # 11/27/99 kenstir: Try zero-delay refresh all the time.=0A= $url =3D $q->url() if (!defined($url));=0A= # 11/14/99 kenstir: For some reason doing cookies + redirect didn't=0A= # work; got a 'page contained no data' error from NS 4.7. This cookie= =0A= # + redirect technique did work for me in a small test case.=0A= #print $q->redirect(-location =3D> $url,=0A= # -cookie =3D> [$global_cookie, $db_cookie]);=0A= # So, this is sort of a lame replacement; a zero-delay refresh.=0A= print_header(-Refresh =3D> "0; URL=3D$url",=0A= -cookie =3D> [$global_cookie, $db_cookie, $expire_old_= cookie]),=0A= $q->start_html();=0A= my $debug =3D 0;=0A= if ($debug) {=0A= print "

debugging params

";=0A=
      my($param,@val);=0A=
      foreach $param (sort $q->param()) {=0A=
        @val =3D $q->param($param);=0A=
        printf "%-12s %s\n", $param, $q->escapeHTML(join(' ', @val));=0A=
      }=0A=
      print "
\n";=0A= }=0A= # Add a link to the new URL. In case the refresh/redirect above did not= =0A= # work, at least the user can select the link manually.=0A= print $q->h3("Hold on... Redirecting...
".=0A= "In case it does not work automatically, please follow ".= =0A= "this link."),=0A= $q->end_html();=0A= }=0A= =0A= # login_page -=0A= # Show the login page.=0A= #=0A= # If $return_url passed in, then we are showing the login page because= =0A= # the user failed to login. In that case, when the login is=0A= # successful, we want to redirect to the given url. For example, if a= =0A= # user follows a ?cmd=3Dview url, but hasn't logged in yet, then we wan= t=0A= # to forward him to the originally requested url after logging in.=0A= #=0A= sub login_page=0A= {=0A= my ($return_url, $message) =3D @_;=0A= my $page =3D 'Login';=0A= page_start_html($page, 1);=0A= page_heading($page, 'Login');=0A= =0A= print login_page_javascript();=0A= =0A= my $html =3D cb('login_page_text');=0A= print $html || '';=0A= =0A= if ($message) {=0A= print $message;=0A= }=0A= =0A= client_init();=0A= my(@dbs) =3D client_cmd("dbls");=0A= print $q->start_form(), hidden_debug(), "";=0A= unless($site_gnatsweb_server_auth) {=0A= print "= \n\n";=0A= if ($site_no_gnats_passwords) {=0A= # we're not using gnats passwords, so the password input=0A= # is superfluous. put in a hidden field with a bogus value,=0A= # just so other parts of the program don't get confused=0A= print qq**;=0A= } else {=0A= print "\n\n\n\n";=0A= }=0A= }=0A= print "\n\n\n\n",=0A= "
Benutzername:",=0A= $q->textfield(-name=3D>'user',=0A= -size=3D>20,=0A= -default=3D>$db_prefs{'user'}),=0A= "
Passwort:",=0A= $q->password_field(-name=3D>'password',=0A= -value=3D>$db_prefs{'password'},=0A= -size=3D>20),=0A= "
Datenbank:",=0A= $q->popup_menu(-name=3D>'database',=0A= -values=3D>\@dbs,=0A= -default=3D>$global_prefs{'database'}),=0A= "
\n";=0A= if (defined($return_url))=0A= {=0A= print $q->hidden('return_url', $return_url);=0A= }=0A= # we need this extra hidden field in case users=0A= # just type in a username and hit return. this will=0A= # ensure that cmd_login() gets called to process the login.=0A= print qq**;=0A= print $q->submit('cmd','login'),=0A= $q->end_form();=0A= page_footer($page);=0A= page_end_html($page);=0A= }=0A= =0A= sub debug_print_all_cookies=0A= {=0A= # Debug: print all our cookies into server log.=0A= warn "=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D all cookies =3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D\n";=0A= my @c;=0A= my $i =3D 0;=0A= foreach my $y ($q->cookie())=0A= {=0A= @c =3D $q->cookie($y);=0A= warn "got cookie: length=3D", scalar(@c), ": $y =3D>@c<=3D\n";=0A= $i +=3D length($y);=0A= }=0A= # @c =3D $q->raw_cookie();=0A= # warn "debug 0.5: @c:\n";=0A= # warn "debug 0.5: total size of raw cookies: ", length("@c"), "\n";=0A= }=0A= =0A= # set_pref -=0A= # Set the named preference. Param values override cookie values, and= =0A= # don't set it if we end up with an undefined value.=0A= #=0A= sub set_pref=0A= {=0A= my($pref_name, $pref_hashref, $cval_hashref) =3D @_;=0A= my $val =3D $q->param($pref_name) || ($pref_name eq "password" ?=0A= uncamouflage($$cval_hashref{$pref_name}) :=0A= $$cval_hashref{$pref_name}=0A= );=0A= =0A= $$pref_hashref{$pref_name} =3D $val=0A= if defined($val);=0A= }=0A= =0A= # init_prefs -=0A= # Initialize global_prefs and db_prefs from cookies and params.=0A= #=0A= sub init_prefs=0A= {=0A= my $debug =3D 0;=0A= =0A= if ($debug) {=0A= debug_print_all_cookies();=0A= use Data::Dumper;=0A= $Data::Dumper::Terse =3D 1;=0A= warn "-------------- init_prefs -------------------\n";=0A= }=0A= =0A= # Global prefs.=0A= my %cvals =3D $q->cookie('gnatsweb-global');=0A= if (! %cvals) {=0A= $global_no_cookies =3D 1;=0A= }=0A= =0A= # deal with legacy cookies, which used email_addr=0A= if ($cvals{'email_addr'})=0A= {=0A= $cvals{'email'} =3D $cvals{'email_addr'};=0A= }=0A= =0A= %global_prefs =3D ();=0A= set_pref('database', \%global_prefs, \%cvals);=0A= set_pref('email', \%global_prefs, \%cvals);=0A= set_pref($ORIGINATOR_FIELD, \%global_prefs, \%cvals);=0A= set_pref($SUBMITTER_ID_FIELD, \%global_prefs, \%cvals);=0A= =0A= # columns is treated differently because it's an array which is stored=0A= # in the cookie as a joined string.=0A= if ($q->param('columns')) {=0A= my(@columns) =3D $q->param('columns');=0A= $global_prefs{'columns'} =3D join(' ', @columns);=0A= }=0A= elsif (defined($cvals{'columns'})) {=0A= $global_prefs{'columns'} =3D $cvals{'columns'};=0A= }=0A= =0A= if (!$cvals{'email'}) {=0A= $global_prefs{'email'} =3D $q->param('email') || '';=0A= }=0A= =0A= # DB prefs.=0A= my $database =3D $global_prefs{'database'} || '';=0A= if ($site_gnatsweb_server_auth)=0A= {=0A= # we're not using cookies for user/password=0A= # since the server is doing authentication=0A= %cvals =3D ( 'password' =3D> $ENV{REMOTE_USER},=0A= 'user' =3D> $ENV{REMOTE_USER} );=0A= }=0A= else=0A= {=0A= %cvals =3D $q->cookie("gnatsweb-db-$database");=0A= }=0A= %db_prefs =3D ();=0A= set_pref('user', \%db_prefs, \%cvals);=0A= set_pref('password', \%db_prefs, \%cvals);=0A= =0A= # Debug.=0A= warn "global_prefs =3D ", Dumper(\%global_prefs) if $debug;=0A= warn "db_prefs =3D ", Dumper(\%db_prefs) if $debug;=0A= }=0A= =0A= # create_global_cookie -=0A= # Create cookie from %global_prefs.=0A= #=0A= sub create_global_cookie=0A= {=0A= my $debug =3D 0;=0A= # As of gnatsweb-2.6beta, the name of this cookie changed. This was=0A= # done so that the old cookie would not be read.=0A= my $cookie =3D $q->cookie(-name =3D> 'gnatsweb-global',=0A= -value =3D> \%global_prefs,=0A= -path =3D> $global_cookie_path,=0A= -expires =3D> $global_cookie_expires);=0A= warn "storing cookie: $cookie\n" if $debug;=0A= return $cookie;=0A= }=0A= =0A= # camouflage -=0A= # If passed a scalar, camouflages it by XORing it with 19 and=0A= # reversing the string. If passed a hash reference with key=0A= # "password", it camouflages the values of this key using the=0A= # same algorithm.=0A= #=0A= sub camouflage=0A= {=0A= my $clear =3D shift || '';=0A= if (ref($clear) =3D~ "HASH")=0A= {=0A= my $res =3D {};=0A= foreach my $key (keys %$clear)=0A= {=0A= $$res{$key} =3D ( $key eq "password" ?=0A= camouflage($$clear{$key}) : $$clear{$key} );=0A= }=0A= return $res;=0A= }=0A= $clear =3D~ s/(.)/chr(19 ^ ord $1)/eg;=0A= return (reverse $clear) || '';=0A= }=0A= =0A= # uncamouflage=0A= # Since the camouflage algorithm employed is symmetric...=0A= #=0A= sub uncamouflage=0A= {=0A= return camouflage(@_);=0A= }=0A= =0A= #=0A= # MAIN starts here:=0A= #=0A= sub main=0A= {=0A= # Load $gnatsweb_site_file if present. Die if there are errors;=0A= # otherwise the person who wrote $gnatsweb_site_file will never know it.= =0A= if (-e $gnatsweb_site_file && -r $gnatsweb_site_file) {=0A= open(GWSP, "<$gnatsweb_site_file");=0A= local $/ =3D undef;=0A= my $gnatsweb_site_pl =3D ;=0A= eval($gnatsweb_site_pl);=0A= if ($@) {=0A= warn("gnatsweb: error in eval of $gnatsweb_site_file: $@; user=3D$db_pre= fs{'user'}, db=3D$global_prefs{'database'}; stacktrace: ", print_stacktrace= ());=0A= die $@=0A= }=0A= }=0A= =0A= # Make sure nobody tries to swamp our server with a huge file attachment.= =0A= # Has to happen before 'new CGI'.=0A= $CGI::POST_MAX =3D $site_post_max if defined($site_post_max);=0A= =0A= # Create the query object. Check to see if there was an error, which=0A= # happens if the post exceeds POST_MAX.=0A= $q =3D new CGI;=0A= if ($q->cgi_error())=0A= {=0A= print_header(-status=3D>$q->cgi_error());=0A= $q->start_html('Fehler');=0A= page_heading('Inititalisierung fehlgeschlagen', 'Fehler');=0A= print $q->h3('Request not processed: ', $q->cgi_error());=0A= warn("gnatsweb: cgi error: ", $q->cgi_error(), " ; user=3D$db_prefs{'us= er'}, db=3D$global_prefs{'database'}; stacktrace: ", print_stacktrace());= =0A= exit();=0A= }=0A= =0A= if ($site_allow_remote_debug) {=0A= my $debugparam =3D $q->param('debug') || '';=0A= # check for debug flag in query string.=0A= if ($debugparam eq 'cmd') {=0A= $client_cmd_debug =3D 1;=0A= }=0A= if ($debugparam eq 'reply') {=0A= $reply_debug =3D 1;=0A= }=0A= if ($debugparam eq 'all') {=0A= $reply_debug =3D 1;=0A= $client_cmd_debug =3D 1;=0A= }=0A= }=0A= =0A= $script_name =3D $q->script_name;=0A= my $cmd =3D $q->param('cmd') || ''; # avoid perl -w warning=0A= =0A= ### Cookie-related code must happen before we print the HTML header.=0A= init_prefs();=0A= =0A= if(!$global_prefs{'database'}=0A= || !$db_prefs{'user'})=0A= {=0A= # We don't have username/database; give login page then=0A= # redirect to the url they really want (self_url).=0A= print_header();=0A= login_page($q->self_url());=0A= exit();=0A= }=0A= =0A= # Big old switch to handle commands.=0A= if($cmd eq 'abfrage speichern')=0A= {=0A= store_query();=0A= exit();=0A= }=0A= elsif($cmd eq 'delete stored query')=0A= {=0A= delete_stored_query();=0A= exit();=0A= }=0A= elsif($cmd eq 'datenbank wechseln')=0A= {=0A= # change the user's database in global cookie=0A= change_database();=0A= exit();=0A= }=0A= elsif($cmd eq 'submit stored query')=0A= {=0A= submit_stored_query();=0A= exit();=0A= }=0A= elsif($cmd eq 'login')=0A= {=0A= cmd_login();=0A= }=0A= elsif($cmd eq 'abmelden')=0A= {=0A= # User is logging out.=0A= cmd_logout();=0A= exit();=0A= }=0A= elsif($cmd eq 'senden')=0A= {=0A= initialize();=0A= =0A= # Only include Create action if user is allowed to create PRs.=0A= # (only applicable if $no_create_without_edit flag is set)=0A= main_page() unless can_create();=0A= =0A= submitnewpr();=0A= exit();=0A= }=0A= elsif($cmd eq 'submit query')=0A= {=0A= # User is querying. Store cookie because column display list may=0A= # have changed.=0A= print_header(-cookie =3D> create_global_cookie());=0A= initialize();=0A= submitquery();=0A= exit();=0A= }=0A= elsif($cmd =3D~ /download attachment (\d+)/)=0A= {=0A= # User is downloading an attachment. Must initialize but not print hea= der.=0A= initialize();=0A= download_attachment($1);=0A= exit();=0A= }=0A= elsif($cmd eq 'erstellen')=0A= {=0A= print_header();=0A= initialize();=0A= =0A= # Only include Create action if user is allowed to create PRs.=0A= # (only applicable if $no_create_without_edit flag is set)=0A= main_page() unless can_create();=0A= =0A= sendpr();=0A= }=0A= elsif($cmd eq 'anzeigen')=0A= {=0A= print_header();=0A= initialize();=0A= view(0);=0A= }=0A= elsif($cmd eq 'view audit-trail')=0A= {=0A= print_header();=0A= initialize();=0A= view(1);=0A= }=0A= elsif($cmd eq '=E4ndern')=0A= {=0A= print_header();=0A= initialize();=0A= =0A= # Only include Edit action if user is allowed to Edit PRs.=0A= main_page() unless can_edit();=0A= =0A= edit();=0A= }=0A= elsif($cmd eq 'submit edit')=0A= {=0A= initialize();=0A= =0A= # Only include Edit action if user is allowed to Edit PRs.=0A= main_page() unless can_edit();=0A= =0A= submitedit();=0A= }=0A= elsif($cmd eq 'abfrage')=0A= {=0A= print_header();=0A= initialize();=0A= query_page();=0A= }=0A= elsif($cmd eq 'erw. abfrage')=0A= {=0A= print_header();=0A= initialize();=0A= advanced_query_page();=0A= }=0A= elsif($cmd eq 'abfrage speichern')=0A= {=0A= print_header();=0A= initialize();=0A= store_query();=0A= }=0A= elsif($cmd eq 'hilfe')=0A= {=0A= print_header();=0A= initialize();=0A= help_page();=0A= }=0A= elsif (cb('cmd', $cmd)) {=0A= ; # cmd was handled by callback=0A= }=0A= else=0A= {=0A= print_header();=0A= initialize();=0A= main_page();=0A= }=0A= =0A= client_exit();=0A= exit();=0A= }=0A= =0A= # To make this code callable from another source file, set $suppress_main.= =0A= $suppress_main ||=3D 0;=0A= main() unless $suppress_main;=0A= =0A= # Emacs stuff -=0A= #=0A= # Local Variables:=0A= # perl-indent-level:2=0A= # perl-continued-brace-offset:-6=0A= # perl-continued-statement-offset:6=0A= # End:=0A= ------_=_NextPart_000_01C393EF.993A7DC0 Content-Type: application/octet-stream; name="gnatsweb-site.pl" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="gnatsweb-site.pl" Content-length: 685 #=0A= # gnatsweb-site.pl -=0A= # Gnatsweb site-specific variables and subroutines.=0A= #=0A= # $Id: gnatsweb-site.pl,v 1.3 2001/10/17 21:25:38 yngves Exp $=0A= #=0A= =0A= # GNATS host.=0A= $site_gnats_host =3D 'localhost';=0A= =0A= # The port which the GNATS server is running on.=0A= # Default installations of GNATS run on port 1529.=0A= $site_gnats_port =3D '1529';=0A= =0A= $site_mail_domain =3D '@postdirekt.de';=0A= =0A= $site_banner_text =3D 'Post Direkt';=0A= $site_banner_background =3D '#000000';=0A= $site_banner_foreground =3D '#ffffff';=0A= $site_button_background =3D '#000000';=0A= $site_button_foreground =3D '#ffffff';=0A= =0A= $site_background =3D '#FFFFB7';=0A= ------_=_NextPart_000_01C393EF.993A7DC0 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline Content-length: 139 _______________________________________________ Help-gnats mailing list Help-gnats@gnu.org http://mail.gnu.org/mailman/listinfo/help-gnats ------_=_NextPart_000_01C393EF.993A7DC0--