6 use Apache::Session::Postgres;
19 our $last_modified = '$Date: 2011-11-19 11:08:01 $';
22 our $masked_csrf_token;
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 $';
33 if (defined($ENV{'REMOTE_USER'})) {
34 $csrf_token = Digest::HMAC_SHA1::hmac_sha1($ENV{'REMOTE_USER'}, $itkaclcommon::hmac_key);
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);
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);
46 $masked_csrf_token = '';
50 sub check_csrf_token {
51 if ($csrf_token eq '') {
52 # Not logged in, so always fine.
56 my $candidate_csrf_token = $cgi->param('csrftoken');
57 if ($candidate_csrf_token !~ /^([0-9a-f]+)_([0-9a-f]+)$/) {
58 die "Invalid CSRF token!";
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!";
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));
71 die "CSRF token mismatch!" if ($hmac_string ne $csrf_token);
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,
86 # Update with open/close
87 my $open = $cgi->param('open');
88 my $close = $cgi->param('close');
91 } elsif (defined($close)) {
92 undef $session{$close};
95 my $cookie = $cgi->cookie(-name=>'itkaclsession',
96 -value=>$session{_session_id},
99 binmode STDOUT, ":utf8";
100 print $cgi->header(-type=>'application/xhtml+xml; charset=utf-8', cookie=>$cookie, -expires=>'now');
102 open HEADER, "<", $itkaclconfig::header
103 or die "Couldn't open $itkaclconfig::header: $!";
105 # Find out if we're using 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"/>';
113 delete @ENV{qw(IFS CDPATH ENV BASH_ENV PATH)};
116 if (defined($itkaclconfig::quotescript)) {
117 # Hent inn quotes. Stygt, jodal! =)
118 $quote = `$itkaclconfig::quotescript`;
119 $quote = Encode::decode_utf8($quote);
123 s/\%QUOTES\%/$quote/ if defined($quote);
126 s/\%TITLE\%/ITKACL-tre/;
127 s/"http:\/\/([^"]*\.(css|png))"/"https:\/\/$1"/;
138 open FOOTER, "<", $itkaclconfig::footer
139 or die "Couldn't open $itkaclconfig::footer: $!";
141 # Strip RCS stuff from $::last_modified
142 (my $lm = $last_modified) =~ s/^\$[D]ate: (.*) \$$/$1/;
145 s/\%LAST_MODIFIED\%/$lm/;
153 my ($fulltree, $boldelem) = @_;
155 print " <div class=\"tree\">\n";
157 print " <div class=\"tree floatingtree\">\n";
160 print " <p><img src=\"/img/base-folder.png\" alt=\"\" width=\"21\" height=\"18\" />Samfundet</p>\n";
162 print_tree_element($dbh, undef, 0, [], $fulltree, $boldelem);
167 sub print_tree_element {
168 my ($dbh, $curr_obj, $level, $vbars, $fulltree, $boldelem) = @_;
171 if (defined($curr_obj)) {
172 $refs = $dbh->selectall_arrayref('SELECT id,name,description FROM objects WHERE parent=? ORDER BY name', undef, $curr_obj);
174 $refs = $dbh->selectall_arrayref('SELECT id,name,description FROM objects WHERE parent IS NULL ORDER BY name');
178 my $count = (scalar @{$refs}) - 1;
179 for my $ref (@{$refs}) {
182 my @vbarscopy = @{$vbars};
187 $msb = "-moresiblings";
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" />';
198 print '<img src="/img/whitespace.png" alt=" " width="16" height="18" />';
203 my $countref = $dbh->selectrow_hashref('SELECT COUNT(*) AS num FROM objects WHERE parent=?', undef, $ref->[0]);
204 if ($countref->{'num'} == 0) {
206 print "<img src=\"/img/folder-nochildren.png\" alt=\"\" width=\"37\" height=\"18\" />";
208 print "<img src=\"/img/folder-nochildren-moresiblings.png\" alt=\"|\" width=\"37\" height=\"18\" />";
211 my $url = $cgi->url(-absolute=>1) . "?";
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);
218 if (scalar @params > 0) {
219 $url .= join('&', @params) . "&";
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>";
225 print "<a href=\"${url}open=$ref->[0]\"><img src=\"/img/folder-closed$msb.png\" alt=\"+\" width=\"37\" height=\"18\" /></a>";
229 if (defined($boldelem) && $boldelem == $ref->[0]) {
233 my $e_entity = HTML::Entities::encode_entities($ref->[1]);
234 my $e_description = HTML::Entities::encode_entities($ref->[2]);
237 print "<a href=\"/view.pl?entry=$ref->[0]\">$e_entity: $e_description</a>";
239 print "<a href=\"/view.pl?entry=$ref->[0]\" title=\"$e_description\">$e_entity</a>";
242 if (defined($boldelem) && $boldelem == $ref->[0]) {
247 if ($countref->{'num'} > 0 && defined($session{$ref->[0]})) {
248 print_tree_element($dbh, $ref->[0], $level + 1, \@vbarscopy, $fulltree, $boldelem);