ListenerAccess.pm: editor defined audio shares

editors can share broadcast records for 7 days.
This commit is contained in:
Milan
2020-12-28 14:20:37 +01:00
parent 4740d307c4
commit 36e9b4b5fd
2 changed files with 73 additions and 24 deletions

View File

@@ -14,26 +14,28 @@ use Apache2::Const -compile => qw(FORBIDDEN OK);
sub handler {
my $r = shift;
my $DAYS = 24 * 60 * 60;
my $OK = Apache2::Const::OK;
my $FORBIDDEN = Apache2::Const::FORBIDDEN;
my $path = $ENV{LISTENER_DIR} . File::Basename::basename( $r->uri() );
my $file = readlink $path;
unless ($file) {
print STDERR "cannot read link for $path\n";
return Apache2::Const::FORBIDDEN;
# granted access by temporary symlinks only
return $FORBIDDEN unless ($file);
# use link age for authorized downloads
if (File::Basename::basename($path) =~ /^shared\-/) {
my $age = time() - (lstat($path))[9];
return ( $age > 7 * $DAYS ) ? $FORBIDDEN : $OK;
}
$file = File::Basename::basename($file);
unless ( $file =~ /(\d\d\d\d)\-(\d\d)\-(\d\d) (\d\d)_(\d\d)/ ) {
printf STDERR "access: cannot find datetime pattern in file:'%s'\n", $file;
return Apache2::Const::FORBIDDEN;
}
my $start_since = time() - Time::Local::timelocal( 0, $5, $4, $3, $2 - 1, $1 );
$start_since /= 24 * 60 * 60;
if ( $start_since > 7 ) {
printf STDERR "access: file is not availabe anymore:'%s'\n", $file;
return Apache2::Const::FORBIDDEN;
}
return Apache2::Const::OK;
# use age from file name for public access
return $FORBIDDEN unless
File::Basename::basename($file) =~ /(\d\d\d\d)\-(\d\d)\-(\d\d) (\d\d)_(\d\d)/;
my $age = time() - Time::Local::timelocal( 0, $5, $4, $3, $2 - 1, $1 );
return ( $age > 7 * $DAYS ) ? $FORBIDDEN : $OK;
}
1;
@@ -41,10 +43,12 @@ __END__
# limit access up to 7 days after datetime given by filename.
# The filename links to a file starting with "yyyy-mm-dd hh_mm" in file name.
#
# Access to links starting with "shared-" are allowed up to 7 days after creation.
#
# <Directory ${archive_dir}/${domain}>
# PerlSetEnv PERL5LIB ${perl_lib}/calcms
# PerlSetEnv LISTENER_DIR ${archive_dir}/${domain}/
# PerlAccessHandler ListenerAccess
# </Directory>
#
#