From d00ee6118815a2d6efdfc191572c19fcac1ed016 Mon Sep 17 00:00:00 2001
From: "Kyle J. McKay" <mackyle@gmail.com>
Date: Thu, 6 Mar 2014 17:30:54 -0800
Subject: [PATCH] html.cgi: support two new hash functions

Add support for @@md5(...)@@ and @@sha1(...)@@ so that hashes
of certain files can easily be shown.  This can help to verify
that was was downloaded is actually correct.
---
 cgi/html.cgi | 43 ++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 42 insertions(+), 1 deletion(-)

diff --git a/cgi/html.cgi b/cgi/html.cgi
index 2103693..0186fc8 100755
--- a/cgi/html.cgi
+++ b/cgi/html.cgi
@@ -1,15 +1,38 @@
 #!/usr/bin/perl
 # (c) Petr Baudis <pasky@suse.cz>
+# Portions Copyright (c) Kyle J. McKay <mackyle@gmail.com>
 # GPLv2
 
 use strict;
 use warnings;
 
+use Digest::MD5 qw(md5_hex);
+
 use lib ".";
 use Girocco::CGI;
 use Girocco::Config;
 use Girocco::Util;
 
+BEGIN {
+	eval {
+		require Digest::SHA;
+		Digest::SHA->import(
+			qw(sha1_hex)
+	);1} ||
+	eval {
+		require Digest::SHA1;
+		Digest::SHA1->import(
+			qw(sha1_hex)
+	);1} ||
+	eval {
+		require Digest::SHA::PurePerl;
+		Digest::SHA::PurePerl->import(
+			qw(sha1_hex)
+	);1} ||
+	die "One of Digest::SHA or Digest::SHA1 or Digest::SHA::PurePerl "
+	. "must be available\n";
+}
+
 # Ultra-trivial templating engine;
 # /^@section=SECTION
 # /^@heading=HEADING
@@ -18,11 +41,14 @@ use Girocco::Util;
 # /@@base(gitweburl)@@/		substitute for base portion of gitweburl variable
 # /@@path(gitweburl)@@/		substitute for path portion of gitweburl variable
 # /@@server(gitweburl)@@/	replace scheme://host:port portion of gitweburl variable
+# /@@md5(relpath)@@/		produces MD5 hex of file in DOCUMENT_ROOT at relpath
+# /@@sha1(relpath)@@/		produces SHA1 hex of file in DOCUMENT_ROOT at relpath
 # /@@ifmob@@...@@end@@/		remove unless mob defined
 # /@@ifssh@@...@@end@@/		remove unless pushurl defined
 # /@@ifhttps@@...@@end@@/	remove unless httpspushurl defined
 
 my $pathinfo = $ENV{PATH_INFO} || '';
+my $docroot = $ENV{DOCUMENT_ROOT} || '';
 $pathinfo =~ s,^/,,;
 unless ($pathinfo) {
 	my $gcgi = Girocco::CGI->new('HTML Templater');
@@ -42,6 +68,20 @@ if ($pathinfo =~ /\.png$/) {
 	exit;
 }
 
+sub get_file_hash {
+	my ($hash, $fn) = @_;
+	return '' unless $docroot && $docroot ne '/' && -d $docroot;
+	return '' if $hash ne 'md5' && $hash ne 'sha1';
+	return '' if !$fn || $fn =~ m|^[./]| || $fn =~ m|[.]/| || $fn =~ m|/[.]|;
+	return '' unless -f "$docroot/$fn";
+	open(HASHFILE, "$docroot/$fn") or return '';
+	local $/;
+	undef $/;
+	my $contents = <HASHFILE>;
+	close(HASHFILE);
+	return $hash eq 'md5' ? md5_hex($contents) : sha1_hex($contents);
+}
+
 my ($gcgi, $section, $heading);
 
 my $template=join('', <TEMPLATE>);
@@ -63,10 +103,11 @@ foreach (split(/\n/, $template)) {
 		print "<div class=\"htmlcgi\">";
 		next;
 	} else {
+		s/@@(\w+?)@@/${$Girocco::Config::{$1}}/ge;
 		s/@\@base\((\w+?)\)@@/url_base(${$Girocco::Config::{$1}})/ge;
 		s/@\@path\((\w+?)\)@@/url_path(${$Girocco::Config::{$1}})/ge;
 		s/@\@server\((\w+?)\)@@/url_server(${$Girocco::Config::{$1}})/ge;
-		s/@@(\w+?)@@/${$Girocco::Config::{$1}}/ge;
+		s/@\@(md5|sha1)\(([^()]+?)\)@@/get_file_hash($1,$2)/ge;
 		print "$_\n";
 	}
 }
-- 
2.11.4.GIT