1# -*- indent-tabs-mode: nil; -*-
2# vim:ft=perl:et:sw=4
3# $Id$
4
5# Sympa - SYsteme de Multi-Postage Automatique
6#
7# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
8# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
9# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
10# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
11# Copyright 2017, 2018 The Sympa Community. See the AUTHORS.md file at the
12# top-level directory of this distribution and at
13# <https://github.com/sympa-community/sympa.git>.
14#
15# This program is free software; you can redistribute it and/or modify
16# it under the terms of the GNU General Public License as published by
17# the Free Software Foundation; either version 2 of the License, or
18# (at your option) any later version.
19#
20# This program is distributed in the hope that it will be useful,
21# but WITHOUT ANY WARRANTY; without even the implied warranty of
22# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23# GNU General Public License for more details.
24#
25# You should have received a copy of the GNU General Public License
26# along with this program.  If not, see <http://www.gnu.org/licenses/>.
27
28package Sympa::WWW::SharedDocument;
29
30use strict;
31use warnings;
32use English qw(-no_match_vars);
33use File::Find qw();
34use POSIX qw();
35
36use Sympa;
37use Conf;
38use Sympa::Language;
39use Sympa::Scenario;
40use Sympa::Tools::Data;
41use Sympa::Tools::File;
42use Sympa::Tools::Text;
43
44# Creates a new object.
45sub new {
46    my $class   = shift;
47    my $list    = shift;
48    my $path    = shift;
49    my %options = @_;
50
51    die 'bug in logic. Ask developer' unless ref $list eq 'Sympa::List';
52
53    my $paths;
54    if (ref $path eq 'ARRAY') {
55        $paths = $path;
56    } elsif (defined $path and length $path) {
57        $paths = [split m{/+}, $path];
58    } else {
59        $paths = [];
60    }
61
62    unless (@$paths) {
63        return $class->_new_root($list);
64    } else {
65        my $parent_paths = [@$paths];
66        my $name         = pop @$parent_paths;
67        return undef
68            unless defined $name
69            and length $name
70            and $name !~ /\A[.]+\z/
71            and $name !~ /\A[.]desc(?:[.]|\z)/;
72
73        my $parent = $class->new($list, $parent_paths);
74        return undef unless $parent;
75
76        #FIXME: At present, conversion by qencode_filename() /
77        # qdecode_filename() may not be bijective.  So we take the first one
78        # of (possibly multiple) matching paths insted of taking encoded one.
79        my ($self) = $parent->get_children(%options, name => $name);
80        return $self;
81    }
82}
83
84sub _new_root {
85    my $class = shift;
86    my $list  = shift;
87
88    my $status;
89    if (-e $list->{'dir'} . '/shared') {
90        $status = 'exist';
91    } elsif (-e $list->{'dir'} . '/pending.shared') {
92        $status = 'deleted';
93    } else {
94        $status = 'none';
95    }
96
97    bless {
98        context => $list,
99        fs_name => '',
100        fs_path => $list->{'dir'} . '/shared',
101        name    => '',
102        paths   => [],
103        status  => $status,
104        type    => 'root',
105    } => $class;
106}
107
108sub _new_child {
109    my $self    = shift;
110    my $fs_name = shift;
111    my %options = @_;
112
113    # Document isn't a description file.
114    # It exists.
115    # It has non-zero size.
116    return undef
117        if $fs_name =~ /\A[.]+\z/
118        or $fs_name =~ /\A[.]desc(?:[.]|\z)/;
119    return undef unless -e $self->{fs_path} . '/' . $fs_name;
120    unless (exists $options{allow_empty} and $options{allow_empty}) {
121        return undef unless -s $self->{fs_path} . '/' . $fs_name;
122    }
123
124    my $child = bless {
125        context => $self->{context},
126        parent  => $self
127    } => (ref $self);
128
129    my $stem;
130    if ($fs_name =~ /\A[.](.*)[.]moderate\z/) {
131        $stem = $1;
132        $child->{moderate} = 1;
133    } else {
134        $stem = $fs_name;
135    }
136    $child->{fs_name} = $fs_name;
137    $child->{fs_path} = $self->{fs_path} . '/' . $fs_name;
138    $child->{name}    = Sympa::Tools::Text::qdecode_filename($stem);
139    $child->{paths}   = [@{$self->{paths}}, $child->{name}];
140
141    $child->{file_extension} = $1 if $stem =~ /[.](\w+)\z/;
142    $child->{type} =
143          (-d $child->{fs_path}) ? 'directory'
144        : ($child->{file_extension} and $child->{file_extension} eq 'url')
145        ? 'url'
146        : 'file';
147
148    if (exists $options{name}) {
149        return undef if $child->{name} ne $options{name};
150    }
151    if (exists $options{moderate}) {
152        return undef if $child->{moderate} xor $options{moderate};
153    }
154
155    ## Check access control
156    #check_access_control($child, $param);
157
158    # Date.
159    $child->{date_epoch} = Sympa::Tools::File::get_mtime($child->{fs_path});
160    # Size of the doc.
161    $child->{size} = (-s $child->{fs_path}) / 1000;
162
163    # Load .desc file unless root directory.
164    my %desc = $child->_load_desc;
165    if (%desc) {
166        $child->{serial_desc} = $desc{serial_desc};
167        $child->{owner}       = $desc{email};
168        $child->{title}       = $desc{title};
169        $child->{scenario}    = {read => $desc{read}, edit => $desc{edit}};
170    }
171
172    if (exists $options{owner}) {
173        return undef unless defined $child->{owner};
174        return undef if $child->{owner} ne $options{owner};
175    }
176
177    # File, directory or URL ?
178    my $robot_id = $self->{context}->{'domain'};
179    if ($child->{type} eq 'url') {
180        $child->{icon} = _get_icon($robot_id, 'url');
181
182        if (open my $fh, $child->{fs_path}) {
183            my $url = <$fh>;
184            close $fh;
185            chomp $url;
186            $child->{url} = $url;
187        }
188
189        if ($child->{name} =~ /\A(.+)[.]url\z/) {
190            $child->{label} = $1;
191        }
192    } elsif ($child->{type} eq 'file') {
193        if ($child->{file_extension}
194            and grep { lc $child->{file_extension} eq $_ } qw(htm html)) {
195            # HTML.
196            $child->{mime_type} = 'text/html';
197
198            $child->{html} = 1;
199            $child->{icon} = _get_icon($robot_id, 'text');
200        } elsif (my $type =
201            Conf::get_mime_type($child->{file_extension} || '')) {
202            $child->{mime_type} = lc $type;
203
204            # Type of the icon.
205            my $mimet;
206            if (lc $type eq 'application/octet-stream') {
207                $mimet = 'octet-stream';
208            } else {
209                ($mimet) = split m{/}, $type;
210            }
211            $child->{icon} = _get_icon($robot_id, $mimet)
212                || _get_icon($robot_id, 'unknown');
213        } else {
214            # Unknown file type.
215            $child->{icon} = _get_icon($robot_id, 'unknown');
216        }
217    } else {
218        # Directory.
219        $child->{icon} = _get_icon($robot_id, 'folder');
220    }
221
222    $child;
223}
224
225sub _load_desc {
226    my $self = shift;
227
228    my $desc_file = $self->_desc_file;
229    return unless $desc_file and -e $desc_file;
230
231    my %desc = _load_desc_file($desc_file);
232    $desc{serial_desc} = Sympa::Tools::File::get_mtime($desc_file);
233
234    return %desc;
235}
236
237# Gets path of property description on physical filesystem.
238sub _desc_file {
239    my $self = shift;
240
241    return (-d $self->{fs_path})
242        ? ($self->{fs_path} . '/.desc')
243        : ($self->{parent}->{fs_path} . '/.desc.' . $self->{fs_name});
244}
245
246# Old name: Sympa::Tools::WWW::get_desc_file().
247#FIXME: Generalize parsing.
248#FIXME: Lock file.
249sub _load_desc_file {
250    my $file = shift;
251
252    my $line;
253    my %hash;
254
255    open my $fh, '<', $file or return;    #FIXME: Check errors.
256
257    while ($line = <$fh>) {
258        if ($line =~ /^title\s*$/) {
259            # Title of the document
260            while ($line = <$fh>) {
261                last if ($line =~ /^\s*$/);
262                $line =~ /^\s*(\S.*\S)\s*/;
263                $hash{'title'} = $hash{'title'} . $1 . " ";
264            }
265        }
266
267        if ($line =~ /^creation\s*$/) {
268            # Creation of the document.
269            while ($line = <$fh>) {
270                last if ($line =~ /^\s*$/);
271                if ($line =~ /^\s*email\s*(\S*)\s*/) {
272                    $hash{'email'} = $1;
273                }
274                if ($line =~ /^\s*date_epoch\s*(\d*)\s*/) {
275                    $hash{'date'} = $1;
276                }
277            }
278        }
279
280        if ($line =~ /^access\s*$/) {
281            # Access scenarios for the document.
282            while ($line = <$fh>) {
283                last if ($line =~ /^\s*$/);
284                if ($line =~ /^\s*read\s*(\S*)\s*/) {
285                    $hash{'read'} = $1;
286                }
287                if ($line =~ /^\s*edit\s*(\S*)\s*/) {
288                    $hash{'edit'} = $1;
289                }
290            }
291        }
292    }
293
294    close $fh;
295
296    return %hash;
297}
298
299# Hash of the icons linked with a type of file.
300# Note: Image icons are no longer used by templates. This is kept for
301# backward compatibility.
302my %icons = (
303    'unknown'        => 'unknown.png',
304    'folder'         => 'folder.png',
305    'current_folder' => 'folder.open.png',
306    'application'    => 'unknown.png',
307    'octet-stream'   => 'binary.png',
308    'audio'          => 'sound1.png',
309    'image'          => 'image2.png',
310    'text'           => 'text.png',
311    'video'          => 'movie.png',
312    'father'         => 'back.png',
313    'sort'           => 'down.png',
314    'url'            => 'link.png',
315    'left'           => 'left.png',
316    'right'          => 'right.png',
317);
318
319# Old name: Sympa::Tools::WWW::get_icon().
320# Note: Image icons are no longer used by templates. This is kept for
321# backward compatibility.
322sub _get_icon {
323    my $robot = shift || '*';
324    my $type = shift;
325
326    return undef unless defined $icons{$type};
327    return
328          Conf::get_robot_conf($robot, 'static_content_url')
329        . '/icons/'
330        . $icons{$type};
331}
332
333sub as_hashref {
334    my $self = shift;
335
336    my %hash = %$self;
337    $hash{context} = {
338        name => $self->{context}->{'name'},
339        # Compat. < 6.2.32
340        host => $self->{context}->{'domain'},
341    };
342    $hash{parent} = $self->{parent}->as_hashref if $self->{parent};
343    $hash{paths} = [@{$self->{paths}}];
344
345    # Special items.
346    # The i18n'ed date.
347    $hash{date} =
348        Sympa::Language->instance->gettext_strftime('%d %b %Y %H:%M:%S',
349        localtime $self->{date_epoch})
350        if defined $self->{date_epoch};
351    # Path components with trailing slash.
352    $hash{paths_d} = [@{$self->{paths}}];
353    push @{$hash{paths_d}}, ''
354        if grep { $self->{type} eq $_ } qw(root directory);
355
356    my @ancestors;
357    my $p = $self->{parent};
358    while ($p) {
359        unshift @ancestors,
360            {
361            name    => $p->{name},
362            paths   => $p->{paths},
363            paths_d => [@{$p->{paths}}, ''],
364            type    => $p->{type},
365            };
366        $p = $p->{parent};
367    }
368    $hash{ancestors} = [@ancestors];
369
370    return {%hash};
371}
372
373# Old name: Sympa::List::create_shared().
374sub create {
375    my $self = shift;
376
377    unless ($self->{type} eq 'root') {
378        $ERRNO = POSIX::EINVAL();
379        return undef;
380    }
381    return undef unless CORE::mkdir $self->{fs_path}, 0777;
382
383    $self->{status} = 'exist';
384    return 1;
385}
386
387sub create_child {
388    my $self     = shift;
389    my $new_name = shift;
390    my %options  = @_;
391
392    $options{type} ||= 'directory';
393
394    if (not Sympa::WWW::SharedDocument::valid_name($new_name)) {
395        $ERRNO = POSIX::EINVAL();
396        return undef;
397    }
398
399    my $new_fs_name =
400        $options{moderate}
401        ? '.' . Sympa::Tools::Text::qencode_filename($new_name) . '.moderate'
402        : Sympa::Tools::Text::qencode_filename($new_name);
403    my $new_fs_path = $self->{fs_path} . '/' . $new_fs_name;
404    my $new_desc_file =
405        ($options{type} eq 'directory')
406        ? $new_fs_path . '/.desc'
407        : $self->{fs_path} . '/.desc.' . $new_fs_name;
408
409    if ($options{type} eq 'directory') {
410        return undef unless mkdir $new_fs_path, 0777;
411    } else {
412        my $fh;
413        return undef unless open $fh, '>', $new_fs_path;
414        if (exists $options{content} and defined $options{content}) {
415            print $fh $options{content};
416        }
417        close $fh;
418    }
419
420    # Creation of a default description file
421    my $fh;
422    return undef unless open $fh, '>', $new_desc_file;
423    print $fh "title\n";
424    print $fh " \n";
425    print $fh "\n";
426    print $fh "creation\n";
427    print $fh "  date_epoch " . time . "\n";
428    print $fh "  email $options{owner}\n";
429    print $fh "\n";
430    print $fh "access\n";
431    print $fh "  read $options{scenario}->{read}\n";
432    print $fh "  edit $options{scenario}->{edit}\n";
433    print $fh "\n";
434    close $fh;
435
436    return $self->_new_child($new_fs_name, allow_empty => 1);
437}
438
439sub delete {
440    my $self = shift;
441
442    unless ($self->{type} eq 'root') {
443        $ERRNO = POSIX::EINVAL();
444        return undef;
445    }
446
447    my $list = $self->{context};
448    return undef
449        unless CORE::rename $self->{fs_path},
450        $list->{'dir'} . '/pending.shared';
451
452    $self->{status} = 'deleted';
453    return 1;
454}
455
456sub count_children {
457    my $self = shift;
458
459    my $dh;
460    return undef unless opendir $dh, $self->{fs_path};
461    my @children =
462        grep { !/\A[.]+\z/ and !/\A[.]desc(?:[.]|\z)/ } sort readdir $dh;
463    closedir $dh;
464
465    return scalar @children;
466}
467
468sub get_children {
469    my $self    = shift;
470    my %options = @_;
471
472    my $dh;
473    return unless opendir $dh, $self->{fs_path};    #FIXME: Report error.
474
475    my @children =
476        sort { _by_order($options{order_by}) }
477        grep {$_}
478        map { $self->_new_child($_, %options) }
479        grep { !/\A[.]+\z/ and !/\A[.]desc(?:[.]|\z)/ } sort readdir $dh;
480
481    closedir $dh;
482
483    return @children;
484}
485
486# Function which sorts a hash of documents
487# Sort by various parameters
488# Old name: by_order() in wwsympa.fcgi.
489sub _by_order {
490    my $order = shift || 'order_by_doc';
491
492    if ($order eq 'order_by_doc') {
493        $a->{name} cmp $b->{name} || $b->{date_epoch} <=> $a->{date_epoch};
494    } elsif ($order eq 'order_by_author') {
495        $a->{owner} cmp $b->{owner} || $b->{date_epoch} <=> $a->{date_epoch};
496    } elsif ($order eq 'order_by_size') {
497        $a->{size} <=> $b->{size} || $b->{date_epoch} <=> $a->{date_epoch};
498    } elsif ($order eq 'order_by_date') {
499        $b->{date_epoch} <=> $a->{date_epoch} || $a->{name} cmp $b->{name};
500    } else {
501        $a->{name} cmp $b->{name};
502    }
503}
504
505# OBSOLETED.  Never used.
506sub dump {
507    my $self = shift;
508    my $fd   = shift;
509
510    Sympa::Tools::Data::dump_var($self, 0, $fd);
511}
512
513# OBSOLETED.  No longer used.
514sub dup {
515    my $self = shift;
516
517    my $copy = {};
518
519    foreach my $k (keys %$self) {
520        $copy->{$k} = $self->{$k};
521    }
522
523    return $copy;
524}
525
526sub count_moderated_descendants {
527    my $self = shift;
528
529    return undef unless -d $self->{fs_path};
530
531    my $count = 0;
532    File::Find::find(
533        sub { $count++ if !/\A[.]desc([.]|\z)/ and /\A[.].*[.]moderate\z/; },
534        $self->{fs_path}
535    );
536    return $count;
537}
538
539# Old name: Sympa::List::get_shared_moderated().
540sub get_moderated_descendants {
541    my $self = shift;
542
543    return unless -e $self->{fs_path};
544
545    my @moderated = $self->_get_moderated_descendants;
546    wantarray ? @moderated : \@moderated;
547}
548
549# Old name: Sympa::List::sort_dir_to_get_mod().
550sub _get_moderated_descendants {
551    my $self = shift;
552
553    my @moderated;
554    foreach my $child ($self->get_children) {
555        push @moderated, $child
556            if $child->{moderate};
557        push @moderated, $child->_get_moderated_descendants
558            if $child->{type} eq 'directory';
559    }
560    return @moderated;
561}
562
563# Returns a hash with privileges in read, edit, control.
564
565## Regulars
566#  read(/) = default (config list)
567#  edit(/) = default (config list)
568#  control(/) = not defined
569#  read(A/B)= (read(A) && read(B)) ||
570#             (author(A) || author(B))
571#  edit = idem read
572#  control (A/B) : author(A) || author(B)
573#  + (set owner A/B) if (empty directory &&
574#                        control A)
575
576# Arguments:
577# (\%mode,$path)
578# if mode->{'read'} control access only for read
579# if mode->{'edit'} control access only for edit
580# if mode->{'control'} control access only for control
581
582# return the hash (
583# $result{'may'}{'read'} == $result{'may'}{'edit'} == $result{'may'}{'control'}  if is_author else :
584# $result{'may'}{'read'} = 0 or 1 (right or not)
585# $result{'may'}{'edit'} = 0(not may edit) or 0.5(may edit with moderation) or 1(may edit ) : it is not a boolean anymore
586# $result{'may'}{'control'} = 0 or 1 (right or not)
587# $result{'reason'}{'read'} = string for authorization_reject.tt2 when may_read == 0
588# $result{'reason'}{'edit'} = string for authorization_reject.tt2 when may_edit == 0
589# $result{'scenario'}{'read'} = scenario name for the document
590# $result{'scenario'}{'edit'} = scenario name for the document
591
592# Old name: d_access_control() in wwsympa.fcgi,
593# Sympa::SharedDocument::check_access_control().
594sub get_privileges {
595    my $self    = shift;
596    my %options = @_;
597
598    my $mode             = $options{mode} || '';
599    my $sender           = $options{sender};
600    my $auth_method      = $options{auth_method};
601    my $scenario_context = $options{scenario_context} || {};
602
603    my $list = $self->{context};
604
605    # Result
606    my %result;
607    $result{'reason'} = {};
608
609    my $mode_read    = (0 <= index $mode, 'read');
610    my $mode_edit    = (0 <= index $mode, 'edit');
611    my $mode_control = (0 <= index $mode, 'control');
612
613    # Control for editing
614    my $may_read     = 1;
615    my $why_not_read = '';
616    my $may_edit     = 1;
617    my $why_not_edit = '';
618    my $is_author    = 0;    # <=> $may_control
619
620    # First check privileges on the root shared directory.
621    $result{'scenario'}{'read'} =
622        $list->{'admin'}{'shared_doc'}{'d_read'}{'name'};
623    $result{'scenario'}{'edit'} =
624        $list->{'admin'}{'shared_doc'}{'d_edit'}{'name'};
625
626    # Privileged owner has all privileges.
627    if (Sympa::is_listmaster($list, $sender)
628        or $list->is_admin('privileged_owner', $sender)) {
629        $result{'may'}{'read'}    = 1;
630        $result{'may'}{'edit'}    = 1;
631        $result{'may'}{'control'} = 1;
632        return %result;
633    }
634
635    # if not privileged owner
636    if ($mode_read) {
637        my $result = Sympa::Scenario->new($list, 'd_read')
638            ->authz($auth_method, $scenario_context);
639        my $action;
640        if (ref($result) eq 'HASH') {
641            $action       = $result->{'action'};
642            $why_not_read = $result->{'reason'};
643        }
644
645        $may_read = ($action =~ /\Ado_it\b/i);
646    }
647
648    if ($mode_edit) {
649        my $result = Sympa::Scenario->new($list, 'd_edit')
650            ->authz($auth_method, $scenario_context);
651        my $action;
652        if (ref($result) eq 'HASH') {
653            $action       = $result->{'action'};
654            $why_not_edit = $result->{'reason'};
655        }
656        $action ||= '';
657
658        # edit = 0, 0.5 or 1
659        $may_edit =
660              ($action =~ /\Ado_it\b/i)  ? 1
661            : ($action =~ /\Aeditor\b/i) ? 0.5
662            :                              0;
663        $why_not_edit = '' if $may_edit;
664    }
665
666    # Only authenticated users can edit files.
667    unless ($sender) {
668        $may_edit     = 0;
669        $why_not_edit = 'not_authenticated';
670    }
671
672    #if ($mode_control) {
673    #    $result{'may'}{'control'} = 0;
674    #}
675
676    my $current = $self;
677    while ($current and @{$current->{paths}}) {
678        if ($current->{scenario}) {
679            if ($mode_read) {
680                my $result =
681                    Sympa::Scenario->new($list, 'd_read',
682                    name => $current->{scenario}{read})
683                    ->authz($auth_method, $scenario_context);
684                my $action;
685                if (ref($result) eq 'HASH') {
686                    $action       = $result->{'action'};
687                    $why_not_read = $result->{'reason'};
688                }
689
690                $may_read = $may_read && ($action =~ /\Ado_it\b/i);
691                $why_not_read = '' if $may_read;
692            }
693
694            if ($mode_edit) {
695                my $result =
696                    Sympa::Scenario->new($list, 'd_edit',
697                    name => $current->{scenario}{edit})
698                    ->authz($auth_method, $scenario_context);
699                my $action_edit;
700                if (ref($result) eq 'HASH') {
701                    $action_edit  = $result->{'action'};
702                    $why_not_edit = $result->{'reason'};
703                }
704                $action_edit ||= '';
705
706                # $may_edit = 0, 0.5 or 1
707                my $may_action_edit =
708                      ($action_edit =~ /\Ado_it\b/i)  ? 1
709                    : ($action_edit =~ /\Aeditor\b/i) ? 0.5
710                    :                                   0;
711                $may_edit =
712                     !($may_edit and $may_action_edit) ? 0
713                    : ($may_edit == 0.5 or $may_action_edit == 0.5) ? 0.5
714                    :                                                 1;
715                $why_not_edit = '' if $may_edit;
716            }
717
718            # Only authenticated users can edit files.
719            unless ($sender) {
720                $may_edit     = 0;
721                $why_not_edit = 'not_authenticated';
722            }
723
724            $is_author = $is_author
725                || (($sender || 'nobody') eq $current->{owner});
726
727            unless (defined $result{'scenario'}{'read'}) {
728                $result{scenario}{read} = $current->{scenario}{read};
729                $result{scenario}{edit} = $current->{scenario}{edit};
730            }
731
732            # Author has all privileges.
733            if ($is_author) {
734                $result{'may'}{'read'}    = 1;
735                $result{'may'}{'edit'}    = 1;
736                $result{'may'}{'control'} = 1;
737                return %result;
738            }
739
740        }
741
742        $current = $current->{parent};
743    }
744
745    if ($mode_read) {
746        $result{'may'}{'read'}    = $may_read;
747        $result{'reason'}{'read'} = $why_not_read;
748    }
749
750    if ($mode_edit) {
751        $result{'may'}{'edit'}    = $may_edit;
752        $result{'reason'}{'edit'} = $why_not_edit;
753    }
754
755    #if ($mode_control) {
756    #    $result{'may'}{'control'} = 0;
757    #}
758
759    return %result;
760}
761
762# Returns the mode of editing included in $action : 0, 0.5 or 1
763# Old name: Sympa::Tools::WWW::find_edit_mode().
764# No longer used.
765#sub _find_edit_mode {
766#    my $action = shift;
767#
768#    my $result;
769#    if ($action =~ /editor/i) {
770#        $result = 0.5;
771#    } elsif ($action =~ /do_it/i) {
772#        $result = 1;
773#    } else {
774#        $result = 0;
775#    }
776#    return $result;
777#}
778
779# Returns the mode of editing : 0, 0.5 or 1 :
780#  do the merging between 2 args of right access edit  : "0" > "0.5" > "1"
781#  instead of a "and" between two booleans : the most restrictive right is
782#  imposed
783# Old name: Sympa::Tools::WWW::merge_edit().
784# No longer used.
785#sub _merge_edit {
786#    my $arg1 = shift;
787#    my $arg2 = shift;
788#    my $result;
789#
790#    if ($arg1 == 0 || $arg2 == 0) {
791#        $result = 0;
792#    } elsif ($arg1 == 0.5 || $arg2 == 0.5) {
793#        $result = 0.5;
794#    } else {
795#        $result = 1;
796#    }
797#    return $result;
798#}
799
800# Old name: Sympa::List::get_shared_size().
801sub get_size {
802    my $self = shift;
803
804    return undef unless grep { $self->{type} eq $_ } qw(root directory);
805    return 0 unless -d $self->{fs_path};
806    return Sympa::Tools::File::get_dir_size($self->{fs_path});
807}
808
809sub install {
810    my $self = shift;
811
812    unless ($self->{moderate} and -e $self->{fs_path}) {
813        $ERRNO = POSIX::ENOENT();
814        return undef;
815    }
816
817    my $new_fs_name;
818    if ($self->{fs_name} =~ /\A[.](.+)[.]moderate\z/) {
819        $new_fs_name = $1;
820    } else {
821        $ERRNO = POSIX::ENOENT();
822        return undef;
823    }
824    my $new_fs_path = $self->{parent}->{fs_path} . '/' . $new_fs_name;
825    my $desc_file   = $self->_desc_file;
826    my $new_desc_file =
827          (-d $self->{fs_path})
828        ? ($new_fs_path . '/.desc')
829        : ($self->{parent}->{fs_path} . '/.desc.' . $new_fs_name);
830
831    # Rename the old file in .old if exists.
832    if (-e $new_fs_path) {
833        return undef
834            unless CORE::rename $new_fs_path, $new_fs_path . '.old';
835        if (-e $new_desc_file) {
836            return undef
837                unless CORE::rename $new_desc_file, $new_desc_file . '.old';
838        }
839    }
840    return undef
841        unless CORE::rename $self->{fs_path}, $new_fs_path;
842    if (-e $desc_file) {
843        return undef
844            unless CORE::rename $desc_file, $new_desc_file;
845    }
846
847    $self->{fs_path} = $new_fs_path;
848    $self->{fs_name} = $new_fs_name;
849    delete $self->{moderate};
850
851    return 1;
852}
853
854sub rename {
855    my $self     = shift;
856    my $new_name = shift;
857
858    if ($self->{type} eq 'root') {
859        $ERRNO = POSIX::EPERM();
860        return undef;
861    }
862    if (not Sympa::WWW::SharedDocument::valid_name($new_name)
863        or ($self->{type} eq 'url' and $new_name !~ /[.]url\z/)) {
864        $ERRNO = POSIX::EINVAL();
865        return undef;
866    }
867
868    my $new_fs_name;
869    if ($self->{moderate}) {
870        $new_fs_name = '.'
871            . Sympa::Tools::Text::qencode_filename($new_name)
872            . '.moderate';
873    } else {
874        $new_fs_name = Sympa::Tools::Text::qencode_filename($new_name);
875    }
876    my $new_fs_path = $self->{parent}->{fs_path} . '/' . $new_fs_name;
877    my $new_paths =
878        [@{$self->{paths}}[0 .. ($#{$self->{paths}} - 1)], $new_name];
879
880    return undef
881        unless CORE::rename $self->{fs_path}, $new_fs_path;
882
883    # Rename description file.
884    unless ($self->{type} eq 'directory') {
885        my $desc_file = $self->_desc_file;
886        my $new_desc_file =
887            $self->{parent}->{fs_path} . '/.desc.' . $new_fs_name;
888        if (-e $desc_file) {
889            return undef
890                unless CORE::rename $desc_file, $new_desc_file;
891        }
892    }
893
894    @{$self}{qw(fs_name fs_path name paths)} =
895        ($new_fs_name, $new_fs_path, $new_name, $new_paths);
896
897    return 1;
898}
899
900sub restore {
901    my $self = shift;
902
903    unless ($self->{type} eq 'root') {
904        $ERRNO = POSIX::EINVAL();
905        return undef;
906    }
907
908    my $list = $self->{context};
909    return undef
910        unless CORE::rename $list->{'dir'} . '/pending.shared',
911        $self->{fs_path};
912
913    $self->{status} = 'exist';
914    return 1;
915}
916
917sub rmdir {
918    my $self = shift;
919
920    unless ($self->{type} eq 'directory' and -d $self->{fs_path}) {
921        $ERRNO = POSIX::ENOTDIR();
922        return undef;
923    }
924    if ($self->count_children) {
925        $ERRNO = POSIX::EEXIST();
926        return undef;
927    }
928
929    if (-e $self->_desc_file) {
930        return undef unless CORE::unlink $self->_desc_file;
931    }
932    CORE::rmdir $self->{fs_path};
933}
934
935#FIXME:Generalize serialization.
936#FIXME:Lock file.
937sub save_description {
938    my $self = shift;
939
940    $self->{title} = '' unless defined $self->{title};
941
942    my $fh;
943    return undef unless open $fh, '>', $self->_desc_file;
944
945    print $fh "title\n";
946    printf $fh "  %s\n", $self->{title};
947    print $fh "\n";
948
949    print $fh "access\n";
950    printf $fh "  read %s\n", $self->{scenario}{read};
951    printf $fh "  edit %s\n", $self->{scenario}{edit};
952    print $fh "\n";
953
954    print $fh "creation\n";
955    printf $fh "  date_epoch %s\n", $self->{date_epoch};
956    printf $fh "  email %s\n",      $self->{owner};
957    print $fh "\n";
958
959    close $fh;
960
961    $self->{serial_desc} = Sympa::Tools::File::get_mtime($self->_desc_file);
962
963    return 1;
964}
965
966sub unlink {
967    my $self = shift;
968
969    if (grep { $self->{type} eq $_ } qw(root directory)) {
970        $ERRNO = POSIX::EPERM();
971        return undef;
972    }
973
974    return undef
975        unless CORE::unlink $self->{fs_path};
976    my $desc_file = $self->_desc_file;
977    if (-e $desc_file) {
978        return undef
979            unless CORE::unlink $desc_file;
980    }
981
982    return 1;
983}
984
985sub valid_name {
986    my $new_name = shift;
987
988    return undef
989        if not defined $new_name
990        or $new_name !~ /\S/
991        or $new_name =~ /\A[.]/
992        or 0 <= index($new_name, '/')
993        or $new_name =~ /[<>\\\*\$\[\]\n]/
994        or $new_name =~ /[~#\[\]]$/;
995
996    return 1;
997}
998
999# Old name: tools::escape_docname().
1000# DEPRECATED. No longer used.
1001#sub escape_docname;
1002
1003sub get_id {
1004    shift->{fs_path};
1005}
1006
10071;
1008__END__
1009
1010=encoding utf-8
1011
1012=head1 NAME
1013
1014Sympa::WWW::SharedDocument - Shared document repository and its nodes
1015
1016=head1 SYNOPSIS
1017
1018  use Sympa::WWW::SharedDocument;
1019
1020  $shared = Sympa::WWW::SharedDocument->new($list, $path);
1021
1022  %access = $shared->get_privileges('read', $email, 'md5', {...});
1023  @children = $shared->get_children;
1024  $parent = $shared->{parent};
1025
1026=head1 DESCRIPTION
1027
1028L<Sympa::WWW::SharedDocument> implements shared document repository of lists.
1029
1030=head2 Methods
1031
1032=over
1033
1034=item new ( $list, [ $path, [ allow_empty =E<gt> 1 ] ] )
1035
1036I<Constructor>.
1037Creates new instance.
1038
1039Parameters:
1040
1041=over
1042
1043=item $list
1044
1045A L<Sympa::List> instance.
1046
1047=item $path
1048
1049String to determine path or arrayref of path components.
1050The path is relative to repository root.
1051
1052=item allow_empty =E<gt> 1
1053
1054Don't omit files with zero size.
1055
1056=back
1057
1058Returns:
1059
1060If $path is empty or not specified, returns new instance of repository root;
1061{status} attribute will be set.
1062If $path is not empty and the path exists, returns new instance of node.
1063Otherwise returns false value.
1064
1065=item as_hashref ( )
1066
1067I<Instance method>.
1068Casts the instance to hashref.
1069
1070Parameters:
1071
1072None.
1073
1074Returns:
1075
1076A hashref including attributes of instance (see L</Attributes>)
1077and following special items:
1078
1079=over
1080
1081=item {ancestors}
1082
1083Arrayref of hashrefs including some attributes of all ancestor nodes.
1084
1085=item {context}
1086
1087Hashref including name and host of the list.
1088
1089=item {date}
1090
1091Localized form of {date_epoch}.
1092
1093=item {parent}
1094
1095Hashref including attributes of parent node recursively.
1096
1097=item {paths_d}
1098
1099Same as {paths} but, if the node is a directory, includes additional empty
1100component at the end.
1101This is useful when the path created by join() should be followed by
1102additional "/" character.
1103
1104=back
1105
1106=item count_children ( )
1107
1108I<Instance method>.
1109Returns number of child nodes.
1110
1111=item count_moderated_descendants ( )
1112
1113I<Instance method>.
1114Returns number of nodes waiting for moderation.
1115
1116=item create_child ( $name, owner =E<gt> $email, scenario =E<gt> $scenario,
1117type =E<gt> $type, [ content => $content ] )
1118
1119I<Instance method>.
1120Creates child node and returns it.
1121TBD.
1122
1123=item get_children ( [ moderate =E<gt> boolean ], [ name =E<gt> $name ],
1124[ order_by =E<gt> $order ], [ owner =E<gt> $email ], [ allow_empty =E<gt> 1 ] )
1125
1126I<Instance method>.
1127Gets child nodes.
1128
1129Parameters:
1130
1131=over
1132
1133=item moderate =E<gt> boolean
1134
1135=item name =E<gt> $name
1136
1137=item owner =E<gt> $email
1138
1139Filters results.
1140
1141=item order_by =E<gt> $order
1142
1143Sorts results.
1144$order may be one of
1145C<'order_by_doc'> (by name of nodes),
1146C<'order_by_author'> (by owner),
1147C<'order_by_size'> (by size),
1148C<'order_by_date'> (by modification time).
1149Default is ordering by names.
1150
1151=item allow_empty =E<gt> 1
1152
1153Don't omit nodes with zero size.
1154
1155=back
1156
1157Returns:
1158
1159(Possibly empty) list of child nodes.
1160
1161=item get_moderated_descendants ( )
1162
1163I<Instance method>.
1164Returns the list of nodes waiting for moderation.
1165
1166Parameters:
1167
1168None.
1169
1170Returns:
1171
1172In array context, a list of nodes.
1173In scalar context, an arrayref of them.
1174
1175=item get_privileges ( mode =E<gt> $mode, sender =E<gt> $sender,
1176auth_method =E<gt> $auth_method, scenario_context =E<gt> $scenario_context )
1177
1178I<Instance method>.
1179Gets privileges of a user on the node.
1180
1181TBD.
1182
1183=item get_size ( )
1184
1185I<Instance method>.
1186Gets total size under current node.
1187
1188=item install ( )
1189
1190I<Instance method>.
1191Approves (install) file if it was held for moderation.
1192
1193Returns:
1194
1195True value.
1196If installation failed, returns false value and sets $ERRNO ($!).
1197
1198=item rename ( $new_name )
1199
1200I<Instance method>.
1201Renames file or directory.
1202
1203Parameters:
1204
1205=over
1206
1207=item $new_name
1208
1209The name to be renamed to.
1210
1211=back
1212
1213Returns:
1214
1215True value.
1216If renaming failed, returns false value and sets $ERRNO ($!).
1217
1218=item rmdir ( )
1219
1220I<instance method>.
1221Removes directory from repository.
1222Directory must be empty.
1223
1224Returns:
1225
1226True value.
1227If removal failed, returns false value and sets $ERRNO ($!).
1228
1229=item save_description ( )
1230
1231I<Instance method>.
1232Creates or updates property description of the node.
1233
1234=item unlink ( )
1235
1236I<instance method>.
1237Removes file from repository.
1238
1239Returns:
1240
1241True value.
1242If removal failed, returns false value and sets $ERRNO ($!).
1243
1244=item get_id ( )
1245
1246I<Instance method>.
1247Returns unique identifier of instance.
1248
1249=back
1250
1251=head3 Methods for repository root
1252
1253=over
1254
1255=item create ( )
1256
1257I<Instance method>.
1258Creates document repository on physical filesystem.
1259
1260=item delete ( )
1261
1262I<Instance method>.
1263Deletes document repository.
1264
1265=item restore ( )
1266
1267I<Instance method>.
1268Restores deleted document repository.
1269
1270=back
1271
1272=head2 Functions
1273
1274=over
1275
1276=item valid_name ( $new_name )
1277
1278I<Function>.
1279Check if the name is allowed for directory and file.
1280
1281Note:
1282This should be used with name of newly created node.
1283Existing files and directories may have the name not allowed by this function.
1284
1285=back
1286
1287=head2 Attributes
1288
1289Instance of L<Sympa::WWW::SharedDocument> may have following attributes.
1290
1291=over
1292
1293=item {context}
1294
1295I<Mandatory>.
1296Instance of L<Sympa::List> class the shared document repository belongs to.
1297
1298=item {date_epoch}
1299
1300I<Mandatory>.
1301Modification time of node in Unix time.
1302
1303=item {file_extension}
1304
1305File extension if any.
1306
1307=item {fs_name}
1308
1309I<Mandatory>.
1310Name of node on physical filesystem,
1311i.e. the last part of {fs_path}.
1312
1313=item {fs_path}
1314
1315I<Mandatory>.
1316Full path of node on physical filesystem.
1317
1318=item {html}
1319
1320Only in HTML file.
1321True value will be set.
1322
1323=item {icon}
1324
1325URL to icon.
1326
1327=item {label}
1328
1329Only in bookmark file.
1330Label to be shown in hyperlink.
1331
1332=item {mime_type}
1333
1334Only in regular file.
1335MIME content type of the file if it is known.
1336
1337=item {moderate}
1338
1339Set if node is held for moderation.
1340
1341=item {name}
1342
1343I<Mandatory>.
1344Name of node accessible by users,
1345i.e. the last item of {paths}.
1346
1347=item {owner}
1348
1349Owner (author) of node,
1350given by property description.
1351
1352=item {parent}
1353
1354Parent node if any.  L<Sympa::WWW::SharedDocument> instance.
1355
1356=item {paths}
1357
1358I<Mandatory>.
1359Arrayref to all path components of node accessible by users.
1360
1361=item {scenario}{read}
1362
1363=item {scenario}{edit}
1364
1365Scenario names to define privileges.
1366These may be given by property description.
1367
1368=item {serial_desc}
1369
1370Modification time of property description in Unix time.
1371Available if property description exists.
1372
1373=item {size}
1374
1375Size of file.
1376
1377=item {status}
1378
1379I<Only in repository root>.
1380Status of repository:
1381C<'exist'>, C<'deleted'> or C<'none'>.
1382
1383=item {title}
1384
1385Description of node,
1386given by property description.
1387
1388=item {type}
1389
1390I<Mandatory>.
1391Type of node.
1392C<'root'> (the root of repository), C<'directory'> (directory), C<'url'>
1393(bookmark file) or C<'file'> (other file).
1394
1395=item {url}
1396
1397Only in bookmark file.
1398URL to be linked.
1399
1400=back
1401
1402=head1 FILES
1403
1404=over
1405
1406=item I<list home>/shared/
1407
1408Root of repository.
1409
1410=item I<... path>/I<name>
1411
1412Directory or file.
1413
1414=item I<... path>/.I<name>.moderate
1415
1416Moderated directory or file.
1417
1418=item I<... path>/I<name>/.desc
1419
1420=item I<... path>/.desc.I<name>
1421
1422=item I<... path>/.desc..I<name>.moderate
1423
1424Property description of directories or files, not moderated or moderated.
1425
1426=back
1427
1428Note:
1429The path components ("I<name>" above) are encoded to the format suitable to
1430physical filesystem.
1431Such conversion will be hidden behind object methods.
1432
1433=head1 SEE ALSO
1434
1435L<Sympa::List>,
1436L<Sympa::Tools::Text/"qdecode_filename">,
1437L<Sympa::Tools::Text/"qencode_filename">.
1438
1439=head1 HISTORY
1440
1441L<SharedDocument> module appeared on Sympa 5.2b.2.
1442
1443Rewritten L<Sympa::SharedDocument> began to provide OO interface on
1444Sympa 6.2.17.
1445
1446It was renamed to L<Sympa::WWW::SharedDocument> on Sympa 6.2.26.
1447
1448=cut
1449