← Back to branch summary

~ubuntu-branches/debian/squeeze/debbugs/squeeze

« back to all changes in this revision

Viewing changes to cgi/cgi-lib.pl

  • Committer: Bazaar Package Importer
  • Author(s): Colin Watson
  • Date: 2003-06-06 09:25:30 UTC
  • Revision ID: james.westby@ubuntu.com-20030606092530-0tnoi4bc3xcrusm3
Tags: 2.4.1
http://bugs.debian.org/170630
http://bugs.debian.org/50746
http://bugs.debian.org/136114
http://bugs.debian.org/139696
http://bugs.debian.org/194892
http://bugs.debian.org/139697
http://bugs.debian.org/153590
http://bugs.debian.org/60595
* Colin Watson:
  - Exit the CGI scripts straight away if the HTTP method is HEAD, to save
    pointless work.
  - Display pending+fixed bugs as "fixed in NMU", not "pending upload".
  - Add a man page for debbugsconfig.
  - Report original tags when changing them, closes: #170630.
  - Add missing <ul></ul> tags to db2html's output, closes: #50746.
  - Add a 'submitter' command to service, based on a patch by Matt Kraai.
  - Remove the final use of cgi-lib.pl, so it's gone. Remove copyright
    notices that were there due to using it.
  - Accept ';' as well as '&' as a CGI argument separator.
  - db2html now works with the new hashed database layout.
  - Disable the fixed severity in favour of the tag.
  - MIME-encoded messages to bugs are displayed in decoded form on the web
    interface (unless the "mime=no" parameter is used), closes: #136114.
  - Add facility to search by tag.
  - Fix rebuild script and add it to the example crontab, closes: #139696.
  - Silence postinst warning if spool/db doesn't exist, closes: #194892.
  - Clean up the definition and use of $gCGIDomain, closes: #139697.
* Adam Heath:
  - Convert all code to use global read/write functions, instead of having
    it duplicated everywhere.
  - Trim trailing whitespace from pseudoheader values.  Closes: #153590.
  - Warn when reassigning to an unknown package.  Closes: #60595.
* Josip Rodin:
  - Added a terse=yes mode for bugreport.cgi, possibly useful for
    monstrously long bugs.
  - Purged needless date(1) forks, replaced with strftime.

Show diffs side-by-side

added added

removed removed

Lines of Context:
cgi/cgi-lib.pl
1
 
#!/usr/bin/perl
2
 
 
3
 
# Perl Routines to Manipulate CGI input
4
 
#
5
 
# Copyright (c) 1995 Steven E. Brenner
6
 
# Permission granted to use and modify this library so long as the
7
 
# copyright above is maintained, modifications are documented, and
8
 
# credit is given for any use of the library.
9
 
#
10
 
# Thanks are due to many people for reporting bugs and suggestions
11
 
# especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,
12
 
# Andrew Dalke, Mark-Jason Dominus, Dave Dittrich, Jason Mathews
13
 
 
14
 
# For more information, see:
15
 
#     http://www.bio.cam.ac.uk/web/form.html
16
 
#     http://www.seas.upenn.edu/~mengwong/forms/
17
 
 
18
 
# Minimalist http form and script (http://www.bio.cam.ac.uk/web/minimal.cgi):
19
 
#
20
 
# require "cgi-lib.pl";
21
 
# if (&ReadParse(*input)) {
22
 
#    print &PrintHeader, &PrintVariables(%input);
23
 
# } else {
24
 
#   print &PrintHeader,'<form><input type="submit"> Data: <input name="myfield">';
25
 
#}
26
 
 
27
 
# ReadParse
28
 
# Reads in GET or POST data, converts it to unescaped text,
29
 
# creates key/value pairs in %in, using '\0' to separate multiple
30
 
# selections
31
 
 
32
 
# Returns TRUE if there was input, FALSE if there was no input
33
 
# UNDEF may be used in the future to indicate some failure.
34
 
 
35
 
# Now that cgi scripts can be put in the normal file space, it is useful
36
 
# to combine both the form and the script in one place.  If no parameters
37
 
# are given (i.e., ReadParse returns FALSE), then a form could be output.
38
 
 
39
 
# If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
40
 
# information is stored there, rather than in $in, @in, and %in.
41
 
 
42
 
sub ReadParse {
43
 
  local (*in) = @_ if @_;
44
 
  local ($i, $key, $val);
45
 
 
46
 
  # Read in text
47
 
  if (&MethGet) {
48
 
    $in = $ENV{'QUERY_STRING'};
49
 
  } elsif (&MethPost) {
50
 
    read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
51
 
  }
52
 
 
53
 
  @in = split(/[&;]/,$in);
54
 
 
55
 
  foreach $i (0 .. $#in) {
56
 
    # Convert plus's to spaces
57
 
    $in[$i] =~ s/\+/ /g;
58
 
 
59
 
    # Split into key and value.
60
 
    ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
61
 
 
62
 
    # Convert %XX from hex numbers to alphanumeric
63
 
    $key =~ s/%(..)/pack("c",hex($1))/ge;
64
 
    $val =~ s/%(..)/pack("c",hex($1))/ge;
65
 
 
66
 
    # Associate key and value
67
 
    $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
68
 
    $in{$key} .= $val;
69
 
 
70
 
  }
71
 
 
72
 
  return scalar(@in);
73
 
}
74
 
 
75
 
 
76
 
