syncmail/folder.pm

package folder;

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

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 @dif;
         while (<$fh>) {
            last unless /^[+-]/;
            push @dif, substr $_, 0, -1;
         }
         unshift @{$self->{diff}}, [$mtime, \@dif];
      } 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]};
   }

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

   rename "$path~", $path;

   delete $self->{dirty};
}

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

   my @d;
   my (%d1, %d2);

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

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

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

   \@d;
}

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) = @_;
         my $mid;
         if ($$head =~ /^Message-Id:\s*(<[^<\n]+>)\s*\n/im) {
            $mid = $1;
         } else {
            $mid = MD5->hexhash("$$head\0$$body");
         }
         push @idx, [$offs, $mid];
      } or return ();

      $self->read_mdif;

      if ($self->{version}) {
         my $d = gendiff $self->{idx}, \@idx;
         push @{$self->{diff}}, [
            $self->{mtime},
            $d,
         ] if @$d;
      } else {
         slog 2, "$path: previously unknown folder\n";
         $self->{version} ||= MDIFVERSION;
      }

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