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.
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 <title>$name :: $heading</title>
112 <link rel="stylesheet" type="text/css" href="@{[url_path($Girocco::Config::gitwebfiles)]}/gitweb.css"/>
113 <link rel="stylesheet" type="text/css" href="@{[url_path($Girocco::Config::gitwebfiles)]}/girocco.css"/>
114 <link rel="shortcut icon" href="@{[url_path($Girocco::Config::gitwebfiles)]}/git-favicon.png" type="image/png"/>
115 <script src="@{[url_path($Girocco::Config::gitwebfiles)]}/mootools.js" type="text/javascript"></script>
116 <script src="@{[url_path($Girocco::Config::gitwebfiles)]}/girocco.js" type="text/javascript"></script>
117 $extraheadhtml$vulnrandpad</head>
121 <div class="page_header">
122 <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>
123 <a href="@{[url_path($Girocco::Config::gitweburl,1)]}">$name</a> / $section / $heading
133 my $vulnrandpad = _vulnpad
;
134 if ($self->{srcname
} and $Girocco::Config
::giroccourl
) {
135 my $hb = $Girocco::Config
::giroccobranch ?
136 "hb=$Girocco::Config::giroccobranch;" : "";
139 <a href="@{[url_path($Girocco::Config::giroccourl)]}?a=blob;${hb}f=$self->{srcname}">(view source)</a>
156 print "<p style=\"color: #c00000; word-wrap: break-word\">@_</p>\n";
162 my $err = $self->{err
}||0;
168 my $err = $self->{err
}||0;
169 my $s = $err == 1 ?
'' : 's';
170 $err and print "<p style=\"font-weight: bold\">Operation aborted due to $err error$s.</p>\n";
177 my $val = $self->{cgi
}->param($param);
178 defined $val and $val =~ s/^\s*(.*?)\s*$/$1/;
185 $self->{srcname
} = $srcname if $srcname;
191 my $charentityokay = shift;
192 defined($str) or $str = '';
193 if ($charentityokay) {
194 $str =~ s/&(?!#(?:[xX][a-fA-F0-9]+|\d+);)/&/g;
198 $str =~ s/</</g; $str =~ s/>/>/g;
199 $str =~ s/[""]/"/g; $str =~ s/['']/'/g;
203 sub print_form_fields
{
205 my ($fieldmap, $valuemap, @fields) = @_;
207 foreach my $field (map { $fieldmap->{$_} } @fields) {
209 if (defined($field->[3]) && $field->[3] ne '') {
210 $title=' title="'.html_esc
($field->[3], 1).'"'
212 print '<tr'.$title.'><td class="formlabel">'.$field->[0].':</td><td>';
213 if ($field->[2] eq 'text') {
214 print '<input type="text" name="'.$field->[1].'" size="80"';
215 print ' value="'.$valuemap->{$field->[1]}.'"' if $valuemap;
218 print '<textarea name="'.$field->[1].'" rows="5" cols="80">';
219 print $valuemap->{$field->[1]} if $valuemap;
222 print "</td></tr>\n";