Girocco/CGI.pm

   1 package Girocco::CGI;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Girocco::Config;
   7 use Girocco::Util;
   8
   9 BEGIN {
  10         our $VERSION = '0.1';
  11         our @ISA = qw(Exporter);
  12         our @EXPORT = qw(html_esc);
  13
  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");
  19 }
  20
  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
  37         );
  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
  48         );
  49 }
  50
  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))]);
  61         }
  62         $str =~ s/--/'-'.chr($_randchars[int(rand($ccnt-1))])/gse;
  63         return $str;
  64 }
  65
  66 sub _vulnpad {
  67         # Return suitably commented vulnerability mitigation padding if applicable
  68
  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.
  73
  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";
  80         }
  81         return $vulnrandpad;
  82 }
  83
  84 sub new {
  85         my $class = shift;
  86         my ($heading, $section, $extraheadhtml, $sectionlink) = @_;
  87         my $gcgi = {};
  88         my $vulnrandpad = _vulnpad;
  89
  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 || '');
  96
  97         $gcgi->{cgi} = CGI->new;
  98
  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};
 102
 103         print $gcgi->{cgi}->header(-type=>'text/html', -charset => 'utf-8');
 104
 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">
 109
 110 <head>
 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>
 118
 119 <body>
 120
 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
 124 </div>
 125
 126 EOT
 127
 128         bless $gcgi, $class;
 129 }
 130
 131 sub DESTROY {
 132         my $self = shift;
 133         my $vulnrandpad = _vulnpad;
 134         if ($self->{srcname} and $Girocco::Config::giroccourl) {
 135                 my $hb = $Girocco::Config::giroccobranch ?
 136                         "hb=$Girocco::Config::giroccobranch;" : "";
 137                 print <<EOT;
 138 <div align="right">
 139 <a href="@{[url_path($Girocco::Config::giroccourl)]}?a=blob;${hb}f=$self->{srcname}">(view source)</a>
 140 </div>
 141 EOT
 142         }
 143         print <<EOT;
 144 </body>
 145 $vulnrandpad</html>
 146 EOT
 147 }
 148
 149 sub cgi {
 150         my $self = shift;
 151         $self->{cgi};
 152 }
 153
 154 sub err {
 155         my $self = shift;
 156         print "<p style=\"color: #c00000; word-wrap: break-word\">@_</p>\n";
 157         $self->{err}++;
 158 }
 159
 160 sub ok {
 161         my $self = shift;
 162         my $err = $self->{err}||0;
 163         return $err == 0;
 164 }
 165
 166 sub err_check {
 167         my $self = shift;
 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";
 171         $err;
 172 }
 173
 174 sub wparam {
 175         my $self = shift;
 176         my ($param) = @_;
 177         my $val = $self->{cgi}->param($param);
 178         defined $val and $val =~ s/^\s*(.*?)\s*$/$1/;
 179         $val;
 180 }
 181
 182 sub srcname {
 183         my $self = shift;
 184         my ($srcname) = @_;
 185         $self->{srcname} = $srcname if $srcname;
 186         $self->{srcname};
 187 }
 188
 189 sub html_esc($;$) {
 190         my $str = shift;
 191         my $charentityokay = shift;
 192         defined($str) or $str = '';
 193         if ($charentityokay) {
 194                 $str =~ s/&(?!#(?:[xX][a-fA-F0-9]+|\d+);)/&amp;/g;
 195         } else {
 196                 $str =~ s/&/&amp;/g;
 197         }
 198         $str =~ s/</&lt;/g; $str =~ s/>/&gt;/g;
 199         $str =~ s/[""]/&quot;/g; $str =~ s/['']/&apos;/g;
 200         $str;
 201 }
 202
 203 sub print_form_fields {
 204         my $self = shift;
 205         my ($fieldmap, $valuemap, @fields) = @_;
 206
 207         foreach my $field (map { $fieldmap->{$_} } @fields) {
 208                 my $title='';
 209                 if (defined($field->[3]) && $field->[3] ne '') {
 210                         $title=' title="'.html_esc($field->[3], 1).'"'
 211                 }
 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;
 216                         print ' />';
 217                 } else {
 218                         print '<textarea name="'.$field->[1].'" rows="5" cols="80">';
 219                         print $valuemap->{$field->[1]} if $valuemap;
 220                         print '</textarea>';
 221                 }
 222                 print "</td></tr>\n";
 223         }
 224 }
 225
 226
 227 1;