syncmail/folder.pm

package folder;

BEGIN { *slog = \&::slog };

use Fcntl;
use File::Sync ();

use Inline Config => NAME => "syncmail::folder";
use Inline C;

use constant MDIFVERSION => 1;

BEGIN {
   if (1) {
      use OpenSSL ();
      *hash = \&OpenSSL::Digest::sha1_hex;
   } elsif (0) {
      # use Digest::SHA1 ();
      my $digest = new Digest::SHA1;
      *hash = sub {
         $digest->reset;
         $digest->add(@_);
         $mid = $digest->hexdigest;
      };
   } 
}

sub flushfh {
   my $oldfh = select $_[0];
   $| = 1;
   select $oldfh;
}

# rename a file and fsync the directory
sub replace {
   my ($src, $dst) = @_;
   my $self = shift;

   rename $src, $dst;

   $dst =~ s/[^\/]*$/./;

   # now sync the directory

   open my $dir, "<", $dst
      or die "$dst: $!";

   File::Sync::fsync($dir);
}

sub new {
   my $class = shift;
   my %arg = @_;
   my $self = bless {
      path => "$::PREFIX/$arg{name}",
      %arg,
   }, $class;
   $self->open(0);
   $self;
}

sub dirty {
   $_[0]{dirty} = 1;
}

sub DESTROY {
   $_[0]->write_mdif;
}

# parse_mbox(mbox-file-path, callback)
# callback gets called with \$header and \$body,
# $header includes the mbox From_ line without
# the leading From_ itself.
sub parse_mbox {
  my ($fh, $cb) = @_;

  local $/ = "\n\n";

  my ($head, $body, $offs);

  read $fh, $head, 5;

  $head eq "From " or $head eq ""
     or return;

  $offs = 0;
  while (defined ($head = <$fh>)) {
     $head =~ /^.*? [A-Z][a-z][a-z] [A-Z][a-z][a-z] [ 0-9][0-9] \d\d:\d\d:\d\d(?: [+-]\d\d\d\d)? \d\d(?:\d\d)\n/
        or die "$path: not standard mbox format header:\n$head\n";

     local $/ = "\nFrom ";
     # NEVER enable this. content-length simply is broken by design
     #if ($head =~ /^Content-Length:\s+(\d+)$/im) {
     #   $1 <= read $fh, $body, $1 + 5
     #      or die "$path: partial message in mbox";
     #} else {
        $body = <$fh>;
     #}
     chomp $body;
     $cb->($offs, \$head, \$body);
     $offs = (tell $fh) - 5;
     &::give unless ++$ecnt & 255;
  }

  1;
}

sub conf_path {
   (my $conf = $_[0]{path}) =~ s%([^/]+$)%.$1.mdif%;
   $conf;
}

