package Apache::OneTimeURL;
use 5.006;
use strict;
use warnings;
use MLDBM qw(DB_File);
use Digest::MD5 qw(md5_hex);
use Mail::Send;
use Apache;
use Apache::Constants;
our $VERSION = "1.2";
sub handler {
my ($class,$r) = @_;
# This allows us to use inheritance in situations where we're called
# as "Apache::OneTimeURL->handler" but not otherwise.
if (!$r and $class) { $r = $class; $class = __PACKAGE__ }
$r->path_info() =~ /([a-f0-9]{32})/ or return DECLINED;
my $key = $1;
my %o;
my $db = $r->dir_config("OneTimeDb")
or die "Database not specified in OneTimeDb!";
tie %o, "MLDBM", $db
or die "Couldn't open database $db: $!";
return DECLINED if !exists $o{$key};
my $stuff = $o{$key};
if ($stuff->{count}++) {
$o{$key} = $stuff;
untie %o;
return $class->intruder($r, $stuff);
}
$o{$key} = $stuff;
untie %o;
return $class->deliver($r);
}
sub deliver {
my ($class, $r) = @_;
die "No OneTimeDoc specified!" unless my $file = $r->dir_config("OneTimeDoc");
my $subr = $r->lookup_file($file);
return $subr->run;
}
sub authorize {
my ($class, $db, $comments) = @_;
my $key = md5_hex(time().{}.rand().$$);
my %o;
tie %o, "MLDBM", $db or die "Couldn't open database: $!";
$o{$key} = {
comments => $comments,
count => 0,
created => time
};
untie %o;
return $key;
}
sub intruder {
my ($class, $r, $hash) = @_;
my $sendcount = $r->dir_config("OneTimeMailCount") || 5;
if ($hash->{count} < $sendcount) {
$class->send_mail($r, $hash);
}
$r->send_http_header("text/html");
print "Unauthorized access
You are not authorized to access this resource. This attempt has been
recorded.
";
return OK; # Can't return forbidden, since that calls other handlers.
}
sub send_mail {
my ($class, $r, $hash) = @_;
my $email = $r->dir_config("OneTimeEmail") || $r->server_admin();
my $referrer = $r->header_in( 'Referer' );
my $msg = new Mail::Send To => $email,
Subject => 'One-time URL reused';
my $fh = $msg->open;
print $fh <{created} ]}
with comments @{[ $hash->{comments} ]}
Reused at @{[ scalar localtime ]}
by @{[ $r->get_remote_host ]} ( @{[ $r->get_remote_logname ]} )
EOF
if ($referrer) { print $fh "Accessed via $referrer\n\n" }
$fh->close;
}
1;
__END__
# Below is stub documentation for your module. You better edit it!
=head1 NAME
Apache::OneTimeURL - One-time use URLs for sensitive data
=head1 SYNOPSIS
PerlModule Apache::OneTimeURL
PerlHandle Apache:OneTimeURL
SetHandler perl-script
PerlSetVar OneTimeDb /opt/secret/access.db
PerlSetVar OneTimeDoc /opt/secret/realfile.html
PerlSetVar OneTimeEmail intruder@simon-cozens.org
F:
#!/usr/bin/perl
use Apache::OneTimeURL;
my $comments = join " ", @ARGV;
my $db = "/opt/secret/access.db";
print "http://www.my.server.int/secret/",
Apache::OneTimeURL->authorize($db, $comments),
"\n";
Now:
% authorize.pl Given to Simon C on IRC
http://www.my.server.int/secret/2c61de78edd612cf79c0d73a3c7c94fb
This URL will only be viewable once, and will then return an error. For
the first five times that the URL is accessed in error, a mail will be sent
to the email address given in the config. The number of times can be
configured with the C variable; if you don't want any
mail, set this to minus one.
=head1 DESCRIPTION
The synopsis pretty much wraps it up. I'm paranoid about giving out
certain information, and although I can't really control what people do
with the HTML when they download it, I can damned well ensure that URLs
in mail I send don't end up on the web and being a liability. Hence the
desire for a URL that's only valid once. You may have your own
interesting uses for such a set-up.
I've hopefully designed the module so that if there's some aspect of its
behaviour you don't like, you can switch to the "method handler" style
(ie. Chandler> and subclass to
override the bits you're unhappy about. This may be easier than convincing
me to make changes to the module.
=head1 THANKS
Peter Sergeant offered several useful ideas which contributed to the 1.1
and 1.2. releases of this module.
=head1 AUTHOR
Simon Cozens, C
Copyright Simon Cozens, and released under the same terms as Perl itself.
=cut