UCW::Gallery::Web: Support for password-protected galleries

diff --git a/lib/UCW/Gallery/Web.pm b/lib/UCW/Gallery/Web.pm
index ba116a092d6a392118d9a7b8a5f164553bd2a607..adc1ae3d2933a65b28aff792fe690c87ed8312c5 100644 (file)
--- a/lib/UCW/Gallery/Web.pm
+++ b/lib/UCW/Gallery/Web.pm
@@ -1,5 +1,5 @@
 # Simple Photo Gallery: Web Interface
 # Simple Photo Gallery: Web Interface

-# (c) 2003--2012 Martin Mares <mj@ucw.cz>
+# (c) 2003--2021 Martin Mares <mj@ucw.cz>

 
 package UCW::Gallery::Web;
 
 
 package UCW::Gallery::Web;
 


@@ -7,14 +7,17 @@ use common::sense;
 
 use UCW::Gallery;
 use UCW::CGI;
 
 use UCW::Gallery;
 use UCW::CGI;

+use Digest::SHA;

 use File::Spec;
 
 my $show_img;
 my $want_archive;
 use File::Spec;
 
 my $show_img;
 my $want_archive;

+my $auth_password;

 
 my %args = (
        'i'     => { 'var' => \$show_img, 'check' => '\d+' },
        'a'     => { 'var' => \$want_archive },
 
 my %args = (
        'i'     => { 'var' => \$show_img, 'check' => '\d+' },
        'a'     => { 'var' => \$want_archive },

+       'pw'    => { 'var' => \$auth_password },

 );
 
 sub error($) {
 );
 
 sub error($) {


@@ -114,7 +117,7 @@ sub show_post_thumbs($) {
        my ($self) = @_;
 }
 
        my ($self) = @_;
 }
 

-sub show_list($) {
+sub show_common_header($) {

        my ($self) = @_;
        $self->html_top;
 
        my ($self) = @_;
        $self->html_top;
 


@@ -122,6 +125,11 @@ sub show_list($) {
        print "<h1>", $self->get('Title'), "</h1>\n";
        my $subtitle = $self->get('SubTitle');
        print "<h2>$subtitle</h2>\n" if $subtitle ne "";
        print "<h1>", $self->get('Title'), "</h1>\n";
        my $subtitle = $self->get('SubTitle');
        print "<h2>$subtitle</h2>\n" if $subtitle ne "";

+}
+
+sub show_list($) {
+       my ($self) = @_;
+       $self->show_common_header;

        $self->show_pre_thumbs;
 
        my $meta = $self->{meta};
        $self->show_pre_thumbs;
 
        my $meta = $self->{meta};


@@ -141,10 +149,114 @@ sub show_list($) {
        $self->html_bot();
 }
 
        $self->html_bot();
 }
 

+sub show_login_page($$) {
+       my ($self, $login_failed) = @_;
+
+       $self->show_common_header;
+
+       print "<div class='gal-login'>\n";
+       print $self->extras('WebLoginExtras');
+
+       my $wrong = $login_failed ? " class='gal-login-bad'" : "";
+       print "\t<form method=POST action='.'>\n";
+       print "\t\t<input type=password name=pw$wrong>\n";
+       print "\t\t<input type=submit value='Login'>\n";
+       print "\t</form>\n";
+
+       print "</div>\n";
+       $self->html_bot;
+}
+
+sub auth_check($) {
+       my ($self) = @_;
+
+       my $needed = $self->auth_get_needed;
+       @$needed or return 1;
+
+       if (length $auth_password) {
+               my $passwords = $self->get('AuthPasswords');
+               my $match = 0;
+               for my $zone (@$needed) {
+                       if (defined $passwords->{$zone} && $passwords->{$zone} eq $auth_password) {
+                               my @opts = ();
+                               my $path = $self->try_get('AuthCookiePath');
+                               push @opts, 'path', $path if defined $path;
+                               push @opts, 'secure', undef if $self->get('AuthCookieSecure');
+                               UCW::CGI::set_cookie($self->get('AuthCookiePrefix') . $zone, $self->auth_zone_hash($zone), @opts);
+                               $match++;
+                       }
+               }
+
+               if ($match) {
+                       my $abs = $self->try_get('WebAbsURL');
+                       if (defined $abs) {
+                               print "Status: 303\n";
+                               print "Location: $abs\n\n";
+                               exit 0;
+                       }
+                       return 1;
+               }
+
+               $self->show_login_page($match == 0);
+               return;
+       }
+
+       my $known_tokens = $self->auth_parse_cookies;
+       for my $zone (@$needed) {
+               return 1 if $known_tokens->{$zone};
+       }
+
+       $self->show_login_page(0);
+       return;
+}
+
+sub auth_get_needed($) {
+       my ($self) = @_;
+
+       my $auth = $self->get('AuthNeeded');
+       defined $auth or return [];
+       if (ref $auth) {
+               return $auth;
+       } else {
+               $auth ne "" or return [];
+               return [$auth];
+       }
+}
+
+sub auth_parse_cookies($) {
+       my ($self) = @_;
+       my $known_tokens = {};
+
+       my %cookies = UCW::CGI::parse_cookies;
+       my $px = $self->get('AuthCookiePrefix');
+       for my $k (keys %cookies) {
+               if (substr($k, 0, length $px) eq $px) {
+                       my $zone = substr($k, length $px);
+                       my $v = $cookies{$k};
+                       if ($v eq $self->auth_zone_hash($zone)) {
+                               $known_tokens->{$zone} = 1;
+                       } else {
+                               print STDERR "Gallery: Invalid auth cookie for zone $zone\n";
+                       }
+               }
+       }
+
+       return $known_tokens;
+}
+
+sub auth_zone_hash($) {
+       my ($self, $zone) = @_;
+       my $secret = $self->get('AuthSecret');
+       return substr(Digest::SHA::hmac_sha256_hex($zone, $secret), 0, 16);
+}
+

 sub dispatch($) {
        my ($self) = @_;
        binmode STDOUT, ':utf8';
        UCW::CGI::parse_args(\%args);
 sub dispatch($) {
        my ($self) = @_;
        binmode STDOUT, ':utf8';
        UCW::CGI::parse_args(\%args);

+
+       $self->auth_check or return;
+

        $self->{meta} = $self->{gal}->read_meta(File::Spec->catfile($self->get('CacheDir'), 'cache.meta'));
        $self->{num_photos} = scalar @{$self->{meta}->{sequence}};
 
        $self->{meta} = $self->{gal}->read_meta(File::Spec->catfile($self->get('CacheDir'), 'cache.meta'));
        $self->{num_photos} = scalar @{$self->{meta}->{sequence}};
 


@@ -168,6 +280,7 @@ sub attach($$) {
                WebHeadExtras => "",
                WebTopExtras => "",
                WebBotExtras => "",
                WebHeadExtras => "",
                WebTopExtras => "",
                WebBotExtras => "",

+               WebLoginExtras => "",

 
                # Used by the theming logic
                WebThemeCSS => undef,
 
                # Used by the theming logic
                WebThemeCSS => undef,


@@ -177,6 +290,24 @@ sub attach($$) {
 
                # If enabled, calling the CGI with a=zip produces a ZIP archive with all photos.
                WebAllowArchives => 1,
 
                # If enabled, calling the CGI with a=zip produces a ZIP archive with all photos.
                WebAllowArchives => 1,

+
+               # Optional absolute URL of the current gallery. This is useful for redirects after login.
+               # If it is not set, form POST does not redirect to GET.
+               WebAbsURL => undef,
+
+               # Authentication: Known zones and their passwords.
+               # AuthPasswords => { 'zone' => 'passwd' },
+
+               # Authentication: Which zones have access to the current gallery.
+               AuthNeeded => [],
+
+               # Authentication: Secret used for encryption of cookies.
+               # AuthSecret => "",
+
+               # Authentication: Properties of cookies.
+               AuthCookiePrefix => 'gal_',
+               AuthCookiePath => undef,
+               AuthCookieSecure => 1,

        );
        bless $self, $class;
        return $self;
        );
        bless $self, $class;
        return $self;