#!/usr/bin/perl
# $Id: guestbook.cgi,v 1.5 2005-10-10 15:12:47 dave Exp $
# Dave Holland <dave@biff.org.uk>
# released under the GPL
# vi:sw=4:ts=4:ai:cindent

use Net::OpenID::Consumer;
use CGI qw(:standard);
use CGI::Pretty;
use CGI::Cookie;
use Digest::SHA1 qw(sha1 sha1_hex);
use HTML::Entities;
use DB_File;

$guestbookfile="/home/dave/openid/guestbook.txt";
$iddb="/home/dave/openid/iddb";

$|=1;
$cgi = CGI->new();
$con = Net::OpenID::Consumer->new(
		ua => LWP::UserAgent->new, # FIXME - use LWPx::ParanoidAgent
		cache => undef, # or File::Cache->new,
		args => $cgi,
		consumer_secret => \&mysecret,
		required_root => "http://www.biff.org.uk/" );

# FIXME - http/s
$this_script = "http://".$ENV{'HTTP_HOST'}.$ENV{'SCRIPT_NAME'};

if($cgi->cookie('biff-openid')) {
	#print header, "found cookie: ", $cgi->cookie('biff-openid');
	if(param()) {
		if(param('logout')) {
			&delid($cgi->cookie('biff-openid'));
			print redirect(
					-url=> $this_script,
					-cookie => new CGI::Cookie(-name => 'biff-openid',
						-value => "", -expires => '-1d'),
					);
			exit(0);
		} elsif(param('entry')) {
			&addentry;
		}
	}
	print header, start_html(-title=>"OpenID guestbook",
			-onLoad=>"document.fred.id.focus();"),
		  h1("OpenID guestbook");
	&gform;
	&listbook;
	exit(0);
}

# no cookie? try to auth with openid

if(param()) {
	if(param('ret')) {
		if($setup_url = $con->user_setup_url) {
			&log("need to redirect to",$setup_url);
			print $cgi->redirect($setup_url);
		} elsif ($con->user_cancel) {
			&log("user cancel");
			print redirect(-url=>$this_script);
		} elsif ($vident = $con->verified_identity) {
			$verified_url = $vident->url;
			&log("verified as $verified_url");
			$r=&saveid($verified_url);
			print redirect(
					-url => $this_script,
					-cookie => new CGI::Cookie(-name => 'biff-openid',
						-value => $r),
					);
		} else {
			&log("error validating identity:", $con->err);
			print header, "error validating identity: ", $con->err, p;
			&print_params;
		}
		exit(0);
	} elsif(param('id')) {
		#print "presented id: ",param('id'),"<p>\n";
		$claimed = $con->claimed_identity(param('id'));
		if(!defined($claimed)) {
			&log("claim for",param('id'),"failed:", $con->err);
			print header, "claim for ",param('id')," failed: ", $con->err, p;
			&print_params;
			exit(0);
		}
		#print "claimed id: ",$claimed->claimed_url,"<p>\n";
		$check_url = $claimed->check_url(
				return_to  => $this_script."?ret=true",
				trust_root => "http://www.biff.org.uk/");
		&log("redirecting to", $check_url);
		print $cgi->redirect($check_url);
		exit(0);
	} else {
		&log("param but no ret or id");
		print header, "hmm, param but no ret or id";
		exit(0);
	}
} else {
	print header, start_html(-title=>"OpenID guestbook",
			-onLoad=>"document.fred.id.focus();"),
		  h1("OpenID guestbook"),
		  start_form(-name=>"fred"),
	      "enter OpenID: ", textfield(-name=>'id', -size=>35,
				  -style=>'background: url(http://stat.livejournal.com/img/openid-inputicon.gif) no-repeat; background-color: #fff; background-position: 0 50%; padding-left: 18px;'), # FIXME use a local copy of this image
		  " ",
	      submit(-name=>"verify"), p,
		  "e.g. www.biff.org.uk/dave or username.livejournal.com",
		  end_form;
	&listbook;
	exit(0);
}

exit(0);

sub mysecret {
	my $t=shift;
	if(! $t) { $t=time(); &log("secret called with no param: using",$t); }
	$t -= $t % 3600; # one hour granularity
	#return($t);
	$s=sha1_hex("foo".($t - $t % 3600));
	# FIXME change "foo" if  you copy this script
	&log("secret:",$t,$s);
	return("$s");
}

sub log {
	open(L,">>/home/dave/openid/openid.log") or return;
	print L scalar(localtime)." ".$ENV{'REMOTE_ADDR'}." ".$$.
		" ".join(" ",@_)."\n";
	close(L);
}

sub print_params {
	@names=param;
	foreach $n (@names) {
		print $n, " = ", param($n), br;
	}
}

# print guestbook entry form
sub gform {
	my $id=&lookupid($cgi->cookie('biff-openid'));
	if($id eq "") {
		print "You need to ", a({href=>$this_script},"log in"),
			  "before you can leave a comment.";
		return;
	}
	print start_form(-name=>"fred"),
		  "Hello ", a({href=>$id},$id),
		  ", enter your comment here:", p,
		  textarea(-name=>"entry", -default=>"", -override=>1, 
				  -rows=>3, -columns=>50),
		  p,
		  submit(-name=>"add entry"), " ",
		  submit(-name=>"logout"),
		  end_form,
		  p;
}

# dump guestbook contents
sub listbook {
	print hr, p;
	if(! -s $guestbookfile) {
		print i("guestbook is empty - add an entry!");
		return;
	}
	open(B,$guestbookfile) or return;
	while(<B>) {
		($id,$time,$rest) = split(' ',$_,3);
		print scalar(localtime($time)), " ", a({href=>$id},$id),
			  " : ", encode_entities($rest), br;
	}
	close(B);
}

# add an entry
sub addentry {
	return if (param('entry') =~ m/^\s*$/);
	open(B,">>".$guestbookfile) or return;
	my $e=param('entry');
	$e=~s/\s/ /g; # no sneaky embedded newlines
	print B &lookupid($cgi->cookie('biff-openid')), " ",
		  time, " ", $e, "\n";
	close(B);
}

# given a handle, look up the url
sub lookupid {
	my $c=shift;
	return "" if ($c eq "");
	$db=tie(%db,'DB_File',$iddb,O_CREAT|O_RDWR,0644) or die "dbcreat: $!\n";
	my $v=$db{$c};
	undef $db;
	untie %db;
	return($v);
}

# given a url, save it and return a handle
sub saveid {
	my $vurl=shift;
	$db=tie(%db,'DB_File',$iddb,O_CREAT|O_RDWR,0644) or die "dbcreat: $!\n";
	$db{$$}=$vurl;
	undef $db;
	untie %db;
	return($$);
}

# given a handle, delete it from the db
sub delid {
	my $id=shift;
	$db=tie(%db,'DB_File',$iddb,O_CREAT|O_RDWR,0644) or die "dbcreat: $!\n";
	$db{$id}="";
	undef $db;
	untie %db;
	return($$);
}