# PrintHeader
77
 
# Returns the magic line which tells WWW that we're an HTML document
78
 
 
79
 
sub PrintHeader {
80
 
  return "Content-type: text/html\n\n";
81
 
}
82
 
 
83
 
 
84
 
# HtmlTop
85
 
# Returns the <head> of a document and the beginning of the body
86
 
# with the title and a body <h1> header as specified by the parameter
87
 
 
88
 
sub HtmlTop
89
 
{
90
 
  local ($title) = @_;
91
 
 
92
 
  return <<END_OF_TEXT;
93
 
<html>
94
 
<head>
95
 
<title>$title</title>
96
 
</head>
97
 
<body>
98
 
<h1>$title</h1>
99
 
END_OF_TEXT
100
 
}
101
 
 
102
 
# Html Bot
103
 
# Returns the </body>, </html> codes for the bottom of every HTML page
104
 
 
105
 
sub HtmlBot
106
 
{
107
 
   return "</body>\n</html>\n";
108
 
 }
109
 
 
110
 
 
111
 
# MethGet
112
 
# Return true if this cgi call was using the GET request, false otherwise
113
 
 
114
 
sub MethGet {
115
 
  return ($ENV{'REQUEST_METHOD'} eq "GET");
116
 
}
117
 
 
118
 
 
119
 
# MethPost
120
 
# Return true if this cgi call was using the POST request, false otherwise
121
 
 
122
 
sub MethPost {
123
 
  return ($ENV{'REQUEST_METHOD'} eq "POST");
124
 
}
125
 
 
126
 
 
127
 
# MyURL
128
 
# Returns a URL to the script
129
 
 
130
 
sub MyURL  {
131
 
  local ($port);
132
 
  $port = ":" . $ENV{'SERVER_PORT'} if  $ENV{'SERVER_PORT'} != 80;
133
 
  return  'http://' . $ENV{'SERVER_NAME'} .  $port . $ENV{'SCRIPT_NAME'};
134
 
}
135
 
 
136
 
 
137
 
# CgiError
138
 
# Prints out an error message which which containes appropriate headers,
139
 
# markup, etcetera.
140
 
# Parameters:
141
 
#  If no parameters, gives a generic error message
142
 
#  Otherwise, the first parameter will be the title and the rest will
143
 
#  be given as different paragraphs of the body
144
 
 
145
 
sub CgiError {
146
 
  local (@msg) = @_;
147
 
  local ($i,$name);
148
 
 
149
 
  if (!@msg) {
150
 
    $name = &MyURL;
151
 
    @msg = ("Error: script $name encountered fatal error");
152
 
  };
153
 
 
154
 
  print &PrintHeader;
155
 
  print "<html><head><title>$msg[0]</title></head>\n";
156
 
  print "<body><h1>$msg[0]</h1>\n";
157
 
  foreach $i (1 .. $#msg) {
158
 
    print "<p>$msg[$i]</p>\n";
159
 
  }
160
 
  print "</body></html>\n";
161
 
}
162
 
 
163
 
 
164
 
# CgiDie
165
 
# Identical to CgiError, but also quits with the passed error message.
166
 
 
167
 
sub CgiDie {
168
 
  local (@msg) = @_;
169
 
  &CgiError (@msg);
170
 
  die @msg;
171
 
}
172
 
 
173
 
 
174
 
# PrintVariables
175
 
# Nicely formats variables in an associative array passed as a parameter
176
 
# And returns the HTML string.
177
 
sub PrintVariables {
178
 
  local (%in) = @_;
179
 
  local ($old, $out, $output);
180
 
  $old = $*;  $* =1;
181
 
  $output .=  "\n<dl compact>\n";
182
 
  foreach $key (sort keys(%in)) {
183
 
    foreach (split("\0", $in{$key})) {
184
 
      ($out = $_) =~ s/\n/<br>\n/g;
185
 
      $output .=  "<dt><b>$key</b>\n <dd><i>$out</i><br>\n";
186
 
    }
187
 
  }
188
 
  $output .=  "</dl>\n";
189
 
  $* = $old;
190
 
 
191
 
  return $output;
192
 
}
193
 
 
194
 
# PrintVariablesShort
195
 
# Now obsolete; just calls PrintVariables
196
 
 
197
 
sub PrintVariablesShort {
198
 
  return &PrintVariables(@_);
199
 
}
200
 
 
201
 
1; #return true
202
 
 
203