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