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, $sectionlink) = @_;
  85         my $gcgi = {};
  86         my $vulnrandpad = _vulnpad;
  87
  88         $heading = CGI::escapeHTML($heading || '');
  89         $section = CGI::escapeHTML($section || 'administration');
  90         $section = "<a href=\"$sectionlink\">$section</a>" if $sectionlink;
  91         # $extraheadhtml is optional RAW html code to include, DO NOT escapeHTML it!
  92         $extraheadhtml = $extraheadhtml || '';
  93         my $name = CGI::escapeHTML($Girocco::Config::name || '');
  94
  95         $gcgi->{cgi} = CGI->new;
  96
  97         my $cgiurl = $gcgi->{cgi}->url(-absolute => 1);
  98         ($gcgi->{srcname}) = ($cgiurl =~ m#^.*/\([a-zA-Z0-9_.\/-]+?\.cgi\)$#); #
  99         $gcgi->{srcname} = "cgi/".$gcgi->{srcname} if $gcgi->{srcname};
 100
 101         print $gcgi->{cgi}->header(-type=>'text/html', -charset => 'utf-8');
 102
 103         print <<EOT;
 104 <?xml version="1.0" encoding="utf-8"?>
 105 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
 106 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-US" lang="en-US">
 107
 108 <head>
 109 <title>$name :: $heading</title>
 110 <link rel="stylesheet" type="text/css" href="@{[url_path($Girocco::Config::gitwebfiles)]}/gitweb.css"/>
 111 <link rel="stylesheet" type="text/css" href="@{[url_path($Girocco::Config::gitwebfiles)]}/girocco.css"/>
 112 <link rel="shortcut icon" href="@{[url_path($Girocco::Config::gitwebfiles)]}/git-favicon.png" type="image/png"/>
 113 <script src="@{[url_path($Girocco::Config::gitwebfiles)]}/mootools.js" type="text/javascript"></script>
 114 <script src="@{[url_path($Girocco::Config::gitwebfiles)]}/girocco.js" type="text/javascript"></script>
 115 $extraheadhtml$vulnrandpad</head>
 116
 117 <body>
 118
 119 <div class="page_header">
 120 <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>
 121 <a href="@{[url_path($Girocco::Config::gitweburl,1)]}">$name</a> / $section / $heading
 122 </div>
 123
 124 EOT
 125
 126         bless $gcgi, $class;
 127 }
 128
 129 sub DESTROY {
 130         my $self = shift;
 131         my $vulnrandpad = _vulnpad;
 132         if ($self->{srcname} and $Girocco::Config::giroccourl) {
 133                 my $hb = $Girocco::Config::giroccobranch ?
 134                         "hb=$Girocco::Config::giroccobranch;" : "";
 135                 print <<EOT;
 136 <div align="right">
 137 <a href="@{[url_path($Girocco::Config::giroccourl)]}?a=blob;${hb}f=$self->{srcname}">(view source)</a>
 138 </div>
 139 EOT
 140         }
 141         print <<EOT;
 142 </body>
 143 $vulnrandpad</html>
 144 EOT
 145 }
 146
 147 sub cgi {
 148         my $self = shift;
 149         $self->{cgi};
 150 }
 151
 152 sub err {
 153         my $self = shift;
 154         print "<p style=\"color: red; word-wrap: break-word\">@_</p>\n";
 155         $self->{err}++;
 156 }
 157
 158 sub ok {
 159         my $self = shift;
 160         my $err = $self->{err}||0;
 161         return $err == 0;
 162 }
 163
 164 sub err_check {
 165         my $self = shift;
 166         my $err = $self->{err}||0;
 167         my $s = $err == 1 ? '' : 's';
 168         $err and print "<p style=\"font-weight: bold\">Operation aborted due to $err error$s.</p>\n";
 169         $err;
 170 }
 171
 172 sub wparam {
 173         my $self = shift;
 174         my ($param) = @_;
 175         my $val = $self->{cgi}->param($param);
 176         defined $val and $val =~ s/^\s*(.*?)\s*$/$1/;
 177         $val;
 178 }
 179
 180 sub srcname {
 181         my $self = shift;
 182         my ($srcname) = @_;
 183         $self->{srcname} = $srcname if $srcname;
 184         $self->{srcname};
 185 }
 186
 187 sub html_esc {
 188         my $str = shift;
 189         defined($str) or $str = '';
 190         $str =~ s/&/&amp;/g;
 191         $str =~ s/</&lt;/g; $str =~ s/>/&gt;/g;
 192         $str =~ s/[""]/&quot;/g; $str =~ s/['']/&apos;/g;
 193         $str;
 194 }
 195
 196 sub print_form_fields {
 197         my $self = shift;
 198         my ($fieldmap, $valuemap, @fields) = @_;
 199
 200         foreach my $field (map { $fieldmap->{$_} } @fields) {
 201                 print '<tr><td class="formlabel">'.$field->[0].':</td><td>';
 202                 if ($field->[2] eq 'text') {
 203                         print '<input type="text" name="'.$field->[1].'" size="80"';
 204                         print ' value="'.$valuemap->{$field->[1]}.'"' if $valuemap;
 205                         print ' />';
 206                 } else {
 207                         print '<textarea name="'.$field->[1].'" rows="5" cols="80">';
 208                         print $valuemap->{$field->[1]} if $valuemap;
 209                         print '</textarea>';
 210                 }
 211                 print "</td></tr>\n";
 212         }
 213 }
 214
 215
 216 1;