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