git.sesse.net Git - itkacl/blob - itkacl-web-1.0/include/itkaclcommon.pm

   1 #! /usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use CGI;
   5 use DBI;
   6 use Apache::Session::Postgres;
   7 use Encode;
   8 use HTML::Entities;
   9 use Digest::HMAC_SHA1;
  10 use locale;
  11 use utf8;
  12
  13 require 'config.pm';
  14
  15 package itkaclcommon;
  16
  17 our $cgi;
  18 our $dbh;
  19 our $last_modified = '$Date: 2011-11-19 11:08:01 $';
  20 our %session;
  21 our $csrf_token;
  22 our $masked_csrf_token;
  23
  24 sub init {
  25         $cgi = new CGI;
  26         $dbh = DBI->connect("dbi:Pg:dbname=$itkaclconfig::db_name;host=$itkaclconfig::db_host",
  27                 $itkaclconfig::db_user, $itkaclconfig::db_pass)
  28                 or die "Couldn't connect to database";
  29         $dbh->{pg_enable_utf8} = 1;
  30         $last_modified = '$Date: 2011-11-19 11:08:01 $';
  31         %session = ();
  32
  33         if (defined($ENV{'REMOTE_USER'})) {
  34                 $csrf_token = Digest::HMAC_SHA1::hmac_sha1($ENV{'REMOTE_USER'}, $itkaclcommon::hmac_key);
  35
  36                 # Mask the CSRF token to avoid the BREACH attack.
  37                 my @hmac_bytes = map { ord($_) } (split //, $csrf_token);
  38                 my @random_bytes = map { int(rand(256)) } (0..$#hmac_bytes);
  39                 my @masked_bytes = map { $hmac_bytes[$_] ^ $random_bytes[$_] } (0..$#hmac_bytes);
  40
  41                 my $random_bytes_string = join('', map { chr($_) } (@random_bytes));
  42                 my $masked_bytes_string = join('', map { chr($_) } (@masked_bytes));
  43                 $masked_csrf_token = unpack('H*', $random_bytes_string) . '_' . unpack("H*", $masked_bytes_string);
  44         } else {
  45                 $csrf_token = '';
  46                 $masked_csrf_token = '';
  47         }
  48 }
  49
  50 sub check_csrf_token {
  51         if ($csrf_token eq '') {
  52                 # Not logged in, so always fine.
  53                 return 1;
  54         }
  55
  56         my $candidate_csrf_token = $cgi->param('csrftoken');
  57         if ($candidate_csrf_token !~ /^([0-9a-f]+)_([0-9a-f]+)$/) {
  58                 die "Invalid CSRF token!";
  59         }
  60
  61         my ($random_bytes_string, $masked_bytes_string) = ($1, $2);
  62         if (length($random_bytes_string) != length($masked_bytes_string)) {
  63                 die "Length mismatch in CSRF token!";
  64         }
  65
  66         my @random_bytes = map { ord($_) } (split //, pack('H*', $random_bytes_string));
  67         my @masked_bytes = map { ord($_) } (split //, pack('H*', $masked_bytes_string));
  68         my @hmac_bytes = map { $masked_bytes[$_] ^ $random_bytes[$_] } (0..$#masked_bytes);
  69         my $hmac_string = join('', map { chr($_) } (@hmac_bytes));
  70
  71         die "CSRF token mismatch!" if ($hmac_string ne $csrf_token);
  72 }
  73
  74 sub print_header {
  75         init();
  76
  77         # Find the cookie, if any
  78         my $session_id = $cgi->cookie('itkaclsession');
  79         tie %session, 'Apache::Session::Postgres', $session_id, {
  80                 DataSource => "dbi:Pg:dbname=$itkaclconfig::sessiondb_name;host=$itkaclconfig::sessiondb_host",
  81                 UserName   => $itkaclconfig::sessiondb_user,
  82                 Password   => $itkaclconfig::sessiondb_pass,
  83                 Commit     => 1
  84         };
  85
  86         # Update with open/close
  87         my $open = $cgi->param('open');
  88         my $close = $cgi->param('close');
  89         if (defined($open)) {
  90                 $session{$open} = 1;
  91         } elsif (defined($close)) {
  92                 undef $session{$close};
  93         }
  94
  95         my $cookie = $cgi->cookie(-name=>'itkaclsession',
  96                         -value=>$session{_session_id},
  97                         -expires=>'+1h');
  98
  99         binmode STDOUT, ":utf8";
 100         print $cgi->header(-type=>'application/xhtml+xml; charset=utf-8', cookie=>$cookie, -expires=>'now');
 101
 102         open HEADER, "<", $itkaclconfig::header
 103                 or die "Couldn't open $itkaclconfig::header: $!";
 104
 105         # Find out if we're using SSO.
 106         my $sso = "";
 107         if (defined($ENV{'AUTH_TYPE'}) && $ENV{'AUTH_TYPE'} eq 'Negotiate') {
 108                 $sso = '<img src="https://itk.samfundet.no/images/ssso-button.png" alt="Samfundet single sign-on" title="Samfundet single sign-on"/>';
 109         }
 110
 111         # Set secure path.
 112         local @ENV;
 113         delete @ENV{qw(IFS CDPATH ENV BASH_ENV PATH)};
 114
 115         my $quote;
 116         if (defined($itkaclconfig::quotescript)) {
 117                 # Hent inn quotes. Stygt, jodal! =)
 118                 $quote = `$itkaclconfig::quotescript`;
 119                 $quote = Encode::decode_utf8($quote);
 120         }
 121
 122         while (<HEADER>) {
 123                 s/\%QUOTES\%/$quote/ if defined($quote);
 124                 s/\%SSO\%/$sso/;
 125                 s/\%META\%//;
 126                 s/\%TITLE\%/ITKACL-tre/;
 127                 s/"http:\/\/([^"]*\.(css|png))"/"https:\/\/$1"/;
 128                 print;
 129         }
 130
 131         close HEADER;
 132 }
 133
 134 sub print_footer {
 135         untie %session;
 136
 137         # Print footer
 138         open FOOTER, "<", $itkaclconfig::footer
 139                 or die "Couldn't open $itkaclconfig::footer: $!";
 140
 141         # Strip RCS stuff from $::last_modified
 142         (my $lm = $last_modified) =~ s/^\$[D]ate: (.*) \$$/$1/;
 143
 144         while (<FOOTER>) {
 145                 s/\%LAST_MODIFIED\%/$lm/;
 146                 print;
 147         }
 148
 149         close FOOTER;
 150 }
 151
 152 sub print_tree {
 153         my ($fulltree, $boldelem) = @_;
 154         if ($fulltree) {
 155                 print "    <div class=\"tree\">\n";
 156         } else {
 157                 print "    <div class=\"tree floatingtree\">\n";
 158         }
 159
 160         print "      <p><img src=\"/img/base-folder.png\" alt=\"\" width=\"21\" height=\"18\" />Samfundet</p>\n";
 161
 162         print_tree_element($dbh, undef, 0, [], $fulltree, $boldelem);
 163
 164         print "    </div>\n";
 165 }
 166
 167 sub print_tree_element {
 168         my ($dbh, $curr_obj, $level, $vbars, $fulltree, $boldelem) = @_;
 169
 170         my $refs;
 171         if (defined($curr_obj)) {
 172                 $refs = $dbh->selectall_arrayref('SELECT id,name,description FROM objects WHERE parent=? ORDER BY name', undef, $curr_obj);
 173         } else {
 174                 $refs = $dbh->selectall_arrayref('SELECT id,name,description FROM objects WHERE parent IS NULL ORDER BY name');
 175         }
 176
 177         my $i = 0;
 178         my $count = (scalar @{$refs}) - 1;
 179         for my $ref (@{$refs}) {
 180                 # More siblings?
 181                 my $msb;
 182                 my @vbarscopy = @{$vbars};
 183                 if ($i == $count) {
 184                         $msb = "";
 185                         push @vbarscopy, 0;
 186                 } else {
 187                         $msb = "-moresiblings";
 188                         push @vbarscopy, 1;
 189                 }
 190
 191                 print "    <p>";
 192
 193                 # Stuff to the left of folder
 194                 for my $i (1..$level) {
 195                         if ($vbars->[$i - 1]) {
 196                                 print '<img src="/img/verticalbar.png" alt="|" width="16" height="18" />';
 197                         } else {
 198                                 print '<img src="/img/whitespace.png" alt="&nbsp;" width="16" height="18" />';
 199                         }
 200                 }
 201
 202                 # The folder itself
 203                 my $countref = $dbh->selectrow_hashref('SELECT COUNT(*) AS num FROM objects WHERE parent=?', undef, $ref->[0]);
 204                 if ($countref->{'num'} == 0) {
 205                         if ($i == $count) {
 206                                 print "<img src=\"/img/folder-nochildren.png\" alt=\"\" width=\"37\" height=\"18\" />";
 207                         } else {
 208                                 print "<img src=\"/img/folder-nochildren-moresiblings.png\" alt=\"|\" width=\"37\" height=\"18\" />";
 209                         }
 210                 } else {
 211                         my $url = $cgi->url(-absolute=>1) . "?";
 212                         my @params = ();
 213                         for my $p ($cgi->param()) {
 214                                 next if ($p eq 'open');
 215                                 next if ($p eq 'close');
 216                                 push @params, "$p=" . $cgi->param($p);
 217                         }
 218                         if (scalar @params > 0) {
 219                                 $url .= join('&amp;', @params) . "&amp;";
 220                         }
 221
 222                         if (defined($session{$ref->[0]})) {
 223                                 print "<a href=\"${url}close=$ref->[0]\"><img src=\"/img/folder-open$msb.png\" alt=\"-\" width=\"37\" height=\"18\" /></a>";
 224                         } else {
 225                                 print "<a href=\"${url}open=$ref->[0]\"><img src=\"/img/folder-closed$msb.png\" alt=\"+\" width=\"37\" height=\"18\" /></a>";
 226                         }
 227                 }
 228
 229                 if (defined($boldelem) && $boldelem == $ref->[0]) {
 230                         print "<strong>";
 231                 }
 232
 233                 my $e_entity = HTML::Entities::encode_entities($ref->[1]);
 234                 my $e_description = HTML::Entities::encode_entities($ref->[2]);
 235
 236                 if ($fulltree) {
 237                         print "<a href=\"/view.pl?entry=$ref->[0]\">$e_entity: $e_description</a>";
 238                 } else {
 239                         print "<a href=\"/view.pl?entry=$ref->[0]\" title=\"$e_description\">$e_entity</a>";
 240                 }
 241
 242                 if (defined($boldelem) && $boldelem == $ref->[0]) {
 243                         print "</strong>";
 244                 }
 245                 print "</p>\n";
 246
 247                 if ($countref->{'num'} > 0 && defined($session{$ref->[0]})) {
 248                         print_tree_element($dbh, $ref->[0], $level + 1, \@vbarscopy, $fulltree, $boldelem);
 249                 }
 250                 ++$i;
 251         }
 252 }
 253
 254 1;