1package Net::DAV::LockManager; 2 3use strict; 4use warnings; 5 6use File::Spec (); 7use Net::DAV::UUID; 8use Net::DAV::Lock; 9 10our $VERSION = '1.305'; 11$VERSION = eval $VERSION; 12 13sub new { 14 my ($class, $db) = (shift, shift); 15 my %obj = @_; 16 17 $obj{'db'} = $db; 18 19 return bless \%obj, $class; 20} 21 22sub can_modify { 23 my ($self, $req) = @_; 24 25 _validate_lock_request( $req, 'user' ); 26 27 my ($resource, $token) = @{$req}{qw/path token/}; 28 my $lock = $self->_get_lock( $resource ) || $self->_get_indirect_lock( $resource ); 29 30 return 1 unless $lock; 31 return 0 unless $token; 32 33 return _is_permitted( $req, $lock ); 34} 35 36sub lock { 37 my ($self, $req) = @_; 38 39 _validate_lock_request( $req, 'user', 'owner' ); 40 41 my $path = $req->{'path'}; 42 43 return undef unless $self->can_modify( $req ) && !$self->_get_lock( $path ); 44 foreach my $lock ( $self->{'db'}->list_descendants( $path ) ) { 45 return undef unless _is_permitted( $req, $lock ); 46 } 47 48 return $self->_add_lock(Net::DAV::Lock->new({ 49 'path' => $path, 50 (defined $req->{'timeout'} ? ('expiry' => time() + $req->{'timeout'}) : ()), 51 'creator' => $req->{'user'}, 52 'owner' => $req->{'owner'}, 53 (defined $req->{'depth'} ? ('depth' => $req->{'depth'}) : ()), 54 (defined $req->{'scope'} ? ('scope' => $req->{'scope'}) : ()), 55 })); 56} 57 58sub refresh_lock { 59 my ($self, $req) = @_; 60 _validate_lock_request( $req, 'user', 'token' ); 61 62 my $lock = $self->_get_lock( $req->{'path'} ); 63 return undef unless $lock; 64 return undef unless _is_permitted( $req, $lock ); 65 66 $lock->renew( time() + ($req->{'timeout'} || $Net::DAV::Lock::DEFAULT_LOCK_TIMEOUT) ); 67 68 return $self->_update_lock( $lock ); 69} 70 71sub unlock { 72 my ($self, $req) = @_; 73 _validate_lock_request( $req, 'user', 'token' ); 74 75 my $lock = $self->_get_lock( $req->{'path'} ); 76 return 0 unless $lock; 77 return 0 unless _is_permitted( $req, $lock ); 78 79 $self->_remove_lock( $lock ); 80 81 return 1; 82} 83 84sub find_lock { 85 my ($self, $req) = @_; 86 87 _validate_lock_request( $req ); 88 89 my $path = $req->{'path'}; 90 91 return $self->_get_lock( $path ) || $self->_get_indirect_lock( $path ); 92} 93 94sub list_all_locks { 95 my ($self, $req) = @_; 96 97 _validate_lock_request( $req ); 98 99 my $path = $req->{'path'}; 100 my @locks; 101 my $lock = $self->_get_lock( $path ); 102 push @locks, $lock if defined $lock; 103 104 while ( $path =~ s{/[^/]+$}{} ) { 105 $path = '/' unless length $path; 106 107 my $lock = $self->_get_lock( $path ); 108 push @locks, $lock if $lock && $lock->depth eq 'infinity'; 109 } 110 111 return @locks; 112} 113 114# 115# Retrieve a lock from the lock database, given the path to the lock. 116# Return undef if none. This method also has the side effect of expiring 117# any old locks persisted upon fetching. 118# 119sub _get_lock { 120 my ($self, $path) = @_; 121 122 my $lock = $self->{'db'}->get( $path ); 123 124 return undef unless $lock; 125 126 if (time() >= $lock->expiry) { 127 $self->_remove_lock($lock); 128 129 return undef; 130 } 131 132 return $lock; 133} 134 135# 136# Add the given lock to the database. 137# 138sub _add_lock { 139 my ($self, $lock) = @_; 140 141 return $self->{'db'}->add($lock); 142} 143 144# 145# Update the lock provided. 146# 147sub _update_lock { 148 my ($self, $lock) = @_; 149 150 return $self->{'db'}->update($lock); 151} 152 153# 154# Remove the lock object passed from the database. 155# 156sub _remove_lock { 157 my ($self, $lock) = @_; 158 159 $self->{'db'}->remove($lock); 160 161 return 1; 162} 163 164# 165# Get the lock of the nearest ancestor that applies to this resource. 166# Returns undef if none found. 167# 168sub _get_indirect_lock { 169 my ($self, $res) = @_; 170 171 while ( $res =~ s{/[^/]+$}{} ) { 172 $res = '/' unless length $res; 173 174 my $lock = $self->_get_lock( $res ); 175 return $lock if $lock && $lock->depth eq 'infinity'; 176 } 177 178 return; 179} 180 181# 182# Return true or false depending on whether or not the information reflected 183# in the request is appropriate for the lock obtained from the database. In 184# other words, make sure the token and user match the request. 185# 186sub _is_permitted { 187 my ($req, $lock) = @_; 188 189 return 0 unless $req->{'user'} eq $lock->creator; 190 return 0 if !defined $req->{'token'}; 191 if ( 'ARRAY' eq ref $req->{'token'} ) { 192 return 0 unless grep { $_ eq $lock->token } @{$req->{'token'}}; 193 } 194 else { 195 return 0 unless $req->{'token'} eq $lock->token; 196 } 197 198 return 1; 199} 200 201# 202# Perform general parameter validation. 203# 204# The parameter passed in should be a hash reference to be validated. The 205# optional list that follows are names of required parameters besides the 206# 'path' and 'user' parameters that are always required. 207# 208# Throws exception on failure. 209# 210sub _validate_lock_request { 211 my ($req, @required) = @_; 212 die "Parameter should be a hash reference.\n" unless 'HASH' eq ref $req; 213 214 foreach my $arg ( qw/path/, @required ) { 215 die "Missing required '$arg' parameter.\n" unless exists $req->{$arg}; 216 } 217 218 die "Not a clean path\n" if $req->{'path'} =~ m{(?:^|/)\.\.?(?:$|/)}; 219 die "Not a clean path\n" if $req->{'path'} !~ m{^/} && !($req->{'path'} =~ s{^https?://[^/]+/}{/}); 220 if( defined $req->{'user'} && $req->{'user'} !~ m{^[0-9a-z_.][-a-z0-9_.]*$}i ) { 221 die "Not a valid user name.\n"; # May need better validation. 222 } 223 224 # Validate optional parameters as necessary. 225 if( defined $req->{'scope'} && $Net::DAV::Lock::DEFAULT_SCOPE ne $req->{'scope'} ) { 226 die "'$req->{'scope'}' is not a supported value for scope.\n"; 227 } 228 229 if( defined $req->{'depth'} && '0' ne $req->{'depth'} && 'infinity' ne $req->{'depth'} ) { 230 die "'$req->{'depth'}' is not a supported value for depth.\n"; 231 } 232 233 if( defined $req->{'timeout'} && $req->{'timeout'} =~ /\D/ ) { 234 die "'$req->{'timeout'}' is not a supported value for timeout.\n"; 235 } 236 237 if ( defined $req->{'token'} ) { 238 unless ( !ref $req->{'token'} || 'ARRAY' eq ref $req->{'token'} ) { 239 die "Invalid token, not a string or array reference.\n"; 240 } 241 } 242 243 # Remove trailing / from path to make pathnames canonical. 244 $req->{'path'} =~ s{/$}{} unless $req->{'path'} eq '/'; 245 246 return; 247} 248 2491; 250 251__END__ 252Copyright (c) 2011, cPanel, Inc. All rights reserved. 253This module is free software; you can redistribute it and/or 254modify it under the same terms as Perl itself. See L<perlartistic>. 255 256