Girocco/CGI.pm: add charset and xhtml spaces
[girocco.git] / Girocco / CGI.pm
blob23713e2f81622602ced351a8b6289aef4aefbd71
1 package Girocco::CGI;
3 use strict;
4 use warnings;
6 use Girocco::Config;
7 use Girocco::Util;
9 BEGIN {
10 our $VERSION = '0.1';
11 our @ISA = qw(Exporter);
12 our @EXPORT = qw(html_esc);
14 use CGI qw(:standard :escapeHTML -nosticky);
15 use CGI::Util qw(unescape);
16 use CGI::Carp qw(fatalsToBrowser);
17 eval 'sub CGI::multi_param {CGI::param(@_)}'
18 unless CGI->can("multi_param");
21 my @_randlens;
22 my @_randchars;
23 BEGIN {
24 @_randlens = (
25 # the prime numbers >= 1024 and < 2048
26 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, 1087, 1091, 1093, 1097, 1103,
27 1109, 1117, 1123, 1129, 1151, 1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213,
28 1217, 1223, 1229, 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291, 1297,
29 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373, 1381, 1399, 1409, 1423,
30 1427, 1429, 1433, 1439, 1447, 1451, 1453, 1459, 1471, 1481, 1483, 1487, 1489,
31 1493, 1499, 1511, 1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579, 1583,
32 1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657, 1663, 1667, 1669,
33 1693, 1697, 1699, 1709, 1721, 1723, 1733, 1741, 1747, 1753, 1759, 1777, 1783,
34 1787, 1789, 1801, 1811, 1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877, 1879,
35 1889, 1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987, 1993, 1997,
36 1999, 2003, 2011, 2017, 2027, 2029, 2039
38 @_randchars = (
39 # IMPORTANT: The '-' MUST be the last character in the array so we can
40 # use one less than the array length to randomly replace the second '-'
41 # in any generated '--' sequence.
42 9, 10, 13, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 46, 47, 48, 49,
43 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69,
44 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89,
45 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107,
46 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123,
47 124, 125, 126, 45 # '-' (45/0x2D) MUST be last
51 sub _randpad {
52 # return 1K - 2K of random padding that is a random length which
53 # happens to be prime and is suitable for inclusion as an XHTML comment
54 # (the comment delimiters are NOT added)
55 use bytes;
56 my $len = $_randlens[int(rand(@_randlens))];
57 my $ccnt = @_randchars;
58 my $str = '';
59 for (my $i=1; $i<$len; ++$i) {
60 $str .= chr($_randchars[int(rand($ccnt))]);
62 $str =~ s/--/'-'.chr($_randchars[int(rand($ccnt-1))])/gse;
63 return $str;
66 sub _vulnpad {
67 # Return suitably commented vulnerability mitigation padding if applicable
69 # If https is enabled (HTTPS == "on") attempt to avoid the compression
70 # vulnerability as described in VU#987798/CVE-2013-3587 (aka BREACH).
71 # This only need be done for POST requests as nothing else has sensitive data.
72 # See http://www.kb.cert.org/vuls/id/987798 for further information.
74 my $vulnrandpad = "";
75 if (($ENV{'HTTPS'} && lc($ENV{'HTTPS'}) eq 'on') &&
76 ($ENV{'REQUEST_METHOD'} && lc($ENV{'REQUEST_METHOD'}) eq 'post')) {
77 # Add some random padding to mitigate the vulnerability
78 $vulnrandpad = "<!-- Mitigate VU#987798/CVE-2013-3587 with random padding -->\n";
79 $vulnrandpad .= "<!-- " . _randpad . " -->\n";
81 return $vulnrandpad;
84 sub new {
85 my $class = shift;
86 my ($heading, $section, $extraheadhtml, $sectionlink) = @_;
87 my $gcgi = {};
88 my $vulnrandpad = _vulnpad;
90 $heading = CGI::escapeHTML($heading || '');
91 $section = CGI::escapeHTML($section || 'administration');
92 $section = "<a href=\"$sectionlink\">$section</a>" if $sectionlink;
93 # $extraheadhtml is optional RAW html code to include, DO NOT escapeHTML it!
94 $extraheadhtml = $extraheadhtml || '';
95 my $name = CGI::escapeHTML($Girocco::Config::name || '');
97 $gcgi->{cgi} = CGI->new;
99 my $cgiurl = $gcgi->{cgi}->url(-absolute => 1);
100 ($gcgi->{srcname}) = ($cgiurl =~ m#^.*/\([a-zA-Z0-9_.\/-]+?\.cgi\)$#); #
101 $gcgi->{srcname} = "cgi/".$gcgi->{srcname} if $gcgi->{srcname};
103 print $gcgi->{cgi}->header(-type=>'text/html', -charset => 'utf-8');
105 print <<EOT;
106 <?xml version="1.0" encoding="utf-8"?>
107 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
108 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
110 <head>
111 <meta charset="utf-8" />
112 <meta http-equiv="content-type" content="text/html; charset=utf-8" />
113 <title>$name :: $heading</title>
114 <link rel="stylesheet" type="text/css" href="@{[url_path($Girocco::Config::gitwebfiles)]}/gitweb.css" />
115 <link rel="stylesheet" type="text/css" href="@{[url_path($Girocco::Config::gitwebfiles)]}/girocco.css" />
116 <link rel="shortcut icon" href="@{[url_path($Girocco::Config::gitwebfiles)]}/git-favicon.png" type="image/png" />
117 <script src="@{[url_path($Girocco::Config::gitwebfiles)]}/mootools.js" type="text/javascript"></script>
118 <script src="@{[url_path($Girocco::Config::gitwebfiles)]}/girocco.js" type="text/javascript"></script>
119 $extraheadhtml$vulnrandpad</head>
121 <body>
123 <div class="page_header">
124 <a href="http://git-scm.com/" title="Git homepage"><img src="@{[url_path($Girocco::Config::gitwebfiles)]}/git-logo.png" width="72" height="27" alt="git" style="float:right; border-width:0px;" /></a>
125 <a href="@{[url_path($Girocco::Config::gitweburl,1)]}">$name</a> / $section / $heading
126 </div>
130 bless $gcgi, $class;
133 sub DESTROY {
134 my $self = shift;
135 my $vulnrandpad = _vulnpad;
136 if ($self->{srcname} and $Girocco::Config::giroccourl) {
137 my $hb = $Girocco::Config::giroccobranch ?
138 "hb=$Girocco::Config::giroccobranch;" : "";
139 print <<EOT;
140 <div align="right">
141 <a href="@{[url_path($Girocco::Config::giroccourl)]}?a=blob;${hb}f=$self->{srcname}">(view source)</a>
142 </div>
145 print <<EOT;
146 </body>
147 $vulnrandpad</html>
151 sub cgi {
152 my $self = shift;
153 $self->{cgi};
156 # return previous value of $self->{errprelude}
157 # if at least one argument is given, then set $self->{errprelude} to the first arg
158 # if $self->{errprelude} is non-empty at the time the first err call happens then
159 # $self->{errprelude} will be output just before the first error message
160 sub err_prelude {
161 my $self = shift;
162 my $result = $self->{errprelude};
163 $self->{errprelude} = $_[0] if @_ >= 1;
164 return $result;
167 sub err {
168 my $self = shift;
169 print $self->{errprelude} if !$self->{err} && defined($self->{errprelude});
170 print "<p style=\"color: #c00000; word-wrap: break-word\">@_</p>\n";
171 $self->{err}++;
174 sub ok {
175 my $self = shift;
176 my $err = $self->{err}||0;
177 return $err == 0;
180 sub err_check {
181 my $self = shift;
182 my $err = $self->{err}||0;
183 my $s = $err == 1 ? '' : 's';
184 $err and print "<p style=\"font-weight: bold\">Operation aborted due to $err error$s.</p>\n";
185 $err;
188 sub wparam {
189 my $self = shift;
190 my ($param) = @_;
191 my $val = $self->{cgi}->param($param);
192 defined $val and $val =~ s/^\s*(.*?)\s*$/$1/;
193 $val;
196 sub srcname {
197 my $self = shift;
198 my ($srcname) = @_;
199 $self->{srcname} = $srcname if $srcname;
200 $self->{srcname};
203 sub html_esc($;$) {
204 my $str = shift;
205 my $charentityokay = shift;
206 defined($str) or $str = '';
207 if ($charentityokay) {
208 $str =~ s/&(?!#(?:[xX][a-fA-F0-9]+|\d+);)/&amp;/g;
209 } else {
210 $str =~ s/&/&amp;/g;
212 $str =~ s/</&lt;/g; $str =~ s/>/&gt;/g;
213 $str =~ s/[""]/&quot;/g; $str =~ s/['']/&apos;/g;
214 $str;
217 sub print_form_fields {
218 my $self = shift;
219 my ($fieldmap, $valuemap, @fields) = @_;
221 foreach my $field (map { $fieldmap->{$_} } @fields) {
222 defined($field->[2]) && $field->[2] ne 'placeholder' or next;
223 my $title='';
224 if (defined($field->[3]) && $field->[3] ne '') {
225 $title=' title="'.html_esc($field->[3], 1).'"'
227 print '<tr'.$title.'><td class="formlabel">'.$field->[0].':</td>';
228 if ($field->[2] eq 'text') {
229 print '<td><input type="text" name="'.$field->[1].'" size="80"';
230 print ' value="'.$valuemap->{$field->[1]}.'"' if $valuemap;
231 print ' />';
232 } elsif ($field->[2] eq 'checkbox') {
233 print '<td class="formdatatd"><input type="checkbox" name="'.$field->[1].'"';
234 print ' checked="checked"' if $valuemap && $valuemap->{$field->[1]};
235 printf ' value="%s"', ($valuemap && $valuemap->{$field->[1]} ? $valuemap->{$field->[1]} : "1");
236 print ' />';
237 } else {
238 print '<td><textarea name="'.$field->[1].'" rows="5" cols="80">';
239 print $valuemap->{$field->[1]} if $valuemap;
240 print '</textarea>';
242 print "</td></tr>\n";