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 fflush {
   my $oldfh = select $_[0];
   $| = 1; $| = 0;
   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; # do NOT!
}

# 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]};
   }

   fflush($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 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}: $!";

      $self->check;
   }
}

sub close {
   my $self = shift;

   if ($self->{rw} && $self->{fh}) {
      fflush($self->{fh});
      File::Sync::fsync($self->{fh});
   }

   $self->write_mdif;

   delete $self->{fh};
}

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

   slog 3, "checking $self->{path}\n";

   my ($fsize, $mtime) = (stat $self->{fh})[7, 9];

   if ($self->{idx}) {
      return 1 if $fsize == $self->{fsize}
               && $mtime == $self->{mtime};
   } else {
      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 "$self->{path}: folder older than mdif";
      }
   }

   slog 2, "updating $self->{path}\n";

   my @idx;

   seek $self->{fh}, 0, SEEK_SET;

   parse_mbox $self->{fh}, sub {
      my ($offs, $head, $body) = @_;
      push @idx, [$offs, hash($$head, "\n\n", $$body)];
   } or die "$self->{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;#d#
}

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

sub iidx {
   my $self = shift;

   $self->{iidx} ||= do {
      my %iidx;
      my $idx = $self->{idx};

      push @$idx, [$self->{fsize}];
      my $ofs = 0;
      for (0 .. @$idx - 2) {
         $iidx{$idx->[$_][1]} = [$idx->[$_][0], $idx->[$_+1][0] - $idx->[$_][0]];
      }
      pop @$idx, [$self->{fsize}];

      \%iidx;
   };
}

sub exists {
   $_[0]->iidx unless $_[0]{iidx};
   return $_[0]{iidx}{$_[1]};
}

sub fetch {
   my ($self, $hash) = @_;

   $self->iidx unless $self->{iidx};

   my $mail;

   my $msg = $self->{iidx}{$hash}
      or die "$hash: no such message in $self->{path}";

   print STDERR "$self->{fh}, $msg->[0], SEEK_SET\n";#d#

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

   print STDERR "$msg->[1] == read $self->{fh}, $msg->[1]\n";#d#

   $msg->[1] == read $self->{fh}, $mail, $msg->[1]
      or die "$self->{path}: $!";

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

   $mail;
}

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

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

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

   $self->iidx unless $self->{iidx};

   for (@_) {
      if (exists $self->{iidx}{$_}) { # at least one message exists
         my $guard = $::lockdisk->guard;
         my %del; @del{@_} = ();
         my @nidx;
         my $dofs = 0;

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

         eval {
            0 == setlkw(fileno $fh, 2)
               or die "$self->{path}~: $!";

            $self->{fsize} = 0; # we virtually truncated the file

            for (@{delete $self->{idx}}) {
               my $hash = $_->[1];
               my $buf;

               unless (exists $del{$hash}) {
                  my ($ofs, $len) = @{$self->{iidx}{$hash}};

                  $len or die;

                  seek $self->{fh}, $ofs, 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";

                  print $fh $buf
                     or die "$self->{path}: $!";

                  push @nidx, [$dofs, $hash];
                  $self->{iidx}{$hash}[0] = $dofs;
                  $dofs += $len;

                  &::give unless ++$ecnt & 255;
               } else {
                  delete $self->{iidx}{$hash};
                  slog 0, "skipping/deleting $hash\n";
               }
            }
         };

         if ($@) {
            close $fh;
            unlink $temp;
            die;
         }

         fflush($fh);
         File::Sync::fsync($fh);
         replace $temp, $self->{path};

         $self->{fh} = $fh;
         $self->{rw} = 1;

         delete $self->{iidx};

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

         return;
      }
   }
}

sub append {
   my ($self, $hash, $mail) = @_;

   if (length $mail) {
      $self->open(1);

      seek $self->{fh}, $self->{fsize}, SEEK_SET
         or die "$self->{path}: $!";

      print {$self->{fh}} $mail
         or die "$self->{path}: $!";

      push @{$self->{idx}}, [$self->{fsize}, $hash];
      $self->{fsize} += length $mail;
   }
}

