syncmail/folder.pm

package folder;

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

use Digest::SHA1;

use constant MDIFVERSION => 1;

sub new {
   my $class = shift;
   my %arg = @_;
   bless {
      path => "$::PREFIX/$arg{name}",
      %arg,
   }, $class;
}

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 ($path, $cb) = @_;

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

  local $/ = "\n\n";

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

  5 == read $fh, $head, 5
     or return;

  $head eq "From "
     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 & 1023;
  }

  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));

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

   close $fh
      or die "$path~: unable to create updated .mdif: $!";

   rename "$path~", $path;

   delete $self->{dirty};
}

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 gendiff {
   my ($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]};
   }

   (\@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";

   if (stat $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 $path, sub {
         my ($offs, $head, $body) = @_;
         push @idx, [$offs, hash($$head, "\0", $$body)];
      } or return ();

      $self->read_mdif;

      $self->{version} ||= MDIFVERSION;
      my ($add, $del) = gendiff $self->{idx}, \@idx;
      push @{$self->{diff}}, [
         $mtime,
         $add, $del,
      ] if @$add || @$del;

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

      $self->dirty;

      return 2;
   } else {
      slog 2, "$path: no longer exists\n";
      unlink $conf;

      return ();
   }
}

1;

Revision:	1.2
Committed:	Sun Oct 28 03:51:24 2001 UTC (22 years, 6 months ago) by root
Branch:	MAIN
Changes since 1.1:	+36 -26 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	package folder;
2
3			BEGIN { *slog = \&::slog };
4
5	root	1.2	use Digest::SHA1;
6
7	root	1.1	use constant MDIFVERSION => 1;
8
9			sub new {
10			my $class = shift;
11			my %arg = @_;
12			bless {
13			path => "$::PREFIX/$arg{name}",
14			%arg,
15			}, $class;
16			}
17
18			sub dirty {
19			$_[0]{dirty} = 1;
20			}
21
22			sub DESTROY {
23			$_[0]->write_mdif;
24			}
25
26			# parse_mbox(mbox-file-path, callback)
27			# callback gets called with \$header and \$body,
28			# $header includes the mbox From_ line without
29			# the leading From_ itself.
30			sub parse_mbox {
31			my ($path, $cb) = @_;
32
33			open my $fh, "<", $path
34			or die "$path: $!";
35
36			local $/ = "\n\n";
37
38			my ($head, $body, $offs);
39
40			5 == read $fh, $head, 5
41			or return;
42
43			$head eq "From "
44			or return;
45
46			$offs = 0;
47			while (defined ($head = <$fh>)) {
48			$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/
49			or die "$path: not standard mbox format header:\n$head\n";
50
51			local $/ = "\nFrom ";
52			# NEVER enable this. content-length simply is broken by design
53			#if ($head =~ /^Content-Length:\s+(\d+)$/im) {
54			# $1 <= read $fh, $body, $1 + 5
55			# or die "$path: partial message in mbox";
56			#} else {
57			$body = <$fh>;
58			#}
59			chomp $body;
60			$cb->($offs, \$head, \$body);
61			$offs = (tell $fh) - 5;
62			::give unless ++$ecnt & 1023;
63			}
64
65			1;
66			}
67
68			sub conf_path {
69			(my $conf = $_[0]{path}) =~ s%([^/]+$)%.$1.mdif%;
70			$conf;
71			}
72
73			sub read_mdif {
74			my $self = shift;
75			my $path = $self->conf_path;
76
77			return if $self->{idx};
78
79			open my $fh, "<", $path
80			or return;
81
82			defined ($_ = <$fh>)
83			or die "$path: empty mdif file\n";
84
85			do {
86			if ($_ eq "[SYNCMAIL]\n") {
87			while (<$fh>) {
88			last unless /^([a-z]+)\s=\s(.*)\n$/;
89			$self->{$1} = $2;
90			}
91			} elsif ($_ eq "[HOSTS]\n") {
92			while (<$fh>) {
93			last unless /^([^[].)=(.)\n$/;
94			$self->{host}{$1} = $2;
95			}
96			} elsif (/^\[DIFF (\d+)\]\n$/) {
97			my $mtime = $1;
98	root	1.2	my (@add, @del);
99	root	1.1	while (<$fh>) {
100	root	1.2	last unless /^([+-])(.*)\n$/;
101			if ($1 eq "+") {
102			push @add, $2;
103			} else {
104			push @del, $2;
105			}
106	root	1.1	}
107	root	1.2	unshift @{$self->{diff}}, [$mtime, \@add, \@del];
108	root	1.1	} elsif ($_ eq "[INDEX]\n") {
109			my @idx;
110			while (<$fh>) {
111			last unless /^(\d+)=(.*)\n$/;
112			push @idx, [$1, $2];
113			}
114			$self->{idx} = \@idx;
115			} elsif (/^#/) {
116			$_ = <$fh>;
117			# nop
118			} else {
119			die "$path: unparseable section '$_'\n";
120			}
121			} while defined $_;
122
123			$self->{version} <= MDIFVERSION
124			or die "$path: version mismatch ($self->{version} found, <".MDIFVERSION." expected)\n";
125			}
126
127			sub write_mdif {
128			my $self = shift;
129			my $path = $self->conf_path;
130
131			return unless $self->{dirty};
132
133			open my $fh, ">", "$path~"
134			or die "$path~: $!";
135
136			print $fh "# automatically generated, do NOT edit\n";
137
138			print $fh "[SYNCMAIL]\n";
139			print $fh "$_=$self->{$_}\n" for (qw(fsize mtime version));
140
141			print $fh "[HOSTS]\n";
142			while (my ($k,$v) = each %{$self->{host}}) {
143			print $fh "$k=$v\n";
144			}
145
146			print $fh "[INDEX]\n";
147			print $fh "$_->[0]=$_->[1]\n" for @{$self->{idx}};
148
149			for (reverse @{$self->{diff}}) {
150			print $fh "[DIFF $_->[0]]\n";
151	root	1.2	print $fh "+$_\n" for @{$_->[1]};
152			print $fh "-$_\n" for @{$_->[2]};
153	root	1.1	}
154
155			close $fh
156			or die "$path~: unable to create updated .mdif: $!";
157
158			rename "$path~", $path;
159
160			delete $self->{dirty};
161			}
162
163	root	1.2	if (1) {
164			use OpenSSL ();
165			*hash = \&OpenSSL::Digest::sha1_hex;
166			} elsif (0) {
167			# use Digest::SHA1;
168			my $digest = new Digest::SHA1;
169			*hash = sub {
170			$digest->reset;
171			$digest->add(@_);
172			$mid = $digest->hexdigest;
173			};
174			}
175
176	root	1.1	sub gendiff {
177			my ($d1, $d2) = @_;
178
179	root	1.2	my (@add, @del);
180	root	1.1	my (%d1, %d2);
181
182			for (@$d2) {
183			undef $d2{$_->[1]};
184			}
185
186			# delete msgs in d1 but not in d2
187			for (@$d1) {
188			undef $d1{$_->[1]};
189	root	1.2	push @del, $_->[1] unless exists $d2{$_->[1]};
190	root	1.1	}
191			%d2 = (); # conserve memory
192
193			# add msgs in d2 but not in d1
194			for (@$d2) {
195	root	1.2	push @add, $_->[1] unless exists $d1{$_->[1]};
196	root	1.1	}
197
198	root	1.2	(\@add, \@del);
199	root	1.1	}
200
201			sub check {
202			my $self = shift;
203			my $path = $self->{path};
204			my $conf = $self->conf_path;
205			my $guard = $::lockdisk->guard;
206
207			slog 3, "checking $path\n";
208
209			if (stat $path) {
210			my ($fsize, $mtime) = (stat _)[7, 9];
211
212			if (open my $fh, "<", $conf) {
213			my %conf;
214			<$fh>; # skip initial comment
215			<$fh> eq "[SYNCMAIL]\n"
216			or die "$conf: format error";
217			while (<$fh> =~ /^([a-z]+)\s=\s(.*)$/) {
218			$conf{$1} = $2;
219			}
220			return 1 if $fsize == $conf{fsize}
221			&& $mtime == $conf{mtime};
222
223			$conf{mtime} <= $mtime
224			or die "$path: folder older than mdif";
225			}
226
227			slog 2, "updating $path\n";
228
229			my @idx;
230
231			parse_mbox $path, sub {
232			my ($offs, $head, $body) = @_;
233	root	1.2	push @idx, [$offs, hash($$head, "\0", $$body)];
234	root	1.1	} or return ();
235
236			$self->read_mdif;
237
238	root	1.2	$self->{version} \|\|= MDIFVERSION;
239			my ($add, $del) = gendiff $self->{idx}, \@idx;
240			push @{$self->{diff}}, [
241			$mtime,
242			$add, $del,
243			] if @$add \|\| @$del;
244	root	1.1
245			$self->{fsize} = $fsize;
246			$self->{mtime} = $mtime;
247			$self->{idx} = \@idx;
248
249			$self->dirty;
250
251			return 2;
252			} else {
253			slog 2, "$path: no longer exists\n";
254			unlink $conf;
255
256			return ();
257			}
258			}
259
260			1;
261