]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/InboxWritable.pm
searchview: do not blindly append "l" parameter to URL
[public-inbox.git] / lib / PublicInbox / InboxWritable.pm
1 # Copyright (C) 2018 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3
4 # Extends read-only Inbox for writing
5 package PublicInbox::InboxWritable;
6 use strict;
7 use warnings;
8 use base qw(PublicInbox::Inbox);
9 use PublicInbox::Import;
10 use PublicInbox::Filter::Base;
11 *REJECT = *PublicInbox::Filter::Base::REJECT;
12
13 use constant {
14         PERM_UMASK => 0,
15         OLD_PERM_GROUP => 1,
16         OLD_PERM_EVERYBODY => 2,
17         PERM_GROUP => 0660,
18         PERM_EVERYBODY => 0664,
19 };
20
21 sub new {
22         my ($class, $ibx) = @_;
23         bless $ibx, $class;
24 }
25
26 sub importer {
27         my ($self, $parallel) = @_;
28         $self->{-importer} ||= eval {
29                 my $v = $self->{version} || 1;
30                 if ($v == 2) {
31                         eval { require PublicInbox::V2Writable };
32                         die "v2 not supported: $@\n" if $@;
33                         my $v2w = PublicInbox::V2Writable->new($self);
34                         $v2w->{parallel} = $parallel;
35                         $v2w;
36                 } elsif ($v == 1) {
37                         my $git = $self->git;
38                         my $name = $self->{name};
39                         my $addr = $self->{-primary_address};
40                         PublicInbox::Import->new($git, $name, $addr, $self);
41                 } else {
42                         die "unsupported inbox version: $v\n";
43                 }
44         }
45 }
46
47 sub filter {
48         my ($self) = @_;
49         my $f = $self->{filter};
50         if ($f && $f =~ /::/) {
51                 my @args = (-inbox => $self);
52                 # basic line splitting, only
53                 # Perhaps we can have proper quote splitting one day...
54                 ($f, @args) = split(/\s+/, $f) if $f =~ /\s+/;
55
56                 eval "require $f";
57                 if ($@) {
58                         warn $@;
59                 } else {
60                         # e.g: PublicInbox::Filter::Vger->new(@args)
61                         return $f->new(@args);
62                 }
63         }
64         undef;
65 }
66
67 sub is_maildir_basename ($) {
68         my ($bn) = @_;
69         return 0 if $bn !~ /\A[a-zA-Z0-9][\-\w:,=\.]+\z/;
70         if ($bn =~ /:2,([A-Z]+)\z/i) {
71                 my $flags = $1;
72                 return 0 if $flags =~ /[DT]/; # no [D]rafts or [T]rashed mail
73         }
74         1;
75 }
76
77 sub is_maildir_path ($) {
78         my ($path) = @_;
79         my @p = split(m!/+!, $path);
80         (is_maildir_basename($p[-1]) && -f $path) ? 1 : 0;
81 }
82
83 sub maildir_path_load ($) {
84         my ($path) = @_;
85         if (open my $fh, '<', $path) {
86                 local $/;
87                 my $str = <$fh>;
88                 $str or return;
89                 return PublicInbox::MIME->new(\$str);
90         } elsif ($!{ENOENT}) {
91                 # common with Maildir
92                 return;
93         } else {
94                 warn "failed to open $path: $!\n";
95                 return;
96         }
97 }
98
99 sub import_maildir {
100         my ($self, $dir) = @_;
101         my $im = $self->importer(1);
102         my $filter = $self->filter;
103         foreach my $sub (qw(cur new tmp)) {
104                 -d "$dir/$sub" or die "$dir is not a Maildir (missing $sub)\n";
105         }
106         foreach my $sub (qw(cur new)) {
107                 opendir my $dh, "$dir/$sub" or die "opendir $dir/$sub: $!\n";
108                 while (defined(my $fn = readdir($dh))) {
109                         next unless is_maildir_basename($fn);
110                         my $mime = maildir_file_load("$dir/$fn") or next;
111                         if ($filter) {
112                                 my $ret = $filter->scrub($mime) or return;
113                                 return if $ret == REJECT();
114                                 $mime = $ret;
115                         }
116                         $im->add($mime);
117                 }
118         }
119         $im->done;
120 }
121
122 # asctime: From example@example.com Fri Jun 23 02:56:55 2000
123 my $from_strict = qr/^From \S+ +\S+ \S+ +\S+ [^:]+:[^:]+:[^:]+ [^:]+/;
124
125 sub mb_add ($$$$) {
126         my ($im, $variant, $filter, $msg) = @_;
127         $$msg =~ s/(\r?\n)+\z/$1/s;
128         my $mime = PublicInbox::MIME->new($msg);
129         if ($variant eq 'mboxrd') {
130                 $$msg =~ s/^>(>*From )/$1/sm;
131         } elsif ($variant eq 'mboxo') {
132                 $$msg =~ s/^>From /From /sm;
133         }
134         if ($filter) {
135                 my $ret = $filter->scrub($mime) or return;
136                 return if $ret == REJECT();
137                 $mime = $ret;
138         }
139         $im->add($mime)
140 }
141
142 sub import_mbox {
143         my ($self, $fh, $variant) = @_;
144         if ($variant !~ /\A(?:mboxrd|mboxo)\z/) {
145                 die "variant must be 'mboxrd' or 'mboxo'\n";
146         }
147         my $im = $self->importer(1);
148         my $prev = undef;
149         my $msg = '';
150         my $filter = $self->filter;
151         while (defined(my $l = <$fh>)) {
152                 if ($l =~ /$from_strict/o) {
153                         if (!defined($prev) || $prev =~ /^\r?$/) {
154                                 mb_add($im, $variant, $filter, \$msg) if $msg;
155                                 $msg = '';
156                                 $prev = $l;
157                                 next;
158                         }
159                         warn "W[$.] $l\n";
160                 }
161                 $prev = $l;
162                 $msg .= $l;
163         }
164         mb_add($im, $variant, $filter, \$msg) if $msg;
165         $im->done;
166 }
167
168 sub _read_git_config_perm {
169         my ($self) = @_;
170         my @cmd = qw(config);
171         chomp(my $perm = $self->git->qx('config', 'core.sharedRepository'));
172         $perm;
173 }
174
175 sub _git_config_perm {
176         my $self = shift;
177         my $perm = scalar @_ ? $_[0] : _read_git_config_perm($self);
178         return PERM_GROUP if (!defined($perm) || $perm eq '');
179         return PERM_UMASK if ($perm eq 'umask');
180         return PERM_GROUP if ($perm eq 'group');
181         if ($perm =~ /\A(?:all|world|everybody)\z/) {
182                 return PERM_EVERYBODY;
183         }
184         return PERM_GROUP if ($perm =~ /\A(?:true|yes|on|1)\z/);
185         return PERM_UMASK if ($perm =~ /\A(?:false|no|off|0)\z/);
186
187         my $i = oct($perm);
188         return PERM_UMASK if ($i == PERM_UMASK);
189         return PERM_GROUP if ($i == OLD_PERM_GROUP);
190         return PERM_EVERYBODY if ($i == OLD_PERM_EVERYBODY);
191
192         if (($i & 0600) != 0600) {
193                 die "core.sharedRepository mode invalid: ".
194                     sprintf('%.3o', $i) . "\nOwner must have permissions\n";
195         }
196         ($i & 0666);
197 }
198
199 sub _umask_for {
200         my ($perm) = @_; # _git_config_perm return value
201         my $rv = $perm;
202         return umask if $rv == 0;
203
204         # set +x bit if +r or +w were set
205         $rv |= 0100 if ($rv & 0600);
206         $rv |= 0010 if ($rv & 0060);
207         $rv |= 0001 if ($rv & 0006);
208         (~$rv & 0777);
209 }
210
211 sub with_umask {
212         my ($self, $cb) = @_;
213         my $old = umask $self->{umask};
214         my $rv = eval { $cb->() };
215         my $err = $@;
216         umask $old;
217         die $err if $err;
218         $rv;
219 }
220
221 sub umask_prepare {
222         my ($self) = @_;
223         my $perm = _git_config_perm($self);
224         my $umask = _umask_for($perm);
225         $self->{umask} = $umask;
226 }
227
228 1;