sub end_update {
   my $self = shift;

   $self->gendiff((delete $self->{oidx}), $self->{idx});

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

   stat $self->{fh}
      or die "$self->{path}: $!";

   $self->{fsize} = (stat _)[7];
   $self->{mtime} = (stat _)[9];

   $self->dirty;
}

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.6
Committed:	Mon Oct 29 02:36:32 2001 UTC (22 years, 6 months ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.5:	+14 -9 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	package folder;
2
3			BEGIN { *slog = \&::slog };
4
5	root	1.4	use Fcntl;
6			use File::Sync ();
7
8			use Inline Config => NAME => "syncmail::folder";
9			use Inline C;
10	root	1.2
11	root	1.1	use constant MDIFVERSION => 1;
12
13	root	1.4	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	root	1.6	sub fflush {
29	root	1.4	my $oldfh = select $_[0];
30	root	1.6	$\| = 1; $\| = 0;
31	root	1.4	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	root	1.1	sub new {
52			my $class = shift;
53			my %arg = @_;
54	root	1.4	my $self = bless {
55	root	1.1	path => "$::PREFIX/$arg{name}",
56			%arg,
57			}, $class;
58	root	1.4	$self->open(0);
59			$self;
60	root	1.1	}
61
62			sub dirty {
63			$_[0]{dirty} = 1;
64			}
65
66			sub DESTROY {
67	root	1.5	#$_[0]->write_mdif; # do NOT!
68	root	1.1	}
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	root	1.4	my ($fh, $cb) = @_;
76	root	1.1
77			local $/ = "\n\n";
78
79			my ($head, $body, $offs);
80
81	root	1.4	read $fh, $head, 5;
82	root	1.1
83	root	1.4	$head eq "From " or $head eq ""
84	root	1.1	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	root	1.4	&::give unless ++$ecnt & 255;
103	root	1.1	}
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	root	1.2	my (@add, @del);
139	root	1.1	while (<$fh>) {
140	root	1.2	last unless /^([+-])(.*)\n$/;
141			if ($1 eq "+") {
142			push @add, $2;
143			} else {
144			push @del, $2;
145			}
146	root	1.1	}
147	root	1.2	unshift @{$self->{diff}}, [$mtime, \@add, \@del];
148	root	1.1	} 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	root	1.3	print $fh "$_=$self->{$_}\n" for (qw(fsize mtime version ctime));
180	root	1.1
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	root	1.2	print $fh "+$_\n" for @{$_->[1]};
192			print $fh "-$_\n" for @{$_->[2]};
193	root	1.1	}
194
195	root	1.6	fflush($fh);
196	root	1.4	File::Sync::fsync($fh);
197	root	1.1	close $fh
198			or die "$path~: unable to create updated .mdif: $!";
199
200	root	1.4	replace("$path~", $path);
201	root	1.1
202			delete $self->{dirty};
203			}
204
205			sub gendiff {
206	root	1.4	my ($self, $d1, $d2) = @_;
207	root	1.1
208	root	1.2	my (@add, @del);
209	root	1.1	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	root	1.2	push @del, $_->[1] unless exists $d2{$_->[1]};
219	root	1.1	}
220			%d2 = (); # conserve memory
221
222			# add msgs in d2 but not in d1
223			for (@$d2) {
224	root	1.2	push @add, $_->[1] unless exists $d1{$_->[1]};
225	root	1.1	}
226
227	root	1.4	push @{$self->{diff}}, [
228			$self->{ctime},
229			\@add, \@del,
230			] if @add \|\| @del;
231	root	1.1	}
232
233	root	1.5	sub open {
234			my ($self, $rw) = @_;
235
236			if (!$self->{fh} \|\| $self->{rw} != $rw) {
237			$self->close;
238			$self->{rw} = $rw;
239			sysopen $self->{fh}, $self->{path},
240			O_CREAT \| ($rw ? O_RDWR : O_RDONLY),
241			0666
242			or die "$self->{path}: $!";
243			0 == setlkw(fileno $self->{fh}, $rw ? 2 : 1)
244			or die "$self->{path}: $!";
245
246			$self->check;
247			}
248			}
249
250			sub close {
251			my $self = shift;
252
253			if ($self->{rw} && $self->{fh}) {
254	root	1.6	fflush($self->{fh});
255	root	1.5	File::Sync::fsync($self->{fh});
256			}
257
258			$self->write_mdif;
259
260			delete $self->{fh};
261			}
262
263	root	1.1	sub check {
264			my $self = shift;
265			my $conf = $self->conf_path;
266			my $guard = $::lockdisk->guard;
267
268	root	1.5	slog 3, "checking $self->{path}\n";
269	root	1.1
270	root	1.5	my ($fsize, $mtime) = (stat $self->{fh})[7, 9];
271	root	1.1
272	root	1.5	if ($self->{idx}) {
273			return 1 if $fsize == $self->{fsize}
274			&& $mtime == $self->{mtime};
275			} else {
276			if (open my $fh, "<", $conf) {
277			my %conf;
278			<$fh>; # skip initial comment
279			<$fh> eq "[SYNCMAIL]\n"
280			or die "$conf: format error";
281			while (<$fh> =~ /^([a-z]+)\s=\s(.*)$/) {
282			$conf{$1} = $2;
283			}
284			return 1 if $fsize == $conf{fsize}
285			&& $mtime == $conf{mtime};
286	root	1.1
287	root	1.5	$conf{mtime} <= $mtime
288			or die "$self->{path}: folder older than mdif";
289	root	1.1	}
290	root	1.4	}
291
292	root	1.5	slog 2, "updating $self->{path}\n";
293	root	1.1
294	root	1.4	my @idx;
295	root	1.1
296	root	1.5	seek $self->{fh}, 0, SEEK_SET;
297
298	root	1.4	parse_mbox $self->{fh}, sub {
299			my ($offs, $head, $body) = @_;
300	root	1.5	push @idx, [$offs, hash($$head, "\n\n", $$body)];
301			} or die "$self->{path}: no valid mbox file";
302	root	1.1
303	root	1.4	$self->read_mdif;
304	root	1.1
305	root	1.4	$self->{version} \|\|= MDIFVERSION;
306			$self->{ctime} = time;
307	root	1.1
308	root	1.4	$self->gendiff($self->{idx}, \@idx);
309	root	1.3
310	root	1.4	$self->{fsize} = $fsize;
311			$self->{mtime} = $mtime;
312			$self->{idx} = \@idx;
313
314			$self->dirty;
315	root	1.5	$self->write_mdif;#d#
316	root	1.4	}
317
318			sub inventory {
319			hash sort map { $_->[1] } @{$_[0]{idx}};
320			}
321	root	1.1
322	root	1.5	sub iidx {
323			my $self = shift;
324
325			$self->{iidx} \|\|= do {
326			my %iidx;
327			my $idx = $self->{idx};
328
329			push @$idx, [$self->{fsize}];
330			my $ofs = 0;
331			for (0 .. @$idx - 2) {
332			$iidx{$idx->[$_][1]} = [$idx->[$_][0], $idx->[$_+1][0] - $idx->[$_][0]];
333			}
334			pop @$idx, [$self->{fsize}];
335	root	1.1
336	root	1.5	\%iidx;
337			};
338			}
339	root	1.1
340	root	1.5	sub exists {
341			$_[0]->iidx unless $_[0]{iidx};
342			return $_[0]{iidx}{$_[1]};
343	root	1.1	}
344
345	root	1.5	sub fetch {
346			my ($self, $hash) = @_;
347
348			$self->iidx unless $self->{iidx};
349
350			my $mail;
351
352			my $msg = $self->{iidx}{$hash}
353			or die "$hash: no such message in $self->{path}";
354
355	root	1.6	print STDERR "$self->{fh}, $msg->[0], SEEK_SET\n";#d#
356
357	root	1.5	seek $self->{fh}, $msg->[0], SEEK_SET
358			or die "$self->{path}: $!";
359
360	root	1.6	print STDERR "$msg->[1] == read $self->{fh}, $msg->[1]\n";#d#
361
362	root	1.5	$msg->[1] == read $self->{fh}, $mail, $msg->[1]
363			or die "$self->{path}: $!";
364
365			$mail =~ /^From \S/
366			or die "$self->{path}: mail folder corrupted";
367	root	1.4
368	root	1.5	$mail;
369	root	1.4	}
370
371			# begin updating folder
372			sub begin_update {
373			my $self = shift;
374
375			$self->{oidx} = $self->{idx};
376			}
377
378			sub delete {
379			my $self = shift;
380			my $temp = "$self->{path}~";
381
382	root	1.5	$self->iidx unless $self->{iidx};
383
384			for (@_) {
385			if (exists $self->{iidx}{$_}) { # at least one message exists
386			my $guard = $::lockdisk->guard;
387			my %del; @del{@_} = ();
388			my @nidx;
389	root	1.6	my $dofs = 0;
390	root	1.5
391	root	1.6	open my $fh, "+>", $temp
392	root	1.5	or die "$temp: $!";
393
394			eval {
395			0 == setlkw(fileno $fh, 2)
396			or die "$self->{path}~: $!";
397	root	1.4
398	root	1.5	$self->{fsize} = 0; # we virtually truncated the file
399	root	1.4
400	root	1.5	for (@{delete $self->{idx}}) {
401			my $hash = $_->[1];
402			my $buf;
403
404			unless (exists $del{$hash}) {
405			my ($ofs, $len) = @{$self->{iidx}{$hash}};
406	root	1.4
407	root	1.5	$len or die;
408	root	1.4
409	root	1.5	seek $self->{fh}, $ofs, SEEK_SET
410			or die "$self->{path}: $!";
411	root	1.4
412	root	1.5	$len == read $self->{fh}, $buf, $len
413			or die "$self->{path}: $!";
414	root	1.4
415	root	1.5	$buf =~ /^From \S/
416			or die "$self->{path}: corrupted mail folder";
417	root	1.4
418	root	1.5	print $fh $buf
419			or die "$self->{path}: $!";
420	root	1.4
421	root	1.5	push @nidx, [$dofs, $hash];
422			$self->{iidx}{$hash}[0] = $dofs;
423			$dofs += $len;
424	root	1.4
425	root	1.5	&::give unless ++$ecnt & 255;
426			} else {
427			delete $self->{iidx}{$hash};
428			slog 0, "skipping/deleting $hash\n";
429			}
430			}
431			};
432	root	1.4
433	root	1.5	if ($@) {
434			close $fh;
435			unlink $temp;
436			die;
437	root	1.4	}
438	root	1.5
439	root	1.6	fflush($fh);
440	root	1.5	File::Sync::fsync($fh);
441			replace $temp, $self->{path};
442
443			$self->{fh} = $fh;
444			$self->{rw} = 1;
445
446			delete $self->{iidx};
447
448			$self->{idx} = \@nidx;
449	root	1.6	$self->{fsize} = $dofs;
450	root	1.5
451			return;
452	root	1.4	}
453	root	1.5	}
454			}
455
456			sub append {
457			my ($self, $hash, $mail) = @_;
458
459			if (length $mail) {
460			$self->open(1);
461
462			seek $self->{fh}, $self->{fsize}, SEEK_SET
463			or die "$self->{path}: $!";
464	root	1.4
465	root	1.5	print {$self->{fh}} $mail
466			or die "$self->{path}: $!";
467	root	1.4
468	root	1.5	push @{$self->{idx}}, [$self->{fsize}, $hash];
469			$self->{fsize} += length $mail;
470	root	1.4	}
471			}
472
473			sub end_update {
474	root	1.5	my $self = shift;
475
476	root	1.6	$self->gendiff((delete $self->{oidx}), $self->{idx});
477	root	1.5
478	root	1.6	fflush($self->{fh});
479	root	1.5	File::Sync::fsync($self->{fh});
480
481			stat $self->{fh}
482			or die "$self->{path}: $!";
483	root	1.4
484	root	1.5	$self->{fsize} = (stat _)[7];
485			$self->{mtime} = (stat _)[9];
486	root	1.4
487	root	1.5	$self->dirty;
488	root	1.4	}
489
490	root	1.1	1;
491	root	1.4
492			__DATA__
493			__C__
494			#include <unistd.h>
495			#include <fcntl.h>
496
497			/* mode0 unlock, mode1 rlock, mode2 rwlock */
498			int setlkw(int fd, int mode)
499			{
500			struct flock l;
501
502			l.l_type = mode == 0 ? F_UNLCK
503			: mode == 1 ? F_RDLCK
504			: F_WRLCK;
505			l.l_whence = SEEK_SET;
506			l.l_start = 0;
507			l.l_len = 0;
508
509			return fcntl (fd, F_SETLKW, &l);
510			}
511	root	1.1