sub read_mdif {
   my $self = shift;
   my $path = $self->conf_path;

   return if $self->{idx};

   open my $fh, "<", $path
      or return;

   defined ($_ = <$fh>)
      or die "$path: empty mdif file\n";

   do {
      if ($_ eq "[SYNCMAIL]\n") {
         while (<$fh>) {
            last unless /^([a-z]+)\s*=\s*(.*)\n$/;
            $self->{$1} = $2;
         }
      } elsif ($_ eq "[HOSTS]\n") {
         while (<$fh>) {
            last unless /^([^[].*)=(.*)\n$/;
            $self->{host}{$1} = $2;
         }
      } elsif (/^\[DIFF (\d+)\]\n$/) {
         my $mtime = $1;
         my (@add, @del);
         while (<$fh>) {
            last unless /^([+-])(.*)\n$/;
            if ($1 eq "+") {
               push @add, $2;
            } else {
               push @del, $2;
            }
         }
         unshift @{$self->{diff}}, [$mtime, \@add, \@del];
      } elsif ($_ eq "[INDEX]\n") {
         my @idx;
         while (<$fh>) {
            last unless /^(\d+)=(.*)\n$/;
            push @idx, [$1, $2];
         }
         $self->{idx} = \@idx;
      } elsif (/^#/) {
         $_ = <$fh>;
         # nop
      } else {
         die "$path: unparseable section '$_'\n";
      }
   } while defined $_;

   $self->{version} <= MDIFVERSION
      or die "$path: version mismatch ($self->{version} found, <".MDIFVERSION." expected)\n";
}

sub write_mdif {
   my $self = shift;
   my $path = $self->conf_path;

   return unless $self->{dirty};

   open my $fh, ">", "$path~"
      or die "$path~: $!";

   print $fh "# automatically generated, do NOT edit\n";

   print $fh "[SYNCMAIL]\n";
   print $fh "$_=$self->{$_}\n" for (qw(fsize mtime version ctime));

   print $fh "[HOSTS]\n";
   while (my ($k,$v) = each %{$self->{host}}) {
      print $fh "$k=$v\n";
   }

   print $fh "[INDEX]\n";
   print $fh "$_->[0]=$_->[1]\n" for @{$self->{idx}};

   for (reverse @{$self->{diff}}) {
      print $fh "[DIFF $_->[0]]\n";
      print $fh "+$_\n" for @{$_->[1]};
      print $fh "-$_\n" for @{$_->[2]};
   }

   flushfh $fh;
   File::Sync::fsync($fh);
   close $fh
      or die "$path~: unable to create updated .mdif: $!";

   replace("$path~", $path);

   delete $self->{dirty};
}

sub gendiff {
   my ($self, $d1, $d2) = @_;

   my (@add, @del);
   my (%d1, %d2);

   for (@$d2) {
      undef $d2{$_->[1]};
   }

   # delete msgs in d1 but not in d2
   for (@$d1) {
      undef $d1{$_->[1]};
      push @del, $_->[1] unless exists $d2{$_->[1]};
   }
   %d2 = (); # conserve memory

   # add msgs in d2 but not in d1
   for (@$d2) {
      push @add, $_->[1] unless exists $d1{$_->[1]};
   }

   push @{$self->{diff}}, [
      $self->{ctime},
      \@add, \@del,
   ] if @add || @del;
}

sub check {
   my $self = shift;
   my $path = $self->{path};
   my $conf = $self->conf_path;
   my $guard = $::lockdisk->guard;

   slog 3, "checking $path\n";

   stat $path
      or die "$path: $!";

   my ($fsize, $mtime) = (stat _)[7, 9];

   if (open my $fh, "<", $conf) {
      my %conf;
      <$fh>; # skip initial comment
      <$fh> eq "[SYNCMAIL]\n"
         or die "$conf: format error";
      while (<$fh> =~ /^([a-z]+)\s*=\s*(.*)$/) {
         $conf{$1} = $2;
      }
      return 1 if $fsize == $conf{fsize}
               && $mtime == $conf{mtime};

      $conf{mtime} <= $mtime
         or die "$path: folder older than mdif";
   }

   slog 2, "updating $path\n";

   my @idx;

   parse_mbox $self->{fh}, sub {
      my ($offs, $head, $body) = @_;
      push @idx, [$offs, hash($$head, "\0", $$body)];
   } or die "$path: no valid mbox file";

   $self->read_mdif;

   $self->{version} ||= MDIFVERSION;
   $self->{ctime} = time;

   $self->gendiff($self->{idx}, \@idx);

   $self->{fsize} = $fsize;
   $self->{mtime} = $mtime;
   $self->{idx}   = \@idx;

   $self->dirty;
   $self->write_mdif;
}

sub inventory {
   hash sort map { $_->[1] } @{$_[0]{idx}};
}

sub open {
   my ($self, $rw) = @_;

   if (!$self->{fh} || $self->{rw} != $rw) {
      $self->close;
      $self->{rw} = $rw;
      sysopen $self->{fh}, $self->{path},
              O_CREAT | ($rw ? O_RDWR : O_RDONLY),
              0666
         or die "$self->{path}: $!";
      0 == setlkw(fileno $self->{fh}, $rw ? 2 : 1)
         or die "$self->{path}: $!";

   }
}

sub close {
   my $self = shift;

   flushfh $self->{fh};
   File::Sync::fsync($self->{fh});
   delete $self->{fh};
}

# begin updating folder
sub begin_update {
   my $self = shift;

   $self->{oidx} = $self->{idx};

}

sub delete {
   my $self = shift;
   my $temp = "$self->{path}~";

   if (@_) {
      my $guard = $::lockdisk->guard;
      my %del; @del{@_} = ();

      open my $fh, ">", $temp
         or die "$temp: $!";

      my $nidx;
      my $idx = delete $self->{idx};
      push @$idx, [$self->{fsize}];
      $self->{fsize} = 0; # we virtually truncated the file

      slog 0, "XXXXXXXXXXXXXXX @_\n";#d#

      my $ofs = 0;
      for (0 .. @$idx - 2) {
         my $buf;

         unless (exists $del{$idx->[$_][1]}) {
            my $len = $idx->[$_+1][0] - $idx->[$_][0];

            slog 0, "$idx->[$_][1] $idx->[$_+1][0] - $idx->[$_][0]\n";#d#

            seek $self->{fh}, $idx->[$_][0],SEEK_SET
               or die "$self->{path}: $!";

            $len == read $self->{fh}, $buf, $len
               or die "$self->{path}: $!";

            $buf =~ /^From \S/
               or die "$self->{path}: corrupted mail folder";

            &::give unless ++$ecnt & 255;
         } else {
            slog 0, "skipping $idx->[$_][1]\n";
         }
      }

      File::Sync::fsync($fh);
      close $fh;

      # replace $temp, $self->{path}
   }
}

sub end_update {
}

sub append {
   my $self = shift;

   &update;
   #$self->open(1);
}

1;

__DATA__
__C__
#include <unistd.h>
#include <fcntl.h>

/* mode0 unlock, mode1 rlock, mode2 rwlock */
int setlkw(int fd, int mode)
{
   struct flock l;

   l.l_type   = mode == 0 ? F_UNLCK
              : mode == 1 ? F_RDLCK
              :             F_WRLCK;
   l.l_whence = SEEK_SET;
   l.l_start  = 0;
   l.l_len    = 0;

   return fcntl (fd, F_SETLKW, &l);
}

Revision:	1.4
Committed:	Sun Oct 28 20:52:24 2001 UTC (22 years, 6 months ago) by root
Branch:	MAIN
Changes since 1.3:	+202 -63 lines
Log Message:	* empty log message *
#	Content
1	package folder;
2
3	BEGIN { *slog = \&::slog };
4
5	use Fcntl;
6	use File::Sync ();
7
8	use Inline Config => NAME => "syncmail::folder";
9	use Inline C;
10
11	use constant MDIFVERSION => 1;
12
13	BEGIN {
14	if (1) {
15	use OpenSSL ();
16	*hash = \&OpenSSL::Digest::sha1_hex;
17	} elsif (0) {
18	# use Digest::SHA1 ();
19	my $digest = new Digest::SHA1;
20	*hash = sub {
21	$digest->reset;
22	$digest->add(@_);
23	$mid = $digest->hexdigest;
24	};
25	}
26	}
27
28	sub flushfh {
29	my $oldfh = select $_[0];
30	$\| = 1;
31	select $oldfh;
32	}
33
34	# rename a file and fsync the directory
35	sub replace {
36	my ($src, $dst) = @_;
37	my $self = shift;
38
39	rename $src, $dst;
40
41	$dst =~ s/[^\/]*$/./;
42
43	# now sync the directory
44
45	open my $dir, "<", $dst
46	or die "$dst: $!";
47
48	File::Sync::fsync($dir);
49	}
50
51	sub new {
52	my $class = shift;
53	my %arg = @_;
54	my $self = bless {
55	path => "$::PREFIX/$arg{name}",
56	%arg,
57	}, $class;
58	$self->open(0);
59	$self;
60	}
61
62	sub dirty {
63	$_[0]{dirty} = 1;
64	}
65
66	sub DESTROY {
67	$_[0]->write_mdif;
68	}
69
70	# parse_mbox(mbox-file-path, callback)
71	# callback gets called with \$header and \$body,
72	# $header includes the mbox From_ line without
73	# the leading From_ itself.
74	sub parse_mbox {
75	my ($fh, $cb) = @_;
76
77	local $/ = "\n\n";
78
79	my ($head, $body, $offs);
80
81	read $fh, $head, 5;
82
83	$head eq "From " or $head eq ""
84	or return;
85
86	$offs = 0;
87	while (defined ($head = <$fh>)) {
88	$head =~ /^.*? [A-Z][a-z][a-z] [A-Z][a-z][a-z] [ 0-9][0-9] \d\d:\d\d:\d\d(?: [+-]\d\d\d\d)? \d\d(?:\d\d)\n/
89	or die "$path: not standard mbox format header:\n$head\n";
90
91	local $/ = "\nFrom ";
92	# NEVER enable this. content-length simply is broken by design
93	#if ($head =~ /^Content-Length:\s+(\d+)$/im) {
94	# $1 <= read $fh, $body, $1 + 5
95	# or die "$path: partial message in mbox";
96	#} else {
97	$body = <$fh>;
98	#}
99	chomp $body;
100	$cb->($offs, \$head, \$body);
101	$offs = (tell $fh) - 5;
102	&::give unless ++$ecnt & 255;
103	}
104
105	1;
106	}
107
108	sub conf_path {
109	(my $conf = $_[0]{path}) =~ s%([^/]+$)%.$1.mdif%;
110	$conf;
111	}
112
113	sub read_mdif {
114	my $self = shift;
115	my $path = $self->conf_path;
116
117	return if $self->{idx};
118
119	open my $fh, "<", $path
120	or return;
121
122	defined ($_ = <$fh>)
123	or die "$path: empty mdif file\n";
124
125	do {
126	if ($_ eq "[SYNCMAIL]\n") {
127	while (<$fh>) {
128	last unless /^([a-z]+)\s=\s(.*)\n$/;
129	$self->{$1} = $2;
130	}
131	} elsif ($_ eq "[HOSTS]\n") {
132	while (<$fh>) {
133	last unless /^([^[].)=(.)\n$/;
134	$self->{host}{$1} = $2;
135	}
136	} elsif (/^\[DIFF (\d+)\]\n$/) {
137	my $mtime = $1;
138	my (@add, @del);
139	while (<$fh>) {
140	last unless /^([+-])(.*)\n$/;
141	if ($1 eq "+") {
142	push @add, $2;
143	} else {
144	push @del, $2;
145	}
146	}
147	unshift @{$self->{diff}}, [$mtime, \@add, \@del];
148	} elsif ($_ eq "[INDEX]\n") {
149	my @idx;
150	while (<$fh>) {
151	last unless /^(\d+)=(.*)\n$/;
152	push @idx, [$1, $2];
153	}
154	$self->{idx} = \@idx;
155	} elsif (/^#/) {
156	$_ = <$fh>;
157	# nop
158	} else {
159	die "$path: unparseable section '$_'\n";
160	}
161	} while defined $_;
162
163	$self->{version} <= MDIFVERSION
164	or die "$path: version mismatch ($self->{version} found, <".MDIFVERSION." expected)\n";
165	}
166
167	sub write_mdif {
168	my $self = shift;
169	my $path = $self->conf_path;
170
171	return unless $self->{dirty};
172
173	open my $fh, ">", "$path~"
174	or die "$path~: $!";
175
176	print $fh "# automatically generated, do NOT edit\n";
177
178	print $fh "[SYNCMAIL]\n";
179	print $fh "$_=$self->{$_}\n" for (qw(fsize mtime version ctime));
180
181	print $fh "[HOSTS]\n";
182	while (my ($k,$v) = each %{$self->{host}}) {
183	print $fh "$k=$v\n";
184	}
185
186	print $fh "[INDEX]\n";
187	print $fh "$_->[0]=$_->[1]\n" for @{$self->{idx}};
188
189	for (reverse @{$self->{diff}}) {
190	print $fh "[DIFF $_->[0]]\n";
191	print $fh "+$_\n" for @{$_->[1]};
192	print $fh "-$_\n" for @{$_->[2]};
193	}
194
195	flushfh $fh;
196	File::Sync::fsync($fh);
197	close $fh
198	or die "$path~: unable to create updated .mdif: $!";
199
200	replace("$path~", $path);
201
202	delete $self->{dirty};
203	}
204
205	sub gendiff {
206	my ($self, $d1, $d2) = @_;
207
208	my (@add, @del);
209	my (%d1, %d2);
210
211	for (@$d2) {
212	undef $d2{$_->[1]};
213	}
214
215	# delete msgs in d1 but not in d2
216	for (@$d1) {
217	undef $d1{$_->[1]};
218	push @del, $_->[1] unless exists $d2{$_->[1]};
219	}
220	%d2 = (); # conserve memory
221
222	# add msgs in d2 but not in d1
223	for (@$d2) {
224	push @add, $_->[1] unless exists $d1{$_->[1]};
225	}
226
227	push @{$self->{diff}}, [
228	$self->{ctime},
229	\@add, \@del,
230	] if @add \|\| @del;
231	}
232
233	sub check {
234	my $self = shift;
235	my $path = $self->{path};
236	my $conf = $self->conf_path;
237	my $guard = $::lockdisk->guard;
238
239	slog 3, "checking $path\n";
240
241	stat $path
242	or die "$path: $!";
243
244	my ($fsize, $mtime) = (stat _)[7, 9];
245
246	if (open my $fh, "<", $conf) {
247	my %conf;
248	<$fh>; # skip initial comment
249	<$fh> eq "[SYNCMAIL]\n"
250	or die "$conf: format error";
251	while (<$fh> =~ /^([a-z]+)\s=\s(.*)$/) {
252	$conf{$1} = $2;
253	}
254	return 1 if $fsize == $conf{fsize}
255	&& $mtime == $conf{mtime};
256
257	$conf{mtime} <= $mtime
258	or die "$path: folder older than mdif";
259	}
260
261	slog 2, "updating $path\n";
262
263	my @idx;
264
265	parse_mbox $self->{fh}, sub {
266	my ($offs, $head, $body) = @_;
267	push @idx, [$offs, hash($$head, "\0", $$body)];
268	} or die "$path: no valid mbox file";
269
270	$self->read_mdif;
271
272	$self->{version} \|\|= MDIFVERSION;
273	$self->{ctime} = time;
274
275	$self->gendiff($self->{idx}, \@idx);
276
277	$self->{fsize} = $fsize;
278	$self->{mtime} = $mtime;
279	$self->{idx} = \@idx;
280
281	$self->dirty;
282	$self->write_mdif;
283	}
284
285	sub inventory {
286	hash sort map { $_->[1] } @{$_[0]{idx}};
287	}
288
289	sub open {
290	my ($self, $rw) = @_;
291
292	if (!$self->{fh} \|\| $self->{rw} != $rw) {
293	$self->close;
294	$self->{rw} = $rw;
295	sysopen $self->{fh}, $self->{path},
296	O_CREAT \| ($rw ? O_RDWR : O_RDONLY),
297	0666
298	or die "$self->{path}: $!";
299	0 == setlkw(fileno $self->{fh}, $rw ? 2 : 1)
300	or die "$self->{path}: $!";
301
302	}
303	}
304
305	sub close {
306	my $self = shift;
307
308	flushfh $self->{fh};
309	File::Sync::fsync($self->{fh});
310	delete $self->{fh};
311	}
312
313	# begin updating folder
314	sub begin_update {
315	my $self = shift;
316
317	$self->{oidx} = $self->{idx};
318
319	}
320
321	sub delete {
322	my $self = shift;
323	my $temp = "$self->{path}~";
324
325	if (@_) {
326	my $guard = $::lockdisk->guard;
327	my %del; @del{@_} = ();
328
329	open my $fh, ">", $temp
330	or die "$temp: $!";
331
332	my $nidx;
333	my $idx = delete $self->{idx};
334	push @$idx, [$self->{fsize}];
335	$self->{fsize} = 0; # we virtually truncated the file
336
337	slog 0, "XXXXXXXXXXXXXXX @_\n";#d#
338
339	my $ofs = 0;
340	for (0 .. @$idx - 2) {
341	my $buf;
342
343	unless (exists $del{$idx->[$_][1]}) {
344	my $len = $idx->[$_+1][0] - $idx->[$_][0];
345
346	slog 0, "$idx->[$_][1] $idx->[$_+1][0] - $idx->[$_][0]\n";#d#
347
348	seek $self->{fh}, $idx->[$_][0],SEEK_SET
349	or die "$self->{path}: $!";
350
351	$len == read $self->{fh}, $buf, $len
352	or die "$self->{path}: $!";
353
354	$buf =~ /^From \S/
355	or die "$self->{path}: corrupted mail folder";
356
357	&::give unless ++$ecnt & 255;
358	} else {
359	slog 0, "skipping $idx->[$_][1]\n";
360	}
361	}
362
363	File::Sync::fsync($fh);
364	close $fh;
365
366	# replace $temp, $self->{path}
367	}
368	}
369
370	sub end_update {
371	}
372
373	sub append {
374	my $self = shift;
375
376	&update;
377	#$self->open(1);
378	}
379
380	1;
381
382	__DATA__
383	__C__
384	#include <unistd.h>
385	#include <fcntl.h>
386
387	/* mode0 unlock, mode1 rlock, mode2 rwlock */
388	int setlkw(int fd, int mode)
389	{
390	struct flock l;
391
392	l.l_type = mode == 0 ? F_UNLCK
393	: mode == 1 ? F_RDLCK
394	: F_WRLCK;
395	l.l_whence = SEEK_SET;
396	l.l_start = 0;
397	l.l_len = 0;
398
399	return fcntl (fd, F_SETLKW, &l);
400	}
401