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");
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
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
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)
56 my $len = $_randlens[int(rand(@_randlens))];
57 my $ccnt = @_randchars;
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;
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.
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";
86 my ($heading, $section, $extraheadhtml, $sectionlink) = @_;
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');
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">
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>
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
135 my $vulnrandpad = _vulnpad
;
136 if ($self->{srcname
} and $Girocco::Config
::giroccourl
) {
137 my $hb = $Girocco::Config
::giroccobranch ?
138 "hb=$Girocco::Config::giroccobranch;" : "";
141 <a href="@{[url_path($Girocco::Config::giroccourl)]}?a=blob;${hb}f=$self->{srcname}">(view source)</a>
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
162 my $result = $self->{errprelude
};
163 $self->{errprelude
} = $_[0] if @_ >= 1;
169 print $self->{errprelude
} if !$self->{err
} && defined($self->{errprelude
});
170 print "<p style=\"color: #c00000; word-wrap: break-word\">@_</p>\n";
176 my $err = $self->{err
}||0;
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";
191 my $val = $self->{cgi
}->param($param);
192 defined $val and $val =~ s/^\s*(.*?)\s*$/$1/;
199 $self->{srcname
} = $srcname if $srcname;
205 my $charentityokay = shift;
206 defined($str) or $str = '';
207 if ($charentityokay) {
208 $str =~ s/&(?!#(?:[xX][a-fA-F0-9]+|\d+);)/&/g;
212 $str =~ s/</</g; $str =~ s/>/>/g;
213 $str =~ s/[""]/"/g; $str =~ s/['']/'/g;
217 sub print_form_fields
{
219 my ($fieldmap, $valuemap, @fields) = @_;
221 foreach my $field (map { $fieldmap->{$_} } @fields) {
222 defined($field->[2]) && $field->[2] ne 'placeholder' or next;
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;
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");
238 print '<td><textarea name="'.$field->[1].'" rows="5" cols="80">';
239 print $valuemap->{$field->[1]} if $valuemap;
242 print "</td></tr>\n";